JimPanic() doesn't require interp
[jimtcl.git] / jim.c
blobf9565bd18d2944ca7dba1b9066e865f40245fc23
2 /* Jim - A small embeddable Tcl interpreter
4 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
5 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
7 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
8 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
9 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
10 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
11 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
12 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
13 * Copyright 2009 Zachary T Welch zw@superlucidity.net
14 * Copyright 2009 David Brownell
16 * Redistribution and use in source and binary forms, with or without
17 * modification, are permitted provided that the following conditions
18 * are met:
20 * 1. Redistributions of source code must retain the above copyright
21 * notice, this list of conditions and the following disclaimer.
22 * 2. Redistributions in binary form must reproduce the above
23 * copyright notice, this list of conditions and the following
24 * disclaimer in the documentation and/or other materials
25 * provided with the distribution.
27 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
28 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
29 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
30 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
31 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
32 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
33 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
34 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
35 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
36 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
37 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
38 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 * The views and conclusions contained in the software and documentation
41 * are those of the authors and should not be interpreted as representing
42 * official policies, either expressed or implied, of the Jim Tcl Project.
43 **/
44 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
46 #include <stdio.h>
47 #include <stdlib.h>
49 #include <string.h>
50 #include <stdarg.h>
51 #include <ctype.h>
52 #include <limits.h>
53 #include <assert.h>
54 #include <errno.h>
55 #include <time.h>
56 #include <setjmp.h>
58 #include <unistd.h>
59 #include <sys/time.h>
61 #include "jim.h"
62 #include "jimautoconf.h"
63 #include "utf8.h"
65 #ifdef HAVE_BACKTRACE
66 #include <execinfo.h>
67 #endif
68 #ifdef HAVE_CRT_EXTERNS_H
69 #include <crt_externs.h>
70 #endif
72 /* For INFINITY, even if math functions are not enabled */
73 #include <math.h>
75 /* We may decide to switch to using $[...] after all, so leave it as an option */
76 /*#define EXPRSUGAR_BRACKET*/
78 /* For the no-autoconf case */
79 #ifndef TCL_LIBRARY
80 #define TCL_LIBRARY "."
81 #endif
82 #ifndef TCL_PLATFORM_OS
83 #define TCL_PLATFORM_OS "unknown"
84 #endif
85 #ifndef TCL_PLATFORM_PLATFORM
86 #define TCL_PLATFORM_PLATFORM "unknown"
87 #endif
88 #ifndef TCL_PLATFORM_PATH_SEPARATOR
89 #define TCL_PLATFORM_PATH_SEPARATOR ":"
90 #endif
92 /*#define DEBUG_SHOW_SCRIPT*/
93 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
94 /*#define DEBUG_SHOW_SUBST*/
95 /*#define DEBUG_SHOW_EXPR*/
96 /*#define DEBUG_SHOW_EXPR_TOKENS*/
97 /*#define JIM_DEBUG_GC*/
98 #ifdef JIM_MAINTAINER
99 #define JIM_DEBUG_COMMAND
100 #define JIM_DEBUG_PANIC
101 #endif
103 const char *jim_tt_name(int type);
105 #ifdef JIM_DEBUG_PANIC
106 static void JimPanicDump(int panic_condition, const char *fmt, ...);
107 #define JimPanic(X) JimPanicDump X
108 #else
109 #define JimPanic(X)
110 #endif
112 /* -----------------------------------------------------------------------------
113 * Global variables
114 * ---------------------------------------------------------------------------*/
116 /* A shared empty string for the objects string representation.
117 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
118 static char JimEmptyStringRep[] = "";
120 /* -----------------------------------------------------------------------------
121 * Required prototypes of not exported functions
122 * ---------------------------------------------------------------------------*/
123 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
124 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
125 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
126 int flags);
127 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
128 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
129 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
130 const char *prefix, const char *const *tablePtr, const char *name);
131 static void JimDeleteLocalProcs(Jim_Interp *interp);
132 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr,
133 int argc, Jim_Obj *const *argv);
134 static int JimEvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv,
135 const char *filename, int linenr);
136 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
137 static int JimSign(jim_wide w);
138 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
139 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
140 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
143 static const Jim_HashTableType JimVariablesHashTableType;
145 /* Fast access to the int (wide) value of an object which is known to be of int type */
146 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
148 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
150 static int utf8_tounicode_case(const char *s, int *uc, int upper)
152 int l = utf8_tounicode(s, uc);
153 if (upper) {
154 *uc = utf8_upper(*uc);
156 return l;
159 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
160 #define JIM_CHARSET_SCAN 2
161 #define JIM_CHARSET_GLOB 0
164 * pattern points to a string like "[^a-z\ub5]"
166 * The pattern may contain trailing chars, which are ignored.
168 * The pattern is matched against unicode char 'c'.
170 * If (flags & JIM_NOCASE), case is ignored when matching.
171 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
172 * of the charset, per scan, rather than glob/string match.
174 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
175 * or the null character if the ']' is missing.
177 * Returns NULL on no match.
179 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
181 int not = 0;
182 int pchar;
183 int match = 0;
184 int nocase = 0;
186 if (flags & JIM_NOCASE) {
187 nocase++;
188 c = utf8_upper(c);
191 if (flags & JIM_CHARSET_SCAN) {
192 if (*pattern == '^') {
193 not++;
194 pattern++;
197 /* Special case. If the first char is ']', it is part of the set */
198 if (*pattern == ']') {
199 goto first;
203 while (*pattern && *pattern != ']') {
204 /* Exact match */
205 if (pattern[0] == '\\') {
206 first:
207 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
209 else {
210 /* Is this a range? a-z */
211 int start;
212 int end;
214 pattern += utf8_tounicode_case(pattern, &start, nocase);
215 if (pattern[0] == '-' && pattern[1]) {
216 /* skip '-' */
217 pattern += utf8_tounicode(pattern, &pchar);
218 pattern += utf8_tounicode_case(pattern, &end, nocase);
220 /* Handle reversed range too */
221 if ((c >= start && c <= end) || (c >= end && c <= start)) {
222 match = 1;
224 continue;
226 pchar = start;
229 if (pchar == c) {
230 match = 1;
233 if (not) {
234 match = !match;
237 return match ? pattern : NULL;
240 /* Glob-style pattern matching. */
242 /* Note: string *must* be valid UTF-8 sequences
243 * slen is a char length, not byte counts.
245 static int GlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (GlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
310 static int JimStringMatch(Jim_Interp *interp, Jim_Obj *patternObj, const char *string, int nocase)
312 return GlobMatch(Jim_String(patternObj), string, nocase);
316 * string comparison works on binary data.
318 * Note that the lengths are byte lengths, not char lengths.
320 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
322 if (l1 < l2) {
323 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
325 else if (l2 < l1) {
326 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
328 else {
329 return JimSign(memcmp(s1, s2, l1));
334 * No-case version.
336 * If maxchars is -1, compares to end of string.
337 * Otherwise compares at most 'maxchars' characters.
339 static int JimStringCompareNoCase(const char *s1, const char *s2, int maxchars)
341 while (*s1 && *s2 && maxchars) {
342 int c1, c2;
343 s1 += utf8_tounicode_case(s1, &c1, 1);
344 s2 += utf8_tounicode_case(s2, &c2, 1);
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
423 int Jim_WideToString(char *buf, jim_wide wideValue)
425 const char *fmt = "%" JIM_WIDE_MODIFIER;
427 return sprintf(buf, fmt, wideValue);
431 * After an strtol()/strtod()-like conversion,
432 * check whether something was converted and that
433 * the only thing left is white space.
435 * Returns JIM_OK or JIM_ERR.
437 static int JimCheckConversion(const char *str, const char *endptr)
439 if (str[0] == '\0' || str == endptr) {
440 return JIM_ERR;
443 if (endptr[0] != '\0') {
444 while (*endptr) {
445 if (!isspace(UCHAR(*endptr))) {
446 return JIM_ERR;
448 endptr++;
451 return JIM_OK;
454 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
456 char *endptr;
458 *widePtr = strtoull(str, &endptr, base);
460 return JimCheckConversion(str, endptr);
463 int Jim_DoubleToString(char *buf, double doubleValue)
465 int len;
466 char *buf0 = buf;
468 len = sprintf(buf, "%.12g", doubleValue);
470 /* Add a final ".0" if it's a number. But not
471 * for NaN or InF */
472 while (*buf) {
473 if (*buf == '.' || isalpha(UCHAR(*buf))) {
474 /* inf -> Inf, nan -> Nan */
475 if (*buf == 'i' || *buf == 'n') {
476 *buf = toupper(UCHAR(*buf));
478 if (*buf == 'I') {
479 /* Infinity -> Inf */
480 buf[3] = '\0';
481 len = buf - buf0 + 3;
483 return len;
485 buf++;
488 *buf++ = '.';
489 *buf++ = '0';
490 *buf = '\0';
492 return len + 2;
495 int Jim_StringToDouble(const char *str, double *doublePtr)
497 char *endptr;
499 /* Callers can check for underflow via ERANGE */
500 errno = 0;
502 *doublePtr = strtod(str, &endptr);
504 return JimCheckConversion(str, endptr);
507 static jim_wide JimPowWide(jim_wide b, jim_wide e)
509 jim_wide i, res = 1;
511 if ((b == 0 && e != 0) || (e < 0))
512 return 0;
513 for (i = 0; i < e; i++) {
514 res *= b;
516 return res;
519 /* -----------------------------------------------------------------------------
520 * Special functions
521 * ---------------------------------------------------------------------------*/
522 #ifdef JIM_DEBUG_PANIC
523 void JimPanicDump(int condition, const char *fmt, ...)
525 va_list ap;
527 if (!condition) {
528 return;
531 va_start(ap, fmt);
533 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
534 vfprintf(stderr, fmt, ap);
535 fprintf(stderr, JIM_NL JIM_NL);
536 va_end(ap);
538 #ifdef HAVE_BACKTRACE
540 void *array[40];
541 int size, i;
542 char **strings;
544 size = backtrace(array, 40);
545 strings = backtrace_symbols(array, size);
546 for (i = 0; i < size; i++)
547 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
548 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
549 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
551 #endif
553 abort();
555 #endif
557 /* -----------------------------------------------------------------------------
558 * Memory allocation
559 * ---------------------------------------------------------------------------*/
561 void *Jim_Alloc(int size)
563 return malloc(size);
566 void Jim_Free(void *ptr)
568 free(ptr);
571 void *Jim_Realloc(void *ptr, int size)
573 return realloc(ptr, size);
576 char *Jim_StrDup(const char *s)
578 return strdup(s);
581 char *Jim_StrDupLen(const char *s, int l)
583 char *copy = Jim_Alloc(l + 1);
585 memcpy(copy, s, l + 1);
586 copy[l] = 0; /* Just to be sure, original could be substring */
587 return copy;
590 /* -----------------------------------------------------------------------------
591 * Time related functions
592 * ---------------------------------------------------------------------------*/
594 /* Returns microseconds of CPU used since start. */
595 static jim_wide JimClock(void)
597 struct timeval tv;
599 gettimeofday(&tv, NULL);
600 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
603 /* -----------------------------------------------------------------------------
604 * Hash Tables
605 * ---------------------------------------------------------------------------*/
607 /* -------------------------- private prototypes ---------------------------- */
608 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
609 static unsigned int JimHashTableNextPower(unsigned int size);
610 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
612 /* -------------------------- hash functions -------------------------------- */
614 /* Thomas Wang's 32 bit Mix Function */
615 unsigned int Jim_IntHashFunction(unsigned int key)
617 key += ~(key << 15);
618 key ^= (key >> 10);
619 key += (key << 3);
620 key ^= (key >> 6);
621 key += ~(key << 11);
622 key ^= (key >> 16);
623 return key;
626 /* Generic hash function (we are using to multiply by 9 and add the byte
627 * as Tcl) */
628 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
630 unsigned int h = 0;
632 while (len--)
633 h += (h << 3) + *buf++;
634 return h;
637 /* ----------------------------- API implementation ------------------------- */
639 /* reset a hashtable already initialized with ht_init().
640 * NOTE: This function should only called by ht_destroy(). */
641 static void JimResetHashTable(Jim_HashTable *ht)
643 ht->table = NULL;
644 ht->size = 0;
645 ht->sizemask = 0;
646 ht->used = 0;
647 ht->collisions = 0;
650 /* Initialize the hash table */
651 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
653 JimResetHashTable(ht);
654 ht->type = type;
655 ht->privdata = privDataPtr;
656 return JIM_OK;
659 /* Resize the table to the minimal size that contains all the elements,
660 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
661 int Jim_ResizeHashTable(Jim_HashTable *ht)
663 int minimal = ht->used;
665 if (minimal < JIM_HT_INITIAL_SIZE)
666 minimal = JIM_HT_INITIAL_SIZE;
667 return Jim_ExpandHashTable(ht, minimal);
670 /* Expand or create the hashtable */
671 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
673 Jim_HashTable n; /* the new hashtable */
674 unsigned int realsize = JimHashTableNextPower(size), i;
676 /* the size is invalid if it is smaller than the number of
677 * elements already inside the hashtable */
678 if (ht->used >= size)
679 return JIM_ERR;
681 Jim_InitHashTable(&n, ht->type, ht->privdata);
682 n.size = realsize;
683 n.sizemask = realsize - 1;
684 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
686 /* Initialize all the pointers to NULL */
687 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
689 /* Copy all the elements from the old to the new table:
690 * note that if the old hash table is empty ht->used is zero,
691 * so Jim_ExpandHashTable just creates an empty hash table. */
692 n.used = ht->used;
693 for (i = 0; ht->used > 0; i++) {
694 Jim_HashEntry *he, *nextHe;
696 if (ht->table[i] == NULL)
697 continue;
699 /* For each hash entry on this slot... */
700 he = ht->table[i];
701 while (he) {
702 unsigned int h;
704 nextHe = he->next;
705 /* Get the new element index */
706 h = Jim_HashKey(ht, he->key) & n.sizemask;
707 he->next = n.table[h];
708 n.table[h] = he;
709 ht->used--;
710 /* Pass to the next element */
711 he = nextHe;
714 assert(ht->used == 0);
715 Jim_Free(ht->table);
717 /* Remap the new hashtable in the old */
718 *ht = n;
719 return JIM_OK;
722 /* Add an element to the target hash table */
723 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
725 int idx;
726 Jim_HashEntry *entry;
728 /* Get the index of the new element, or -1 if
729 * the element already exists. */
730 if ((idx = JimInsertHashEntry(ht, key)) == -1)
731 return JIM_ERR;
733 /* Allocates the memory and stores key */
734 entry = Jim_Alloc(sizeof(*entry));
735 entry->next = ht->table[idx];
736 ht->table[idx] = entry;
738 /* Set the hash entry fields. */
739 Jim_SetHashKey(ht, entry, key);
740 Jim_SetHashVal(ht, entry, val);
741 ht->used++;
742 return JIM_OK;
745 /* Add an element, discarding the old if the key already exists */
746 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
748 Jim_HashEntry *entry;
750 /* Try to add the element. If the key
751 * does not exists Jim_AddHashEntry will suceed. */
752 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
753 return JIM_OK;
754 /* It already exists, get the entry */
755 entry = Jim_FindHashEntry(ht, key);
756 /* Free the old value and set the new one */
757 Jim_FreeEntryVal(ht, entry);
758 Jim_SetHashVal(ht, entry, val);
759 return JIM_OK;
762 /* Search and remove an element */
763 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
765 unsigned int h;
766 Jim_HashEntry *he, *prevHe;
768 if (ht->used == 0)
769 return JIM_ERR;
770 h = Jim_HashKey(ht, key) & ht->sizemask;
771 he = ht->table[h];
773 prevHe = NULL;
774 while (he) {
775 if (Jim_CompareHashKeys(ht, key, he->key)) {
776 /* Unlink the element from the list */
777 if (prevHe)
778 prevHe->next = he->next;
779 else
780 ht->table[h] = he->next;
781 Jim_FreeEntryKey(ht, he);
782 Jim_FreeEntryVal(ht, he);
783 Jim_Free(he);
784 ht->used--;
785 return JIM_OK;
787 prevHe = he;
788 he = he->next;
790 return JIM_ERR; /* not found */
793 /* Destroy an entire hash table */
794 int Jim_FreeHashTable(Jim_HashTable *ht)
796 unsigned int i;
798 /* Free all the elements */
799 for (i = 0; ht->used > 0; i++) {
800 Jim_HashEntry *he, *nextHe;
802 if ((he = ht->table[i]) == NULL)
803 continue;
804 while (he) {
805 nextHe = he->next;
806 Jim_FreeEntryKey(ht, he);
807 Jim_FreeEntryVal(ht, he);
808 Jim_Free(he);
809 ht->used--;
810 he = nextHe;
813 /* Free the table and the allocated cache structure */
814 Jim_Free(ht->table);
815 /* Re-initialize the table */
816 JimResetHashTable(ht);
817 return JIM_OK; /* never fails */
820 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
822 Jim_HashEntry *he;
823 unsigned int h;
825 if (ht->used == 0)
826 return NULL;
827 h = Jim_HashKey(ht, key) & ht->sizemask;
828 he = ht->table[h];
829 while (he) {
830 if (Jim_CompareHashKeys(ht, key, he->key))
831 return he;
832 he = he->next;
834 return NULL;
837 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
839 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
841 iter->ht = ht;
842 iter->index = -1;
843 iter->entry = NULL;
844 iter->nextEntry = NULL;
845 return iter;
848 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
850 while (1) {
851 if (iter->entry == NULL) {
852 iter->index++;
853 if (iter->index >= (signed)iter->ht->size)
854 break;
855 iter->entry = iter->ht->table[iter->index];
857 else {
858 iter->entry = iter->nextEntry;
860 if (iter->entry) {
861 /* We need to save the 'next' here, the iterator user
862 * may delete the entry we are returning. */
863 iter->nextEntry = iter->entry->next;
864 return iter->entry;
867 return NULL;
870 /* ------------------------- private functions ------------------------------ */
872 /* Expand the hash table if needed */
873 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
875 /* If the hash table is empty expand it to the intial size,
876 * if the table is "full" dobule its size. */
877 if (ht->size == 0)
878 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
879 if (ht->size == ht->used)
880 return Jim_ExpandHashTable(ht, ht->size * 2);
881 return JIM_OK;
884 /* Our hash table capability is a power of two */
885 static unsigned int JimHashTableNextPower(unsigned int size)
887 unsigned int i = JIM_HT_INITIAL_SIZE;
889 if (size >= 2147483648U)
890 return 2147483648U;
891 while (1) {
892 if (i >= size)
893 return i;
894 i *= 2;
898 /* Returns the index of a free slot that can be populated with
899 * an hash entry for the given 'key'.
900 * If the key already exists, -1 is returned. */
901 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
903 unsigned int h;
904 Jim_HashEntry *he;
906 /* Expand the hashtable if needed */
907 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
908 return -1;
909 /* Compute the key hash value */
910 h = Jim_HashKey(ht, key) & ht->sizemask;
911 /* Search if this slot does not already contain the given key */
912 he = ht->table[h];
913 while (he) {
914 if (Jim_CompareHashKeys(ht, key, he->key))
915 return -1;
916 he = he->next;
918 return h;
921 /* ----------------------- StringCopy Hash Table Type ------------------------*/
923 static unsigned int JimStringCopyHTHashFunction(const void *key)
925 return Jim_GenHashFunction(key, strlen(key));
928 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
930 int len = strlen(key);
931 char *copy = Jim_Alloc(len + 1);
933 JIM_NOTUSED(privdata);
935 memcpy(copy, key, len);
936 copy[len] = '\0';
937 return copy;
940 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
942 int len = strlen(val);
943 char *copy = Jim_Alloc(len + 1);
945 JIM_NOTUSED(privdata);
947 memcpy(copy, val, len);
948 copy[len] = '\0';
949 return copy;
952 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
954 JIM_NOTUSED(privdata);
956 return strcmp(key1, key2) == 0;
959 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
961 JIM_NOTUSED(privdata);
963 Jim_Free((void *)key); /* ATTENTION: const cast */
966 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
968 JIM_NOTUSED(privdata);
970 Jim_Free((void *)val); /* ATTENTION: const cast */
973 #if 0
974 static Jim_HashTableType JimStringCopyHashTableType = {
975 JimStringCopyHTHashFunction, /* hash function */
976 JimStringCopyHTKeyDup, /* key dup */
977 NULL, /* val dup */
978 JimStringCopyHTKeyCompare, /* key compare */
979 JimStringCopyHTKeyDestructor, /* key destructor */
980 NULL /* val destructor */
982 #endif
984 /* This is like StringCopy but does not auto-duplicate the key.
985 * It's used for intepreter's shared strings. */
986 static const Jim_HashTableType JimSharedStringsHashTableType = {
987 JimStringCopyHTHashFunction, /* hash function */
988 NULL, /* key dup */
989 NULL, /* val dup */
990 JimStringCopyHTKeyCompare, /* key compare */
991 JimStringCopyHTKeyDestructor, /* key destructor */
992 NULL /* val destructor */
995 /* This is like StringCopy but also automatically handle dynamic
996 * allocated C strings as values. */
997 static const Jim_HashTableType JimStringKeyValCopyHashTableType = {
998 JimStringCopyHTHashFunction, /* hash function */
999 JimStringCopyHTKeyDup, /* key dup */
1000 JimStringKeyValCopyHTValDup, /* val dup */
1001 JimStringCopyHTKeyCompare, /* key compare */
1002 JimStringCopyHTKeyDestructor, /* key destructor */
1003 JimStringKeyValCopyHTValDestructor, /* val destructor */
1006 typedef struct AssocDataValue
1008 Jim_InterpDeleteProc *delProc;
1009 void *data;
1010 } AssocDataValue;
1012 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1014 AssocDataValue *assocPtr = (AssocDataValue *) data;
1016 if (assocPtr->delProc != NULL)
1017 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1018 Jim_Free(data);
1021 static const Jim_HashTableType JimAssocDataHashTableType = {
1022 JimStringCopyHTHashFunction, /* hash function */
1023 JimStringCopyHTKeyDup, /* key dup */
1024 NULL, /* val dup */
1025 JimStringCopyHTKeyCompare, /* key compare */
1026 JimStringCopyHTKeyDestructor, /* key destructor */
1027 JimAssocDataHashTableValueDestructor /* val destructor */
1030 /* -----------------------------------------------------------------------------
1031 * Stack - This is a simple generic stack implementation. It is used for
1032 * example in the 'expr' expression compiler.
1033 * ---------------------------------------------------------------------------*/
1034 void Jim_InitStack(Jim_Stack *stack)
1036 stack->len = 0;
1037 stack->maxlen = 0;
1038 stack->vector = NULL;
1041 void Jim_FreeStack(Jim_Stack *stack)
1043 Jim_Free(stack->vector);
1046 int Jim_StackLen(Jim_Stack *stack)
1048 return stack->len;
1051 void Jim_StackPush(Jim_Stack *stack, void *element)
1053 int neededLen = stack->len + 1;
1055 if (neededLen > stack->maxlen) {
1056 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1057 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1059 stack->vector[stack->len] = element;
1060 stack->len++;
1063 void *Jim_StackPop(Jim_Stack *stack)
1065 if (stack->len == 0)
1066 return NULL;
1067 stack->len--;
1068 return stack->vector[stack->len];
1071 void *Jim_StackPeek(Jim_Stack *stack)
1073 if (stack->len == 0)
1074 return NULL;
1075 return stack->vector[stack->len - 1];
1078 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1080 int i;
1082 for (i = 0; i < stack->len; i++)
1083 freeFunc(stack->vector[i]);
1086 /* -----------------------------------------------------------------------------
1087 * Parser
1088 * ---------------------------------------------------------------------------*/
1090 /* Token types */
1091 #define JIM_TT_NONE 0 /* No token returned */
1092 #define JIM_TT_STR 1 /* simple string */
1093 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1094 #define JIM_TT_VAR 3 /* var substitution */
1095 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1096 #define JIM_TT_CMD 5 /* command substitution */
1097 /* Note: Keep these three together for TOKEN_IS_SEP() */
1098 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
1099 #define JIM_TT_EOL 7 /* line separator */
1100 #define JIM_TT_EOF 8 /* end of script */
1102 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1103 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1105 /* Additional token types needed for expressions */
1106 #define JIM_TT_SUBEXPR_START 11
1107 #define JIM_TT_SUBEXPR_END 12
1108 #define JIM_TT_EXPR_INT 13
1109 #define JIM_TT_EXPR_DOUBLE 14
1111 #define JIM_TT_EXPRSUGAR 15 /* $(expression) */
1113 /* Operator token types start here */
1114 #define JIM_TT_EXPR_OP 20
1116 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1118 /* Parser states */
1119 #define JIM_PS_DEF 0 /* Default state */
1120 #define JIM_PS_QUOTE 1 /* Inside "" */
1121 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1123 /* Parser context structure. The same context is used both to parse
1124 * Tcl scripts and lists. */
1125 struct JimParserCtx
1127 const char *p; /* Pointer to the point of the program we are parsing */
1128 int len; /* Remaining length */
1129 int linenr; /* Current line number */
1130 const char *tstart;
1131 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1132 int tline; /* Line number of the returned token */
1133 int tt; /* Token type */
1134 int eof; /* Non zero if EOF condition is true. */
1135 int state; /* Parser state */
1136 int comment; /* Non zero if the next chars may be a comment. */
1137 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1138 int missingline; /* Line number starting the missing token */
1142 * Results of missing quotes, braces, etc. from parsing.
1144 struct JimParseResult {
1145 char missing; /* From JimParserCtx.missing */
1146 int line; /* From JimParserCtx.missingline */
1149 static int JimParseScript(struct JimParserCtx *pc);
1150 static int JimParseSep(struct JimParserCtx *pc);
1151 static int JimParseEol(struct JimParserCtx *pc);
1152 static int JimParseCmd(struct JimParserCtx *pc);
1153 static int JimParseQuote(struct JimParserCtx *pc);
1154 static int JimParseVar(struct JimParserCtx *pc);
1155 static int JimParseBrace(struct JimParserCtx *pc);
1156 static int JimParseStr(struct JimParserCtx *pc);
1157 static int JimParseComment(struct JimParserCtx *pc);
1158 static void JimParseSubCmd(struct JimParserCtx *pc);
1159 static int JimParseSubQuote(struct JimParserCtx *pc);
1160 static void JimParseSubCmd(struct JimParserCtx *pc);
1161 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1163 /* Initialize a parser context.
1164 * 'prg' is a pointer to the program text, linenr is the line
1165 * number of the first line contained in the program. */
1166 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1168 pc->p = prg;
1169 pc->len = len;
1170 pc->tstart = NULL;
1171 pc->tend = NULL;
1172 pc->tline = 0;
1173 pc->tt = JIM_TT_NONE;
1174 pc->eof = 0;
1175 pc->state = JIM_PS_DEF;
1176 pc->linenr = linenr;
1177 pc->comment = 1;
1178 pc->missing = ' ';
1179 pc->missingline = linenr;
1182 static int JimParseScript(struct JimParserCtx *pc)
1184 while (1) { /* the while is used to reiterate with continue if needed */
1185 if (!pc->len) {
1186 pc->tstart = pc->p;
1187 pc->tend = pc->p - 1;
1188 pc->tline = pc->linenr;
1189 pc->tt = JIM_TT_EOL;
1190 pc->eof = 1;
1191 return JIM_OK;
1193 switch (*(pc->p)) {
1194 case '\\':
1195 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1196 return JimParseSep(pc);
1198 else {
1199 pc->comment = 0;
1200 return JimParseStr(pc);
1202 break;
1203 case ' ':
1204 case '\t':
1205 case '\r':
1206 if (pc->state == JIM_PS_DEF)
1207 return JimParseSep(pc);
1208 else {
1209 pc->comment = 0;
1210 return JimParseStr(pc);
1212 break;
1213 case '\n':
1214 case ';':
1215 pc->comment = 1;
1216 if (pc->state == JIM_PS_DEF)
1217 return JimParseEol(pc);
1218 else
1219 return JimParseStr(pc);
1220 break;
1221 case '[':
1222 pc->comment = 0;
1223 return JimParseCmd(pc);
1224 break;
1225 case '$':
1226 pc->comment = 0;
1227 if (JimParseVar(pc) == JIM_ERR) {
1228 pc->tstart = pc->tend = pc->p++;
1229 pc->len--;
1230 pc->tline = pc->linenr;
1231 pc->tt = JIM_TT_STR;
1232 return JIM_OK;
1234 else
1235 return JIM_OK;
1236 break;
1237 case '#':
1238 if (pc->comment) {
1239 JimParseComment(pc);
1240 continue;
1242 else {
1243 return JimParseStr(pc);
1245 default:
1246 pc->comment = 0;
1247 return JimParseStr(pc);
1248 break;
1250 return JIM_OK;
1254 static int JimParseSep(struct JimParserCtx *pc)
1256 pc->tstart = pc->p;
1257 pc->tline = pc->linenr;
1258 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1259 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1260 if (*pc->p == '\\') {
1261 pc->p++;
1262 pc->len--;
1263 pc->linenr++;
1265 pc->p++;
1266 pc->len--;
1268 pc->tend = pc->p - 1;
1269 pc->tt = JIM_TT_SEP;
1270 return JIM_OK;
1273 static int JimParseEol(struct JimParserCtx *pc)
1275 pc->tstart = pc->p;
1276 pc->tline = pc->linenr;
1277 while (*pc->p == ' ' || *pc->p == '\n' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1278 if (*pc->p == '\n')
1279 pc->linenr++;
1280 pc->p++;
1281 pc->len--;
1283 pc->tend = pc->p - 1;
1284 pc->tt = JIM_TT_EOL;
1285 return JIM_OK;
1289 ** Here are the rules for parsing:
1290 ** {braced expression}
1291 ** - Count open and closing braces
1292 ** - Backslash escapes meaning of braces
1294 ** "quoted expression"
1295 ** - First double quote at start of word terminates the expression
1296 ** - Backslash escapes quote and bracket
1297 ** - [commands brackets] are counted/nested
1298 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1300 ** [command expression]
1301 ** - Count open and closing brackets
1302 ** - Backslash escapes quote, bracket and brace
1303 ** - [commands brackets] are counted/nested
1304 ** - "quoted expressions" are parsed according to quoting rules
1305 ** - {braced expressions} are parsed according to brace rules
1307 ** For everything, backslash escapes the next char, newline increments current line
1311 * Parses a braced expression starting at pc->p.
1313 * Positions the parser at the end of the braced expression,
1314 * sets pc->tend and possibly pc->missing.
1316 static void JimParseSubBrace(struct JimParserCtx *pc)
1318 int level = 1;
1320 /* Skip the brace */
1321 pc->p++;
1322 pc->len--;
1323 while (pc->len) {
1324 switch (*pc->p) {
1325 case '\\':
1326 if (pc->len > 1) {
1327 if (*++pc->p == '\n') {
1328 pc->linenr++;
1330 pc->len--;
1332 break;
1334 case '{':
1335 level++;
1336 break;
1338 case '}':
1339 if (--level == 0) {
1340 pc->tend = pc->p - 1;
1341 pc->p++;
1342 pc->len--;
1343 return;
1345 break;
1347 case '\n':
1348 pc->linenr++;
1349 break;
1351 pc->p++;
1352 pc->len--;
1354 pc->missing = '{';
1355 pc->missingline = pc->tline;
1356 pc->tend = pc->p - 1;
1360 * Parses a quoted expression starting at pc->p.
1362 * Positions the parser at the end of the quoted expression,
1363 * sets pc->tend and possibly pc->missing.
1365 * Returns the type of the token of the string,
1366 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1367 * or JIM_TT_STR.
1369 static int JimParseSubQuote(struct JimParserCtx *pc)
1371 int tt = JIM_TT_STR;
1372 int line = pc->tline;
1374 /* Skip the quote */
1375 pc->p++;
1376 pc->len--;
1377 while (pc->len) {
1378 switch (*pc->p) {
1379 case '\\':
1380 if (pc->len > 1) {
1381 if (*++pc->p == '\n') {
1382 pc->linenr++;
1384 pc->len--;
1385 tt = JIM_TT_ESC;
1387 break;
1389 case '"':
1390 pc->tend = pc->p - 1;
1391 pc->p++;
1392 pc->len--;
1393 return tt;
1395 case '[':
1396 JimParseSubCmd(pc);
1397 tt = JIM_TT_ESC;
1398 continue;
1400 case '\n':
1401 pc->linenr++;
1402 break;
1404 case '$':
1405 tt = JIM_TT_ESC;
1406 break;
1408 pc->p++;
1409 pc->len--;
1411 pc->missing = '"';
1412 pc->missingline = line;
1413 pc->tend = pc->p - 1;
1414 return tt;
1418 * Parses a [command] expression starting at pc->p.
1420 * Positions the parser at the end of the command expression,
1421 * sets pc->tend and possibly pc->missing.
1423 static void JimParseSubCmd(struct JimParserCtx *pc)
1425 int level = 1;
1426 int startofword = 1;
1427 int line = pc->tline;
1429 /* Skip the bracket */
1430 pc->p++;
1431 pc->len--;
1432 while (pc->len) {
1433 switch (*pc->p) {
1434 case '\\':
1435 if (pc->len > 1) {
1436 if (*++pc->p == '\n') {
1437 pc->linenr++;
1439 pc->len--;
1441 break;
1443 case '[':
1444 level++;
1445 break;
1447 case ']':
1448 if (--level == 0) {
1449 pc->tend = pc->p - 1;
1450 pc->p++;
1451 pc->len--;
1452 return;
1454 break;
1456 case '"':
1457 if (startofword) {
1458 JimParseSubQuote(pc);
1459 continue;
1461 break;
1463 case '{':
1464 JimParseSubBrace(pc);
1465 startofword = 0;
1466 continue;
1468 case '\n':
1469 pc->linenr++;
1470 break;
1472 startofword = isspace(UCHAR(*pc->p));
1473 pc->p++;
1474 pc->len--;
1476 pc->missing = '[';
1477 pc->missingline = line;
1478 pc->tend = pc->p - 1;
1481 static int JimParseBrace(struct JimParserCtx *pc)
1483 pc->tstart = pc->p + 1;
1484 pc->tline = pc->linenr;
1485 pc->tt = JIM_TT_STR;
1486 JimParseSubBrace(pc);
1487 return JIM_OK;
1490 static int JimParseCmd(struct JimParserCtx *pc)
1492 pc->tstart = pc->p + 1;
1493 pc->tline = pc->linenr;
1494 pc->tt = JIM_TT_CMD;
1495 JimParseSubCmd(pc);
1496 return JIM_OK;
1499 static int JimParseQuote(struct JimParserCtx *pc)
1501 pc->tstart = pc->p + 1;
1502 pc->tline = pc->linenr;
1503 pc->tt = JimParseSubQuote(pc);
1504 return JIM_OK;
1507 static int JimParseVar(struct JimParserCtx *pc)
1509 /* skip the $ */
1510 pc->p++;
1511 pc->len--;
1513 #ifdef EXPRSUGAR_BRACKET
1514 if (*pc->p == '[') {
1515 /* Parse $[...] expr shorthand syntax */
1516 JimParseCmd(pc);
1517 pc->tt = JIM_TT_EXPRSUGAR;
1518 return JIM_OK;
1520 #endif
1522 pc->tstart = pc->p;
1523 pc->tt = JIM_TT_VAR;
1524 pc->tline = pc->linenr;
1526 if (*pc->p == '{') {
1527 pc->tstart = ++pc->p;
1528 pc->len--;
1530 while (pc->len && *pc->p != '}') {
1531 if (*pc->p == '\n') {
1532 pc->linenr++;
1534 pc->p++;
1535 pc->len--;
1537 pc->tend = pc->p - 1;
1538 if (pc->len) {
1539 pc->p++;
1540 pc->len--;
1543 else {
1544 while (1) {
1545 /* Skip double colon, but not single colon! */
1546 if (pc->p[0] == ':' && pc->p[1] == ':') {
1547 pc->p += 2;
1548 pc->len -= 2;
1549 continue;
1551 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_') {
1552 pc->p++;
1553 pc->len--;
1554 continue;
1556 break;
1558 /* Parse [dict get] syntax sugar. */
1559 if (*pc->p == '(') {
1560 int count = 1;
1561 const char *paren = NULL;
1563 pc->tt = JIM_TT_DICTSUGAR;
1565 while (count && pc->len) {
1566 pc->p++;
1567 pc->len--;
1568 if (*pc->p == '\\' && pc->len >= 1) {
1569 pc->p++;
1570 pc->len--;
1572 else if (*pc->p == '(') {
1573 count++;
1575 else if (*pc->p == ')') {
1576 paren = pc->p;
1577 count--;
1580 if (count == 0) {
1581 pc->p++;
1582 pc->len--;
1584 else if (paren) {
1585 /* Did not find a matching paren. Back up */
1586 paren++;
1587 pc->len += (pc->p - paren);
1588 pc->p = paren;
1590 #ifndef EXPRSUGAR_BRACKET
1591 if (*pc->tstart == '(') {
1592 pc->tt = JIM_TT_EXPRSUGAR;
1594 #endif
1596 pc->tend = pc->p - 1;
1598 /* Check if we parsed just the '$' character.
1599 * That's not a variable so an error is returned
1600 * to tell the state machine to consider this '$' just
1601 * a string. */
1602 if (pc->tstart == pc->p) {
1603 pc->p--;
1604 pc->len++;
1605 return JIM_ERR;
1607 return JIM_OK;
1610 static int JimParseStr(struct JimParserCtx *pc)
1612 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1613 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1614 if (newword && *pc->p == '{') {
1615 return JimParseBrace(pc);
1617 else if (newword && *pc->p == '"') {
1618 pc->state = JIM_PS_QUOTE;
1619 pc->p++;
1620 pc->len--;
1621 /* In case the end quote is missing */
1622 pc->missingline = pc->tline;
1624 pc->tstart = pc->p;
1625 pc->tline = pc->linenr;
1626 while (1) {
1627 if (pc->len == 0) {
1628 if (pc->state == JIM_PS_QUOTE) {
1629 pc->missing = '"';
1631 pc->tend = pc->p - 1;
1632 pc->tt = JIM_TT_ESC;
1633 return JIM_OK;
1635 switch (*pc->p) {
1636 case '\\':
1637 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1638 pc->tend = pc->p - 1;
1639 pc->tt = JIM_TT_ESC;
1640 return JIM_OK;
1642 if (pc->len >= 2) {
1643 if (*(pc->p + 1) == '\n') {
1644 pc->linenr++;
1646 pc->p++;
1647 pc->len--;
1649 break;
1650 case '(':
1651 /* If the following token is not '$' just keep going */
1652 if (pc->len > 1 && pc->p[1] != '$') {
1653 break;
1655 case ')':
1656 /* Only need a separate ')' token if the previous was a var */
1657 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1658 if (pc->p == pc->tstart) {
1659 /* At the start of the token, so just return this char */
1660 pc->p++;
1661 pc->len--;
1663 pc->tend = pc->p - 1;
1664 pc->tt = JIM_TT_ESC;
1665 return JIM_OK;
1667 break;
1669 case '$':
1670 case '[':
1671 pc->tend = pc->p - 1;
1672 pc->tt = JIM_TT_ESC;
1673 return JIM_OK;
1674 case ' ':
1675 case '\t':
1676 case '\n':
1677 case '\r':
1678 case ';':
1679 if (pc->state == JIM_PS_DEF) {
1680 pc->tend = pc->p - 1;
1681 pc->tt = JIM_TT_ESC;
1682 return JIM_OK;
1684 else if (*pc->p == '\n') {
1685 pc->linenr++;
1687 break;
1688 case '"':
1689 if (pc->state == JIM_PS_QUOTE) {
1690 pc->tend = pc->p - 1;
1691 pc->tt = JIM_TT_ESC;
1692 pc->p++;
1693 pc->len--;
1694 pc->state = JIM_PS_DEF;
1695 return JIM_OK;
1697 break;
1699 pc->p++;
1700 pc->len--;
1702 return JIM_OK; /* unreached */
1705 static int JimParseComment(struct JimParserCtx *pc)
1707 while (*pc->p) {
1708 if (*pc->p == '\n') {
1709 pc->linenr++;
1710 if (*(pc->p - 1) != '\\') {
1711 pc->p++;
1712 pc->len--;
1713 return JIM_OK;
1716 pc->p++;
1717 pc->len--;
1719 return JIM_OK;
1722 /* xdigitval and odigitval are helper functions for JimEscape() */
1723 static int xdigitval(int c)
1725 if (c >= '0' && c <= '9')
1726 return c - '0';
1727 if (c >= 'a' && c <= 'f')
1728 return c - 'a' + 10;
1729 if (c >= 'A' && c <= 'F')
1730 return c - 'A' + 10;
1731 return -1;
1734 static int odigitval(int c)
1736 if (c >= '0' && c <= '7')
1737 return c - '0';
1738 return -1;
1741 /* Perform Tcl escape substitution of 's', storing the result
1742 * string into 'dest'. The escaped string is guaranteed to
1743 * be the same length or shorted than the source string.
1744 * Slen is the length of the string at 's', if it's -1 the string
1745 * length will be calculated by the function.
1747 * The function returns the length of the resulting string. */
1748 static int JimEscape(char *dest, const char *s, int slen)
1750 char *p = dest;
1751 int i, len;
1753 if (slen == -1)
1754 slen = strlen(s);
1756 for (i = 0; i < slen; i++) {
1757 switch (s[i]) {
1758 case '\\':
1759 switch (s[i + 1]) {
1760 case 'a':
1761 *p++ = 0x7;
1762 i++;
1763 break;
1764 case 'b':
1765 *p++ = 0x8;
1766 i++;
1767 break;
1768 case 'f':
1769 *p++ = 0xc;
1770 i++;
1771 break;
1772 case 'n':
1773 *p++ = 0xa;
1774 i++;
1775 break;
1776 case 'r':
1777 *p++ = 0xd;
1778 i++;
1779 break;
1780 case 't':
1781 *p++ = 0x9;
1782 i++;
1783 break;
1784 case 'u':
1785 case 'x':
1786 /* A unicode or hex sequence.
1787 * \u Expect 1-4 hex chars and convert to utf-8.
1788 * \x Expect 1-2 hex chars and convert to hex.
1789 * An invalid sequence means simply the escaped char.
1792 int val = 0;
1793 int k;
1795 i++;
1797 for (k = 0; k < (s[i] == 'u' ? 4 : 2); k++) {
1798 int c = xdigitval(s[i + k + 1]);
1799 if (c == -1) {
1800 break;
1802 val = (val << 4) | c;
1804 if (k) {
1805 /* Got a valid sequence, so convert */
1806 if (s[i] == 'u') {
1807 p += utf8_fromunicode(p, val);
1809 else {
1810 *p++ = val;
1812 i += k;
1813 break;
1815 /* Not a valid codepoint, just an escaped char */
1816 *p++ = s[i];
1818 break;
1819 case 'v':
1820 *p++ = 0xb;
1821 i++;
1822 break;
1823 case '\0':
1824 *p++ = '\\';
1825 i++;
1826 break;
1827 case '\n':
1828 /* Replace all spaces and tabs after backslash newline with a single space*/
1829 *p++ = ' ';
1830 do {
1831 i++;
1832 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1833 break;
1834 case '0':
1835 case '1':
1836 case '2':
1837 case '3':
1838 case '4':
1839 case '5':
1840 case '6':
1841 case '7':
1842 /* octal escape */
1844 int val = 0;
1845 int c = odigitval(s[i + 1]);
1847 val = c;
1848 c = odigitval(s[i + 2]);
1849 if (c == -1) {
1850 *p++ = val;
1851 i++;
1852 break;
1854 val = (val * 8) + c;
1855 c = odigitval(s[i + 3]);
1856 if (c == -1) {
1857 *p++ = val;
1858 i += 2;
1859 break;
1861 val = (val * 8) + c;
1862 *p++ = val;
1863 i += 3;
1865 break;
1866 default:
1867 *p++ = s[i + 1];
1868 i++;
1869 break;
1871 break;
1872 default:
1873 *p++ = s[i];
1874 break;
1877 len = p - dest;
1878 *p = '\0';
1879 return len;
1882 /* Returns a dynamically allocated copy of the current token in the
1883 * parser context. The function performs conversion of escapes if
1884 * the token is of type JIM_TT_ESC.
1886 * Note that after the conversion, tokens that are grouped with
1887 * braces in the source code, are always recognizable from the
1888 * identical string obtained in a different way from the type.
1890 * For example the string:
1892 * {*}$a
1894 * will return as first token "*", of type JIM_TT_STR
1896 * While the string:
1898 * *$a
1900 * will return as first token "*", of type JIM_TT_ESC
1902 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1904 const char *start, *end;
1905 char *token;
1906 int len;
1908 start = pc->tstart;
1909 end = pc->tend;
1910 if (start > end) {
1911 len = 0;
1912 token = Jim_Alloc(1);
1913 token[0] = '\0';
1915 else {
1916 len = (end - start) + 1;
1917 token = Jim_Alloc(len + 1);
1918 if (pc->tt != JIM_TT_ESC) {
1919 /* No escape conversion needed? Just copy it. */
1920 memcpy(token, start, len);
1921 token[len] = '\0';
1923 else {
1924 /* Else convert the escape chars. */
1925 len = JimEscape(token, start, len);
1929 return Jim_NewStringObjNoAlloc(interp, token, len);
1932 /* Parses the given string to determine if it represents a complete script.
1934 * This is useful for interactive shells implementation, for [info complete].
1936 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1937 * '{' on scripts incomplete missing one or more '}' to be balanced.
1938 * '[' on scripts incomplete missing one or more ']' to be balanced.
1939 * '"' on scripts incomplete missing a '"' char.
1941 * If the script is complete, 1 is returned, otherwise 0.
1943 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1945 struct JimParserCtx parser;
1947 JimParserInit(&parser, s, len, 1);
1948 while (!parser.eof) {
1949 JimParseScript(&parser);
1951 if (stateCharPtr) {
1952 *stateCharPtr = parser.missing;
1954 return parser.missing == ' ';
1957 /* -----------------------------------------------------------------------------
1958 * Tcl Lists parsing
1959 * ---------------------------------------------------------------------------*/
1960 static int JimParseListSep(struct JimParserCtx *pc);
1961 static int JimParseListStr(struct JimParserCtx *pc);
1962 static int JimParseListQuote(struct JimParserCtx *pc);
1964 static int JimParseList(struct JimParserCtx *pc)
1966 switch (*pc->p) {
1967 case ' ':
1968 case '\n':
1969 case '\t':
1970 case '\r':
1971 return JimParseListSep(pc);
1973 case '"':
1974 return JimParseListQuote(pc);
1976 case '{':
1977 return JimParseBrace(pc);
1979 default:
1980 if (pc->len) {
1981 return JimParseListStr(pc);
1983 break;
1986 pc->tstart = pc->tend = pc->p;
1987 pc->tline = pc->linenr;
1988 pc->tt = JIM_TT_EOL;
1989 pc->eof = 1;
1990 return JIM_OK;
1993 static int JimParseListSep(struct JimParserCtx *pc)
1995 pc->tstart = pc->p;
1996 pc->tline = pc->linenr;
1997 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n') {
1998 if (*pc->p == '\n') {
1999 pc->linenr++;
2001 pc->p++;
2002 pc->len--;
2004 pc->tend = pc->p - 1;
2005 pc->tt = JIM_TT_SEP;
2006 return JIM_OK;
2009 static int JimParseListQuote(struct JimParserCtx *pc)
2011 pc->p++;
2012 pc->len--;
2014 pc->tstart = pc->p;
2015 pc->tline = pc->linenr;
2016 pc->tt = JIM_TT_STR;
2018 while (pc->len) {
2019 switch (*pc->p) {
2020 case '\\':
2021 pc->tt = JIM_TT_ESC;
2022 if (--pc->len == 0) {
2023 /* Trailing backslash */
2024 pc->tend = pc->p;
2025 return JIM_OK;
2027 pc->p++;
2028 break;
2029 case '\n':
2030 pc->linenr++;
2031 break;
2032 case '"':
2033 pc->tend = pc->p - 1;
2034 pc->p++;
2035 pc->len--;
2036 return JIM_OK;
2038 pc->p++;
2039 pc->len--;
2042 pc->tend = pc->p - 1;
2043 return JIM_OK;
2046 static int JimParseListStr(struct JimParserCtx *pc)
2048 pc->tstart = pc->p;
2049 pc->tline = pc->linenr;
2050 pc->tt = JIM_TT_STR;
2052 while (pc->len) {
2053 switch (*pc->p) {
2054 case '\\':
2055 if (--pc->len == 0) {
2056 /* Trailing backslash */
2057 pc->tend = pc->p;
2058 return JIM_OK;
2060 pc->tt = JIM_TT_ESC;
2061 pc->p++;
2062 break;
2063 case ' ':
2064 case '\t':
2065 case '\n':
2066 case '\r':
2067 pc->tend = pc->p - 1;
2068 return JIM_OK;
2070 pc->p++;
2071 pc->len--;
2073 pc->tend = pc->p - 1;
2074 return JIM_OK;
2077 /* -----------------------------------------------------------------------------
2078 * Jim_Obj related functions
2079 * ---------------------------------------------------------------------------*/
2081 /* Return a new initialized object. */
2082 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2084 Jim_Obj *objPtr;
2086 /* -- Check if there are objects in the free list -- */
2087 if (interp->freeList != NULL) {
2088 /* -- Unlink the object from the free list -- */
2089 objPtr = interp->freeList;
2090 interp->freeList = objPtr->nextObjPtr;
2092 else {
2093 /* -- No ready to use objects: allocate a new one -- */
2094 objPtr = Jim_Alloc(sizeof(*objPtr));
2097 /* Object is returned with refCount of 0. Every
2098 * kind of GC implemented should take care to don't try
2099 * to scan objects with refCount == 0. */
2100 objPtr->refCount = 0;
2101 /* All the other fields are left not initialized to save time.
2102 * The caller will probably want to set them to the right
2103 * value anyway. */
2105 /* -- Put the object into the live list -- */
2106 objPtr->prevObjPtr = NULL;
2107 objPtr->nextObjPtr = interp->liveList;
2108 if (interp->liveList)
2109 interp->liveList->prevObjPtr = objPtr;
2110 interp->liveList = objPtr;
2112 return objPtr;
2115 /* Free an object. Actually objects are never freed, but
2116 * just moved to the free objects list, where they will be
2117 * reused by Jim_NewObj(). */
2118 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2120 /* Check if the object was already freed, panic. */
2121 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2122 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2124 /* Free the internal representation */
2125 Jim_FreeIntRep(interp, objPtr);
2126 /* Free the string representation */
2127 if (objPtr->bytes != NULL) {
2128 if (objPtr->bytes != JimEmptyStringRep)
2129 Jim_Free(objPtr->bytes);
2131 /* Unlink the object from the live objects list */
2132 if (objPtr->prevObjPtr)
2133 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2134 if (objPtr->nextObjPtr)
2135 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2136 if (interp->liveList == objPtr)
2137 interp->liveList = objPtr->nextObjPtr;
2138 /* Link the object into the free objects list */
2139 objPtr->prevObjPtr = NULL;
2140 objPtr->nextObjPtr = interp->freeList;
2141 if (interp->freeList)
2142 interp->freeList->prevObjPtr = objPtr;
2143 interp->freeList = objPtr;
2144 objPtr->refCount = -1;
2147 /* Invalidate the string representation of an object. */
2148 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2150 if (objPtr->bytes != NULL) {
2151 if (objPtr->bytes != JimEmptyStringRep)
2152 Jim_Free(objPtr->bytes);
2154 objPtr->bytes = NULL;
2157 #define Jim_SetStringRep(o, b, l) \
2158 do { (o)->bytes = b; (o)->length = l; } while (0)
2160 /* Set the initial string representation for an object.
2161 * Does not try to free an old one. */
2162 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
2164 if (length == 0) {
2165 objPtr->bytes = JimEmptyStringRep;
2166 objPtr->length = 0;
2168 else {
2169 objPtr->bytes = Jim_Alloc(length + 1);
2170 objPtr->length = length;
2171 memcpy(objPtr->bytes, bytes, length);
2172 objPtr->bytes[length] = '\0';
2176 /* Duplicate an object. The returned object has refcount = 0. */
2177 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2179 Jim_Obj *dupPtr;
2181 dupPtr = Jim_NewObj(interp);
2182 if (objPtr->bytes == NULL) {
2183 /* Object does not have a valid string representation. */
2184 dupPtr->bytes = NULL;
2186 else {
2187 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
2190 /* By default, the new object has the same type as the old object */
2191 dupPtr->typePtr = objPtr->typePtr;
2192 if (objPtr->typePtr != NULL) {
2193 if (objPtr->typePtr->dupIntRepProc == NULL) {
2194 dupPtr->internalRep = objPtr->internalRep;
2196 else {
2197 /* The dup proc may set a different type, e.g. NULL */
2198 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2201 return dupPtr;
2204 /* Return the string representation for objPtr. If the object
2205 * string representation is invalid, calls the method to create
2206 * a new one starting from the internal representation of the object. */
2207 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2209 if (objPtr->bytes == NULL) {
2210 /* Invalid string repr. Generate it. */
2211 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2212 objPtr->typePtr->updateStringProc(objPtr);
2214 if (lenPtr)
2215 *lenPtr = objPtr->length;
2216 return objPtr->bytes;
2219 /* Just returns the length of the object's string rep */
2220 int Jim_Length(Jim_Obj *objPtr)
2222 int len;
2224 Jim_GetString(objPtr, &len);
2225 return len;
2228 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2229 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2231 static const Jim_ObjType dictSubstObjType = {
2232 "dict-substitution",
2233 FreeDictSubstInternalRep,
2234 DupDictSubstInternalRep,
2235 NULL,
2236 JIM_TYPE_NONE,
2239 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2241 Jim_DecrRefCount(interp, (Jim_Obj *)objPtr->internalRep.twoPtrValue.ptr2);
2244 static const Jim_ObjType interpolatedObjType = {
2245 "interpolated",
2246 FreeInterpolatedInternalRep,
2247 NULL,
2248 NULL,
2249 JIM_TYPE_NONE,
2252 /* -----------------------------------------------------------------------------
2253 * String Object
2254 * ---------------------------------------------------------------------------*/
2255 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2256 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2258 static const Jim_ObjType stringObjType = {
2259 "string",
2260 NULL,
2261 DupStringInternalRep,
2262 NULL,
2263 JIM_TYPE_REFERENCES,
2266 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2268 JIM_NOTUSED(interp);
2270 /* This is a bit subtle: the only caller of this function
2271 * should be Jim_DuplicateObj(), that will copy the
2272 * string representaion. After the copy, the duplicated
2273 * object will not have more room in teh buffer than
2274 * srcPtr->length bytes. So we just set it to length. */
2275 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2277 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2280 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2282 /* Get a fresh string representation. */
2283 (void)Jim_String(objPtr);
2284 /* Free any other internal representation. */
2285 Jim_FreeIntRep(interp, objPtr);
2286 /* Set it as string, i.e. just set the maxLength field. */
2287 objPtr->typePtr = &stringObjType;
2288 objPtr->internalRep.strValue.maxLength = objPtr->length;
2289 /* Don't know the utf-8 length yet */
2290 objPtr->internalRep.strValue.charLength = -1;
2291 return JIM_OK;
2295 * Returns the length of the object string in chars, not bytes.
2297 * These may be different for a utf-8 string.
2299 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2301 #ifdef JIM_UTF8
2302 if (objPtr->typePtr != &stringObjType)
2303 SetStringFromAny(interp, objPtr);
2305 if (objPtr->internalRep.strValue.charLength < 0) {
2306 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2308 return objPtr->internalRep.strValue.charLength;
2309 #else
2310 return Jim_Length(objPtr);
2311 #endif
2314 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2315 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2317 Jim_Obj *objPtr = Jim_NewObj(interp);
2319 /* Need to find out how many bytes the string requires */
2320 if (len == -1)
2321 len = strlen(s);
2322 /* Alloc/Set the string rep. */
2323 if (len == 0) {
2324 objPtr->bytes = JimEmptyStringRep;
2325 objPtr->length = 0;
2327 else {
2328 objPtr->bytes = Jim_Alloc(len + 1);
2329 objPtr->length = len;
2330 memcpy(objPtr->bytes, s, len);
2331 objPtr->bytes[len] = '\0';
2334 /* No typePtr field for the vanilla string object. */
2335 objPtr->typePtr = NULL;
2336 return objPtr;
2339 /* charlen is in characters -- see also Jim_NewStringObj() */
2340 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2342 #ifdef JIM_UTF8
2343 /* Need to find out how many bytes the string requires */
2344 int bytelen = utf8_index(s, charlen);
2346 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2348 /* Remember the utf8 length, so set the type */
2349 objPtr->typePtr = &stringObjType;
2350 objPtr->internalRep.strValue.maxLength = bytelen;
2351 objPtr->internalRep.strValue.charLength = charlen;
2353 return objPtr;
2354 #else
2355 return Jim_NewStringObj(interp, s, charlen);
2356 #endif
2359 /* This version does not try to duplicate the 's' pointer, but
2360 * use it directly. */
2361 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2363 Jim_Obj *objPtr = Jim_NewObj(interp);
2365 if (len == -1)
2366 len = strlen(s);
2367 Jim_SetStringRep(objPtr, s, len);
2368 objPtr->typePtr = NULL;
2369 return objPtr;
2372 /* Low-level string append. Use it only against objects
2373 * of type "string". */
2374 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2376 int needlen;
2378 if (len == -1)
2379 len = strlen(str);
2380 needlen = objPtr->length + len;
2381 if (objPtr->internalRep.strValue.maxLength < needlen ||
2382 objPtr->internalRep.strValue.maxLength == 0) {
2383 needlen *= 2;
2384 /* Inefficient to malloc() for less than 8 bytes */
2385 if (needlen < 7) {
2386 needlen = 7;
2388 if (objPtr->bytes == JimEmptyStringRep) {
2389 objPtr->bytes = Jim_Alloc(needlen + 1);
2391 else {
2392 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2394 objPtr->internalRep.strValue.maxLength = needlen;
2396 memcpy(objPtr->bytes + objPtr->length, str, len);
2397 objPtr->bytes[objPtr->length + len] = '\0';
2398 if (objPtr->internalRep.strValue.charLength >= 0) {
2399 /* Update the utf-8 char length */
2400 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2402 objPtr->length += len;
2405 /* Higher level API to append strings to objects. */
2406 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2408 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2409 if (objPtr->typePtr != &stringObjType)
2410 SetStringFromAny(interp, objPtr);
2411 StringAppendString(objPtr, str, len);
2414 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2416 int len;
2417 const char *str;
2419 str = Jim_GetString(appendObjPtr, &len);
2420 Jim_AppendString(interp, objPtr, str, len);
2423 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2425 va_list ap;
2427 if (objPtr->typePtr != &stringObjType)
2428 SetStringFromAny(interp, objPtr);
2429 va_start(ap, objPtr);
2430 while (1) {
2431 char *s = va_arg(ap, char *);
2433 if (s == NULL)
2434 break;
2435 Jim_AppendString(interp, objPtr, s, -1);
2437 va_end(ap);
2440 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2442 const char *aStr, *bStr;
2443 int aLen, bLen;
2445 if (aObjPtr == bObjPtr)
2446 return 1;
2447 aStr = Jim_GetString(aObjPtr, &aLen);
2448 bStr = Jim_GetString(bObjPtr, &bLen);
2449 if (aLen != bLen)
2450 return 0;
2451 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2454 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2456 return JimStringMatch(interp, patternObjPtr, Jim_String(objPtr), nocase);
2459 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2461 const char *s1, *s2;
2462 int l1, l2;
2464 s1 = Jim_GetString(firstObjPtr, &l1);
2465 s2 = Jim_GetString(secondObjPtr, &l2);
2467 if (nocase) {
2468 return JimStringCompareNoCase(s1, s2, -1);
2470 return JimStringCompare(s1, l1, s2, l2);
2473 /* Convert a range, as returned by Jim_GetRange(), into
2474 * an absolute index into an object of the specified length.
2475 * This function may return negative values, or values
2476 * bigger or equal to the length of the list if the index
2477 * is out of range. */
2478 static int JimRelToAbsIndex(int len, int idx)
2480 if (idx < 0)
2481 return len + idx;
2482 return idx;
2485 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2486 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2487 * for implementation of commands like [string range] and [lrange].
2489 * The resulting range is guaranteed to address valid elements of
2490 * the structure. */
2491 static void JimRelToAbsRange(int len, int first, int last,
2492 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2494 int rangeLen;
2496 if (first > last) {
2497 rangeLen = 0;
2499 else {
2500 rangeLen = last - first + 1;
2501 if (rangeLen) {
2502 if (first < 0) {
2503 rangeLen += first;
2504 first = 0;
2506 if (last >= len) {
2507 rangeLen -= (last - (len - 1));
2508 last = len - 1;
2512 if (rangeLen < 0)
2513 rangeLen = 0;
2515 *firstPtr = first;
2516 *lastPtr = last;
2517 *rangeLenPtr = rangeLen;
2520 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2521 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2523 int first, last;
2524 const char *str;
2525 int rangeLen;
2526 int bytelen;
2528 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2529 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2530 return NULL;
2531 str = Jim_GetString(strObjPtr, &bytelen);
2532 first = JimRelToAbsIndex(bytelen, first);
2533 last = JimRelToAbsIndex(bytelen, last);
2534 JimRelToAbsRange(bytelen, first, last, &first, &last, &rangeLen);
2535 if (first == 0 && rangeLen == bytelen) {
2536 return strObjPtr;
2538 return Jim_NewStringObj(interp, str + first, rangeLen);
2541 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2542 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2544 #ifdef JIM_UTF8
2545 int first, last;
2546 const char *str;
2547 int len, rangeLen;
2548 int bytelen;
2550 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2551 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2552 return NULL;
2553 str = Jim_GetString(strObjPtr, &bytelen);
2554 len = Jim_Utf8Length(interp, strObjPtr);
2555 first = JimRelToAbsIndex(len, first);
2556 last = JimRelToAbsIndex(len, last);
2557 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2558 if (first == 0 && rangeLen == len) {
2559 return strObjPtr;
2561 if (len == bytelen) {
2562 /* ASCII optimisation */
2563 return Jim_NewStringObj(interp, str + first, rangeLen);
2565 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2566 #else
2567 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2568 #endif
2571 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2573 char *buf, *p;
2574 int len;
2575 const char *str;
2577 if (strObjPtr->typePtr != &stringObjType) {
2578 SetStringFromAny(interp, strObjPtr);
2581 str = Jim_GetString(strObjPtr, &len);
2583 buf = p = Jim_Alloc(len + 1);
2584 while (*str) {
2585 int c;
2586 str += utf8_tounicode(str, &c);
2587 p += utf8_fromunicode(p, utf8_lower(c));
2589 *p = 0;
2590 return Jim_NewStringObjNoAlloc(interp, buf, len);
2593 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2595 char *buf, *p;
2596 int len;
2597 const char *str;
2599 if (strObjPtr->typePtr != &stringObjType) {
2600 SetStringFromAny(interp, strObjPtr);
2603 str = Jim_GetString(strObjPtr, &len);
2605 buf = p = Jim_Alloc(len + 1);
2606 while (*str) {
2607 int c;
2608 str += utf8_tounicode(str, &c);
2609 p += utf8_fromunicode(p, utf8_upper(c));
2611 *p = 0;
2612 return Jim_NewStringObjNoAlloc(interp, buf, len);
2615 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2616 * for unicode character 'c'.
2617 * Returns the position if found or NULL if not
2619 static const char *utf8_memchr(const char *str, int len, int c)
2621 #ifdef JIM_UTF8
2622 while (len) {
2623 int sc;
2624 int n = utf8_tounicode(str, &sc);
2625 if (sc == c) {
2626 return str;
2628 str += n;
2629 len -= n;
2631 return NULL;
2632 #else
2633 return memchr(str, c, len);
2634 #endif
2638 * Searches for the first non-trim char in string (str, len)
2640 * If none is found, returns just past the last char.
2642 * Lengths are in bytes.
2644 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2646 while (len) {
2647 int c;
2648 int n = utf8_tounicode(str, &c);
2650 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2651 /* Not a trim char, so stop */
2652 break;
2654 str += n;
2655 len -= n;
2657 return str;
2661 * Searches backwards for a non-trim char in string (str, len).
2663 * Returns a pointer to just after the non-trim char, or NULL if not found.
2665 * Lengths are in bytes.
2667 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2669 str += len;
2671 while (len) {
2672 int c;
2673 int n = utf8_prev_len(str, len);
2675 len -= n;
2676 str -= n;
2678 n = utf8_tounicode(str, &c);
2680 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2681 return str + n;
2685 return NULL;
2688 static const char default_trim_chars[] = " \t\n\r";
2689 /* sizeof() here includes the null byte */
2690 static int default_trim_chars_len = sizeof(default_trim_chars);
2692 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2694 int len;
2695 const char *str = Jim_GetString(strObjPtr, &len);
2696 const char *trimchars = default_trim_chars;
2697 int trimcharslen = default_trim_chars_len;
2698 const char *newstr;
2700 if (trimcharsObjPtr) {
2701 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2704 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2705 if (newstr == str) {
2706 return strObjPtr;
2709 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2712 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2714 int len;
2715 const char *trimchars = default_trim_chars;
2716 int trimcharslen = default_trim_chars_len;
2717 const char *nontrim;
2719 if (trimcharsObjPtr) {
2720 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2723 if (strObjPtr->typePtr != &stringObjType) {
2724 SetStringFromAny(interp, strObjPtr);
2726 Jim_GetString(strObjPtr, &len);
2727 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2729 if (nontrim == NULL) {
2730 /* All trim, so return a zero-length string */
2731 return Jim_NewEmptyStringObj(interp);
2733 if (nontrim == strObjPtr->bytes + len) {
2734 return strObjPtr;
2737 if (Jim_IsShared(strObjPtr)) {
2738 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2740 else {
2741 /* Can modify this string in place */
2742 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2743 strObjPtr->length = (nontrim - strObjPtr->bytes);
2746 return strObjPtr;
2749 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2751 /* First trim left. */
2752 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2754 /* Now trim right */
2755 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2757 if (objPtr != strObjPtr) {
2758 /* Note that we don't want this object to be leaked */
2759 Jim_IncrRefCount(objPtr);
2760 Jim_DecrRefCount(interp, objPtr);
2763 return strObjPtr;
2767 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2769 static const char * const strclassnames[] = {
2770 "integer", "alpha", "alnum", "ascii", "digit",
2771 "double", "lower", "upper", "space", "xdigit",
2772 "control", "print", "graph", "punct",
2773 NULL
2775 enum {
2776 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2777 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2778 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2780 int strclass;
2781 int len;
2782 int i;
2783 const char *str;
2784 int (*isclassfunc)(int c) = NULL;
2786 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2787 return JIM_ERR;
2790 str = Jim_GetString(strObjPtr, &len);
2791 if (len == 0) {
2792 Jim_SetResultInt(interp, !strict);
2793 return JIM_OK;
2796 switch (strclass) {
2797 case STR_IS_INTEGER:
2799 jim_wide w;
2800 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2801 return JIM_OK;
2804 case STR_IS_DOUBLE:
2806 double d;
2807 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2808 return JIM_OK;
2811 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2812 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2813 case STR_IS_ASCII: isclassfunc = isascii; break;
2814 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2815 case STR_IS_LOWER: isclassfunc = islower; break;
2816 case STR_IS_UPPER: isclassfunc = isupper; break;
2817 case STR_IS_SPACE: isclassfunc = isspace; break;
2818 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2819 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2820 case STR_IS_PRINT: isclassfunc = isprint; break;
2821 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2822 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2823 default:
2824 return JIM_ERR;
2827 for (i = 0; i < len; i++) {
2828 if (!isclassfunc(str[i])) {
2829 Jim_SetResultInt(interp, 0);
2830 return JIM_OK;
2833 Jim_SetResultInt(interp, 1);
2834 return JIM_OK;
2837 /* -----------------------------------------------------------------------------
2838 * Compared String Object
2839 * ---------------------------------------------------------------------------*/
2841 /* This is strange object that allows to compare a C literal string
2842 * with a Jim object in very short time if the same comparison is done
2843 * multiple times. For example every time the [if] command is executed,
2844 * Jim has to check if a given argument is "else". This comparions if
2845 * the code has no errors are true most of the times, so we can cache
2846 * inside the object the pointer of the string of the last matching
2847 * comparison. Because most C compilers perform literal sharing,
2848 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2849 * this works pretty well even if comparisons are at different places
2850 * inside the C code. */
2852 static const Jim_ObjType comparedStringObjType = {
2853 "compared-string",
2854 NULL,
2855 NULL,
2856 NULL,
2857 JIM_TYPE_REFERENCES,
2860 /* The only way this object is exposed to the API is via the following
2861 * function. Returns true if the string and the object string repr.
2862 * are the same, otherwise zero is returned.
2864 * Note: this isn't binary safe, but it hardly needs to be.*/
2865 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
2867 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
2868 return 1;
2869 else {
2870 const char *objStr = Jim_String(objPtr);
2872 if (strcmp(str, objStr) != 0)
2873 return 0;
2874 if (objPtr->typePtr != &comparedStringObjType) {
2875 Jim_FreeIntRep(interp, objPtr);
2876 objPtr->typePtr = &comparedStringObjType;
2878 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
2879 return 1;
2883 static int qsortCompareStringPointers(const void *a, const void *b)
2885 char *const *sa = (char *const *)a;
2886 char *const *sb = (char *const *)b;
2888 return strcmp(*sa, *sb);
2892 /* -----------------------------------------------------------------------------
2893 * Source Object
2895 * This object is just a string from the language point of view, but
2896 * in the internal representation it contains the filename and line number
2897 * where this given token was read. This information is used by
2898 * Jim_EvalObj() if the object passed happens to be of type "source".
2900 * This allows to propagate the information about line numbers and file
2901 * names and give error messages with absolute line numbers.
2903 * Note that this object uses shared strings for filenames, and the
2904 * pointer to the filename together with the line number is taken into
2905 * the space for the "inline" internal representation of the Jim_Object,
2906 * so there is almost memory zero-overhead.
2908 * Also the object will be converted to something else if the given
2909 * token it represents in the source file is not something to be
2910 * evaluated (not a script), and will be specialized in some other way,
2911 * so the time overhead is also null.
2912 * ---------------------------------------------------------------------------*/
2914 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2915 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2917 static const Jim_ObjType sourceObjType = {
2918 "source",
2919 FreeSourceInternalRep,
2920 DupSourceInternalRep,
2921 NULL,
2922 JIM_TYPE_REFERENCES,
2925 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2927 Jim_ReleaseSharedString(interp, objPtr->internalRep.sourceValue.fileName);
2930 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2932 dupPtr->internalRep.sourceValue.fileName =
2933 Jim_GetSharedString(interp, srcPtr->internalRep.sourceValue.fileName);
2934 dupPtr->internalRep.sourceValue.lineNumber = dupPtr->internalRep.sourceValue.lineNumber;
2935 dupPtr->typePtr = &sourceObjType;
2938 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2939 const char *fileName, int lineNumber)
2941 if (fileName) {
2942 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
2943 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typePtr != NULL"));
2944 objPtr->internalRep.sourceValue.fileName = Jim_GetSharedString(interp, fileName);
2945 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2946 objPtr->typePtr = &sourceObjType;
2950 /* -----------------------------------------------------------------------------
2951 * Script Object
2952 * ---------------------------------------------------------------------------*/
2954 static const Jim_ObjType scriptLineObjType = {
2955 "scriptline",
2956 NULL,
2957 NULL,
2958 NULL,
2962 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
2964 Jim_Obj *objPtr;
2966 #ifdef DEBUG_SHOW_SCRIPT
2967 char buf[100];
2968 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
2969 objPtr = Jim_NewStringObj(interp, buf, -1);
2970 #else
2971 objPtr = Jim_NewEmptyStringObj(interp);
2972 #endif
2973 objPtr->typePtr = &scriptLineObjType;
2974 objPtr->internalRep.scriptLineValue.argc = argc;
2975 objPtr->internalRep.scriptLineValue.line = line;
2977 return objPtr;
2980 #define JIM_CMDSTRUCT_EXPAND -1
2982 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2983 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2984 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
2986 static const Jim_ObjType scriptObjType = {
2987 "script",
2988 FreeScriptInternalRep,
2989 DupScriptInternalRep,
2990 NULL,
2991 JIM_TYPE_REFERENCES,
2994 /* The ScriptToken structure represents every token into a scriptObj.
2995 * Every token contains an associated Jim_Obj that can be specialized
2996 * by commands operating on it. */
2997 typedef struct ScriptToken
2999 int type;
3000 Jim_Obj *objPtr;
3001 } ScriptToken;
3003 /* This is the script object internal representation. An array of
3004 * ScriptToken structures, including a pre-computed representation of the
3005 * command length and arguments.
3007 * For example the script:
3009 * puts hello
3010 * set $i $x$y [foo]BAR
3012 * will produce a ScriptObj with the following Tokens:
3014 * LIN 2
3015 * ESC puts
3016 * ESC hello
3017 * LIN 4
3018 * ESC set
3019 * VAR i
3020 * WRD 2
3021 * VAR x
3022 * VAR y
3023 * WRD 2
3024 * CMD foo
3025 * ESC BAR
3027 * "puts hello" has two args (LIN 2), composed of single tokens.
3028 * (Note that the WRD token is omitted for the common case of a single token.)
3030 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3031 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3033 * The precomputation of the command structure makes Jim_Eval() faster,
3034 * and simpler because there aren't dynamic lengths / allocations.
3036 * -- {expand}/{*} handling --
3038 * Expand is handled in a special way.
3040 * If a "word" begins with {*}, the word token count is -ve.
3042 * For example the command:
3044 * list {*}{a b}
3046 * Will produce the following cmdstruct array:
3048 * LIN 2
3049 * ESC list
3050 * WRD -1
3051 * STR a b
3053 * Note that the 'LIN' token also contains the source information for the
3054 * first word of the line for error reporting purposes
3056 * -- the substFlags field of the structure --
3058 * The scriptObj structure is used to represent both "script" objects
3059 * and "subst" objects. In the second case, the there are no LIN and WRD
3060 * tokens. Instead SEP and EOL tokens are added as-is.
3061 * In addition, the field 'substFlags' is used to represent the flags used to turn
3062 * the string into the internal representation used to perform the
3063 * substitution. If this flags are not what the application requires
3064 * the scriptObj is created again. For example the script:
3066 * subst -nocommands $string
3067 * subst -novariables $string
3069 * Will recreate the internal representation of the $string object
3070 * two times.
3072 typedef struct ScriptObj
3074 int len; /* Length as number of tokens. */
3075 ScriptToken *token; /* Tokens array. */
3076 int substFlags; /* flags used for the compilation of "subst" objects */
3077 int inUse; /* Used to share a ScriptObj. Currently
3078 only used by Jim_EvalObj() as protection against
3079 shimmering of the currently evaluated object. */
3080 const char *fileName;
3081 int line; /* Line number of the first line */
3082 } ScriptObj;
3084 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3086 int i;
3087 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3089 script->inUse--;
3090 if (script->inUse != 0)
3091 return;
3092 for (i = 0; i < script->len; i++) {
3093 Jim_DecrRefCount(interp, script->token[i].objPtr);
3095 Jim_Free(script->token);
3096 if (script->fileName) {
3097 Jim_ReleaseSharedString(interp, script->fileName);
3099 Jim_Free(script);
3102 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3104 JIM_NOTUSED(interp);
3105 JIM_NOTUSED(srcPtr);
3107 /* Just returns an simple string. */
3108 dupPtr->typePtr = NULL;
3111 /* A simple parser token.
3112 * All the simple tokens for the script point into the same script string rep.
3114 typedef struct
3116 const char *token; /* Pointer to the start of the token */
3117 int len; /* Length of this token */
3118 int type; /* Token type */
3119 int line; /* Line number */
3120 } ParseToken;
3122 /* A list of parsed tokens representing a script.
3123 * Tokens are added to this list as the script is parsed.
3124 * It grows as needed.
3126 typedef struct
3128 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3129 ParseToken *list; /* Array of tokens */
3130 int size; /* Current size of the list */
3131 int count; /* Number of entries used */
3132 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3133 } ParseTokenList;
3135 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3137 tokenlist->list = tokenlist->static_list;
3138 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3139 tokenlist->count = 0;
3142 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3144 if (tokenlist->list != tokenlist->static_list) {
3145 Jim_Free(tokenlist->list);
3150 * Adds the new token to the tokenlist.
3151 * The token has the given length, type and line number.
3152 * The token list is resized as necessary.
3154 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3155 int line)
3157 ParseToken *t;
3159 if (tokenlist->count == tokenlist->size) {
3160 /* Resize the list */
3161 tokenlist->size *= 2;
3162 if (tokenlist->list != tokenlist->static_list) {
3163 tokenlist->list =
3164 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3166 else {
3167 /* The list needs to become allocated */
3168 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3169 memcpy(tokenlist->list, tokenlist->static_list,
3170 tokenlist->count * sizeof(*tokenlist->list));
3173 t = &tokenlist->list[tokenlist->count++];
3174 t->token = token;
3175 t->len = len;
3176 t->type = type;
3177 t->line = line;
3180 /* Counts the number of adjoining non-separator.
3182 * Returns -ve if the first token is the expansion
3183 * operator (in which case the count doesn't include
3184 * that token).
3186 static int JimCountWordTokens(ParseToken *t)
3188 int expand = 1;
3189 int count = 0;
3191 /* Is the first word {*} or {expand}? */
3192 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3193 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3194 /* Create an expand token */
3195 expand = -1;
3196 t++;
3200 /* Now count non-separator words */
3201 while (!TOKEN_IS_SEP(t->type)) {
3202 t++;
3203 count++;
3206 return count * expand;
3210 * Create a script/subst object from the given token.
3212 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3214 Jim_Obj *objPtr;
3216 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3217 /* Convert the backlash escapes . */
3218 int len = t->len;
3219 char *str = Jim_Alloc(len + 1);
3220 len = JimEscape(str, t->token, len);
3221 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3223 else {
3224 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
3225 * with a single space. This is currently not done.
3227 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3229 return objPtr;
3233 * Takes a tokenlist and creates the allocated list of script tokens
3234 * in script->token, of length script->len.
3236 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3237 * as required.
3239 * Also sets script->line to the line number of the first token
3241 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3242 ParseTokenList *tokenlist)
3244 int i;
3245 struct ScriptToken *token;
3246 /* Number of tokens so far for the current command */
3247 int lineargs = 0;
3248 /* This is the first token for the current command */
3249 ScriptToken *linefirst;
3250 int count;
3251 int linenr;
3253 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3254 printf("==== Tokens ====\n");
3255 for (i = 0; i < tokenlist->count; i++) {
3256 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3257 tokenlist->list[i].len, tokenlist->list[i].token);
3259 #endif
3261 /* May need up to one extra script token for each EOL in the worst case */
3262 count = tokenlist->count;
3263 for (i = 0; i < tokenlist->count; i++) {
3264 if (tokenlist->list[i].type == JIM_TT_EOL) {
3265 count++;
3268 linenr = script->line = tokenlist->list[0].line;
3270 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3272 /* This is the first token for the current command */
3273 linefirst = token++;
3275 for (i = 0; i < tokenlist->count; ) {
3276 /* Look ahead to find out how many tokens make up the next word */
3277 int wordtokens;
3279 /* Skip any leading separators */
3280 while (tokenlist->list[i].type == JIM_TT_SEP) {
3281 i++;
3284 wordtokens = JimCountWordTokens(tokenlist->list + i);
3286 if (wordtokens == 0) {
3287 /* None, so at end of line */
3288 if (lineargs) {
3289 linefirst->type = JIM_TT_LINE;
3290 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3291 Jim_IncrRefCount(linefirst->objPtr);
3293 /* Reset for new line */
3294 lineargs = 0;
3295 linefirst = token++;
3297 i++;
3298 continue;
3300 else if (wordtokens != 1) {
3301 /* More than 1, or {expand}, so insert a WORD token */
3302 token->type = JIM_TT_WORD;
3303 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3304 Jim_IncrRefCount(token->objPtr);
3305 token++;
3306 if (wordtokens < 0) {
3307 /* Skip the expand token */
3308 i++;
3309 wordtokens = -wordtokens - 1;
3310 lineargs--;
3314 if (lineargs == 0) {
3315 /* First real token on the line, so record the line number */
3316 linenr = tokenlist->list[i].line;
3318 lineargs++;
3320 /* Add each non-separator word token to the line */
3321 while (wordtokens--) {
3322 const ParseToken *t = &tokenlist->list[i++];
3324 token->type = t->type;
3325 token->objPtr = JimMakeScriptObj(interp, t);
3326 Jim_IncrRefCount(token->objPtr);
3328 /* Every object is initially a string, but the
3329 * internal type may be specialized during execution of the
3330 * script. */
3331 JimSetSourceInfo(interp, token->objPtr, script->fileName, t->line);
3332 token++;
3336 if (lineargs == 0) {
3337 token--;
3340 script->len = token - script->token;
3342 assert(script->len < count);
3344 #ifdef DEBUG_SHOW_SCRIPT
3345 printf("==== Script (%s) ====\n", script->fileName);
3346 for (i = 0; i < script->len; i++) {
3347 const ScriptToken *t = &script->token[i];
3348 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3350 #endif
3355 * Similar to ScriptObjAddTokens(), but for subst objects.
3357 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3358 ParseTokenList *tokenlist)
3360 int i;
3361 struct ScriptToken *token;
3363 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3365 for (i = 0; i < tokenlist->count; i++) {
3366 const ParseToken *t = &tokenlist->list[i];
3368 /* Create a token for 't' */
3369 token->type = t->type;
3370 token->objPtr = JimMakeScriptObj(interp, t);
3371 Jim_IncrRefCount(token->objPtr);
3372 token++;
3375 script->len = i;
3378 /* This method takes the string representation of an object
3379 * as a Tcl script, and generates the pre-parsed internal representation
3380 * of the script. */
3381 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3383 int scriptTextLen;
3384 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3385 struct JimParserCtx parser;
3386 struct ScriptObj *script;
3387 ParseTokenList tokenlist;
3388 int line = 1;
3390 /* Try to get information about filename / line number */
3391 if (objPtr->typePtr == &sourceObjType) {
3392 line = objPtr->internalRep.sourceValue.lineNumber;
3395 /* Initially parse the script into tokens (in tokenlist) */
3396 ScriptTokenListInit(&tokenlist);
3398 JimParserInit(&parser, scriptText, scriptTextLen, line);
3399 while (!parser.eof) {
3400 JimParseScript(&parser);
3401 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3402 parser.tline);
3404 if (result && parser.missing != ' ') {
3405 ScriptTokenListFree(&tokenlist);
3406 result->missing = parser.missing;
3407 result->line = parser.missingline;
3408 return JIM_ERR;
3411 /* Add a final EOF token */
3412 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3414 /* Create the "real" script tokens from the initial token list */
3415 script = Jim_Alloc(sizeof(*script));
3416 memset(script, 0, sizeof(*script));
3417 script->inUse = 1;
3418 script->line = line;
3419 if (objPtr->typePtr == &sourceObjType) {
3420 script->fileName = Jim_GetSharedString(interp, objPtr->internalRep.sourceValue.fileName);
3423 ScriptObjAddTokens(interp, script, &tokenlist);
3425 /* No longer need the token list */
3426 ScriptTokenListFree(&tokenlist);
3428 if (!script->fileName) {
3429 script->fileName = Jim_GetSharedString(interp, "");
3432 /* Free the old internal rep and set the new one. */
3433 Jim_FreeIntRep(interp, objPtr);
3434 Jim_SetIntRepPtr(objPtr, script);
3435 objPtr->typePtr = &scriptObjType;
3437 return JIM_OK;
3440 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3442 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
3444 if (objPtr->typePtr != &scriptObjType || script->substFlags) {
3445 SetScriptFromAny(interp, objPtr, NULL);
3447 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3450 /* -----------------------------------------------------------------------------
3451 * Commands
3452 * ---------------------------------------------------------------------------*/
3453 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3455 cmdPtr->inUse++;
3458 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3460 if (--cmdPtr->inUse == 0) {
3461 if (cmdPtr->isproc) {
3462 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3463 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3464 if (cmdPtr->u.proc.staticVars) {
3465 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3466 Jim_Free(cmdPtr->u.proc.staticVars);
3468 if (cmdPtr->u.proc.prevCmd) {
3469 /* Delete any pushed command too */
3470 JimDecrCmdRefCount(interp, cmdPtr->u.proc.prevCmd);
3473 else {
3474 /* native (C) */
3475 if (cmdPtr->u.native.delProc) {
3476 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3479 Jim_Free(cmdPtr);
3483 /* Commands HashTable Type.
3485 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3486 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3488 JimDecrCmdRefCount(interp, val);
3491 static const Jim_HashTableType JimCommandsHashTableType = {
3492 JimStringCopyHTHashFunction, /* hash function */
3493 JimStringCopyHTKeyDup, /* key dup */
3494 NULL, /* val dup */
3495 JimStringCopyHTKeyCompare, /* key compare */
3496 JimStringCopyHTKeyDestructor, /* key destructor */
3497 JimCommandsHT_ValDestructor /* val destructor */
3500 /* ------------------------- Commands related functions --------------------- */
3502 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3503 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3505 Jim_Cmd *cmdPtr;
3507 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3508 /* Command existed so incr proc epoch */
3509 Jim_InterpIncrProcEpoch(interp);
3512 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3514 /* Store the new details for this proc */
3515 memset(cmdPtr, 0, sizeof(*cmdPtr));
3516 cmdPtr->inUse = 1;
3517 cmdPtr->u.native.delProc = delProc;
3518 cmdPtr->u.native.cmdProc = cmdProc;
3519 cmdPtr->u.native.privData = privData;
3521 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3523 /* There is no need to increment the 'proc epoch' because
3524 * creation of a new procedure can never affect existing
3525 * cached commands. We don't do negative caching. */
3526 return JIM_OK;
3529 static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
3530 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr)
3532 Jim_Cmd *cmdPtr;
3533 Jim_HashEntry *he;
3534 int argListLen;
3535 int i;
3537 if (JimValidName(interp, "procedure", cmdName) != JIM_OK) {
3538 return JIM_ERR;
3541 argListLen = Jim_ListLength(interp, argListObjPtr);
3543 /* Allocate space for both the command pointer and the arg list */
3544 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3545 memset(cmdPtr, 0, sizeof(*cmdPtr));
3546 cmdPtr->inUse = 1;
3547 cmdPtr->isproc = 1;
3548 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3549 cmdPtr->u.proc.argListLen = argListLen;
3550 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3551 cmdPtr->u.proc.argsPos = -1;
3552 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3553 Jim_IncrRefCount(argListObjPtr);
3554 Jim_IncrRefCount(bodyObjPtr);
3556 /* Create the statics hash table. */
3557 if (staticsListObjPtr) {
3558 int len, i;
3560 len = Jim_ListLength(interp, staticsListObjPtr);
3561 if (len != 0) {
3562 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3563 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3564 for (i = 0; i < len; i++) {
3565 Jim_Obj *objPtr = 0, *initObjPtr = 0, *nameObjPtr = 0;
3566 Jim_Var *varPtr;
3567 int subLen;
3569 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3570 /* Check if it's composed of two elements. */
3571 subLen = Jim_ListLength(interp, objPtr);
3572 if (subLen == 1 || subLen == 2) {
3573 /* Try to get the variable value from the current
3574 * environment. */
3575 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3576 if (subLen == 1) {
3577 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3578 if (initObjPtr == NULL) {
3579 Jim_SetResultFormatted(interp,
3580 "variable for initialization of static \"%#s\" not found in the local context",
3581 nameObjPtr);
3582 goto err;
3585 else {
3586 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3588 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3589 goto err;
3592 varPtr = Jim_Alloc(sizeof(*varPtr));
3593 varPtr->objPtr = initObjPtr;
3594 Jim_IncrRefCount(initObjPtr);
3595 varPtr->linkFramePtr = NULL;
3596 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3597 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3598 Jim_SetResultFormatted(interp,
3599 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3600 Jim_DecrRefCount(interp, initObjPtr);
3601 Jim_Free(varPtr);
3602 goto err;
3605 else {
3606 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3607 objPtr);
3608 goto err;
3614 /* Parse the args out into arglist, validating as we go */
3615 /* Examine the argument list for default parameters and 'args' */
3616 for (i = 0; i < argListLen; i++) {
3617 Jim_Obj *argPtr;
3618 Jim_Obj *nameObjPtr;
3619 Jim_Obj *defaultObjPtr;
3620 int len;
3621 int n = 1;
3623 /* Examine a parameter */
3624 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3625 len = Jim_ListLength(interp, argPtr);
3626 if (len == 0) {
3627 Jim_SetResultString(interp, "procedure has argument with no name", -1);
3628 goto err;
3630 if (len > 2) {
3631 Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
3632 goto err;
3635 if (len == 2) {
3636 /* Optional parameter */
3637 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
3638 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
3640 else {
3641 /* Required parameter */
3642 nameObjPtr = argPtr;
3643 defaultObjPtr = NULL;
3647 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
3648 if (cmdPtr->u.proc.argsPos >= 0) {
3649 Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
3650 goto err;
3652 cmdPtr->u.proc.argsPos = i;
3654 else {
3655 if (len == 2) {
3656 cmdPtr->u.proc.optArity += n;
3658 else {
3659 cmdPtr->u.proc.reqArity += n;
3663 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
3664 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
3667 /* Add the new command */
3669 /* It may already exist, so we try to delete the old one.
3670 * Note that reference count means that it won't be deleted yet if
3671 * it exists in the call stack.
3673 * BUT, if 'local' is in force, instead of deleting the existing
3674 * proc, we stash a reference to the old proc here.
3676 he = Jim_FindHashEntry(&interp->commands, Jim_String(cmdName));
3677 if (he) {
3678 /* There was an old procedure with the same name, this requires
3679 * a 'proc epoch' update. */
3681 /* If a procedure with the same name didn't existed there is no need
3682 * to increment the 'proc epoch' because creation of a new procedure
3683 * can never affect existing cached commands. We don't do
3684 * negative caching. */
3685 Jim_InterpIncrProcEpoch(interp);
3688 if (he && interp->local) {
3689 /* Just push this proc over the top of the previous one */
3690 cmdPtr->u.proc.prevCmd = he->u.val;
3691 he->u.val = cmdPtr;
3693 else {
3694 if (he) {
3695 /* Replace the existing proc */
3696 Jim_DeleteHashEntry(&interp->commands, Jim_String(cmdName));
3699 Jim_AddHashEntry(&interp->commands, Jim_String(cmdName), cmdPtr);
3702 /* Unlike Tcl, set the name of the proc as the result */
3703 Jim_SetResult(interp, cmdName);
3704 return JIM_OK;
3706 err:
3707 if (cmdPtr->u.proc.staticVars) {
3708 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3710 Jim_Free(cmdPtr->u.proc.staticVars);
3711 Jim_DecrRefCount(interp, argListObjPtr);
3712 Jim_DecrRefCount(interp, bodyObjPtr);
3713 Jim_Free(cmdPtr);
3714 return JIM_ERR;
3717 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3719 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3720 return JIM_ERR;
3721 Jim_InterpIncrProcEpoch(interp);
3722 return JIM_OK;
3725 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
3727 Jim_HashEntry *he;
3729 /* Does it exist? */
3730 he = Jim_FindHashEntry(&interp->commands, oldName);
3731 if (he == NULL) {
3732 Jim_SetResultFormatted(interp, "can't %s \"%s\": command doesn't exist",
3733 newName[0] ? "rename" : "delete", oldName);
3734 return JIM_ERR;
3737 if (newName[0] == '\0') /* Delete! */
3738 return Jim_DeleteCommand(interp, oldName);
3740 /* rename */
3741 if (Jim_FindHashEntry(&interp->commands, newName)) {
3742 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
3743 return JIM_ERR;
3746 /* Add the new name first */
3747 JimIncrCmdRefCount(he->u.val);
3748 Jim_AddHashEntry(&interp->commands, newName, he->u.val);
3750 /* Now remove the old name */
3751 Jim_DeleteHashEntry(&interp->commands, oldName);
3753 /* Increment the epoch */
3754 Jim_InterpIncrProcEpoch(interp);
3755 return JIM_OK;
3758 /* -----------------------------------------------------------------------------
3759 * Command object
3760 * ---------------------------------------------------------------------------*/
3762 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3764 static const Jim_ObjType commandObjType = {
3765 "command",
3766 NULL,
3767 NULL,
3768 NULL,
3769 JIM_TYPE_REFERENCES,
3772 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3774 Jim_HashEntry *he;
3775 const char *cmdName;
3777 /* Get the string representation */
3778 cmdName = Jim_String(objPtr);
3779 /* Lookup this name into the commands hash table */
3780 he = Jim_FindHashEntry(&interp->commands, cmdName);
3781 if (he == NULL)
3782 return JIM_ERR;
3784 /* Free the old internal repr and set the new one. */
3785 Jim_FreeIntRep(interp, objPtr);
3786 objPtr->typePtr = &commandObjType;
3787 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3788 objPtr->internalRep.cmdValue.cmdPtr = (void *)he->u.val;
3789 return JIM_OK;
3792 /* This function returns the command structure for the command name
3793 * stored in objPtr. It tries to specialize the objPtr to contain
3794 * a cached info instead to perform the lookup into the hash table
3795 * every time. The information cached may not be uptodate, in such
3796 * a case the lookup is performed and the cache updated.
3798 * Respects the 'upcall' setting
3800 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3802 Jim_Cmd *cmd;
3804 if ((objPtr->typePtr != &commandObjType ||
3805 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3806 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3807 if (flags & JIM_ERRMSG) {
3808 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
3810 return NULL;
3812 cmd = objPtr->internalRep.cmdValue.cmdPtr;
3813 while (cmd->isproc && cmd->u.proc.upcall) {
3814 cmd = cmd->u.proc.prevCmd;
3816 return cmd;
3819 /* -----------------------------------------------------------------------------
3820 * Variables
3821 * ---------------------------------------------------------------------------*/
3823 /* Variables HashTable Type.
3825 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3826 static void JimVariablesHTValDestructor(void *interp, void *val)
3828 Jim_Var *varPtr = (void *)val;
3830 Jim_DecrRefCount(interp, varPtr->objPtr);
3831 Jim_Free(val);
3834 static const Jim_HashTableType JimVariablesHashTableType = {
3835 JimStringCopyHTHashFunction, /* hash function */
3836 JimStringCopyHTKeyDup, /* key dup */
3837 NULL, /* val dup */
3838 JimStringCopyHTKeyCompare, /* key compare */
3839 JimStringCopyHTKeyDestructor, /* key destructor */
3840 JimVariablesHTValDestructor /* val destructor */
3843 /* -----------------------------------------------------------------------------
3844 * Variable object
3845 * ---------------------------------------------------------------------------*/
3847 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3849 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3851 static const Jim_ObjType variableObjType = {
3852 "variable",
3853 NULL,
3854 NULL,
3855 NULL,
3856 JIM_TYPE_REFERENCES,
3859 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3860 * is in the form "varname(key)". */
3861 static int JimNameIsDictSugar(const char *str, int len)
3863 if (len && str[len - 1] == ')' && strchr(str, '(') != NULL)
3864 return 1;
3865 return 0;
3869 * Check that the name does not contain embedded nulls.
3871 * Variable and procedure names are maniplated as null terminated strings, so
3872 * don't allow names with embedded nulls.
3874 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
3876 /* Variable names and proc names can't contain embedded nulls */
3877 if (nameObjPtr->typePtr != &variableObjType) {
3878 int len;
3879 const char *str = Jim_GetString(nameObjPtr, &len);
3880 if (memchr(str, '\0', len)) {
3881 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
3882 return JIM_ERR;
3885 return JIM_OK;
3888 /* This method should be called only by the variable API.
3889 * It returns JIM_OK on success (variable already exists),
3890 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
3891 * a variable name, but syntax glue for [dict] i.e. the last
3892 * character is ')' */
3893 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3895 Jim_HashEntry *he;
3896 const char *varName;
3897 int len;
3898 Jim_CallFrame *framePtr = interp->framePtr;
3900 /* Check if the object is already an uptodate variable */
3901 if (objPtr->typePtr == &variableObjType &&
3902 objPtr->internalRep.varValue.callFrameId == framePtr->id) {
3903 return JIM_OK; /* nothing to do */
3906 if (objPtr->typePtr == &dictSubstObjType) {
3907 return JIM_DICT_SUGAR;
3910 if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
3911 return JIM_ERR;
3914 /* Get the string representation */
3915 varName = Jim_GetString(objPtr, &len);
3917 /* Make sure it's not syntax glue to get/set dict. */
3918 if (JimNameIsDictSugar(varName, len)) {
3919 return JIM_DICT_SUGAR;
3922 if (varName[0] == ':' && varName[1] == ':') {
3923 framePtr = interp->topFramePtr;
3924 he = Jim_FindHashEntry(&framePtr->vars, varName + 2);
3925 if (he == NULL) {
3926 return JIM_ERR;
3929 else {
3930 /* Lookup this name into the variables hash table */
3931 he = Jim_FindHashEntry(&framePtr->vars, varName);
3932 if (he == NULL) {
3933 /* Try with static vars. */
3934 if (framePtr->staticVars == NULL)
3935 return JIM_ERR;
3936 if (!(he = Jim_FindHashEntry(framePtr->staticVars, varName)))
3937 return JIM_ERR;
3940 /* Free the old internal repr and set the new one. */
3941 Jim_FreeIntRep(interp, objPtr);
3942 objPtr->typePtr = &variableObjType;
3943 objPtr->internalRep.varValue.callFrameId = framePtr->id;
3944 objPtr->internalRep.varValue.varPtr = (void *)he->u.val;
3945 return JIM_OK;
3948 /* -------------------- Variables related functions ------------------------- */
3949 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
3950 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
3952 /* For now that's dummy. Variables lookup should be optimized
3953 * in many ways, with caching of lookups, and possibly with
3954 * a table of pre-allocated vars in every CallFrame for local vars.
3955 * All the caching should also have an 'epoch' mechanism similar
3956 * to the one used by Tcl for procedures lookup caching. */
3958 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3960 const char *name;
3961 Jim_Var *var;
3962 int err;
3964 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3965 Jim_CallFrame *framePtr = interp->framePtr;
3967 /* Check for [dict] syntax sugar. */
3968 if (err == JIM_DICT_SUGAR)
3969 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3971 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
3972 return JIM_ERR;
3975 /* New variable to create */
3976 name = Jim_String(nameObjPtr);
3978 var = Jim_Alloc(sizeof(*var));
3979 var->objPtr = valObjPtr;
3980 Jim_IncrRefCount(valObjPtr);
3981 var->linkFramePtr = NULL;
3982 /* Insert the new variable */
3983 if (name[0] == ':' && name[1] == ':') {
3984 /* Into the top level frame */
3985 framePtr = interp->topFramePtr;
3986 Jim_AddHashEntry(&framePtr->vars, name + 2, var);
3988 else {
3989 Jim_AddHashEntry(&framePtr->vars, name, var);
3991 /* Make the object int rep a variable */
3992 Jim_FreeIntRep(interp, nameObjPtr);
3993 nameObjPtr->typePtr = &variableObjType;
3994 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
3995 nameObjPtr->internalRep.varValue.varPtr = var;
3997 else {
3998 var = nameObjPtr->internalRep.varValue.varPtr;
3999 if (var->linkFramePtr == NULL) {
4000 Jim_IncrRefCount(valObjPtr);
4001 Jim_DecrRefCount(interp, var->objPtr);
4002 var->objPtr = valObjPtr;
4004 else { /* Else handle the link */
4005 Jim_CallFrame *savedCallFrame;
4007 savedCallFrame = interp->framePtr;
4008 interp->framePtr = var->linkFramePtr;
4009 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4010 interp->framePtr = savedCallFrame;
4011 if (err != JIM_OK)
4012 return err;
4015 return JIM_OK;
4018 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4020 Jim_Obj *nameObjPtr;
4021 int result;
4023 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4024 Jim_IncrRefCount(nameObjPtr);
4025 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4026 Jim_DecrRefCount(interp, nameObjPtr);
4027 return result;
4030 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4032 Jim_CallFrame *savedFramePtr;
4033 int result;
4035 savedFramePtr = interp->framePtr;
4036 interp->framePtr = interp->topFramePtr;
4037 result = Jim_SetVariableStr(interp, name, objPtr);
4038 interp->framePtr = savedFramePtr;
4039 return result;
4042 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4044 Jim_Obj *nameObjPtr, *valObjPtr;
4045 int result;
4047 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4048 valObjPtr = Jim_NewStringObj(interp, val, -1);
4049 Jim_IncrRefCount(nameObjPtr);
4050 Jim_IncrRefCount(valObjPtr);
4051 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4052 Jim_DecrRefCount(interp, nameObjPtr);
4053 Jim_DecrRefCount(interp, valObjPtr);
4054 return result;
4057 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4058 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4060 const char *varName;
4061 int len;
4063 varName = Jim_GetString(nameObjPtr, &len);
4065 if (varName[0] == ':' && varName[1] == ':') {
4066 /* Linking a global var does nothing */
4067 return JIM_OK;
4070 if (JimNameIsDictSugar(varName, len)) {
4071 Jim_SetResultString(interp, "Dict key syntax invalid as link source", -1);
4072 return JIM_ERR;
4075 /* Check for an existing variable or link */
4076 if (SetVariableFromAny(interp, nameObjPtr) == JIM_OK) {
4077 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4079 if (varPtr->linkFramePtr == NULL) {
4080 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4081 return JIM_ERR;
4084 /* It exists, but is a link, so delete the link */
4085 varPtr->linkFramePtr = NULL;
4088 /* Check for cycles. */
4089 if (interp->framePtr == targetCallFrame) {
4090 Jim_Obj *objPtr = targetNameObjPtr;
4091 Jim_Var *varPtr;
4093 /* Cycles are only possible with 'uplevel 0' */
4094 while (1) {
4095 if (Jim_StringEqObj(objPtr, nameObjPtr)) {
4096 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4097 return JIM_ERR;
4099 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4100 break;
4101 varPtr = objPtr->internalRep.varValue.varPtr;
4102 if (varPtr->linkFramePtr != targetCallFrame)
4103 break;
4104 objPtr = varPtr->objPtr;
4108 /* Perform the binding */
4109 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4110 /* We are now sure 'nameObjPtr' type is variableObjType */
4111 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4112 return JIM_OK;
4115 /* Return the Jim_Obj pointer associated with a variable name,
4116 * or NULL if the variable was not found in the current context.
4117 * The same optimization discussed in the comment to the
4118 * 'SetVariable' function should apply here.
4120 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4121 * in a dictionary which is shared, the array variable value is duplicated first.
4122 * This allows the array element to be updated (e.g. append, lappend) without
4123 * affecting other references to the dictionary.
4125 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4127 switch (SetVariableFromAny(interp, nameObjPtr)) {
4128 case JIM_OK:{
4129 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4131 if (varPtr->linkFramePtr == NULL) {
4132 return varPtr->objPtr;
4134 else {
4135 Jim_Obj *objPtr;
4137 /* The variable is a link? Resolve it. */
4138 Jim_CallFrame *savedCallFrame = interp->framePtr;
4140 interp->framePtr = varPtr->linkFramePtr;
4141 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4142 interp->framePtr = savedCallFrame;
4143 if (objPtr) {
4144 return objPtr;
4146 /* Error, so fall through to the error message */
4149 break;
4151 case JIM_DICT_SUGAR:
4152 /* [dict] syntax sugar. */
4153 return JimDictSugarGet(interp, nameObjPtr, flags);
4155 if (flags & JIM_ERRMSG) {
4156 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4158 return NULL;
4161 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4163 Jim_CallFrame *savedFramePtr;
4164 Jim_Obj *objPtr;
4166 savedFramePtr = interp->framePtr;
4167 interp->framePtr = interp->topFramePtr;
4168 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4169 interp->framePtr = savedFramePtr;
4171 return objPtr;
4174 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4176 Jim_Obj *nameObjPtr, *varObjPtr;
4178 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4179 Jim_IncrRefCount(nameObjPtr);
4180 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4181 Jim_DecrRefCount(interp, nameObjPtr);
4182 return varObjPtr;
4185 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4187 Jim_CallFrame *savedFramePtr;
4188 Jim_Obj *objPtr;
4190 savedFramePtr = interp->framePtr;
4191 interp->framePtr = interp->topFramePtr;
4192 objPtr = Jim_GetVariableStr(interp, name, flags);
4193 interp->framePtr = savedFramePtr;
4195 return objPtr;
4198 /* Unset a variable.
4199 * Note: On success unset invalidates all the variable objects created
4200 * in the current call frame incrementing. */
4201 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4203 const char *name;
4204 Jim_Var *varPtr;
4205 int retval;
4207 retval = SetVariableFromAny(interp, nameObjPtr);
4208 if (retval == JIM_DICT_SUGAR) {
4209 /* [dict] syntax sugar. */
4210 return JimDictSugarSet(interp, nameObjPtr, NULL);
4212 else if (retval == JIM_OK) {
4213 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4215 /* If it's a link call UnsetVariable recursively */
4216 if (varPtr->linkFramePtr) {
4217 Jim_CallFrame *savedCallFrame;
4219 savedCallFrame = interp->framePtr;
4220 interp->framePtr = varPtr->linkFramePtr;
4221 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4222 interp->framePtr = savedCallFrame;
4224 else {
4225 Jim_CallFrame *framePtr = interp->framePtr;
4227 name = Jim_String(nameObjPtr);
4228 if (name[0] == ':' && name[1] == ':') {
4229 framePtr = interp->topFramePtr;
4230 name += 2;
4232 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4233 if (retval == JIM_OK) {
4234 /* Change the callframe id, invalidating var lookup caching */
4235 JimChangeCallFrameId(interp, framePtr);
4239 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4240 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4242 return retval;
4245 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4247 /* Given a variable name for [dict] operation syntax sugar,
4248 * this function returns two objects, the first with the name
4249 * of the variable to set, and the second with the rispective key.
4250 * For example "foo(bar)" will return objects with string repr. of
4251 * "foo" and "bar".
4253 * The returned objects have refcount = 1. The function can't fail. */
4254 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4255 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4257 const char *str, *p;
4258 int len, keyLen;
4259 Jim_Obj *varObjPtr, *keyObjPtr;
4261 str = Jim_GetString(objPtr, &len);
4263 p = strchr(str, '(');
4264 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4266 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4268 p++;
4269 keyLen = (str + len) - p;
4270 if (str[len - 1] == ')') {
4271 keyLen--;
4274 /* Create the objects with the variable name and key. */
4275 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4277 Jim_IncrRefCount(varObjPtr);
4278 Jim_IncrRefCount(keyObjPtr);
4279 *varPtrPtr = varObjPtr;
4280 *keyPtrPtr = keyObjPtr;
4283 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4284 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4285 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4287 int err;
4289 SetDictSubstFromAny(interp, objPtr);
4291 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4292 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr);
4294 if (err == JIM_OK) {
4295 /* Don't keep an extra ref to the result */
4296 Jim_SetEmptyResult(interp);
4298 else {
4299 if (!valObjPtr) {
4300 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4301 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4302 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4303 objPtr);
4304 return err;
4307 /* Make the error more informative and Tcl-compatible */
4308 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4309 (valObjPtr ? "set" : "unset"), objPtr);
4311 return err;
4315 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4317 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4318 * and stored back to the variable before expansion.
4320 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4321 Jim_Obj *keyObjPtr, int flags)
4323 Jim_Obj *dictObjPtr;
4324 Jim_Obj *resObjPtr = NULL;
4325 int ret;
4327 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4328 if (!dictObjPtr) {
4329 return NULL;
4332 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4333 if (ret != JIM_OK) {
4334 resObjPtr = NULL;
4335 if (ret < 0) {
4336 Jim_SetResultFormatted(interp,
4337 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4339 else {
4340 Jim_SetResultFormatted(interp,
4341 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4344 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4345 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4346 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4347 /* This can probably never happen */
4348 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4350 /* We know that the key exists. Get the result in the now-unshared dictionary */
4351 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4354 return resObjPtr;
4357 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4358 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4360 SetDictSubstFromAny(interp, objPtr);
4362 return JimDictExpandArrayVariable(interp,
4363 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4364 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4367 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4369 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4371 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4372 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4375 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4377 JIM_NOTUSED(interp);
4379 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4380 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4381 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4382 dupPtr->typePtr = &dictSubstObjType;
4385 /* Note: The object *must* be in dict-sugar format */
4386 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4388 if (objPtr->typePtr != &dictSubstObjType) {
4389 Jim_Obj *varObjPtr, *keyObjPtr;
4391 if (objPtr->typePtr == &interpolatedObjType) {
4392 /* An interpolated object in dict-sugar form */
4394 const ScriptToken *token = objPtr->internalRep.twoPtrValue.ptr1;
4396 varObjPtr = token[0].objPtr;
4397 keyObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
4399 Jim_IncrRefCount(varObjPtr);
4400 Jim_IncrRefCount(keyObjPtr);
4402 else {
4403 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4406 Jim_FreeIntRep(interp, objPtr);
4407 objPtr->typePtr = &dictSubstObjType;
4408 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4409 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4413 /* This function is used to expand [dict get] sugar in the form
4414 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4415 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4416 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4417 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4418 * the [dict]ionary contained in variable VARNAME. */
4419 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4421 Jim_Obj *resObjPtr = NULL;
4422 Jim_Obj *substKeyObjPtr = NULL;
4424 SetDictSubstFromAny(interp, objPtr);
4426 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4427 &substKeyObjPtr, JIM_NONE)
4428 != JIM_OK) {
4429 return NULL;
4431 Jim_IncrRefCount(substKeyObjPtr);
4432 resObjPtr =
4433 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4434 substKeyObjPtr, 0);
4435 Jim_DecrRefCount(interp, substKeyObjPtr);
4437 return resObjPtr;
4440 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4442 Jim_Obj *resultObjPtr;
4444 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4445 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4446 resultObjPtr->refCount--;
4447 return resultObjPtr;
4449 return NULL;
4452 /* -----------------------------------------------------------------------------
4453 * CallFrame
4454 * ---------------------------------------------------------------------------*/
4456 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent)
4458 Jim_CallFrame *cf;
4460 if (interp->freeFramesList) {
4461 cf = interp->freeFramesList;
4462 interp->freeFramesList = cf->nextFramePtr;
4464 else {
4465 cf = Jim_Alloc(sizeof(*cf));
4466 cf->vars.table = NULL;
4469 cf->id = interp->callFrameEpoch++;
4470 cf->parentCallFrame = parent;
4471 cf->level = parent ? parent->level + 1 : 0;
4472 cf->argv = NULL;
4473 cf->argc = 0;
4474 cf->procArgsObjPtr = NULL;
4475 cf->procBodyObjPtr = NULL;
4476 cf->nextFramePtr = NULL;
4477 cf->staticVars = NULL;
4478 if (cf->vars.table == NULL)
4479 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4480 return cf;
4483 /* Used to invalidate every caching related to callframe stability. */
4484 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4486 cf->id = interp->callFrameEpoch++;
4489 #define JIM_FCF_NONE 0 /* no flags */
4490 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4491 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4493 if (cf->procArgsObjPtr)
4494 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4495 if (cf->procBodyObjPtr)
4496 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4497 if (!(flags & JIM_FCF_NOHT))
4498 Jim_FreeHashTable(&cf->vars);
4499 else {
4500 int i;
4501 Jim_HashEntry **table = cf->vars.table, *he;
4503 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4504 he = table[i];
4505 while (he != NULL) {
4506 Jim_HashEntry *nextEntry = he->next;
4507 Jim_Var *varPtr = (void *)he->u.val;
4509 Jim_DecrRefCount(interp, varPtr->objPtr);
4510 Jim_Free(he->u.val);
4511 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4512 Jim_Free(he);
4513 table[i] = NULL;
4514 he = nextEntry;
4517 cf->vars.used = 0;
4519 cf->nextFramePtr = interp->freeFramesList;
4520 interp->freeFramesList = cf;
4523 /* -----------------------------------------------------------------------------
4524 * References
4525 * ---------------------------------------------------------------------------*/
4526 #ifdef JIM_REFERENCES
4528 /* References HashTable Type.
4530 * Keys are jim_wide integers, dynamically allocated for now but in the
4531 * future it's worth to cache this 8 bytes objects. Values are poitners
4532 * to Jim_References. */
4533 static void JimReferencesHTValDestructor(void *interp, void *val)
4535 Jim_Reference *refPtr = (void *)val;
4537 Jim_DecrRefCount(interp, refPtr->objPtr);
4538 if (refPtr->finalizerCmdNamePtr != NULL) {
4539 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4541 Jim_Free(val);
4544 static unsigned int JimReferencesHTHashFunction(const void *key)
4546 /* Only the least significant bits are used. */
4547 const jim_wide *widePtr = key;
4548 unsigned int intValue = (unsigned int)*widePtr;
4550 return Jim_IntHashFunction(intValue);
4553 static const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4555 void *copy = Jim_Alloc(sizeof(jim_wide));
4557 JIM_NOTUSED(privdata);
4559 memcpy(copy, key, sizeof(jim_wide));
4560 return copy;
4563 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4565 JIM_NOTUSED(privdata);
4567 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4570 static void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4572 JIM_NOTUSED(privdata);
4574 Jim_Free((void *)key);
4577 static const Jim_HashTableType JimReferencesHashTableType = {
4578 JimReferencesHTHashFunction, /* hash function */
4579 JimReferencesHTKeyDup, /* key dup */
4580 NULL, /* val dup */
4581 JimReferencesHTKeyCompare, /* key compare */
4582 JimReferencesHTKeyDestructor, /* key destructor */
4583 JimReferencesHTValDestructor /* val destructor */
4586 /* -----------------------------------------------------------------------------
4587 * Reference object type and References API
4588 * ---------------------------------------------------------------------------*/
4590 /* The string representation of references has two features in order
4591 * to make the GC faster. The first is that every reference starts
4592 * with a non common character '<', in order to make the string matching
4593 * faster. The second is that the reference string rep is 42 characters
4594 * in length, this allows to avoid to check every object with a string
4595 * repr < 42, and usually there aren't many of these objects. */
4597 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
4599 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
4601 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
4603 sprintf(buf, fmt, refPtr->tag, id);
4604 return JIM_REFERENCE_SPACE;
4607 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4609 static const Jim_ObjType referenceObjType = {
4610 "reference",
4611 NULL,
4612 NULL,
4613 UpdateStringOfReference,
4614 JIM_TYPE_REFERENCES,
4617 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4619 int len;
4620 char buf[JIM_REFERENCE_SPACE + 1];
4621 Jim_Reference *refPtr;
4623 refPtr = objPtr->internalRep.refValue.refPtr;
4624 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4625 objPtr->bytes = Jim_Alloc(len + 1);
4626 memcpy(objPtr->bytes, buf, len + 1);
4627 objPtr->length = len;
4630 /* returns true if 'c' is a valid reference tag character.
4631 * i.e. inside the range [_a-zA-Z0-9] */
4632 static int isrefchar(int c)
4634 return (c == '_' || isalnum(c));
4637 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4639 jim_wide wideValue;
4640 int i, len;
4641 const char *str, *start, *end;
4642 char refId[21];
4643 Jim_Reference *refPtr;
4644 Jim_HashEntry *he;
4646 /* Get the string representation */
4647 str = Jim_GetString(objPtr, &len);
4648 /* Check if it looks like a reference */
4649 if (len < JIM_REFERENCE_SPACE)
4650 goto badformat;
4651 /* Trim spaces */
4652 start = str;
4653 end = str + len - 1;
4654 while (*start == ' ')
4655 start++;
4656 while (*end == ' ' && end > start)
4657 end--;
4658 if (end - start + 1 != JIM_REFERENCE_SPACE)
4659 goto badformat;
4660 /* <reference.<1234567>.%020> */
4661 if (memcmp(start, "<reference.<", 12) != 0)
4662 goto badformat;
4663 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
4664 goto badformat;
4665 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4666 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4667 if (!isrefchar(start[12 + i]))
4668 goto badformat;
4670 /* Extract info from the reference. */
4671 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4672 refId[20] = '\0';
4673 /* Try to convert the ID into a jim_wide */
4674 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK)
4675 goto badformat;
4676 /* Check if the reference really exists! */
4677 he = Jim_FindHashEntry(&interp->references, &wideValue);
4678 if (he == NULL) {
4679 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
4680 return JIM_ERR;
4682 refPtr = he->u.val;
4683 /* Free the old internal repr and set the new one. */
4684 Jim_FreeIntRep(interp, objPtr);
4685 objPtr->typePtr = &referenceObjType;
4686 objPtr->internalRep.refValue.id = wideValue;
4687 objPtr->internalRep.refValue.refPtr = refPtr;
4688 return JIM_OK;
4690 badformat:
4691 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
4692 return JIM_ERR;
4695 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4696 * as finalizer command (or NULL if there is no finalizer).
4697 * The returned reference object has refcount = 0. */
4698 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
4700 struct Jim_Reference *refPtr;
4701 jim_wide wideValue = interp->referenceNextId;
4702 Jim_Obj *refObjPtr;
4703 const char *tag;
4704 int tagLen, i;
4706 /* Perform the Garbage Collection if needed. */
4707 Jim_CollectIfNeeded(interp);
4709 refPtr = Jim_Alloc(sizeof(*refPtr));
4710 refPtr->objPtr = objPtr;
4711 Jim_IncrRefCount(objPtr);
4712 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4713 if (cmdNamePtr)
4714 Jim_IncrRefCount(cmdNamePtr);
4715 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4716 refObjPtr = Jim_NewObj(interp);
4717 refObjPtr->typePtr = &referenceObjType;
4718 refObjPtr->bytes = NULL;
4719 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4720 refObjPtr->internalRep.refValue.refPtr = refPtr;
4721 interp->referenceNextId++;
4722 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
4723 * that does not pass the 'isrefchar' test is replaced with '_' */
4724 tag = Jim_GetString(tagPtr, &tagLen);
4725 if (tagLen > JIM_REFERENCE_TAGLEN)
4726 tagLen = JIM_REFERENCE_TAGLEN;
4727 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4728 if (i < tagLen && isrefchar(tag[i]))
4729 refPtr->tag[i] = tag[i];
4730 else
4731 refPtr->tag[i] = '_';
4733 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4734 return refObjPtr;
4737 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4739 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4740 return NULL;
4741 return objPtr->internalRep.refValue.refPtr;
4744 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4746 Jim_Reference *refPtr;
4748 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4749 return JIM_ERR;
4750 Jim_IncrRefCount(cmdNamePtr);
4751 if (refPtr->finalizerCmdNamePtr)
4752 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4753 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4754 return JIM_OK;
4757 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4759 Jim_Reference *refPtr;
4761 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4762 return JIM_ERR;
4763 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4764 return JIM_OK;
4767 /* -----------------------------------------------------------------------------
4768 * References Garbage Collection
4769 * ---------------------------------------------------------------------------*/
4771 /* This the hash table type for the "MARK" phase of the GC */
4772 static const Jim_HashTableType JimRefMarkHashTableType = {
4773 JimReferencesHTHashFunction, /* hash function */
4774 JimReferencesHTKeyDup, /* key dup */
4775 NULL, /* val dup */
4776 JimReferencesHTKeyCompare, /* key compare */
4777 JimReferencesHTKeyDestructor, /* key destructor */
4778 NULL /* val destructor */
4781 /* Performs the garbage collection. */
4782 int Jim_Collect(Jim_Interp *interp)
4784 Jim_HashTable marks;
4785 Jim_HashTableIterator *htiter;
4786 Jim_HashEntry *he;
4787 Jim_Obj *objPtr;
4788 int collected = 0;
4790 /* Avoid recursive calls */
4791 if (interp->lastCollectId == -1) {
4792 /* Jim_Collect() already running. Return just now. */
4793 return 0;
4795 interp->lastCollectId = -1;
4797 /* Mark all the references found into the 'mark' hash table.
4798 * The references are searched in every live object that
4799 * is of a type that can contain references. */
4800 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4801 objPtr = interp->liveList;
4802 while (objPtr) {
4803 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4804 const char *str, *p;
4805 int len;
4807 /* If the object is of type reference, to get the
4808 * Id is simple... */
4809 if (objPtr->typePtr == &referenceObjType) {
4810 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
4811 #ifdef JIM_DEBUG_GC
4812 printf("MARK (reference): %d refcount: %d" JIM_NL,
4813 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
4814 #endif
4815 objPtr = objPtr->nextObjPtr;
4816 continue;
4818 /* Get the string repr of the object we want
4819 * to scan for references. */
4820 p = str = Jim_GetString(objPtr, &len);
4821 /* Skip objects too little to contain references. */
4822 if (len < JIM_REFERENCE_SPACE) {
4823 objPtr = objPtr->nextObjPtr;
4824 continue;
4826 /* Extract references from the object string repr. */
4827 while (1) {
4828 int i;
4829 jim_wide id;
4830 char buf[21];
4832 if ((p = strstr(p, "<reference.<")) == NULL)
4833 break;
4834 /* Check if it's a valid reference. */
4835 if (len - (p - str) < JIM_REFERENCE_SPACE)
4836 break;
4837 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
4838 break;
4839 for (i = 21; i <= 40; i++)
4840 if (!isdigit(UCHAR(p[i])))
4841 break;
4842 /* Get the ID */
4843 memcpy(buf, p + 21, 20);
4844 buf[20] = '\0';
4845 Jim_StringToWide(buf, &id, 10);
4847 /* Ok, a reference for the given ID
4848 * was found. Mark it. */
4849 Jim_AddHashEntry(&marks, &id, NULL);
4850 #ifdef JIM_DEBUG_GC
4851 printf("MARK: %d" JIM_NL, (int)id);
4852 #endif
4853 p += JIM_REFERENCE_SPACE;
4856 objPtr = objPtr->nextObjPtr;
4859 /* Run the references hash table to destroy every reference that
4860 * is not referenced outside (not present in the mark HT). */
4861 htiter = Jim_GetHashTableIterator(&interp->references);
4862 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4863 const jim_wide *refId;
4864 Jim_Reference *refPtr;
4866 refId = he->key;
4867 /* Check if in the mark phase we encountered
4868 * this reference. */
4869 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4870 #ifdef JIM_DEBUG_GC
4871 printf("COLLECTING %d" JIM_NL, (int)*refId);
4872 #endif
4873 collected++;
4874 /* Drop the reference, but call the
4875 * finalizer first if registered. */
4876 refPtr = he->u.val;
4877 if (refPtr->finalizerCmdNamePtr) {
4878 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4879 Jim_Obj *objv[3], *oldResult;
4881 JimFormatReference(refstr, refPtr, *refId);
4883 objv[0] = refPtr->finalizerCmdNamePtr;
4884 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, 32);
4885 objv[2] = refPtr->objPtr;
4886 Jim_IncrRefCount(objv[0]);
4887 Jim_IncrRefCount(objv[1]);
4888 Jim_IncrRefCount(objv[2]);
4890 /* Drop the reference itself */
4891 Jim_DeleteHashEntry(&interp->references, refId);
4893 /* Call the finalizer. Errors ignored. */
4894 oldResult = interp->result;
4895 Jim_IncrRefCount(oldResult);
4896 Jim_EvalObjVector(interp, 3, objv);
4897 Jim_SetResult(interp, oldResult);
4898 Jim_DecrRefCount(interp, oldResult);
4900 Jim_DecrRefCount(interp, objv[0]);
4901 Jim_DecrRefCount(interp, objv[1]);
4902 Jim_DecrRefCount(interp, objv[2]);
4904 else {
4905 Jim_DeleteHashEntry(&interp->references, refId);
4909 Jim_FreeHashTableIterator(htiter);
4910 Jim_FreeHashTable(&marks);
4911 interp->lastCollectId = interp->referenceNextId;
4912 interp->lastCollectTime = time(NULL);
4913 return collected;
4916 #define JIM_COLLECT_ID_PERIOD 5000
4917 #define JIM_COLLECT_TIME_PERIOD 300
4919 void Jim_CollectIfNeeded(Jim_Interp *interp)
4921 jim_wide elapsedId;
4922 int elapsedTime;
4924 elapsedId = interp->referenceNextId - interp->lastCollectId;
4925 elapsedTime = time(NULL) - interp->lastCollectTime;
4928 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4929 Jim_Collect(interp);
4932 #endif
4934 static int JimIsBigEndian(void)
4936 union {
4937 unsigned short s;
4938 unsigned char c[2];
4939 } uval = {0x0102};
4941 return uval.c[0] == 1;
4944 /* -----------------------------------------------------------------------------
4945 * Interpreter related functions
4946 * ---------------------------------------------------------------------------*/
4948 Jim_Interp *Jim_CreateInterp(void)
4950 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4952 memset(i, 0, sizeof(*i));
4954 i->errorFileName = Jim_StrDup("");
4955 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4956 i->lastCollectTime = time(NULL);
4958 /* Note that we can create objects only after the
4959 * interpreter liveList and freeList pointers are
4960 * initialized to NULL. */
4961 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4962 #ifdef JIM_REFERENCES
4963 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4964 #endif
4965 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType, NULL);
4966 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4967 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4968 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL);
4969 i->emptyObj = Jim_NewEmptyStringObj(i);
4970 i->trueObj = Jim_NewIntObj(i, 1);
4971 i->falseObj = Jim_NewIntObj(i, 0);
4972 i->result = i->emptyObj;
4973 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4974 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4975 i->errorProc = i->emptyObj;
4976 i->currentScriptObj = Jim_NewEmptyStringObj(i);
4977 Jim_IncrRefCount(i->emptyObj);
4978 Jim_IncrRefCount(i->result);
4979 Jim_IncrRefCount(i->stackTrace);
4980 Jim_IncrRefCount(i->unknown);
4981 Jim_IncrRefCount(i->currentScriptObj);
4982 Jim_IncrRefCount(i->errorProc);
4983 Jim_IncrRefCount(i->trueObj);
4984 Jim_IncrRefCount(i->falseObj);
4986 /* Initialize key variables every interpreter should contain */
4987 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
4988 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
4990 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
4991 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
4992 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
4993 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
4994 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
4995 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
4996 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
4998 return i;
5001 void Jim_FreeInterp(Jim_Interp *i)
5003 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5004 Jim_Obj *objPtr, *nextObjPtr;
5006 Jim_DecrRefCount(i, i->emptyObj);
5007 Jim_DecrRefCount(i, i->trueObj);
5008 Jim_DecrRefCount(i, i->falseObj);
5009 Jim_DecrRefCount(i, i->result);
5010 Jim_DecrRefCount(i, i->stackTrace);
5011 Jim_DecrRefCount(i, i->errorProc);
5012 Jim_DecrRefCount(i, i->unknown);
5013 Jim_Free((void *)i->errorFileName);
5014 Jim_DecrRefCount(i, i->currentScriptObj);
5015 Jim_FreeHashTable(&i->commands);
5016 #ifdef JIM_REFERENCES
5017 Jim_FreeHashTable(&i->references);
5018 #endif
5019 Jim_FreeHashTable(&i->packages);
5020 Jim_Free(i->prngState);
5021 Jim_FreeHashTable(&i->assocData);
5022 JimDeleteLocalProcs(i);
5024 /* Free the call frames list */
5025 while (cf) {
5026 prevcf = cf->parentCallFrame;
5027 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5028 cf = prevcf;
5030 /* Check that the live object list is empty, otherwise
5031 * there is a memory leak. */
5032 if (i->liveList != NULL) {
5033 objPtr = i->liveList;
5035 printf(JIM_NL "-------------------------------------" JIM_NL);
5036 printf("Objects still in the free list:" JIM_NL);
5037 while (objPtr) {
5038 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5040 printf("%p (%d) %-10s: '%.20s'" JIM_NL,
5041 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5042 if (objPtr->typePtr == &sourceObjType) {
5043 printf("FILE %s LINE %d" JIM_NL,
5044 objPtr->internalRep.sourceValue.fileName,
5045 objPtr->internalRep.sourceValue.lineNumber);
5047 objPtr = objPtr->nextObjPtr;
5049 printf("-------------------------------------" JIM_NL JIM_NL);
5050 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5052 /* Free all the freed objects. */
5053 objPtr = i->freeList;
5054 while (objPtr) {
5055 nextObjPtr = objPtr->nextObjPtr;
5056 Jim_Free(objPtr);
5057 objPtr = nextObjPtr;
5059 /* Free cached CallFrame structures */
5060 cf = i->freeFramesList;
5061 while (cf) {
5062 nextcf = cf->nextFramePtr;
5063 if (cf->vars.table != NULL)
5064 Jim_Free(cf->vars.table);
5065 Jim_Free(cf);
5066 cf = nextcf;
5068 #ifdef jim_ext_load
5069 Jim_FreeLoadHandles(i);
5070 #endif
5072 /* Free the sharedString hash table. Make sure to free it
5073 * after every other Jim_Object was freed. */
5074 Jim_FreeHashTable(&i->sharedStrings);
5075 /* Free the interpreter structure. */
5076 Jim_Free(i);
5079 /* Returns the call frame relative to the level represented by
5080 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5082 * This function accepts the 'level' argument in the form
5083 * of the commands [uplevel] and [upvar].
5085 * For a function accepting a relative integer as level suitable
5086 * for implementation of [info level ?level?] check the
5087 * JimGetCallFrameByInteger() function.
5089 * Returns NULL on error.
5091 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5093 long level;
5094 const char *str;
5095 Jim_CallFrame *framePtr;
5097 if (levelObjPtr) {
5098 str = Jim_String(levelObjPtr);
5099 if (str[0] == '#') {
5100 char *endptr;
5102 level = strtol(str + 1, &endptr, 0);
5103 if (str[1] == '\0' || endptr[0] != '\0') {
5104 level = -1;
5107 else {
5108 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5109 level = -1;
5111 else {
5112 /* Convert from a relative to an absolute level */
5113 level = interp->framePtr->level - level;
5117 else {
5118 str = "1"; /* Needed to format the error message. */
5119 level = interp->framePtr->level - 1;
5122 if (level == 0) {
5123 return interp->topFramePtr;
5125 if (level > 0) {
5126 /* Lookup */
5127 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parentCallFrame) {
5128 if (framePtr->level == level) {
5129 return framePtr;
5134 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5135 return NULL;
5138 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5139 * as a relative integer like in the [info level ?level?] command.
5141 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5143 long level;
5144 Jim_CallFrame *framePtr;
5146 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5147 if (level <= 0) {
5148 /* Convert from a relative to an absolute level */
5149 level = interp->framePtr->level + level;
5152 if (level == 0) {
5153 return interp->topFramePtr;
5156 /* Lookup */
5157 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parentCallFrame) {
5158 if (framePtr->level == level) {
5159 return framePtr;
5164 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5165 return NULL;
5168 static void JimSetErrorFileName(Jim_Interp *interp, const char *filename)
5170 Jim_Free((void *)interp->errorFileName);
5171 interp->errorFileName = Jim_StrDup(filename);
5174 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
5176 interp->errorLine = linenr;
5179 static void JimResetStackTrace(Jim_Interp *interp)
5181 Jim_DecrRefCount(interp, interp->stackTrace);
5182 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5183 Jim_IncrRefCount(interp->stackTrace);
5186 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5188 int len;
5190 /* Increment reference first in case these are the same object */
5191 Jim_IncrRefCount(stackTraceObj);
5192 Jim_DecrRefCount(interp, interp->stackTrace);
5193 interp->stackTrace = stackTraceObj;
5194 interp->errorFlag = 1;
5196 /* This is a bit ugly.
5197 * If the filename of the last entry of the stack trace is empty,
5198 * the next stack level should be added.
5200 len = Jim_ListLength(interp, interp->stackTrace);
5201 if (len >= 3) {
5202 Jim_Obj *filenameObj;
5204 Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj, JIM_NONE);
5206 Jim_GetString(filenameObj, &len);
5208 if (len == 0) {
5209 interp->addStackTrace = 1;
5214 /* Returns 1 if the stack trace information was used or 0 if not */
5215 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5216 const char *filename, int linenr)
5218 if (strcmp(procname, "unknown") == 0) {
5219 procname = "";
5221 if (!*procname && !*filename) {
5222 /* No useful info here */
5223 return;
5226 if (Jim_IsShared(interp->stackTrace)) {
5227 Jim_DecrRefCount(interp, interp->stackTrace);
5228 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5229 Jim_IncrRefCount(interp->stackTrace);
5232 /* If we have no procname but the previous element did, merge with that frame */
5233 if (!*procname && *filename) {
5234 /* Just a filename. Check the previous entry */
5235 int len = Jim_ListLength(interp, interp->stackTrace);
5237 if (len >= 3) {
5238 Jim_Obj *procnameObj;
5239 Jim_Obj *filenameObj;
5241 if (Jim_ListIndex(interp, interp->stackTrace, len - 3, &procnameObj, JIM_NONE) == JIM_OK
5242 && Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj,
5243 JIM_NONE) == JIM_OK) {
5245 const char *prev_procname = Jim_String(procnameObj);
5246 const char *prev_filename = Jim_String(filenameObj);
5248 if (*prev_procname && !*prev_filename) {
5249 ListSetIndex(interp, interp->stackTrace, len - 2, Jim_NewStringObj(interp,
5250 filename, -1), 0);
5251 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr),
5253 return;
5259 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5260 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, filename, -1));
5261 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5264 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5265 void *data)
5267 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5269 assocEntryPtr->delProc = delProc;
5270 assocEntryPtr->data = data;
5271 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5274 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5276 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5278 if (entryPtr != NULL) {
5279 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5281 return assocEntryPtr->data;
5283 return NULL;
5286 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5288 return Jim_DeleteHashEntry(&interp->assocData, key);
5291 int Jim_GetExitCode(Jim_Interp *interp)
5293 return interp->exitCode;
5296 /* -----------------------------------------------------------------------------
5297 * Shared strings.
5298 * Every interpreter has an hash table where to put shared dynamically
5299 * allocate strings that are likely to be used a lot of times.
5300 * For example, in the 'source' object type, there is a pointer to
5301 * the filename associated with that object. Every script has a lot
5302 * of this objects with the identical file name, so it is wise to share
5303 * this info.
5305 * The API is trivial: Jim_GetSharedString(interp, "foobar")
5306 * returns the pointer to the shared string. Every time a reference
5307 * to the string is no longer used, the user should call
5308 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
5309 * a given string, it is removed from the hash table.
5310 * ---------------------------------------------------------------------------*/
5311 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
5313 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
5315 if (he == NULL) {
5316 char *strCopy = Jim_StrDup(str);
5318 Jim_AddHashEntry(&interp->sharedStrings, strCopy, NULL);
5319 he = Jim_FindHashEntry(&interp->sharedStrings, strCopy);
5320 he->u.intval = 1;
5321 return strCopy;
5323 else {
5324 he->u.intval++;
5325 return he->key;
5329 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
5331 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
5333 JimPanic((he == NULL, "Jim_ReleaseSharedString called with " "unknown shared string '%s'", str));
5335 if (--he->u.intval == 0) {
5336 Jim_DeleteHashEntry(&interp->sharedStrings, str);
5340 /* -----------------------------------------------------------------------------
5341 * Integer object
5342 * ---------------------------------------------------------------------------*/
5343 #define JIM_INTEGER_SPACE 24
5345 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5346 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5348 static const Jim_ObjType intObjType = {
5349 "int",
5350 NULL,
5351 NULL,
5352 UpdateStringOfInt,
5353 JIM_TYPE_NONE,
5356 /* A coerced double is closer to an int than a double.
5357 * It is an int value temporarily masquerading as a double value.
5358 * i.e. it has the same string value as an int and Jim_GetWide()
5359 * succeeds, but also Jim_GetDouble() returns the value directly.
5361 static const Jim_ObjType coercedDoubleObjType = {
5362 "coerced-double",
5363 NULL,
5364 NULL,
5365 UpdateStringOfInt,
5366 JIM_TYPE_NONE,
5370 void UpdateStringOfInt(struct Jim_Obj *objPtr)
5372 int len;
5373 char buf[JIM_INTEGER_SPACE + 1];
5375 len = Jim_WideToString(buf, JimWideValue(objPtr));
5376 objPtr->bytes = Jim_Alloc(len + 1);
5377 memcpy(objPtr->bytes, buf, len + 1);
5378 objPtr->length = len;
5381 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5383 jim_wide wideValue;
5384 const char *str;
5386 if (objPtr->typePtr == &coercedDoubleObjType) {
5387 /* Simple switcheroo */
5388 objPtr->typePtr = &intObjType;
5389 return JIM_OK;
5392 /* Get the string representation */
5393 str = Jim_String(objPtr);
5394 /* Try to convert into a jim_wide */
5395 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5396 if (flags & JIM_ERRMSG) {
5397 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5399 return JIM_ERR;
5401 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5402 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5403 return JIM_ERR;
5405 /* Free the old internal repr and set the new one. */
5406 Jim_FreeIntRep(interp, objPtr);
5407 objPtr->typePtr = &intObjType;
5408 objPtr->internalRep.wideValue = wideValue;
5409 return JIM_OK;
5412 #ifdef JIM_OPTIMIZATION
5413 static int JimIsWide(Jim_Obj *objPtr)
5415 return objPtr->typePtr == &intObjType;
5417 #endif
5419 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5421 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5422 return JIM_ERR;
5423 *widePtr = JimWideValue(objPtr);
5424 return JIM_OK;
5427 /* Get a wide but does not set an error if the format is bad. */
5428 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5430 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5431 return JIM_ERR;
5432 *widePtr = JimWideValue(objPtr);
5433 return JIM_OK;
5436 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5438 jim_wide wideValue;
5439 int retval;
5441 retval = Jim_GetWide(interp, objPtr, &wideValue);
5442 if (retval == JIM_OK) {
5443 *longPtr = (long)wideValue;
5444 return JIM_OK;
5446 return JIM_ERR;
5449 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5451 Jim_Obj *objPtr;
5453 objPtr = Jim_NewObj(interp);
5454 objPtr->typePtr = &intObjType;
5455 objPtr->bytes = NULL;
5456 objPtr->internalRep.wideValue = wideValue;
5457 return objPtr;
5460 /* -----------------------------------------------------------------------------
5461 * Double object
5462 * ---------------------------------------------------------------------------*/
5463 #define JIM_DOUBLE_SPACE 30
5465 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5466 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5468 static const Jim_ObjType doubleObjType = {
5469 "double",
5470 NULL,
5471 NULL,
5472 UpdateStringOfDouble,
5473 JIM_TYPE_NONE,
5476 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5478 int len;
5479 char buf[JIM_DOUBLE_SPACE + 1];
5481 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
5482 objPtr->bytes = Jim_Alloc(len + 1);
5483 memcpy(objPtr->bytes, buf, len + 1);
5484 objPtr->length = len;
5487 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5489 double doubleValue;
5490 jim_wide wideValue;
5491 const char *str;
5493 /* Preserve the string representation.
5494 * Needed so we can convert back to int without loss
5496 str = Jim_String(objPtr);
5498 #ifdef HAVE_LONG_LONG
5499 /* Assume a 53 bit mantissa */
5500 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5501 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5503 if (objPtr->typePtr == &intObjType
5504 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5505 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5507 /* Direct conversion to coerced double */
5508 objPtr->typePtr = &coercedDoubleObjType;
5509 return JIM_OK;
5511 else
5512 #endif
5513 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5514 /* Managed to convert to an int, so we can use this as a cooerced double */
5515 Jim_FreeIntRep(interp, objPtr);
5516 objPtr->typePtr = &coercedDoubleObjType;
5517 objPtr->internalRep.wideValue = wideValue;
5518 return JIM_OK;
5520 else {
5521 /* Try to convert into a double */
5522 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5523 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5524 return JIM_ERR;
5526 /* Free the old internal repr and set the new one. */
5527 Jim_FreeIntRep(interp, objPtr);
5529 objPtr->typePtr = &doubleObjType;
5530 objPtr->internalRep.doubleValue = doubleValue;
5531 return JIM_OK;
5534 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5536 if (objPtr->typePtr == &coercedDoubleObjType) {
5537 *doublePtr = JimWideValue(objPtr);
5538 return JIM_OK;
5540 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5541 return JIM_ERR;
5543 if (objPtr->typePtr == &coercedDoubleObjType) {
5544 *doublePtr = JimWideValue(objPtr);
5546 else {
5547 *doublePtr = objPtr->internalRep.doubleValue;
5549 return JIM_OK;
5552 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5554 Jim_Obj *objPtr;
5556 objPtr = Jim_NewObj(interp);
5557 objPtr->typePtr = &doubleObjType;
5558 objPtr->bytes = NULL;
5559 objPtr->internalRep.doubleValue = doubleValue;
5560 return objPtr;
5563 /* -----------------------------------------------------------------------------
5564 * List object
5565 * ---------------------------------------------------------------------------*/
5566 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5567 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5568 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5569 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5570 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5572 /* Note that while the elements of the list may contain references,
5573 * the list object itself can't. This basically means that the
5574 * list object string representation as a whole can't contain references
5575 * that are not presents in the single elements. */
5576 static const Jim_ObjType listObjType = {
5577 "list",
5578 FreeListInternalRep,
5579 DupListInternalRep,
5580 UpdateStringOfList,
5581 JIM_TYPE_NONE,
5584 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5586 int i;
5588 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5589 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5591 Jim_Free(objPtr->internalRep.listValue.ele);
5594 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5596 int i;
5598 JIM_NOTUSED(interp);
5600 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5601 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5602 dupPtr->internalRep.listValue.ele =
5603 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
5604 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5605 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
5606 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5607 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5609 dupPtr->typePtr = &listObjType;
5612 /* The following function checks if a given string can be encoded
5613 * into a list element without any kind of quoting, surrounded by braces,
5614 * or using escapes to quote. */
5615 #define JIM_ELESTR_SIMPLE 0
5616 #define JIM_ELESTR_BRACE 1
5617 #define JIM_ELESTR_QUOTE 2
5618 static int ListElementQuotingType(const char *s, int len)
5620 int i, level, blevel, trySimple = 1;
5622 /* Try with the SIMPLE case */
5623 if (len == 0)
5624 return JIM_ELESTR_BRACE;
5625 if (s[0] == '#')
5626 return JIM_ELESTR_BRACE;
5627 if (s[0] == '"' || s[0] == '{') {
5628 trySimple = 0;
5629 goto testbrace;
5631 for (i = 0; i < len; i++) {
5632 switch (s[i]) {
5633 case ' ':
5634 case '$':
5635 case '"':
5636 case '[':
5637 case ']':
5638 case ';':
5639 case '\\':
5640 case '\r':
5641 case '\n':
5642 case '\t':
5643 case '\f':
5644 case '\v':
5645 trySimple = 0;
5646 case '{':
5647 case '}':
5648 goto testbrace;
5651 return JIM_ELESTR_SIMPLE;
5653 testbrace:
5654 /* Test if it's possible to do with braces */
5655 if (s[len - 1] == '\\')
5656 return JIM_ELESTR_QUOTE;
5657 level = 0;
5658 blevel = 0;
5659 for (i = 0; i < len; i++) {
5660 switch (s[i]) {
5661 case '{':
5662 level++;
5663 break;
5664 case '}':
5665 level--;
5666 if (level < 0)
5667 return JIM_ELESTR_QUOTE;
5668 break;
5669 case '[':
5670 blevel++;
5671 break;
5672 case ']':
5673 blevel--;
5674 break;
5675 case '\\':
5676 if (s[i + 1] == '\n')
5677 return JIM_ELESTR_QUOTE;
5678 else if (s[i + 1] != '\0')
5679 i++;
5680 break;
5683 if (blevel < 0) {
5684 return JIM_ELESTR_QUOTE;
5687 if (level == 0) {
5688 if (!trySimple)
5689 return JIM_ELESTR_BRACE;
5690 for (i = 0; i < len; i++) {
5691 switch (s[i]) {
5692 case ' ':
5693 case '$':
5694 case '"':
5695 case '[':
5696 case ']':
5697 case ';':
5698 case '\\':
5699 case '\r':
5700 case '\n':
5701 case '\t':
5702 case '\f':
5703 case '\v':
5704 return JIM_ELESTR_BRACE;
5705 break;
5708 return JIM_ELESTR_SIMPLE;
5710 return JIM_ELESTR_QUOTE;
5713 /* Returns the malloc-ed representation of a string
5714 * using backslash to quote special chars. */
5715 static char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5717 char *q = Jim_Alloc(len * 2 + 1), *p;
5719 p = q;
5720 while (*s) {
5721 switch (*s) {
5722 case ' ':
5723 case '$':
5724 case '"':
5725 case '[':
5726 case ']':
5727 case '{':
5728 case '}':
5729 case ';':
5730 case '\\':
5731 *p++ = '\\';
5732 *p++ = *s++;
5733 break;
5734 case '\n':
5735 *p++ = '\\';
5736 *p++ = 'n';
5737 s++;
5738 break;
5739 case '\r':
5740 *p++ = '\\';
5741 *p++ = 'r';
5742 s++;
5743 break;
5744 case '\t':
5745 *p++ = '\\';
5746 *p++ = 't';
5747 s++;
5748 break;
5749 case '\f':
5750 *p++ = '\\';
5751 *p++ = 'f';
5752 s++;
5753 break;
5754 case '\v':
5755 *p++ = '\\';
5756 *p++ = 'v';
5757 s++;
5758 break;
5759 default:
5760 *p++ = *s++;
5761 break;
5764 *p = '\0';
5765 *qlenPtr = p - q;
5766 return q;
5769 static void UpdateStringOfList(struct Jim_Obj *objPtr)
5771 int i, bufLen, realLength;
5772 const char *strRep;
5773 char *p;
5774 int *quotingType;
5775 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5777 /* (Over) Estimate the space needed. */
5778 quotingType = Jim_Alloc(sizeof(int) * objPtr->internalRep.listValue.len + 1);
5779 bufLen = 0;
5780 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5781 int len;
5783 strRep = Jim_GetString(ele[i], &len);
5784 quotingType[i] = ListElementQuotingType(strRep, len);
5785 switch (quotingType[i]) {
5786 case JIM_ELESTR_SIMPLE:
5787 bufLen += len;
5788 break;
5789 case JIM_ELESTR_BRACE:
5790 bufLen += len + 2;
5791 break;
5792 case JIM_ELESTR_QUOTE:
5793 bufLen += len * 2;
5794 break;
5796 bufLen++; /* elements separator. */
5798 bufLen++;
5800 /* Generate the string rep. */
5801 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5802 realLength = 0;
5803 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5804 int len, qlen;
5805 char *q;
5807 strRep = Jim_GetString(ele[i], &len);
5809 switch (quotingType[i]) {
5810 case JIM_ELESTR_SIMPLE:
5811 memcpy(p, strRep, len);
5812 p += len;
5813 realLength += len;
5814 break;
5815 case JIM_ELESTR_BRACE:
5816 *p++ = '{';
5817 memcpy(p, strRep, len);
5818 p += len;
5819 *p++ = '}';
5820 realLength += len + 2;
5821 break;
5822 case JIM_ELESTR_QUOTE:
5823 q = BackslashQuoteString(strRep, len, &qlen);
5824 memcpy(p, q, qlen);
5825 Jim_Free(q);
5826 p += qlen;
5827 realLength += qlen;
5828 break;
5830 /* Add a separating space */
5831 if (i + 1 != objPtr->internalRep.listValue.len) {
5832 *p++ = ' ';
5833 realLength++;
5836 *p = '\0'; /* nul term. */
5837 objPtr->length = realLength;
5838 Jim_Free(quotingType);
5841 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5843 struct JimParserCtx parser;
5844 const char *str;
5845 int strLen;
5846 const char *filename = NULL;
5847 int linenr = 1;
5849 /* Try to preserve information about filename / line number */
5850 if (objPtr->typePtr == &sourceObjType) {
5851 filename = Jim_GetSharedString(interp, objPtr->internalRep.sourceValue.fileName);
5852 linenr = objPtr->internalRep.sourceValue.lineNumber;
5855 /* Get the string representation */
5856 str = Jim_GetString(objPtr, &strLen);
5858 /* Free the old internal repr just now and initialize the
5859 * new one just now. The string->list conversion can't fail. */
5860 Jim_FreeIntRep(interp, objPtr);
5861 objPtr->typePtr = &listObjType;
5862 objPtr->internalRep.listValue.len = 0;
5863 objPtr->internalRep.listValue.maxLen = 0;
5864 objPtr->internalRep.listValue.ele = NULL;
5866 /* Convert into a list */
5867 JimParserInit(&parser, str, strLen, linenr);
5868 while (!parser.eof) {
5869 Jim_Obj *elementPtr;
5871 JimParseList(&parser);
5872 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
5873 continue;
5874 elementPtr = JimParserGetTokenObj(interp, &parser);
5875 JimSetSourceInfo(interp, elementPtr, filename, parser.tline);
5876 ListAppendElement(objPtr, elementPtr);
5878 if (filename) {
5879 Jim_ReleaseSharedString(interp, filename);
5881 return JIM_OK;
5884 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5886 Jim_Obj *objPtr;
5887 int i;
5889 objPtr = Jim_NewObj(interp);
5890 objPtr->typePtr = &listObjType;
5891 objPtr->bytes = NULL;
5892 objPtr->internalRep.listValue.ele = NULL;
5893 objPtr->internalRep.listValue.len = 0;
5894 objPtr->internalRep.listValue.maxLen = 0;
5895 for (i = 0; i < len; i++) {
5896 ListAppendElement(objPtr, elements[i]);
5898 return objPtr;
5901 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5902 * length of the vector. Note that the user of this function should make
5903 * sure that the list object can't shimmer while the vector returned
5904 * is in use, this vector is the one stored inside the internal representation
5905 * of the list object. This function is not exported, extensions should
5906 * always access to the List object elements using Jim_ListIndex(). */
5907 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
5908 Jim_Obj ***listVec)
5910 *listLen = Jim_ListLength(interp, listObj);
5911 *listVec = listObj->internalRep.listValue.ele;
5914 /* Sorting uses ints, but commands may return wide */
5915 static int JimSign(jim_wide w)
5917 if (w == 0) {
5918 return 0;
5920 else if (w < 0) {
5921 return -1;
5923 return 1;
5926 /* ListSortElements type values */
5927 struct lsort_info {
5928 jmp_buf jmpbuf;
5929 Jim_Obj *command;
5930 Jim_Interp *interp;
5931 enum {
5932 JIM_LSORT_ASCII,
5933 JIM_LSORT_NOCASE,
5934 JIM_LSORT_INTEGER,
5935 JIM_LSORT_COMMAND
5936 } type;
5937 int order;
5938 int index;
5939 int indexed;
5940 int (*subfn)(Jim_Obj **, Jim_Obj **);
5943 static struct lsort_info *sort_info;
5945 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5947 Jim_Obj *lObj, *rObj;
5949 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
5950 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
5951 longjmp(sort_info->jmpbuf, JIM_ERR);
5953 return sort_info->subfn(&lObj, &rObj);
5956 /* Sort the internal rep of a list. */
5957 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5959 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
5962 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5964 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
5967 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5969 jim_wide lhs = 0, rhs = 0;
5971 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
5972 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
5973 longjmp(sort_info->jmpbuf, JIM_ERR);
5976 return JimSign(lhs - rhs) * sort_info->order;
5979 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5981 Jim_Obj *compare_script;
5982 int rc;
5984 jim_wide ret = 0;
5986 /* This must be a valid list */
5987 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
5988 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
5989 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
5991 rc = Jim_EvalObj(sort_info->interp, compare_script);
5993 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
5994 longjmp(sort_info->jmpbuf, rc);
5997 return JimSign(ret) * sort_info->order;
6000 /* Sort a list *in place*. MUST be called with non-shared objects. */
6001 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6003 struct lsort_info *prev_info;
6005 typedef int (qsort_comparator) (const void *, const void *);
6006 int (*fn) (Jim_Obj **, Jim_Obj **);
6007 Jim_Obj **vector;
6008 int len;
6009 int rc;
6011 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6012 if (!Jim_IsList(listObjPtr))
6013 SetListFromAny(interp, listObjPtr);
6015 /* Allow lsort to be called reentrantly */
6016 prev_info = sort_info;
6017 sort_info = info;
6019 vector = listObjPtr->internalRep.listValue.ele;
6020 len = listObjPtr->internalRep.listValue.len;
6021 switch (info->type) {
6022 case JIM_LSORT_ASCII:
6023 fn = ListSortString;
6024 break;
6025 case JIM_LSORT_NOCASE:
6026 fn = ListSortStringNoCase;
6027 break;
6028 case JIM_LSORT_INTEGER:
6029 fn = ListSortInteger;
6030 break;
6031 case JIM_LSORT_COMMAND:
6032 fn = ListSortCommand;
6033 break;
6034 default:
6035 fn = NULL; /* avoid warning */
6036 JimPanic((1, "ListSort called with invalid sort type"));
6039 if (info->indexed) {
6040 /* Need to interpose a "list index" function */
6041 info->subfn = fn;
6042 fn = ListSortIndexHelper;
6045 if ((rc = setjmp(info->jmpbuf)) == 0) {
6046 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6048 Jim_InvalidateStringRep(listObjPtr);
6049 sort_info = prev_info;
6051 return rc;
6054 /* This is the low-level function to insert elements into a list.
6055 * The higher-level Jim_ListInsertElements() performs shared object
6056 * check and invalidate the string repr. This version is used
6057 * in the internals of the List Object and is not exported.
6059 * NOTE: this function can be called only against objects
6060 * with internal type of List. */
6061 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6063 int currentLen = listPtr->internalRep.listValue.len;
6064 int requiredLen = currentLen + elemc;
6065 int i;
6066 Jim_Obj **point;
6068 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6069 int maxLen = requiredLen * 2;
6071 listPtr->internalRep.listValue.ele =
6072 Jim_Realloc(listPtr->internalRep.listValue.ele, sizeof(Jim_Obj *) * maxLen);
6073 listPtr->internalRep.listValue.maxLen = maxLen;
6075 point = listPtr->internalRep.listValue.ele + idx;
6076 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6077 for (i = 0; i < elemc; ++i) {
6078 point[i] = elemVec[i];
6079 Jim_IncrRefCount(point[i]);
6081 listPtr->internalRep.listValue.len += elemc;
6084 /* Convenience call to ListInsertElements() to append a single element.
6086 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6088 ListInsertElements(listPtr, listPtr->internalRep.listValue.len, 1, &objPtr);
6092 /* Appends every element of appendListPtr into listPtr.
6093 * Both have to be of the list type.
6094 * Convenience call to ListInsertElements()
6096 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6098 ListInsertElements(listPtr, listPtr->internalRep.listValue.len,
6099 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6102 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6104 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6105 if (!Jim_IsList(listPtr))
6106 SetListFromAny(interp, listPtr);
6107 Jim_InvalidateStringRep(listPtr);
6108 ListAppendElement(listPtr, objPtr);
6111 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6113 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6114 if (!Jim_IsList(listPtr))
6115 SetListFromAny(interp, listPtr);
6116 Jim_InvalidateStringRep(listPtr);
6117 ListAppendList(listPtr, appendListPtr);
6120 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6122 if (!Jim_IsList(objPtr))
6123 SetListFromAny(interp, objPtr);
6124 return objPtr->internalRep.listValue.len;
6127 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6128 int objc, Jim_Obj *const *objVec)
6130 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6131 if (!Jim_IsList(listPtr))
6132 SetListFromAny(interp, listPtr);
6133 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6134 idx = listPtr->internalRep.listValue.len;
6135 else if (idx < 0)
6136 idx = 0;
6137 Jim_InvalidateStringRep(listPtr);
6138 ListInsertElements(listPtr, idx, objc, objVec);
6141 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6143 if (!Jim_IsList(listPtr))
6144 SetListFromAny(interp, listPtr);
6145 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6146 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6147 if (flags & JIM_ERRMSG) {
6148 Jim_SetResultString(interp, "list index out of range", -1);
6150 *objPtrPtr = NULL;
6151 return JIM_ERR;
6153 if (idx < 0)
6154 idx = listPtr->internalRep.listValue.len + idx;
6155 *objPtrPtr = listPtr->internalRep.listValue.ele[idx];
6156 return JIM_OK;
6159 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6160 Jim_Obj *newObjPtr, int flags)
6162 if (!Jim_IsList(listPtr))
6163 SetListFromAny(interp, listPtr);
6164 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6165 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6166 if (flags & JIM_ERRMSG) {
6167 Jim_SetResultString(interp, "list index out of range", -1);
6169 return JIM_ERR;
6171 if (idx < 0)
6172 idx = listPtr->internalRep.listValue.len + idx;
6173 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6174 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6175 Jim_IncrRefCount(newObjPtr);
6176 return JIM_OK;
6179 /* Modify the list stored into the variable named 'varNamePtr'
6180 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6181 * with the new element 'newObjptr'. */
6182 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6183 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6185 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6186 int shared, i, idx;
6188 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6189 if (objPtr == NULL)
6190 return JIM_ERR;
6191 if ((shared = Jim_IsShared(objPtr)))
6192 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6193 for (i = 0; i < indexc - 1; i++) {
6194 listObjPtr = objPtr;
6195 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6196 goto err;
6197 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6198 goto err;
6200 if (Jim_IsShared(objPtr)) {
6201 objPtr = Jim_DuplicateObj(interp, objPtr);
6202 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6204 Jim_InvalidateStringRep(listObjPtr);
6206 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6207 goto err;
6208 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6209 goto err;
6210 Jim_InvalidateStringRep(objPtr);
6211 Jim_InvalidateStringRep(varObjPtr);
6212 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6213 goto err;
6214 Jim_SetResult(interp, varObjPtr);
6215 return JIM_OK;
6216 err:
6217 if (shared) {
6218 Jim_FreeNewObj(interp, varObjPtr);
6220 return JIM_ERR;
6223 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6225 int i;
6227 /* If all the objects in objv are lists,
6228 * it's possible to return a list as result, that's the
6229 * concatenation of all the lists. */
6230 for (i = 0; i < objc; i++) {
6231 if (!Jim_IsList(objv[i]))
6232 break;
6234 if (i == objc) {
6235 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6237 for (i = 0; i < objc; i++)
6238 Jim_ListAppendList(interp, objPtr, objv[i]);
6239 return objPtr;
6241 else {
6242 /* Else... we have to glue strings together */
6243 int len = 0, objLen;
6244 char *bytes, *p;
6246 /* Compute the length */
6247 for (i = 0; i < objc; i++) {
6248 Jim_GetString(objv[i], &objLen);
6249 len += objLen;
6251 if (objc)
6252 len += objc - 1;
6253 /* Create the string rep, and a string object holding it. */
6254 p = bytes = Jim_Alloc(len + 1);
6255 for (i = 0; i < objc; i++) {
6256 const char *s = Jim_GetString(objv[i], &objLen);
6258 /* Remove leading space */
6259 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6260 s++;
6261 objLen--;
6262 len--;
6264 /* And trailing space */
6265 while (objLen && (s[objLen - 1] == ' ' ||
6266 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6267 /* Handle trailing backslash-space case */
6268 if (objLen > 1 && s[objLen - 2] == '\\') {
6269 break;
6271 objLen--;
6272 len--;
6274 memcpy(p, s, objLen);
6275 p += objLen;
6276 if (objLen && i + 1 != objc) {
6277 *p++ = ' ';
6279 else if (i + 1 != objc) {
6280 /* Drop the space calcuated for this
6281 * element that is instead null. */
6282 len--;
6285 *p = '\0';
6286 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6290 /* Returns a list composed of the elements in the specified range.
6291 * first and start are directly accepted as Jim_Objects and
6292 * processed for the end?-index? case. */
6293 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6294 Jim_Obj *lastObjPtr)
6296 int first, last;
6297 int len, rangeLen;
6299 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6300 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6301 return NULL;
6302 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6303 first = JimRelToAbsIndex(len, first);
6304 last = JimRelToAbsIndex(len, last);
6305 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
6306 if (first == 0 && last == len) {
6307 return listObjPtr;
6309 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6312 /* -----------------------------------------------------------------------------
6313 * Dict object
6314 * ---------------------------------------------------------------------------*/
6315 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6316 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6317 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6318 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6320 /* Dict HashTable Type.
6322 * Keys and Values are Jim objects. */
6324 static unsigned int JimObjectHTHashFunction(const void *key)
6326 const char *str;
6327 Jim_Obj *objPtr = (Jim_Obj *)key;
6328 int len, h;
6330 str = Jim_GetString(objPtr, &len);
6331 h = Jim_GenHashFunction((unsigned char *)str, len);
6332 return h;
6335 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6337 JIM_NOTUSED(privdata);
6339 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6342 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6344 Jim_Obj *objPtr = val;
6346 Jim_DecrRefCount(interp, objPtr);
6349 static const Jim_HashTableType JimDictHashTableType = {
6350 JimObjectHTHashFunction, /* hash function */
6351 NULL, /* key dup */
6352 NULL, /* val dup */
6353 JimObjectHTKeyCompare, /* key compare */
6354 (void (*)(void *, const void *)) /* ATTENTION: const cast */
6355 JimObjectHTKeyValDestructor, /* key destructor */
6356 JimObjectHTKeyValDestructor /* val destructor */
6359 /* Note that while the elements of the dict may contain references,
6360 * the list object itself can't. This basically means that the
6361 * dict object string representation as a whole can't contain references
6362 * that are not presents in the single elements. */
6363 static const Jim_ObjType dictObjType = {
6364 "dict",
6365 FreeDictInternalRep,
6366 DupDictInternalRep,
6367 UpdateStringOfDict,
6368 JIM_TYPE_NONE,
6371 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6373 JIM_NOTUSED(interp);
6375 Jim_FreeHashTable(objPtr->internalRep.ptr);
6376 Jim_Free(objPtr->internalRep.ptr);
6379 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6381 Jim_HashTable *ht, *dupHt;
6382 Jim_HashTableIterator *htiter;
6383 Jim_HashEntry *he;
6385 /* Create a new hash table */
6386 ht = srcPtr->internalRep.ptr;
6387 dupHt = Jim_Alloc(sizeof(*dupHt));
6388 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6389 if (ht->size != 0)
6390 Jim_ExpandHashTable(dupHt, ht->size);
6391 /* Copy every element from the source to the dup hash table */
6392 htiter = Jim_GetHashTableIterator(ht);
6393 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6394 const Jim_Obj *keyObjPtr = he->key;
6395 Jim_Obj *valObjPtr = he->u.val;
6397 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6398 Jim_IncrRefCount(valObjPtr);
6399 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6401 Jim_FreeHashTableIterator(htiter);
6403 dupPtr->internalRep.ptr = dupHt;
6404 dupPtr->typePtr = &dictObjType;
6407 void UpdateStringOfDict(struct Jim_Obj *objPtr)
6409 int i, bufLen, realLength;
6410 const char *strRep;
6411 char *p;
6412 int *quotingType, objc;
6413 Jim_HashTable *ht;
6414 Jim_HashTableIterator *htiter;
6415 Jim_HashEntry *he;
6416 Jim_Obj **objv;
6418 /* Trun the hash table into a flat vector of Jim_Objects. */
6419 ht = objPtr->internalRep.ptr;
6420 objc = ht->used * 2;
6421 objv = Jim_Alloc(objc * sizeof(Jim_Obj *));
6422 htiter = Jim_GetHashTableIterator(ht);
6423 i = 0;
6424 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6425 objv[i++] = (Jim_Obj *)he->key; /* ATTENTION: const cast */
6426 objv[i++] = he->u.val;
6428 Jim_FreeHashTableIterator(htiter);
6429 /* (Over) Estimate the space needed. */
6430 quotingType = Jim_Alloc(sizeof(int) * objc);
6431 bufLen = 0;
6432 for (i = 0; i < objc; i++) {
6433 int len;
6435 strRep = Jim_GetString(objv[i], &len);
6436 quotingType[i] = ListElementQuotingType(strRep, len);
6437 switch (quotingType[i]) {
6438 case JIM_ELESTR_SIMPLE:
6439 bufLen += len;
6440 break;
6441 case JIM_ELESTR_BRACE:
6442 bufLen += len + 2;
6443 break;
6444 case JIM_ELESTR_QUOTE:
6445 bufLen += len * 2;
6446 break;
6448 bufLen++; /* elements separator. */
6450 bufLen++;
6452 /* Generate the string rep. */
6453 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6454 realLength = 0;
6455 for (i = 0; i < objc; i++) {
6456 int len, qlen;
6457 char *q;
6459 strRep = Jim_GetString(objv[i], &len);
6461 switch (quotingType[i]) {
6462 case JIM_ELESTR_SIMPLE:
6463 memcpy(p, strRep, len);
6464 p += len;
6465 realLength += len;
6466 break;
6467 case JIM_ELESTR_BRACE:
6468 *p++ = '{';
6469 memcpy(p, strRep, len);
6470 p += len;
6471 *p++ = '}';
6472 realLength += len + 2;
6473 break;
6474 case JIM_ELESTR_QUOTE:
6475 q = BackslashQuoteString(strRep, len, &qlen);
6476 memcpy(p, q, qlen);
6477 Jim_Free(q);
6478 p += qlen;
6479 realLength += qlen;
6480 break;
6482 /* Add a separating space */
6483 if (i + 1 != objc) {
6484 *p++ = ' ';
6485 realLength++;
6488 *p = '\0'; /* nul term. */
6489 objPtr->length = realLength;
6490 Jim_Free(quotingType);
6491 Jim_Free(objv);
6494 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6496 int listlen;
6498 /* Get the string representation. Do this first so we don't
6499 * change order in case of fast conversion to dict.
6501 Jim_String(objPtr);
6503 /* For simplicity, convert a non-list object to a list and then to a dict */
6504 listlen = Jim_ListLength(interp, objPtr);
6505 if (listlen % 2) {
6506 Jim_SetResultString(interp,
6507 "invalid dictionary value: must be a list with an even number of elements", -1);
6508 return JIM_ERR;
6510 else {
6511 /* Now it is easy to convert to a dict from a list, and it can't fail */
6512 Jim_HashTable *ht;
6513 int i;
6515 ht = Jim_Alloc(sizeof(*ht));
6516 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6518 for (i = 0; i < listlen; i += 2) {
6519 Jim_Obj *keyObjPtr;
6520 Jim_Obj *valObjPtr;
6522 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
6523 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
6525 Jim_IncrRefCount(keyObjPtr);
6526 Jim_IncrRefCount(valObjPtr);
6528 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
6529 Jim_HashEntry *he;
6531 he = Jim_FindHashEntry(ht, keyObjPtr);
6532 Jim_DecrRefCount(interp, keyObjPtr);
6533 /* ATTENTION: const cast */
6534 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
6535 he->u.val = valObjPtr;
6539 Jim_FreeIntRep(interp, objPtr);
6540 objPtr->typePtr = &dictObjType;
6541 objPtr->internalRep.ptr = ht;
6543 return JIM_OK;
6547 /* Dict object API */
6549 /* Add an element to a dict. objPtr must be of the "dict" type.
6550 * The higer-level exported function is Jim_DictAddElement().
6551 * If an element with the specified key already exists, the value
6552 * associated is replaced with the new one.
6554 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6555 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6556 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6558 Jim_HashTable *ht = objPtr->internalRep.ptr;
6560 if (valueObjPtr == NULL) { /* unset */
6561 return Jim_DeleteHashEntry(ht, keyObjPtr);
6563 Jim_IncrRefCount(keyObjPtr);
6564 Jim_IncrRefCount(valueObjPtr);
6565 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
6566 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
6568 Jim_DecrRefCount(interp, keyObjPtr);
6569 /* ATTENTION: const cast */
6570 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
6571 he->u.val = valueObjPtr;
6573 return JIM_OK;
6576 /* Add an element, higher-level interface for DictAddElement().
6577 * If valueObjPtr == NULL, the key is removed if it exists. */
6578 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6579 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6581 int retcode;
6583 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
6584 if (objPtr->typePtr != &dictObjType) {
6585 if (SetDictFromAny(interp, objPtr) != JIM_OK)
6586 return JIM_ERR;
6588 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
6589 Jim_InvalidateStringRep(objPtr);
6590 return retcode;
6593 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6595 Jim_Obj *objPtr;
6596 int i;
6598 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
6600 objPtr = Jim_NewObj(interp);
6601 objPtr->typePtr = &dictObjType;
6602 objPtr->bytes = NULL;
6603 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
6604 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
6605 for (i = 0; i < len; i += 2)
6606 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
6607 return objPtr;
6610 /* Return the value associated to the specified dict key
6611 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
6613 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
6614 Jim_Obj **objPtrPtr, int flags)
6616 Jim_HashEntry *he;
6617 Jim_HashTable *ht;
6619 if (dictPtr->typePtr != &dictObjType) {
6620 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
6621 return -1;
6623 ht = dictPtr->internalRep.ptr;
6624 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
6625 if (flags & JIM_ERRMSG) {
6626 Jim_SetResultFormatted(interp, "key \"%#s\" not found in dictionary", keyPtr);
6628 return JIM_ERR;
6630 *objPtrPtr = he->u.val;
6631 return JIM_OK;
6634 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
6635 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
6637 Jim_HashTable *ht;
6638 Jim_HashTableIterator *htiter;
6639 Jim_HashEntry *he;
6640 Jim_Obj **objv;
6641 int i;
6643 if (dictPtr->typePtr != &dictObjType) {
6644 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
6645 return JIM_ERR;
6647 ht = dictPtr->internalRep.ptr;
6649 /* Turn the hash table into a flat vector of Jim_Objects. */
6650 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6651 htiter = Jim_GetHashTableIterator(ht);
6652 i = 0;
6653 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6654 objv[i++] = (Jim_Obj *)he->key; /* ATTENTION: const cast */
6655 objv[i++] = he->u.val;
6657 *len = i;
6658 Jim_FreeHashTableIterator(htiter);
6659 *objPtrPtr = objv;
6660 return JIM_OK;
6664 /* Return the value associated to the specified dict keys */
6665 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
6666 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
6668 int i;
6670 if (keyc == 0) {
6671 *objPtrPtr = dictPtr;
6672 return JIM_OK;
6675 for (i = 0; i < keyc; i++) {
6676 Jim_Obj *objPtr;
6678 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
6679 != JIM_OK)
6680 return JIM_ERR;
6681 dictPtr = objPtr;
6683 *objPtrPtr = dictPtr;
6684 return JIM_OK;
6687 /* Modify the dict stored into the variable named 'varNamePtr'
6688 * setting the element specified by the 'keyc' keys objects in 'keyv',
6689 * with the new value of the element 'newObjPtr'.
6691 * If newObjPtr == NULL the operation is to remove the given key
6692 * from the dictionary. */
6693 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
6694 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
6696 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
6697 int shared, i;
6699 varObjPtr = objPtr =
6700 Jim_GetVariable(interp, varNamePtr, newObjPtr == NULL ? JIM_ERRMSG : JIM_NONE);
6701 if (objPtr == NULL) {
6702 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
6703 return JIM_ERR;
6704 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
6705 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
6706 Jim_FreeNewObj(interp, varObjPtr);
6707 return JIM_ERR;
6710 if ((shared = Jim_IsShared(objPtr)))
6711 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6712 for (i = 0; i < keyc - 1; i++) {
6713 dictObjPtr = objPtr;
6715 /* Check if it's a valid dictionary */
6716 if (dictObjPtr->typePtr != &dictObjType) {
6717 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
6718 goto err;
6720 /* Check if the given key exists. */
6721 Jim_InvalidateStringRep(dictObjPtr);
6722 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
6723 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
6724 /* This key exists at the current level.
6725 * Make sure it's not shared!. */
6726 if (Jim_IsShared(objPtr)) {
6727 objPtr = Jim_DuplicateObj(interp, objPtr);
6728 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6731 else {
6732 /* Key not found. If it's an [unset] operation
6733 * this is an error. Only the last key may not
6734 * exist. */
6735 if (newObjPtr == NULL)
6736 goto err;
6737 /* Otherwise set an empty dictionary
6738 * as key's value. */
6739 objPtr = Jim_NewDictObj(interp, NULL, 0);
6740 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6743 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
6744 goto err;
6746 Jim_InvalidateStringRep(objPtr);
6747 Jim_InvalidateStringRep(varObjPtr);
6748 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6749 goto err;
6750 Jim_SetResult(interp, varObjPtr);
6751 return JIM_OK;
6752 err:
6753 if (shared) {
6754 Jim_FreeNewObj(interp, varObjPtr);
6756 return JIM_ERR;
6759 /* -----------------------------------------------------------------------------
6760 * Index object
6761 * ---------------------------------------------------------------------------*/
6762 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6763 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6765 static const Jim_ObjType indexObjType = {
6766 "index",
6767 NULL,
6768 NULL,
6769 UpdateStringOfIndex,
6770 JIM_TYPE_NONE,
6773 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6775 int len;
6776 char buf[JIM_INTEGER_SPACE + 1];
6778 if (objPtr->internalRep.indexValue >= 0)
6779 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6780 else if (objPtr->internalRep.indexValue == -1)
6781 len = sprintf(buf, "end");
6782 else {
6783 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6785 objPtr->bytes = Jim_Alloc(len + 1);
6786 memcpy(objPtr->bytes, buf, len + 1);
6787 objPtr->length = len;
6790 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6792 int idx, end = 0;
6793 const char *str;
6794 char *endptr;
6796 /* Get the string representation */
6797 str = Jim_String(objPtr);
6799 /* Try to convert into an index */
6800 if (strncmp(str, "end", 3) == 0) {
6801 end = 1;
6802 str += 3;
6803 idx = 0;
6805 else {
6806 idx = strtol(str, &endptr, 10);
6808 if (endptr == str) {
6809 goto badindex;
6811 str = endptr;
6814 /* Now str may include or +<num> or -<num> */
6815 if (*str == '+' || *str == '-') {
6816 int sign = (*str == '+' ? 1 : -1);
6818 idx += sign * strtol(++str, &endptr, 10);
6819 if (str == endptr || *endptr) {
6820 goto badindex;
6822 str = endptr;
6824 /* The only thing left should be spaces */
6825 while (isspace(UCHAR(*str))) {
6826 str++;
6828 if (*str) {
6829 goto badindex;
6831 if (end) {
6832 if (idx > 0) {
6833 idx = INT_MAX;
6835 else {
6836 /* end-1 is repesented as -2 */
6837 idx--;
6840 else if (idx < 0) {
6841 idx = -INT_MAX;
6844 /* Free the old internal repr and set the new one. */
6845 Jim_FreeIntRep(interp, objPtr);
6846 objPtr->typePtr = &indexObjType;
6847 objPtr->internalRep.indexValue = idx;
6848 return JIM_OK;
6850 badindex:
6851 Jim_SetResultFormatted(interp,
6852 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
6853 return JIM_ERR;
6856 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6858 /* Avoid shimmering if the object is an integer. */
6859 if (objPtr->typePtr == &intObjType) {
6860 jim_wide val = JimWideValue(objPtr);
6862 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6863 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6864 return JIM_OK;
6867 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
6868 return JIM_ERR;
6869 *indexPtr = objPtr->internalRep.indexValue;
6870 return JIM_OK;
6873 /* -----------------------------------------------------------------------------
6874 * Return Code Object.
6875 * ---------------------------------------------------------------------------*/
6877 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
6878 static const char * const jimReturnCodes[] = {
6879 [JIM_OK] = "ok",
6880 [JIM_ERR] = "error",
6881 [JIM_RETURN] = "return",
6882 [JIM_BREAK] = "break",
6883 [JIM_CONTINUE] = "continue",
6884 [JIM_SIGNAL] = "signal",
6885 [JIM_EXIT] = "exit",
6886 [JIM_EVAL] = "eval",
6887 NULL
6890 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
6892 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6894 static const Jim_ObjType returnCodeObjType = {
6895 "return-code",
6896 NULL,
6897 NULL,
6898 NULL,
6899 JIM_TYPE_NONE,
6902 /* Converts a (standard) return code to a string. Returns "?" for
6903 * non-standard return codes.
6905 const char *Jim_ReturnCode(int code)
6907 if (code < 0 || code >= (int)jimReturnCodesSize) {
6908 return "?";
6910 else {
6911 return jimReturnCodes[code];
6915 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6917 int returnCode;
6918 jim_wide wideValue;
6920 /* Try to convert into an integer */
6921 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6922 returnCode = (int)wideValue;
6923 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
6924 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
6925 return JIM_ERR;
6927 /* Free the old internal repr and set the new one. */
6928 Jim_FreeIntRep(interp, objPtr);
6929 objPtr->typePtr = &returnCodeObjType;
6930 objPtr->internalRep.returnCode = returnCode;
6931 return JIM_OK;
6934 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6936 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6937 return JIM_ERR;
6938 *intPtr = objPtr->internalRep.returnCode;
6939 return JIM_OK;
6942 /* -----------------------------------------------------------------------------
6943 * Expression Parsing
6944 * ---------------------------------------------------------------------------*/
6945 static int JimParseExprOperator(struct JimParserCtx *pc);
6946 static int JimParseExprNumber(struct JimParserCtx *pc);
6947 static int JimParseExprIrrational(struct JimParserCtx *pc);
6949 /* Exrp's Stack machine operators opcodes. */
6951 /* Binary operators (numbers) */
6952 enum
6954 /* Continues on from the JIM_TT_ space */
6955 /* Operations */
6956 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 15 */
6957 JIM_EXPROP_DIV,
6958 JIM_EXPROP_MOD,
6959 JIM_EXPROP_SUB,
6960 JIM_EXPROP_ADD,
6961 JIM_EXPROP_LSHIFT,
6962 JIM_EXPROP_RSHIFT,
6963 JIM_EXPROP_ROTL,
6964 JIM_EXPROP_ROTR,
6965 JIM_EXPROP_LT,
6966 JIM_EXPROP_GT,
6967 JIM_EXPROP_LTE,
6968 JIM_EXPROP_GTE,
6969 JIM_EXPROP_NUMEQ,
6970 JIM_EXPROP_NUMNE,
6971 JIM_EXPROP_BITAND, /* 30 */
6972 JIM_EXPROP_BITXOR,
6973 JIM_EXPROP_BITOR,
6975 /* Note must keep these together */
6976 JIM_EXPROP_LOGICAND, /* 33 */
6977 JIM_EXPROP_LOGICAND_LEFT,
6978 JIM_EXPROP_LOGICAND_RIGHT,
6980 /* and these */
6981 JIM_EXPROP_LOGICOR, /* 36 */
6982 JIM_EXPROP_LOGICOR_LEFT,
6983 JIM_EXPROP_LOGICOR_RIGHT,
6985 /* and these */
6986 /* Ternary operators */
6987 JIM_EXPROP_TERNARY, /* 39 */
6988 JIM_EXPROP_TERNARY_LEFT,
6989 JIM_EXPROP_TERNARY_RIGHT,
6991 /* and these */
6992 JIM_EXPROP_COLON, /* 42 */
6993 JIM_EXPROP_COLON_LEFT,
6994 JIM_EXPROP_COLON_RIGHT,
6996 JIM_EXPROP_POW, /* 45 */
6998 /* Binary operators (strings) */
6999 JIM_EXPROP_STREQ,
7000 JIM_EXPROP_STRNE,
7001 JIM_EXPROP_STRIN,
7002 JIM_EXPROP_STRNI,
7004 /* Unary operators (numbers) */
7005 JIM_EXPROP_NOT,
7006 JIM_EXPROP_BITNOT,
7007 JIM_EXPROP_UNARYMINUS,
7008 JIM_EXPROP_UNARYPLUS,
7010 /* Functions */
7011 JIM_EXPROP_FUNC_FIRST,
7012 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7013 JIM_EXPROP_FUNC_ABS,
7014 JIM_EXPROP_FUNC_DOUBLE,
7015 JIM_EXPROP_FUNC_ROUND,
7016 JIM_EXPROP_FUNC_RAND,
7017 JIM_EXPROP_FUNC_SRAND,
7019 #ifdef JIM_MATH_FUNCTIONS
7020 /* math functions from libm */
7021 JIM_EXPROP_FUNC_SIN,
7022 JIM_EXPROP_FUNC_COS,
7023 JIM_EXPROP_FUNC_TAN,
7024 JIM_EXPROP_FUNC_ASIN,
7025 JIM_EXPROP_FUNC_ACOS,
7026 JIM_EXPROP_FUNC_ATAN,
7027 JIM_EXPROP_FUNC_SINH,
7028 JIM_EXPROP_FUNC_COSH,
7029 JIM_EXPROP_FUNC_TANH,
7030 JIM_EXPROP_FUNC_CEIL,
7031 JIM_EXPROP_FUNC_FLOOR,
7032 JIM_EXPROP_FUNC_EXP,
7033 JIM_EXPROP_FUNC_LOG,
7034 JIM_EXPROP_FUNC_LOG10,
7035 JIM_EXPROP_FUNC_SQRT,
7036 #endif
7039 struct JimExprState
7041 Jim_Obj **stack;
7042 int stacklen;
7043 int opcode;
7044 int skip;
7047 /* Operators table */
7048 typedef struct Jim_ExprOperator
7050 const char *name;
7051 int precedence;
7052 int arity;
7053 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7054 int lazy;
7055 } Jim_ExprOperator;
7057 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7059 Jim_IncrRefCount(obj);
7060 e->stack[e->stacklen++] = obj;
7063 static Jim_Obj *ExprPop(struct JimExprState *e)
7065 return e->stack[--e->stacklen];
7068 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7070 int intresult = 0;
7071 int rc = JIM_OK;
7072 Jim_Obj *A = ExprPop(e);
7073 double dA, dC = 0;
7074 jim_wide wA, wC = 0;
7076 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7077 intresult = 1;
7079 switch (e->opcode) {
7080 case JIM_EXPROP_FUNC_INT:
7081 wC = wA;
7082 break;
7083 case JIM_EXPROP_FUNC_ROUND:
7084 wC = wA;
7085 break;
7086 case JIM_EXPROP_FUNC_DOUBLE:
7087 dC = wA;
7088 intresult = 0;
7089 break;
7090 case JIM_EXPROP_FUNC_ABS:
7091 wC = wA >= 0 ? wA : -wA;
7092 break;
7093 case JIM_EXPROP_UNARYMINUS:
7094 wC = -wA;
7095 break;
7096 case JIM_EXPROP_UNARYPLUS:
7097 wC = wA;
7098 break;
7099 case JIM_EXPROP_NOT:
7100 wC = !wA;
7101 break;
7102 default:
7103 abort();
7106 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7107 switch (e->opcode) {
7108 case JIM_EXPROP_FUNC_INT:
7109 wC = dA;
7110 intresult = 1;
7111 break;
7112 case JIM_EXPROP_FUNC_ROUND:
7113 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7114 intresult = 1;
7115 break;
7116 case JIM_EXPROP_FUNC_DOUBLE:
7117 dC = dA;
7118 break;
7119 case JIM_EXPROP_FUNC_ABS:
7120 dC = dA >= 0 ? dA : -dA;
7121 break;
7122 case JIM_EXPROP_UNARYMINUS:
7123 dC = -dA;
7124 break;
7125 case JIM_EXPROP_UNARYPLUS:
7126 dC = dA;
7127 break;
7128 case JIM_EXPROP_NOT:
7129 wC = !dA;
7130 intresult = 1;
7131 break;
7132 default:
7133 abort();
7137 if (rc == JIM_OK) {
7138 if (intresult) {
7139 ExprPush(e, Jim_NewIntObj(interp, wC));
7141 else {
7142 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7146 Jim_DecrRefCount(interp, A);
7148 return rc;
7151 static double JimRandDouble(Jim_Interp *interp)
7153 unsigned long x;
7154 JimRandomBytes(interp, &x, sizeof(x));
7156 return (double)x / (unsigned long)~0;
7159 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7161 Jim_Obj *A = ExprPop(e);
7162 jim_wide wA;
7164 int rc = Jim_GetWide(interp, A, &wA);
7165 if (rc == JIM_OK) {
7166 switch (e->opcode) {
7167 case JIM_EXPROP_BITNOT:
7168 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7169 break;
7170 case JIM_EXPROP_FUNC_SRAND:
7171 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7172 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7173 break;
7174 default:
7175 abort();
7179 Jim_DecrRefCount(interp, A);
7181 return rc;
7184 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7186 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7188 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7190 return JIM_OK;
7193 #ifdef JIM_MATH_FUNCTIONS
7194 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7196 int rc;
7197 Jim_Obj *A = ExprPop(e);
7198 double dA, dC;
7200 rc = Jim_GetDouble(interp, A, &dA);
7201 if (rc == JIM_OK) {
7202 switch (e->opcode) {
7203 case JIM_EXPROP_FUNC_SIN:
7204 dC = sin(dA);
7205 break;
7206 case JIM_EXPROP_FUNC_COS:
7207 dC = cos(dA);
7208 break;
7209 case JIM_EXPROP_FUNC_TAN:
7210 dC = tan(dA);
7211 break;
7212 case JIM_EXPROP_FUNC_ASIN:
7213 dC = asin(dA);
7214 break;
7215 case JIM_EXPROP_FUNC_ACOS:
7216 dC = acos(dA);
7217 break;
7218 case JIM_EXPROP_FUNC_ATAN:
7219 dC = atan(dA);
7220 break;
7221 case JIM_EXPROP_FUNC_SINH:
7222 dC = sinh(dA);
7223 break;
7224 case JIM_EXPROP_FUNC_COSH:
7225 dC = cosh(dA);
7226 break;
7227 case JIM_EXPROP_FUNC_TANH:
7228 dC = tanh(dA);
7229 break;
7230 case JIM_EXPROP_FUNC_CEIL:
7231 dC = ceil(dA);
7232 break;
7233 case JIM_EXPROP_FUNC_FLOOR:
7234 dC = floor(dA);
7235 break;
7236 case JIM_EXPROP_FUNC_EXP:
7237 dC = exp(dA);
7238 break;
7239 case JIM_EXPROP_FUNC_LOG:
7240 dC = log(dA);
7241 break;
7242 case JIM_EXPROP_FUNC_LOG10:
7243 dC = log10(dA);
7244 break;
7245 case JIM_EXPROP_FUNC_SQRT:
7246 dC = sqrt(dA);
7247 break;
7248 default:
7249 abort();
7251 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7254 Jim_DecrRefCount(interp, A);
7256 return rc;
7258 #endif
7260 /* A binary operation on two ints */
7261 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7263 Jim_Obj *B = ExprPop(e);
7264 Jim_Obj *A = ExprPop(e);
7265 jim_wide wA, wB;
7266 int rc = JIM_ERR;
7268 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7269 jim_wide wC;
7271 rc = JIM_OK;
7273 switch (e->opcode) {
7274 case JIM_EXPROP_LSHIFT:
7275 wC = wA << wB;
7276 break;
7277 case JIM_EXPROP_RSHIFT:
7278 wC = wA >> wB;
7279 break;
7280 case JIM_EXPROP_BITAND:
7281 wC = wA & wB;
7282 break;
7283 case JIM_EXPROP_BITXOR:
7284 wC = wA ^ wB;
7285 break;
7286 case JIM_EXPROP_BITOR:
7287 wC = wA | wB;
7288 break;
7289 case JIM_EXPROP_MOD:
7290 if (wB == 0) {
7291 wC = 0;
7292 Jim_SetResultString(interp, "Division by zero", -1);
7293 rc = JIM_ERR;
7295 else {
7297 * From Tcl 8.x
7299 * This code is tricky: C doesn't guarantee much
7300 * about the quotient or remainder, but Tcl does.
7301 * The remainder always has the same sign as the
7302 * divisor and a smaller absolute value.
7304 int negative = 0;
7306 if (wB < 0) {
7307 wB = -wB;
7308 wA = -wA;
7309 negative = 1;
7311 wC = wA % wB;
7312 if (wC < 0) {
7313 wC += wB;
7315 if (negative) {
7316 wC = -wC;
7319 break;
7320 case JIM_EXPROP_ROTL:
7321 case JIM_EXPROP_ROTR:{
7322 /* uint32_t would be better. But not everyone has inttypes.h? */
7323 unsigned long uA = (unsigned long)wA;
7324 unsigned long uB = (unsigned long)wB;
7325 const unsigned int S = sizeof(unsigned long) * 8;
7327 /* Shift left by the word size or more is undefined. */
7328 uB %= S;
7330 if (e->opcode == JIM_EXPROP_ROTR) {
7331 uB = S - uB;
7333 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7334 break;
7336 default:
7337 abort();
7339 ExprPush(e, Jim_NewIntObj(interp, wC));
7343 Jim_DecrRefCount(interp, A);
7344 Jim_DecrRefCount(interp, B);
7346 return rc;
7350 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7351 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7353 int intresult = 0;
7354 int rc = JIM_OK;
7355 double dA, dB, dC = 0;
7356 jim_wide wA, wB, wC = 0;
7358 Jim_Obj *B = ExprPop(e);
7359 Jim_Obj *A = ExprPop(e);
7361 if ((A->typePtr != &doubleObjType || A->bytes) &&
7362 (B->typePtr != &doubleObjType || B->bytes) &&
7363 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7365 /* Both are ints */
7367 intresult = 1;
7369 switch (e->opcode) {
7370 case JIM_EXPROP_POW:
7371 wC = JimPowWide(wA, wB);
7372 break;
7373 case JIM_EXPROP_ADD:
7374 wC = wA + wB;
7375 break;
7376 case JIM_EXPROP_SUB:
7377 wC = wA - wB;
7378 break;
7379 case JIM_EXPROP_MUL:
7380 wC = wA * wB;
7381 break;
7382 case JIM_EXPROP_DIV:
7383 if (wB == 0) {
7384 Jim_SetResultString(interp, "Division by zero", -1);
7385 rc = JIM_ERR;
7387 else {
7389 * From Tcl 8.x
7391 * This code is tricky: C doesn't guarantee much
7392 * about the quotient or remainder, but Tcl does.
7393 * The remainder always has the same sign as the
7394 * divisor and a smaller absolute value.
7396 if (wB < 0) {
7397 wB = -wB;
7398 wA = -wA;
7400 wC = wA / wB;
7401 if (wA % wB < 0) {
7402 wC--;
7405 break;
7406 case JIM_EXPROP_LT:
7407 wC = wA < wB;
7408 break;
7409 case JIM_EXPROP_GT:
7410 wC = wA > wB;
7411 break;
7412 case JIM_EXPROP_LTE:
7413 wC = wA <= wB;
7414 break;
7415 case JIM_EXPROP_GTE:
7416 wC = wA >= wB;
7417 break;
7418 case JIM_EXPROP_NUMEQ:
7419 wC = wA == wB;
7420 break;
7421 case JIM_EXPROP_NUMNE:
7422 wC = wA != wB;
7423 break;
7424 default:
7425 abort();
7428 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7429 switch (e->opcode) {
7430 case JIM_EXPROP_POW:
7431 #ifdef JIM_MATH_FUNCTIONS
7432 dC = pow(dA, dB);
7433 #else
7434 Jim_SetResultString(interp, "unsupported", -1);
7435 rc = JIM_ERR;
7436 #endif
7437 break;
7438 case JIM_EXPROP_ADD:
7439 dC = dA + dB;
7440 break;
7441 case JIM_EXPROP_SUB:
7442 dC = dA - dB;
7443 break;
7444 case JIM_EXPROP_MUL:
7445 dC = dA * dB;
7446 break;
7447 case JIM_EXPROP_DIV:
7448 if (dB == 0) {
7449 #ifdef INFINITY
7450 dC = dA < 0 ? -INFINITY : INFINITY;
7451 #else
7452 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7453 #endif
7455 else {
7456 dC = dA / dB;
7458 break;
7459 case JIM_EXPROP_LT:
7460 wC = dA < dB;
7461 intresult = 1;
7462 break;
7463 case JIM_EXPROP_GT:
7464 wC = dA > dB;
7465 intresult = 1;
7466 break;
7467 case JIM_EXPROP_LTE:
7468 wC = dA <= dB;
7469 intresult = 1;
7470 break;
7471 case JIM_EXPROP_GTE:
7472 wC = dA >= dB;
7473 intresult = 1;
7474 break;
7475 case JIM_EXPROP_NUMEQ:
7476 wC = dA == dB;
7477 intresult = 1;
7478 break;
7479 case JIM_EXPROP_NUMNE:
7480 wC = dA != dB;
7481 intresult = 1;
7482 break;
7483 default:
7484 abort();
7487 else {
7488 /* Handle the string case */
7490 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7491 int i = Jim_StringCompareObj(interp, A, B, 0);
7493 intresult = 1;
7495 switch (e->opcode) {
7496 case JIM_EXPROP_LT:
7497 wC = i < 0;
7498 break;
7499 case JIM_EXPROP_GT:
7500 wC = i > 0;
7501 break;
7502 case JIM_EXPROP_LTE:
7503 wC = i <= 0;
7504 break;
7505 case JIM_EXPROP_GTE:
7506 wC = i >= 0;
7507 break;
7508 case JIM_EXPROP_NUMEQ:
7509 wC = i == 0;
7510 break;
7511 case JIM_EXPROP_NUMNE:
7512 wC = i != 0;
7513 break;
7514 default:
7515 rc = JIM_ERR;
7516 break;
7520 if (rc == JIM_OK) {
7521 if (intresult) {
7522 ExprPush(e, Jim_NewIntObj(interp, wC));
7524 else {
7525 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7529 Jim_DecrRefCount(interp, A);
7530 Jim_DecrRefCount(interp, B);
7532 return rc;
7535 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
7537 int listlen;
7538 int i;
7540 listlen = Jim_ListLength(interp, listObjPtr);
7541 for (i = 0; i < listlen; i++) {
7542 Jim_Obj *objPtr;
7544 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
7546 if (Jim_StringEqObj(objPtr, valObj)) {
7547 return 1;
7550 return 0;
7553 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
7555 Jim_Obj *B = ExprPop(e);
7556 Jim_Obj *A = ExprPop(e);
7558 jim_wide wC;
7560 switch (e->opcode) {
7561 case JIM_EXPROP_STREQ:
7562 case JIM_EXPROP_STRNE: {
7563 int Alen, Blen;
7564 const char *sA = Jim_GetString(A, &Alen);
7565 const char *sB = Jim_GetString(B, &Blen);
7567 if (e->opcode == JIM_EXPROP_STREQ) {
7568 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7570 else {
7571 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7573 break;
7575 case JIM_EXPROP_STRIN:
7576 wC = JimSearchList(interp, B, A);
7577 break;
7578 case JIM_EXPROP_STRNI:
7579 wC = !JimSearchList(interp, B, A);
7580 break;
7581 default:
7582 abort();
7584 ExprPush(e, Jim_NewIntObj(interp, wC));
7586 Jim_DecrRefCount(interp, A);
7587 Jim_DecrRefCount(interp, B);
7589 return JIM_OK;
7592 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
7594 long l;
7595 double d;
7597 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
7598 return l != 0;
7600 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
7601 return d != 0;
7603 return -1;
7606 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
7608 Jim_Obj *skip = ExprPop(e);
7609 Jim_Obj *A = ExprPop(e);
7610 int rc = JIM_OK;
7612 switch (ExprBool(interp, A)) {
7613 case 0:
7614 /* false, so skip RHS opcodes with a 0 result */
7615 e->skip = JimWideValue(skip);
7616 ExprPush(e, Jim_NewIntObj(interp, 0));
7617 break;
7619 case 1:
7620 /* true so continue */
7621 break;
7623 case -1:
7624 /* Invalid */
7625 rc = JIM_ERR;
7627 Jim_DecrRefCount(interp, A);
7628 Jim_DecrRefCount(interp, skip);
7630 return rc;
7633 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
7635 Jim_Obj *skip = ExprPop(e);
7636 Jim_Obj *A = ExprPop(e);
7637 int rc = JIM_OK;
7639 switch (ExprBool(interp, A)) {
7640 case 0:
7641 /* false, so do nothing */
7642 break;
7644 case 1:
7645 /* true so skip RHS opcodes with a 1 result */
7646 e->skip = JimWideValue(skip);
7647 ExprPush(e, Jim_NewIntObj(interp, 1));
7648 break;
7650 case -1:
7651 /* Invalid */
7652 rc = JIM_ERR;
7653 break;
7655 Jim_DecrRefCount(interp, A);
7656 Jim_DecrRefCount(interp, skip);
7658 return rc;
7661 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
7663 Jim_Obj *A = ExprPop(e);
7664 int rc = JIM_OK;
7666 switch (ExprBool(interp, A)) {
7667 case 0:
7668 ExprPush(e, Jim_NewIntObj(interp, 0));
7669 break;
7671 case 1:
7672 ExprPush(e, Jim_NewIntObj(interp, 1));
7673 break;
7675 case -1:
7676 /* Invalid */
7677 rc = JIM_ERR;
7678 break;
7680 Jim_DecrRefCount(interp, A);
7682 return rc;
7685 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
7687 Jim_Obj *skip = ExprPop(e);
7688 Jim_Obj *A = ExprPop(e);
7689 int rc = JIM_OK;
7691 /* Repush A */
7692 ExprPush(e, A);
7694 switch (ExprBool(interp, A)) {
7695 case 0:
7696 /* false, skip RHS opcodes */
7697 e->skip = JimWideValue(skip);
7698 /* Push a dummy value */
7699 ExprPush(e, Jim_NewIntObj(interp, 0));
7700 break;
7702 case 1:
7703 /* true so do nothing */
7704 break;
7706 case -1:
7707 /* Invalid */
7708 rc = JIM_ERR;
7709 break;
7711 Jim_DecrRefCount(interp, A);
7712 Jim_DecrRefCount(interp, skip);
7714 return rc;
7717 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
7719 Jim_Obj *skip = ExprPop(e);
7720 Jim_Obj *B = ExprPop(e);
7721 Jim_Obj *A = ExprPop(e);
7723 /* No need to check for A as non-boolean */
7724 if (ExprBool(interp, A)) {
7725 /* true, so skip RHS opcodes */
7726 e->skip = JimWideValue(skip);
7727 /* Repush B as the answer */
7728 ExprPush(e, B);
7731 Jim_DecrRefCount(interp, skip);
7732 Jim_DecrRefCount(interp, A);
7733 Jim_DecrRefCount(interp, B);
7734 return JIM_OK;
7737 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
7739 return JIM_OK;
7742 enum
7744 LAZY_NONE,
7745 LAZY_OP,
7746 LAZY_LEFT,
7747 LAZY_RIGHT
7750 /* name - precedence - arity - opcode */
7751 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
7752 [JIM_EXPROP_FUNC_INT] = {"int", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7753 [JIM_EXPROP_FUNC_DOUBLE] = {"double", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7754 [JIM_EXPROP_FUNC_ABS] = {"abs", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7755 [JIM_EXPROP_FUNC_ROUND] = {"round", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7756 [JIM_EXPROP_FUNC_RAND] = {"rand", 400, 0, JimExprOpNone, LAZY_NONE},
7757 [JIM_EXPROP_FUNC_SRAND] = {"srand", 400, 1, JimExprOpIntUnary, LAZY_NONE},
7759 #ifdef JIM_MATH_FUNCTIONS
7760 [JIM_EXPROP_FUNC_SIN] = {"sin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7761 [JIM_EXPROP_FUNC_COS] = {"cos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7762 [JIM_EXPROP_FUNC_TAN] = {"tan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7763 [JIM_EXPROP_FUNC_ASIN] = {"asin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7764 [JIM_EXPROP_FUNC_ACOS] = {"acos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7765 [JIM_EXPROP_FUNC_ATAN] = {"atan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7766 [JIM_EXPROP_FUNC_SINH] = {"sinh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7767 [JIM_EXPROP_FUNC_COSH] = {"cosh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7768 [JIM_EXPROP_FUNC_TANH] = {"tanh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7769 [JIM_EXPROP_FUNC_CEIL] = {"ceil", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7770 [JIM_EXPROP_FUNC_FLOOR] = {"floor", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7771 [JIM_EXPROP_FUNC_EXP] = {"exp", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7772 [JIM_EXPROP_FUNC_LOG] = {"log", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7773 [JIM_EXPROP_FUNC_LOG10] = {"log10", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7774 [JIM_EXPROP_FUNC_SQRT] = {"sqrt", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7775 #endif
7777 [JIM_EXPROP_NOT] = {"!", 300, 1, JimExprOpNumUnary, LAZY_NONE},
7778 [JIM_EXPROP_BITNOT] = {"~", 300, 1, JimExprOpIntUnary, LAZY_NONE},
7779 [JIM_EXPROP_UNARYMINUS] = {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7780 [JIM_EXPROP_UNARYPLUS] = {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7782 [JIM_EXPROP_POW] = {"**", 250, 2, JimExprOpBin, LAZY_NONE},
7784 [JIM_EXPROP_MUL] = {"*", 200, 2, JimExprOpBin, LAZY_NONE},
7785 [JIM_EXPROP_DIV] = {"/", 200, 2, JimExprOpBin, LAZY_NONE},
7786 [JIM_EXPROP_MOD] = {"%", 200, 2, JimExprOpIntBin, LAZY_NONE},
7788 [JIM_EXPROP_SUB] = {"-", 100, 2, JimExprOpBin, LAZY_NONE},
7789 [JIM_EXPROP_ADD] = {"+", 100, 2, JimExprOpBin, LAZY_NONE},
7791 [JIM_EXPROP_ROTL] = {"<<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7792 [JIM_EXPROP_ROTR] = {">>>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7793 [JIM_EXPROP_LSHIFT] = {"<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7794 [JIM_EXPROP_RSHIFT] = {">>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7796 [JIM_EXPROP_LT] = {"<", 80, 2, JimExprOpBin, LAZY_NONE},
7797 [JIM_EXPROP_GT] = {">", 80, 2, JimExprOpBin, LAZY_NONE},
7798 [JIM_EXPROP_LTE] = {"<=", 80, 2, JimExprOpBin, LAZY_NONE},
7799 [JIM_EXPROP_GTE] = {">=", 80, 2, JimExprOpBin, LAZY_NONE},
7801 [JIM_EXPROP_NUMEQ] = {"==", 70, 2, JimExprOpBin, LAZY_NONE},
7802 [JIM_EXPROP_NUMNE] = {"!=", 70, 2, JimExprOpBin, LAZY_NONE},
7804 [JIM_EXPROP_STREQ] = {"eq", 60, 2, JimExprOpStrBin, LAZY_NONE},
7805 [JIM_EXPROP_STRNE] = {"ne", 60, 2, JimExprOpStrBin, LAZY_NONE},
7807 [JIM_EXPROP_STRIN] = {"in", 55, 2, JimExprOpStrBin, LAZY_NONE},
7808 [JIM_EXPROP_STRNI] = {"ni", 55, 2, JimExprOpStrBin, LAZY_NONE},
7810 [JIM_EXPROP_BITAND] = {"&", 50, 2, JimExprOpIntBin, LAZY_NONE},
7811 [JIM_EXPROP_BITXOR] = {"^", 49, 2, JimExprOpIntBin, LAZY_NONE},
7812 [JIM_EXPROP_BITOR] = {"|", 48, 2, JimExprOpIntBin, LAZY_NONE},
7814 [JIM_EXPROP_LOGICAND] = {"&&", 10, 2, NULL, LAZY_OP},
7815 [JIM_EXPROP_LOGICOR] = {"||", 9, 2, NULL, LAZY_OP},
7817 [JIM_EXPROP_TERNARY] = {"?", 5, 2, JimExprOpNull, LAZY_OP},
7818 [JIM_EXPROP_COLON] = {":", 5, 2, JimExprOpNull, LAZY_OP},
7820 /* private operators */
7821 [JIM_EXPROP_TERNARY_LEFT] = {NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT},
7822 [JIM_EXPROP_TERNARY_RIGHT] = {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7823 [JIM_EXPROP_COLON_LEFT] = {NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT},
7824 [JIM_EXPROP_COLON_RIGHT] = {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7825 [JIM_EXPROP_LOGICAND_LEFT] = {NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT},
7826 [JIM_EXPROP_LOGICAND_RIGHT] = {NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7827 [JIM_EXPROP_LOGICOR_LEFT] = {NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT},
7828 [JIM_EXPROP_LOGICOR_RIGHT] = {NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7831 #define JIM_EXPR_OPERATORS_NUM \
7832 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
7834 static int JimParseExpression(struct JimParserCtx *pc)
7836 /* Discard spaces and quoted newline */
7837 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
7838 pc->p++;
7839 pc->len--;
7842 if (pc->len == 0) {
7843 pc->tstart = pc->tend = pc->p;
7844 pc->tline = pc->linenr;
7845 pc->tt = JIM_TT_EOL;
7846 pc->eof = 1;
7847 return JIM_OK;
7849 switch (*(pc->p)) {
7850 case '(':
7851 pc->tstart = pc->tend = pc->p;
7852 pc->tline = pc->linenr;
7853 pc->tt = JIM_TT_SUBEXPR_START;
7854 pc->p++;
7855 pc->len--;
7856 break;
7857 case ')':
7858 pc->tstart = pc->tend = pc->p;
7859 pc->tline = pc->linenr;
7860 pc->tt = JIM_TT_SUBEXPR_END;
7861 pc->p++;
7862 pc->len--;
7863 break;
7864 case '[':
7865 return JimParseCmd(pc);
7866 case '$':
7867 if (JimParseVar(pc) == JIM_ERR)
7868 return JimParseExprOperator(pc);
7869 else {
7870 /* Don't allow expr sugar in expressions */
7871 if (pc->tt == JIM_TT_EXPRSUGAR) {
7872 return JIM_ERR;
7874 return JIM_OK;
7876 break;
7877 case '0':
7878 case '1':
7879 case '2':
7880 case '3':
7881 case '4':
7882 case '5':
7883 case '6':
7884 case '7':
7885 case '8':
7886 case '9':
7887 case '.':
7888 return JimParseExprNumber(pc);
7889 case '"':
7890 return JimParseQuote(pc);
7891 case '{':
7892 return JimParseBrace(pc);
7894 case 'N':
7895 case 'I':
7896 case 'n':
7897 case 'i':
7898 if (JimParseExprIrrational(pc) == JIM_ERR)
7899 return JimParseExprOperator(pc);
7900 break;
7901 default:
7902 return JimParseExprOperator(pc);
7903 break;
7905 return JIM_OK;
7908 static int JimParseExprNumber(struct JimParserCtx *pc)
7910 int allowdot = 1;
7911 int allowhex = 0;
7913 /* Assume an integer for now */
7914 pc->tt = JIM_TT_EXPR_INT;
7915 pc->tstart = pc->p;
7916 pc->tline = pc->linenr;
7917 while (isdigit(UCHAR(*pc->p))
7918 || (allowhex && isxdigit(UCHAR(*pc->p)))
7919 || (allowdot && *pc->p == '.')
7920 || (pc->p - pc->tstart == 1 && *pc->tstart == '0' && (*pc->p == 'x' || *pc->p == 'X'))
7922 if ((*pc->p == 'x') || (*pc->p == 'X')) {
7923 allowhex = 1;
7924 allowdot = 0;
7926 if (*pc->p == '.') {
7927 allowdot = 0;
7928 pc->tt = JIM_TT_EXPR_DOUBLE;
7930 pc->p++;
7931 pc->len--;
7932 if (!allowhex && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
7933 || isdigit(UCHAR(pc->p[1])))) {
7934 pc->p += 2;
7935 pc->len -= 2;
7936 pc->tt = JIM_TT_EXPR_DOUBLE;
7939 pc->tend = pc->p - 1;
7940 return JIM_OK;
7943 static int JimParseExprIrrational(struct JimParserCtx *pc)
7945 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
7946 const char **token;
7948 for (token = Tokens; *token != NULL; token++) {
7949 int len = strlen(*token);
7951 if (strncmp(*token, pc->p, len) == 0) {
7952 pc->tstart = pc->p;
7953 pc->tend = pc->p + len - 1;
7954 pc->p += len;
7955 pc->len -= len;
7956 pc->tline = pc->linenr;
7957 pc->tt = JIM_TT_EXPR_DOUBLE;
7958 return JIM_OK;
7961 return JIM_ERR;
7964 static int JimParseExprOperator(struct JimParserCtx *pc)
7966 int i;
7967 int bestIdx = -1, bestLen = 0;
7969 /* Try to get the longest match. */
7970 for (i = JIM_TT_EXPR_OP; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
7971 const char *opname;
7972 int oplen;
7974 opname = Jim_ExprOperators[i].name;
7975 if (opname == NULL) {
7976 continue;
7978 oplen = strlen(opname);
7980 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
7981 bestIdx = i;
7982 bestLen = oplen;
7985 if (bestIdx == -1) {
7986 return JIM_ERR;
7989 /* Validate paretheses around function arguments */
7990 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
7991 const char *p = pc->p + bestLen;
7992 int len = pc->len - bestLen;
7994 while (len && isspace(UCHAR(*p))) {
7995 len--;
7996 p++;
7998 if (*p != '(') {
7999 return JIM_ERR;
8002 pc->tstart = pc->p;
8003 pc->tend = pc->p + bestLen - 1;
8004 pc->p += bestLen;
8005 pc->len -= bestLen;
8006 pc->tline = pc->linenr;
8008 pc->tt = bestIdx;
8009 return JIM_OK;
8012 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8014 return &Jim_ExprOperators[opcode];
8017 const char *jim_tt_name(int type)
8019 static const char * const tt_names[JIM_TT_EXPR_OP] =
8020 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", "INT",
8021 "DBL", "$()" };
8022 if (type < JIM_TT_EXPR_OP) {
8023 return tt_names[type];
8025 else {
8026 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8027 static char buf[20];
8029 if (op && op->name) {
8030 return op->name;
8032 sprintf(buf, "(%d)", type);
8033 return buf;
8037 /* -----------------------------------------------------------------------------
8038 * Expression Object
8039 * ---------------------------------------------------------------------------*/
8040 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8041 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8042 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8044 static const Jim_ObjType exprObjType = {
8045 "expression",
8046 FreeExprInternalRep,
8047 DupExprInternalRep,
8048 NULL,
8049 JIM_TYPE_REFERENCES,
8052 /* Expr bytecode structure */
8053 typedef struct ExprByteCode
8055 int len; /* Length as number of tokens. */
8056 ScriptToken *token; /* Tokens array. */
8057 int inUse; /* Used for sharing. */
8058 } ExprByteCode;
8060 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8062 int i;
8064 for (i = 0; i < expr->len; i++) {
8065 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8067 Jim_Free(expr->token);
8068 Jim_Free(expr);
8071 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8073 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8075 if (expr) {
8076 if (--expr->inUse != 0) {
8077 return;
8080 ExprFreeByteCode(interp, expr);
8084 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8086 JIM_NOTUSED(interp);
8087 JIM_NOTUSED(srcPtr);
8089 /* Just returns an simple string. */
8090 dupPtr->typePtr = NULL;
8093 /* Check if an expr program looks correct. */
8094 static int ExprCheckCorrectness(ExprByteCode * expr)
8096 int i;
8097 int stacklen = 0;
8098 int ternary = 0;
8100 /* Try to check if there are stack underflows,
8101 * and make sure at the end of the program there is
8102 * a single result on the stack. */
8103 for (i = 0; i < expr->len; i++) {
8104 ScriptToken *t = &expr->token[i];
8105 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8107 if (op) {
8108 stacklen -= op->arity;
8109 if (stacklen < 0) {
8110 break;
8112 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8113 ternary++;
8115 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8116 ternary--;
8120 /* All operations and operands add one to the stack */
8121 stacklen++;
8123 if (stacklen != 1 || ternary != 0) {
8124 return JIM_ERR;
8126 return JIM_OK;
8129 /* This procedure converts every occurrence of || and && opereators
8130 * in lazy unary versions.
8132 * a b || is converted into:
8134 * a <offset> |L b |R
8136 * a b && is converted into:
8138 * a <offset> &L b &R
8140 * "|L" checks if 'a' is true:
8141 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8142 * the opcode just after |R.
8143 * 2) if it is false does nothing.
8144 * "|R" checks if 'b' is true:
8145 * 1) if it is true pushes 1, otherwise pushes 0.
8147 * "&L" checks if 'a' is true:
8148 * 1) if it is true does nothing.
8149 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8150 * the opcode just after &R
8151 * "&R" checks if 'a' is true:
8152 * if it is true pushes 1, otherwise pushes 0.
8154 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8156 int i;
8158 int leftindex, arity, offset;
8160 /* Search for the end of the first operator */
8161 leftindex = expr->len - 1;
8163 arity = 1;
8164 while (arity) {
8165 ScriptToken *tt = &expr->token[leftindex];
8167 if (tt->type >= JIM_TT_EXPR_OP) {
8168 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8170 arity--;
8171 if (--leftindex < 0) {
8172 return JIM_ERR;
8175 leftindex++;
8177 /* Move them up */
8178 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8179 sizeof(*expr->token) * (expr->len - leftindex));
8180 expr->len += 2;
8181 offset = (expr->len - leftindex) - 1;
8183 /* Now we rely on the fact the the left and right version have opcodes
8184 * 1 and 2 after the main opcode respectively
8186 expr->token[leftindex + 1].type = t->type + 1;
8187 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8189 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8190 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8192 /* Now add the 'R' operator */
8193 expr->token[expr->len].objPtr = interp->emptyObj;
8194 expr->token[expr->len].type = t->type + 2;
8195 expr->len++;
8197 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8198 for (i = leftindex - 1; i > 0; i--) {
8199 if (JimExprOperatorInfoByOpcode(expr->token[i].type)->lazy == LAZY_LEFT) {
8200 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8201 JimWideValue(expr->token[i - 1].objPtr) += 2;
8205 return JIM_OK;
8208 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8210 struct ScriptToken *token = &expr->token[expr->len];
8211 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8213 if (op->lazy == LAZY_OP) {
8214 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8215 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8216 return JIM_ERR;
8219 else {
8220 token->objPtr = interp->emptyObj;
8221 token->type = t->type;
8222 expr->len++;
8224 return JIM_OK;
8228 * Returns the index of the COLON_LEFT to the left of 'right_index'
8229 * taking into account nesting.
8231 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8233 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8235 int ternary_count = 1;
8237 right_index--;
8239 while (right_index > 1) {
8240 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8241 ternary_count--;
8243 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8244 ternary_count++;
8246 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8247 return right_index;
8249 right_index--;
8252 /*notreached*/
8253 return -1;
8257 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8259 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8260 * Otherwise returns 0.
8262 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8264 int i = right_index - 1;
8265 int ternary_count = 1;
8267 while (i > 1) {
8268 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8269 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8270 *prev_right_index = i - 2;
8271 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8272 return 1;
8275 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8276 if (ternary_count == 0) {
8277 return 0;
8279 ternary_count++;
8281 i--;
8283 return 0;
8287 * ExprTernaryReorderExpression description
8288 * ========================================
8290 * ?: is right-to-left associative which doesn't work with the stack-based
8291 * expression engine. The fix is to reorder the bytecode.
8293 * The expression:
8295 * expr 1?2:0?3:4
8297 * Has initial bytecode:
8299 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8300 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8302 * The fix involves simulating this expression instead:
8304 * expr 1?2:(0?3:4)
8306 * With the following bytecode:
8308 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8309 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8311 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8312 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8313 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8314 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8316 * ExprTernaryReorderExpression works thus as follows :
8317 * - start from the end of the stack
8318 * - while walking towards the beginning of the stack
8319 * if token=JIM_EXPROP_COLON_RIGHT then
8320 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8321 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8322 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8323 * if all found then
8324 * perform the rotation
8325 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8326 * end if
8327 * end if
8329 * Note: care has to be taken for nested ternary constructs!!!
8331 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8333 int i;
8335 for (i = expr->len - 1; i > 1; i--) {
8336 int prev_right_index;
8337 int prev_left_index;
8338 int j;
8339 ScriptToken tmp;
8341 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8342 continue;
8345 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8346 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8347 continue;
8351 ** rotate tokens down
8353 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8354 ** | | |
8355 ** | V V
8356 ** | [...] : ...
8357 ** | | |
8358 ** | V V
8359 ** | [...] : ...
8360 ** | | |
8361 ** | V V
8362 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8364 tmp = expr->token[prev_right_index];
8365 for (j = prev_right_index; j < i; j++) {
8366 expr->token[j] = expr->token[j + 1];
8368 expr->token[i] = tmp;
8370 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8372 * This is 'colon left increment' = i - prev_right_index
8374 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8375 * [prev_left_index-1] : skip_count
8378 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8380 /* Adjust for i-- in the loop */
8381 i++;
8385 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist)
8387 Jim_Stack stack;
8388 ExprByteCode *expr;
8389 int ok = 1;
8390 int i;
8391 int prevtt = JIM_TT_NONE;
8392 int have_ternary = 0;
8394 /* -1 for EOL */
8395 int count = tokenlist->count - 1;
8397 expr = Jim_Alloc(sizeof(*expr));
8398 expr->inUse = 1;
8399 expr->len = 0;
8401 Jim_InitStack(&stack);
8403 /* Need extra bytecodes for lazy operators.
8404 * Also check for the ternary operator
8406 for (i = 0; i < tokenlist->count; i++) {
8407 ParseToken *t = &tokenlist->list[i];
8409 if (JimExprOperatorInfoByOpcode(t->type)->lazy == LAZY_OP) {
8410 count += 2;
8411 /* Ternary is a lazy op but also needs reordering */
8412 if (t->type == JIM_EXPROP_TERNARY) {
8413 have_ternary = 1;
8418 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8420 for (i = 0; i < tokenlist->count && ok; i++) {
8421 ParseToken *t = &tokenlist->list[i];
8423 /* Next token will be stored here */
8424 struct ScriptToken *token = &expr->token[expr->len];
8426 if (t->type == JIM_TT_EOL) {
8427 break;
8430 switch (t->type) {
8431 case JIM_TT_STR:
8432 case JIM_TT_ESC:
8433 case JIM_TT_VAR:
8434 case JIM_TT_DICTSUGAR:
8435 case JIM_TT_EXPRSUGAR:
8436 case JIM_TT_CMD:
8437 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8438 token->type = t->type;
8439 expr->len++;
8440 break;
8442 case JIM_TT_EXPR_INT:
8443 token->objPtr = Jim_NewIntObj(interp, strtoull(t->token, NULL, 0));
8444 token->type = t->type;
8445 expr->len++;
8446 break;
8448 case JIM_TT_EXPR_DOUBLE:
8449 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, NULL));
8450 token->type = t->type;
8451 expr->len++;
8452 break;
8454 case JIM_TT_SUBEXPR_START:
8455 Jim_StackPush(&stack, t);
8456 prevtt = JIM_TT_NONE;
8457 continue;
8459 case JIM_TT_SUBEXPR_END:
8460 ok = 0;
8461 while (Jim_StackLen(&stack)) {
8462 ParseToken *tt = Jim_StackPop(&stack);
8464 if (tt->type == JIM_TT_SUBEXPR_START) {
8465 ok = 1;
8466 break;
8469 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8470 goto err;
8473 if (!ok) {
8474 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8475 goto err;
8477 break;
8480 default:{
8481 /* Must be an operator */
8482 const struct Jim_ExprOperator *op;
8483 ParseToken *tt;
8485 /* Convert -/+ to unary minus or unary plus if necessary */
8486 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
8487 if (t->type == JIM_EXPROP_SUB) {
8488 t->type = JIM_EXPROP_UNARYMINUS;
8490 else if (t->type == JIM_EXPROP_ADD) {
8491 t->type = JIM_EXPROP_UNARYPLUS;
8495 op = JimExprOperatorInfoByOpcode(t->type);
8497 /* Now handle precedence */
8498 while ((tt = Jim_StackPeek(&stack)) != NULL) {
8499 const struct Jim_ExprOperator *tt_op =
8500 JimExprOperatorInfoByOpcode(tt->type);
8502 /* Note that right-to-left associativity of ?: operator is handled later */
8504 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
8505 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8506 ok = 0;
8507 goto err;
8509 Jim_StackPop(&stack);
8511 else {
8512 break;
8515 Jim_StackPush(&stack, t);
8516 break;
8519 prevtt = t->type;
8522 /* Reduce any remaining subexpr */
8523 while (Jim_StackLen(&stack)) {
8524 ParseToken *tt = Jim_StackPop(&stack);
8526 if (tt->type == JIM_TT_SUBEXPR_START) {
8527 ok = 0;
8528 Jim_SetResultString(interp, "Missing close parenthesis", -1);
8529 goto err;
8531 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8532 ok = 0;
8533 goto err;
8537 if (have_ternary) {
8538 ExprTernaryReorderExpression(interp, expr);
8541 err:
8542 /* Free the stack used for the compilation. */
8543 Jim_FreeStack(&stack);
8545 for (i = 0; i < expr->len; i++) {
8546 Jim_IncrRefCount(expr->token[i].objPtr);
8549 if (!ok) {
8550 ExprFreeByteCode(interp, expr);
8551 return NULL;
8554 return expr;
8558 /* This method takes the string representation of an expression
8559 * and generates a program for the Expr's stack-based VM. */
8560 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
8562 int exprTextLen;
8563 const char *exprText;
8564 struct JimParserCtx parser;
8565 struct ExprByteCode *expr;
8566 ParseTokenList tokenlist;
8567 int rc = JIM_ERR;
8568 int line = 1;
8570 /* Try to get information about filename / line number */
8571 if (objPtr->typePtr == &sourceObjType) {
8572 line = objPtr->internalRep.sourceValue.lineNumber;
8575 exprText = Jim_GetString(objPtr, &exprTextLen);
8577 /* Initially tokenise the expression into tokenlist */
8578 ScriptTokenListInit(&tokenlist);
8580 JimParserInit(&parser, exprText, exprTextLen, line);
8581 while (!parser.eof) {
8582 if (JimParseExpression(&parser) != JIM_OK) {
8583 ScriptTokenListFree(&tokenlist);
8584 invalidexpr:
8585 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
8586 expr = NULL;
8587 goto err;
8590 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
8591 parser.tline);
8594 #ifdef DEBUG_SHOW_EXPR_TOKENS
8596 int i;
8597 printf("==== Expr Tokens ====\n");
8598 for (i = 0; i < tokenlist.count; i++) {
8599 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
8600 tokenlist.list[i].len, tokenlist.list[i].token);
8603 #endif
8605 /* Now create the expression bytecode from the tokenlist */
8606 expr = ExprCreateByteCode(interp, &tokenlist);
8608 /* No longer need the token list */
8609 ScriptTokenListFree(&tokenlist);
8611 if (!expr) {
8612 goto err;
8615 #ifdef DEBUG_SHOW_EXPR
8617 int i;
8619 printf("==== Expr ====\n");
8620 for (i = 0; i < expr->len; i++) {
8621 ScriptToken *t = &expr->token[i];
8623 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
8626 #endif
8628 /* Check program correctness. */
8629 if (ExprCheckCorrectness(expr) != JIM_OK) {
8630 ExprFreeByteCode(interp, expr);
8631 goto invalidexpr;
8634 rc = JIM_OK;
8636 err:
8637 /* Free the old internal rep and set the new one. */
8638 Jim_FreeIntRep(interp, objPtr);
8639 Jim_SetIntRepPtr(objPtr, expr);
8640 objPtr->typePtr = &exprObjType;
8641 return rc;
8644 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
8646 if (objPtr->typePtr != &exprObjType) {
8647 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
8648 return NULL;
8651 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
8654 /* -----------------------------------------------------------------------------
8655 * Expressions evaluation.
8656 * Jim uses a specialized stack-based virtual machine for expressions,
8657 * that takes advantage of the fact that expr's operators
8658 * can't be redefined.
8660 * Jim_EvalExpression() uses the bytecode compiled by
8661 * SetExprFromAny() method of the "expression" object.
8663 * On success a Tcl Object containing the result of the evaluation
8664 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
8665 * returned.
8666 * On error the function returns a retcode != to JIM_OK and set a suitable
8667 * error on the interp.
8668 * ---------------------------------------------------------------------------*/
8669 #define JIM_EE_STATICSTACK_LEN 10
8671 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
8673 ExprByteCode *expr;
8674 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
8675 int i;
8676 int retcode = JIM_OK;
8677 struct JimExprState e;
8679 expr = JimGetExpression(interp, exprObjPtr);
8680 if (!expr) {
8681 return JIM_ERR; /* error in expression. */
8684 #ifdef JIM_OPTIMIZATION
8685 /* Check for one of the following common expressions used by while/for
8687 * CONST
8688 * $a
8689 * !$a
8690 * $a < CONST, $a < $b
8691 * $a <= CONST, $a <= $b
8692 * $a > CONST, $a > $b
8693 * $a >= CONST, $a >= $b
8694 * $a != CONST, $a != $b
8695 * $a == CONST, $a == $b
8698 Jim_Obj *objPtr;
8700 /* STEP 1 -- Check if there are the conditions to run the specialized
8701 * version of while */
8703 switch (expr->len) {
8704 case 1:
8705 if (expr->token[0].type == JIM_TT_EXPR_INT) {
8706 *exprResultPtrPtr = expr->token[0].objPtr;
8707 Jim_IncrRefCount(*exprResultPtrPtr);
8708 return JIM_OK;
8710 if (expr->token[0].type == JIM_TT_VAR) {
8711 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
8712 if (objPtr) {
8713 *exprResultPtrPtr = objPtr;
8714 Jim_IncrRefCount(*exprResultPtrPtr);
8715 return JIM_OK;
8718 break;
8720 case 2:
8721 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
8722 jim_wide wideValue;
8724 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8725 if (objPtr && JimIsWide(objPtr)
8726 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
8727 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
8728 Jim_IncrRefCount(*exprResultPtrPtr);
8729 return JIM_OK;
8732 break;
8734 case 3:
8735 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
8736 || expr->token[1].type == JIM_TT_VAR)) {
8737 switch (expr->token[2].type) {
8738 case JIM_EXPROP_LT:
8739 case JIM_EXPROP_LTE:
8740 case JIM_EXPROP_GT:
8741 case JIM_EXPROP_GTE:
8742 case JIM_EXPROP_NUMEQ:
8743 case JIM_EXPROP_NUMNE:{
8744 /* optimise ok */
8745 jim_wide wideValueA;
8746 jim_wide wideValueB;
8748 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8749 if (objPtr && JimIsWide(objPtr)
8750 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
8751 if (expr->token[1].type == JIM_TT_VAR) {
8752 objPtr =
8753 Jim_GetVariable(interp, expr->token[1].objPtr,
8754 JIM_NONE);
8756 else {
8757 objPtr = expr->token[1].objPtr;
8759 if (objPtr && JimIsWide(objPtr)
8760 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
8761 int cmpRes;
8763 switch (expr->token[2].type) {
8764 case JIM_EXPROP_LT:
8765 cmpRes = wideValueA < wideValueB;
8766 break;
8767 case JIM_EXPROP_LTE:
8768 cmpRes = wideValueA <= wideValueB;
8769 break;
8770 case JIM_EXPROP_GT:
8771 cmpRes = wideValueA > wideValueB;
8772 break;
8773 case JIM_EXPROP_GTE:
8774 cmpRes = wideValueA >= wideValueB;
8775 break;
8776 case JIM_EXPROP_NUMEQ:
8777 cmpRes = wideValueA == wideValueB;
8778 break;
8779 case JIM_EXPROP_NUMNE:
8780 cmpRes = wideValueA != wideValueB;
8781 break;
8782 default: /*notreached */
8783 cmpRes = 0;
8785 *exprResultPtrPtr =
8786 cmpRes ? interp->trueObj : interp->falseObj;
8787 Jim_IncrRefCount(*exprResultPtrPtr);
8788 return JIM_OK;
8794 break;
8797 #endif
8799 /* In order to avoid that the internal repr gets freed due to
8800 * shimmering of the exprObjPtr's object, we make the internal rep
8801 * shared. */
8802 expr->inUse++;
8804 /* The stack-based expr VM itself */
8806 /* Stack allocation. Expr programs have the feature that
8807 * a program of length N can't require a stack longer than
8808 * N. */
8809 if (expr->len > JIM_EE_STATICSTACK_LEN)
8810 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
8811 else
8812 e.stack = staticStack;
8814 e.stacklen = 0;
8816 /* Execute every instruction */
8817 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
8818 Jim_Obj *objPtr;
8820 switch (expr->token[i].type) {
8821 case JIM_TT_EXPR_INT:
8822 case JIM_TT_EXPR_DOUBLE:
8823 case JIM_TT_STR:
8824 ExprPush(&e, expr->token[i].objPtr);
8825 break;
8827 case JIM_TT_VAR:
8828 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
8829 if (objPtr) {
8830 ExprPush(&e, objPtr);
8832 else {
8833 retcode = JIM_ERR;
8835 break;
8837 case JIM_TT_DICTSUGAR:
8838 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
8839 if (objPtr) {
8840 ExprPush(&e, objPtr);
8842 else {
8843 retcode = JIM_ERR;
8845 break;
8847 case JIM_TT_ESC:
8848 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
8849 if (retcode == JIM_OK) {
8850 ExprPush(&e, objPtr);
8852 break;
8854 case JIM_TT_CMD:
8855 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
8856 if (retcode == JIM_OK) {
8857 ExprPush(&e, Jim_GetResult(interp));
8859 break;
8861 default:{
8862 /* Find and execute the operation */
8863 e.skip = 0;
8864 e.opcode = expr->token[i].type;
8866 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
8867 /* Skip some opcodes if necessary */
8868 i += e.skip;
8869 continue;
8874 expr->inUse--;
8876 if (retcode == JIM_OK) {
8877 *exprResultPtrPtr = ExprPop(&e);
8879 else {
8880 for (i = 0; i < e.stacklen; i++) {
8881 Jim_DecrRefCount(interp, e.stack[i]);
8884 if (e.stack != staticStack) {
8885 Jim_Free(e.stack);
8887 return retcode;
8890 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
8892 int retcode;
8893 jim_wide wideValue;
8894 double doubleValue;
8895 Jim_Obj *exprResultPtr;
8897 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
8898 if (retcode != JIM_OK)
8899 return retcode;
8901 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
8902 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
8903 Jim_DecrRefCount(interp, exprResultPtr);
8904 return JIM_ERR;
8906 else {
8907 Jim_DecrRefCount(interp, exprResultPtr);
8908 *boolPtr = doubleValue != 0;
8909 return JIM_OK;
8912 *boolPtr = wideValue != 0;
8914 Jim_DecrRefCount(interp, exprResultPtr);
8915 return JIM_OK;
8918 /* -----------------------------------------------------------------------------
8919 * ScanFormat String Object
8920 * ---------------------------------------------------------------------------*/
8922 /* This Jim_Obj will held a parsed representation of a format string passed to
8923 * the Jim_ScanString command. For error diagnostics, the scanformat string has
8924 * to be parsed in its entirely first and then, if correct, can be used for
8925 * scanning. To avoid endless re-parsing, the parsed representation will be
8926 * stored in an internal representation and re-used for performance reason. */
8928 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
8929 * scanformat string. This part will later be used to extract information
8930 * out from the string to be parsed by Jim_ScanString */
8932 typedef struct ScanFmtPartDescr
8934 char type; /* Type of conversion (e.g. c, d, f) */
8935 char modifier; /* Modify type (e.g. l - long, h - short */
8936 size_t width; /* Maximal width of input to be converted */
8937 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
8938 char *arg; /* Specification of a CHARSET conversion */
8939 char *prefix; /* Prefix to be scanned literally before conversion */
8940 } ScanFmtPartDescr;
8942 /* The ScanFmtStringObj will hold the internal representation of a scanformat
8943 * string parsed and separated in part descriptions. Furthermore it contains
8944 * the original string representation of the scanformat string to allow for
8945 * fast update of the Jim_Obj's string representation part.
8947 * As an add-on the internal object representation adds some scratch pad area
8948 * for usage by Jim_ScanString to avoid endless allocating and freeing of
8949 * memory for purpose of string scanning.
8951 * The error member points to a static allocated string in case of a mal-
8952 * formed scanformat string or it contains '0' (NULL) in case of a valid
8953 * parse representation.
8955 * The whole memory of the internal representation is allocated as a single
8956 * area of memory that will be internally separated. So freeing and duplicating
8957 * of such an object is cheap */
8959 typedef struct ScanFmtStringObj
8961 jim_wide size; /* Size of internal repr in bytes */
8962 char *stringRep; /* Original string representation */
8963 size_t count; /* Number of ScanFmtPartDescr contained */
8964 size_t convCount; /* Number of conversions that will assign */
8965 size_t maxPos; /* Max position index if XPG3 is used */
8966 const char *error; /* Ptr to error text (NULL if no error */
8967 char *scratch; /* Some scratch pad used by Jim_ScanString */
8968 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
8969 } ScanFmtStringObj;
8972 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8973 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8974 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
8976 static const Jim_ObjType scanFmtStringObjType = {
8977 "scanformatstring",
8978 FreeScanFmtInternalRep,
8979 DupScanFmtInternalRep,
8980 UpdateStringOfScanFmt,
8981 JIM_TYPE_NONE,
8984 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8986 JIM_NOTUSED(interp);
8987 Jim_Free((char *)objPtr->internalRep.ptr);
8988 objPtr->internalRep.ptr = 0;
8991 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8993 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
8994 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
8996 JIM_NOTUSED(interp);
8997 memcpy(newVec, srcPtr->internalRep.ptr, size);
8998 dupPtr->internalRep.ptr = newVec;
8999 dupPtr->typePtr = &scanFmtStringObjType;
9002 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9004 char *bytes = ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep;
9006 objPtr->bytes = Jim_StrDup(bytes);
9007 objPtr->length = strlen(bytes);
9010 /* SetScanFmtFromAny will parse a given string and create the internal
9011 * representation of the format specification. In case of an error
9012 * the error data member of the internal representation will be set
9013 * to an descriptive error text and the function will be left with
9014 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9015 * specification */
9017 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9019 ScanFmtStringObj *fmtObj;
9020 char *buffer;
9021 int maxCount, i, approxSize, lastPos = -1;
9022 const char *fmt = objPtr->bytes;
9023 int maxFmtLen = objPtr->length;
9024 const char *fmtEnd = fmt + maxFmtLen;
9025 int curr;
9027 Jim_FreeIntRep(interp, objPtr);
9028 /* Count how many conversions could take place maximally */
9029 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9030 if (fmt[i] == '%')
9031 ++maxCount;
9032 /* Calculate an approximation of the memory necessary */
9033 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9034 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9035 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9036 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9037 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9038 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9039 +1; /* safety byte */
9040 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9041 memset(fmtObj, 0, approxSize);
9042 fmtObj->size = approxSize;
9043 fmtObj->maxPos = 0;
9044 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9045 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9046 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9047 buffer = fmtObj->stringRep + maxFmtLen + 1;
9048 objPtr->internalRep.ptr = fmtObj;
9049 objPtr->typePtr = &scanFmtStringObjType;
9050 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9051 int width = 0, skip;
9052 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9054 fmtObj->count++;
9055 descr->width = 0; /* Assume width unspecified */
9056 /* Overread and store any "literal" prefix */
9057 if (*fmt != '%' || fmt[1] == '%') {
9058 descr->type = 0;
9059 descr->prefix = &buffer[i];
9060 for (; fmt < fmtEnd; ++fmt) {
9061 if (*fmt == '%') {
9062 if (fmt[1] != '%')
9063 break;
9064 ++fmt;
9066 buffer[i++] = *fmt;
9068 buffer[i++] = 0;
9070 /* Skip the conversion introducing '%' sign */
9071 ++fmt;
9072 /* End reached due to non-conversion literal only? */
9073 if (fmt >= fmtEnd)
9074 goto done;
9075 descr->pos = 0; /* Assume "natural" positioning */
9076 if (*fmt == '*') {
9077 descr->pos = -1; /* Okay, conversion will not be assigned */
9078 ++fmt;
9080 else
9081 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9082 /* Check if next token is a number (could be width or pos */
9083 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9084 fmt += skip;
9085 /* Was the number a XPG3 position specifier? */
9086 if (descr->pos != -1 && *fmt == '$') {
9087 int prev;
9089 ++fmt;
9090 descr->pos = width;
9091 width = 0;
9092 /* Look if "natural" postioning and XPG3 one was mixed */
9093 if ((lastPos == 0 && descr->pos > 0)
9094 || (lastPos > 0 && descr->pos == 0)) {
9095 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9096 return JIM_ERR;
9098 /* Look if this position was already used */
9099 for (prev = 0; prev < curr; ++prev) {
9100 if (fmtObj->descr[prev].pos == -1)
9101 continue;
9102 if (fmtObj->descr[prev].pos == descr->pos) {
9103 fmtObj->error =
9104 "variable is assigned by multiple \"%n$\" conversion specifiers";
9105 return JIM_ERR;
9108 /* Try to find a width after the XPG3 specifier */
9109 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9110 descr->width = width;
9111 fmt += skip;
9113 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9114 fmtObj->maxPos = descr->pos;
9116 else {
9117 /* Number was not a XPG3, so it has to be a width */
9118 descr->width = width;
9121 /* If positioning mode was undetermined yet, fix this */
9122 if (lastPos == -1)
9123 lastPos = descr->pos;
9124 /* Handle CHARSET conversion type ... */
9125 if (*fmt == '[') {
9126 int swapped = 1, beg = i, end, j;
9128 descr->type = '[';
9129 descr->arg = &buffer[i];
9130 ++fmt;
9131 if (*fmt == '^')
9132 buffer[i++] = *fmt++;
9133 if (*fmt == ']')
9134 buffer[i++] = *fmt++;
9135 while (*fmt && *fmt != ']')
9136 buffer[i++] = *fmt++;
9137 if (*fmt != ']') {
9138 fmtObj->error = "unmatched [ in format string";
9139 return JIM_ERR;
9141 end = i;
9142 buffer[i++] = 0;
9143 /* In case a range fence was given "backwards", swap it */
9144 while (swapped) {
9145 swapped = 0;
9146 for (j = beg + 1; j < end - 1; ++j) {
9147 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9148 char tmp = buffer[j - 1];
9150 buffer[j - 1] = buffer[j + 1];
9151 buffer[j + 1] = tmp;
9152 swapped = 1;
9157 else {
9158 /* Remember any valid modifier if given */
9159 if (strchr("hlL", *fmt) != 0)
9160 descr->modifier = tolower((int)*fmt++);
9162 descr->type = *fmt;
9163 if (strchr("efgcsndoxui", *fmt) == 0) {
9164 fmtObj->error = "bad scan conversion character";
9165 return JIM_ERR;
9167 else if (*fmt == 'c' && descr->width != 0) {
9168 fmtObj->error = "field width may not be specified in %c " "conversion";
9169 return JIM_ERR;
9171 else if (*fmt == 'u' && descr->modifier == 'l') {
9172 fmtObj->error = "unsigned wide not supported";
9173 return JIM_ERR;
9176 curr++;
9178 done:
9179 return JIM_OK;
9182 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9184 #define FormatGetCnvCount(_fo_) \
9185 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9186 #define FormatGetMaxPos(_fo_) \
9187 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9188 #define FormatGetError(_fo_) \
9189 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9191 /* JimScanAString is used to scan an unspecified string that ends with
9192 * next WS, or a string that is specified via a charset.
9195 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9197 char *buffer = Jim_StrDup(str);
9198 char *p = buffer;
9200 while (*str) {
9201 int c;
9202 int n;
9204 if (!sdescr && isspace(UCHAR(*str)))
9205 break; /* EOS via WS if unspecified */
9207 n = utf8_tounicode(str, &c);
9208 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9209 break;
9210 while (n--)
9211 *p++ = *str++;
9213 *p = 0;
9214 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9217 /* ScanOneEntry will scan one entry out of the string passed as argument.
9218 * It use the sscanf() function for this task. After extracting and
9219 * converting of the value, the count of scanned characters will be
9220 * returned of -1 in case of no conversion tool place and string was
9221 * already scanned thru */
9223 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9224 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9226 const char *tok;
9227 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9228 size_t scanned = 0;
9229 size_t anchor = pos;
9230 int i;
9231 Jim_Obj *tmpObj = NULL;
9233 /* First pessimistically assume, we will not scan anything :-) */
9234 *valObjPtr = 0;
9235 if (descr->prefix) {
9236 /* There was a prefix given before the conversion, skip it and adjust
9237 * the string-to-be-parsed accordingly */
9238 /* XXX: Should be checking strLen, not str[pos] */
9239 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9240 /* If prefix require, skip WS */
9241 if (isspace(UCHAR(descr->prefix[i])))
9242 while (pos < strLen && isspace(UCHAR(str[pos])))
9243 ++pos;
9244 else if (descr->prefix[i] != str[pos])
9245 break; /* Prefix do not match here, leave the loop */
9246 else
9247 ++pos; /* Prefix matched so far, next round */
9249 if (pos >= strLen) {
9250 return -1; /* All of str consumed: EOF condition */
9252 else if (descr->prefix[i] != 0)
9253 return 0; /* Not whole prefix consumed, no conversion possible */
9255 /* For all but following conversion, skip leading WS */
9256 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9257 while (isspace(UCHAR(str[pos])))
9258 ++pos;
9259 /* Determine how much skipped/scanned so far */
9260 scanned = pos - anchor;
9262 /* %c is a special, simple case. no width */
9263 if (descr->type == 'n') {
9264 /* Return pseudo conversion means: how much scanned so far? */
9265 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9267 else if (pos >= strLen) {
9268 /* Cannot scan anything, as str is totally consumed */
9269 return -1;
9271 else if (descr->type == 'c') {
9272 int c;
9273 scanned += utf8_tounicode(&str[pos], &c);
9274 *valObjPtr = Jim_NewIntObj(interp, c);
9275 return scanned;
9277 else {
9278 /* Processing of conversions follows ... */
9279 if (descr->width > 0) {
9280 /* Do not try to scan as fas as possible but only the given width.
9281 * To ensure this, we copy the part that should be scanned. */
9282 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9283 size_t tLen = descr->width > sLen ? sLen : descr->width;
9285 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9286 tok = tmpObj->bytes;
9288 else {
9289 /* As no width was given, simply refer to the original string */
9290 tok = &str[pos];
9292 switch (descr->type) {
9293 case 'd':
9294 case 'o':
9295 case 'x':
9296 case 'u':
9297 case 'i':{
9298 char *endp; /* Position where the number finished */
9299 jim_wide w;
9301 int base = descr->type == 'o' ? 8
9302 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9304 /* Try to scan a number with the given base */
9305 w = strtoull(tok, &endp, base);
9306 if (endp == tok && base == 0) {
9307 /* If scanning failed, and base was undetermined, simply
9308 * put it to 10 and try once more. This should catch the
9309 * case where %i begin to parse a number prefix (e.g.
9310 * '0x' but no further digits follows. This will be
9311 * handled as a ZERO followed by a char 'x' by Tcl */
9312 w = strtoull(tok, &endp, 10);
9315 if (endp != tok) {
9316 /* There was some number sucessfully scanned! */
9317 *valObjPtr = Jim_NewIntObj(interp, w);
9319 /* Adjust the number-of-chars scanned so far */
9320 scanned += endp - tok;
9322 else {
9323 /* Nothing was scanned. We have to determine if this
9324 * happened due to e.g. prefix mismatch or input str
9325 * exhausted */
9326 scanned = *tok ? 0 : -1;
9328 break;
9330 case 's':
9331 case '[':{
9332 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9333 scanned += Jim_Length(*valObjPtr);
9334 break;
9336 case 'e':
9337 case 'f':
9338 case 'g':{
9339 char *endp;
9340 double value = strtod(tok, &endp);
9342 if (endp != tok) {
9343 /* There was some number sucessfully scanned! */
9344 *valObjPtr = Jim_NewDoubleObj(interp, value);
9345 /* Adjust the number-of-chars scanned so far */
9346 scanned += endp - tok;
9348 else {
9349 /* Nothing was scanned. We have to determine if this
9350 * happened due to e.g. prefix mismatch or input str
9351 * exhausted */
9352 scanned = *tok ? 0 : -1;
9354 break;
9357 /* If a substring was allocated (due to pre-defined width) do not
9358 * forget to free it */
9359 if (tmpObj) {
9360 Jim_FreeNewObj(interp, tmpObj);
9363 return scanned;
9366 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9367 * string and returns all converted (and not ignored) values in a list back
9368 * to the caller. If an error occured, a NULL pointer will be returned */
9370 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9372 size_t i, pos;
9373 int scanned = 1;
9374 const char *str = Jim_String(strObjPtr);
9375 int strLen = Jim_Utf8Length(interp, strObjPtr);
9376 Jim_Obj *resultList = 0;
9377 Jim_Obj **resultVec = 0;
9378 int resultc;
9379 Jim_Obj *emptyStr = 0;
9380 ScanFmtStringObj *fmtObj;
9382 /* This should never happen. The format object should already be of the correct type */
9383 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9385 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9386 /* Check if format specification was valid */
9387 if (fmtObj->error != 0) {
9388 if (flags & JIM_ERRMSG)
9389 Jim_SetResultString(interp, fmtObj->error, -1);
9390 return 0;
9392 /* Allocate a new "shared" empty string for all unassigned conversions */
9393 emptyStr = Jim_NewEmptyStringObj(interp);
9394 Jim_IncrRefCount(emptyStr);
9395 /* Create a list and fill it with empty strings up to max specified XPG3 */
9396 resultList = Jim_NewListObj(interp, 0, 0);
9397 if (fmtObj->maxPos > 0) {
9398 for (i = 0; i < fmtObj->maxPos; ++i)
9399 Jim_ListAppendElement(interp, resultList, emptyStr);
9400 JimListGetElements(interp, resultList, &resultc, &resultVec);
9402 /* Now handle every partial format description */
9403 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9404 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9405 Jim_Obj *value = 0;
9407 /* Only last type may be "literal" w/o conversion - skip it! */
9408 if (descr->type == 0)
9409 continue;
9410 /* As long as any conversion could be done, we will proceed */
9411 if (scanned > 0)
9412 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9413 /* In case our first try results in EOF, we will leave */
9414 if (scanned == -1 && i == 0)
9415 goto eof;
9416 /* Advance next pos-to-be-scanned for the amount scanned already */
9417 pos += scanned;
9419 /* value == 0 means no conversion took place so take empty string */
9420 if (value == 0)
9421 value = Jim_NewEmptyStringObj(interp);
9422 /* If value is a non-assignable one, skip it */
9423 if (descr->pos == -1) {
9424 Jim_FreeNewObj(interp, value);
9426 else if (descr->pos == 0)
9427 /* Otherwise append it to the result list if no XPG3 was given */
9428 Jim_ListAppendElement(interp, resultList, value);
9429 else if (resultVec[descr->pos - 1] == emptyStr) {
9430 /* But due to given XPG3, put the value into the corr. slot */
9431 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9432 Jim_IncrRefCount(value);
9433 resultVec[descr->pos - 1] = value;
9435 else {
9436 /* Otherwise, the slot was already used - free obj and ERROR */
9437 Jim_FreeNewObj(interp, value);
9438 goto err;
9441 Jim_DecrRefCount(interp, emptyStr);
9442 return resultList;
9443 eof:
9444 Jim_DecrRefCount(interp, emptyStr);
9445 Jim_FreeNewObj(interp, resultList);
9446 return (Jim_Obj *)EOF;
9447 err:
9448 Jim_DecrRefCount(interp, emptyStr);
9449 Jim_FreeNewObj(interp, resultList);
9450 return 0;
9453 /* -----------------------------------------------------------------------------
9454 * Pseudo Random Number Generation
9455 * ---------------------------------------------------------------------------*/
9456 /* Initialize the sbox with the numbers from 0 to 255 */
9457 static void JimPrngInit(Jim_Interp *interp)
9459 #define PRNG_SEED_SIZE 256
9460 int i;
9461 unsigned int *seed;
9462 time_t t = time(NULL);
9464 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9466 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9467 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9468 seed[i] = (rand() ^ t ^ clock());
9470 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9471 Jim_Free(seed);
9474 /* Generates N bytes of random data */
9475 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9477 Jim_PrngState *prng;
9478 unsigned char *destByte = (unsigned char *)dest;
9479 unsigned int si, sj, x;
9481 /* initialization, only needed the first time */
9482 if (interp->prngState == NULL)
9483 JimPrngInit(interp);
9484 prng = interp->prngState;
9485 /* generates 'len' bytes of pseudo-random numbers */
9486 for (x = 0; x < len; x++) {
9487 prng->i = (prng->i + 1) & 0xff;
9488 si = prng->sbox[prng->i];
9489 prng->j = (prng->j + si) & 0xff;
9490 sj = prng->sbox[prng->j];
9491 prng->sbox[prng->i] = sj;
9492 prng->sbox[prng->j] = si;
9493 *destByte++ = prng->sbox[(si + sj) & 0xff];
9497 /* Re-seed the generator with user-provided bytes */
9498 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9500 int i;
9501 Jim_PrngState *prng;
9503 /* initialization, only needed the first time */
9504 if (interp->prngState == NULL)
9505 JimPrngInit(interp);
9506 prng = interp->prngState;
9508 /* Set the sbox[i] with i */
9509 for (i = 0; i < 256; i++)
9510 prng->sbox[i] = i;
9511 /* Now use the seed to perform a random permutation of the sbox */
9512 for (i = 0; i < seedLen; i++) {
9513 unsigned char t;
9515 t = prng->sbox[i & 0xFF];
9516 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9517 prng->sbox[seed[i]] = t;
9519 prng->i = prng->j = 0;
9521 /* discard at least the first 256 bytes of stream.
9522 * borrow the seed buffer for this
9524 for (i = 0; i < 256; i += seedLen) {
9525 JimRandomBytes(interp, seed, seedLen);
9529 /* [incr] */
9530 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9532 jim_wide wideValue, increment = 1;
9533 Jim_Obj *intObjPtr;
9535 if (argc != 2 && argc != 3) {
9536 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9537 return JIM_ERR;
9539 if (argc == 3) {
9540 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9541 return JIM_ERR;
9543 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
9544 if (!intObjPtr) {
9545 /* Set missing variable to 0 */
9546 wideValue = 0;
9548 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
9549 return JIM_ERR;
9551 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
9552 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9553 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9554 Jim_FreeNewObj(interp, intObjPtr);
9555 return JIM_ERR;
9558 else {
9559 /* Can do it the quick way */
9560 Jim_InvalidateStringRep(intObjPtr);
9561 JimWideValue(intObjPtr) = wideValue + increment;
9563 /* The following step is required in order to invalidate the
9564 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9565 if (argv[1]->typePtr != &variableObjType) {
9566 /* Note that this can't fail since GetVariable already succeeded */
9567 Jim_SetVariable(interp, argv[1], intObjPtr);
9570 Jim_SetResult(interp, intObjPtr);
9571 return JIM_OK;
9575 /* -----------------------------------------------------------------------------
9576 * Eval
9577 * ---------------------------------------------------------------------------*/
9578 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
9579 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
9581 /* Handle calls to the [unknown] command */
9582 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *filename,
9583 int linenr)
9585 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
9586 int retCode;
9588 /* If JimUnknown() is recursively called too many times...
9589 * done here
9591 if (interp->unknown_called > 50) {
9592 return JIM_ERR;
9595 /* If the [unknown] command does not exists returns
9596 * just now */
9597 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
9598 return JIM_ERR;
9600 /* The object interp->unknown just contains
9601 * the "unknown" string, it is used in order to
9602 * avoid to lookup the unknown command every time
9603 * but instread to cache the result. */
9604 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
9605 v = sv;
9606 else
9607 v = Jim_Alloc(sizeof(Jim_Obj *) * (argc + 1));
9608 /* Make a copy of the arguments vector, but shifted on
9609 * the right of one position. The command name of the
9610 * command will be instead the first argument of the
9611 * [unknown] call. */
9612 memcpy(v + 1, argv, sizeof(Jim_Obj *) * argc);
9613 v[0] = interp->unknown;
9614 /* Call it */
9615 interp->unknown_called++;
9616 retCode = JimEvalObjVector(interp, argc + 1, v, filename, linenr);
9617 interp->unknown_called--;
9619 /* Clean up */
9620 if (v != sv)
9621 Jim_Free(v);
9622 return retCode;
9625 /* Eval the object vector 'objv' composed of 'objc' elements.
9626 * Every element is used as single argument.
9627 * Jim_EvalObj() will call this function every time its object
9628 * argument is of "list" type, with no string representation.
9630 * This is possible because the string representation of a
9631 * list object generated by the UpdateStringOfList is made
9632 * in a way that ensures that every list element is a different
9633 * command argument. */
9634 static int JimEvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv,
9635 const char *filename, int linenr)
9637 int i, retcode;
9638 Jim_Cmd *cmdPtr;
9640 /* Incr refcount of arguments. */
9641 for (i = 0; i < objc; i++)
9642 Jim_IncrRefCount(objv[i]);
9643 /* Command lookup */
9644 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
9645 if (cmdPtr == NULL) {
9646 retcode = JimUnknown(interp, objc, objv, filename, linenr);
9648 else {
9649 /* Call it -- Make sure result is an empty object. */
9650 JimIncrCmdRefCount(cmdPtr);
9651 Jim_SetEmptyResult(interp);
9652 if (cmdPtr->isproc) {
9653 retcode = JimCallProcedure(interp, cmdPtr, filename, linenr, objc, objv);
9655 else {
9656 interp->cmdPrivData = cmdPtr->u.native.privData;
9657 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
9659 JimDecrCmdRefCount(interp, cmdPtr);
9661 /* Decr refcount of arguments and return the retcode */
9662 for (i = 0; i < objc; i++)
9663 Jim_DecrRefCount(interp, objv[i]);
9665 return retcode;
9668 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
9670 return JimEvalObjVector(interp, objc, objv, NULL, 0);
9674 * Invokes 'prefix' as a command with the objv array as arguments.
9676 int Jim_EvalObjPrefix(Jim_Interp *interp, const char *prefix, int objc, Jim_Obj *const *objv)
9678 int i;
9679 int ret;
9680 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
9682 nargv[0] = Jim_NewStringObj(interp, prefix, -1);
9683 for (i = 0; i < objc; i++) {
9684 nargv[i + 1] = objv[i];
9686 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
9687 Jim_Free(nargv);
9688 return ret;
9691 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filename, int line)
9693 int rc = retcode;
9695 if (rc == JIM_ERR && !interp->errorFlag) {
9696 /* This is the first error, so save the file/line information and reset the stack */
9697 interp->errorFlag = 1;
9698 JimSetErrorFileName(interp, filename);
9699 JimSetErrorLineNumber(interp, line);
9701 JimResetStackTrace(interp);
9702 /* Always add a level where the error first occurs */
9703 interp->addStackTrace++;
9706 /* Now if this is an "interesting" level, add it to the stack trace */
9707 if (rc == JIM_ERR && interp->addStackTrace > 0) {
9708 /* Add the stack info for the current level */
9710 JimAppendStackTrace(interp, Jim_String(interp->errorProc), filename, line);
9712 /* Note: if we didn't have a filename for this level,
9713 * don't clear the addStackTrace flag
9714 * so we can pick it up at the next level
9716 if (*filename) {
9717 interp->addStackTrace = 0;
9720 Jim_DecrRefCount(interp, interp->errorProc);
9721 interp->errorProc = interp->emptyObj;
9722 Jim_IncrRefCount(interp->errorProc);
9724 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
9725 /* Propagate the addStackTrace value through 'return -code error' */
9727 else {
9728 interp->addStackTrace = 0;
9732 /* And delete any local procs */
9733 static void JimDeleteLocalProcs(Jim_Interp *interp)
9735 if (interp->localProcs) {
9736 char *procname;
9738 while ((procname = Jim_StackPop(interp->localProcs)) != NULL) {
9739 /* If there is a pushed command, find it */
9740 Jim_Cmd *prevCmd = NULL;
9741 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, procname);
9742 if (he) {
9743 Jim_Cmd *cmd = (Jim_Cmd *)he->u.val;
9744 if (cmd->isproc && cmd->u.proc.prevCmd) {
9745 prevCmd = cmd->u.proc.prevCmd;
9746 cmd->u.proc.prevCmd = NULL;
9750 /* Delete the local proc */
9751 Jim_DeleteCommand(interp, procname);
9753 if (prevCmd) {
9754 /* And restore the pushed command */
9755 Jim_AddHashEntry(&interp->commands, procname, prevCmd);
9757 Jim_Free(procname);
9759 Jim_FreeStack(interp->localProcs);
9760 Jim_Free(interp->localProcs);
9761 interp->localProcs = NULL;
9765 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
9767 Jim_Obj *objPtr;
9769 switch (token->type) {
9770 case JIM_TT_STR:
9771 case JIM_TT_ESC:
9772 objPtr = token->objPtr;
9773 break;
9774 case JIM_TT_VAR:
9775 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
9776 break;
9777 case JIM_TT_DICTSUGAR:
9778 objPtr = JimExpandDictSugar(interp, token->objPtr);
9779 break;
9780 case JIM_TT_EXPRSUGAR:
9781 objPtr = JimExpandExprSugar(interp, token->objPtr);
9782 break;
9783 case JIM_TT_CMD:
9784 switch (Jim_EvalObj(interp, token->objPtr)) {
9785 case JIM_OK:
9786 case JIM_RETURN:
9787 objPtr = interp->result;
9788 break;
9789 case JIM_BREAK:
9790 /* Stop substituting */
9791 return JIM_BREAK;
9792 case JIM_CONTINUE:
9793 /* just skip this one */
9794 return JIM_CONTINUE;
9795 default:
9796 return JIM_ERR;
9798 break;
9799 default:
9800 JimPanic((1,
9801 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
9802 objPtr = NULL;
9803 break;
9805 if (objPtr) {
9806 *objPtrPtr = objPtr;
9807 return JIM_OK;
9809 return JIM_ERR;
9812 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
9813 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
9814 * The returned object has refcount = 0.
9816 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
9818 int totlen = 0, i;
9819 Jim_Obj **intv;
9820 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
9821 Jim_Obj *objPtr;
9822 char *s;
9824 if (tokens <= JIM_EVAL_SINTV_LEN)
9825 intv = sintv;
9826 else
9827 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
9829 /* Compute every token forming the argument
9830 * in the intv objects vector. */
9831 for (i = 0; i < tokens; i++) {
9832 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
9833 case JIM_OK:
9834 case JIM_RETURN:
9835 break;
9836 case JIM_BREAK:
9837 if (flags & JIM_SUBST_FLAG) {
9838 /* Stop here */
9839 tokens = i;
9840 continue;
9842 /* XXX: Should probably set an error about break outside loop */
9843 /* fall through to error */
9844 case JIM_CONTINUE:
9845 if (flags & JIM_SUBST_FLAG) {
9846 intv[i] = NULL;
9847 continue;
9849 /* XXX: Ditto continue outside loop */
9850 /* fall through to error */
9851 default:
9852 while (i--) {
9853 Jim_DecrRefCount(interp, intv[i]);
9855 if (intv != sintv) {
9856 Jim_Free(intv);
9858 return NULL;
9860 Jim_IncrRefCount(intv[i]);
9861 Jim_String(intv[i]);
9862 totlen += intv[i]->length;
9865 /* Fast path return for a single token */
9866 if (tokens == 1 && intv[0] && intv == sintv) {
9867 Jim_DecrRefCount(interp, intv[0]);
9868 return intv[0];
9871 /* Concatenate every token in an unique
9872 * object. */
9873 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
9875 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
9876 && token[2].type == JIM_TT_VAR) {
9877 /* May be able to do fast interpolated object -> dictSubst */
9878 objPtr->typePtr = &interpolatedObjType;
9879 objPtr->internalRep.twoPtrValue.ptr1 = (void *)token;
9880 objPtr->internalRep.twoPtrValue.ptr2 = intv[2];
9881 Jim_IncrRefCount(intv[2]);
9884 s = objPtr->bytes = Jim_Alloc(totlen + 1);
9885 objPtr->length = totlen;
9886 for (i = 0; i < tokens; i++) {
9887 if (intv[i]) {
9888 memcpy(s, intv[i]->bytes, intv[i]->length);
9889 s += intv[i]->length;
9890 Jim_DecrRefCount(interp, intv[i]);
9893 objPtr->bytes[totlen] = '\0';
9894 /* Free the intv vector if not static. */
9895 if (intv != sintv) {
9896 Jim_Free(intv);
9899 return objPtr;
9903 /* If listPtr is a list, call JimEvalObjVector() with the given source info.
9904 * Otherwise eval with Jim_EvalObj()
9906 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr, const char *filename, int linenr)
9908 if (!Jim_IsList(listPtr)) {
9909 return Jim_EvalObj(interp, listPtr);
9911 else {
9912 int retcode = JIM_OK;
9914 if (listPtr->internalRep.listValue.len) {
9915 Jim_IncrRefCount(listPtr);
9916 retcode = JimEvalObjVector(interp,
9917 listPtr->internalRep.listValue.len,
9918 listPtr->internalRep.listValue.ele, filename, linenr);
9919 Jim_DecrRefCount(interp, listPtr);
9921 return retcode;
9925 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
9927 int i;
9928 ScriptObj *script;
9929 ScriptToken *token;
9930 int retcode = JIM_OK;
9931 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
9932 int linenr = 0;
9934 interp->errorFlag = 0;
9936 /* If the object is of type "list", we can call
9937 * a specialized version of Jim_EvalObj() */
9938 if (Jim_IsList(scriptObjPtr)) {
9939 return Jim_EvalObjList(interp, scriptObjPtr, NULL, 0);
9942 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
9943 script = Jim_GetScript(interp, scriptObjPtr);
9945 /* Reset the interpreter result. This is useful to
9946 * return the empty result in the case of empty program. */
9947 Jim_SetEmptyResult(interp);
9949 #ifdef JIM_OPTIMIZATION
9950 /* Check for one of the following common scripts used by for, while
9952 * {}
9953 * incr a
9955 if (script->len == 0) {
9956 Jim_DecrRefCount(interp, scriptObjPtr);
9957 return JIM_OK;
9959 if (script->len == 3
9960 && script->token[1].objPtr->typePtr == &commandObjType
9961 && script->token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
9962 && script->token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
9963 && script->token[2].objPtr->typePtr == &variableObjType) {
9965 Jim_Obj *objPtr = Jim_GetVariable(interp, script->token[2].objPtr, JIM_NONE);
9967 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
9968 JimWideValue(objPtr)++;
9969 Jim_InvalidateStringRep(objPtr);
9970 Jim_DecrRefCount(interp, scriptObjPtr);
9971 Jim_SetResult(interp, objPtr);
9972 return JIM_OK;
9975 #endif
9977 /* Now we have to make sure the internal repr will not be
9978 * freed on shimmering.
9980 * Think for example to this:
9982 * set x {llength $x; ... some more code ...}; eval $x
9984 * In order to preserve the internal rep, we increment the
9985 * inUse field of the script internal rep structure. */
9986 script->inUse++;
9988 token = script->token;
9989 argv = sargv;
9991 /* Execute every command sequentially until the end of the script
9992 * or an error occurs.
9994 for (i = 0; i < script->len && retcode == JIM_OK; ) {
9995 int argc;
9996 int j;
9997 Jim_Cmd *cmd;
9999 /* First token of the line is always JIM_TT_LINE */
10000 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10001 linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10003 /* Allocate the arguments vector if required */
10004 if (argc > JIM_EVAL_SARGV_LEN)
10005 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10007 /* Skip the JIM_TT_LINE token */
10008 i++;
10010 /* Populate the arguments objects.
10011 * If an error occurs, retcode will be set and
10012 * 'j' will be set to the number of args expanded
10014 for (j = 0; j < argc; j++) {
10015 long wordtokens = 1;
10016 int expand = 0;
10017 Jim_Obj *wordObjPtr = NULL;
10019 if (token[i].type == JIM_TT_WORD) {
10020 wordtokens = JimWideValue(token[i++].objPtr);
10021 if (wordtokens < 0) {
10022 expand = 1;
10023 wordtokens = -wordtokens;
10027 if (wordtokens == 1) {
10028 /* Fast path if the token does not
10029 * need interpolation */
10031 switch (token[i].type) {
10032 case JIM_TT_ESC:
10033 case JIM_TT_STR:
10034 wordObjPtr = token[i].objPtr;
10035 break;
10036 case JIM_TT_VAR:
10037 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10038 break;
10039 case JIM_TT_EXPRSUGAR:
10040 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10041 break;
10042 case JIM_TT_DICTSUGAR:
10043 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10044 break;
10045 case JIM_TT_CMD:
10046 retcode = Jim_EvalObj(interp, token[i].objPtr);
10047 if (retcode == JIM_OK) {
10048 wordObjPtr = Jim_GetResult(interp);
10050 break;
10051 default:
10052 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10055 else {
10056 /* For interpolation we call a helper
10057 * function to do the work for us. */
10058 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10061 if (!wordObjPtr) {
10062 if (retcode == JIM_OK) {
10063 retcode = JIM_ERR;
10065 break;
10068 Jim_IncrRefCount(wordObjPtr);
10069 i += wordtokens;
10071 if (!expand) {
10072 argv[j] = wordObjPtr;
10074 else {
10075 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10076 int len = Jim_ListLength(interp, wordObjPtr);
10077 int newargc = argc + len - 1;
10078 int k;
10080 if (len > 1) {
10081 if (argv == sargv) {
10082 if (newargc > JIM_EVAL_SARGV_LEN) {
10083 argv = Jim_Alloc(sizeof(*argv) * newargc);
10084 memcpy(argv, sargv, sizeof(*argv) * j);
10087 else {
10088 /* Need to realloc to make room for (len - 1) more entries */
10089 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10093 /* Now copy in the expanded version */
10094 for (k = 0; k < len; k++) {
10095 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10096 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10099 /* The original object reference is no longer needed,
10100 * after the expansion it is no longer present on
10101 * the argument vector, but the single elements are
10102 * in its place. */
10103 Jim_DecrRefCount(interp, wordObjPtr);
10105 /* And update the indexes */
10106 j--;
10107 argc += len - 1;
10111 if (retcode == JIM_OK && argc) {
10112 /* Lookup the command to call */
10113 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
10114 if (cmd != NULL) {
10115 /* Call it -- Make sure result is an empty object. */
10116 JimIncrCmdRefCount(cmd);
10117 Jim_SetEmptyResult(interp);
10118 if (cmd->isproc) {
10119 retcode =
10120 JimCallProcedure(interp, cmd, script->fileName, linenr, argc, argv);
10121 } else {
10122 interp->cmdPrivData = cmd->u.native.privData;
10123 retcode = cmd->u.native.cmdProc(interp, argc, argv);
10125 JimDecrCmdRefCount(interp, cmd);
10127 else {
10128 /* Call [unknown] */
10129 retcode = JimUnknown(interp, argc, argv, script->fileName, linenr);
10131 if (interp->signal_level && interp->sigmask) {
10132 /* Check for a signal after each command */
10133 retcode = JIM_SIGNAL;
10137 /* Finished with the command, so decrement ref counts of each argument */
10138 while (j-- > 0) {
10139 Jim_DecrRefCount(interp, argv[j]);
10142 if (argv != sargv) {
10143 Jim_Free(argv);
10144 argv = sargv;
10148 /* Possibly add to the error stack trace */
10149 JimAddErrorToStack(interp, retcode, script->fileName, linenr);
10151 /* Note that we don't have to decrement inUse, because the
10152 * following code transfers our use of the reference again to
10153 * the script object. */
10154 Jim_FreeIntRep(interp, scriptObjPtr);
10155 scriptObjPtr->typePtr = &scriptObjType;
10156 Jim_SetIntRepPtr(scriptObjPtr, script);
10157 Jim_DecrRefCount(interp, scriptObjPtr);
10159 return retcode;
10162 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10164 int retcode;
10165 /* If argObjPtr begins with '&', do an automatic upvar */
10166 const char *varname = Jim_String(argNameObj);
10167 if (*varname == '&') {
10168 /* First check that the target variable exists */
10169 Jim_Obj *objPtr;
10170 Jim_CallFrame *savedCallFrame = interp->framePtr;
10172 interp->framePtr = interp->framePtr->parentCallFrame;
10173 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10174 interp->framePtr = savedCallFrame;
10175 if (!objPtr) {
10176 return JIM_ERR;
10179 /* It exists, so perform the binding. */
10180 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10181 Jim_IncrRefCount(objPtr);
10182 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parentCallFrame);
10183 Jim_DecrRefCount(interp, objPtr);
10185 else {
10186 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10188 return retcode;
10192 * Sets the interp result to be an error message indicating the required proc args.
10194 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10196 /* Create a nice error message, consistent with Tcl 8.5 */
10197 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10198 int i;
10200 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10201 Jim_AppendString(interp, argmsg, " ", 1);
10203 if (i == cmd->u.proc.argsPos) {
10204 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10205 /* Renamed args */
10206 Jim_AppendString(interp, argmsg, "?", 1);
10207 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10208 Jim_AppendString(interp, argmsg, " ...?", -1);
10210 else {
10211 /* We have plain args */
10212 Jim_AppendString(interp, argmsg, "?argument ...?", -1);
10215 else {
10216 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10217 Jim_AppendString(interp, argmsg, "?", 1);
10218 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10219 Jim_AppendString(interp, argmsg, "?", 1);
10221 else {
10222 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10226 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10227 Jim_FreeNewObj(interp, argmsg);
10230 /* Call a procedure implemented in Tcl.
10231 * It's possible to speed-up a lot this function, currently
10232 * the callframes are not cached, but allocated and
10233 * destroied every time. What is expecially costly is
10234 * to create/destroy the local vars hash table every time.
10236 * This can be fixed just implementing callframes caching
10237 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10238 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
10239 Jim_Obj *const *argv)
10241 Jim_CallFrame *callFramePtr;
10242 Jim_Stack *prevLocalProcs;
10243 int i, d, retcode, optargs;
10245 /* Check arity */
10246 if (argc - 1 < cmd->u.proc.reqArity ||
10247 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10248 JimSetProcWrongArgs(interp, argv[0], cmd);
10249 return JIM_ERR;
10252 /* Check if there are too nested calls */
10253 if (interp->framePtr->level == interp->maxNestingDepth) {
10254 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10255 return JIM_ERR;
10258 /* Create a new callframe */
10259 callFramePtr = JimCreateCallFrame(interp, interp->framePtr);
10260 callFramePtr->argv = argv;
10261 callFramePtr->argc = argc;
10262 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10263 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10264 callFramePtr->staticVars = cmd->u.proc.staticVars;
10265 callFramePtr->filename = filename;
10266 callFramePtr->line = linenr;
10267 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10268 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10269 interp->framePtr = callFramePtr;
10271 /* How many optional args are available */
10272 optargs = (argc - 1 - cmd->u.proc.reqArity);
10274 /* Step 'i' along the actual args, and step 'd' along the formal args */
10275 i = 1;
10276 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10277 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10278 if (d == cmd->u.proc.argsPos) {
10279 /* assign $args */
10280 Jim_Obj *listObjPtr;
10281 int argsLen = 0;
10282 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10283 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10285 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10287 /* It is possible to rename args. */
10288 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10289 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10291 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10292 if (retcode != JIM_OK) {
10293 goto badargset;
10296 i += argsLen;
10297 continue;
10300 /* Optional or required? */
10301 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10302 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10304 else {
10305 /* Ran out, so use the default */
10306 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10308 if (retcode != JIM_OK) {
10309 goto badargset;
10313 /* Install a new stack for local procs */
10314 prevLocalProcs = interp->localProcs;
10315 interp->localProcs = NULL;
10317 /* Eval the body */
10318 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10320 /* Delete any local procs */
10321 JimDeleteLocalProcs(interp);
10322 interp->localProcs = prevLocalProcs;
10324 badargset:
10325 /* Destroy the callframe */
10326 interp->framePtr = interp->framePtr->parentCallFrame;
10327 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10328 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10330 else {
10331 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10333 /* Handle the JIM_EVAL return code */
10334 while (retcode == JIM_EVAL) {
10335 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
10337 Jim_IncrRefCount(resultScriptObjPtr);
10338 /* Should be a list! */
10339 retcode = Jim_EvalObjList(interp, resultScriptObjPtr, filename, linenr);
10340 Jim_DecrRefCount(interp, resultScriptObjPtr);
10342 /* Handle the JIM_RETURN return code */
10343 if (retcode == JIM_RETURN) {
10344 if (--interp->returnLevel <= 0) {
10345 retcode = interp->returnCode;
10346 interp->returnCode = JIM_OK;
10347 interp->returnLevel = 0;
10350 else if (retcode == JIM_ERR) {
10351 interp->addStackTrace++;
10352 Jim_DecrRefCount(interp, interp->errorProc);
10353 interp->errorProc = argv[0];
10354 Jim_IncrRefCount(interp->errorProc);
10356 return retcode;
10359 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
10361 int retval;
10362 Jim_Obj *scriptObjPtr;
10364 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10365 Jim_IncrRefCount(scriptObjPtr);
10368 if (filename) {
10369 Jim_Obj *prevScriptObj;
10371 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
10373 prevScriptObj = interp->currentScriptObj;
10374 interp->currentScriptObj = scriptObjPtr;
10376 retval = Jim_EvalObj(interp, scriptObjPtr);
10378 interp->currentScriptObj = prevScriptObj;
10380 else {
10381 retval = Jim_EvalObj(interp, scriptObjPtr);
10383 Jim_DecrRefCount(interp, scriptObjPtr);
10384 return retval;
10387 int Jim_Eval(Jim_Interp *interp, const char *script)
10389 return Jim_Eval_Named(interp, script, NULL, 0);
10392 /* Execute script in the scope of the global level */
10393 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10395 int retval;
10396 Jim_CallFrame *savedFramePtr = interp->framePtr;
10398 interp->framePtr = interp->topFramePtr;
10399 retval = Jim_Eval(interp, script);
10400 interp->framePtr = savedFramePtr;
10402 return retval;
10405 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10407 int retval;
10408 Jim_CallFrame *savedFramePtr = interp->framePtr;
10410 interp->framePtr = interp->topFramePtr;
10411 retval = Jim_EvalFile(interp, filename);
10412 interp->framePtr = savedFramePtr;
10414 return retval;
10417 #include <sys/stat.h>
10419 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10421 FILE *fp;
10422 char *buf;
10423 Jim_Obj *scriptObjPtr;
10424 Jim_Obj *prevScriptObj;
10425 struct stat sb;
10426 int retcode;
10427 int readlen;
10428 struct JimParseResult result;
10430 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10431 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10432 return JIM_ERR;
10434 if (sb.st_size == 0) {
10435 fclose(fp);
10436 return JIM_OK;
10439 buf = Jim_Alloc(sb.st_size + 1);
10440 readlen = fread(buf, 1, sb.st_size, fp);
10441 if (ferror(fp)) {
10442 fclose(fp);
10443 Jim_Free(buf);
10444 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10445 return JIM_ERR;
10447 fclose(fp);
10448 buf[readlen] = 0;
10450 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10451 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
10452 Jim_IncrRefCount(scriptObjPtr);
10454 /* Now check the script for unmatched braces, etc. */
10455 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
10456 const char *msg;
10457 char linebuf[20];
10459 switch (result.missing) {
10460 case '[':
10461 msg = "unmatched \"[\"";
10462 break;
10463 case '{':
10464 msg = "missing close-brace";
10465 break;
10466 case '"':
10467 default:
10468 msg = "missing quote";
10469 break;
10472 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
10474 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
10475 msg, filename, linebuf);
10476 Jim_DecrRefCount(interp, scriptObjPtr);
10477 return JIM_ERR;
10480 prevScriptObj = interp->currentScriptObj;
10481 interp->currentScriptObj = scriptObjPtr;
10483 retcode = Jim_EvalObj(interp, scriptObjPtr);
10485 /* Handle the JIM_RETURN return code */
10486 if (retcode == JIM_RETURN) {
10487 if (--interp->returnLevel <= 0) {
10488 retcode = interp->returnCode;
10489 interp->returnCode = JIM_OK;
10490 interp->returnLevel = 0;
10493 if (retcode == JIM_ERR) {
10494 /* EvalFile changes context, so add a stack frame here */
10495 interp->addStackTrace++;
10498 interp->currentScriptObj = prevScriptObj;
10500 Jim_DecrRefCount(interp, scriptObjPtr);
10502 return retcode;
10505 /* -----------------------------------------------------------------------------
10506 * Subst
10507 * ---------------------------------------------------------------------------*/
10508 static int JimParseSubstStr(struct JimParserCtx *pc)
10510 pc->tstart = pc->p;
10511 pc->tline = pc->linenr;
10512 while (pc->len && *pc->p != '$' && *pc->p != '[') {
10513 if (*pc->p == '\\' && pc->len > 1) {
10514 pc->p++;
10515 pc->len--;
10517 pc->p++;
10518 pc->len--;
10520 pc->tend = pc->p - 1;
10521 pc->tt = JIM_TT_ESC;
10522 return JIM_OK;
10525 static int JimParseSubst(struct JimParserCtx *pc, int flags)
10527 int retval;
10529 if (pc->len == 0) {
10530 pc->tstart = pc->tend = pc->p;
10531 pc->tline = pc->linenr;
10532 pc->tt = JIM_TT_EOL;
10533 pc->eof = 1;
10534 return JIM_OK;
10536 switch (*pc->p) {
10537 case '[':
10538 retval = JimParseCmd(pc);
10539 if (flags & JIM_SUBST_NOCMD) {
10540 pc->tstart--;
10541 pc->tend++;
10542 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
10544 return retval;
10545 break;
10546 case '$':
10547 if (JimParseVar(pc) == JIM_ERR) {
10548 pc->tstart = pc->tend = pc->p++;
10549 pc->len--;
10550 pc->tline = pc->linenr;
10551 pc->tt = JIM_TT_STR;
10553 else {
10554 if (flags & JIM_SUBST_NOVAR) {
10555 pc->tstart--;
10556 if (flags & JIM_SUBST_NOESC)
10557 pc->tt = JIM_TT_STR;
10558 else
10559 pc->tt = JIM_TT_ESC;
10560 if (*pc->tstart == '{') {
10561 pc->tstart--;
10562 if (*(pc->tend + 1))
10563 pc->tend++;
10567 break;
10568 default:
10569 retval = JimParseSubstStr(pc);
10570 if (flags & JIM_SUBST_NOESC)
10571 pc->tt = JIM_TT_STR;
10572 return retval;
10573 break;
10575 return JIM_OK;
10578 /* The subst object type reuses most of the data structures and functions
10579 * of the script object. Script's data structures are a bit more complex
10580 * for what is needed for [subst]itution tasks, but the reuse helps to
10581 * deal with a single data structure at the cost of some more memory
10582 * usage for substitutions. */
10584 /* This method takes the string representation of an object
10585 * as a Tcl string where to perform [subst]itution, and generates
10586 * the pre-parsed internal representation. */
10587 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
10589 int scriptTextLen;
10590 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
10591 struct JimParserCtx parser;
10592 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
10593 ParseTokenList tokenlist;
10595 /* Initially parse the subst into tokens (in tokenlist) */
10596 ScriptTokenListInit(&tokenlist);
10598 JimParserInit(&parser, scriptText, scriptTextLen, 1);
10599 while (1) {
10600 JimParseSubst(&parser, flags);
10601 if (parser.eof) {
10602 /* Note that subst doesn't need the EOL token */
10603 break;
10605 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
10606 parser.tline);
10609 /* Create the "real" subst/script tokens from the initial token list */
10610 script->inUse = 1;
10611 script->substFlags = flags;
10612 script->fileName = NULL;
10613 SubstObjAddTokens(interp, script, &tokenlist);
10615 /* No longer need the token list */
10616 ScriptTokenListFree(&tokenlist);
10618 #ifdef DEBUG_SHOW_SUBST
10620 int i;
10622 printf("==== Subst ====\n");
10623 for (i = 0; i < script->len; i++) {
10624 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
10625 Jim_String(script->token[i].objPtr));
10628 #endif
10630 /* Free the old internal rep and set the new one. */
10631 Jim_FreeIntRep(interp, objPtr);
10632 Jim_SetIntRepPtr(objPtr, script);
10633 objPtr->typePtr = &scriptObjType;
10634 return JIM_OK;
10637 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
10639 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
10640 SetSubstFromAny(interp, objPtr, flags);
10641 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
10644 /* Performs commands,variables,blackslashes substitution,
10645 * storing the result object (with refcount 0) into
10646 * resObjPtrPtr. */
10647 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
10649 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
10651 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
10652 /* In order to preserve the internal rep, we increment the
10653 * inUse field of the script internal rep structure. */
10654 script->inUse++;
10656 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
10658 script->inUse--;
10659 Jim_DecrRefCount(interp, substObjPtr);
10660 if (*resObjPtrPtr == NULL) {
10661 return JIM_ERR;
10663 return JIM_OK;
10666 /* -----------------------------------------------------------------------------
10667 * Core commands utility functions
10668 * ---------------------------------------------------------------------------*/
10669 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
10671 int i;
10672 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
10674 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
10675 for (i = 0; i < argc; i++) {
10676 Jim_AppendObj(interp, objPtr, argv[i]);
10677 if (!(i + 1 == argc && msg[0] == '\0'))
10678 Jim_AppendString(interp, objPtr, " ", 1);
10680 Jim_AppendString(interp, objPtr, msg, -1);
10681 Jim_AppendString(interp, objPtr, "\"", 1);
10682 Jim_SetResult(interp, objPtr);
10685 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
10687 /* type is: 0=commands, 1=procs, 2=channels */
10688 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
10690 Jim_HashTableIterator *htiter;
10691 Jim_HashEntry *he;
10692 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10694 /* Check for the non-pattern case. We can do this much more efficiently. */
10695 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
10696 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, patternObjPtr, JIM_NONE);
10697 if (cmdPtr) {
10698 if (type == 1 && !cmdPtr->isproc) {
10699 /* not a proc */
10701 else if (type == 2 && !Jim_AioFilehandle(interp, patternObjPtr)) {
10702 /* not a channel */
10704 else {
10705 Jim_ListAppendElement(interp, listObjPtr, patternObjPtr);
10708 return listObjPtr;
10711 htiter = Jim_GetHashTableIterator(&interp->commands);
10712 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10713 Jim_Cmd *cmdPtr = he->u.val;
10714 Jim_Obj *cmdNameObj;
10716 if (type == 1 && !cmdPtr->isproc) {
10717 /* not a proc */
10718 continue;
10720 if (patternObjPtr && !JimStringMatch(interp, patternObjPtr, he->key, 0))
10721 continue;
10723 cmdNameObj = Jim_NewStringObj(interp, he->key, -1);
10725 /* Is it a channel? */
10726 if (type == 2 && !Jim_AioFilehandle(interp, cmdNameObj)) {
10727 Jim_FreeNewObj(interp, cmdNameObj);
10728 continue;
10731 Jim_ListAppendElement(interp, listObjPtr, cmdNameObj);
10733 Jim_FreeHashTableIterator(htiter);
10734 return listObjPtr;
10737 /* Keep this in order */
10738 #define JIM_VARLIST_GLOBALS 0
10739 #define JIM_VARLIST_LOCALS 1
10740 #define JIM_VARLIST_VARS 2
10742 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
10744 Jim_HashTableIterator *htiter;
10745 Jim_HashEntry *he;
10746 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10748 if (mode == JIM_VARLIST_GLOBALS) {
10749 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
10751 else {
10752 /* For [info locals], if we are at top level an emtpy list
10753 * is returned. I don't agree, but we aim at compatibility (SS) */
10754 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr)
10755 return listObjPtr;
10756 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
10758 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10759 Jim_Var *varPtr = (Jim_Var *)he->u.val;
10761 if (mode == JIM_VARLIST_LOCALS) {
10762 if (varPtr->linkFramePtr != NULL)
10763 continue;
10765 if (patternObjPtr && !JimStringMatch(interp, patternObjPtr, he->key, 0))
10766 continue;
10767 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
10769 Jim_FreeHashTableIterator(htiter);
10770 return listObjPtr;
10773 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
10774 Jim_Obj **objPtrPtr, int info_level_cmd)
10776 Jim_CallFrame *targetCallFrame;
10778 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
10779 if (targetCallFrame == NULL) {
10780 return JIM_ERR;
10782 /* No proc call at toplevel callframe */
10783 if (targetCallFrame == interp->topFramePtr) {
10784 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
10785 return JIM_ERR;
10787 if (info_level_cmd) {
10788 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
10790 else {
10791 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
10793 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
10794 Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp,
10795 targetCallFrame->filename ? targetCallFrame->filename : "", -1));
10796 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
10797 *objPtrPtr = listObj;
10799 return JIM_OK;
10802 /* -----------------------------------------------------------------------------
10803 * Core commands
10804 * ---------------------------------------------------------------------------*/
10806 /* fake [puts] -- not the real puts, just for debugging. */
10807 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10809 if (argc != 2 && argc != 3) {
10810 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
10811 return JIM_ERR;
10813 if (argc == 3) {
10814 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
10815 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
10816 return JIM_ERR;
10818 else {
10819 fputs(Jim_String(argv[2]), stdout);
10822 else {
10823 puts(Jim_String(argv[1]));
10825 return JIM_OK;
10828 /* Helper for [+] and [*] */
10829 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10831 jim_wide wideValue, res;
10832 double doubleValue, doubleRes;
10833 int i;
10835 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
10837 for (i = 1; i < argc; i++) {
10838 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
10839 goto trydouble;
10840 if (op == JIM_EXPROP_ADD)
10841 res += wideValue;
10842 else
10843 res *= wideValue;
10845 Jim_SetResultInt(interp, res);
10846 return JIM_OK;
10847 trydouble:
10848 doubleRes = (double)res;
10849 for (; i < argc; i++) {
10850 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10851 return JIM_ERR;
10852 if (op == JIM_EXPROP_ADD)
10853 doubleRes += doubleValue;
10854 else
10855 doubleRes *= doubleValue;
10857 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10858 return JIM_OK;
10861 /* Helper for [-] and [/] */
10862 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10864 jim_wide wideValue, res = 0;
10865 double doubleValue, doubleRes = 0;
10866 int i = 2;
10868 if (argc < 2) {
10869 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
10870 return JIM_ERR;
10872 else if (argc == 2) {
10873 /* The arity = 2 case is different. For [- x] returns -x,
10874 * while [/ x] returns 1/x. */
10875 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
10876 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
10877 return JIM_ERR;
10879 else {
10880 if (op == JIM_EXPROP_SUB)
10881 doubleRes = -doubleValue;
10882 else
10883 doubleRes = 1.0 / doubleValue;
10884 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10885 return JIM_OK;
10888 if (op == JIM_EXPROP_SUB) {
10889 res = -wideValue;
10890 Jim_SetResultInt(interp, res);
10892 else {
10893 doubleRes = 1.0 / wideValue;
10894 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10896 return JIM_OK;
10898 else {
10899 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
10900 if (Jim_GetDouble(interp, argv[1], &doubleRes)
10901 != JIM_OK) {
10902 return JIM_ERR;
10904 else {
10905 goto trydouble;
10909 for (i = 2; i < argc; i++) {
10910 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
10911 doubleRes = (double)res;
10912 goto trydouble;
10914 if (op == JIM_EXPROP_SUB)
10915 res -= wideValue;
10916 else
10917 res /= wideValue;
10919 Jim_SetResultInt(interp, res);
10920 return JIM_OK;
10921 trydouble:
10922 for (; i < argc; i++) {
10923 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10924 return JIM_ERR;
10925 if (op == JIM_EXPROP_SUB)
10926 doubleRes -= doubleValue;
10927 else
10928 doubleRes /= doubleValue;
10930 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10931 return JIM_OK;
10935 /* [+] */
10936 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10938 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
10941 /* [*] */
10942 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10944 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
10947 /* [-] */
10948 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10950 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
10953 /* [/] */
10954 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10956 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
10959 /* [set] */
10960 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10962 if (argc != 2 && argc != 3) {
10963 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
10964 return JIM_ERR;
10966 if (argc == 2) {
10967 Jim_Obj *objPtr;
10969 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10970 if (!objPtr)
10971 return JIM_ERR;
10972 Jim_SetResult(interp, objPtr);
10973 return JIM_OK;
10975 /* argc == 3 case. */
10976 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10977 return JIM_ERR;
10978 Jim_SetResult(interp, argv[2]);
10979 return JIM_OK;
10982 /* [unset]
10984 * unset ?-nocomplain? ?--? ?varName ...?
10986 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10988 int i = 1;
10989 int complain = 1;
10991 while (i < argc) {
10992 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
10993 i++;
10994 break;
10996 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
10997 complain = 0;
10998 i++;
10999 continue;
11001 break;
11004 while (i < argc) {
11005 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11006 && complain) {
11007 return JIM_ERR;
11009 i++;
11011 return JIM_OK;
11014 /* [while] */
11015 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11017 if (argc != 3) {
11018 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11019 return JIM_ERR;
11022 /* The general purpose implementation of while starts here */
11023 while (1) {
11024 int boolean, retval;
11026 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11027 return retval;
11028 if (!boolean)
11029 break;
11031 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11032 switch (retval) {
11033 case JIM_BREAK:
11034 goto out;
11035 break;
11036 case JIM_CONTINUE:
11037 continue;
11038 break;
11039 default:
11040 return retval;
11044 out:
11045 Jim_SetEmptyResult(interp);
11046 return JIM_OK;
11049 /* [for] */
11050 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11052 int retval;
11053 int boolean = 1;
11054 Jim_Obj *varNamePtr = NULL;
11055 Jim_Obj *stopVarNamePtr = NULL;
11057 if (argc != 5) {
11058 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11059 return JIM_ERR;
11062 /* Do the initialisation */
11063 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11064 return retval;
11067 /* And do the first test now. Better for optimisation
11068 * if we can do next/test at the bottom of the loop
11070 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11072 /* Ready to do the body as follows:
11073 * while (1) {
11074 * body // check retcode
11075 * next // check retcode
11076 * test // check retcode/test bool
11080 #ifdef JIM_OPTIMIZATION
11081 /* Check if the for is on the form:
11082 * for ... {$i < CONST} {incr i}
11083 * for ... {$i < $j} {incr i}
11085 if (retval == JIM_OK && boolean) {
11086 ScriptObj *incrScript;
11087 ExprByteCode *expr;
11088 jim_wide stop, currentVal;
11089 unsigned jim_wide procEpoch;
11090 Jim_Obj *objPtr;
11091 int cmpOffset;
11093 /* Do it only if there aren't shared arguments */
11094 expr = JimGetExpression(interp, argv[2]);
11095 incrScript = Jim_GetScript(interp, argv[3]);
11097 /* Ensure proper lengths to start */
11098 if (incrScript->len != 3 || !expr || expr->len != 3) {
11099 goto evalstart;
11101 /* Ensure proper token types. */
11102 if (incrScript->token[1].type != JIM_TT_ESC ||
11103 expr->token[0].type != JIM_TT_VAR ||
11104 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11105 goto evalstart;
11108 if (expr->token[2].type == JIM_EXPROP_LT) {
11109 cmpOffset = 0;
11111 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11112 cmpOffset = 1;
11114 else {
11115 goto evalstart;
11118 /* Update command must be incr */
11119 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11120 goto evalstart;
11123 /* incr, expression must be about the same variable */
11124 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11125 goto evalstart;
11128 /* Get the stop condition (must be a variable or integer) */
11129 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11130 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11131 goto evalstart;
11134 else {
11135 stopVarNamePtr = expr->token[1].objPtr;
11136 Jim_IncrRefCount(stopVarNamePtr);
11137 /* Keep the compiler happy */
11138 stop = 0;
11141 /* Initialization */
11142 procEpoch = interp->procEpoch;
11143 varNamePtr = expr->token[0].objPtr;
11144 Jim_IncrRefCount(varNamePtr);
11146 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11147 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11148 goto testcond;
11151 /* --- OPTIMIZED FOR --- */
11152 while (retval == JIM_OK) {
11153 /* === Check condition === */
11154 /* Note that currentVal is already set here */
11156 /* Immediate or Variable? get the 'stop' value if the latter. */
11157 if (stopVarNamePtr) {
11158 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11159 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11160 goto testcond;
11164 if (currentVal >= stop + cmpOffset) {
11165 break;
11168 /* Eval body */
11169 retval = Jim_EvalObj(interp, argv[4]);
11170 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11171 retval = JIM_OK;
11172 /* If there was a change in procedures/command continue
11173 * with the usual [for] command implementation */
11174 if (procEpoch != interp->procEpoch) {
11175 goto evalnext;
11178 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11180 /* Increment */
11181 if (objPtr == NULL) {
11182 retval = JIM_ERR;
11183 goto out;
11185 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11186 currentVal = ++JimWideValue(objPtr);
11187 Jim_InvalidateStringRep(objPtr);
11189 else {
11190 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11191 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11192 ++currentVal)) != JIM_OK) {
11193 goto evalnext;
11198 goto out;
11200 evalstart:
11201 #endif
11203 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11204 /* Body */
11205 retval = Jim_EvalObj(interp, argv[4]);
11207 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11208 /* increment */
11209 evalnext:
11210 retval = Jim_EvalObj(interp, argv[3]);
11211 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11212 /* test */
11213 testcond:
11214 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11218 out:
11219 if (stopVarNamePtr) {
11220 Jim_DecrRefCount(interp, stopVarNamePtr);
11222 if (varNamePtr) {
11223 Jim_DecrRefCount(interp, varNamePtr);
11226 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11227 Jim_SetEmptyResult(interp);
11228 return JIM_OK;
11231 return retval;
11234 /* [loop] */
11235 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11237 int retval;
11238 jim_wide i;
11239 jim_wide limit;
11240 jim_wide incr = 1;
11241 Jim_Obj *bodyObjPtr;
11243 if (argc != 5 && argc != 6) {
11244 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11245 return JIM_ERR;
11248 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11249 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11250 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11251 return JIM_ERR;
11253 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11255 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11257 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11258 retval = Jim_EvalObj(interp, bodyObjPtr);
11259 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11260 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11262 retval = JIM_OK;
11264 /* Increment */
11265 i += incr;
11267 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11268 if (argv[1]->typePtr != &variableObjType) {
11269 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11270 return JIM_ERR;
11273 JimWideValue(objPtr) = i;
11274 Jim_InvalidateStringRep(objPtr);
11276 /* The following step is required in order to invalidate the
11277 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11278 if (argv[1]->typePtr != &variableObjType) {
11279 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11280 retval = JIM_ERR;
11281 break;
11285 else {
11286 objPtr = Jim_NewIntObj(interp, i);
11287 retval = Jim_SetVariable(interp, argv[1], objPtr);
11288 if (retval != JIM_OK) {
11289 Jim_FreeNewObj(interp, objPtr);
11295 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11296 Jim_SetEmptyResult(interp);
11297 return JIM_OK;
11299 return retval;
11302 /* foreach + lmap implementation. */
11303 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11305 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
11306 int nbrOfLoops = 0;
11307 Jim_Obj *emptyStr, *script, *mapRes = NULL;
11309 if (argc < 4 || argc % 2 != 0) {
11310 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11311 return JIM_ERR;
11313 if (doMap) {
11314 mapRes = Jim_NewListObj(interp, NULL, 0);
11315 Jim_IncrRefCount(mapRes);
11317 emptyStr = Jim_NewEmptyStringObj(interp);
11318 Jim_IncrRefCount(emptyStr);
11319 script = argv[argc - 1]; /* Last argument is a script */
11320 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
11321 listsIdx = (int *)Jim_Alloc(nbrOfLists * sizeof(int));
11322 listsEnd = (int *)Jim_Alloc(nbrOfLists * 2 * sizeof(int));
11323 /* Initialize iterators and remember max nbr elements each list */
11324 memset(listsIdx, 0, nbrOfLists * sizeof(int));
11325 /* Remember lengths of all lists and calculate how much rounds to loop */
11326 for (i = 0; i < nbrOfLists * 2; i += 2) {
11327 div_t cnt;
11328 int count;
11330 listsEnd[i] = Jim_ListLength(interp, argv[i + 1]);
11331 listsEnd[i + 1] = Jim_ListLength(interp, argv[i + 2]);
11332 if (listsEnd[i] == 0) {
11333 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11334 goto err;
11336 cnt = div(listsEnd[i + 1], listsEnd[i]);
11337 count = cnt.quot + (cnt.rem ? 1 : 0);
11338 if (count > nbrOfLoops)
11339 nbrOfLoops = count;
11341 for (; nbrOfLoops-- > 0;) {
11342 for (i = 0; i < nbrOfLists; ++i) {
11343 int varIdx = 0, var = i * 2;
11345 while (varIdx < listsEnd[var]) {
11346 Jim_Obj *varName, *ele;
11347 int lst = i * 2 + 1;
11349 /* List index operations below can't fail */
11350 Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_NONE);
11351 if (listsIdx[i] < listsEnd[lst]) {
11352 Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_NONE);
11353 /* Avoid shimmering */
11354 Jim_IncrRefCount(ele);
11355 result = Jim_SetVariable(interp, varName, ele);
11356 Jim_DecrRefCount(interp, ele);
11357 if (result == JIM_OK) {
11358 ++listsIdx[i]; /* Remember next iterator of current list */
11359 ++varIdx; /* Next variable */
11360 continue;
11363 else if (Jim_SetVariable(interp, varName, emptyStr) == JIM_OK) {
11364 ++varIdx; /* Next variable */
11365 continue;
11367 goto err;
11370 switch (result = Jim_EvalObj(interp, script)) {
11371 case JIM_OK:
11372 if (doMap)
11373 Jim_ListAppendElement(interp, mapRes, interp->result);
11374 break;
11375 case JIM_CONTINUE:
11376 break;
11377 case JIM_BREAK:
11378 goto out;
11379 break;
11380 default:
11381 goto err;
11384 out:
11385 result = JIM_OK;
11386 if (doMap)
11387 Jim_SetResult(interp, mapRes);
11388 else
11389 Jim_SetEmptyResult(interp);
11390 err:
11391 if (doMap)
11392 Jim_DecrRefCount(interp, mapRes);
11393 Jim_DecrRefCount(interp, emptyStr);
11394 Jim_Free(listsIdx);
11395 Jim_Free(listsEnd);
11396 return result;
11399 /* [foreach] */
11400 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11402 return JimForeachMapHelper(interp, argc, argv, 0);
11405 /* [lmap] */
11406 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11408 return JimForeachMapHelper(interp, argc, argv, 1);
11411 /* [if] */
11412 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11414 int boolean, retval, current = 1, falsebody = 0;
11416 if (argc >= 3) {
11417 while (1) {
11418 /* Far not enough arguments given! */
11419 if (current >= argc)
11420 goto err;
11421 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11422 != JIM_OK)
11423 return retval;
11424 /* There lacks something, isn't it? */
11425 if (current >= argc)
11426 goto err;
11427 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11428 current++;
11429 /* Tsk tsk, no then-clause? */
11430 if (current >= argc)
11431 goto err;
11432 if (boolean)
11433 return Jim_EvalObj(interp, argv[current]);
11434 /* Ok: no else-clause follows */
11435 if (++current >= argc) {
11436 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11437 return JIM_OK;
11439 falsebody = current++;
11440 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
11441 /* IIICKS - else-clause isn't last cmd? */
11442 if (current != argc - 1)
11443 goto err;
11444 return Jim_EvalObj(interp, argv[current]);
11446 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
11447 /* Ok: elseif follows meaning all the stuff
11448 * again (how boring...) */
11449 continue;
11450 /* OOPS - else-clause is not last cmd? */
11451 else if (falsebody != argc - 1)
11452 goto err;
11453 return Jim_EvalObj(interp, argv[falsebody]);
11455 return JIM_OK;
11457 err:
11458 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11459 return JIM_ERR;
11463 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11464 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
11465 Jim_Obj *stringObj, int nocase)
11467 Jim_Obj *parms[4];
11468 int argc = 0;
11469 long eq;
11470 int rc;
11472 parms[argc++] = commandObj;
11473 if (nocase) {
11474 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
11476 parms[argc++] = patternObj;
11477 parms[argc++] = stringObj;
11479 rc = Jim_EvalObjVector(interp, argc, parms);
11481 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
11482 eq = -rc;
11485 return eq;
11488 enum
11489 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
11491 /* [switch] */
11492 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11494 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
11495 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
11496 Jim_Obj *script = 0;
11498 if (argc < 3) {
11499 wrongnumargs:
11500 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
11501 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
11502 return JIM_ERR;
11504 for (opt = 1; opt < argc; ++opt) {
11505 const char *option = Jim_GetString(argv[opt], 0);
11507 if (*option != '-')
11508 break;
11509 else if (strncmp(option, "--", 2) == 0) {
11510 ++opt;
11511 break;
11513 else if (strncmp(option, "-exact", 2) == 0)
11514 matchOpt = SWITCH_EXACT;
11515 else if (strncmp(option, "-glob", 2) == 0)
11516 matchOpt = SWITCH_GLOB;
11517 else if (strncmp(option, "-regexp", 2) == 0)
11518 matchOpt = SWITCH_RE;
11519 else if (strncmp(option, "-command", 2) == 0) {
11520 matchOpt = SWITCH_CMD;
11521 if ((argc - opt) < 2)
11522 goto wrongnumargs;
11523 command = argv[++opt];
11525 else {
11526 Jim_SetResultFormatted(interp,
11527 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
11528 argv[opt]);
11529 return JIM_ERR;
11531 if ((argc - opt) < 2)
11532 goto wrongnumargs;
11534 strObj = argv[opt++];
11535 patCount = argc - opt;
11536 if (patCount == 1) {
11537 Jim_Obj **vector;
11539 JimListGetElements(interp, argv[opt], &patCount, &vector);
11540 caseList = vector;
11542 else
11543 caseList = &argv[opt];
11544 if (patCount == 0 || patCount % 2 != 0)
11545 goto wrongnumargs;
11546 for (i = 0; script == 0 && i < patCount; i += 2) {
11547 Jim_Obj *patObj = caseList[i];
11549 if (!Jim_CompareStringImmediate(interp, patObj, "default")
11550 || i < (patCount - 2)) {
11551 switch (matchOpt) {
11552 case SWITCH_EXACT:
11553 if (Jim_StringEqObj(strObj, patObj))
11554 script = caseList[i + 1];
11555 break;
11556 case SWITCH_GLOB:
11557 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
11558 script = caseList[i + 1];
11559 break;
11560 case SWITCH_RE:
11561 command = Jim_NewStringObj(interp, "regexp", -1);
11562 /* Fall thru intentionally */
11563 case SWITCH_CMD:{
11564 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
11566 /* After the execution of a command we need to
11567 * make sure to reconvert the object into a list
11568 * again. Only for the single-list style [switch]. */
11569 if (argc - opt == 1) {
11570 Jim_Obj **vector;
11572 JimListGetElements(interp, argv[opt], &patCount, &vector);
11573 caseList = vector;
11575 /* command is here already decref'd */
11576 if (rc < 0) {
11577 return -rc;
11579 if (rc)
11580 script = caseList[i + 1];
11581 break;
11585 else {
11586 script = caseList[i + 1];
11589 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
11590 script = caseList[i + 1];
11591 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
11592 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
11593 return JIM_ERR;
11595 Jim_SetEmptyResult(interp);
11596 if (script) {
11597 return Jim_EvalObj(interp, script);
11599 return JIM_OK;
11602 /* [list] */
11603 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11605 Jim_Obj *listObjPtr;
11607 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
11608 Jim_SetResult(interp, listObjPtr);
11609 return JIM_OK;
11612 /* [lindex] */
11613 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11615 Jim_Obj *objPtr, *listObjPtr;
11616 int i;
11617 int idx;
11619 if (argc < 3) {
11620 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
11621 return JIM_ERR;
11623 objPtr = argv[1];
11624 Jim_IncrRefCount(objPtr);
11625 for (i = 2; i < argc; i++) {
11626 listObjPtr = objPtr;
11627 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
11628 Jim_DecrRefCount(interp, listObjPtr);
11629 return JIM_ERR;
11631 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
11632 /* Returns an empty object if the index
11633 * is out of range. */
11634 Jim_DecrRefCount(interp, listObjPtr);
11635 Jim_SetEmptyResult(interp);
11636 return JIM_OK;
11638 Jim_IncrRefCount(objPtr);
11639 Jim_DecrRefCount(interp, listObjPtr);
11641 Jim_SetResult(interp, objPtr);
11642 Jim_DecrRefCount(interp, objPtr);
11643 return JIM_OK;
11646 /* [llength] */
11647 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11649 if (argc != 2) {
11650 Jim_WrongNumArgs(interp, 1, argv, "list");
11651 return JIM_ERR;
11653 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
11654 return JIM_OK;
11657 /* [lsearch] */
11658 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11660 static const char * const options[] = {
11661 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
11662 NULL
11664 enum
11665 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
11666 OPT_COMMAND };
11667 int i;
11668 int opt_bool = 0;
11669 int opt_not = 0;
11670 int opt_nocase = 0;
11671 int opt_all = 0;
11672 int opt_inline = 0;
11673 int opt_match = OPT_EXACT;
11674 int listlen;
11675 int rc = JIM_OK;
11676 Jim_Obj *listObjPtr = NULL;
11677 Jim_Obj *commandObj = NULL;
11679 if (argc < 3) {
11680 wrongargs:
11681 Jim_WrongNumArgs(interp, 1, argv,
11682 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
11683 return JIM_ERR;
11686 for (i = 1; i < argc - 2; i++) {
11687 int option;
11689 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
11690 return JIM_ERR;
11692 switch (option) {
11693 case OPT_BOOL:
11694 opt_bool = 1;
11695 opt_inline = 0;
11696 break;
11697 case OPT_NOT:
11698 opt_not = 1;
11699 break;
11700 case OPT_NOCASE:
11701 opt_nocase = 1;
11702 break;
11703 case OPT_INLINE:
11704 opt_inline = 1;
11705 opt_bool = 0;
11706 break;
11707 case OPT_ALL:
11708 opt_all = 1;
11709 break;
11710 case OPT_COMMAND:
11711 if (i >= argc - 2) {
11712 goto wrongargs;
11714 commandObj = argv[++i];
11715 /* fallthru */
11716 case OPT_EXACT:
11717 case OPT_GLOB:
11718 case OPT_REGEXP:
11719 opt_match = option;
11720 break;
11724 argv += i;
11726 if (opt_all) {
11727 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11729 if (opt_match == OPT_REGEXP) {
11730 commandObj = Jim_NewStringObj(interp, "regexp", -1);
11732 if (commandObj) {
11733 Jim_IncrRefCount(commandObj);
11736 listlen = Jim_ListLength(interp, argv[0]);
11737 for (i = 0; i < listlen; i++) {
11738 Jim_Obj *objPtr;
11739 int eq = 0;
11741 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
11742 switch (opt_match) {
11743 case OPT_EXACT:
11744 eq = Jim_StringCompareObj(interp, objPtr, argv[1], opt_nocase) == 0;
11745 break;
11747 case OPT_GLOB:
11748 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
11749 break;
11751 case OPT_REGEXP:
11752 case OPT_COMMAND:
11753 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
11754 if (eq < 0) {
11755 if (listObjPtr) {
11756 Jim_FreeNewObj(interp, listObjPtr);
11758 rc = JIM_ERR;
11759 goto done;
11761 break;
11764 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
11765 if (!eq && opt_bool && opt_not && !opt_all) {
11766 continue;
11769 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
11770 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
11771 Jim_Obj *resultObj;
11773 if (opt_bool) {
11774 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
11776 else if (!opt_inline) {
11777 resultObj = Jim_NewIntObj(interp, i);
11779 else {
11780 resultObj = objPtr;
11783 if (opt_all) {
11784 Jim_ListAppendElement(interp, listObjPtr, resultObj);
11786 else {
11787 Jim_SetResult(interp, resultObj);
11788 goto done;
11793 if (opt_all) {
11794 Jim_SetResult(interp, listObjPtr);
11796 else {
11797 /* No match */
11798 if (opt_bool) {
11799 Jim_SetResultBool(interp, opt_not);
11801 else if (!opt_inline) {
11802 Jim_SetResultInt(interp, -1);
11806 done:
11807 if (commandObj) {
11808 Jim_DecrRefCount(interp, commandObj);
11810 return rc;
11813 /* [lappend] */
11814 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11816 Jim_Obj *listObjPtr;
11817 int shared, i;
11819 if (argc < 2) {
11820 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
11821 return JIM_ERR;
11823 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
11824 if (!listObjPtr) {
11825 /* Create the list if it does not exists */
11826 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11827 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11828 Jim_FreeNewObj(interp, listObjPtr);
11829 return JIM_ERR;
11832 shared = Jim_IsShared(listObjPtr);
11833 if (shared)
11834 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
11835 for (i = 2; i < argc; i++)
11836 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
11837 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11838 if (shared)
11839 Jim_FreeNewObj(interp, listObjPtr);
11840 return JIM_ERR;
11842 Jim_SetResult(interp, listObjPtr);
11843 return JIM_OK;
11846 /* [linsert] */
11847 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11849 int idx, len;
11850 Jim_Obj *listPtr;
11852 if (argc < 4) {
11853 Jim_WrongNumArgs(interp, 1, argv, "list index element " "?element ...?");
11854 return JIM_ERR;
11856 listPtr = argv[1];
11857 if (Jim_IsShared(listPtr))
11858 listPtr = Jim_DuplicateObj(interp, listPtr);
11859 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
11860 goto err;
11861 len = Jim_ListLength(interp, listPtr);
11862 if (idx >= len)
11863 idx = len;
11864 else if (idx < 0)
11865 idx = len + idx + 1;
11866 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
11867 Jim_SetResult(interp, listPtr);
11868 return JIM_OK;
11869 err:
11870 if (listPtr != argv[1]) {
11871 Jim_FreeNewObj(interp, listPtr);
11873 return JIM_ERR;
11876 /* [lreplace] */
11877 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11879 int first, last, len, rangeLen;
11880 Jim_Obj *listObj;
11881 Jim_Obj *newListObj;
11882 int i;
11883 int shared;
11885 if (argc < 4) {
11886 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element element ...?");
11887 return JIM_ERR;
11889 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
11890 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
11891 return JIM_ERR;
11894 listObj = argv[1];
11895 len = Jim_ListLength(interp, listObj);
11897 first = JimRelToAbsIndex(len, first);
11898 last = JimRelToAbsIndex(len, last);
11899 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
11901 /* Now construct a new list which consists of:
11902 * <elements before first> <supplied elements> <elements after last>
11905 /* Check to see if trying to replace past the end of the list */
11906 if (first < len) {
11907 /* OK. Not past the end */
11909 else if (len == 0) {
11910 /* Special for empty list, adjust first to 0 */
11911 first = 0;
11913 else {
11914 Jim_SetResultString(interp, "list doesn't contain element ", -1);
11915 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
11916 return JIM_ERR;
11919 newListObj = Jim_NewListObj(interp, NULL, 0);
11921 shared = Jim_IsShared(listObj);
11922 if (shared) {
11923 listObj = Jim_DuplicateObj(interp, listObj);
11926 /* Add the first set of elements */
11927 for (i = 0; i < first; i++) {
11928 Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
11931 /* Add supplied elements */
11932 for (i = 4; i < argc; i++) {
11933 Jim_ListAppendElement(interp, newListObj, argv[i]);
11936 /* Add the remaining elements */
11937 for (i = first + rangeLen; i < len; i++) {
11938 Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
11940 Jim_SetResult(interp, newListObj);
11941 if (shared) {
11942 Jim_FreeNewObj(interp, listObj);
11944 return JIM_OK;
11947 /* [lset] */
11948 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11950 if (argc < 3) {
11951 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
11952 return JIM_ERR;
11954 else if (argc == 3) {
11955 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11956 return JIM_ERR;
11957 Jim_SetResult(interp, argv[2]);
11958 return JIM_OK;
11960 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
11961 == JIM_ERR)
11962 return JIM_ERR;
11963 return JIM_OK;
11966 /* [lsort] */
11967 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
11969 static const char * const options[] = {
11970 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
11972 enum
11973 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_INDEX };
11974 Jim_Obj *resObj;
11975 int i;
11976 int retCode;
11978 struct lsort_info info;
11980 if (argc < 2) {
11981 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
11982 return JIM_ERR;
11985 info.type = JIM_LSORT_ASCII;
11986 info.order = 1;
11987 info.indexed = 0;
11988 info.command = NULL;
11989 info.interp = interp;
11991 for (i = 1; i < (argc - 1); i++) {
11992 int option;
11994 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
11995 != JIM_OK)
11996 return JIM_ERR;
11997 switch (option) {
11998 case OPT_ASCII:
11999 info.type = JIM_LSORT_ASCII;
12000 break;
12001 case OPT_NOCASE:
12002 info.type = JIM_LSORT_NOCASE;
12003 break;
12004 case OPT_INTEGER:
12005 info.type = JIM_LSORT_INTEGER;
12006 break;
12007 case OPT_INCREASING:
12008 info.order = 1;
12009 break;
12010 case OPT_DECREASING:
12011 info.order = -1;
12012 break;
12013 case OPT_COMMAND:
12014 if (i >= (argc - 2)) {
12015 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12016 return JIM_ERR;
12018 info.type = JIM_LSORT_COMMAND;
12019 info.command = argv[i + 1];
12020 i++;
12021 break;
12022 case OPT_INDEX:
12023 if (i >= (argc - 2)) {
12024 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12025 return JIM_ERR;
12027 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12028 return JIM_ERR;
12030 info.indexed = 1;
12031 i++;
12032 break;
12035 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12036 retCode = ListSortElements(interp, resObj, &info);
12037 if (retCode == JIM_OK) {
12038 Jim_SetResult(interp, resObj);
12040 else {
12041 Jim_FreeNewObj(interp, resObj);
12043 return retCode;
12046 /* [append] */
12047 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12049 Jim_Obj *stringObjPtr;
12050 int i;
12052 if (argc < 2) {
12053 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12054 return JIM_ERR;
12056 if (argc == 2) {
12057 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12058 if (!stringObjPtr)
12059 return JIM_ERR;
12061 else {
12062 int freeobj = 0;
12063 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12064 if (!stringObjPtr) {
12065 /* Create the string if it doesn't exist */
12066 stringObjPtr = Jim_NewEmptyStringObj(interp);
12067 freeobj = 1;
12069 else if (Jim_IsShared(stringObjPtr)) {
12070 freeobj = 1;
12071 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12073 for (i = 2; i < argc; i++) {
12074 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12076 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12077 if (freeobj) {
12078 Jim_FreeNewObj(interp, stringObjPtr);
12080 return JIM_ERR;
12083 Jim_SetResult(interp, stringObjPtr);
12084 return JIM_OK;
12087 /* [debug] */
12088 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12090 #ifdef JIM_DEBUG_COMMAND
12091 static const char * const options[] = {
12092 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12093 "exprbc", "show",
12094 NULL
12096 enum
12098 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12099 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12101 int option;
12103 if (argc < 2) {
12104 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12105 return JIM_ERR;
12107 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12108 return JIM_ERR;
12109 if (option == OPT_REFCOUNT) {
12110 if (argc != 3) {
12111 Jim_WrongNumArgs(interp, 2, argv, "object");
12112 return JIM_ERR;
12114 Jim_SetResultInt(interp, argv[2]->refCount);
12115 return JIM_OK;
12117 else if (option == OPT_OBJCOUNT) {
12118 int freeobj = 0, liveobj = 0;
12119 char buf[256];
12120 Jim_Obj *objPtr;
12122 if (argc != 2) {
12123 Jim_WrongNumArgs(interp, 2, argv, "");
12124 return JIM_ERR;
12126 /* Count the number of free objects. */
12127 objPtr = interp->freeList;
12128 while (objPtr) {
12129 freeobj++;
12130 objPtr = objPtr->nextObjPtr;
12132 /* Count the number of live objects. */
12133 objPtr = interp->liveList;
12134 while (objPtr) {
12135 liveobj++;
12136 objPtr = objPtr->nextObjPtr;
12138 /* Set the result string and return. */
12139 sprintf(buf, "free %d used %d", freeobj, liveobj);
12140 Jim_SetResultString(interp, buf, -1);
12141 return JIM_OK;
12143 else if (option == OPT_OBJECTS) {
12144 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12146 /* Count the number of live objects. */
12147 objPtr = interp->liveList;
12148 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12149 while (objPtr) {
12150 char buf[128];
12151 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12153 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12154 sprintf(buf, "%p", objPtr);
12155 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12156 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12157 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12158 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12159 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12160 objPtr = objPtr->nextObjPtr;
12162 Jim_SetResult(interp, listObjPtr);
12163 return JIM_OK;
12165 else if (option == OPT_INVSTR) {
12166 Jim_Obj *objPtr;
12168 if (argc != 3) {
12169 Jim_WrongNumArgs(interp, 2, argv, "object");
12170 return JIM_ERR;
12172 objPtr = argv[2];
12173 if (objPtr->typePtr != NULL)
12174 Jim_InvalidateStringRep(objPtr);
12175 Jim_SetEmptyResult(interp);
12176 return JIM_OK;
12178 else if (option == OPT_SHOW) {
12179 const char *s;
12180 int len, charlen;
12182 if (argc != 3) {
12183 Jim_WrongNumArgs(interp, 2, argv, "object");
12184 return JIM_ERR;
12186 s = Jim_GetString(argv[2], &len);
12187 charlen = Jim_Utf8Length(interp, argv[2]);
12188 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12189 printf("chars (%d): <<%s>>\n", charlen, s);
12190 printf("bytes (%d):", len);
12191 while (len--) {
12192 printf(" %02x", (unsigned char)*s++);
12194 printf("\n");
12195 return JIM_OK;
12197 else if (option == OPT_SCRIPTLEN) {
12198 ScriptObj *script;
12200 if (argc != 3) {
12201 Jim_WrongNumArgs(interp, 2, argv, "script");
12202 return JIM_ERR;
12204 script = Jim_GetScript(interp, argv[2]);
12205 Jim_SetResultInt(interp, script->len);
12206 return JIM_OK;
12208 else if (option == OPT_EXPRLEN) {
12209 ExprByteCode *expr;
12211 if (argc != 3) {
12212 Jim_WrongNumArgs(interp, 2, argv, "expression");
12213 return JIM_ERR;
12215 expr = JimGetExpression(interp, argv[2]);
12216 if (expr == NULL)
12217 return JIM_ERR;
12218 Jim_SetResultInt(interp, expr->len);
12219 return JIM_OK;
12221 else if (option == OPT_EXPRBC) {
12222 Jim_Obj *objPtr;
12223 ExprByteCode *expr;
12224 int i;
12226 if (argc != 3) {
12227 Jim_WrongNumArgs(interp, 2, argv, "expression");
12228 return JIM_ERR;
12230 expr = JimGetExpression(interp, argv[2]);
12231 if (expr == NULL)
12232 return JIM_ERR;
12233 objPtr = Jim_NewListObj(interp, NULL, 0);
12234 for (i = 0; i < expr->len; i++) {
12235 const char *type;
12236 const Jim_ExprOperator *op;
12237 Jim_Obj *obj = expr->token[i].objPtr;
12239 switch (expr->token[i].type) {
12240 case JIM_TT_EXPR_INT:
12241 type = "int";
12242 break;
12243 case JIM_TT_EXPR_DOUBLE:
12244 type = "double";
12245 break;
12246 case JIM_TT_CMD:
12247 type = "command";
12248 break;
12249 case JIM_TT_VAR:
12250 type = "variable";
12251 break;
12252 case JIM_TT_DICTSUGAR:
12253 type = "dictsugar";
12254 break;
12255 case JIM_TT_EXPRSUGAR:
12256 type = "exprsugar";
12257 break;
12258 case JIM_TT_ESC:
12259 type = "subst";
12260 break;
12261 case JIM_TT_STR:
12262 type = "string";
12263 break;
12264 default:
12265 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12266 if (op == NULL) {
12267 type = "private";
12269 else {
12270 type = "operator";
12272 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12273 break;
12275 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12276 Jim_ListAppendElement(interp, objPtr, obj);
12278 Jim_SetResult(interp, objPtr);
12279 return JIM_OK;
12281 else {
12282 Jim_SetResultString(interp,
12283 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12284 return JIM_ERR;
12286 /* unreached */
12287 #else
12288 Jim_SetResultString(interp, "unsupported", -1);
12289 return JIM_ERR;
12290 #endif
12293 /* [eval] */
12294 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12296 int rc;
12298 if (argc < 2) {
12299 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12300 return JIM_ERR;
12303 if (argc == 2) {
12304 rc = Jim_EvalObj(interp, argv[1]);
12306 else {
12307 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12310 if (rc == JIM_ERR) {
12311 /* eval is "interesting", so add a stack frame here */
12312 interp->addStackTrace++;
12314 return rc;
12317 /* [uplevel] */
12318 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12320 if (argc >= 2) {
12321 int retcode;
12322 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12323 Jim_Obj *objPtr;
12324 const char *str;
12326 /* Save the old callframe pointer */
12327 savedCallFrame = interp->framePtr;
12329 /* Lookup the target frame pointer */
12330 str = Jim_String(argv[1]);
12331 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12332 targetCallFrame =Jim_GetCallFrameByLevel(interp, argv[1]);
12333 argc--;
12334 argv++;
12336 else {
12337 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12339 if (targetCallFrame == NULL) {
12340 return JIM_ERR;
12342 if (argc < 2) {
12343 argv--;
12344 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12345 return JIM_ERR;
12347 /* Eval the code in the target callframe. */
12348 interp->framePtr = targetCallFrame;
12349 if (argc == 2) {
12350 retcode = Jim_EvalObj(interp, argv[1]);
12352 else {
12353 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12354 Jim_IncrRefCount(objPtr);
12355 retcode = Jim_EvalObj(interp, objPtr);
12356 Jim_DecrRefCount(interp, objPtr);
12358 interp->framePtr = savedCallFrame;
12359 return retcode;
12361 else {
12362 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12363 return JIM_ERR;
12367 /* [expr] */
12368 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12370 Jim_Obj *exprResultPtr;
12371 int retcode;
12373 if (argc == 2) {
12374 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12376 else if (argc > 2) {
12377 Jim_Obj *objPtr;
12379 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12380 Jim_IncrRefCount(objPtr);
12381 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12382 Jim_DecrRefCount(interp, objPtr);
12384 else {
12385 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12386 return JIM_ERR;
12388 if (retcode != JIM_OK)
12389 return retcode;
12390 Jim_SetResult(interp, exprResultPtr);
12391 Jim_DecrRefCount(interp, exprResultPtr);
12392 return JIM_OK;
12395 /* [break] */
12396 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12398 if (argc != 1) {
12399 Jim_WrongNumArgs(interp, 1, argv, "");
12400 return JIM_ERR;
12402 return JIM_BREAK;
12405 /* [continue] */
12406 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12408 if (argc != 1) {
12409 Jim_WrongNumArgs(interp, 1, argv, "");
12410 return JIM_ERR;
12412 return JIM_CONTINUE;
12415 /* [return] */
12416 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12418 int i;
12419 Jim_Obj *stackTraceObj = NULL;
12420 Jim_Obj *errorCodeObj = NULL;
12421 int returnCode = JIM_OK;
12422 long level = 1;
12424 for (i = 1; i < argc - 1; i += 2) {
12425 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12426 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12427 return JIM_ERR;
12430 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12431 stackTraceObj = argv[i + 1];
12433 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12434 errorCodeObj = argv[i + 1];
12436 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12437 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12438 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12439 return JIM_ERR;
12442 else {
12443 break;
12447 if (i != argc - 1 && i != argc) {
12448 Jim_WrongNumArgs(interp, 1, argv,
12449 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12452 /* If a stack trace is supplied and code is error, set the stack trace */
12453 if (stackTraceObj && returnCode == JIM_ERR) {
12454 JimSetStackTrace(interp, stackTraceObj);
12456 /* If an error code list is supplied, set the global $errorCode */
12457 if (errorCodeObj && returnCode == JIM_ERR) {
12458 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12460 interp->returnCode = returnCode;
12461 interp->returnLevel = level;
12463 if (i == argc - 1) {
12464 Jim_SetResult(interp, argv[i]);
12466 return JIM_RETURN;
12469 /* [tailcall] */
12470 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12472 Jim_Obj *objPtr;
12474 objPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12475 Jim_SetResult(interp, objPtr);
12476 return JIM_EVAL;
12479 /* [proc] */
12480 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12482 if (argc != 4 && argc != 5) {
12483 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
12484 return JIM_ERR;
12487 if (argc == 4) {
12488 return JimCreateProcedure(interp, argv[1], argv[2], NULL, argv[3]);
12490 else {
12491 return JimCreateProcedure(interp, argv[1], argv[2], argv[3], argv[4]);
12495 /* [local] */
12496 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12498 int retcode;
12500 /* Evaluate the arguments with 'local' in force */
12501 interp->local++;
12502 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12503 interp->local--;
12506 /* If OK, and the result is a proc, add it to the list of local procs */
12507 if (retcode == 0) {
12508 const char *procname = Jim_String(Jim_GetResult(interp));
12510 if (Jim_FindHashEntry(&interp->commands, procname) == NULL) {
12511 Jim_SetResultFormatted(interp, "not a proc: \"%s\"", procname);
12512 return JIM_ERR;
12514 if (interp->localProcs == NULL) {
12515 interp->localProcs = Jim_Alloc(sizeof(*interp->localProcs));
12516 Jim_InitStack(interp->localProcs);
12518 Jim_StackPush(interp->localProcs, Jim_StrDup(procname));
12521 return retcode;
12524 /* [upcall] */
12525 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12527 if (argc < 2) {
12528 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
12529 return JIM_ERR;
12531 else {
12532 int retcode;
12534 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
12535 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->u.proc.prevCmd) {
12536 Jim_SetResultFormatted(interp, "no previous proc: \"%#s\"", argv[1]);
12537 return JIM_ERR;
12539 /* OK. Mark this command as being in an upcall */
12540 cmdPtr->u.proc.upcall++;
12541 JimIncrCmdRefCount(cmdPtr);
12543 /* Invoke the command as normal */
12544 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12546 /* No longer in an upcall */
12547 cmdPtr->u.proc.upcall--;
12548 JimDecrCmdRefCount(interp, cmdPtr);
12550 return retcode;
12554 /* [concat] */
12555 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12557 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12558 return JIM_OK;
12561 /* [upvar] */
12562 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12564 int i;
12565 Jim_CallFrame *targetCallFrame;
12567 /* Lookup the target frame pointer */
12568 if (argc > 3 && (argc % 2 == 0)) {
12569 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12570 argc--;
12571 argv++;
12573 else {
12574 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12576 if (targetCallFrame == NULL) {
12577 return JIM_ERR;
12580 /* Check for arity */
12581 if (argc < 3) {
12582 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
12583 return JIM_ERR;
12586 /* Now... for every other/local couple: */
12587 for (i = 1; i < argc; i += 2) {
12588 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
12589 return JIM_ERR;
12591 return JIM_OK;
12594 /* [global] */
12595 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12597 int i;
12599 if (argc < 2) {
12600 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
12601 return JIM_ERR;
12603 /* Link every var to the toplevel having the same name */
12604 if (interp->framePtr->level == 0)
12605 return JIM_OK; /* global at toplevel... */
12606 for (i = 1; i < argc; i++) {
12607 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
12608 return JIM_ERR;
12610 return JIM_OK;
12613 /* does the [string map] operation. On error NULL is returned,
12614 * otherwise a new string object with the result, having refcount = 0,
12615 * is returned. */
12616 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
12617 Jim_Obj *objPtr, int nocase)
12619 int numMaps;
12620 const char *str, *noMatchStart = NULL;
12621 int strLen, i;
12622 Jim_Obj *resultObjPtr;
12624 numMaps = Jim_ListLength(interp, mapListObjPtr);
12625 if (numMaps % 2) {
12626 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
12627 return NULL;
12630 str = Jim_String(objPtr);
12631 strLen = Jim_Utf8Length(interp, objPtr);
12633 /* Map it */
12634 resultObjPtr = Jim_NewStringObj(interp, "", 0);
12635 while (strLen) {
12636 for (i = 0; i < numMaps; i += 2) {
12637 Jim_Obj *objPtr;
12638 const char *k;
12639 int kl;
12641 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
12642 k = Jim_String(objPtr);
12643 kl = Jim_Utf8Length(interp, objPtr);
12645 if (strLen >= kl && kl) {
12646 int rc;
12647 if (nocase) {
12648 rc = JimStringCompareNoCase(str, k, kl);
12650 else {
12651 rc = JimStringCompare(str, kl, k, kl);
12653 if (rc == 0) {
12654 if (noMatchStart) {
12655 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12656 noMatchStart = NULL;
12658 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
12659 Jim_AppendObj(interp, resultObjPtr, objPtr);
12660 str += utf8_index(str, kl);
12661 strLen -= kl;
12662 break;
12666 if (i == numMaps) { /* no match */
12667 int c;
12668 if (noMatchStart == NULL)
12669 noMatchStart = str;
12670 str += utf8_tounicode(str, &c);
12671 strLen--;
12674 if (noMatchStart) {
12675 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12677 return resultObjPtr;
12680 /* [string] */
12681 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12683 int len;
12684 int opt_case = 1;
12685 int option;
12686 static const char * const options[] = {
12687 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "map",
12688 "repeat", "reverse", "index", "first", "last",
12689 "trim", "trimleft", "trimright", "tolower", "toupper", NULL
12691 enum
12693 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_MAP,
12694 OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
12695 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER
12697 static const char * const nocase_options[] = {
12698 "-nocase", NULL
12701 if (argc < 2) {
12702 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12703 return JIM_ERR;
12705 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
12706 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
12707 return JIM_ERR;
12709 switch (option) {
12710 case OPT_LENGTH:
12711 case OPT_BYTELENGTH:
12712 if (argc != 3) {
12713 Jim_WrongNumArgs(interp, 2, argv, "string");
12714 return JIM_ERR;
12716 if (option == OPT_LENGTH) {
12717 len = Jim_Utf8Length(interp, argv[2]);
12719 else {
12720 len = Jim_Length(argv[2]);
12722 Jim_SetResultInt(interp, len);
12723 return JIM_OK;
12725 case OPT_COMPARE:
12726 case OPT_EQUAL:
12727 if (argc != 4 &&
12728 (argc != 5 ||
12729 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12730 JIM_ENUM_ABBREV) != JIM_OK)) {
12731 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? string1 string2");
12732 return JIM_ERR;
12734 if (opt_case == 0) {
12735 argv++;
12737 if (option == OPT_COMPARE || !opt_case) {
12738 Jim_SetResultInt(interp, Jim_StringCompareObj(interp, argv[2], argv[3], !opt_case));
12740 else {
12741 Jim_SetResultBool(interp, Jim_StringEqObj(argv[2], argv[3]));
12743 return JIM_OK;
12745 case OPT_MATCH:
12746 if (argc != 4 &&
12747 (argc != 5 ||
12748 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12749 JIM_ENUM_ABBREV) != JIM_OK)) {
12750 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
12751 return JIM_ERR;
12753 if (opt_case == 0) {
12754 argv++;
12756 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
12757 return JIM_OK;
12759 case OPT_MAP:{
12760 Jim_Obj *objPtr;
12762 if (argc != 4 &&
12763 (argc != 5 ||
12764 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12765 JIM_ENUM_ABBREV) != JIM_OK)) {
12766 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
12767 return JIM_ERR;
12770 if (opt_case == 0) {
12771 argv++;
12773 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
12774 if (objPtr == NULL) {
12775 return JIM_ERR;
12777 Jim_SetResult(interp, objPtr);
12778 return JIM_OK;
12781 case OPT_RANGE:
12782 case OPT_BYTERANGE:{
12783 Jim_Obj *objPtr;
12785 if (argc != 5) {
12786 Jim_WrongNumArgs(interp, 2, argv, "string first last");
12787 return JIM_ERR;
12789 if (option == OPT_RANGE) {
12790 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
12792 else
12794 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
12797 if (objPtr == NULL) {
12798 return JIM_ERR;
12800 Jim_SetResult(interp, objPtr);
12801 return JIM_OK;
12804 case OPT_REPEAT:{
12805 Jim_Obj *objPtr;
12806 jim_wide count;
12808 if (argc != 4) {
12809 Jim_WrongNumArgs(interp, 2, argv, "string count");
12810 return JIM_ERR;
12812 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
12813 return JIM_ERR;
12815 objPtr = Jim_NewStringObj(interp, "", 0);
12816 if (count > 0) {
12817 while (count--) {
12818 Jim_AppendObj(interp, objPtr, argv[2]);
12821 Jim_SetResult(interp, objPtr);
12822 return JIM_OK;
12825 case OPT_REVERSE:{
12826 char *buf, *p;
12827 const char *str;
12828 int len;
12829 int i;
12831 if (argc != 3) {
12832 Jim_WrongNumArgs(interp, 2, argv, "string");
12833 return JIM_ERR;
12836 str = Jim_GetString(argv[2], &len);
12837 if (!str) {
12838 return JIM_ERR;
12841 buf = Jim_Alloc(len + 1);
12842 p = buf + len;
12843 *p = 0;
12844 for (i = 0; i < len; ) {
12845 int c;
12846 int l = utf8_tounicode(str, &c);
12847 memcpy(p - l, str, l);
12848 p -= l;
12849 i += l;
12850 str += l;
12852 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
12853 return JIM_OK;
12856 case OPT_INDEX:{
12857 int idx;
12858 const char *str;
12860 if (argc != 4) {
12861 Jim_WrongNumArgs(interp, 2, argv, "string index");
12862 return JIM_ERR;
12864 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
12865 return JIM_ERR;
12867 str = Jim_String(argv[2]);
12868 len = Jim_Utf8Length(interp, argv[2]);
12869 if (idx != INT_MIN && idx != INT_MAX) {
12870 idx = JimRelToAbsIndex(len, idx);
12872 if (idx < 0 || idx >= len || str == NULL) {
12873 Jim_SetResultString(interp, "", 0);
12875 else if (len == Jim_Length(argv[2])) {
12876 /* ASCII optimisation */
12877 Jim_SetResultString(interp, str + idx, 1);
12879 else {
12880 int c;
12881 int i = utf8_index(str, idx);
12882 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
12884 return JIM_OK;
12887 case OPT_FIRST:
12888 case OPT_LAST:{
12889 int idx = 0, l1, l2;
12890 const char *s1, *s2;
12892 if (argc != 4 && argc != 5) {
12893 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
12894 return JIM_ERR;
12896 s1 = Jim_String(argv[2]);
12897 s2 = Jim_String(argv[3]);
12898 l1 = Jim_Utf8Length(interp, argv[2]);
12899 l2 = Jim_Utf8Length(interp, argv[3]);
12900 if (argc == 5) {
12901 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
12902 return JIM_ERR;
12904 idx = JimRelToAbsIndex(l2, idx);
12906 else if (option == OPT_LAST) {
12907 idx = l2;
12909 if (option == OPT_FIRST) {
12910 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
12912 else {
12913 #ifdef JIM_UTF8
12914 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
12915 #else
12916 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
12917 #endif
12919 return JIM_OK;
12922 case OPT_TRIM:
12923 case OPT_TRIMLEFT:
12924 case OPT_TRIMRIGHT:{
12925 Jim_Obj *trimchars;
12927 if (argc != 3 && argc != 4) {
12928 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
12929 return JIM_ERR;
12931 trimchars = (argc == 4 ? argv[3] : NULL);
12932 if (option == OPT_TRIM) {
12933 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
12935 else if (option == OPT_TRIMLEFT) {
12936 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
12938 else if (option == OPT_TRIMRIGHT) {
12939 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
12941 return JIM_OK;
12944 case OPT_TOLOWER:
12945 case OPT_TOUPPER:
12946 if (argc != 3) {
12947 Jim_WrongNumArgs(interp, 2, argv, "string");
12948 return JIM_ERR;
12950 if (option == OPT_TOLOWER) {
12951 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
12953 else {
12954 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
12956 return JIM_OK;
12958 case OPT_IS:
12959 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
12960 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
12962 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
12963 return JIM_ERR;
12965 return JIM_OK;
12968 /* [time] */
12969 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12971 long i, count = 1;
12972 jim_wide start, elapsed;
12973 char buf[60];
12974 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
12976 if (argc < 2) {
12977 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
12978 return JIM_ERR;
12980 if (argc == 3) {
12981 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
12982 return JIM_ERR;
12984 if (count < 0)
12985 return JIM_OK;
12986 i = count;
12987 start = JimClock();
12988 while (i-- > 0) {
12989 int retval;
12991 retval = Jim_EvalObj(interp, argv[1]);
12992 if (retval != JIM_OK) {
12993 return retval;
12996 elapsed = JimClock() - start;
12997 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
12998 Jim_SetResultString(interp, buf, -1);
12999 return JIM_OK;
13002 /* [exit] */
13003 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13005 long exitCode = 0;
13007 if (argc > 2) {
13008 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13009 return JIM_ERR;
13011 if (argc == 2) {
13012 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13013 return JIM_ERR;
13015 interp->exitCode = exitCode;
13016 return JIM_EXIT;
13019 /* [catch] */
13020 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13022 int exitCode = 0;
13023 int i;
13024 int sig = 0;
13026 /* Which return codes are caught? These are the defaults */
13027 jim_wide mask =
13028 (1 << JIM_OK | 1 << JIM_ERR | 1 << JIM_BREAK | 1 << JIM_CONTINUE | 1 << JIM_RETURN);
13030 /* Reset the error code before catch.
13031 * Note that this is not strictly correct.
13033 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13035 for (i = 1; i < argc - 1; i++) {
13036 const char *arg = Jim_String(argv[i]);
13037 jim_wide option;
13038 int add;
13040 /* It's a pity we can't use Jim_GetEnum here :-( */
13041 if (strcmp(arg, "--") == 0) {
13042 i++;
13043 break;
13045 if (*arg != '-') {
13046 break;
13049 if (strncmp(arg, "-no", 3) == 0) {
13050 arg += 3;
13051 add = 0;
13053 else {
13054 arg++;
13055 add = 1;
13058 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13059 option = -1;
13061 if (option < 0) {
13062 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13064 if (option < 0) {
13065 goto wrongargs;
13068 if (add) {
13069 mask |= (1 << option);
13071 else {
13072 mask &= ~(1 << option);
13076 argc -= i;
13077 if (argc < 1 || argc > 3) {
13078 wrongargs:
13079 Jim_WrongNumArgs(interp, 1, argv,
13080 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13081 return JIM_ERR;
13083 argv += i;
13085 if (mask & (1 << JIM_SIGNAL)) {
13086 sig++;
13089 interp->signal_level += sig;
13090 if (interp->signal_level && interp->sigmask) {
13091 /* If a signal is set, don't even try to execute the body */
13092 exitCode = JIM_SIGNAL;
13094 else {
13095 exitCode = Jim_EvalObj(interp, argv[0]);
13097 interp->signal_level -= sig;
13099 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13100 if (exitCode >= 0 && exitCode < (int)sizeof(mask) * 8 && ((1 << exitCode) & mask) == 0) {
13101 /* Not caught, pass it up */
13102 return exitCode;
13105 if (sig && exitCode == JIM_SIGNAL) {
13106 /* Catch the signal at this level */
13107 if (interp->signal_set_result) {
13108 interp->signal_set_result(interp, interp->sigmask);
13110 else {
13111 Jim_SetResultInt(interp, interp->sigmask);
13113 interp->sigmask = 0;
13116 if (argc >= 2) {
13117 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13118 return JIM_ERR;
13120 if (argc == 3) {
13121 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13123 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13124 Jim_ListAppendElement(interp, optListObj,
13125 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13126 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13127 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13128 if (exitCode == JIM_ERR) {
13129 Jim_Obj *errorCode;
13130 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13131 -1));
13132 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13134 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13135 if (errorCode) {
13136 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13137 Jim_ListAppendElement(interp, optListObj, errorCode);
13140 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13141 return JIM_ERR;
13145 Jim_SetResultInt(interp, exitCode);
13146 return JIM_OK;
13149 #ifdef JIM_REFERENCES
13151 /* [ref] */
13152 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13154 if (argc != 3 && argc != 4) {
13155 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13156 return JIM_ERR;
13158 if (argc == 3) {
13159 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13161 else {
13162 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13164 return JIM_OK;
13167 /* [getref] */
13168 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13170 Jim_Reference *refPtr;
13172 if (argc != 2) {
13173 Jim_WrongNumArgs(interp, 1, argv, "reference");
13174 return JIM_ERR;
13176 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13177 return JIM_ERR;
13178 Jim_SetResult(interp, refPtr->objPtr);
13179 return JIM_OK;
13182 /* [setref] */
13183 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 Jim_Reference *refPtr;
13187 if (argc != 3) {
13188 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13189 return JIM_ERR;
13191 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13192 return JIM_ERR;
13193 Jim_IncrRefCount(argv[2]);
13194 Jim_DecrRefCount(interp, refPtr->objPtr);
13195 refPtr->objPtr = argv[2];
13196 Jim_SetResult(interp, argv[2]);
13197 return JIM_OK;
13200 /* [collect] */
13201 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13203 if (argc != 1) {
13204 Jim_WrongNumArgs(interp, 1, argv, "");
13205 return JIM_ERR;
13207 Jim_SetResultInt(interp, Jim_Collect(interp));
13209 /* Free all the freed objects. */
13210 while (interp->freeList) {
13211 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13212 Jim_Free(interp->freeList);
13213 interp->freeList = nextObjPtr;
13216 return JIM_OK;
13219 /* [finalize] reference ?newValue? */
13220 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13222 if (argc != 2 && argc != 3) {
13223 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13224 return JIM_ERR;
13226 if (argc == 2) {
13227 Jim_Obj *cmdNamePtr;
13229 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13230 return JIM_ERR;
13231 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13232 Jim_SetResult(interp, cmdNamePtr);
13234 else {
13235 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13236 return JIM_ERR;
13237 Jim_SetResult(interp, argv[2]);
13239 return JIM_OK;
13242 /* [info references] */
13243 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13245 Jim_Obj *listObjPtr;
13246 Jim_HashTableIterator *htiter;
13247 Jim_HashEntry *he;
13249 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13251 htiter = Jim_GetHashTableIterator(&interp->references);
13252 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
13253 char buf[JIM_REFERENCE_SPACE];
13254 Jim_Reference *refPtr = he->u.val;
13255 const jim_wide *refId = he->key;
13257 JimFormatReference(buf, refPtr, *refId);
13258 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
13260 Jim_FreeHashTableIterator(htiter);
13261 Jim_SetResult(interp, listObjPtr);
13262 return JIM_OK;
13264 #endif
13266 /* [rename] */
13267 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13269 const char *oldName, *newName;
13271 if (argc != 3) {
13272 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
13273 return JIM_ERR;
13276 if (JimValidName(interp, "new procedure", argv[2])) {
13277 return JIM_ERR;
13280 oldName = Jim_String(argv[1]);
13281 newName = Jim_String(argv[2]);
13282 return Jim_RenameCommand(interp, oldName, newName);
13285 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj)
13287 int i;
13288 int len;
13289 Jim_Obj *resultObj;
13290 Jim_Obj *dictObj;
13291 Jim_Obj **dictValuesObj;
13293 if (Jim_DictKeysVector(interp, objPtr, NULL, 0, &dictObj, JIM_ERRMSG) != JIM_OK) {
13294 return JIM_ERR;
13297 /* XXX: Could make the exact-match case much more efficient here.
13298 * See JimCommandsList()
13300 if (Jim_DictPairs(interp, dictObj, &dictValuesObj, &len) != JIM_OK) {
13301 return JIM_ERR;
13304 /* Only return the matching values */
13305 resultObj = Jim_NewListObj(interp, NULL, 0);
13307 for (i = 0; i < len; i += 2) {
13308 if (patternObj == NULL || Jim_StringMatchObj(interp, patternObj, dictValuesObj[i], 0)) {
13309 Jim_ListAppendElement(interp, resultObj, dictValuesObj[i]);
13312 Jim_Free(dictValuesObj);
13314 Jim_SetResult(interp, resultObj);
13315 return JIM_OK;
13318 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
13320 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13321 return -1;
13323 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
13326 /* [dict] */
13327 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13329 Jim_Obj *objPtr;
13330 int option;
13331 static const char * const options[] = {
13332 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
13334 enum
13336 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST, OPT_KEYS, OPT_MERGE, OPT_SIZE, OPT_WITH,
13339 if (argc < 2) {
13340 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
13341 return JIM_ERR;
13344 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
13345 return JIM_ERR;
13348 switch (option) {
13349 case OPT_GET:
13350 if (argc < 3) {
13351 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
13352 return JIM_ERR;
13354 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
13355 JIM_ERRMSG) != JIM_OK) {
13356 return JIM_ERR;
13358 Jim_SetResult(interp, objPtr);
13359 return JIM_OK;
13361 case OPT_SET:
13362 if (argc < 5) {
13363 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
13364 return JIM_ERR;
13366 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
13368 case OPT_EXIST:
13369 if (argc < 3) {
13370 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
13371 return JIM_ERR;
13373 Jim_SetResultBool(interp, Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3,
13374 &objPtr, JIM_ERRMSG) == JIM_OK);
13375 return JIM_OK;
13377 case OPT_UNSET:
13378 if (argc < 4) {
13379 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
13380 return JIM_ERR;
13382 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL);
13384 case OPT_KEYS:
13385 if (argc != 3 && argc != 4) {
13386 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?pattern?");
13387 return JIM_ERR;
13389 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
13391 case OPT_SIZE: {
13392 int size;
13394 if (argc != 3) {
13395 Jim_WrongNumArgs(interp, 2, argv, "dictVar");
13396 return JIM_ERR;
13399 size = Jim_DictSize(interp, argv[2]);
13400 if (size < 0) {
13401 return JIM_ERR;
13403 Jim_SetResultInt(interp, size);
13404 return JIM_OK;
13407 case OPT_MERGE:
13408 if (argc == 2) {
13409 return JIM_OK;
13411 else if (argv[2]->typePtr != &dictObjType && SetDictFromAny(interp, argv[2]) != JIM_OK) {
13412 return JIM_ERR;
13414 else {
13415 return Jim_EvalObjPrefix(interp, "dict merge", argc - 2, argv + 2);
13418 case OPT_WITH:
13419 if (argc < 4) {
13420 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
13421 return JIM_ERR;
13423 else if (Jim_GetVariable(interp, argv[2], JIM_ERRMSG) == NULL) {
13424 return JIM_ERR;
13426 else {
13427 return Jim_EvalObjPrefix(interp, "dict with", argc - 2, argv + 2);
13430 case OPT_CREATE:
13431 if (argc % 2) {
13432 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
13433 return JIM_ERR;
13435 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
13436 Jim_SetResult(interp, objPtr);
13437 return JIM_OK;
13439 default:
13440 abort();
13444 /* [subst] */
13445 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13447 static const char * const options[] = {
13448 "-nobackslashes", "-nocommands", "-novariables", NULL
13450 enum
13451 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
13452 int i;
13453 int flags = JIM_SUBST_FLAG;
13454 Jim_Obj *objPtr;
13456 if (argc < 2) {
13457 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
13458 return JIM_ERR;
13460 for (i = 1; i < (argc - 1); i++) {
13461 int option;
13463 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
13464 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
13465 return JIM_ERR;
13467 switch (option) {
13468 case OPT_NOBACKSLASHES:
13469 flags |= JIM_SUBST_NOESC;
13470 break;
13471 case OPT_NOCOMMANDS:
13472 flags |= JIM_SUBST_NOCMD;
13473 break;
13474 case OPT_NOVARIABLES:
13475 flags |= JIM_SUBST_NOVAR;
13476 break;
13479 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
13480 return JIM_ERR;
13482 Jim_SetResult(interp, objPtr);
13483 return JIM_OK;
13486 /* [info] */
13487 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13489 int cmd;
13490 Jim_Obj *objPtr;
13491 int mode = 0;
13493 static const char * const commands[] = {
13494 "body", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
13495 "vars", "version", "patchlevel", "complete", "args", "hostname",
13496 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
13497 "references", NULL
13499 enum
13500 { INFO_BODY, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
13501 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
13502 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
13503 INFO_RETURNCODES, INFO_REFERENCES,
13506 if (argc < 2) {
13507 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
13508 return JIM_ERR;
13510 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
13511 != JIM_OK) {
13512 return JIM_ERR;
13515 /* Test for the the most common commands first, just in case it makes a difference */
13516 switch (cmd) {
13517 case INFO_EXISTS:{
13518 if (argc != 3) {
13519 Jim_WrongNumArgs(interp, 2, argv, "varName");
13520 return JIM_ERR;
13522 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
13523 break;
13526 case INFO_CHANNELS:
13527 #ifndef jim_ext_aio
13528 Jim_SetResultString(interp, "aio not enabled", -1);
13529 return JIM_ERR;
13530 #endif
13531 case INFO_COMMANDS:
13532 case INFO_PROCS:
13533 if (argc != 2 && argc != 3) {
13534 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
13535 return JIM_ERR;
13537 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL,
13538 (cmd - INFO_COMMANDS)));
13539 break;
13541 case INFO_VARS:
13542 mode++; /* JIM_VARLIST_VARS */
13543 case INFO_LOCALS:
13544 mode++; /* JIM_VARLIST_LOCALS */
13545 case INFO_GLOBALS:
13546 /* mode 0 => JIM_VARLIST_GLOBALS */
13547 if (argc != 2 && argc != 3) {
13548 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
13549 return JIM_ERR;
13551 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
13552 break;
13554 case INFO_SCRIPT:
13555 if (argc != 2) {
13556 Jim_WrongNumArgs(interp, 2, argv, "");
13557 return JIM_ERR;
13559 Jim_SetResultString(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileName,
13560 -1);
13561 break;
13563 case INFO_SOURCE:{
13564 const char *filename = "";
13565 int line = 0;
13566 Jim_Obj *resObjPtr;
13568 if (argc != 3) {
13569 Jim_WrongNumArgs(interp, 2, argv, "source");
13570 return JIM_ERR;
13572 if (argv[2]->typePtr == &sourceObjType) {
13573 filename = argv[2]->internalRep.sourceValue.fileName;
13574 line = argv[2]->internalRep.sourceValue.lineNumber;
13576 else if (argv[2]->typePtr == &scriptObjType) {
13577 ScriptObj *script = Jim_GetScript(interp, argv[2]);
13578 filename = script->fileName;
13579 line = script->line;
13581 resObjPtr = Jim_NewListObj(interp, NULL, 0);
13582 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObj(interp, filename, -1));
13583 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
13584 Jim_SetResult(interp, resObjPtr);
13585 break;
13588 case INFO_STACKTRACE:
13589 Jim_SetResult(interp, interp->stackTrace);
13590 break;
13592 case INFO_LEVEL:
13593 case INFO_FRAME:
13594 switch (argc) {
13595 case 2:
13596 Jim_SetResultInt(interp, interp->framePtr->level);
13597 break;
13599 case 3:
13600 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
13601 return JIM_ERR;
13603 Jim_SetResult(interp, objPtr);
13604 break;
13606 default:
13607 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
13608 return JIM_ERR;
13610 break;
13612 case INFO_BODY:
13613 case INFO_ARGS:{
13614 Jim_Cmd *cmdPtr;
13616 if (argc != 3) {
13617 Jim_WrongNumArgs(interp, 2, argv, "procname");
13618 return JIM_ERR;
13620 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
13621 return JIM_ERR;
13623 if (!cmdPtr->isproc) {
13624 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
13625 return JIM_ERR;
13627 Jim_SetResult(interp,
13628 cmd == INFO_BODY ? cmdPtr->u.proc.bodyObjPtr : cmdPtr->u.proc.argListObjPtr);
13629 break;
13632 case INFO_VERSION:
13633 case INFO_PATCHLEVEL:{
13634 char buf[(JIM_INTEGER_SPACE * 2) + 1];
13636 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
13637 Jim_SetResultString(interp, buf, -1);
13638 break;
13641 case INFO_COMPLETE:
13642 if (argc != 3 && argc != 4) {
13643 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
13644 return JIM_ERR;
13646 else {
13647 int len;
13648 const char *s = Jim_GetString(argv[2], &len);
13649 char missing;
13651 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
13652 if (missing != ' ' && argc == 4) {
13653 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
13656 break;
13658 case INFO_HOSTNAME:
13659 /* Redirect to os.gethostname if it exists */
13660 return Jim_Eval(interp, "os.gethostname");
13662 case INFO_NAMEOFEXECUTABLE:
13663 /* Redirect to Tcl proc */
13664 return Jim_Eval(interp, "{info nameofexecutable}");
13666 case INFO_RETURNCODES:
13667 if (argc == 2) {
13668 int i;
13669 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13671 for (i = 0; jimReturnCodes[i]; i++) {
13672 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
13673 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
13674 jimReturnCodes[i], -1));
13677 Jim_SetResult(interp, listObjPtr);
13679 else if (argc == 3) {
13680 long code;
13681 const char *name;
13683 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
13684 return JIM_ERR;
13686 name = Jim_ReturnCode(code);
13687 if (*name == '?') {
13688 Jim_SetResultInt(interp, code);
13690 else {
13691 Jim_SetResultString(interp, name, -1);
13694 else {
13695 Jim_WrongNumArgs(interp, 2, argv, "?code?");
13696 return JIM_ERR;
13698 break;
13699 case INFO_REFERENCES:
13700 #ifdef JIM_REFERENCES
13701 return JimInfoReferences(interp, argc, argv);
13702 #else
13703 Jim_SetResultString(interp, "not supported", -1);
13704 return JIM_ERR;
13705 #endif
13707 return JIM_OK;
13710 /* [exists] */
13711 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13713 Jim_Obj *objPtr;
13715 static const char * const options[] = {
13716 "-command", "-proc", "-var", NULL
13718 enum
13720 OPT_COMMAND, OPT_PROC, OPT_VAR
13722 int option;
13724 if (argc == 2) {
13725 option = OPT_VAR;
13726 objPtr = argv[1];
13728 else if (argc == 3) {
13729 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
13730 return JIM_ERR;
13732 objPtr = argv[2];
13734 else {
13735 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
13736 return JIM_ERR;
13739 /* Test for the the most common commands first, just in case it makes a difference */
13740 switch (option) {
13741 case OPT_VAR:
13742 Jim_SetResultBool(interp, Jim_GetVariable(interp, objPtr, 0) != NULL);
13743 break;
13745 case OPT_COMMAND:
13746 case OPT_PROC: {
13747 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
13748 Jim_SetResultBool(interp, cmd != NULL && (option == OPT_COMMAND || cmd->isproc));
13749 break;
13752 return JIM_OK;
13755 /* [split] */
13756 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13758 const char *str, *splitChars, *noMatchStart;
13759 int splitLen, strLen;
13760 Jim_Obj *resObjPtr;
13761 int c;
13762 int len;
13764 if (argc != 2 && argc != 3) {
13765 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
13766 return JIM_ERR;
13769 str = Jim_GetString(argv[1], &len);
13770 if (len == 0) {
13771 return JIM_OK;
13773 strLen = Jim_Utf8Length(interp, argv[1]);
13775 /* Init */
13776 if (argc == 2) {
13777 splitChars = " \n\t\r";
13778 splitLen = 4;
13780 else {
13781 splitChars = Jim_String(argv[2]);
13782 splitLen = Jim_Utf8Length(interp, argv[2]);
13785 noMatchStart = str;
13786 resObjPtr = Jim_NewListObj(interp, NULL, 0);
13788 /* Split */
13789 if (splitLen) {
13790 Jim_Obj *objPtr;
13791 while (strLen--) {
13792 const char *sc = splitChars;
13793 int scLen = splitLen;
13794 int sl = utf8_tounicode(str, &c);
13795 while (scLen--) {
13796 int pc;
13797 sc += utf8_tounicode(sc, &pc);
13798 if (c == pc) {
13799 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
13800 Jim_ListAppendElement(interp, resObjPtr, objPtr);
13801 noMatchStart = str + sl;
13802 break;
13805 str += sl;
13807 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
13808 Jim_ListAppendElement(interp, resObjPtr, objPtr);
13810 else {
13811 /* This handles the special case of splitchars eq {}
13812 * Optimise by sharing common (ASCII) characters
13814 Jim_Obj **commonObj = NULL;
13815 #define NUM_COMMON (128 - 9)
13816 while (strLen--) {
13817 int n = utf8_tounicode(str, &c);
13818 #ifdef JIM_OPTIMIZATION
13819 if (c >= 9 && c < 128) {
13820 /* Common ASCII char. Note that 9 is the tab character */
13821 c -= 9;
13822 if (!commonObj) {
13823 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
13824 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
13826 if (!commonObj[c]) {
13827 commonObj[c] = Jim_NewStringObj(interp, str, 1);
13829 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
13830 str++;
13831 continue;
13833 #endif
13834 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
13835 str += n;
13837 Jim_Free(commonObj);
13840 Jim_SetResult(interp, resObjPtr);
13841 return JIM_OK;
13844 /* [join] */
13845 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13847 const char *joinStr;
13848 int joinStrLen, i, listLen;
13849 Jim_Obj *resObjPtr;
13851 if (argc != 2 && argc != 3) {
13852 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
13853 return JIM_ERR;
13855 /* Init */
13856 if (argc == 2) {
13857 joinStr = " ";
13858 joinStrLen = 1;
13860 else {
13861 joinStr = Jim_GetString(argv[2], &joinStrLen);
13863 listLen = Jim_ListLength(interp, argv[1]);
13864 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
13865 /* Split */
13866 for (i = 0; i < listLen; i++) {
13867 Jim_Obj *objPtr = 0;
13869 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
13870 Jim_AppendObj(interp, resObjPtr, objPtr);
13871 if (i + 1 != listLen) {
13872 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
13875 Jim_SetResult(interp, resObjPtr);
13876 return JIM_OK;
13879 /* [format] */
13880 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13882 Jim_Obj *objPtr;
13884 if (argc < 2) {
13885 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
13886 return JIM_ERR;
13888 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
13889 if (objPtr == NULL)
13890 return JIM_ERR;
13891 Jim_SetResult(interp, objPtr);
13892 return JIM_OK;
13895 /* [scan] */
13896 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13898 Jim_Obj *listPtr, **outVec;
13899 int outc, i;
13901 if (argc < 3) {
13902 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
13903 return JIM_ERR;
13905 if (argv[2]->typePtr != &scanFmtStringObjType)
13906 SetScanFmtFromAny(interp, argv[2]);
13907 if (FormatGetError(argv[2]) != 0) {
13908 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
13909 return JIM_ERR;
13911 if (argc > 3) {
13912 int maxPos = FormatGetMaxPos(argv[2]);
13913 int count = FormatGetCnvCount(argv[2]);
13915 if (maxPos > argc - 3) {
13916 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
13917 return JIM_ERR;
13919 else if (count > argc - 3) {
13920 Jim_SetResultString(interp, "different numbers of variable names and "
13921 "field specifiers", -1);
13922 return JIM_ERR;
13924 else if (count < argc - 3) {
13925 Jim_SetResultString(interp, "variable is not assigned by any "
13926 "conversion specifiers", -1);
13927 return JIM_ERR;
13930 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
13931 if (listPtr == 0)
13932 return JIM_ERR;
13933 if (argc > 3) {
13934 int rc = JIM_OK;
13935 int count = 0;
13937 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
13938 int len = Jim_ListLength(interp, listPtr);
13940 if (len != 0) {
13941 JimListGetElements(interp, listPtr, &outc, &outVec);
13942 for (i = 0; i < outc; ++i) {
13943 if (Jim_Length(outVec[i]) > 0) {
13944 ++count;
13945 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
13946 rc = JIM_ERR;
13951 Jim_FreeNewObj(interp, listPtr);
13953 else {
13954 count = -1;
13956 if (rc == JIM_OK) {
13957 Jim_SetResultInt(interp, count);
13959 return rc;
13961 else {
13962 if (listPtr == (Jim_Obj *)EOF) {
13963 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
13964 return JIM_OK;
13966 Jim_SetResult(interp, listPtr);
13968 return JIM_OK;
13971 /* [error] */
13972 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13974 if (argc != 2 && argc != 3) {
13975 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
13976 return JIM_ERR;
13978 Jim_SetResult(interp, argv[1]);
13979 if (argc == 3) {
13980 JimSetStackTrace(interp, argv[2]);
13981 return JIM_ERR;
13983 interp->addStackTrace++;
13984 return JIM_ERR;
13987 /* [lrange] */
13988 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13990 Jim_Obj *objPtr;
13992 if (argc != 4) {
13993 Jim_WrongNumArgs(interp, 1, argv, "list first last");
13994 return JIM_ERR;
13996 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
13997 return JIM_ERR;
13998 Jim_SetResult(interp, objPtr);
13999 return JIM_OK;
14002 /* [lrepeat] */
14003 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14005 Jim_Obj *objPtr;
14006 long count;
14008 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14009 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14010 return JIM_ERR;
14013 if (count == 0 || argc == 2) {
14014 return JIM_OK;
14017 argc -= 2;
14018 argv += 2;
14020 objPtr = Jim_NewListObj(interp, argv, argc);
14021 while (--count) {
14022 int i;
14024 for (i = 0; i < argc; i++) {
14025 ListAppendElement(objPtr, argv[i]);
14029 Jim_SetResult(interp, objPtr);
14030 return JIM_OK;
14033 char **Jim_GetEnviron(void)
14035 #if defined(HAVE__NSGETENVIRON)
14036 return *_NSGetEnviron();
14037 #else
14038 #if !defined(NO_ENVIRON_EXTERN)
14039 extern char **environ;
14040 #endif
14042 return environ;
14043 #endif
14046 void Jim_SetEnviron(char **env)
14048 #if defined(HAVE__NSGETENVIRON)
14049 *_NSGetEnviron() = env;
14050 #else
14051 #if !defined(NO_ENVIRON_EXTERN)
14052 extern char **environ;
14053 #endif
14055 environ = env;
14056 #endif
14059 /* [env] */
14060 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14062 const char *key;
14063 const char *val;
14065 if (argc == 1) {
14066 char **e = Jim_GetEnviron();
14068 int i;
14069 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14071 for (i = 0; e[i]; i++) {
14072 const char *equals = strchr(e[i], '=');
14074 if (equals) {
14075 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14076 equals - e[i]));
14077 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14081 Jim_SetResult(interp, listObjPtr);
14082 return JIM_OK;
14085 if (argc < 2) {
14086 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14087 return JIM_ERR;
14089 key = Jim_String(argv[1]);
14090 val = getenv(key);
14091 if (val == NULL) {
14092 if (argc < 3) {
14093 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14094 return JIM_ERR;
14096 val = Jim_String(argv[2]);
14098 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
14099 return JIM_OK;
14102 /* [source] */
14103 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14105 int retval;
14107 if (argc != 2) {
14108 Jim_WrongNumArgs(interp, 1, argv, "fileName");
14109 return JIM_ERR;
14111 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
14112 if (retval == JIM_RETURN)
14113 return JIM_OK;
14114 return retval;
14117 /* [lreverse] */
14118 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14120 Jim_Obj *revObjPtr, **ele;
14121 int len;
14123 if (argc != 2) {
14124 Jim_WrongNumArgs(interp, 1, argv, "list");
14125 return JIM_ERR;
14127 JimListGetElements(interp, argv[1], &len, &ele);
14128 len--;
14129 revObjPtr = Jim_NewListObj(interp, NULL, 0);
14130 while (len >= 0)
14131 ListAppendElement(revObjPtr, ele[len--]);
14132 Jim_SetResult(interp, revObjPtr);
14133 return JIM_OK;
14136 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
14138 jim_wide len;
14140 if (step == 0)
14141 return -1;
14142 if (start == end)
14143 return 0;
14144 else if (step > 0 && start > end)
14145 return -1;
14146 else if (step < 0 && end > start)
14147 return -1;
14148 len = end - start;
14149 if (len < 0)
14150 len = -len; /* abs(len) */
14151 if (step < 0)
14152 step = -step; /* abs(step) */
14153 len = 1 + ((len - 1) / step);
14154 /* We can truncate safely to INT_MAX, the range command
14155 * will always return an error for a such long range
14156 * because Tcl lists can't be so long. */
14157 if (len > INT_MAX)
14158 len = INT_MAX;
14159 return (int)((len < 0) ? -1 : len);
14162 /* [range] */
14163 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14165 jim_wide start = 0, end, step = 1;
14166 int len, i;
14167 Jim_Obj *objPtr;
14169 if (argc < 2 || argc > 4) {
14170 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
14171 return JIM_ERR;
14173 if (argc == 2) {
14174 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
14175 return JIM_ERR;
14177 else {
14178 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
14179 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
14180 return JIM_ERR;
14181 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
14182 return JIM_ERR;
14184 if ((len = JimRangeLen(start, end, step)) == -1) {
14185 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
14186 return JIM_ERR;
14188 objPtr = Jim_NewListObj(interp, NULL, 0);
14189 for (i = 0; i < len; i++)
14190 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
14191 Jim_SetResult(interp, objPtr);
14192 return JIM_OK;
14195 /* [rand] */
14196 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14198 jim_wide min = 0, max = 0, len, maxMul;
14200 if (argc < 1 || argc > 3) {
14201 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
14202 return JIM_ERR;
14204 if (argc == 1) {
14205 max = JIM_WIDE_MAX;
14206 } else if (argc == 2) {
14207 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
14208 return JIM_ERR;
14209 } else if (argc == 3) {
14210 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
14211 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
14212 return JIM_ERR;
14214 len = max-min;
14215 if (len < 0) {
14216 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
14217 return JIM_ERR;
14219 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
14220 while (1) {
14221 jim_wide r;
14223 JimRandomBytes(interp, &r, sizeof(jim_wide));
14224 if (r < 0 || r >= maxMul) continue;
14225 r = (len == 0) ? 0 : r%len;
14226 Jim_SetResultInt(interp, min+r);
14227 return JIM_OK;
14231 static const struct {
14232 const char *name;
14233 Jim_CmdProc cmdProc;
14234 } Jim_CoreCommandsTable[] = {
14235 {"set", Jim_SetCoreCommand},
14236 {"unset", Jim_UnsetCoreCommand},
14237 {"puts", Jim_PutsCoreCommand},
14238 {"+", Jim_AddCoreCommand},
14239 {"*", Jim_MulCoreCommand},
14240 {"-", Jim_SubCoreCommand},
14241 {"/", Jim_DivCoreCommand},
14242 {"incr", Jim_IncrCoreCommand},
14243 {"while", Jim_WhileCoreCommand},
14244 {"loop", Jim_LoopCoreCommand},
14245 {"for", Jim_ForCoreCommand},
14246 {"foreach", Jim_ForeachCoreCommand},
14247 {"lmap", Jim_LmapCoreCommand},
14248 {"if", Jim_IfCoreCommand},
14249 {"switch", Jim_SwitchCoreCommand},
14250 {"list", Jim_ListCoreCommand},
14251 {"lindex", Jim_LindexCoreCommand},
14252 {"lset", Jim_LsetCoreCommand},
14253 {"lsearch", Jim_LsearchCoreCommand},
14254 {"llength", Jim_LlengthCoreCommand},
14255 {"lappend", Jim_LappendCoreCommand},
14256 {"linsert", Jim_LinsertCoreCommand},
14257 {"lreplace", Jim_LreplaceCoreCommand},
14258 {"lsort", Jim_LsortCoreCommand},
14259 {"append", Jim_AppendCoreCommand},
14260 {"debug", Jim_DebugCoreCommand},
14261 {"eval", Jim_EvalCoreCommand},
14262 {"uplevel", Jim_UplevelCoreCommand},
14263 {"expr", Jim_ExprCoreCommand},
14264 {"break", Jim_BreakCoreCommand},
14265 {"continue", Jim_ContinueCoreCommand},
14266 {"proc", Jim_ProcCoreCommand},
14267 {"concat", Jim_ConcatCoreCommand},
14268 {"return", Jim_ReturnCoreCommand},
14269 {"upvar", Jim_UpvarCoreCommand},
14270 {"global", Jim_GlobalCoreCommand},
14271 {"string", Jim_StringCoreCommand},
14272 {"time", Jim_TimeCoreCommand},
14273 {"exit", Jim_ExitCoreCommand},
14274 {"catch", Jim_CatchCoreCommand},
14275 #ifdef JIM_REFERENCES
14276 {"ref", Jim_RefCoreCommand},
14277 {"getref", Jim_GetrefCoreCommand},
14278 {"setref", Jim_SetrefCoreCommand},
14279 {"finalize", Jim_FinalizeCoreCommand},
14280 {"collect", Jim_CollectCoreCommand},
14281 #endif
14282 {"rename", Jim_RenameCoreCommand},
14283 {"dict", Jim_DictCoreCommand},
14284 {"subst", Jim_SubstCoreCommand},
14285 {"info", Jim_InfoCoreCommand},
14286 {"exists", Jim_ExistsCoreCommand},
14287 {"split", Jim_SplitCoreCommand},
14288 {"join", Jim_JoinCoreCommand},
14289 {"format", Jim_FormatCoreCommand},
14290 {"scan", Jim_ScanCoreCommand},
14291 {"error", Jim_ErrorCoreCommand},
14292 {"lrange", Jim_LrangeCoreCommand},
14293 {"lrepeat", Jim_LrepeatCoreCommand},
14294 {"env", Jim_EnvCoreCommand},
14295 {"source", Jim_SourceCoreCommand},
14296 {"lreverse", Jim_LreverseCoreCommand},
14297 {"range", Jim_RangeCoreCommand},
14298 {"rand", Jim_RandCoreCommand},
14299 {"tailcall", Jim_TailcallCoreCommand},
14300 {"local", Jim_LocalCoreCommand},
14301 {"upcall", Jim_UpcallCoreCommand},
14302 {NULL, NULL},
14305 void Jim_RegisterCoreCommands(Jim_Interp *interp)
14307 int i = 0;
14309 while (Jim_CoreCommandsTable[i].name != NULL) {
14310 Jim_CreateCommand(interp,
14311 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
14312 i++;
14316 /* -----------------------------------------------------------------------------
14317 * Interactive prompt
14318 * ---------------------------------------------------------------------------*/
14319 void Jim_MakeErrorMessage(Jim_Interp *interp)
14321 Jim_Obj *argv[2];
14323 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
14324 argv[1] = interp->result;
14326 Jim_EvalObjVector(interp, 2, argv);
14329 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
14330 const char *prefix, const char *const *tablePtr, const char *name)
14332 int count;
14333 char **tablePtrSorted;
14334 int i;
14336 for (count = 0; tablePtr[count]; count++) {
14339 if (name == NULL) {
14340 name = "option";
14343 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
14344 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
14345 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
14346 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
14347 for (i = 0; i < count; i++) {
14348 if (i + 1 == count && count > 1) {
14349 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
14351 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
14352 if (i + 1 != count) {
14353 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
14356 Jim_Free(tablePtrSorted);
14359 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
14360 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
14362 const char *bad = "bad ";
14363 const char *const *entryPtr = NULL;
14364 int i;
14365 int match = -1;
14366 int arglen;
14367 const char *arg = Jim_GetString(objPtr, &arglen);
14369 *indexPtr = -1;
14371 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
14372 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
14373 /* Found an exact match */
14374 *indexPtr = i;
14375 return JIM_OK;
14377 if (flags & JIM_ENUM_ABBREV) {
14378 /* Accept an unambiguous abbreviation.
14379 * Note that '-' doesnt' consitute a valid abbreviation
14381 if (strncmp(arg, *entryPtr, arglen) == 0) {
14382 if (*arg == '-' && arglen == 1) {
14383 break;
14385 if (match >= 0) {
14386 bad = "ambiguous ";
14387 goto ambiguous;
14389 match = i;
14394 /* If we had an unambiguous partial match */
14395 if (match >= 0) {
14396 *indexPtr = match;
14397 return JIM_OK;
14400 ambiguous:
14401 if (flags & JIM_ERRMSG) {
14402 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
14404 return JIM_ERR;
14407 int Jim_FindByName(const char *name, const char * const array[], size_t len)
14409 int i;
14411 for (i = 0; i < (int)len; i++) {
14412 if (array[i] && strcmp(array[i], name) == 0) {
14413 return i;
14416 return -1;
14419 int Jim_IsDict(Jim_Obj *objPtr)
14421 return objPtr->typePtr == &dictObjType;
14424 int Jim_IsList(Jim_Obj *objPtr)
14426 return objPtr->typePtr == &listObjType;
14430 * Very simple printf-like formatting, designed for error messages.
14432 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
14433 * The resulting string is created and set as the result.
14435 * Each '%s' should correspond to a regular string parameter.
14436 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
14437 * Any other printf specifier is not allowed (but %% is allowed for the % character).
14439 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
14441 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
14443 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
14445 /* Initial space needed */
14446 int len = strlen(format);
14447 int extra = 0;
14448 int n = 0;
14449 const char *params[5];
14450 char *buf;
14451 va_list args;
14452 int i;
14454 va_start(args, format);
14456 for (i = 0; i < len && n < 5; i++) {
14457 int l;
14459 if (strncmp(format + i, "%s", 2) == 0) {
14460 params[n] = va_arg(args, char *);
14462 l = strlen(params[n]);
14464 else if (strncmp(format + i, "%#s", 3) == 0) {
14465 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
14467 params[n] = Jim_GetString(objPtr, &l);
14469 else {
14470 if (format[i] == '%') {
14471 i++;
14473 continue;
14475 n++;
14476 extra += l;
14479 len += extra;
14480 buf = Jim_Alloc(len + 1);
14481 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
14483 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
14486 /* stubs */
14487 #ifndef jim_ext_package
14488 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
14490 return JIM_OK;
14492 #endif
14493 #ifndef jim_ext_aio
14494 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
14496 Jim_SetResultString(interp, "aio not enabled", -1);
14497 return NULL;
14499 #endif
14503 * Local Variables: ***
14504 * c-basic-offset: 4 ***
14505 * tab-width: 4 ***
14506 * End: ***