Add an uninstall target
[jimtcl.git] / jim.c
blob776b91bd5105c0765c388c6bcb4873598370a7c0
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 /* For the no-autoconf case */
76 #ifndef TCL_LIBRARY
77 #define TCL_LIBRARY "."
78 #endif
79 #ifndef TCL_PLATFORM_OS
80 #define TCL_PLATFORM_OS "unknown"
81 #endif
82 #ifndef TCL_PLATFORM_PLATFORM
83 #define TCL_PLATFORM_PLATFORM "unknown"
84 #endif
86 /*#define DEBUG_SHOW_SCRIPT*/
87 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
88 /*#define DEBUG_SHOW_SUBST*/
89 /*#define DEBUG_SHOW_EXPR*/
90 /*#define DEBUG_SHOW_EXPR_TOKENS*/
91 /*#define JIM_DEBUG_GC*/
92 #ifdef JIM_MAINTAINER
93 #define JIM_DEBUG_COMMAND
94 #define JIM_DEBUG_PANIC
95 #endif
97 const char *jim_tt_name(int type);
99 #ifdef JIM_DEBUG_PANIC
100 static void JimPanicDump(int panic_condition, Jim_Interp *interp, const char *fmt, ...);
101 #define JimPanic(X) JimPanicDump X
102 #else
103 #define JimPanic(X)
104 #endif
106 /* -----------------------------------------------------------------------------
107 * Global variables
108 * ---------------------------------------------------------------------------*/
110 /* A shared empty string for the objects string representation.
111 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
112 static char JimEmptyStringRep[] = "";
114 /* -----------------------------------------------------------------------------
115 * Required prototypes of not exported functions
116 * ---------------------------------------------------------------------------*/
117 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
118 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
119 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
120 int flags);
121 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
122 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
123 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
124 const char *prefix, const char *const *tablePtr, const char *name);
125 static void JimDeleteLocalProcs(Jim_Interp *interp);
126 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr,
127 int argc, Jim_Obj *const *argv);
128 static int JimEvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv,
129 const char *filename, int linenr);
130 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
131 static int JimSign(jim_wide w);
132 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
134 static const Jim_HashTableType JimVariablesHashTableType;
136 /* Fast access to the int (wide) value of an object which is known to be of int type */
137 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
139 static int utf8_tounicode_case(const char *s, int *uc, int upper)
141 int l = utf8_tounicode(s, uc);
142 if (upper) {
143 *uc = utf8_upper(*uc);
145 return l;
148 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
149 #define JIM_CHARSET_SCAN 2
150 #define JIM_CHARSET_GLOB 0
153 * pattern points to a string like "[^a-z\ub5]"
155 * The pattern may contain trailing chars, which are ignored.
157 * The pattern is matched against unicode char 'c'.
159 * If (flags & JIM_NOCASE), case is ignored when matching.
160 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
161 * of the charset, per scan, rather than glob/string match.
163 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
164 * or the null character if the ']' is missing.
166 * Returns NULL on no match.
168 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
170 int not = 0;
171 int pchar;
172 int match = 0;
173 int nocase = 0;
175 if (flags & JIM_NOCASE) {
176 nocase++;
177 c = utf8_upper(c);
180 if (flags & JIM_CHARSET_SCAN) {
181 if (*pattern == '^') {
182 not++;
183 pattern++;
186 /* Special case. If the first char is ']', it is part of the set */
187 if (*pattern == ']') {
188 goto first;
192 while (*pattern && *pattern != ']') {
193 /* Exact match */
194 if (pattern[0] == '\\') {
195 first:
196 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
198 else {
199 /* Is this a range? a-z */
200 int start;
201 int end;
203 pattern += utf8_tounicode_case(pattern, &start, nocase);
204 if (pattern[0] == '-' && pattern[1]) {
205 /* skip '-' */
206 pattern += utf8_tounicode(pattern, &pchar);
207 pattern += utf8_tounicode_case(pattern, &end, nocase);
209 /* Handle reversed range too */
210 if ((c >= start && c <= end) || (c >= end && c <= start)) {
211 match = 1;
213 continue;
215 pchar = start;
218 if (pchar == c) {
219 match = 1;
222 if (not) {
223 match = !match;
226 return match ? pattern : NULL;
229 /* Glob-style pattern matching. */
231 /* Note: string *must* be valid UTF-8 sequences
232 * slen is a char length, not byte counts.
234 static int GlobMatch(const char *pattern, const char *string, int nocase)
236 int c;
237 int pchar;
238 while (*pattern) {
239 switch (pattern[0]) {
240 case '*':
241 while (pattern[1] == '*') {
242 pattern++;
244 pattern++;
245 if (!pattern[0]) {
246 return 1; /* match */
248 while (*string) {
249 /* Recursive call - Does the remaining pattern match anywhere? */
250 if (GlobMatch(pattern, string, nocase))
251 return 1; /* match */
252 string += utf8_tounicode(string, &c);
254 return 0; /* no match */
256 case '?':
257 string += utf8_tounicode(string, &c);
258 break;
260 case '[': {
261 string += utf8_tounicode(string, &c);
262 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
263 if (!pattern) {
264 return 0;
266 if (!*pattern) {
267 /* Ran out of pattern (no ']') */
268 continue;
270 break;
272 case '\\':
273 if (pattern[1]) {
274 pattern++;
276 /* fall through */
277 default:
278 string += utf8_tounicode_case(string, &c, nocase);
279 utf8_tounicode_case(pattern, &pchar, nocase);
280 if (pchar != c) {
281 return 0;
283 break;
285 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
286 if (!*string) {
287 while (*pattern == '*') {
288 pattern++;
290 break;
293 if (!*pattern && !*string) {
294 return 1;
296 return 0;
299 static int JimStringMatch(Jim_Interp *interp, Jim_Obj *patternObj, const char *string, int nocase)
301 return GlobMatch(Jim_String(patternObj), string, nocase);
305 * string comparison works on binary data.
307 * Note that the lengths are byte lengths, not char lengths.
309 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
311 if (l1 < l2) {
312 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
314 else if (l2 < l1) {
315 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
317 else {
318 return JimSign(memcmp(s1, s2, l1));
323 * No-case version.
325 * If maxchars is -1, compares to end of string.
326 * Otherwise compares at most 'maxchars' characters.
328 static int JimStringCompareNoCase(const char *s1, const char *s2, int maxchars)
330 while (*s1 && *s2 && maxchars) {
331 int c1, c2;
332 s1 += utf8_tounicode_case(s1, &c1, 1);
333 s2 += utf8_tounicode_case(s2, &c2, 1);
334 if (c1 != c2) {
335 return JimSign(c1 - c2);
337 maxchars--;
339 if (!maxchars) {
340 return 0;
342 /* One string or both terminated */
343 if (*s1) {
344 return 1;
346 if (*s2) {
347 return -1;
349 return 0;
352 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
353 * The index of the first occurrence of s1 in s2 is returned.
354 * If s1 is not found inside s2, -1 is returned. */
355 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
357 int i;
358 int l1bytelen;
360 if (!l1 || !l2 || l1 > l2) {
361 return -1;
363 if (idx < 0)
364 idx = 0;
365 s2 += utf8_index(s2, idx);
367 l1bytelen = utf8_index(s1, l1);
369 for (i = idx; i <= l2 - l1; i++) {
370 int c;
371 if (memcmp(s2, s1, l1bytelen) == 0) {
372 return i;
374 s2 += utf8_tounicode(s2, &c);
376 return -1;
380 * Note: Lengths and return value are in bytes, not chars.
382 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
384 const char *p;
386 if (!l1 || !l2 || l1 > l2)
387 return -1;
389 /* Now search for the needle */
390 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
391 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
392 return p - s2;
395 return -1;
398 #ifdef JIM_UTF8
400 * Note: Lengths and return value are in chars.
402 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
404 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
405 if (n > 0) {
406 n = utf8_strlen(s2, n);
408 return n;
410 #endif
412 int Jim_WideToString(char *buf, jim_wide wideValue)
414 const char *fmt = "%" JIM_WIDE_MODIFIER;
416 return sprintf(buf, fmt, wideValue);
420 * After an strtol()/strtod()-like conversion,
421 * check whether something was converted and that
422 * the only thing left is white space.
424 * Returns JIM_OK or JIM_ERR.
426 static int JimCheckConversion(const char *str, const char *endptr)
428 if (str[0] == '\0' || str == endptr) {
429 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while (*endptr) {
434 if (!isspace(UCHAR(*endptr))) {
435 return JIM_ERR;
437 endptr++;
440 return JIM_OK;
443 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
445 char *endptr;
447 *widePtr = strtoull(str, &endptr, base);
449 return JimCheckConversion(str, endptr);
452 int Jim_DoubleToString(char *buf, double doubleValue)
454 int len;
455 char *buf0 = buf;
457 len = sprintf(buf, "%.12g", doubleValue);
459 /* Add a final ".0" if it's a number. But not
460 * for NaN or InF */
461 while (*buf) {
462 if (*buf == '.' || isalpha(UCHAR(*buf))) {
463 /* inf -> Inf, nan -> Nan */
464 if (*buf == 'i' || *buf == 'n') {
465 *buf = toupper(UCHAR(*buf));
467 if (*buf == 'I') {
468 /* Infinity -> Inf */
469 buf[3] = '\0';
470 len = buf - buf0 + 3;
472 return len;
474 buf++;
477 *buf++ = '.';
478 *buf++ = '0';
479 *buf = '\0';
481 return len + 2;
484 int Jim_StringToDouble(const char *str, double *doublePtr)
486 char *endptr;
488 /* Callers can check for underflow via ERANGE */
489 errno = 0;
491 *doublePtr = strtod(str, &endptr);
493 return JimCheckConversion(str, endptr);
496 static jim_wide JimPowWide(jim_wide b, jim_wide e)
498 jim_wide i, res = 1;
500 if ((b == 0 && e != 0) || (e < 0))
501 return 0;
502 for (i = 0; i < e; i++) {
503 res *= b;
505 return res;
508 /* -----------------------------------------------------------------------------
509 * Special functions
510 * ---------------------------------------------------------------------------*/
511 #ifdef JIM_DEBUG_PANIC
512 /* Note that 'interp' may be NULL if not available in the
513 * context of the panic. It's only useful to get the error
514 * file descriptor, it will default to stderr otherwise. */
515 void JimPanicDump(int condition, Jim_Interp *interp, const char *fmt, ...)
517 va_list ap;
519 if (!condition) {
520 return;
523 va_start(ap, fmt);
525 * Send it here first.. Assuming STDIO still works
527 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
528 vfprintf(stderr, fmt, ap);
529 fprintf(stderr, JIM_NL JIM_NL);
530 va_end(ap);
532 #ifdef HAVE_BACKTRACE
534 void *array[40];
535 int size, i;
536 char **strings;
538 size = backtrace(array, 40);
539 strings = backtrace_symbols(array, size);
540 for (i = 0; i < size; i++)
541 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
542 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
543 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
545 #endif
547 abort();
549 #endif
551 /* -----------------------------------------------------------------------------
552 * Memory allocation
553 * ---------------------------------------------------------------------------*/
555 void *Jim_Alloc(int size)
557 return malloc(size);
560 void Jim_Free(void *ptr)
562 free(ptr);
565 void *Jim_Realloc(void *ptr, int size)
567 return realloc(ptr, size);
570 char *Jim_StrDup(const char *s)
572 return strdup(s);
575 char *Jim_StrDupLen(const char *s, int l)
577 char *copy = Jim_Alloc(l + 1);
579 memcpy(copy, s, l + 1);
580 copy[l] = 0; /* Just to be sure, original could be substring */
581 return copy;
584 /* -----------------------------------------------------------------------------
585 * Time related functions
586 * ---------------------------------------------------------------------------*/
588 /* Returns microseconds of CPU used since start. */
589 static jim_wide JimClock(void)
591 struct timeval tv;
593 gettimeofday(&tv, NULL);
594 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
597 /* -----------------------------------------------------------------------------
598 * Hash Tables
599 * ---------------------------------------------------------------------------*/
601 /* -------------------------- private prototypes ---------------------------- */
602 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
603 static unsigned int JimHashTableNextPower(unsigned int size);
604 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
606 /* -------------------------- hash functions -------------------------------- */
608 /* Thomas Wang's 32 bit Mix Function */
609 unsigned int Jim_IntHashFunction(unsigned int key)
611 key += ~(key << 15);
612 key ^= (key >> 10);
613 key += (key << 3);
614 key ^= (key >> 6);
615 key += ~(key << 11);
616 key ^= (key >> 16);
617 return key;
620 /* Generic hash function (we are using to multiply by 9 and add the byte
621 * as Tcl) */
622 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
624 unsigned int h = 0;
626 while (len--)
627 h += (h << 3) + *buf++;
628 return h;
631 /* ----------------------------- API implementation ------------------------- */
633 /* reset a hashtable already initialized with ht_init().
634 * NOTE: This function should only called by ht_destroy(). */
635 static void JimResetHashTable(Jim_HashTable *ht)
637 ht->table = NULL;
638 ht->size = 0;
639 ht->sizemask = 0;
640 ht->used = 0;
641 ht->collisions = 0;
644 /* Initialize the hash table */
645 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
647 JimResetHashTable(ht);
648 ht->type = type;
649 ht->privdata = privDataPtr;
650 return JIM_OK;
653 /* Resize the table to the minimal size that contains all the elements,
654 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
655 int Jim_ResizeHashTable(Jim_HashTable *ht)
657 int minimal = ht->used;
659 if (minimal < JIM_HT_INITIAL_SIZE)
660 minimal = JIM_HT_INITIAL_SIZE;
661 return Jim_ExpandHashTable(ht, minimal);
664 /* Expand or create the hashtable */
665 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
667 Jim_HashTable n; /* the new hashtable */
668 unsigned int realsize = JimHashTableNextPower(size), i;
670 /* the size is invalid if it is smaller than the number of
671 * elements already inside the hashtable */
672 if (ht->used >= size)
673 return JIM_ERR;
675 Jim_InitHashTable(&n, ht->type, ht->privdata);
676 n.size = realsize;
677 n.sizemask = realsize - 1;
678 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
680 /* Initialize all the pointers to NULL */
681 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
683 /* Copy all the elements from the old to the new table:
684 * note that if the old hash table is empty ht->size is zero,
685 * so Jim_ExpandHashTable just creates an hash table. */
686 n.used = ht->used;
687 for (i = 0; i < ht->size && ht->used > 0; i++) {
688 Jim_HashEntry *he, *nextHe;
690 if (ht->table[i] == NULL)
691 continue;
693 /* For each hash entry on this slot... */
694 he = ht->table[i];
695 while (he) {
696 unsigned int h;
698 nextHe = he->next;
699 /* Get the new element index */
700 h = Jim_HashKey(ht, he->key) & n.sizemask;
701 he->next = n.table[h];
702 n.table[h] = he;
703 ht->used--;
704 /* Pass to the next element */
705 he = nextHe;
708 assert(ht->used == 0);
709 Jim_Free(ht->table);
711 /* Remap the new hashtable in the old */
712 *ht = n;
713 return JIM_OK;
716 /* Add an element to the target hash table */
717 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
719 int idx;
720 Jim_HashEntry *entry;
722 /* Get the index of the new element, or -1 if
723 * the element already exists. */
724 if ((idx = JimInsertHashEntry(ht, key)) == -1)
725 return JIM_ERR;
727 /* Allocates the memory and stores key */
728 entry = Jim_Alloc(sizeof(*entry));
729 entry->next = ht->table[idx];
730 ht->table[idx] = entry;
732 /* Set the hash entry fields. */
733 Jim_SetHashKey(ht, entry, key);
734 Jim_SetHashVal(ht, entry, val);
735 ht->used++;
736 return JIM_OK;
739 /* Add an element, discarding the old if the key already exists */
740 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
742 Jim_HashEntry *entry;
744 /* Try to add the element. If the key
745 * does not exists Jim_AddHashEntry will suceed. */
746 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
747 return JIM_OK;
748 /* It already exists, get the entry */
749 entry = Jim_FindHashEntry(ht, key);
750 /* Free the old value and set the new one */
751 Jim_FreeEntryVal(ht, entry);
752 Jim_SetHashVal(ht, entry, val);
753 return JIM_OK;
756 /* Search and remove an element */
757 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
759 unsigned int h;
760 Jim_HashEntry *he, *prevHe;
762 if (ht->size == 0)
763 return JIM_ERR;
764 h = Jim_HashKey(ht, key) & ht->sizemask;
765 he = ht->table[h];
767 prevHe = NULL;
768 while (he) {
769 if (Jim_CompareHashKeys(ht, key, he->key)) {
770 /* Unlink the element from the list */
771 if (prevHe)
772 prevHe->next = he->next;
773 else
774 ht->table[h] = he->next;
775 Jim_FreeEntryKey(ht, he);
776 Jim_FreeEntryVal(ht, he);
777 Jim_Free(he);
778 ht->used--;
779 return JIM_OK;
781 prevHe = he;
782 he = he->next;
784 return JIM_ERR; /* not found */
787 /* Destroy an entire hash table */
788 int Jim_FreeHashTable(Jim_HashTable *ht)
790 unsigned int i;
792 /* Free all the elements */
793 for (i = 0; i < ht->size && ht->used > 0; i++) {
794 Jim_HashEntry *he, *nextHe;
796 if ((he = ht->table[i]) == NULL)
797 continue;
798 while (he) {
799 nextHe = he->next;
800 Jim_FreeEntryKey(ht, he);
801 Jim_FreeEntryVal(ht, he);
802 Jim_Free(he);
803 ht->used--;
804 he = nextHe;
807 /* Free the table and the allocated cache structure */
808 Jim_Free(ht->table);
809 /* Re-initialize the table */
810 JimResetHashTable(ht);
811 return JIM_OK; /* never fails */
814 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
816 Jim_HashEntry *he;
817 unsigned int h;
819 if (ht->size == 0)
820 return NULL;
821 h = Jim_HashKey(ht, key) & ht->sizemask;
822 he = ht->table[h];
823 while (he) {
824 if (Jim_CompareHashKeys(ht, key, he->key))
825 return he;
826 he = he->next;
828 return NULL;
831 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
833 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
835 iter->ht = ht;
836 iter->index = -1;
837 iter->entry = NULL;
838 iter->nextEntry = NULL;
839 return iter;
842 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
844 while (1) {
845 if (iter->entry == NULL) {
846 iter->index++;
847 if (iter->index >= (signed)iter->ht->size)
848 break;
849 iter->entry = iter->ht->table[iter->index];
851 else {
852 iter->entry = iter->nextEntry;
854 if (iter->entry) {
855 /* We need to save the 'next' here, the iterator user
856 * may delete the entry we are returning. */
857 iter->nextEntry = iter->entry->next;
858 return iter->entry;
861 return NULL;
864 /* ------------------------- private functions ------------------------------ */
866 /* Expand the hash table if needed */
867 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
869 /* If the hash table is empty expand it to the intial size,
870 * if the table is "full" dobule its size. */
871 if (ht->size == 0)
872 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
873 if (ht->size == ht->used)
874 return Jim_ExpandHashTable(ht, ht->size * 2);
875 return JIM_OK;
878 /* Our hash table capability is a power of two */
879 static unsigned int JimHashTableNextPower(unsigned int size)
881 unsigned int i = JIM_HT_INITIAL_SIZE;
883 if (size >= 2147483648U)
884 return 2147483648U;
885 while (1) {
886 if (i >= size)
887 return i;
888 i *= 2;
892 /* Returns the index of a free slot that can be populated with
893 * an hash entry for the given 'key'.
894 * If the key already exists, -1 is returned. */
895 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
897 unsigned int h;
898 Jim_HashEntry *he;
900 /* Expand the hashtable if needed */
901 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
902 return -1;
903 /* Compute the key hash value */
904 h = Jim_HashKey(ht, key) & ht->sizemask;
905 /* Search if this slot does not already contain the given key */
906 he = ht->table[h];
907 while (he) {
908 if (Jim_CompareHashKeys(ht, key, he->key))
909 return -1;
910 he = he->next;
912 return h;
915 /* ----------------------- StringCopy Hash Table Type ------------------------*/
917 static unsigned int JimStringCopyHTHashFunction(const void *key)
919 return Jim_GenHashFunction(key, strlen(key));
922 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
924 int len = strlen(key);
925 char *copy = Jim_Alloc(len + 1);
927 JIM_NOTUSED(privdata);
929 memcpy(copy, key, len);
930 copy[len] = '\0';
931 return copy;
934 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
936 int len = strlen(val);
937 char *copy = Jim_Alloc(len + 1);
939 JIM_NOTUSED(privdata);
941 memcpy(copy, val, len);
942 copy[len] = '\0';
943 return copy;
946 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
948 JIM_NOTUSED(privdata);
950 return strcmp(key1, key2) == 0;
953 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
955 JIM_NOTUSED(privdata);
957 Jim_Free((void *)key); /* ATTENTION: const cast */
960 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
962 JIM_NOTUSED(privdata);
964 Jim_Free((void *)val); /* ATTENTION: const cast */
967 #if 0
968 static Jim_HashTableType JimStringCopyHashTableType = {
969 JimStringCopyHTHashFunction, /* hash function */
970 JimStringCopyHTKeyDup, /* key dup */
971 NULL, /* val dup */
972 JimStringCopyHTKeyCompare, /* key compare */
973 JimStringCopyHTKeyDestructor, /* key destructor */
974 NULL /* val destructor */
976 #endif
978 /* This is like StringCopy but does not auto-duplicate the key.
979 * It's used for intepreter's shared strings. */
980 static const Jim_HashTableType JimSharedStringsHashTableType = {
981 JimStringCopyHTHashFunction, /* hash function */
982 NULL, /* key dup */
983 NULL, /* val dup */
984 JimStringCopyHTKeyCompare, /* key compare */
985 JimStringCopyHTKeyDestructor, /* key destructor */
986 NULL /* val destructor */
989 /* This is like StringCopy but also automatically handle dynamic
990 * allocated C strings as values. */
991 static const Jim_HashTableType JimStringKeyValCopyHashTableType = {
992 JimStringCopyHTHashFunction, /* hash function */
993 JimStringCopyHTKeyDup, /* key dup */
994 JimStringKeyValCopyHTValDup, /* val dup */
995 JimStringCopyHTKeyCompare, /* key compare */
996 JimStringCopyHTKeyDestructor, /* key destructor */
997 JimStringKeyValCopyHTValDestructor, /* val destructor */
1000 typedef struct AssocDataValue
1002 Jim_InterpDeleteProc *delProc;
1003 void *data;
1004 } AssocDataValue;
1006 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1008 AssocDataValue *assocPtr = (AssocDataValue *) data;
1010 if (assocPtr->delProc != NULL)
1011 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1012 Jim_Free(data);
1015 static const Jim_HashTableType JimAssocDataHashTableType = {
1016 JimStringCopyHTHashFunction, /* hash function */
1017 JimStringCopyHTKeyDup, /* key dup */
1018 NULL, /* val dup */
1019 JimStringCopyHTKeyCompare, /* key compare */
1020 JimStringCopyHTKeyDestructor, /* key destructor */
1021 JimAssocDataHashTableValueDestructor /* val destructor */
1024 /* -----------------------------------------------------------------------------
1025 * Stack - This is a simple generic stack implementation. It is used for
1026 * example in the 'expr' expression compiler.
1027 * ---------------------------------------------------------------------------*/
1028 void Jim_InitStack(Jim_Stack *stack)
1030 stack->len = 0;
1031 stack->maxlen = 0;
1032 stack->vector = NULL;
1035 void Jim_FreeStack(Jim_Stack *stack)
1037 Jim_Free(stack->vector);
1040 int Jim_StackLen(Jim_Stack *stack)
1042 return stack->len;
1045 void Jim_StackPush(Jim_Stack *stack, void *element)
1047 int neededLen = stack->len + 1;
1049 if (neededLen > stack->maxlen) {
1050 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1051 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1053 stack->vector[stack->len] = element;
1054 stack->len++;
1057 void *Jim_StackPop(Jim_Stack *stack)
1059 if (stack->len == 0)
1060 return NULL;
1061 stack->len--;
1062 return stack->vector[stack->len];
1065 void *Jim_StackPeek(Jim_Stack *stack)
1067 if (stack->len == 0)
1068 return NULL;
1069 return stack->vector[stack->len - 1];
1072 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1074 int i;
1076 for (i = 0; i < stack->len; i++)
1077 freeFunc(stack->vector[i]);
1080 /* -----------------------------------------------------------------------------
1081 * Parser
1082 * ---------------------------------------------------------------------------*/
1084 /* Token types */
1085 #define JIM_TT_NONE 0 /* No token returned */
1086 #define JIM_TT_STR 1 /* simple string */
1087 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1088 #define JIM_TT_VAR 3 /* var substitution */
1089 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1090 #define JIM_TT_CMD 5 /* command substitution */
1091 /* Note: Keep these three together for TOKEN_IS_SEP() */
1092 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
1093 #define JIM_TT_EOL 7 /* line separator */
1094 #define JIM_TT_EOF 8 /* end of script */
1096 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1097 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1099 /* Additional token types needed for expressions */
1100 #define JIM_TT_SUBEXPR_START 11
1101 #define JIM_TT_SUBEXPR_END 12
1102 #define JIM_TT_EXPR_INT 13
1103 #define JIM_TT_EXPR_DOUBLE 14
1105 #define JIM_TT_EXPRSUGAR 15 /* $(expression) */
1107 /* Operator token types start here */
1108 #define JIM_TT_EXPR_OP 20
1110 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1112 /* Parser states */
1113 #define JIM_PS_DEF 0 /* Default state */
1114 #define JIM_PS_QUOTE 1 /* Inside "" */
1115 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1117 /* Parser context structure. The same context is used both to parse
1118 * Tcl scripts and lists. */
1119 struct JimParserCtx
1121 const char *prg; /* Program text */
1122 const char *p; /* Pointer to the point of the program we are parsing */
1123 int len; /* Left length of 'prg' */
1124 int linenr; /* Current line number */
1125 const char *tstart;
1126 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1127 int tline; /* Line number of the returned token */
1128 int tt; /* Token type */
1129 int eof; /* Non zero if EOF condition is true. */
1130 int state; /* Parser state */
1131 int comment; /* Non zero if the next chars may be a comment. */
1132 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1135 static int JimParseScript(struct JimParserCtx *pc);
1136 static int JimParseSep(struct JimParserCtx *pc);
1137 static int JimParseEol(struct JimParserCtx *pc);
1138 static int JimParseCmd(struct JimParserCtx *pc);
1139 static int JimParseQuote(struct JimParserCtx *pc);
1140 static int JimParseVar(struct JimParserCtx *pc);
1141 static int JimParseBrace(struct JimParserCtx *pc);
1142 static int JimParseStr(struct JimParserCtx *pc);
1143 static int JimParseComment(struct JimParserCtx *pc);
1144 static void JimParseSubCmd(struct JimParserCtx *pc);
1145 static int JimParseSubQuote(struct JimParserCtx *pc);
1146 static void JimParseSubCmd(struct JimParserCtx *pc);
1147 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1149 /* Initialize a parser context.
1150 * 'prg' is a pointer to the program text, linenr is the line
1151 * number of the first line contained in the program. */
1152 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1154 pc->prg = prg;
1155 pc->p = prg;
1156 pc->len = len;
1157 pc->tstart = NULL;
1158 pc->tend = NULL;
1159 pc->tline = 0;
1160 pc->tt = JIM_TT_NONE;
1161 pc->eof = 0;
1162 pc->state = JIM_PS_DEF;
1163 pc->linenr = linenr;
1164 pc->comment = 1;
1165 pc->missing = ' ';
1168 static int JimParseScript(struct JimParserCtx *pc)
1170 while (1) { /* the while is used to reiterate with continue if needed */
1171 if (!pc->len) {
1172 pc->tstart = pc->p;
1173 pc->tend = pc->p - 1;
1174 pc->tline = pc->linenr;
1175 pc->tt = JIM_TT_EOL;
1176 pc->eof = 1;
1177 return JIM_OK;
1179 switch (*(pc->p)) {
1180 case '\\':
1181 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1182 return JimParseSep(pc);
1184 else {
1185 pc->comment = 0;
1186 return JimParseStr(pc);
1188 break;
1189 case ' ':
1190 case '\t':
1191 case '\r':
1192 if (pc->state == JIM_PS_DEF)
1193 return JimParseSep(pc);
1194 else {
1195 pc->comment = 0;
1196 return JimParseStr(pc);
1198 break;
1199 case '\n':
1200 case ';':
1201 pc->comment = 1;
1202 if (pc->state == JIM_PS_DEF)
1203 return JimParseEol(pc);
1204 else
1205 return JimParseStr(pc);
1206 break;
1207 case '[':
1208 pc->comment = 0;
1209 return JimParseCmd(pc);
1210 break;
1211 case '$':
1212 pc->comment = 0;
1213 if (JimParseVar(pc) == JIM_ERR) {
1214 pc->tstart = pc->tend = pc->p++;
1215 pc->len--;
1216 pc->tline = pc->linenr;
1217 pc->tt = JIM_TT_STR;
1218 return JIM_OK;
1220 else
1221 return JIM_OK;
1222 break;
1223 case '#':
1224 if (pc->comment) {
1225 JimParseComment(pc);
1226 continue;
1228 else {
1229 return JimParseStr(pc);
1231 default:
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 break;
1236 return JIM_OK;
1240 static int JimParseSep(struct JimParserCtx *pc)
1242 pc->tstart = pc->p;
1243 pc->tline = pc->linenr;
1244 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1245 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1246 if (*pc->p == '\\') {
1247 pc->p++;
1248 pc->len--;
1249 pc->linenr++;
1251 pc->p++;
1252 pc->len--;
1254 pc->tend = pc->p - 1;
1255 pc->tt = JIM_TT_SEP;
1256 return JIM_OK;
1259 static int JimParseEol(struct JimParserCtx *pc)
1261 pc->tstart = pc->p;
1262 pc->tline = pc->linenr;
1263 while (*pc->p == ' ' || *pc->p == '\n' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1264 if (*pc->p == '\n')
1265 pc->linenr++;
1266 pc->p++;
1267 pc->len--;
1269 pc->tend = pc->p - 1;
1270 pc->tt = JIM_TT_EOL;
1271 return JIM_OK;
1275 ** Here are the rules for parsing:
1276 ** {braced expression}
1277 ** - Count open and closing braces
1278 ** - Backslash escapes meaning of braces
1280 ** "quoted expression"
1281 ** - First double quote at start of word terminates the expression
1282 ** - Backslash escapes quote and bracket
1283 ** - [commands brackets] are counted/nested
1284 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1286 ** [command expression]
1287 ** - Count open and closing brackets
1288 ** - Backslash escapes quote, bracket and brace
1289 ** - [commands brackets] are counted/nested
1290 ** - "quoted expressions" are parsed according to quoting rules
1291 ** - {braced expressions} are parsed according to brace rules
1293 ** For everything, backslash escapes the next char, newline increments current line
1297 * Parses a braced expression starting at pc->p.
1299 * Positions the parser at the end of the braced expression,
1300 * sets pc->tend and possibly pc->missing.
1302 static void JimParseSubBrace(struct JimParserCtx *pc)
1304 int level = 1;
1306 /* Skip the brace */
1307 pc->p++;
1308 pc->len--;
1309 while (pc->len) {
1310 switch (*pc->p) {
1311 case '\\':
1312 if (pc->len > 1) {
1313 if (*++pc->p == '\n') {
1314 pc->linenr++;
1316 pc->len--;
1318 break;
1320 case '{':
1321 level++;
1322 break;
1324 case '}':
1325 if (--level == 0) {
1326 pc->tend = pc->p - 1;
1327 pc->p++;
1328 pc->len--;
1329 return;
1331 break;
1333 case '\n':
1334 pc->linenr++;
1335 break;
1337 pc->p++;
1338 pc->len--;
1340 pc->missing = '{';
1341 pc->tend = pc->p - 1;
1345 * Parses a quoted expression starting at pc->p.
1347 * Positions the parser at the end of the quoted expression,
1348 * sets pc->tend and possibly pc->missing.
1350 * Returns the type of the token of the string,
1351 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1352 * or JIM_TT_STR.
1354 static int JimParseSubQuote(struct JimParserCtx *pc)
1356 int tt = JIM_TT_STR;
1358 /* Skip the quote */
1359 pc->p++;
1360 pc->len--;
1361 while (pc->len) {
1362 switch (*pc->p) {
1363 case '\\':
1364 if (pc->len > 1) {
1365 if (*++pc->p == '\n') {
1366 pc->linenr++;
1368 pc->len--;
1369 tt = JIM_TT_ESC;
1371 break;
1373 case '"':
1374 pc->tend = pc->p - 1;
1375 pc->p++;
1376 pc->len--;
1377 return tt;
1379 case '[':
1380 JimParseSubCmd(pc);
1381 tt = JIM_TT_ESC;
1382 continue;
1384 case '\n':
1385 pc->linenr++;
1386 break;
1388 case '$':
1389 tt = JIM_TT_ESC;
1390 break;
1392 pc->p++;
1393 pc->len--;
1395 pc->missing = '"';
1396 pc->tend = pc->p - 1;
1397 return tt;
1401 * Parses a [command] expression starting at pc->p.
1403 * Positions the parser at the end of the command expression,
1404 * sets pc->tend and possibly pc->missing.
1406 static void JimParseSubCmd(struct JimParserCtx *pc)
1408 int level = 1;
1409 int startofword = 1;
1411 /* Skip the bracket */
1412 pc->p++;
1413 pc->len--;
1414 while (pc->len) {
1415 switch (*pc->p) {
1416 case '\\':
1417 if (pc->len > 1) {
1418 if (*++pc->p == '\n') {
1419 pc->linenr++;
1421 pc->len--;
1423 break;
1425 case '[':
1426 level++;
1427 break;
1429 case ']':
1430 if (--level == 0) {
1431 pc->tend = pc->p - 1;
1432 pc->p++;
1433 pc->len--;
1434 return;
1436 break;
1438 case '"':
1439 if (startofword) {
1440 JimParseSubQuote(pc);
1441 continue;
1443 break;
1445 case '{':
1446 JimParseSubBrace(pc);
1447 startofword = 0;
1448 continue;
1450 case '\n':
1451 pc->linenr++;
1452 break;
1454 startofword = isspace(UCHAR(*pc->p));
1455 pc->p++;
1456 pc->len--;
1458 pc->missing = '[';
1459 pc->tend = pc->p - 1;
1462 static int JimParseBrace(struct JimParserCtx *pc)
1464 pc->tstart = pc->p + 1;
1465 pc->tline = pc->linenr;
1466 pc->tt = JIM_TT_STR;
1467 JimParseSubBrace(pc);
1468 return JIM_OK;
1471 static int JimParseCmd(struct JimParserCtx *pc)
1473 pc->tstart = pc->p + 1;
1474 pc->tline = pc->linenr;
1475 pc->tt = JIM_TT_CMD;
1476 JimParseSubCmd(pc);
1477 return JIM_OK;
1480 static int JimParseQuote(struct JimParserCtx *pc)
1482 pc->tstart = pc->p + 1;
1483 pc->tline = pc->linenr;
1484 pc->tt = JimParseSubQuote(pc);
1485 return JIM_OK;
1488 static int JimParseVar(struct JimParserCtx *pc)
1490 int brace = 0, stop = 0;
1491 int ttype = JIM_TT_VAR;
1493 pc->tstart = ++pc->p;
1494 pc->len--; /* skip the $ */
1495 pc->tline = pc->linenr;
1496 if (*pc->p == '{') {
1497 pc->tstart = ++pc->p;
1498 pc->len--;
1499 brace = 1;
1501 if (brace) {
1502 while (!stop) {
1503 if (*pc->p == '}' || pc->len == 0) {
1504 pc->tend = pc->p - 1;
1505 stop = 1;
1506 if (pc->len == 0)
1507 break;
1509 else if (*pc->p == '\n')
1510 pc->linenr++;
1511 pc->p++;
1512 pc->len--;
1515 else {
1516 while (!stop) {
1517 /* Skip double colon, but not single colon! */
1518 if (pc->p[0] == ':' && pc->len > 1 && pc->p[1] == ':') {
1519 pc->p += 2;
1520 pc->len -= 2;
1521 continue;
1523 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1524 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1525 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1526 stop = 1;
1527 else {
1528 pc->p++;
1529 pc->len--;
1532 /* Parse [dict get] syntax sugar. */
1533 if (*pc->p == '(') {
1534 int count = 1;
1535 const char *paren = NULL;
1537 while (count && pc->len) {
1538 pc->p++;
1539 pc->len--;
1540 if (*pc->p == '\\' && pc->len >= 1) {
1541 pc->p++;
1542 pc->len--;
1544 else if (*pc->p == '(') {
1545 count++;
1547 else if (*pc->p == ')') {
1548 paren = pc->p;
1549 count--;
1552 if (count == 0) {
1553 pc->p++;
1554 pc->len--;
1556 else if (paren) {
1557 /* Did not find a matching paren. Back up */
1558 paren++;
1559 pc->len += (pc->p - paren);
1560 pc->p = paren;
1562 ttype = (*pc->tstart == '(') ? JIM_TT_EXPRSUGAR : JIM_TT_DICTSUGAR;
1564 pc->tend = pc->p - 1;
1566 /* Check if we parsed just the '$' character.
1567 * That's not a variable so an error is returned
1568 * to tell the state machine to consider this '$' just
1569 * a string. */
1570 if (pc->tstart == pc->p) {
1571 pc->p--;
1572 pc->len++;
1573 return JIM_ERR;
1575 pc->tt = ttype;
1576 return JIM_OK;
1579 static int JimParseStr(struct JimParserCtx *pc)
1581 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1582 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1583 if (newword && *pc->p == '{') {
1584 return JimParseBrace(pc);
1586 else if (newword && *pc->p == '"') {
1587 pc->state = JIM_PS_QUOTE;
1588 pc->p++;
1589 pc->len--;
1591 pc->tstart = pc->p;
1592 pc->tline = pc->linenr;
1593 while (1) {
1594 if (pc->len == 0) {
1595 if (pc->state == JIM_PS_QUOTE) {
1596 pc->missing = '"';
1598 pc->tend = pc->p - 1;
1599 pc->tt = JIM_TT_ESC;
1600 return JIM_OK;
1602 switch (*pc->p) {
1603 case '\\':
1604 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1605 pc->tend = pc->p - 1;
1606 pc->tt = JIM_TT_ESC;
1607 return JIM_OK;
1609 if (pc->len >= 2) {
1610 if (*(pc->p + 1) == '\n') {
1611 pc->linenr++;
1613 pc->p++;
1614 pc->len--;
1616 break;
1617 case '(':
1618 /* If the following token is not '$' just keep going */
1619 if (pc->len > 1 && pc->p[1] != '$') {
1620 break;
1622 case ')':
1623 /* Only need a separate ')' token if the previous was a var */
1624 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1625 if (pc->p == pc->tstart) {
1626 /* At the start of the token, so just return this char */
1627 pc->p++;
1628 pc->len--;
1630 pc->tend = pc->p - 1;
1631 pc->tt = JIM_TT_ESC;
1632 return JIM_OK;
1634 break;
1636 case '$':
1637 case '[':
1638 pc->tend = pc->p - 1;
1639 pc->tt = JIM_TT_ESC;
1640 return JIM_OK;
1641 case ' ':
1642 case '\t':
1643 case '\n':
1644 case '\r':
1645 case ';':
1646 if (pc->state == JIM_PS_DEF) {
1647 pc->tend = pc->p - 1;
1648 pc->tt = JIM_TT_ESC;
1649 return JIM_OK;
1651 else if (*pc->p == '\n') {
1652 pc->linenr++;
1654 break;
1655 case '"':
1656 if (pc->state == JIM_PS_QUOTE) {
1657 pc->tend = pc->p - 1;
1658 pc->tt = JIM_TT_ESC;
1659 pc->p++;
1660 pc->len--;
1661 pc->state = JIM_PS_DEF;
1662 return JIM_OK;
1664 break;
1666 pc->p++;
1667 pc->len--;
1669 return JIM_OK; /* unreached */
1672 static int JimParseComment(struct JimParserCtx *pc)
1674 while (*pc->p) {
1675 if (*pc->p == '\n') {
1676 pc->linenr++;
1677 if (*(pc->p - 1) != '\\') {
1678 pc->p++;
1679 pc->len--;
1680 return JIM_OK;
1683 pc->p++;
1684 pc->len--;
1686 return JIM_OK;
1689 /* xdigitval and odigitval are helper functions for JimEscape() */
1690 static int xdigitval(int c)
1692 if (c >= '0' && c <= '9')
1693 return c - '0';
1694 if (c >= 'a' && c <= 'f')
1695 return c - 'a' + 10;
1696 if (c >= 'A' && c <= 'F')
1697 return c - 'A' + 10;
1698 return -1;
1701 static int odigitval(int c)
1703 if (c >= '0' && c <= '7')
1704 return c - '0';
1705 return -1;
1708 /* Perform Tcl escape substitution of 's', storing the result
1709 * string into 'dest'. The escaped string is guaranteed to
1710 * be the same length or shorted than the source string.
1711 * Slen is the length of the string at 's', if it's -1 the string
1712 * length will be calculated by the function.
1714 * The function returns the length of the resulting string. */
1715 static int JimEscape(char *dest, const char *s, int slen)
1717 char *p = dest;
1718 int i, len;
1720 if (slen == -1)
1721 slen = strlen(s);
1723 for (i = 0; i < slen; i++) {
1724 switch (s[i]) {
1725 case '\\':
1726 switch (s[i + 1]) {
1727 case 'a':
1728 *p++ = 0x7;
1729 i++;
1730 break;
1731 case 'b':
1732 *p++ = 0x8;
1733 i++;
1734 break;
1735 case 'f':
1736 *p++ = 0xc;
1737 i++;
1738 break;
1739 case 'n':
1740 *p++ = 0xa;
1741 i++;
1742 break;
1743 case 'r':
1744 *p++ = 0xd;
1745 i++;
1746 break;
1747 case 't':
1748 *p++ = 0x9;
1749 i++;
1750 break;
1751 case 'u':
1752 case 'x':
1753 /* A unicode or hex sequence.
1754 * \u Expect 1-4 hex chars and convert to utf-8.
1755 * \x Expect 1-2 hex chars and convert to hex.
1756 * An invalid sequence means simply the escaped char.
1759 int val = 0;
1760 int k;
1762 i++;
1764 for (k = 0; k < (s[i] == 'u' ? 4 : 2); k++) {
1765 int c = xdigitval(s[i + k + 1]);
1766 if (c == -1) {
1767 break;
1769 val = (val << 4) | c;
1771 if (k) {
1772 /* Got a valid sequence, so convert */
1773 if (s[i] == 'u') {
1774 p += utf8_fromunicode(p, val);
1776 else {
1777 *p++ = val;
1779 i += k;
1780 break;
1782 /* Not a valid codepoint, just an escaped char */
1783 *p++ = s[i];
1785 break;
1786 case 'v':
1787 *p++ = 0xb;
1788 i++;
1789 break;
1790 case '\0':
1791 *p++ = '\\';
1792 i++;
1793 break;
1794 case '\n':
1795 /* Replace all spaces and tabs after backslash newline with a single space*/
1796 *p++ = ' ';
1797 do {
1798 i++;
1799 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1800 break;
1801 case '0':
1802 case '1':
1803 case '2':
1804 case '3':
1805 case '4':
1806 case '5':
1807 case '6':
1808 case '7':
1809 /* octal escape */
1811 int val = 0;
1812 int c = odigitval(s[i + 1]);
1814 val = c;
1815 c = odigitval(s[i + 2]);
1816 if (c == -1) {
1817 *p++ = val;
1818 i++;
1819 break;
1821 val = (val * 8) + c;
1822 c = odigitval(s[i + 3]);
1823 if (c == -1) {
1824 *p++ = val;
1825 i += 2;
1826 break;
1828 val = (val * 8) + c;
1829 *p++ = val;
1830 i += 3;
1832 break;
1833 default:
1834 *p++ = s[i + 1];
1835 i++;
1836 break;
1838 break;
1839 default:
1840 *p++ = s[i];
1841 break;
1844 len = p - dest;
1845 *p = '\0';
1846 return len;
1849 /* Returns a dynamically allocated copy of the current token in the
1850 * parser context. The function performs conversion of escapes if
1851 * the token is of type JIM_TT_ESC.
1853 * Note that after the conversion, tokens that are grouped with
1854 * braces in the source code, are always recognizable from the
1855 * identical string obtained in a different way from the type.
1857 * For example the string:
1859 * {*}$a
1861 * will return as first token "*", of type JIM_TT_STR
1863 * While the string:
1865 * *$a
1867 * will return as first token "*", of type JIM_TT_ESC
1869 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1871 const char *start, *end;
1872 char *token;
1873 int len;
1875 start = pc->tstart;
1876 end = pc->tend;
1877 if (start > end) {
1878 len = 0;
1879 token = Jim_Alloc(1);
1880 token[0] = '\0';
1882 else {
1883 len = (end - start) + 1;
1884 token = Jim_Alloc(len + 1);
1885 if (pc->tt != JIM_TT_ESC) {
1886 /* No escape conversion needed? Just copy it. */
1887 memcpy(token, start, len);
1888 token[len] = '\0';
1890 else {
1891 /* Else convert the escape chars. */
1892 len = JimEscape(token, start, len);
1896 return Jim_NewStringObjNoAlloc(interp, token, len);
1899 /* Parses the given string to determine if it represents a complete script.
1901 * This is useful for interactive shells implementation, for [info complete]
1902 * and is used by source/Jim_EvalFile().
1904 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1905 * '{' on scripts incomplete missing one or more '}' to be balanced.
1906 * '"' on scripts incomplete missing a '"' char.
1908 * If the script is complete, 1 is returned, otherwise 0.
1910 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1912 struct JimParserCtx parser;
1914 JimParserInit(&parser, s, len, 1);
1915 while (!parser.eof) {
1916 JimParseScript(&parser);
1918 if (stateCharPtr) {
1919 *stateCharPtr = parser.missing;
1921 return parser.missing == ' ';
1924 /* -----------------------------------------------------------------------------
1925 * Tcl Lists parsing
1926 * ---------------------------------------------------------------------------*/
1927 static int JimParseListSep(struct JimParserCtx *pc);
1928 static int JimParseListStr(struct JimParserCtx *pc);
1929 static int JimParseListQuote(struct JimParserCtx *pc);
1931 static int JimParseList(struct JimParserCtx *pc)
1933 switch (*pc->p) {
1934 case ' ':
1935 case '\n':
1936 case '\t':
1937 case '\r':
1938 return JimParseListSep(pc);
1940 case '"':
1941 return JimParseListQuote(pc);
1943 case '{':
1944 return JimParseBrace(pc);
1946 default:
1947 if (pc->len) {
1948 return JimParseListStr(pc);
1950 break;
1953 pc->tstart = pc->tend = pc->p;
1954 pc->tline = pc->linenr;
1955 pc->tt = JIM_TT_EOL;
1956 pc->eof = 1;
1957 return JIM_OK;
1960 static int JimParseListSep(struct JimParserCtx *pc)
1962 pc->tstart = pc->p;
1963 pc->tline = pc->linenr;
1964 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n') {
1965 if (*pc->p == '\n') {
1966 pc->linenr++;
1968 pc->p++;
1969 pc->len--;
1971 pc->tend = pc->p - 1;
1972 pc->tt = JIM_TT_SEP;
1973 return JIM_OK;
1976 static int JimParseListQuote(struct JimParserCtx *pc)
1978 pc->p++;
1979 pc->len--;
1981 pc->tstart = pc->p;
1982 pc->tline = pc->linenr;
1983 pc->tt = JIM_TT_STR;
1985 while (pc->len) {
1986 switch (*pc->p) {
1987 case '\\':
1988 pc->tt = JIM_TT_ESC;
1989 if (--pc->len == 0) {
1990 /* Trailing backslash */
1991 pc->tend = pc->p;
1992 return JIM_OK;
1994 pc->p++;
1995 break;
1996 case '\n':
1997 pc->linenr++;
1998 break;
1999 case '"':
2000 pc->tend = pc->p - 1;
2001 pc->p++;
2002 pc->len--;
2003 return JIM_OK;
2005 pc->p++;
2006 pc->len--;
2009 pc->tend = pc->p - 1;
2010 return JIM_OK;
2013 static int JimParseListStr(struct JimParserCtx *pc)
2015 pc->tstart = pc->p;
2016 pc->tline = pc->linenr;
2017 pc->tt = JIM_TT_STR;
2019 while (pc->len) {
2020 switch (*pc->p) {
2021 case '\\':
2022 if (--pc->len == 0) {
2023 /* Trailing backslash */
2024 pc->tend = pc->p;
2025 return JIM_OK;
2027 pc->tt = JIM_TT_ESC;
2028 pc->p++;
2029 break;
2030 case ' ':
2031 case '\t':
2032 case '\n':
2033 case '\r':
2034 pc->tend = pc->p - 1;
2035 return JIM_OK;
2037 pc->p++;
2038 pc->len--;
2040 pc->tend = pc->p - 1;
2041 return JIM_OK;
2044 /* -----------------------------------------------------------------------------
2045 * Jim_Obj related functions
2046 * ---------------------------------------------------------------------------*/
2048 /* Return a new initialized object. */
2049 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2051 Jim_Obj *objPtr;
2053 /* -- Check if there are objects in the free list -- */
2054 if (interp->freeList != NULL) {
2055 /* -- Unlink the object from the free list -- */
2056 objPtr = interp->freeList;
2057 interp->freeList = objPtr->nextObjPtr;
2059 else {
2060 /* -- No ready to use objects: allocate a new one -- */
2061 objPtr = Jim_Alloc(sizeof(*objPtr));
2064 /* Object is returned with refCount of 0. Every
2065 * kind of GC implemented should take care to don't try
2066 * to scan objects with refCount == 0. */
2067 objPtr->refCount = 0;
2068 /* All the other fields are left not initialized to save time.
2069 * The caller will probably want to set them to the right
2070 * value anyway. */
2072 /* -- Put the object into the live list -- */
2073 objPtr->prevObjPtr = NULL;
2074 objPtr->nextObjPtr = interp->liveList;
2075 if (interp->liveList)
2076 interp->liveList->prevObjPtr = objPtr;
2077 interp->liveList = objPtr;
2079 return objPtr;
2082 /* Free an object. Actually objects are never freed, but
2083 * just moved to the free objects list, where they will be
2084 * reused by Jim_NewObj(). */
2085 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2087 /* Check if the object was already freed, panic. */
2088 JimPanic((objPtr->refCount != 0, interp, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2089 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2091 /* Free the internal representation */
2092 Jim_FreeIntRep(interp, objPtr);
2093 /* Free the string representation */
2094 if (objPtr->bytes != NULL) {
2095 if (objPtr->bytes != JimEmptyStringRep)
2096 Jim_Free(objPtr->bytes);
2098 /* Unlink the object from the live objects list */
2099 if (objPtr->prevObjPtr)
2100 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2101 if (objPtr->nextObjPtr)
2102 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2103 if (interp->liveList == objPtr)
2104 interp->liveList = objPtr->nextObjPtr;
2105 /* Link the object into the free objects list */
2106 objPtr->prevObjPtr = NULL;
2107 objPtr->nextObjPtr = interp->freeList;
2108 if (interp->freeList)
2109 interp->freeList->prevObjPtr = objPtr;
2110 interp->freeList = objPtr;
2111 objPtr->refCount = -1;
2114 /* Invalidate the string representation of an object. */
2115 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2117 if (objPtr->bytes != NULL) {
2118 if (objPtr->bytes != JimEmptyStringRep)
2119 Jim_Free(objPtr->bytes);
2121 objPtr->bytes = NULL;
2124 #define Jim_SetStringRep(o, b, l) \
2125 do { (o)->bytes = b; (o)->length = l; } while (0)
2127 /* Set the initial string representation for an object.
2128 * Does not try to free an old one. */
2129 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
2131 if (length == 0) {
2132 objPtr->bytes = JimEmptyStringRep;
2133 objPtr->length = 0;
2135 else {
2136 objPtr->bytes = Jim_Alloc(length + 1);
2137 objPtr->length = length;
2138 memcpy(objPtr->bytes, bytes, length);
2139 objPtr->bytes[length] = '\0';
2143 /* Duplicate an object. The returned object has refcount = 0. */
2144 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2146 Jim_Obj *dupPtr;
2148 dupPtr = Jim_NewObj(interp);
2149 if (objPtr->bytes == NULL) {
2150 /* Object does not have a valid string representation. */
2151 dupPtr->bytes = NULL;
2153 else {
2154 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
2156 if (objPtr->typePtr != NULL) {
2157 if (objPtr->typePtr->dupIntRepProc == NULL) {
2158 dupPtr->internalRep = objPtr->internalRep;
2160 else {
2161 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2163 dupPtr->typePtr = objPtr->typePtr;
2165 else {
2166 dupPtr->typePtr = NULL;
2168 return dupPtr;
2171 /* Return the string representation for objPtr. If the object
2172 * string representation is invalid, calls the method to create
2173 * a new one starting from the internal representation of the object. */
2174 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2176 if (objPtr->bytes == NULL) {
2177 /* Invalid string repr. Generate it. */
2178 JimPanic((objPtr->typePtr->updateStringProc == NULL, NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2179 objPtr->typePtr->updateStringProc(objPtr);
2181 if (lenPtr)
2182 *lenPtr = objPtr->length;
2183 return objPtr->bytes;
2186 /* Just returns the length of the object's string rep */
2187 int Jim_Length(Jim_Obj *objPtr)
2189 int len;
2191 Jim_GetString(objPtr, &len);
2192 return len;
2195 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2196 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2198 static const Jim_ObjType dictSubstObjType = {
2199 "dict-substitution",
2200 FreeDictSubstInternalRep,
2201 DupDictSubstInternalRep,
2202 NULL,
2203 JIM_TYPE_NONE,
2206 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2208 Jim_DecrRefCount(interp, (Jim_Obj *)objPtr->internalRep.twoPtrValue.ptr2);
2211 static const Jim_ObjType interpolatedObjType = {
2212 "interpolated",
2213 FreeInterpolatedInternalRep,
2214 NULL,
2215 NULL,
2216 JIM_TYPE_NONE,
2219 /* -----------------------------------------------------------------------------
2220 * String Object
2221 * ---------------------------------------------------------------------------*/
2222 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2223 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2225 static const Jim_ObjType stringObjType = {
2226 "string",
2227 NULL,
2228 DupStringInternalRep,
2229 NULL,
2230 JIM_TYPE_REFERENCES,
2233 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2235 JIM_NOTUSED(interp);
2237 /* This is a bit subtle: the only caller of this function
2238 * should be Jim_DuplicateObj(), that will copy the
2239 * string representaion. After the copy, the duplicated
2240 * object will not have more room in teh buffer than
2241 * srcPtr->length bytes. So we just set it to length. */
2242 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2244 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2247 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2249 /* Get a fresh string representation. */
2250 (void)Jim_String(objPtr);
2251 /* Free any other internal representation. */
2252 Jim_FreeIntRep(interp, objPtr);
2253 /* Set it as string, i.e. just set the maxLength field. */
2254 objPtr->typePtr = &stringObjType;
2255 objPtr->internalRep.strValue.maxLength = objPtr->length;
2256 /* Don't know the utf-8 length yet */
2257 objPtr->internalRep.strValue.charLength = -1;
2258 return JIM_OK;
2262 * Returns the length of the object string in chars, not bytes.
2264 * These may be different for a utf-8 string.
2266 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2268 #ifdef JIM_UTF8
2269 if (objPtr->typePtr != &stringObjType)
2270 SetStringFromAny(interp, objPtr);
2272 if (objPtr->internalRep.strValue.charLength < 0) {
2273 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2275 return objPtr->internalRep.strValue.charLength;
2276 #else
2277 return Jim_Length(objPtr);
2278 #endif
2281 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2282 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2284 Jim_Obj *objPtr = Jim_NewObj(interp);
2286 /* Need to find out how many bytes the string requires */
2287 if (len == -1)
2288 len = strlen(s);
2289 /* Alloc/Set the string rep. */
2290 if (len == 0) {
2291 objPtr->bytes = JimEmptyStringRep;
2292 objPtr->length = 0;
2294 else {
2295 objPtr->bytes = Jim_Alloc(len + 1);
2296 objPtr->length = len;
2297 memcpy(objPtr->bytes, s, len);
2298 objPtr->bytes[len] = '\0';
2301 /* No typePtr field for the vanilla string object. */
2302 objPtr->typePtr = NULL;
2303 return objPtr;
2306 /* charlen is in characters -- see also Jim_NewStringObj() */
2307 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2309 #ifdef JIM_UTF8
2310 /* Need to find out how many bytes the string requires */
2311 int bytelen = utf8_index(s, charlen);
2313 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2315 /* Remember the utf8 length, so set the type */
2316 objPtr->typePtr = &stringObjType;
2317 objPtr->internalRep.strValue.maxLength = bytelen;
2318 objPtr->internalRep.strValue.charLength = charlen;
2320 return objPtr;
2321 #else
2322 return Jim_NewStringObj(interp, s, charlen);
2323 #endif
2326 /* This version does not try to duplicate the 's' pointer, but
2327 * use it directly. */
2328 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2330 Jim_Obj *objPtr = Jim_NewObj(interp);
2332 if (len == -1)
2333 len = strlen(s);
2334 Jim_SetStringRep(objPtr, s, len);
2335 objPtr->typePtr = NULL;
2336 return objPtr;
2339 /* Low-level string append. Use it only against objects
2340 * of type "string". */
2341 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2343 int needlen;
2345 if (len == -1)
2346 len = strlen(str);
2347 needlen = objPtr->length + len;
2348 if (objPtr->internalRep.strValue.maxLength < needlen ||
2349 objPtr->internalRep.strValue.maxLength == 0) {
2350 needlen *= 2;
2351 /* Inefficient to malloc() for less than 8 bytes */
2352 if (needlen < 7) {
2353 needlen = 7;
2355 if (objPtr->bytes == JimEmptyStringRep) {
2356 objPtr->bytes = Jim_Alloc(needlen + 1);
2358 else {
2359 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2361 objPtr->internalRep.strValue.maxLength = needlen;
2363 memcpy(objPtr->bytes + objPtr->length, str, len);
2364 objPtr->bytes[objPtr->length + len] = '\0';
2365 if (objPtr->internalRep.strValue.charLength >= 0) {
2366 /* Update the utf-8 char length */
2367 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2369 objPtr->length += len;
2372 /* Higher level API to append strings to objects. */
2373 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2375 JimPanic((Jim_IsShared(objPtr), interp, "Jim_AppendString called with shared object"));
2376 if (objPtr->typePtr != &stringObjType)
2377 SetStringFromAny(interp, objPtr);
2378 StringAppendString(objPtr, str, len);
2381 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2383 int len;
2384 const char *str;
2386 str = Jim_GetString(appendObjPtr, &len);
2387 Jim_AppendString(interp, objPtr, str, len);
2390 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2392 va_list ap;
2394 if (objPtr->typePtr != &stringObjType)
2395 SetStringFromAny(interp, objPtr);
2396 va_start(ap, objPtr);
2397 while (1) {
2398 char *s = va_arg(ap, char *);
2400 if (s == NULL)
2401 break;
2402 Jim_AppendString(interp, objPtr, s, -1);
2404 va_end(ap);
2407 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2409 const char *aStr, *bStr;
2410 int aLen, bLen;
2412 if (aObjPtr == bObjPtr)
2413 return 1;
2414 aStr = Jim_GetString(aObjPtr, &aLen);
2415 bStr = Jim_GetString(bObjPtr, &bLen);
2416 if (aLen != bLen)
2417 return 0;
2418 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2421 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2423 return JimStringMatch(interp, patternObjPtr, Jim_String(objPtr), nocase);
2426 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2428 const char *s1, *s2;
2429 int l1, l2;
2431 s1 = Jim_GetString(firstObjPtr, &l1);
2432 s2 = Jim_GetString(secondObjPtr, &l2);
2434 if (nocase) {
2435 return JimStringCompareNoCase(s1, s2, -1);
2437 return JimStringCompare(s1, l1, s2, l2);
2440 /* Convert a range, as returned by Jim_GetRange(), into
2441 * an absolute index into an object of the specified length.
2442 * This function may return negative values, or values
2443 * bigger or equal to the length of the list if the index
2444 * is out of range. */
2445 static int JimRelToAbsIndex(int len, int idx)
2447 if (idx < 0)
2448 return len + idx;
2449 return idx;
2452 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2453 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2454 * for implementation of commands like [string range] and [lrange].
2456 * The resulting range is guaranteed to address valid elements of
2457 * the structure. */
2458 static void JimRelToAbsRange(int len, int first, int last,
2459 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2461 int rangeLen;
2463 if (first > last) {
2464 rangeLen = 0;
2466 else {
2467 rangeLen = last - first + 1;
2468 if (rangeLen) {
2469 if (first < 0) {
2470 rangeLen += first;
2471 first = 0;
2473 if (last >= len) {
2474 rangeLen -= (last - (len - 1));
2475 last = len - 1;
2479 if (rangeLen < 0)
2480 rangeLen = 0;
2482 *firstPtr = first;
2483 *lastPtr = last;
2484 *rangeLenPtr = rangeLen;
2487 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2488 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2490 int first, last;
2491 const char *str;
2492 int rangeLen;
2493 int bytelen;
2495 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2496 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2497 return NULL;
2498 str = Jim_GetString(strObjPtr, &bytelen);
2499 first = JimRelToAbsIndex(bytelen, first);
2500 last = JimRelToAbsIndex(bytelen, last);
2501 JimRelToAbsRange(bytelen, first, last, &first, &last, &rangeLen);
2502 if (first == 0 && rangeLen == bytelen) {
2503 return strObjPtr;
2505 return Jim_NewStringObj(interp, str + first, rangeLen);
2508 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2509 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2511 #ifdef JIM_UTF8
2512 int first, last;
2513 const char *str;
2514 int len, rangeLen;
2515 int bytelen;
2517 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2518 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2519 return NULL;
2520 str = Jim_GetString(strObjPtr, &bytelen);
2521 len = Jim_Utf8Length(interp, strObjPtr);
2522 first = JimRelToAbsIndex(len, first);
2523 last = JimRelToAbsIndex(len, last);
2524 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2525 if (first == 0 && rangeLen == len) {
2526 return strObjPtr;
2528 if (len == bytelen) {
2529 /* ASCII optimisation */
2530 return Jim_NewStringObj(interp, str + first, rangeLen);
2532 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2533 #else
2534 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2535 #endif
2538 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2540 char *buf, *p;
2541 int len;
2542 const char *str;
2544 if (strObjPtr->typePtr != &stringObjType) {
2545 SetStringFromAny(interp, strObjPtr);
2548 str = Jim_GetString(strObjPtr, &len);
2550 buf = p = Jim_Alloc(len + 1);
2551 while (*str) {
2552 int c;
2553 str += utf8_tounicode(str, &c);
2554 p += utf8_fromunicode(p, utf8_lower(c));
2556 *p = 0;
2557 return Jim_NewStringObjNoAlloc(interp, buf, len);
2560 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2562 char *buf, *p;
2563 int len;
2564 const char *str;
2566 if (strObjPtr->typePtr != &stringObjType) {
2567 SetStringFromAny(interp, strObjPtr);
2570 str = Jim_GetString(strObjPtr, &len);
2572 buf = p = Jim_Alloc(len + 1);
2573 while (*str) {
2574 int c;
2575 str += utf8_tounicode(str, &c);
2576 p += utf8_fromunicode(p, utf8_upper(c));
2578 *p = 0;
2579 return Jim_NewStringObjNoAlloc(interp, buf, len);
2582 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2583 * for unicode character 'c'.
2584 * Returns the position if found or NULL if not
2586 static const char *utf8_memchr(const char *str, int len, int c)
2588 #ifdef JIM_UTF8
2589 while (len) {
2590 int sc;
2591 int n = utf8_tounicode(str, &sc);
2592 if (sc == c) {
2593 return str;
2595 str += n;
2596 len -= n;
2598 return NULL;
2599 #else
2600 return memchr(str, c, len);
2601 #endif
2605 * Searches for the first non-trim char in string (str, len)
2607 * If none is found, returns just past the last char.
2609 * Lengths are in bytes.
2611 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2613 while (len) {
2614 int c;
2615 int n = utf8_tounicode(str, &c);
2617 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2618 /* Not a trim char, so stop */
2619 break;
2621 str += n;
2622 len -= n;
2624 return str;
2628 * Searches backwards for a non-trim char in string (str, len).
2630 * Returns a pointer to just after the non-trim char, or NULL if not found.
2632 * Lengths are in bytes.
2634 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2636 str += len;
2638 while (len) {
2639 int c;
2640 int n = utf8_prev_len(str, len);
2642 len -= n;
2643 str -= n;
2645 n = utf8_tounicode(str, &c);
2647 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2648 return str + n;
2652 return NULL;
2655 static const char default_trim_chars[] = " \t\n\r";
2656 /* sizeof() here includes the null byte */
2657 static int default_trim_chars_len = sizeof(default_trim_chars);
2659 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2661 int len;
2662 const char *str = Jim_GetString(strObjPtr, &len);
2663 const char *trimchars = default_trim_chars;
2664 int trimcharslen = default_trim_chars_len;
2665 const char *newstr;
2667 if (trimcharsObjPtr) {
2668 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2671 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2672 if (newstr == str) {
2673 return strObjPtr;
2676 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2679 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2681 int len;
2682 const char *trimchars = default_trim_chars;
2683 int trimcharslen = default_trim_chars_len;
2684 const char *nontrim;
2686 if (trimcharsObjPtr) {
2687 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2690 if (strObjPtr->typePtr != &stringObjType) {
2691 SetStringFromAny(interp, strObjPtr);
2693 Jim_GetString(strObjPtr, &len);
2694 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2696 if (nontrim == NULL) {
2697 /* All trim, so return a zero-length string */
2698 return Jim_NewEmptyStringObj(interp);
2700 if (nontrim == strObjPtr->bytes + len) {
2701 return strObjPtr;
2704 if (Jim_IsShared(strObjPtr)) {
2705 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2707 else {
2708 /* Can modify this string in place */
2709 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2710 strObjPtr->length = (nontrim - strObjPtr->bytes);
2713 return strObjPtr;
2716 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2718 /* First trim left. */
2719 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2721 /* Now trim right */
2722 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2724 if (objPtr != strObjPtr) {
2725 /* Note that we don't want this object to be leaked */
2726 Jim_IncrRefCount(objPtr);
2727 Jim_DecrRefCount(interp, objPtr);
2730 return strObjPtr;
2734 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2736 static const char * const strclassnames[] = {
2737 "integer", "alpha", "alnum", "ascii", "digit",
2738 "double", "lower", "upper", "space", "xdigit",
2739 "control", "print", "graph", "punct",
2740 NULL
2742 enum {
2743 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2744 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2745 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2747 int strclass;
2748 int len;
2749 int i;
2750 const char *str;
2751 int (*isclassfunc)(int c) = NULL;
2753 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2754 return JIM_ERR;
2757 str = Jim_GetString(strObjPtr, &len);
2758 if (len == 0) {
2759 Jim_SetResultInt(interp, !strict);
2760 return JIM_OK;
2763 switch (strclass) {
2764 case STR_IS_INTEGER:
2766 jim_wide w;
2767 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2768 return JIM_OK;
2771 case STR_IS_DOUBLE:
2773 double d;
2774 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2775 return JIM_OK;
2778 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2779 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2780 case STR_IS_ASCII: isclassfunc = isascii; break;
2781 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2782 case STR_IS_LOWER: isclassfunc = islower; break;
2783 case STR_IS_UPPER: isclassfunc = isupper; break;
2784 case STR_IS_SPACE: isclassfunc = isspace; break;
2785 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2786 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2787 case STR_IS_PRINT: isclassfunc = isprint; break;
2788 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2789 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2790 default:
2791 return JIM_ERR;
2794 for (i = 0; i < len; i++) {
2795 if (!isclassfunc(str[i])) {
2796 Jim_SetResultInt(interp, 0);
2797 return JIM_OK;
2800 Jim_SetResultInt(interp, 1);
2801 return JIM_OK;
2804 /* -----------------------------------------------------------------------------
2805 * Compared String Object
2806 * ---------------------------------------------------------------------------*/
2808 /* This is strange object that allows to compare a C literal string
2809 * with a Jim object in very short time if the same comparison is done
2810 * multiple times. For example every time the [if] command is executed,
2811 * Jim has to check if a given argument is "else". This comparions if
2812 * the code has no errors are true most of the times, so we can cache
2813 * inside the object the pointer of the string of the last matching
2814 * comparison. Because most C compilers perform literal sharing,
2815 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2816 * this works pretty well even if comparisons are at different places
2817 * inside the C code. */
2819 static const Jim_ObjType comparedStringObjType = {
2820 "compared-string",
2821 NULL,
2822 NULL,
2823 NULL,
2824 JIM_TYPE_REFERENCES,
2827 /* The only way this object is exposed to the API is via the following
2828 * function. Returns true if the string and the object string repr.
2829 * are the same, otherwise zero is returned.
2831 * Note: this isn't binary safe, but it hardly needs to be.*/
2832 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
2834 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
2835 return 1;
2836 else {
2837 const char *objStr = Jim_String(objPtr);
2839 if (strcmp(str, objStr) != 0)
2840 return 0;
2841 if (objPtr->typePtr != &comparedStringObjType) {
2842 Jim_FreeIntRep(interp, objPtr);
2843 objPtr->typePtr = &comparedStringObjType;
2845 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
2846 return 1;
2850 static int qsortCompareStringPointers(const void *a, const void *b)
2852 char *const *sa = (char *const *)a;
2853 char *const *sb = (char *const *)b;
2855 return strcmp(*sa, *sb);
2859 /* -----------------------------------------------------------------------------
2860 * Source Object
2862 * This object is just a string from the language point of view, but
2863 * in the internal representation it contains the filename and line number
2864 * where this given token was read. This information is used by
2865 * Jim_EvalObj() if the object passed happens to be of type "source".
2867 * This allows to propagate the information about line numbers and file
2868 * names and give error messages with absolute line numbers.
2870 * Note that this object uses shared strings for filenames, and the
2871 * pointer to the filename together with the line number is taken into
2872 * the space for the "inline" internal representation of the Jim_Object,
2873 * so there is almost memory zero-overhead.
2875 * Also the object will be converted to something else if the given
2876 * token it represents in the source file is not something to be
2877 * evaluated (not a script), and will be specialized in some other way,
2878 * so the time overhead is also null.
2879 * ---------------------------------------------------------------------------*/
2881 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2882 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2884 static const Jim_ObjType sourceObjType = {
2885 "source",
2886 FreeSourceInternalRep,
2887 DupSourceInternalRep,
2888 NULL,
2889 JIM_TYPE_REFERENCES,
2892 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2894 Jim_ReleaseSharedString(interp, objPtr->internalRep.sourceValue.fileName);
2897 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2899 dupPtr->internalRep.sourceValue.fileName =
2900 Jim_GetSharedString(interp, srcPtr->internalRep.sourceValue.fileName);
2901 dupPtr->internalRep.sourceValue.lineNumber = dupPtr->internalRep.sourceValue.lineNumber;
2902 dupPtr->typePtr = &sourceObjType;
2905 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2906 const char *fileName, int lineNumber)
2908 if (fileName) {
2909 JimPanic((Jim_IsShared(objPtr), interp, "JimSetSourceInfo called with shared object"));
2910 JimPanic((objPtr->typePtr != NULL, interp, "JimSetSourceInfo called with typePtr != NULL"));
2911 objPtr->internalRep.sourceValue.fileName = Jim_GetSharedString(interp, fileName);
2912 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2913 objPtr->typePtr = &sourceObjType;
2917 /* -----------------------------------------------------------------------------
2918 * Script Object
2919 * ---------------------------------------------------------------------------*/
2921 static const Jim_ObjType scriptLineObjType = {
2922 "scriptline",
2923 NULL,
2924 NULL,
2925 NULL,
2929 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
2931 Jim_Obj *objPtr;
2933 objPtr = Jim_NewObj(interp);
2934 objPtr->typePtr = &scriptLineObjType;
2935 objPtr->bytes = JimEmptyStringRep;
2936 objPtr->internalRep.scriptLineValue.argc = argc;
2937 objPtr->internalRep.scriptLineValue.line = line;
2939 return objPtr;
2942 #define JIM_CMDSTRUCT_EXPAND -1
2944 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2945 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2946 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2948 static const Jim_ObjType scriptObjType = {
2949 "script",
2950 FreeScriptInternalRep,
2951 DupScriptInternalRep,
2952 NULL,
2953 JIM_TYPE_REFERENCES,
2956 /* The ScriptToken structure represents every token into a scriptObj.
2957 * Every token contains an associated Jim_Obj that can be specialized
2958 * by commands operating on it. */
2959 typedef struct ScriptToken
2961 int type;
2962 Jim_Obj *objPtr;
2963 } ScriptToken;
2965 /* This is the script object internal representation. An array of
2966 * ScriptToken structures, including a pre-computed representation of the
2967 * command length and arguments.
2969 * For example the script:
2971 * puts hello
2972 * set $i $x$y [foo]BAR
2974 * will produce a ScriptObj with the following Tokens:
2976 * LIN 2
2977 * ESC puts
2978 * ESC hello
2979 * LIN 4
2980 * ESC set
2981 * VAR i
2982 * WRD 2
2983 * VAR x
2984 * VAR y
2985 * WRD 2
2986 * CMD foo
2987 * ESC BAR
2989 * "puts hello" has two args (LIN 2), composed of single tokens.
2990 * (Note that the WRD token is omitted for the common case of a single token.)
2992 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
2993 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
2995 * The precomputation of the command structure makes Jim_Eval() faster,
2996 * and simpler because there aren't dynamic lengths / allocations.
2998 * -- {expand}/{*} handling --
3000 * Expand is handled in a special way.
3002 * If a "word" begins with {*}, the word token count is -ve.
3004 * For example the command:
3006 * list {*}{a b}
3008 * Will produce the following cmdstruct array:
3010 * LIN 2
3011 * ESC list
3012 * WRD -1
3013 * STR a b
3015 * Note that the 'LIN' token also contains the source information for the
3016 * first word of the line for error reporting purposes
3018 * -- the substFlags field of the structure --
3020 * The scriptObj structure is used to represent both "script" objects
3021 * and "subst" objects. In the second case, the there are no LIN and WRD
3022 * tokens. Instead SEP and EOL tokens are added as-is.
3023 * In addition, the field 'substFlags' is used to represent the flags used to turn
3024 * the string into the internal representation used to perform the
3025 * substitution. If this flags are not what the application requires
3026 * the scriptObj is created again. For example the script:
3028 * subst -nocommands $string
3029 * subst -novariables $string
3031 * Will recreate the internal representation of the $string object
3032 * two times.
3034 typedef struct ScriptObj
3036 int len; /* Length as number of tokens. */
3037 ScriptToken *token; /* Tokens array. */
3038 int substFlags; /* flags used for the compilation of "subst" objects */
3039 int inUse; /* Used to share a ScriptObj. Currently
3040 only used by Jim_EvalObj() as protection against
3041 shimmering of the currently evaluated object. */
3042 const char *fileName;
3043 int line; /* Line number of the first line */
3044 } ScriptObj;
3046 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3048 int i;
3049 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3051 script->inUse--;
3052 if (script->inUse != 0)
3053 return;
3054 for (i = 0; i < script->len; i++) {
3055 Jim_DecrRefCount(interp, script->token[i].objPtr);
3057 Jim_Free(script->token);
3058 if (script->fileName) {
3059 Jim_ReleaseSharedString(interp, script->fileName);
3061 Jim_Free(script);
3064 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3066 JIM_NOTUSED(interp);
3067 JIM_NOTUSED(srcPtr);
3069 /* Just returns an simple string. */
3070 dupPtr->typePtr = NULL;
3073 /* A simple parser token.
3074 * All the simple tokens for the script point into the same script string rep.
3076 typedef struct
3078 const char *token; /* Pointer to the start of the token */
3079 int len; /* Length of this token */
3080 int type; /* Token type */
3081 int line; /* Line number */
3082 } ParseToken;
3084 /* A list of parsed tokens representing a script.
3085 * Tokens are added to this list as the script is parsed.
3086 * It grows as needed.
3088 typedef struct
3090 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3091 ParseToken *list; /* Array of tokens */
3092 int size; /* Current size of the list */
3093 int count; /* Number of entries used */
3094 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3095 } ParseTokenList;
3097 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3099 tokenlist->list = tokenlist->static_list;
3100 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3101 tokenlist->count = 0;
3104 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3106 if (tokenlist->list != tokenlist->static_list) {
3107 Jim_Free(tokenlist->list);
3112 * Adds the new token to the tokenlist.
3113 * The token has the given length, type and line number.
3114 * The token list is resized as necessary.
3116 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3117 int line)
3119 ParseToken *t;
3121 if (tokenlist->count == tokenlist->size) {
3122 /* Resize the list */
3123 tokenlist->size *= 2;
3124 if (tokenlist->list != tokenlist->static_list) {
3125 tokenlist->list =
3126 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3128 else {
3129 /* The list needs to become allocated */
3130 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3131 memcpy(tokenlist->list, tokenlist->static_list,
3132 tokenlist->count * sizeof(*tokenlist->list));
3135 t = &tokenlist->list[tokenlist->count++];
3136 t->token = token;
3137 t->len = len;
3138 t->type = type;
3139 t->line = line;
3142 /* Counts the number of adjoining non-separator.
3144 * Returns -ve if the first token is the expansion
3145 * operator (in which case the count doesn't include
3146 * that token).
3148 static int JimCountWordTokens(ParseToken *t)
3150 int expand = 1;
3151 int count = 0;
3153 /* Is the first word {*} or {expand}? */
3154 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3155 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3156 /* Create an expand token */
3157 expand = -1;
3158 t++;
3162 /* Now count non-separator words */
3163 while (!TOKEN_IS_SEP(t->type)) {
3164 t++;
3165 count++;
3168 return count * expand;
3172 * Create a script/subst object from the given token.
3174 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3176 Jim_Obj *objPtr;
3178 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3179 /* Convert the backlash escapes . */
3180 int len = t->len;
3181 char *str = Jim_Alloc(len + 1);
3182 len = JimEscape(str, t->token, len);
3183 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3185 else {
3186 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
3187 * with a single space. This is currently not done.
3189 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3191 return objPtr;
3195 * Takes a tokenlist and creates the allocated list of script tokens
3196 * in script->token, of length script->len.
3198 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3199 * as required.
3201 * Also sets script->line to the line number of the first token
3203 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3204 ParseTokenList *tokenlist)
3206 int i;
3207 struct ScriptToken *token;
3208 /* Number of tokens so far for the current command */
3209 int lineargs = 0;
3210 /* This is the first token for the current command */
3211 ScriptToken *linefirst;
3212 int count;
3213 int linenr;
3215 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3216 printf("==== Tokens ====\n");
3217 for (i = 0; i < tokenlist->count; i++) {
3218 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3219 tokenlist->list[i].len, tokenlist->list[i].token);
3221 #endif
3223 /* May need up to one extra script token for each EOL in the worst case */
3224 count = tokenlist->count;
3225 for (i = 0; i < tokenlist->count; i++) {
3226 if (tokenlist->list[i].type == JIM_TT_EOL) {
3227 count++;
3230 linenr = script->line = tokenlist->list[0].line;
3232 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3234 /* This is the first token for the current command */
3235 linefirst = token++;
3237 for (i = 0; i < tokenlist->count; ) {
3238 /* Look ahead to find out how many tokens make up the next word */
3239 int wordtokens;
3241 /* Skip any leading separators */
3242 while (tokenlist->list[i].type == JIM_TT_SEP) {
3243 i++;
3246 wordtokens = JimCountWordTokens(tokenlist->list + i);
3248 if (wordtokens == 0) {
3249 /* None, so at end of line */
3250 if (lineargs) {
3251 linefirst->type = JIM_TT_LINE;
3252 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3253 Jim_IncrRefCount(linefirst->objPtr);
3255 /* Reset for new line */
3256 lineargs = 0;
3257 linefirst = token++;
3259 i++;
3260 continue;
3262 else if (wordtokens != 1) {
3263 /* More than 1, or {expand}, so insert a WORD token */
3264 token->type = JIM_TT_WORD;
3265 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3266 Jim_IncrRefCount(token->objPtr);
3267 token++;
3268 if (wordtokens < 0) {
3269 /* Skip the expand token */
3270 i++;
3271 wordtokens = -wordtokens - 1;
3272 lineargs--;
3276 lineargs++;
3277 linenr = tokenlist->list[i].line;
3279 /* Add each non-separator word token to the line */
3280 while (wordtokens--) {
3281 const ParseToken *t = &tokenlist->list[i++];
3283 token->type = t->type;
3284 token->objPtr = JimMakeScriptObj(interp, t);
3285 Jim_IncrRefCount(token->objPtr);
3287 /* Every object is initially a string, but the
3288 * internal type may be specialized during execution of the
3289 * script. */
3290 JimSetSourceInfo(interp, token->objPtr, script->fileName, t->line);
3291 token++;
3295 if (lineargs == 0) {
3296 token--;
3299 script->len = token - script->token;
3301 assert(script->len < count);
3303 #ifdef DEBUG_SHOW_SCRIPT
3304 printf("==== Script ====\n");
3305 for (i = 0; i < script->len; i++) {
3306 const ScriptToken *t = &script->token[i];
3307 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3309 #endif
3314 * Similar to ScriptObjAddTokens(), but for subst objects.
3316 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3317 ParseTokenList *tokenlist)
3319 int i;
3320 struct ScriptToken *token;
3322 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3324 for (i = 0; i < tokenlist->count; i++) {
3325 const ParseToken *t = &tokenlist->list[i];
3327 /* Create a token for 't' */
3328 token->type = t->type;
3329 token->objPtr = JimMakeScriptObj(interp, t);
3330 Jim_IncrRefCount(token->objPtr);
3331 token++;
3334 script->len = i;
3337 /* This method takes the string representation of an object
3338 * as a Tcl script, and generates the pre-parsed internal representation
3339 * of the script. */
3340 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3342 int scriptTextLen;
3343 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3344 struct JimParserCtx parser;
3345 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3346 ParseTokenList tokenlist;
3348 /* Try to get information about filename / line number */
3349 if (objPtr->typePtr == &sourceObjType) {
3350 script->fileName = Jim_GetSharedString(interp, objPtr->internalRep.sourceValue.fileName);
3351 script->line = objPtr->internalRep.sourceValue.lineNumber;
3353 else {
3354 script->fileName = NULL;
3355 script->line = 1;
3358 /* Initially parse the script into tokens (in tokenlist) */
3359 ScriptTokenListInit(&tokenlist);
3361 JimParserInit(&parser, scriptText, scriptTextLen, script->line);
3362 while (!parser.eof) {
3363 JimParseScript(&parser);
3364 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3365 parser.tline);
3367 /* Add a final EOF token */
3368 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3370 /* Create the "real" script tokens from the initial token list */
3371 script->substFlags = 0;
3372 script->inUse = 1;
3373 ScriptObjAddTokens(interp, script, &tokenlist);
3375 /* No longer need the token list */
3376 ScriptTokenListFree(&tokenlist);
3378 if (!script->fileName) {
3379 script->fileName = Jim_GetSharedString(interp, "");
3382 /* Free the old internal rep and set the new one. */
3383 Jim_FreeIntRep(interp, objPtr);
3384 Jim_SetIntRepPtr(objPtr, script);
3385 objPtr->typePtr = &scriptObjType;
3387 return JIM_OK;
3390 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3392 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
3394 if (objPtr->typePtr != &scriptObjType || script->substFlags) {
3395 SetScriptFromAny(interp, objPtr);
3397 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3400 /* -----------------------------------------------------------------------------
3401 * Commands
3402 * ---------------------------------------------------------------------------*/
3403 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3405 cmdPtr->inUse++;
3408 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3410 if (--cmdPtr->inUse == 0) {
3411 if (cmdPtr->isproc) {
3412 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3413 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3414 if (cmdPtr->u.proc.staticVars) {
3415 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3416 Jim_Free(cmdPtr->u.proc.staticVars);
3418 if (cmdPtr->u.proc.prevCmd) {
3419 /* Delete any pushed command too */
3420 JimDecrCmdRefCount(interp, cmdPtr->u.proc.prevCmd);
3423 else {
3424 /* native (C) */
3425 if (cmdPtr->u.native.delProc) {
3426 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3429 Jim_Free(cmdPtr);
3433 /* Commands HashTable Type.
3435 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3436 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3438 JimDecrCmdRefCount(interp, val);
3441 static const Jim_HashTableType JimCommandsHashTableType = {
3442 JimStringCopyHTHashFunction, /* hash function */
3443 JimStringCopyHTKeyDup, /* key dup */
3444 NULL, /* val dup */
3445 JimStringCopyHTKeyCompare, /* key compare */
3446 JimStringCopyHTKeyDestructor, /* key destructor */
3447 JimCommandsHT_ValDestructor /* val destructor */
3450 /* ------------------------- Commands related functions --------------------- */
3452 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3453 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3455 Jim_Cmd *cmdPtr;
3457 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3458 /* Command existed so incr proc epoch */
3459 Jim_InterpIncrProcEpoch(interp);
3462 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3464 /* Store the new details for this proc */
3465 memset(cmdPtr, 0, sizeof(*cmdPtr));
3466 cmdPtr->inUse = 1;
3467 cmdPtr->u.native.delProc = delProc;
3468 cmdPtr->u.native.cmdProc = cmdProc;
3469 cmdPtr->u.native.privData = privData;
3471 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3473 /* There is no need to increment the 'proc epoch' because
3474 * creation of a new procedure can never affect existing
3475 * cached commands. We don't do negative caching. */
3476 return JIM_OK;
3479 static int JimCreateProcedure(Jim_Interp *interp, const char *cmdName,
3480 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3481 int leftArity, int optionalArgs, int args, int rightArity)
3483 Jim_Cmd *cmdPtr;
3484 Jim_HashEntry *he;
3486 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3487 memset(cmdPtr, 0, sizeof(*cmdPtr));
3488 cmdPtr->inUse = 1;
3489 cmdPtr->isproc = 1;
3490 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3491 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3492 Jim_IncrRefCount(argListObjPtr);
3493 Jim_IncrRefCount(bodyObjPtr);
3494 cmdPtr->u.proc.leftArity = leftArity;
3495 cmdPtr->u.proc.optionalArgs = optionalArgs;
3496 cmdPtr->u.proc.args = args;
3497 cmdPtr->u.proc.rightArity = rightArity;
3498 cmdPtr->u.proc.staticVars = NULL;
3499 cmdPtr->u.proc.prevCmd = NULL;
3500 cmdPtr->inUse = 1;
3502 /* Create the statics hash table. */
3503 if (staticsListObjPtr) {
3504 int len, i;
3506 len = Jim_ListLength(interp, staticsListObjPtr);
3507 if (len != 0) {
3508 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3509 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3510 for (i = 0; i < len; i++) {
3511 Jim_Obj *objPtr = 0, *initObjPtr = 0, *nameObjPtr = 0;
3512 Jim_Var *varPtr;
3513 int subLen;
3515 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3516 /* Check if it's composed of two elements. */
3517 subLen = Jim_ListLength(interp, objPtr);
3518 if (subLen == 1 || subLen == 2) {
3519 /* Try to get the variable value from the current
3520 * environment. */
3521 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3522 if (subLen == 1) {
3523 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3524 if (initObjPtr == NULL) {
3525 Jim_SetResultFormatted(interp,
3526 "variable for initialization of static \"%#s\" not found in the local context",
3527 nameObjPtr);
3528 goto err;
3531 else {
3532 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3534 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3535 goto err;
3538 varPtr = Jim_Alloc(sizeof(*varPtr));
3539 varPtr->objPtr = initObjPtr;
3540 Jim_IncrRefCount(initObjPtr);
3541 varPtr->linkFramePtr = NULL;
3542 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3543 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3544 Jim_SetResultFormatted(interp,
3545 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3546 Jim_DecrRefCount(interp, initObjPtr);
3547 Jim_Free(varPtr);
3548 goto err;
3551 else {
3552 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3553 objPtr);
3554 goto err;
3560 /* Add the new command */
3562 /* It may already exist, so we try to delete the old one.
3563 * Note that reference count means that it won't be deleted yet if
3564 * it exists in the call stack.
3566 * BUT, if 'local' is in force, instead of deleting the existing
3567 * proc, we stash a reference to the old proc here.
3569 he = Jim_FindHashEntry(&interp->commands, cmdName);
3570 if (he) {
3571 /* There was an old procedure with the same name, this requires
3572 * a 'proc epoch' update. */
3574 /* If a procedure with the same name didn't existed there is no need
3575 * to increment the 'proc epoch' because creation of a new procedure
3576 * can never affect existing cached commands. We don't do
3577 * negative caching. */
3578 Jim_InterpIncrProcEpoch(interp);
3581 if (he && interp->local) {
3582 /* Just push this proc over the top of the previous one */
3583 cmdPtr->u.proc.prevCmd = he->val;
3584 he->val = cmdPtr;
3586 else {
3587 if (he) {
3588 /* Replace the existing proc */
3589 Jim_DeleteHashEntry(&interp->commands, cmdName);
3592 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3595 /* Unlike Tcl, set the name of the proc as the result */
3596 Jim_SetResultString(interp, cmdName, -1);
3597 return JIM_OK;
3599 err:
3600 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3601 Jim_Free(cmdPtr->u.proc.staticVars);
3602 Jim_DecrRefCount(interp, argListObjPtr);
3603 Jim_DecrRefCount(interp, bodyObjPtr);
3604 Jim_Free(cmdPtr);
3605 return JIM_ERR;
3608 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3610 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3611 return JIM_ERR;
3612 Jim_InterpIncrProcEpoch(interp);
3613 return JIM_OK;
3616 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
3618 Jim_HashEntry *he;
3620 /* Does it exist? */
3621 he = Jim_FindHashEntry(&interp->commands, oldName);
3622 if (he == NULL) {
3623 Jim_SetResultFormatted(interp, "can't %s \"%s\": command doesn't exist",
3624 newName[0] ? "rename" : "delete", oldName);
3625 return JIM_ERR;
3628 if (newName[0] == '\0') /* Delete! */
3629 return Jim_DeleteCommand(interp, oldName);
3631 /* rename */
3632 if (Jim_FindHashEntry(&interp->commands, newName)) {
3633 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
3634 return JIM_ERR;
3637 /* Add the new name first */
3638 JimIncrCmdRefCount(he->val);
3639 Jim_AddHashEntry(&interp->commands, newName, he->val);
3641 /* Now remove the old name */
3642 Jim_DeleteHashEntry(&interp->commands, oldName);
3644 /* Increment the epoch */
3645 Jim_InterpIncrProcEpoch(interp);
3646 return JIM_OK;
3649 /* -----------------------------------------------------------------------------
3650 * Command object
3651 * ---------------------------------------------------------------------------*/
3653 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3655 static const Jim_ObjType commandObjType = {
3656 "command",
3657 NULL,
3658 NULL,
3659 NULL,
3660 JIM_TYPE_REFERENCES,
3663 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3665 Jim_HashEntry *he;
3666 const char *cmdName;
3668 /* Get the string representation */
3669 cmdName = Jim_String(objPtr);
3670 /* Lookup this name into the commands hash table */
3671 he = Jim_FindHashEntry(&interp->commands, cmdName);
3672 if (he == NULL)
3673 return JIM_ERR;
3675 /* Free the old internal repr and set the new one. */
3676 Jim_FreeIntRep(interp, objPtr);
3677 objPtr->typePtr = &commandObjType;
3678 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3679 objPtr->internalRep.cmdValue.cmdPtr = (void *)he->val;
3680 return JIM_OK;
3683 /* This function returns the command structure for the command name
3684 * stored in objPtr. It tries to specialize the objPtr to contain
3685 * a cached info instead to perform the lookup into the hash table
3686 * every time. The information cached may not be uptodate, in such
3687 * a case the lookup is performed and the cache updated.
3689 * Respects the 'upcall' setting
3691 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3693 Jim_Cmd *cmd;
3695 if ((objPtr->typePtr != &commandObjType ||
3696 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3697 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3698 if (flags & JIM_ERRMSG) {
3699 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
3701 return NULL;
3703 cmd = objPtr->internalRep.cmdValue.cmdPtr;
3704 while (cmd->isproc && cmd->u.proc.upcall) {
3705 cmd = cmd->u.proc.prevCmd;
3707 return cmd;
3710 /* -----------------------------------------------------------------------------
3711 * Variables
3712 * ---------------------------------------------------------------------------*/
3714 /* Variables HashTable Type.
3716 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3717 static void JimVariablesHTValDestructor(void *interp, void *val)
3719 Jim_Var *varPtr = (void *)val;
3721 Jim_DecrRefCount(interp, varPtr->objPtr);
3722 Jim_Free(val);
3725 static const Jim_HashTableType JimVariablesHashTableType = {
3726 JimStringCopyHTHashFunction, /* hash function */
3727 JimStringCopyHTKeyDup, /* key dup */
3728 NULL, /* val dup */
3729 JimStringCopyHTKeyCompare, /* key compare */
3730 JimStringCopyHTKeyDestructor, /* key destructor */
3731 JimVariablesHTValDestructor /* val destructor */
3734 /* -----------------------------------------------------------------------------
3735 * Variable object
3736 * ---------------------------------------------------------------------------*/
3738 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3740 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3742 static const Jim_ObjType variableObjType = {
3743 "variable",
3744 NULL,
3745 NULL,
3746 NULL,
3747 JIM_TYPE_REFERENCES,
3750 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3751 * is in the form "varname(key)". */
3752 static int JimNameIsDictSugar(const char *str, int len)
3754 if (len && str[len - 1] == ')' && strchr(str, '(') != NULL)
3755 return 1;
3756 return 0;
3760 * Check that the name does not contain embedded nulls.
3762 * Variable and procedure names are maniplated as null terminated strings, so
3763 * don't allow names with embedded nulls.
3765 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
3767 /* Variable names and proc names can't contain embedded nulls */
3768 if (nameObjPtr->typePtr != &variableObjType) {
3769 int len;
3770 const char *str = Jim_GetString(nameObjPtr, &len);
3771 if (memchr(str, '\0', len)) {
3772 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
3773 return JIM_ERR;
3776 return JIM_OK;
3779 /* This method should be called only by the variable API.
3780 * It returns JIM_OK on success (variable already exists),
3781 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
3782 * a variable name, but syntax glue for [dict] i.e. the last
3783 * character is ')' */
3784 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3786 Jim_HashEntry *he;
3787 const char *varName;
3788 int len;
3789 Jim_CallFrame *framePtr = interp->framePtr;
3791 /* Check if the object is already an uptodate variable */
3792 if (objPtr->typePtr == &variableObjType &&
3793 objPtr->internalRep.varValue.callFrameId == framePtr->id) {
3794 return JIM_OK; /* nothing to do */
3797 if (objPtr->typePtr == &dictSubstObjType) {
3798 return JIM_DICT_SUGAR;
3801 if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
3802 return JIM_ERR;
3805 /* Get the string representation */
3806 varName = Jim_GetString(objPtr, &len);
3808 /* Make sure it's not syntax glue to get/set dict. */
3809 if (JimNameIsDictSugar(varName, len)) {
3810 return JIM_DICT_SUGAR;
3813 if (varName[0] == ':' && varName[1] == ':') {
3814 framePtr = interp->topFramePtr;
3815 he = Jim_FindHashEntry(&framePtr->vars, varName + 2);
3816 if (he == NULL) {
3817 return JIM_ERR;
3820 else {
3821 /* Lookup this name into the variables hash table */
3822 he = Jim_FindHashEntry(&framePtr->vars, varName);
3823 if (he == NULL) {
3824 /* Try with static vars. */
3825 if (framePtr->staticVars == NULL)
3826 return JIM_ERR;
3827 if (!(he = Jim_FindHashEntry(framePtr->staticVars, varName)))
3828 return JIM_ERR;
3831 /* Free the old internal repr and set the new one. */
3832 Jim_FreeIntRep(interp, objPtr);
3833 objPtr->typePtr = &variableObjType;
3834 objPtr->internalRep.varValue.callFrameId = framePtr->id;
3835 objPtr->internalRep.varValue.varPtr = (void *)he->val;
3836 return JIM_OK;
3839 /* -------------------- Variables related functions ------------------------- */
3840 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
3841 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
3843 /* For now that's dummy. Variables lookup should be optimized
3844 * in many ways, with caching of lookups, and possibly with
3845 * a table of pre-allocated vars in every CallFrame for local vars.
3846 * All the caching should also have an 'epoch' mechanism similar
3847 * to the one used by Tcl for procedures lookup caching. */
3849 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3851 const char *name;
3852 Jim_Var *var;
3853 int err;
3855 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3856 Jim_CallFrame *framePtr = interp->framePtr;
3858 /* Check for [dict] syntax sugar. */
3859 if (err == JIM_DICT_SUGAR)
3860 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3862 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
3863 return JIM_ERR;
3866 /* New variable to create */
3867 name = Jim_String(nameObjPtr);
3869 var = Jim_Alloc(sizeof(*var));
3870 var->objPtr = valObjPtr;
3871 Jim_IncrRefCount(valObjPtr);
3872 var->linkFramePtr = NULL;
3873 /* Insert the new variable */
3874 if (name[0] == ':' && name[1] == ':') {
3875 /* Into the top level frame */
3876 framePtr = interp->topFramePtr;
3877 Jim_AddHashEntry(&framePtr->vars, name + 2, var);
3879 else {
3880 Jim_AddHashEntry(&framePtr->vars, name, var);
3882 /* Make the object int rep a variable */
3883 Jim_FreeIntRep(interp, nameObjPtr);
3884 nameObjPtr->typePtr = &variableObjType;
3885 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
3886 nameObjPtr->internalRep.varValue.varPtr = var;
3888 else {
3889 var = nameObjPtr->internalRep.varValue.varPtr;
3890 if (var->linkFramePtr == NULL) {
3891 Jim_IncrRefCount(valObjPtr);
3892 Jim_DecrRefCount(interp, var->objPtr);
3893 var->objPtr = valObjPtr;
3895 else { /* Else handle the link */
3896 Jim_CallFrame *savedCallFrame;
3898 savedCallFrame = interp->framePtr;
3899 interp->framePtr = var->linkFramePtr;
3900 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3901 interp->framePtr = savedCallFrame;
3902 if (err != JIM_OK)
3903 return err;
3906 return JIM_OK;
3909 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3911 Jim_Obj *nameObjPtr;
3912 int result;
3914 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3915 Jim_IncrRefCount(nameObjPtr);
3916 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3917 Jim_DecrRefCount(interp, nameObjPtr);
3918 return result;
3921 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3923 Jim_CallFrame *savedFramePtr;
3924 int result;
3926 savedFramePtr = interp->framePtr;
3927 interp->framePtr = interp->topFramePtr;
3928 result = Jim_SetVariableStr(interp, name, objPtr);
3929 interp->framePtr = savedFramePtr;
3930 return result;
3933 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3935 Jim_Obj *nameObjPtr, *valObjPtr;
3936 int result;
3938 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3939 valObjPtr = Jim_NewStringObj(interp, val, -1);
3940 Jim_IncrRefCount(nameObjPtr);
3941 Jim_IncrRefCount(valObjPtr);
3942 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3943 Jim_DecrRefCount(interp, nameObjPtr);
3944 Jim_DecrRefCount(interp, valObjPtr);
3945 return result;
3948 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3949 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3951 const char *varName;
3952 int len;
3954 varName = Jim_GetString(nameObjPtr, &len);
3956 if (varName[0] == ':' && varName[1] == ':') {
3957 /* Linking a global var does nothing */
3958 return JIM_OK;
3961 if (JimNameIsDictSugar(varName, len)) {
3962 Jim_SetResultString(interp, "Dict key syntax invalid as link source", -1);
3963 return JIM_ERR;
3966 /* Check for an existing variable or link */
3967 if (SetVariableFromAny(interp, nameObjPtr) == JIM_OK) {
3968 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
3970 if (varPtr->linkFramePtr == NULL) {
3971 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
3972 return JIM_ERR;
3975 /* It exists, but is a link, so delete the link */
3976 varPtr->linkFramePtr = NULL;
3979 /* Check for cycles. */
3980 if (interp->framePtr == targetCallFrame) {
3981 Jim_Obj *objPtr = targetNameObjPtr;
3982 Jim_Var *varPtr;
3984 /* Cycles are only possible with 'uplevel 0' */
3985 while (1) {
3986 if (Jim_StringEqObj(objPtr, nameObjPtr)) {
3987 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
3988 return JIM_ERR;
3990 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3991 break;
3992 varPtr = objPtr->internalRep.varValue.varPtr;
3993 if (varPtr->linkFramePtr != targetCallFrame)
3994 break;
3995 objPtr = varPtr->objPtr;
3999 /* Perform the binding */
4000 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4001 /* We are now sure 'nameObjPtr' type is variableObjType */
4002 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4003 return JIM_OK;
4006 /* Return the Jim_Obj pointer associated with a variable name,
4007 * or NULL if the variable was not found in the current context.
4008 * The same optimization discussed in the comment to the
4009 * 'SetVariable' function should apply here.
4011 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4012 * in a dictionary which is shared, the array variable value is duplicated first.
4013 * This allows the array element to be updated (e.g. append, lappend) without
4014 * affecting other references to the dictionary.
4016 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4018 switch (SetVariableFromAny(interp, nameObjPtr)) {
4019 case JIM_OK:{
4020 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4022 if (varPtr->linkFramePtr == NULL) {
4023 return varPtr->objPtr;
4025 else {
4026 Jim_Obj *objPtr;
4028 /* The variable is a link? Resolve it. */
4029 Jim_CallFrame *savedCallFrame = interp->framePtr;
4031 interp->framePtr = varPtr->linkFramePtr;
4032 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4033 interp->framePtr = savedCallFrame;
4034 if (objPtr) {
4035 return objPtr;
4037 /* Error, so fall through to the error message */
4040 break;
4042 case JIM_DICT_SUGAR:
4043 /* [dict] syntax sugar. */
4044 return JimDictSugarGet(interp, nameObjPtr, flags);
4046 if (flags & JIM_ERRMSG) {
4047 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4049 return NULL;
4052 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4054 Jim_CallFrame *savedFramePtr;
4055 Jim_Obj *objPtr;
4057 savedFramePtr = interp->framePtr;
4058 interp->framePtr = interp->topFramePtr;
4059 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4060 interp->framePtr = savedFramePtr;
4062 return objPtr;
4065 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4067 Jim_Obj *nameObjPtr, *varObjPtr;
4069 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4070 Jim_IncrRefCount(nameObjPtr);
4071 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4072 Jim_DecrRefCount(interp, nameObjPtr);
4073 return varObjPtr;
4076 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4078 Jim_CallFrame *savedFramePtr;
4079 Jim_Obj *objPtr;
4081 savedFramePtr = interp->framePtr;
4082 interp->framePtr = interp->topFramePtr;
4083 objPtr = Jim_GetVariableStr(interp, name, flags);
4084 interp->framePtr = savedFramePtr;
4086 return objPtr;
4089 /* Unset a variable.
4090 * Note: On success unset invalidates all the variable objects created
4091 * in the current call frame incrementing. */
4092 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4094 const char *name;
4095 Jim_Var *varPtr;
4096 int retval;
4098 retval = SetVariableFromAny(interp, nameObjPtr);
4099 if (retval == JIM_DICT_SUGAR) {
4100 /* [dict] syntax sugar. */
4101 return JimDictSugarSet(interp, nameObjPtr, NULL);
4103 else if (retval == JIM_OK) {
4104 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4106 /* If it's a link call UnsetVariable recursively */
4107 if (varPtr->linkFramePtr) {
4108 Jim_CallFrame *savedCallFrame;
4110 savedCallFrame = interp->framePtr;
4111 interp->framePtr = varPtr->linkFramePtr;
4112 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4113 interp->framePtr = savedCallFrame;
4115 else {
4116 Jim_CallFrame *framePtr = interp->framePtr;
4118 name = Jim_String(nameObjPtr);
4119 if (name[0] == ':' && name[1] == ':') {
4120 framePtr = interp->topFramePtr;
4121 name += 2;
4123 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4124 if (retval == JIM_OK) {
4125 /* Change the callframe id, invalidating var lookup caching */
4126 JimChangeCallFrameId(interp, framePtr);
4130 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4131 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4133 return retval;
4136 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4138 /* Given a variable name for [dict] operation syntax sugar,
4139 * this function returns two objects, the first with the name
4140 * of the variable to set, and the second with the rispective key.
4141 * For example "foo(bar)" will return objects with string repr. of
4142 * "foo" and "bar".
4144 * The returned objects have refcount = 1. The function can't fail. */
4145 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4146 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4148 const char *str, *p;
4149 int len, keyLen;
4150 Jim_Obj *varObjPtr, *keyObjPtr;
4152 str = Jim_GetString(objPtr, &len);
4154 p = strchr(str, '(');
4155 JimPanic((p == NULL, interp, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4157 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4159 p++;
4160 keyLen = (str + len) - p;
4161 if (str[len - 1] == ')') {
4162 keyLen--;
4165 /* Create the objects with the variable name and key. */
4166 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4168 Jim_IncrRefCount(varObjPtr);
4169 Jim_IncrRefCount(keyObjPtr);
4170 *varPtrPtr = varObjPtr;
4171 *keyPtrPtr = keyObjPtr;
4174 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4175 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4176 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4178 int err;
4180 SetDictSubstFromAny(interp, objPtr);
4182 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4183 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr);
4185 if (err == JIM_OK) {
4186 /* Don't keep an extra ref to the result */
4187 Jim_SetEmptyResult(interp);
4189 else {
4190 if (!valObjPtr) {
4191 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4192 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4193 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4194 objPtr);
4195 return err;
4198 /* Make the error more informative and Tcl-compatible */
4199 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4200 (valObjPtr ? "set" : "unset"), objPtr);
4202 return err;
4206 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4208 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4209 * and stored back to the variable before expansion.
4211 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4212 Jim_Obj *keyObjPtr, int flags)
4214 Jim_Obj *dictObjPtr;
4215 Jim_Obj *resObjPtr = NULL;
4216 int ret;
4218 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4219 if (!dictObjPtr) {
4220 return NULL;
4223 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4224 if (ret != JIM_OK) {
4225 resObjPtr = NULL;
4226 if (ret < 0) {
4227 Jim_SetResultFormatted(interp,
4228 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4230 else {
4231 Jim_SetResultFormatted(interp,
4232 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4235 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4236 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4237 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4238 /* This can probably never happen */
4239 JimPanic((1, interp, "SetVariable failed for JIM_UNSHARED"));
4241 /* We know that the key exists. Get the result in the now-unshared dictionary */
4242 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4245 return resObjPtr;
4248 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4249 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4251 SetDictSubstFromAny(interp, objPtr);
4253 return JimDictExpandArrayVariable(interp,
4254 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4255 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4258 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4260 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4262 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4263 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4266 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4268 JIM_NOTUSED(interp);
4270 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4271 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4272 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4273 dupPtr->typePtr = &dictSubstObjType;
4276 /* Note: The object *must* be in dict-sugar format */
4277 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4279 if (objPtr->typePtr != &dictSubstObjType) {
4280 Jim_Obj *varObjPtr, *keyObjPtr;
4282 if (objPtr->typePtr == &interpolatedObjType) {
4283 /* An interpolated object in dict-sugar form */
4285 const ScriptToken *token = objPtr->internalRep.twoPtrValue.ptr1;
4287 varObjPtr = token[0].objPtr;
4288 keyObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
4290 Jim_IncrRefCount(varObjPtr);
4291 Jim_IncrRefCount(keyObjPtr);
4293 else {
4294 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4297 Jim_FreeIntRep(interp, objPtr);
4298 objPtr->typePtr = &dictSubstObjType;
4299 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4300 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4304 /* This function is used to expand [dict get] sugar in the form
4305 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4306 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4307 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4308 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4309 * the [dict]ionary contained in variable VARNAME. */
4310 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4312 Jim_Obj *resObjPtr = NULL;
4313 Jim_Obj *substKeyObjPtr = NULL;
4315 SetDictSubstFromAny(interp, objPtr);
4317 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4318 &substKeyObjPtr, JIM_NONE)
4319 != JIM_OK) {
4320 return NULL;
4322 Jim_IncrRefCount(substKeyObjPtr);
4323 resObjPtr =
4324 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4325 substKeyObjPtr, 0);
4326 Jim_DecrRefCount(interp, substKeyObjPtr);
4328 return resObjPtr;
4331 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4333 Jim_Obj *resultObjPtr;
4335 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4336 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4337 resultObjPtr->refCount--;
4338 return resultObjPtr;
4340 return NULL;
4343 /* -----------------------------------------------------------------------------
4344 * CallFrame
4345 * ---------------------------------------------------------------------------*/
4347 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent)
4349 Jim_CallFrame *cf;
4351 if (interp->freeFramesList) {
4352 cf = interp->freeFramesList;
4353 interp->freeFramesList = cf->nextFramePtr;
4355 else {
4356 cf = Jim_Alloc(sizeof(*cf));
4357 cf->vars.table = NULL;
4360 cf->id = interp->callFrameEpoch++;
4361 cf->parentCallFrame = parent;
4362 cf->level = parent ? parent->level + 1 : 0;
4363 cf->argv = NULL;
4364 cf->argc = 0;
4365 cf->procArgsObjPtr = NULL;
4366 cf->procBodyObjPtr = NULL;
4367 cf->nextFramePtr = NULL;
4368 cf->staticVars = NULL;
4369 if (cf->vars.table == NULL)
4370 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4371 return cf;
4374 /* Used to invalidate every caching related to callframe stability. */
4375 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4377 cf->id = interp->callFrameEpoch++;
4380 #define JIM_FCF_NONE 0 /* no flags */
4381 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4382 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4384 if (cf->procArgsObjPtr)
4385 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4386 if (cf->procBodyObjPtr)
4387 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4388 if (!(flags & JIM_FCF_NOHT))
4389 Jim_FreeHashTable(&cf->vars);
4390 else {
4391 int i;
4392 Jim_HashEntry **table = cf->vars.table, *he;
4394 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4395 he = table[i];
4396 while (he != NULL) {
4397 Jim_HashEntry *nextEntry = he->next;
4398 Jim_Var *varPtr = (void *)he->val;
4400 Jim_DecrRefCount(interp, varPtr->objPtr);
4401 Jim_Free(he->val);
4402 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4403 Jim_Free(he);
4404 table[i] = NULL;
4405 he = nextEntry;
4408 cf->vars.used = 0;
4410 cf->nextFramePtr = interp->freeFramesList;
4411 interp->freeFramesList = cf;
4414 /* -----------------------------------------------------------------------------
4415 * References
4416 * ---------------------------------------------------------------------------*/
4417 #ifdef JIM_REFERENCES
4419 /* References HashTable Type.
4421 * Keys are jim_wide integers, dynamically allocated for now but in the
4422 * future it's worth to cache this 8 bytes objects. Values are poitners
4423 * to Jim_References. */
4424 static void JimReferencesHTValDestructor(void *interp, void *val)
4426 Jim_Reference *refPtr = (void *)val;
4428 Jim_DecrRefCount(interp, refPtr->objPtr);
4429 if (refPtr->finalizerCmdNamePtr != NULL) {
4430 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4432 Jim_Free(val);
4435 static unsigned int JimReferencesHTHashFunction(const void *key)
4437 /* Only the least significant bits are used. */
4438 const jim_wide *widePtr = key;
4439 unsigned int intValue = (unsigned int)*widePtr;
4441 return Jim_IntHashFunction(intValue);
4444 static const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4446 void *copy = Jim_Alloc(sizeof(jim_wide));
4448 JIM_NOTUSED(privdata);
4450 memcpy(copy, key, sizeof(jim_wide));
4451 return copy;
4454 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4456 JIM_NOTUSED(privdata);
4458 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4461 static void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4463 JIM_NOTUSED(privdata);
4465 Jim_Free((void *)key);
4468 static const Jim_HashTableType JimReferencesHashTableType = {
4469 JimReferencesHTHashFunction, /* hash function */
4470 JimReferencesHTKeyDup, /* key dup */
4471 NULL, /* val dup */
4472 JimReferencesHTKeyCompare, /* key compare */
4473 JimReferencesHTKeyDestructor, /* key destructor */
4474 JimReferencesHTValDestructor /* val destructor */
4477 /* -----------------------------------------------------------------------------
4478 * Reference object type and References API
4479 * ---------------------------------------------------------------------------*/
4481 /* The string representation of references has two features in order
4482 * to make the GC faster. The first is that every reference starts
4483 * with a non common character '<', in order to make the string matching
4484 * faster. The second is that the reference string rep is 42 characters
4485 * in length, this allows to avoid to check every object with a string
4486 * repr < 42, and usually there aren't many of these objects. */
4488 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
4490 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
4492 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
4494 sprintf(buf, fmt, refPtr->tag, id);
4495 return JIM_REFERENCE_SPACE;
4498 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4500 static const Jim_ObjType referenceObjType = {
4501 "reference",
4502 NULL,
4503 NULL,
4504 UpdateStringOfReference,
4505 JIM_TYPE_REFERENCES,
4508 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4510 int len;
4511 char buf[JIM_REFERENCE_SPACE + 1];
4512 Jim_Reference *refPtr;
4514 refPtr = objPtr->internalRep.refValue.refPtr;
4515 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4516 objPtr->bytes = Jim_Alloc(len + 1);
4517 memcpy(objPtr->bytes, buf, len + 1);
4518 objPtr->length = len;
4521 /* returns true if 'c' is a valid reference tag character.
4522 * i.e. inside the range [_a-zA-Z0-9] */
4523 static int isrefchar(int c)
4525 return (c == '_' || isalnum(c));
4528 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4530 jim_wide wideValue;
4531 int i, len;
4532 const char *str, *start, *end;
4533 char refId[21];
4534 Jim_Reference *refPtr;
4535 Jim_HashEntry *he;
4537 /* Get the string representation */
4538 str = Jim_GetString(objPtr, &len);
4539 /* Check if it looks like a reference */
4540 if (len < JIM_REFERENCE_SPACE)
4541 goto badformat;
4542 /* Trim spaces */
4543 start = str;
4544 end = str + len - 1;
4545 while (*start == ' ')
4546 start++;
4547 while (*end == ' ' && end > start)
4548 end--;
4549 if (end - start + 1 != JIM_REFERENCE_SPACE)
4550 goto badformat;
4551 /* <reference.<1234567>.%020> */
4552 if (memcmp(start, "<reference.<", 12) != 0)
4553 goto badformat;
4554 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
4555 goto badformat;
4556 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4557 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4558 if (!isrefchar(start[12 + i]))
4559 goto badformat;
4561 /* Extract info from the reference. */
4562 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4563 refId[20] = '\0';
4564 /* Try to convert the ID into a jim_wide */
4565 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK)
4566 goto badformat;
4567 /* Check if the reference really exists! */
4568 he = Jim_FindHashEntry(&interp->references, &wideValue);
4569 if (he == NULL) {
4570 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
4571 return JIM_ERR;
4573 refPtr = he->val;
4574 /* Free the old internal repr and set the new one. */
4575 Jim_FreeIntRep(interp, objPtr);
4576 objPtr->typePtr = &referenceObjType;
4577 objPtr->internalRep.refValue.id = wideValue;
4578 objPtr->internalRep.refValue.refPtr = refPtr;
4579 return JIM_OK;
4581 badformat:
4582 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
4583 return JIM_ERR;
4586 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4587 * as finalizer command (or NULL if there is no finalizer).
4588 * The returned reference object has refcount = 0. */
4589 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
4591 struct Jim_Reference *refPtr;
4592 jim_wide wideValue = interp->referenceNextId;
4593 Jim_Obj *refObjPtr;
4594 const char *tag;
4595 int tagLen, i;
4597 /* Perform the Garbage Collection if needed. */
4598 Jim_CollectIfNeeded(interp);
4600 refPtr = Jim_Alloc(sizeof(*refPtr));
4601 refPtr->objPtr = objPtr;
4602 Jim_IncrRefCount(objPtr);
4603 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4604 if (cmdNamePtr)
4605 Jim_IncrRefCount(cmdNamePtr);
4606 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4607 refObjPtr = Jim_NewObj(interp);
4608 refObjPtr->typePtr = &referenceObjType;
4609 refObjPtr->bytes = NULL;
4610 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4611 refObjPtr->internalRep.refValue.refPtr = refPtr;
4612 interp->referenceNextId++;
4613 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
4614 * that does not pass the 'isrefchar' test is replaced with '_' */
4615 tag = Jim_GetString(tagPtr, &tagLen);
4616 if (tagLen > JIM_REFERENCE_TAGLEN)
4617 tagLen = JIM_REFERENCE_TAGLEN;
4618 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4619 if (i < tagLen && isrefchar(tag[i]))
4620 refPtr->tag[i] = tag[i];
4621 else
4622 refPtr->tag[i] = '_';
4624 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4625 return refObjPtr;
4628 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4630 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4631 return NULL;
4632 return objPtr->internalRep.refValue.refPtr;
4635 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4637 Jim_Reference *refPtr;
4639 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4640 return JIM_ERR;
4641 Jim_IncrRefCount(cmdNamePtr);
4642 if (refPtr->finalizerCmdNamePtr)
4643 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4644 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4645 return JIM_OK;
4648 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4650 Jim_Reference *refPtr;
4652 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4653 return JIM_ERR;
4654 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4655 return JIM_OK;
4658 /* -----------------------------------------------------------------------------
4659 * References Garbage Collection
4660 * ---------------------------------------------------------------------------*/
4662 /* This the hash table type for the "MARK" phase of the GC */
4663 static const Jim_HashTableType JimRefMarkHashTableType = {
4664 JimReferencesHTHashFunction, /* hash function */
4665 JimReferencesHTKeyDup, /* key dup */
4666 NULL, /* val dup */
4667 JimReferencesHTKeyCompare, /* key compare */
4668 JimReferencesHTKeyDestructor, /* key destructor */
4669 NULL /* val destructor */
4672 /* Performs the garbage collection. */
4673 int Jim_Collect(Jim_Interp *interp)
4675 Jim_HashTable marks;
4676 Jim_HashTableIterator *htiter;
4677 Jim_HashEntry *he;
4678 Jim_Obj *objPtr;
4679 int collected = 0;
4681 /* Avoid recursive calls */
4682 if (interp->lastCollectId == -1) {
4683 /* Jim_Collect() already running. Return just now. */
4684 return 0;
4686 interp->lastCollectId = -1;
4688 /* Mark all the references found into the 'mark' hash table.
4689 * The references are searched in every live object that
4690 * is of a type that can contain references. */
4691 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4692 objPtr = interp->liveList;
4693 while (objPtr) {
4694 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4695 const char *str, *p;
4696 int len;
4698 /* If the object is of type reference, to get the
4699 * Id is simple... */
4700 if (objPtr->typePtr == &referenceObjType) {
4701 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
4702 #ifdef JIM_DEBUG_GC
4703 printf("MARK (reference): %d refcount: %d" JIM_NL,
4704 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
4705 #endif
4706 objPtr = objPtr->nextObjPtr;
4707 continue;
4709 /* Get the string repr of the object we want
4710 * to scan for references. */
4711 p = str = Jim_GetString(objPtr, &len);
4712 /* Skip objects too little to contain references. */
4713 if (len < JIM_REFERENCE_SPACE) {
4714 objPtr = objPtr->nextObjPtr;
4715 continue;
4717 /* Extract references from the object string repr. */
4718 while (1) {
4719 int i;
4720 jim_wide id;
4721 char buf[21];
4723 if ((p = strstr(p, "<reference.<")) == NULL)
4724 break;
4725 /* Check if it's a valid reference. */
4726 if (len - (p - str) < JIM_REFERENCE_SPACE)
4727 break;
4728 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
4729 break;
4730 for (i = 21; i <= 40; i++)
4731 if (!isdigit(UCHAR(p[i])))
4732 break;
4733 /* Get the ID */
4734 memcpy(buf, p + 21, 20);
4735 buf[20] = '\0';
4736 Jim_StringToWide(buf, &id, 10);
4738 /* Ok, a reference for the given ID
4739 * was found. Mark it. */
4740 Jim_AddHashEntry(&marks, &id, NULL);
4741 #ifdef JIM_DEBUG_GC
4742 printf("MARK: %d" JIM_NL, (int)id);
4743 #endif
4744 p += JIM_REFERENCE_SPACE;
4747 objPtr = objPtr->nextObjPtr;
4750 /* Run the references hash table to destroy every reference that
4751 * is not referenced outside (not present in the mark HT). */
4752 htiter = Jim_GetHashTableIterator(&interp->references);
4753 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4754 const jim_wide *refId;
4755 Jim_Reference *refPtr;
4757 refId = he->key;
4758 /* Check if in the mark phase we encountered
4759 * this reference. */
4760 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4761 #ifdef JIM_DEBUG_GC
4762 printf("COLLECTING %d" JIM_NL, (int)*refId);
4763 #endif
4764 collected++;
4765 /* Drop the reference, but call the
4766 * finalizer first if registered. */
4767 refPtr = he->val;
4768 if (refPtr->finalizerCmdNamePtr) {
4769 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4770 Jim_Obj *objv[3], *oldResult;
4772 JimFormatReference(refstr, refPtr, *refId);
4774 objv[0] = refPtr->finalizerCmdNamePtr;
4775 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, 32);
4776 objv[2] = refPtr->objPtr;
4777 Jim_IncrRefCount(objv[0]);
4778 Jim_IncrRefCount(objv[1]);
4779 Jim_IncrRefCount(objv[2]);
4781 /* Drop the reference itself */
4782 Jim_DeleteHashEntry(&interp->references, refId);
4784 /* Call the finalizer. Errors ignored. */
4785 oldResult = interp->result;
4786 Jim_IncrRefCount(oldResult);
4787 Jim_EvalObjVector(interp, 3, objv);
4788 Jim_SetResult(interp, oldResult);
4789 Jim_DecrRefCount(interp, oldResult);
4791 Jim_DecrRefCount(interp, objv[0]);
4792 Jim_DecrRefCount(interp, objv[1]);
4793 Jim_DecrRefCount(interp, objv[2]);
4795 else {
4796 Jim_DeleteHashEntry(&interp->references, refId);
4800 Jim_FreeHashTableIterator(htiter);
4801 Jim_FreeHashTable(&marks);
4802 interp->lastCollectId = interp->referenceNextId;
4803 interp->lastCollectTime = time(NULL);
4804 return collected;
4807 #define JIM_COLLECT_ID_PERIOD 5000
4808 #define JIM_COLLECT_TIME_PERIOD 300
4810 void Jim_CollectIfNeeded(Jim_Interp *interp)
4812 jim_wide elapsedId;
4813 int elapsedTime;
4815 elapsedId = interp->referenceNextId - interp->lastCollectId;
4816 elapsedTime = time(NULL) - interp->lastCollectTime;
4819 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4820 Jim_Collect(interp);
4823 #endif
4825 static int JimIsBigEndian(void)
4827 union {
4828 unsigned short s;
4829 unsigned char c[2];
4830 } uval = {0x0102};
4832 return uval.c[0] == 1;
4835 /* -----------------------------------------------------------------------------
4836 * Interpreter related functions
4837 * ---------------------------------------------------------------------------*/
4839 Jim_Interp *Jim_CreateInterp(void)
4841 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4843 i->errorLine = 0;
4844 i->errorFileName = Jim_StrDup("");
4845 i->addStackTrace = 0;
4846 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4847 i->returnCode = JIM_OK;
4848 i->returnLevel = 0;
4849 i->exitCode = 0;
4850 i->procEpoch = 0;
4851 i->callFrameEpoch = 0;
4852 i->liveList = i->freeList = NULL;
4853 i->referenceNextId = 0;
4854 i->lastCollectId = 0;
4855 i->lastCollectTime = time(NULL);
4856 i->freeFramesList = NULL;
4857 i->prngState = NULL;
4858 i->id = 0;
4859 i->sigmask = 0;
4860 i->signal_level = 0;
4861 i->signal_set_result = NULL;
4862 i->localProcs = NULL;
4863 i->loadHandles = NULL;
4865 /* Note that we can create objects only after the
4866 * interpreter liveList and freeList pointers are
4867 * initialized to NULL. */
4868 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4869 i->local = 0;
4870 #ifdef JIM_REFERENCES
4871 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4872 #endif
4873 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType, NULL);
4874 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4875 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4876 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL);
4877 i->emptyObj = Jim_NewEmptyStringObj(i);
4878 i->trueObj = Jim_NewIntObj(i, 1);
4879 i->falseObj = Jim_NewIntObj(i, 0);
4880 i->result = i->emptyObj;
4881 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4882 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4883 i->unknown_called = 0;
4884 i->errorProc = i->emptyObj;
4885 i->currentScriptObj = Jim_NewEmptyStringObj(i);
4886 Jim_IncrRefCount(i->emptyObj);
4887 Jim_IncrRefCount(i->result);
4888 Jim_IncrRefCount(i->stackTrace);
4889 Jim_IncrRefCount(i->unknown);
4890 Jim_IncrRefCount(i->currentScriptObj);
4891 Jim_IncrRefCount(i->errorProc);
4892 Jim_IncrRefCount(i->trueObj);
4893 Jim_IncrRefCount(i->falseObj);
4895 /* Initialize key variables every interpreter should contain */
4896 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
4897 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
4899 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
4900 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
4901 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
4902 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
4903 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
4904 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
4906 return i;
4909 void Jim_FreeInterp(Jim_Interp *i)
4911 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4912 Jim_Obj *objPtr, *nextObjPtr;
4914 Jim_DecrRefCount(i, i->emptyObj);
4915 Jim_DecrRefCount(i, i->trueObj);
4916 Jim_DecrRefCount(i, i->falseObj);
4917 Jim_DecrRefCount(i, i->result);
4918 Jim_DecrRefCount(i, i->stackTrace);
4919 Jim_DecrRefCount(i, i->errorProc);
4920 Jim_DecrRefCount(i, i->unknown);
4921 Jim_Free((void *)i->errorFileName);
4922 Jim_DecrRefCount(i, i->currentScriptObj);
4923 Jim_FreeHashTable(&i->commands);
4924 #ifdef JIM_REFERENCES
4925 Jim_FreeHashTable(&i->references);
4926 #endif
4927 Jim_FreeHashTable(&i->packages);
4928 Jim_Free(i->prngState);
4929 Jim_FreeHashTable(&i->assocData);
4930 JimDeleteLocalProcs(i);
4932 /* Free the call frames list */
4933 while (cf) {
4934 prevcf = cf->parentCallFrame;
4935 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4936 cf = prevcf;
4938 /* Check that the live object list is empty, otherwise
4939 * there is a memory leak. */
4940 if (i->liveList != NULL) {
4941 objPtr = i->liveList;
4943 printf(JIM_NL "-------------------------------------" JIM_NL);
4944 printf("Objects still in the free list:" JIM_NL);
4945 while (objPtr) {
4946 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
4948 printf("%p (%d) %-10s: '%.20s'" JIM_NL,
4949 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
4950 if (objPtr->typePtr == &sourceObjType) {
4951 printf("FILE %s LINE %d" JIM_NL,
4952 objPtr->internalRep.sourceValue.fileName,
4953 objPtr->internalRep.sourceValue.lineNumber);
4955 objPtr = objPtr->nextObjPtr;
4957 printf("-------------------------------------" JIM_NL JIM_NL);
4958 JimPanic((1, i, "Live list non empty freeing the interpreter! Leak?"));
4960 /* Free all the freed objects. */
4961 objPtr = i->freeList;
4962 while (objPtr) {
4963 nextObjPtr = objPtr->nextObjPtr;
4964 Jim_Free(objPtr);
4965 objPtr = nextObjPtr;
4967 /* Free cached CallFrame structures */
4968 cf = i->freeFramesList;
4969 while (cf) {
4970 nextcf = cf->nextFramePtr;
4971 if (cf->vars.table != NULL)
4972 Jim_Free(cf->vars.table);
4973 Jim_Free(cf);
4974 cf = nextcf;
4976 #ifdef jim_ext_load
4977 Jim_FreeLoadHandles(i);
4978 #endif
4980 /* Free the sharedString hash table. Make sure to free it
4981 * after every other Jim_Object was freed. */
4982 Jim_FreeHashTable(&i->sharedStrings);
4983 /* Free the interpreter structure. */
4984 Jim_Free(i);
4987 /* Returns the call frame relative to the level represented by
4988 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
4990 * This function accepts the 'level' argument in the form
4991 * of the commands [uplevel] and [upvar].
4993 * For a function accepting a relative integer as level suitable
4994 * for implementation of [info level ?level?] check the
4995 * JimGetCallFrameByInteger() function.
4997 * Returns NULL on error.
4999 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5001 long level;
5002 const char *str;
5003 Jim_CallFrame *framePtr;
5005 if (levelObjPtr) {
5006 str = Jim_String(levelObjPtr);
5007 if (str[0] == '#') {
5008 char *endptr;
5010 level = strtol(str + 1, &endptr, 0);
5011 if (str[1] == '\0' || endptr[0] != '\0') {
5012 level = -1;
5015 else {
5016 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5017 level = -1;
5019 else {
5020 /* Convert from a relative to an absolute level */
5021 level = interp->framePtr->level - level;
5025 else {
5026 str = "1"; /* Needed to format the error message. */
5027 level = interp->framePtr->level - 1;
5030 if (level == 0) {
5031 return interp->topFramePtr;
5033 if (level > 0) {
5034 /* Lookup */
5035 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parentCallFrame) {
5036 if (framePtr->level == level) {
5037 return framePtr;
5042 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5043 return NULL;
5046 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5047 * as a relative integer like in the [info level ?level?] command.
5049 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5051 long level;
5052 Jim_CallFrame *framePtr;
5054 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5055 if (level <= 0) {
5056 /* Convert from a relative to an absolute level */
5057 level = interp->framePtr->level + level;
5060 if (level == 0) {
5061 return interp->topFramePtr;
5064 /* Lookup */
5065 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parentCallFrame) {
5066 if (framePtr->level == level) {
5067 return framePtr;
5072 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5073 return NULL;
5076 static void JimSetErrorFileName(Jim_Interp *interp, const char *filename)
5078 Jim_Free((void *)interp->errorFileName);
5079 interp->errorFileName = Jim_StrDup(filename);
5082 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
5084 interp->errorLine = linenr;
5087 static void JimResetStackTrace(Jim_Interp *interp)
5089 Jim_DecrRefCount(interp, interp->stackTrace);
5090 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5091 Jim_IncrRefCount(interp->stackTrace);
5094 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5096 int len;
5098 /* Increment reference first in case these are the same object */
5099 Jim_IncrRefCount(stackTraceObj);
5100 Jim_DecrRefCount(interp, interp->stackTrace);
5101 interp->stackTrace = stackTraceObj;
5102 interp->errorFlag = 1;
5104 /* This is a bit ugly.
5105 * If the filename of the last entry of the stack trace is empty,
5106 * the next stack level should be added.
5108 len = Jim_ListLength(interp, interp->stackTrace);
5109 if (len >= 3) {
5110 Jim_Obj *filenameObj;
5112 Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj, JIM_NONE);
5114 Jim_GetString(filenameObj, &len);
5116 if (len == 0) {
5117 interp->addStackTrace = 1;
5122 /* Returns 1 if the stack trace information was used or 0 if not */
5123 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5124 const char *filename, int linenr)
5126 if (strcmp(procname, "unknown") == 0) {
5127 procname = "";
5129 if (!*procname && !*filename) {
5130 /* No useful info here */
5131 return;
5134 if (Jim_IsShared(interp->stackTrace)) {
5135 Jim_DecrRefCount(interp, interp->stackTrace);
5136 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5137 Jim_IncrRefCount(interp->stackTrace);
5140 /* If we have no procname but the previous element did, merge with that frame */
5141 if (!*procname && *filename) {
5142 /* Just a filename. Check the previous entry */
5143 int len = Jim_ListLength(interp, interp->stackTrace);
5145 if (len >= 3) {
5146 Jim_Obj *procnameObj;
5147 Jim_Obj *filenameObj;
5149 if (Jim_ListIndex(interp, interp->stackTrace, len - 3, &procnameObj, JIM_NONE) == JIM_OK
5150 && Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj,
5151 JIM_NONE) == JIM_OK) {
5153 const char *prev_procname = Jim_String(procnameObj);
5154 const char *prev_filename = Jim_String(filenameObj);
5156 if (*prev_procname && !*prev_filename) {
5157 ListSetIndex(interp, interp->stackTrace, len - 2, Jim_NewStringObj(interp,
5158 filename, -1), 0);
5159 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr),
5161 return;
5167 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5168 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, filename, -1));
5169 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5172 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5173 void *data)
5175 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5177 assocEntryPtr->delProc = delProc;
5178 assocEntryPtr->data = data;
5179 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5182 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5184 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5186 if (entryPtr != NULL) {
5187 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->val;
5189 return assocEntryPtr->data;
5191 return NULL;
5194 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5196 return Jim_DeleteHashEntry(&interp->assocData, key);
5199 int Jim_GetExitCode(Jim_Interp *interp)
5201 return interp->exitCode;
5204 /* -----------------------------------------------------------------------------
5205 * Shared strings.
5206 * Every interpreter has an hash table where to put shared dynamically
5207 * allocate strings that are likely to be used a lot of times.
5208 * For example, in the 'source' object type, there is a pointer to
5209 * the filename associated with that object. Every script has a lot
5210 * of this objects with the identical file name, so it is wise to share
5211 * this info.
5213 * The API is trivial: Jim_GetSharedString(interp, "foobar")
5214 * returns the pointer to the shared string. Every time a reference
5215 * to the string is no longer used, the user should call
5216 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
5217 * a given string, it is removed from the hash table.
5218 * ---------------------------------------------------------------------------*/
5219 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
5221 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
5223 if (he == NULL) {
5224 char *strCopy = Jim_StrDup(str);
5226 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void *)1);
5227 return strCopy;
5229 else {
5230 long refCount = (long)he->val;
5232 refCount++;
5233 he->val = (void *)refCount;
5234 return he->key;
5238 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
5240 long refCount;
5241 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
5243 JimPanic((he == NULL, interp, "Jim_ReleaseSharedString called with " "unknown shared string '%s'", str));
5245 refCount = (long)he->val;
5246 refCount--;
5247 if (refCount == 0) {
5248 Jim_DeleteHashEntry(&interp->sharedStrings, str);
5250 else {
5251 he->val = (void *)refCount;
5255 /* -----------------------------------------------------------------------------
5256 * Integer object
5257 * ---------------------------------------------------------------------------*/
5258 #define JIM_INTEGER_SPACE 24
5260 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5261 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5263 static const Jim_ObjType intObjType = {
5264 "int",
5265 NULL,
5266 NULL,
5267 UpdateStringOfInt,
5268 JIM_TYPE_NONE,
5271 /* A coerced double is closer to an int than a double.
5272 * It is an int value temporarily masquerading as a double value.
5273 * i.e. it has the same string value as an int and Jim_GetWide()
5274 * succeeds, but also Jim_GetDouble() returns the value directly.
5276 static const Jim_ObjType coercedDoubleObjType = {
5277 "coerced-double",
5278 NULL,
5279 NULL,
5280 UpdateStringOfInt,
5281 JIM_TYPE_NONE,
5285 void UpdateStringOfInt(struct Jim_Obj *objPtr)
5287 int len;
5288 char buf[JIM_INTEGER_SPACE + 1];
5290 len = Jim_WideToString(buf, JimWideValue(objPtr));
5291 objPtr->bytes = Jim_Alloc(len + 1);
5292 memcpy(objPtr->bytes, buf, len + 1);
5293 objPtr->length = len;
5296 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5298 jim_wide wideValue;
5299 const char *str;
5301 if (objPtr->typePtr == &coercedDoubleObjType) {
5302 /* Simple switcheroo */
5303 objPtr->typePtr = &intObjType;
5304 return JIM_OK;
5307 /* Get the string representation */
5308 str = Jim_String(objPtr);
5309 /* Try to convert into a jim_wide */
5310 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5311 if (flags & JIM_ERRMSG) {
5312 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5314 return JIM_ERR;
5316 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5317 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5318 return JIM_ERR;
5320 /* Free the old internal repr and set the new one. */
5321 Jim_FreeIntRep(interp, objPtr);
5322 objPtr->typePtr = &intObjType;
5323 objPtr->internalRep.wideValue = wideValue;
5324 return JIM_OK;
5327 #ifdef JIM_OPTIMIZATION
5328 static int JimIsWide(Jim_Obj *objPtr)
5330 return objPtr->typePtr == &intObjType;
5332 #endif
5334 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5336 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5337 return JIM_ERR;
5338 *widePtr = JimWideValue(objPtr);
5339 return JIM_OK;
5342 /* Get a wide but does not set an error if the format is bad. */
5343 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5345 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5346 return JIM_ERR;
5347 *widePtr = JimWideValue(objPtr);
5348 return JIM_OK;
5351 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5353 jim_wide wideValue;
5354 int retval;
5356 retval = Jim_GetWide(interp, objPtr, &wideValue);
5357 if (retval == JIM_OK) {
5358 *longPtr = (long)wideValue;
5359 return JIM_OK;
5361 return JIM_ERR;
5364 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5366 Jim_Obj *objPtr;
5368 objPtr = Jim_NewObj(interp);
5369 objPtr->typePtr = &intObjType;
5370 objPtr->bytes = NULL;
5371 objPtr->internalRep.wideValue = wideValue;
5372 return objPtr;
5375 /* -----------------------------------------------------------------------------
5376 * Double object
5377 * ---------------------------------------------------------------------------*/
5378 #define JIM_DOUBLE_SPACE 30
5380 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5381 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5383 static const Jim_ObjType doubleObjType = {
5384 "double",
5385 NULL,
5386 NULL,
5387 UpdateStringOfDouble,
5388 JIM_TYPE_NONE,
5391 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5393 int len;
5394 char buf[JIM_DOUBLE_SPACE + 1];
5396 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
5397 objPtr->bytes = Jim_Alloc(len + 1);
5398 memcpy(objPtr->bytes, buf, len + 1);
5399 objPtr->length = len;
5402 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5404 double doubleValue;
5405 jim_wide wideValue;
5406 const char *str;
5408 /* Preserve the string representation.
5409 * Needed so we can convert back to int without loss
5411 str = Jim_String(objPtr);
5413 #ifdef HAVE_LONG_LONG
5414 /* Assume a 53 bit mantissa */
5415 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5416 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5418 if (objPtr->typePtr == &intObjType
5419 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5420 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5422 /* Direct conversion to coerced double */
5423 objPtr->typePtr = &coercedDoubleObjType;
5424 return JIM_OK;
5426 else
5427 #endif
5428 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5429 /* Managed to convert to an int, so we can use this as a cooerced double */
5430 Jim_FreeIntRep(interp, objPtr);
5431 objPtr->typePtr = &coercedDoubleObjType;
5432 objPtr->internalRep.wideValue = wideValue;
5433 return JIM_OK;
5435 else {
5436 /* Try to convert into a double */
5437 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5438 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5439 return JIM_ERR;
5441 /* Free the old internal repr and set the new one. */
5442 Jim_FreeIntRep(interp, objPtr);
5444 objPtr->typePtr = &doubleObjType;
5445 objPtr->internalRep.doubleValue = doubleValue;
5446 return JIM_OK;
5449 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5451 if (objPtr->typePtr == &coercedDoubleObjType) {
5452 *doublePtr = JimWideValue(objPtr);
5453 return JIM_OK;
5455 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5456 return JIM_ERR;
5458 if (objPtr->typePtr == &coercedDoubleObjType) {
5459 *doublePtr = JimWideValue(objPtr);
5461 else {
5462 *doublePtr = objPtr->internalRep.doubleValue;
5464 return JIM_OK;
5467 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5469 Jim_Obj *objPtr;
5471 objPtr = Jim_NewObj(interp);
5472 objPtr->typePtr = &doubleObjType;
5473 objPtr->bytes = NULL;
5474 objPtr->internalRep.doubleValue = doubleValue;
5475 return objPtr;
5478 /* -----------------------------------------------------------------------------
5479 * List object
5480 * ---------------------------------------------------------------------------*/
5481 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5482 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5483 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5484 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5485 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5487 /* Note that while the elements of the list may contain references,
5488 * the list object itself can't. This basically means that the
5489 * list object string representation as a whole can't contain references
5490 * that are not presents in the single elements. */
5491 static const Jim_ObjType listObjType = {
5492 "list",
5493 FreeListInternalRep,
5494 DupListInternalRep,
5495 UpdateStringOfList,
5496 JIM_TYPE_NONE,
5499 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5501 int i;
5503 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5504 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5506 Jim_Free(objPtr->internalRep.listValue.ele);
5509 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5511 int i;
5513 JIM_NOTUSED(interp);
5515 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5516 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5517 dupPtr->internalRep.listValue.ele =
5518 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
5519 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5520 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
5521 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5522 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5524 dupPtr->typePtr = &listObjType;
5527 /* The following function checks if a given string can be encoded
5528 * into a list element without any kind of quoting, surrounded by braces,
5529 * or using escapes to quote. */
5530 #define JIM_ELESTR_SIMPLE 0
5531 #define JIM_ELESTR_BRACE 1
5532 #define JIM_ELESTR_QUOTE 2
5533 static int ListElementQuotingType(const char *s, int len)
5535 int i, level, trySimple = 1;
5537 /* Try with the SIMPLE case */
5538 if (len == 0)
5539 return JIM_ELESTR_BRACE;
5540 if (s[0] == '#')
5541 return JIM_ELESTR_BRACE;
5542 if (s[0] == '"' || s[0] == '{') {
5543 trySimple = 0;
5544 goto testbrace;
5546 for (i = 0; i < len; i++) {
5547 switch (s[i]) {
5548 case ' ':
5549 case '$':
5550 case '"':
5551 case '[':
5552 case ']':
5553 case ';':
5554 case '\\':
5555 case '\r':
5556 case '\n':
5557 case '\t':
5558 case '\f':
5559 case '\v':
5560 trySimple = 0;
5561 case '{':
5562 case '}':
5563 goto testbrace;
5566 return JIM_ELESTR_SIMPLE;
5568 testbrace:
5569 /* Test if it's possible to do with braces */
5570 if (s[len - 1] == '\\' || s[len - 1] == ']')
5571 return JIM_ELESTR_QUOTE;
5572 level = 0;
5573 for (i = 0; i < len; i++) {
5574 switch (s[i]) {
5575 case '{':
5576 level++;
5577 break;
5578 case '}':
5579 level--;
5580 if (level < 0)
5581 return JIM_ELESTR_QUOTE;
5582 break;
5583 case '\\':
5584 if (s[i + 1] == '\n')
5585 return JIM_ELESTR_QUOTE;
5586 else if (s[i + 1] != '\0')
5587 i++;
5588 break;
5591 if (level == 0) {
5592 if (!trySimple)
5593 return JIM_ELESTR_BRACE;
5594 for (i = 0; i < len; i++) {
5595 switch (s[i]) {
5596 case ' ':
5597 case '$':
5598 case '"':
5599 case '[':
5600 case ']':
5601 case ';':
5602 case '\\':
5603 case '\r':
5604 case '\n':
5605 case '\t':
5606 case '\f':
5607 case '\v':
5608 return JIM_ELESTR_BRACE;
5609 break;
5612 return JIM_ELESTR_SIMPLE;
5614 return JIM_ELESTR_QUOTE;
5617 /* Returns the malloc-ed representation of a string
5618 * using backslash to quote special chars. */
5619 static char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5621 char *q = Jim_Alloc(len * 2 + 1), *p;
5623 p = q;
5624 while (*s) {
5625 switch (*s) {
5626 case ' ':
5627 case '$':
5628 case '"':
5629 case '[':
5630 case ']':
5631 case '{':
5632 case '}':
5633 case ';':
5634 case '\\':
5635 *p++ = '\\';
5636 *p++ = *s++;
5637 break;
5638 case '\n':
5639 *p++ = '\\';
5640 *p++ = 'n';
5641 s++;
5642 break;
5643 case '\r':
5644 *p++ = '\\';
5645 *p++ = 'r';
5646 s++;
5647 break;
5648 case '\t':
5649 *p++ = '\\';
5650 *p++ = 't';
5651 s++;
5652 break;
5653 case '\f':
5654 *p++ = '\\';
5655 *p++ = 'f';
5656 s++;
5657 break;
5658 case '\v':
5659 *p++ = '\\';
5660 *p++ = 'v';
5661 s++;
5662 break;
5663 default:
5664 *p++ = *s++;
5665 break;
5668 *p = '\0';
5669 *qlenPtr = p - q;
5670 return q;
5673 void UpdateStringOfList(struct Jim_Obj *objPtr)
5675 int i, bufLen, realLength;
5676 const char *strRep;
5677 char *p;
5678 int *quotingType;
5679 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5681 /* (Over) Estimate the space needed. */
5682 quotingType = Jim_Alloc(sizeof(int) * objPtr->internalRep.listValue.len + 1);
5683 bufLen = 0;
5684 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5685 int len;
5687 strRep = Jim_GetString(ele[i], &len);
5688 quotingType[i] = ListElementQuotingType(strRep, len);
5689 switch (quotingType[i]) {
5690 case JIM_ELESTR_SIMPLE:
5691 bufLen += len;
5692 break;
5693 case JIM_ELESTR_BRACE:
5694 bufLen += len + 2;
5695 break;
5696 case JIM_ELESTR_QUOTE:
5697 bufLen += len * 2;
5698 break;
5700 bufLen++; /* elements separator. */
5702 bufLen++;
5704 /* Generate the string rep. */
5705 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5706 realLength = 0;
5707 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5708 int len, qlen;
5709 char *q;
5711 strRep = Jim_GetString(ele[i], &len);
5713 switch (quotingType[i]) {
5714 case JIM_ELESTR_SIMPLE:
5715 memcpy(p, strRep, len);
5716 p += len;
5717 realLength += len;
5718 break;
5719 case JIM_ELESTR_BRACE:
5720 *p++ = '{';
5721 memcpy(p, strRep, len);
5722 p += len;
5723 *p++ = '}';
5724 realLength += len + 2;
5725 break;
5726 case JIM_ELESTR_QUOTE:
5727 q = BackslashQuoteString(strRep, len, &qlen);
5728 memcpy(p, q, qlen);
5729 Jim_Free(q);
5730 p += qlen;
5731 realLength += qlen;
5732 break;
5734 /* Add a separating space */
5735 if (i + 1 != objPtr->internalRep.listValue.len) {
5736 *p++ = ' ';
5737 realLength++;
5740 *p = '\0'; /* nul term. */
5741 objPtr->length = realLength;
5742 Jim_Free(quotingType);
5745 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5747 struct JimParserCtx parser;
5748 const char *str;
5749 int strLen;
5750 const char *filename = NULL;
5751 int linenr = 1;
5753 /* Try to preserve information about filename / line number */
5754 if (objPtr->typePtr == &sourceObjType) {
5755 filename = Jim_GetSharedString(interp, objPtr->internalRep.sourceValue.fileName);
5756 linenr = objPtr->internalRep.sourceValue.lineNumber;
5759 /* Get the string representation */
5760 str = Jim_GetString(objPtr, &strLen);
5762 /* Free the old internal repr just now and initialize the
5763 * new one just now. The string->list conversion can't fail. */
5764 Jim_FreeIntRep(interp, objPtr);
5765 objPtr->typePtr = &listObjType;
5766 objPtr->internalRep.listValue.len = 0;
5767 objPtr->internalRep.listValue.maxLen = 0;
5768 objPtr->internalRep.listValue.ele = NULL;
5770 /* Convert into a list */
5771 JimParserInit(&parser, str, strLen, linenr);
5772 while (!parser.eof) {
5773 Jim_Obj *elementPtr;
5775 JimParseList(&parser);
5776 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
5777 continue;
5778 elementPtr = JimParserGetTokenObj(interp, &parser);
5779 JimSetSourceInfo(interp, elementPtr, filename, parser.tline);
5780 ListAppendElement(objPtr, elementPtr);
5782 if (filename) {
5783 Jim_ReleaseSharedString(interp, filename);
5785 return JIM_OK;
5788 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5790 Jim_Obj *objPtr;
5791 int i;
5793 objPtr = Jim_NewObj(interp);
5794 objPtr->typePtr = &listObjType;
5795 objPtr->bytes = NULL;
5796 objPtr->internalRep.listValue.ele = NULL;
5797 objPtr->internalRep.listValue.len = 0;
5798 objPtr->internalRep.listValue.maxLen = 0;
5799 for (i = 0; i < len; i++) {
5800 ListAppendElement(objPtr, elements[i]);
5802 return objPtr;
5805 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5806 * length of the vector. Note that the user of this function should make
5807 * sure that the list object can't shimmer while the vector returned
5808 * is in use, this vector is the one stored inside the internal representation
5809 * of the list object. This function is not exported, extensions should
5810 * always access to the List object elements using Jim_ListIndex(). */
5811 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
5812 Jim_Obj ***listVec)
5814 *listLen = Jim_ListLength(interp, listObj);
5815 *listVec = listObj->internalRep.listValue.ele;
5818 /* Sorting uses ints, but commands may return wide */
5819 static int JimSign(jim_wide w)
5821 if (w == 0) {
5822 return 0;
5824 else if (w < 0) {
5825 return -1;
5827 return 1;
5830 /* ListSortElements type values */
5831 struct lsort_info {
5832 jmp_buf jmpbuf;
5833 Jim_Obj *command;
5834 Jim_Interp *interp;
5835 enum {
5836 JIM_LSORT_ASCII,
5837 JIM_LSORT_NOCASE,
5838 JIM_LSORT_INTEGER,
5839 JIM_LSORT_COMMAND
5840 } type;
5841 int order;
5842 int index;
5843 int indexed;
5844 int (*subfn)(Jim_Obj **, Jim_Obj **);
5847 static struct lsort_info *sort_info;
5849 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5851 Jim_Obj *lObj, *rObj;
5853 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
5854 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
5855 longjmp(sort_info->jmpbuf, JIM_ERR);
5857 return sort_info->subfn(&lObj, &rObj);
5860 /* Sort the internal rep of a list. */
5861 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5863 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
5866 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5868 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
5871 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5873 jim_wide lhs = 0, rhs = 0;
5875 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
5876 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
5877 longjmp(sort_info->jmpbuf, JIM_ERR);
5880 return JimSign(lhs - rhs) * sort_info->order;
5883 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5885 Jim_Obj *compare_script;
5886 int rc;
5888 jim_wide ret = 0;
5890 /* This must be a valid list */
5891 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
5892 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
5893 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
5895 rc = Jim_EvalObj(sort_info->interp, compare_script);
5897 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
5898 longjmp(sort_info->jmpbuf, rc);
5901 return JimSign(ret) * sort_info->order;
5904 /* Sort a list *in place*. MUST be called with non-shared objects. */
5905 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
5907 struct lsort_info *prev_info;
5909 typedef int (qsort_comparator) (const void *, const void *);
5910 int (*fn) (Jim_Obj **, Jim_Obj **);
5911 Jim_Obj **vector;
5912 int len;
5913 int rc;
5915 JimPanic((Jim_IsShared(listObjPtr), interp, "Jim_ListSortElements called with shared object"));
5916 if (!Jim_IsList(listObjPtr))
5917 SetListFromAny(interp, listObjPtr);
5919 /* Allow lsort to be called reentrantly */
5920 prev_info = sort_info;
5921 sort_info = info;
5923 vector = listObjPtr->internalRep.listValue.ele;
5924 len = listObjPtr->internalRep.listValue.len;
5925 switch (info->type) {
5926 case JIM_LSORT_ASCII:
5927 fn = ListSortString;
5928 break;
5929 case JIM_LSORT_NOCASE:
5930 fn = ListSortStringNoCase;
5931 break;
5932 case JIM_LSORT_INTEGER:
5933 fn = ListSortInteger;
5934 break;
5935 case JIM_LSORT_COMMAND:
5936 fn = ListSortCommand;
5937 break;
5938 default:
5939 fn = NULL; /* avoid warning */
5940 JimPanic((1, interp, "ListSort called with invalid sort type"));
5943 if (info->indexed) {
5944 /* Need to interpose a "list index" function */
5945 info->subfn = fn;
5946 fn = ListSortIndexHelper;
5949 if ((rc = setjmp(info->jmpbuf)) == 0) {
5950 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
5952 Jim_InvalidateStringRep(listObjPtr);
5953 sort_info = prev_info;
5955 return rc;
5958 /* This is the low-level function to insert elements into a list.
5959 * The higher-level Jim_ListInsertElements() performs shared object
5960 * check and invalidate the string repr. This version is used
5961 * in the internals of the List Object and is not exported.
5963 * NOTE: this function can be called only against objects
5964 * with internal type of List. */
5965 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
5967 int currentLen = listPtr->internalRep.listValue.len;
5968 int requiredLen = currentLen + elemc;
5969 int i;
5970 Jim_Obj **point;
5972 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5973 int maxLen = requiredLen * 2;
5975 listPtr->internalRep.listValue.ele =
5976 Jim_Realloc(listPtr->internalRep.listValue.ele, sizeof(Jim_Obj *) * maxLen);
5977 listPtr->internalRep.listValue.maxLen = maxLen;
5979 point = listPtr->internalRep.listValue.ele + idx;
5980 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
5981 for (i = 0; i < elemc; ++i) {
5982 point[i] = elemVec[i];
5983 Jim_IncrRefCount(point[i]);
5985 listPtr->internalRep.listValue.len += elemc;
5988 /* Convenience call to ListInsertElements() to append a single element.
5990 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5992 ListInsertElements(listPtr, listPtr->internalRep.listValue.len, 1, &objPtr);
5996 /* Appends every element of appendListPtr into listPtr.
5997 * Both have to be of the list type.
5998 * Convenience call to ListInsertElements()
6000 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6002 ListInsertElements(listPtr, listPtr->internalRep.listValue.len,
6003 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6006 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6008 JimPanic((Jim_IsShared(listPtr), interp, "Jim_ListAppendElement called with shared object"));
6009 if (!Jim_IsList(listPtr))
6010 SetListFromAny(interp, listPtr);
6011 Jim_InvalidateStringRep(listPtr);
6012 ListAppendElement(listPtr, objPtr);
6015 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6017 JimPanic((Jim_IsShared(listPtr), interp, "Jim_ListAppendList called with shared object"));
6018 if (!Jim_IsList(listPtr))
6019 SetListFromAny(interp, listPtr);
6020 Jim_InvalidateStringRep(listPtr);
6021 ListAppendList(listPtr, appendListPtr);
6024 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6026 if (!Jim_IsList(objPtr))
6027 SetListFromAny(interp, objPtr);
6028 return objPtr->internalRep.listValue.len;
6031 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6032 int objc, Jim_Obj *const *objVec)
6034 JimPanic((Jim_IsShared(listPtr), interp, "Jim_ListInsertElement called with shared object"));
6035 if (!Jim_IsList(listPtr))
6036 SetListFromAny(interp, listPtr);
6037 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6038 idx = listPtr->internalRep.listValue.len;
6039 else if (idx < 0)
6040 idx = 0;
6041 Jim_InvalidateStringRep(listPtr);
6042 ListInsertElements(listPtr, idx, objc, objVec);
6045 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6047 if (!Jim_IsList(listPtr))
6048 SetListFromAny(interp, listPtr);
6049 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6050 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6051 if (flags & JIM_ERRMSG) {
6052 Jim_SetResultString(interp, "list index out of range", -1);
6054 *objPtrPtr = NULL;
6055 return JIM_ERR;
6057 if (idx < 0)
6058 idx = listPtr->internalRep.listValue.len + idx;
6059 *objPtrPtr = listPtr->internalRep.listValue.ele[idx];
6060 return JIM_OK;
6063 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6064 Jim_Obj *newObjPtr, int flags)
6066 if (!Jim_IsList(listPtr))
6067 SetListFromAny(interp, listPtr);
6068 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6069 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6070 if (flags & JIM_ERRMSG) {
6071 Jim_SetResultString(interp, "list index out of range", -1);
6073 return JIM_ERR;
6075 if (idx < 0)
6076 idx = listPtr->internalRep.listValue.len + idx;
6077 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6078 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6079 Jim_IncrRefCount(newObjPtr);
6080 return JIM_OK;
6083 /* Modify the list stored into the variable named 'varNamePtr'
6084 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6085 * with the new element 'newObjptr'. */
6086 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6087 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6089 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6090 int shared, i, idx;
6092 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6093 if (objPtr == NULL)
6094 return JIM_ERR;
6095 if ((shared = Jim_IsShared(objPtr)))
6096 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6097 for (i = 0; i < indexc - 1; i++) {
6098 listObjPtr = objPtr;
6099 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6100 goto err;
6101 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6102 goto err;
6104 if (Jim_IsShared(objPtr)) {
6105 objPtr = Jim_DuplicateObj(interp, objPtr);
6106 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6108 Jim_InvalidateStringRep(listObjPtr);
6110 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6111 goto err;
6112 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6113 goto err;
6114 Jim_InvalidateStringRep(objPtr);
6115 Jim_InvalidateStringRep(varObjPtr);
6116 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6117 goto err;
6118 Jim_SetResult(interp, varObjPtr);
6119 return JIM_OK;
6120 err:
6121 if (shared) {
6122 Jim_FreeNewObj(interp, varObjPtr);
6124 return JIM_ERR;
6127 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6129 int i;
6131 /* If all the objects in objv are lists,
6132 * it's possible to return a list as result, that's the
6133 * concatenation of all the lists. */
6134 for (i = 0; i < objc; i++) {
6135 if (!Jim_IsList(objv[i]))
6136 break;
6138 if (i == objc) {
6139 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6141 for (i = 0; i < objc; i++)
6142 Jim_ListAppendList(interp, objPtr, objv[i]);
6143 return objPtr;
6145 else {
6146 /* Else... we have to glue strings together */
6147 int len = 0, objLen;
6148 char *bytes, *p;
6150 /* Compute the length */
6151 for (i = 0; i < objc; i++) {
6152 Jim_GetString(objv[i], &objLen);
6153 len += objLen;
6155 if (objc)
6156 len += objc - 1;
6157 /* Create the string rep, and a string object holding it. */
6158 p = bytes = Jim_Alloc(len + 1);
6159 for (i = 0; i < objc; i++) {
6160 const char *s = Jim_GetString(objv[i], &objLen);
6162 /* Remove leading space */
6163 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6164 s++;
6165 objLen--;
6166 len--;
6168 /* And trailing space */
6169 while (objLen && (s[objLen - 1] == ' ' ||
6170 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6171 /* Handle trailing backslash-space case */
6172 if (objLen > 1 && s[objLen - 2] == '\\') {
6173 break;
6175 objLen--;
6176 len--;
6178 memcpy(p, s, objLen);
6179 p += objLen;
6180 if (objLen && i + 1 != objc) {
6181 *p++ = ' ';
6183 else if (i + 1 != objc) {
6184 /* Drop the space calcuated for this
6185 * element that is instead null. */
6186 len--;
6189 *p = '\0';
6190 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6194 /* Returns a list composed of the elements in the specified range.
6195 * first and start are directly accepted as Jim_Objects and
6196 * processed for the end?-index? case. */
6197 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6198 Jim_Obj *lastObjPtr)
6200 int first, last;
6201 int len, rangeLen;
6203 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6204 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6205 return NULL;
6206 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6207 first = JimRelToAbsIndex(len, first);
6208 last = JimRelToAbsIndex(len, last);
6209 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
6210 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6213 /* -----------------------------------------------------------------------------
6214 * Dict object
6215 * ---------------------------------------------------------------------------*/
6216 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6217 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6218 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6219 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6221 /* Dict HashTable Type.
6223 * Keys and Values are Jim objects. */
6225 static unsigned int JimObjectHTHashFunction(const void *key)
6227 const char *str;
6228 Jim_Obj *objPtr = (Jim_Obj *)key;
6229 int len, h;
6231 str = Jim_GetString(objPtr, &len);
6232 h = Jim_GenHashFunction((unsigned char *)str, len);
6233 return h;
6236 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6238 JIM_NOTUSED(privdata);
6240 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6243 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6245 Jim_Obj *objPtr = val;
6247 Jim_DecrRefCount(interp, objPtr);
6250 static const Jim_HashTableType JimDictHashTableType = {
6251 JimObjectHTHashFunction, /* hash function */
6252 NULL, /* key dup */
6253 NULL, /* val dup */
6254 JimObjectHTKeyCompare, /* key compare */
6255 (void (*)(void *, const void *)) /* ATTENTION: const cast */
6256 JimObjectHTKeyValDestructor, /* key destructor */
6257 JimObjectHTKeyValDestructor /* val destructor */
6260 /* Note that while the elements of the dict may contain references,
6261 * the list object itself can't. This basically means that the
6262 * dict object string representation as a whole can't contain references
6263 * that are not presents in the single elements. */
6264 static const Jim_ObjType dictObjType = {
6265 "dict",
6266 FreeDictInternalRep,
6267 DupDictInternalRep,
6268 UpdateStringOfDict,
6269 JIM_TYPE_NONE,
6272 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6274 JIM_NOTUSED(interp);
6276 Jim_FreeHashTable(objPtr->internalRep.ptr);
6277 Jim_Free(objPtr->internalRep.ptr);
6280 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6282 Jim_HashTable *ht, *dupHt;
6283 Jim_HashTableIterator *htiter;
6284 Jim_HashEntry *he;
6286 /* Create a new hash table */
6287 ht = srcPtr->internalRep.ptr;
6288 dupHt = Jim_Alloc(sizeof(*dupHt));
6289 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6290 if (ht->size != 0)
6291 Jim_ExpandHashTable(dupHt, ht->size);
6292 /* Copy every element from the source to the dup hash table */
6293 htiter = Jim_GetHashTableIterator(ht);
6294 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6295 const Jim_Obj *keyObjPtr = he->key;
6296 Jim_Obj *valObjPtr = he->val;
6298 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6299 Jim_IncrRefCount(valObjPtr);
6300 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6302 Jim_FreeHashTableIterator(htiter);
6304 dupPtr->internalRep.ptr = dupHt;
6305 dupPtr->typePtr = &dictObjType;
6308 void UpdateStringOfDict(struct Jim_Obj *objPtr)
6310 int i, bufLen, realLength;
6311 const char *strRep;
6312 char *p;
6313 int *quotingType, objc;
6314 Jim_HashTable *ht;
6315 Jim_HashTableIterator *htiter;
6316 Jim_HashEntry *he;
6317 Jim_Obj **objv;
6319 /* Trun the hash table into a flat vector of Jim_Objects. */
6320 ht = objPtr->internalRep.ptr;
6321 objc = ht->used * 2;
6322 objv = Jim_Alloc(objc * sizeof(Jim_Obj *));
6323 htiter = Jim_GetHashTableIterator(ht);
6324 i = 0;
6325 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6326 objv[i++] = (Jim_Obj *)he->key; /* ATTENTION: const cast */
6327 objv[i++] = he->val;
6329 Jim_FreeHashTableIterator(htiter);
6330 /* (Over) Estimate the space needed. */
6331 quotingType = Jim_Alloc(sizeof(int) * objc);
6332 bufLen = 0;
6333 for (i = 0; i < objc; i++) {
6334 int len;
6336 strRep = Jim_GetString(objv[i], &len);
6337 quotingType[i] = ListElementQuotingType(strRep, len);
6338 switch (quotingType[i]) {
6339 case JIM_ELESTR_SIMPLE:
6340 bufLen += len;
6341 break;
6342 case JIM_ELESTR_BRACE:
6343 bufLen += len + 2;
6344 break;
6345 case JIM_ELESTR_QUOTE:
6346 bufLen += len * 2;
6347 break;
6349 bufLen++; /* elements separator. */
6351 bufLen++;
6353 /* Generate the string rep. */
6354 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6355 realLength = 0;
6356 for (i = 0; i < objc; i++) {
6357 int len, qlen;
6358 char *q;
6360 strRep = Jim_GetString(objv[i], &len);
6362 switch (quotingType[i]) {
6363 case JIM_ELESTR_SIMPLE:
6364 memcpy(p, strRep, len);
6365 p += len;
6366 realLength += len;
6367 break;
6368 case JIM_ELESTR_BRACE:
6369 *p++ = '{';
6370 memcpy(p, strRep, len);
6371 p += len;
6372 *p++ = '}';
6373 realLength += len + 2;
6374 break;
6375 case JIM_ELESTR_QUOTE:
6376 q = BackslashQuoteString(strRep, len, &qlen);
6377 memcpy(p, q, qlen);
6378 Jim_Free(q);
6379 p += qlen;
6380 realLength += qlen;
6381 break;
6383 /* Add a separating space */
6384 if (i + 1 != objc) {
6385 *p++ = ' ';
6386 realLength++;
6389 *p = '\0'; /* nul term. */
6390 objPtr->length = realLength;
6391 Jim_Free(quotingType);
6392 Jim_Free(objv);
6395 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6397 int listlen;
6399 /* Get the string representation. Do this first so we don't
6400 * change order in case of fast conversion to dict.
6402 Jim_String(objPtr);
6404 /* For simplicity, convert a non-list object to a list and then to a dict */
6405 listlen = Jim_ListLength(interp, objPtr);
6406 if (listlen % 2) {
6407 Jim_SetResultString(interp,
6408 "invalid dictionary value: must be a list with an even number of elements", -1);
6409 return JIM_ERR;
6411 else {
6412 /* Now it is easy to convert to a dict from a list, and it can't fail */
6413 Jim_HashTable *ht;
6414 int i;
6416 ht = Jim_Alloc(sizeof(*ht));
6417 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6419 for (i = 0; i < listlen; i += 2) {
6420 Jim_Obj *keyObjPtr;
6421 Jim_Obj *valObjPtr;
6423 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
6424 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
6426 Jim_IncrRefCount(keyObjPtr);
6427 Jim_IncrRefCount(valObjPtr);
6429 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
6430 Jim_HashEntry *he;
6432 he = Jim_FindHashEntry(ht, keyObjPtr);
6433 Jim_DecrRefCount(interp, keyObjPtr);
6434 /* ATTENTION: const cast */
6435 Jim_DecrRefCount(interp, (Jim_Obj *)he->val);
6436 he->val = valObjPtr;
6440 Jim_FreeIntRep(interp, objPtr);
6441 objPtr->typePtr = &dictObjType;
6442 objPtr->internalRep.ptr = ht;
6444 return JIM_OK;
6448 /* Dict object API */
6450 /* Add an element to a dict. objPtr must be of the "dict" type.
6451 * The higer-level exported function is Jim_DictAddElement().
6452 * If an element with the specified key already exists, the value
6453 * associated is replaced with the new one.
6455 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6456 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6457 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6459 Jim_HashTable *ht = objPtr->internalRep.ptr;
6461 if (valueObjPtr == NULL) { /* unset */
6462 return Jim_DeleteHashEntry(ht, keyObjPtr);
6464 Jim_IncrRefCount(keyObjPtr);
6465 Jim_IncrRefCount(valueObjPtr);
6466 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
6467 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
6469 Jim_DecrRefCount(interp, keyObjPtr);
6470 /* ATTENTION: const cast */
6471 Jim_DecrRefCount(interp, (Jim_Obj *)he->val);
6472 he->val = valueObjPtr;
6474 return JIM_OK;
6477 /* Add an element, higher-level interface for DictAddElement().
6478 * If valueObjPtr == NULL, the key is removed if it exists. */
6479 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6480 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6482 int retcode;
6484 JimPanic((Jim_IsShared(objPtr), interp, "Jim_DictAddElement called with shared object"));
6485 if (objPtr->typePtr != &dictObjType) {
6486 if (SetDictFromAny(interp, objPtr) != JIM_OK)
6487 return JIM_ERR;
6489 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
6490 Jim_InvalidateStringRep(objPtr);
6491 return retcode;
6494 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6496 Jim_Obj *objPtr;
6497 int i;
6499 JimPanic((len % 2, interp, "Jim_NewDictObj() 'len' argument must be even"));
6501 objPtr = Jim_NewObj(interp);
6502 objPtr->typePtr = &dictObjType;
6503 objPtr->bytes = NULL;
6504 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
6505 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
6506 for (i = 0; i < len; i += 2)
6507 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
6508 return objPtr;
6511 /* Return the value associated to the specified dict key
6512 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
6514 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
6515 Jim_Obj **objPtrPtr, int flags)
6517 Jim_HashEntry *he;
6518 Jim_HashTable *ht;
6520 if (dictPtr->typePtr != &dictObjType) {
6521 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
6522 return -1;
6524 ht = dictPtr->internalRep.ptr;
6525 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
6526 if (flags & JIM_ERRMSG) {
6527 Jim_SetResultFormatted(interp, "key \"%#s\" not found in dictionary", keyPtr);
6529 return JIM_ERR;
6531 *objPtrPtr = he->val;
6532 return JIM_OK;
6535 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
6536 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
6538 Jim_HashTable *ht;
6539 Jim_HashTableIterator *htiter;
6540 Jim_HashEntry *he;
6541 Jim_Obj **objv;
6542 int i;
6544 if (dictPtr->typePtr != &dictObjType) {
6545 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
6546 return JIM_ERR;
6548 ht = dictPtr->internalRep.ptr;
6550 /* Turn the hash table into a flat vector of Jim_Objects. */
6551 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6552 htiter = Jim_GetHashTableIterator(ht);
6553 i = 0;
6554 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6555 objv[i++] = (Jim_Obj *)he->key; /* ATTENTION: const cast */
6556 objv[i++] = he->val;
6558 *len = i;
6559 Jim_FreeHashTableIterator(htiter);
6560 *objPtrPtr = objv;
6561 return JIM_OK;
6565 /* Return the value associated to the specified dict keys */
6566 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
6567 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
6569 int i;
6571 if (keyc == 0) {
6572 *objPtrPtr = dictPtr;
6573 return JIM_OK;
6576 for (i = 0; i < keyc; i++) {
6577 Jim_Obj *objPtr;
6579 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
6580 != JIM_OK)
6581 return JIM_ERR;
6582 dictPtr = objPtr;
6584 *objPtrPtr = dictPtr;
6585 return JIM_OK;
6588 /* Modify the dict stored into the variable named 'varNamePtr'
6589 * setting the element specified by the 'keyc' keys objects in 'keyv',
6590 * with the new value of the element 'newObjPtr'.
6592 * If newObjPtr == NULL the operation is to remove the given key
6593 * from the dictionary. */
6594 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
6595 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
6597 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
6598 int shared, i;
6600 varObjPtr = objPtr =
6601 Jim_GetVariable(interp, varNamePtr, newObjPtr == NULL ? JIM_ERRMSG : JIM_NONE);
6602 if (objPtr == NULL) {
6603 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
6604 return JIM_ERR;
6605 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
6606 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
6607 Jim_FreeNewObj(interp, varObjPtr);
6608 return JIM_ERR;
6611 if ((shared = Jim_IsShared(objPtr)))
6612 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6613 for (i = 0; i < keyc - 1; i++) {
6614 dictObjPtr = objPtr;
6616 /* Check if it's a valid dictionary */
6617 if (dictObjPtr->typePtr != &dictObjType) {
6618 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
6619 goto err;
6621 /* Check if the given key exists. */
6622 Jim_InvalidateStringRep(dictObjPtr);
6623 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
6624 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
6625 /* This key exists at the current level.
6626 * Make sure it's not shared!. */
6627 if (Jim_IsShared(objPtr)) {
6628 objPtr = Jim_DuplicateObj(interp, objPtr);
6629 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6632 else {
6633 /* Key not found. If it's an [unset] operation
6634 * this is an error. Only the last key may not
6635 * exist. */
6636 if (newObjPtr == NULL)
6637 goto err;
6638 /* Otherwise set an empty dictionary
6639 * as key's value. */
6640 objPtr = Jim_NewDictObj(interp, NULL, 0);
6641 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6644 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
6645 goto err;
6647 Jim_InvalidateStringRep(objPtr);
6648 Jim_InvalidateStringRep(varObjPtr);
6649 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6650 goto err;
6651 Jim_SetResult(interp, varObjPtr);
6652 return JIM_OK;
6653 err:
6654 if (shared) {
6655 Jim_FreeNewObj(interp, varObjPtr);
6657 return JIM_ERR;
6660 /* -----------------------------------------------------------------------------
6661 * Index object
6662 * ---------------------------------------------------------------------------*/
6663 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6664 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6666 static const Jim_ObjType indexObjType = {
6667 "index",
6668 NULL,
6669 NULL,
6670 UpdateStringOfIndex,
6671 JIM_TYPE_NONE,
6674 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6676 int len;
6677 char buf[JIM_INTEGER_SPACE + 1];
6679 if (objPtr->internalRep.indexValue >= 0)
6680 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6681 else if (objPtr->internalRep.indexValue == -1)
6682 len = sprintf(buf, "end");
6683 else {
6684 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6686 objPtr->bytes = Jim_Alloc(len + 1);
6687 memcpy(objPtr->bytes, buf, len + 1);
6688 objPtr->length = len;
6691 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6693 int idx, end = 0;
6694 const char *str;
6695 char *endptr;
6697 /* Get the string representation */
6698 str = Jim_String(objPtr);
6700 /* Try to convert into an index */
6701 if (strncmp(str, "end", 3) == 0) {
6702 end = 1;
6703 str += 3;
6704 idx = 0;
6706 else {
6707 idx = strtol(str, &endptr, 10);
6709 if (endptr == str) {
6710 goto badindex;
6712 str = endptr;
6715 /* Now str may include or +<num> or -<num> */
6716 if (*str == '+' || *str == '-') {
6717 int sign = (*str == '+' ? 1 : -1);
6719 idx += sign * strtol(++str, &endptr, 10);
6720 if (str == endptr || *endptr) {
6721 goto badindex;
6723 str = endptr;
6725 /* The only thing left should be spaces */
6726 while (isspace(UCHAR(*str))) {
6727 str++;
6729 if (*str) {
6730 goto badindex;
6732 if (end) {
6733 if (idx > 0) {
6734 idx = INT_MAX;
6736 else {
6737 /* end-1 is repesented as -2 */
6738 idx--;
6741 else if (idx < 0) {
6742 idx = -INT_MAX;
6745 /* Free the old internal repr and set the new one. */
6746 Jim_FreeIntRep(interp, objPtr);
6747 objPtr->typePtr = &indexObjType;
6748 objPtr->internalRep.indexValue = idx;
6749 return JIM_OK;
6751 badindex:
6752 Jim_SetResultFormatted(interp,
6753 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
6754 return JIM_ERR;
6757 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6759 /* Avoid shimmering if the object is an integer. */
6760 if (objPtr->typePtr == &intObjType) {
6761 jim_wide val = JimWideValue(objPtr);
6763 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6764 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6765 return JIM_OK;
6768 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
6769 return JIM_ERR;
6770 *indexPtr = objPtr->internalRep.indexValue;
6771 return JIM_OK;
6774 /* -----------------------------------------------------------------------------
6775 * Return Code Object.
6776 * ---------------------------------------------------------------------------*/
6778 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
6779 static const char * const jimReturnCodes[] = {
6780 [JIM_OK] = "ok",
6781 [JIM_ERR] = "error",
6782 [JIM_RETURN] = "return",
6783 [JIM_BREAK] = "break",
6784 [JIM_CONTINUE] = "continue",
6785 [JIM_SIGNAL] = "signal",
6786 [JIM_EXIT] = "exit",
6787 [JIM_EVAL] = "eval",
6788 NULL
6791 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
6793 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6795 static const Jim_ObjType returnCodeObjType = {
6796 "return-code",
6797 NULL,
6798 NULL,
6799 NULL,
6800 JIM_TYPE_NONE,
6803 /* Converts a (standard) return code to a string. Returns "?" for
6804 * non-standard return codes.
6806 const char *Jim_ReturnCode(int code)
6808 if (code < 0 || code >= (int)jimReturnCodesSize) {
6809 return "?";
6811 else {
6812 return jimReturnCodes[code];
6816 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6818 int returnCode;
6819 jim_wide wideValue;
6821 /* Try to convert into an integer */
6822 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6823 returnCode = (int)wideValue;
6824 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
6825 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
6826 return JIM_ERR;
6828 /* Free the old internal repr and set the new one. */
6829 Jim_FreeIntRep(interp, objPtr);
6830 objPtr->typePtr = &returnCodeObjType;
6831 objPtr->internalRep.returnCode = returnCode;
6832 return JIM_OK;
6835 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6837 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6838 return JIM_ERR;
6839 *intPtr = objPtr->internalRep.returnCode;
6840 return JIM_OK;
6843 /* -----------------------------------------------------------------------------
6844 * Expression Parsing
6845 * ---------------------------------------------------------------------------*/
6846 static int JimParseExprOperator(struct JimParserCtx *pc);
6847 static int JimParseExprNumber(struct JimParserCtx *pc);
6848 static int JimParseExprIrrational(struct JimParserCtx *pc);
6850 /* Exrp's Stack machine operators opcodes. */
6852 /* Binary operators (numbers) */
6853 enum
6855 /* Continues on from the JIM_TT_ space */
6856 /* Operations */
6857 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 15 */
6858 JIM_EXPROP_DIV,
6859 JIM_EXPROP_MOD,
6860 JIM_EXPROP_SUB,
6861 JIM_EXPROP_ADD,
6862 JIM_EXPROP_LSHIFT,
6863 JIM_EXPROP_RSHIFT,
6864 JIM_EXPROP_ROTL,
6865 JIM_EXPROP_ROTR,
6866 JIM_EXPROP_LT,
6867 JIM_EXPROP_GT,
6868 JIM_EXPROP_LTE,
6869 JIM_EXPROP_GTE,
6870 JIM_EXPROP_NUMEQ,
6871 JIM_EXPROP_NUMNE,
6872 JIM_EXPROP_BITAND, /* 30 */
6873 JIM_EXPROP_BITXOR,
6874 JIM_EXPROP_BITOR,
6876 /* Note must keep these together */
6877 JIM_EXPROP_LOGICAND, /* 33 */
6878 JIM_EXPROP_LOGICAND_LEFT,
6879 JIM_EXPROP_LOGICAND_RIGHT,
6881 /* and these */
6882 JIM_EXPROP_LOGICOR, /* 36 */
6883 JIM_EXPROP_LOGICOR_LEFT,
6884 JIM_EXPROP_LOGICOR_RIGHT,
6886 /* and these */
6887 /* Ternary operators */
6888 JIM_EXPROP_TERNARY, /* 39 */
6889 JIM_EXPROP_TERNARY_LEFT,
6890 JIM_EXPROP_TERNARY_RIGHT,
6892 /* and these */
6893 JIM_EXPROP_COLON, /* 42 */
6894 JIM_EXPROP_COLON_LEFT,
6895 JIM_EXPROP_COLON_RIGHT,
6897 JIM_EXPROP_POW, /* 45 */
6899 /* Binary operators (strings) */
6900 JIM_EXPROP_STREQ,
6901 JIM_EXPROP_STRNE,
6902 JIM_EXPROP_STRIN,
6903 JIM_EXPROP_STRNI,
6905 /* Unary operators (numbers) */
6906 JIM_EXPROP_NOT,
6907 JIM_EXPROP_BITNOT,
6908 JIM_EXPROP_UNARYMINUS,
6909 JIM_EXPROP_UNARYPLUS,
6911 /* Functions */
6912 JIM_EXPROP_FUNC_FIRST,
6913 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
6914 JIM_EXPROP_FUNC_ABS,
6915 JIM_EXPROP_FUNC_DOUBLE,
6916 JIM_EXPROP_FUNC_ROUND,
6918 #ifdef JIM_MATH_FUNCTIONS
6919 /* math functions from libm */
6920 JIM_EXPROP_FUNC_SIN,
6921 JIM_EXPROP_FUNC_COS,
6922 JIM_EXPROP_FUNC_TAN,
6923 JIM_EXPROP_FUNC_ASIN,
6924 JIM_EXPROP_FUNC_ACOS,
6925 JIM_EXPROP_FUNC_ATAN,
6926 JIM_EXPROP_FUNC_SINH,
6927 JIM_EXPROP_FUNC_COSH,
6928 JIM_EXPROP_FUNC_TANH,
6929 JIM_EXPROP_FUNC_CEIL,
6930 JIM_EXPROP_FUNC_FLOOR,
6931 JIM_EXPROP_FUNC_EXP,
6932 JIM_EXPROP_FUNC_LOG,
6933 JIM_EXPROP_FUNC_LOG10,
6934 JIM_EXPROP_FUNC_SQRT,
6935 #endif
6938 struct JimExprState
6940 Jim_Obj **stack;
6941 int stacklen;
6942 int opcode;
6943 int skip;
6946 /* Operators table */
6947 typedef struct Jim_ExprOperator
6949 const char *name;
6950 int precedence;
6951 int arity;
6952 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
6953 int lazy;
6954 } Jim_ExprOperator;
6956 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
6958 Jim_IncrRefCount(obj);
6959 e->stack[e->stacklen++] = obj;
6962 static Jim_Obj *ExprPop(struct JimExprState *e)
6964 return e->stack[--e->stacklen];
6967 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
6969 int intresult = 0;
6970 int rc = JIM_OK;
6971 Jim_Obj *A = ExprPop(e);
6972 double dA, dC = 0;
6973 jim_wide wA, wC = 0;
6975 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
6976 intresult = 1;
6978 switch (e->opcode) {
6979 case JIM_EXPROP_FUNC_INT:
6980 wC = wA;
6981 break;
6982 case JIM_EXPROP_FUNC_ROUND:
6983 wC = wA;
6984 break;
6985 case JIM_EXPROP_FUNC_DOUBLE:
6986 dC = wA;
6987 intresult = 0;
6988 break;
6989 case JIM_EXPROP_FUNC_ABS:
6990 wC = wA >= 0 ? wA : -wA;
6991 break;
6992 case JIM_EXPROP_UNARYMINUS:
6993 wC = -wA;
6994 break;
6995 case JIM_EXPROP_UNARYPLUS:
6996 wC = wA;
6997 break;
6998 case JIM_EXPROP_NOT:
6999 wC = !wA;
7000 break;
7001 default:
7002 abort();
7005 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7006 switch (e->opcode) {
7007 case JIM_EXPROP_FUNC_INT:
7008 wC = dA;
7009 intresult = 1;
7010 break;
7011 case JIM_EXPROP_FUNC_ROUND:
7012 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7013 intresult = 1;
7014 break;
7015 case JIM_EXPROP_FUNC_DOUBLE:
7016 dC = dA;
7017 break;
7018 case JIM_EXPROP_FUNC_ABS:
7019 dC = dA >= 0 ? dA : -dA;
7020 break;
7021 case JIM_EXPROP_UNARYMINUS:
7022 dC = -dA;
7023 break;
7024 case JIM_EXPROP_UNARYPLUS:
7025 dC = dA;
7026 break;
7027 case JIM_EXPROP_NOT:
7028 wC = !dA;
7029 intresult = 1;
7030 break;
7031 default:
7032 abort();
7036 if (rc == JIM_OK) {
7037 if (intresult) {
7038 ExprPush(e, Jim_NewIntObj(interp, wC));
7040 else {
7041 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7045 Jim_DecrRefCount(interp, A);
7047 return rc;
7050 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7052 Jim_Obj *A = ExprPop(e);
7053 jim_wide wA;
7054 int rc = JIM_ERR;
7057 if (Jim_GetWide(interp, A, &wA) == JIM_OK) {
7058 jim_wide wC;
7060 switch (e->opcode) {
7061 case JIM_EXPROP_BITNOT:
7062 wC = ~wA;
7063 break;
7064 default:
7065 abort();
7067 ExprPush(e, Jim_NewIntObj(interp, wC));
7068 rc = JIM_OK;
7071 Jim_DecrRefCount(interp, A);
7073 return rc;
7076 #ifdef JIM_MATH_FUNCTIONS
7077 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7079 int rc;
7080 Jim_Obj *A = ExprPop(e);
7081 double dA, dC;
7083 rc = Jim_GetDouble(interp, A, &dA);
7084 if (rc == JIM_OK) {
7085 switch (e->opcode) {
7086 case JIM_EXPROP_FUNC_SIN:
7087 dC = sin(dA);
7088 break;
7089 case JIM_EXPROP_FUNC_COS:
7090 dC = cos(dA);
7091 break;
7092 case JIM_EXPROP_FUNC_TAN:
7093 dC = tan(dA);
7094 break;
7095 case JIM_EXPROP_FUNC_ASIN:
7096 dC = asin(dA);
7097 break;
7098 case JIM_EXPROP_FUNC_ACOS:
7099 dC = acos(dA);
7100 break;
7101 case JIM_EXPROP_FUNC_ATAN:
7102 dC = atan(dA);
7103 break;
7104 case JIM_EXPROP_FUNC_SINH:
7105 dC = sinh(dA);
7106 break;
7107 case JIM_EXPROP_FUNC_COSH:
7108 dC = cosh(dA);
7109 break;
7110 case JIM_EXPROP_FUNC_TANH:
7111 dC = tanh(dA);
7112 break;
7113 case JIM_EXPROP_FUNC_CEIL:
7114 dC = ceil(dA);
7115 break;
7116 case JIM_EXPROP_FUNC_FLOOR:
7117 dC = floor(dA);
7118 break;
7119 case JIM_EXPROP_FUNC_EXP:
7120 dC = exp(dA);
7121 break;
7122 case JIM_EXPROP_FUNC_LOG:
7123 dC = log(dA);
7124 break;
7125 case JIM_EXPROP_FUNC_LOG10:
7126 dC = log10(dA);
7127 break;
7128 case JIM_EXPROP_FUNC_SQRT:
7129 dC = sqrt(dA);
7130 break;
7131 default:
7132 abort();
7134 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7137 Jim_DecrRefCount(interp, A);
7139 return rc;
7141 #endif
7143 /* A binary operation on two ints */
7144 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7146 Jim_Obj *B = ExprPop(e);
7147 Jim_Obj *A = ExprPop(e);
7148 jim_wide wA, wB;
7149 int rc = JIM_ERR;
7151 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7152 jim_wide wC;
7154 rc = JIM_OK;
7156 switch (e->opcode) {
7157 case JIM_EXPROP_LSHIFT:
7158 wC = wA << wB;
7159 break;
7160 case JIM_EXPROP_RSHIFT:
7161 wC = wA >> wB;
7162 break;
7163 case JIM_EXPROP_BITAND:
7164 wC = wA & wB;
7165 break;
7166 case JIM_EXPROP_BITXOR:
7167 wC = wA ^ wB;
7168 break;
7169 case JIM_EXPROP_BITOR:
7170 wC = wA | wB;
7171 break;
7172 case JIM_EXPROP_MOD:
7173 if (wB == 0) {
7174 wC = 0;
7175 Jim_SetResultString(interp, "Division by zero", -1);
7176 rc = JIM_ERR;
7178 else {
7180 * From Tcl 8.x
7182 * This code is tricky: C doesn't guarantee much
7183 * about the quotient or remainder, but Tcl does.
7184 * The remainder always has the same sign as the
7185 * divisor and a smaller absolute value.
7187 int negative = 0;
7189 if (wB < 0) {
7190 wB = -wB;
7191 wA = -wA;
7192 negative = 1;
7194 wC = wA % wB;
7195 if (wC < 0) {
7196 wC += wB;
7198 if (negative) {
7199 wC = -wC;
7202 break;
7203 case JIM_EXPROP_ROTL:
7204 case JIM_EXPROP_ROTR:{
7205 /* uint32_t would be better. But not everyone has inttypes.h? */
7206 unsigned long uA = (unsigned long)wA;
7207 unsigned long uB = (unsigned long)wB;
7208 const unsigned int S = sizeof(unsigned long) * 8;
7210 /* Shift left by the word size or more is undefined. */
7211 uB %= S;
7213 if (e->opcode == JIM_EXPROP_ROTR) {
7214 uB = S - uB;
7216 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7217 break;
7219 default:
7220 abort();
7222 ExprPush(e, Jim_NewIntObj(interp, wC));
7226 Jim_DecrRefCount(interp, A);
7227 Jim_DecrRefCount(interp, B);
7229 return rc;
7233 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7234 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7236 int intresult = 0;
7237 int rc = JIM_OK;
7238 double dA, dB, dC = 0;
7239 jim_wide wA, wB, wC = 0;
7241 Jim_Obj *B = ExprPop(e);
7242 Jim_Obj *A = ExprPop(e);
7244 if ((A->typePtr != &doubleObjType || A->bytes) &&
7245 (B->typePtr != &doubleObjType || B->bytes) &&
7246 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7248 /* Both are ints */
7250 intresult = 1;
7252 switch (e->opcode) {
7253 case JIM_EXPROP_POW:
7254 wC = JimPowWide(wA, wB);
7255 break;
7256 case JIM_EXPROP_ADD:
7257 wC = wA + wB;
7258 break;
7259 case JIM_EXPROP_SUB:
7260 wC = wA - wB;
7261 break;
7262 case JIM_EXPROP_MUL:
7263 wC = wA * wB;
7264 break;
7265 case JIM_EXPROP_DIV:
7266 if (wB == 0) {
7267 Jim_SetResultString(interp, "Division by zero", -1);
7268 rc = JIM_ERR;
7270 else {
7272 * From Tcl 8.x
7274 * This code is tricky: C doesn't guarantee much
7275 * about the quotient or remainder, but Tcl does.
7276 * The remainder always has the same sign as the
7277 * divisor and a smaller absolute value.
7279 if (wB < 0) {
7280 wB = -wB;
7281 wA = -wA;
7283 wC = wA / wB;
7284 if (wA % wB < 0) {
7285 wC--;
7288 break;
7289 case JIM_EXPROP_LT:
7290 wC = wA < wB;
7291 break;
7292 case JIM_EXPROP_GT:
7293 wC = wA > wB;
7294 break;
7295 case JIM_EXPROP_LTE:
7296 wC = wA <= wB;
7297 break;
7298 case JIM_EXPROP_GTE:
7299 wC = wA >= wB;
7300 break;
7301 case JIM_EXPROP_NUMEQ:
7302 wC = wA == wB;
7303 break;
7304 case JIM_EXPROP_NUMNE:
7305 wC = wA != wB;
7306 break;
7307 default:
7308 abort();
7311 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7312 switch (e->opcode) {
7313 case JIM_EXPROP_POW:
7314 #ifdef JIM_MATH_FUNCTIONS
7315 dC = pow(dA, dB);
7316 #else
7317 Jim_SetResultString(interp, "unsupported", -1);
7318 rc = JIM_ERR;
7319 #endif
7320 break;
7321 case JIM_EXPROP_ADD:
7322 dC = dA + dB;
7323 break;
7324 case JIM_EXPROP_SUB:
7325 dC = dA - dB;
7326 break;
7327 case JIM_EXPROP_MUL:
7328 dC = dA * dB;
7329 break;
7330 case JIM_EXPROP_DIV:
7331 if (dB == 0) {
7332 #ifdef INFINITY
7333 dC = dA < 0 ? -INFINITY : INFINITY;
7334 #else
7335 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7336 #endif
7338 else {
7339 dC = dA / dB;
7341 break;
7342 case JIM_EXPROP_LT:
7343 wC = dA < dB;
7344 intresult = 1;
7345 break;
7346 case JIM_EXPROP_GT:
7347 wC = dA > dB;
7348 intresult = 1;
7349 break;
7350 case JIM_EXPROP_LTE:
7351 wC = dA <= dB;
7352 intresult = 1;
7353 break;
7354 case JIM_EXPROP_GTE:
7355 wC = dA >= dB;
7356 intresult = 1;
7357 break;
7358 case JIM_EXPROP_NUMEQ:
7359 wC = dA == dB;
7360 intresult = 1;
7361 break;
7362 case JIM_EXPROP_NUMNE:
7363 wC = dA != dB;
7364 intresult = 1;
7365 break;
7366 default:
7367 abort();
7370 else {
7371 /* Handle the string case */
7373 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7374 int i = Jim_StringCompareObj(interp, A, B, 0);
7376 intresult = 1;
7378 switch (e->opcode) {
7379 case JIM_EXPROP_LT:
7380 wC = i < 0;
7381 break;
7382 case JIM_EXPROP_GT:
7383 wC = i > 0;
7384 break;
7385 case JIM_EXPROP_LTE:
7386 wC = i <= 0;
7387 break;
7388 case JIM_EXPROP_GTE:
7389 wC = i >= 0;
7390 break;
7391 case JIM_EXPROP_NUMEQ:
7392 wC = i == 0;
7393 break;
7394 case JIM_EXPROP_NUMNE:
7395 wC = i != 0;
7396 break;
7397 default:
7398 rc = JIM_ERR;
7399 break;
7403 if (rc == JIM_OK) {
7404 if (intresult) {
7405 ExprPush(e, Jim_NewIntObj(interp, wC));
7407 else {
7408 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7412 Jim_DecrRefCount(interp, A);
7413 Jim_DecrRefCount(interp, B);
7415 return rc;
7418 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
7420 int listlen;
7421 int i;
7423 listlen = Jim_ListLength(interp, listObjPtr);
7424 for (i = 0; i < listlen; i++) {
7425 Jim_Obj *objPtr;
7427 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
7429 if (Jim_StringEqObj(objPtr, valObj)) {
7430 return 1;
7433 return 0;
7436 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
7438 Jim_Obj *B = ExprPop(e);
7439 Jim_Obj *A = ExprPop(e);
7441 jim_wide wC;
7443 switch (e->opcode) {
7444 case JIM_EXPROP_STREQ:
7445 case JIM_EXPROP_STRNE: {
7446 int Alen, Blen;
7447 const char *sA = Jim_GetString(A, &Alen);
7448 const char *sB = Jim_GetString(B, &Blen);
7450 if (e->opcode == JIM_EXPROP_STREQ) {
7451 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7453 else {
7454 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7456 break;
7458 case JIM_EXPROP_STRIN:
7459 wC = JimSearchList(interp, B, A);
7460 break;
7461 case JIM_EXPROP_STRNI:
7462 wC = !JimSearchList(interp, B, A);
7463 break;
7464 default:
7465 abort();
7467 ExprPush(e, Jim_NewIntObj(interp, wC));
7469 Jim_DecrRefCount(interp, A);
7470 Jim_DecrRefCount(interp, B);
7472 return JIM_OK;
7475 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
7477 long l;
7478 double d;
7480 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
7481 return l != 0;
7483 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
7484 return d != 0;
7486 return -1;
7489 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
7491 Jim_Obj *skip = ExprPop(e);
7492 Jim_Obj *A = ExprPop(e);
7493 int rc = JIM_OK;
7495 switch (ExprBool(interp, A)) {
7496 case 0:
7497 /* false, so skip RHS opcodes with a 0 result */
7498 e->skip = JimWideValue(skip);
7499 ExprPush(e, Jim_NewIntObj(interp, 0));
7500 break;
7502 case 1:
7503 /* true so continue */
7504 break;
7506 case -1:
7507 /* Invalid */
7508 rc = JIM_ERR;
7510 Jim_DecrRefCount(interp, A);
7511 Jim_DecrRefCount(interp, skip);
7513 return rc;
7516 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
7518 Jim_Obj *skip = ExprPop(e);
7519 Jim_Obj *A = ExprPop(e);
7520 int rc = JIM_OK;
7522 switch (ExprBool(interp, A)) {
7523 case 0:
7524 /* false, so do nothing */
7525 break;
7527 case 1:
7528 /* true so skip RHS opcodes with a 1 result */
7529 e->skip = JimWideValue(skip);
7530 ExprPush(e, Jim_NewIntObj(interp, 1));
7531 break;
7533 case -1:
7534 /* Invalid */
7535 rc = JIM_ERR;
7536 break;
7538 Jim_DecrRefCount(interp, A);
7539 Jim_DecrRefCount(interp, skip);
7541 return rc;
7544 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
7546 Jim_Obj *A = ExprPop(e);
7547 int rc = JIM_OK;
7549 switch (ExprBool(interp, A)) {
7550 case 0:
7551 ExprPush(e, Jim_NewIntObj(interp, 0));
7552 break;
7554 case 1:
7555 ExprPush(e, Jim_NewIntObj(interp, 1));
7556 break;
7558 case -1:
7559 /* Invalid */
7560 rc = JIM_ERR;
7561 break;
7563 Jim_DecrRefCount(interp, A);
7565 return rc;
7568 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
7570 Jim_Obj *skip = ExprPop(e);
7571 Jim_Obj *A = ExprPop(e);
7572 int rc = JIM_OK;
7574 /* Repush A */
7575 ExprPush(e, A);
7577 switch (ExprBool(interp, A)) {
7578 case 0:
7579 /* false, skip RHS opcodes */
7580 e->skip = JimWideValue(skip);
7581 /* Push a dummy value */
7582 ExprPush(e, Jim_NewIntObj(interp, 0));
7583 break;
7585 case 1:
7586 /* true so do nothing */
7587 break;
7589 case -1:
7590 /* Invalid */
7591 rc = JIM_ERR;
7592 break;
7594 Jim_DecrRefCount(interp, A);
7595 Jim_DecrRefCount(interp, skip);
7597 return rc;
7600 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
7602 Jim_Obj *skip = ExprPop(e);
7603 Jim_Obj *B = ExprPop(e);
7604 Jim_Obj *A = ExprPop(e);
7606 /* No need to check for A as non-boolean */
7607 if (ExprBool(interp, A)) {
7608 /* true, so skip RHS opcodes */
7609 e->skip = JimWideValue(skip);
7610 /* Repush B as the answer */
7611 ExprPush(e, B);
7614 Jim_DecrRefCount(interp, skip);
7615 Jim_DecrRefCount(interp, A);
7616 Jim_DecrRefCount(interp, B);
7617 return JIM_OK;
7620 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
7622 return JIM_OK;
7625 enum
7627 LAZY_NONE,
7628 LAZY_OP,
7629 LAZY_LEFT,
7630 LAZY_RIGHT
7633 /* name - precedence - arity - opcode */
7634 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
7635 [JIM_EXPROP_FUNC_INT] = {"int", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7636 [JIM_EXPROP_FUNC_DOUBLE] = {"double", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7637 [JIM_EXPROP_FUNC_ABS] = {"abs", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7638 [JIM_EXPROP_FUNC_ROUND] = {"round", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7640 #ifdef JIM_MATH_FUNCTIONS
7641 [JIM_EXPROP_FUNC_SIN] = {"sin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7642 [JIM_EXPROP_FUNC_COS] = {"cos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7643 [JIM_EXPROP_FUNC_TAN] = {"tan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7644 [JIM_EXPROP_FUNC_ASIN] = {"asin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7645 [JIM_EXPROP_FUNC_ACOS] = {"acos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7646 [JIM_EXPROP_FUNC_ATAN] = {"atan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7647 [JIM_EXPROP_FUNC_SINH] = {"sinh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7648 [JIM_EXPROP_FUNC_COSH] = {"cosh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7649 [JIM_EXPROP_FUNC_TANH] = {"tanh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7650 [JIM_EXPROP_FUNC_CEIL] = {"ceil", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7651 [JIM_EXPROP_FUNC_FLOOR] = {"floor", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7652 [JIM_EXPROP_FUNC_EXP] = {"exp", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7653 [JIM_EXPROP_FUNC_LOG] = {"log", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7654 [JIM_EXPROP_FUNC_LOG10] = {"log10", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7655 [JIM_EXPROP_FUNC_SQRT] = {"sqrt", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7656 #endif
7658 [JIM_EXPROP_NOT] = {"!", 300, 1, JimExprOpNumUnary, LAZY_NONE},
7659 [JIM_EXPROP_BITNOT] = {"~", 300, 1, JimExprOpIntUnary, LAZY_NONE},
7660 [JIM_EXPROP_UNARYMINUS] = {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7661 [JIM_EXPROP_UNARYPLUS] = {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7663 [JIM_EXPROP_POW] = {"**", 250, 2, JimExprOpBin, LAZY_NONE},
7665 [JIM_EXPROP_MUL] = {"*", 200, 2, JimExprOpBin, LAZY_NONE},
7666 [JIM_EXPROP_DIV] = {"/", 200, 2, JimExprOpBin, LAZY_NONE},
7667 [JIM_EXPROP_MOD] = {"%", 200, 2, JimExprOpIntBin, LAZY_NONE},
7669 [JIM_EXPROP_SUB] = {"-", 100, 2, JimExprOpBin, LAZY_NONE},
7670 [JIM_EXPROP_ADD] = {"+", 100, 2, JimExprOpBin, LAZY_NONE},
7672 [JIM_EXPROP_ROTL] = {"<<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7673 [JIM_EXPROP_ROTR] = {">>>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7674 [JIM_EXPROP_LSHIFT] = {"<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7675 [JIM_EXPROP_RSHIFT] = {">>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7677 [JIM_EXPROP_LT] = {"<", 80, 2, JimExprOpBin, LAZY_NONE},
7678 [JIM_EXPROP_GT] = {">", 80, 2, JimExprOpBin, LAZY_NONE},
7679 [JIM_EXPROP_LTE] = {"<=", 80, 2, JimExprOpBin, LAZY_NONE},
7680 [JIM_EXPROP_GTE] = {">=", 80, 2, JimExprOpBin, LAZY_NONE},
7682 [JIM_EXPROP_NUMEQ] = {"==", 70, 2, JimExprOpBin, LAZY_NONE},
7683 [JIM_EXPROP_NUMNE] = {"!=", 70, 2, JimExprOpBin, LAZY_NONE},
7685 [JIM_EXPROP_STREQ] = {"eq", 60, 2, JimExprOpStrBin, LAZY_NONE},
7686 [JIM_EXPROP_STRNE] = {"ne", 60, 2, JimExprOpStrBin, LAZY_NONE},
7688 [JIM_EXPROP_STRIN] = {"in", 55, 2, JimExprOpStrBin, LAZY_NONE},
7689 [JIM_EXPROP_STRNI] = {"ni", 55, 2, JimExprOpStrBin, LAZY_NONE},
7691 [JIM_EXPROP_BITAND] = {"&", 50, 2, JimExprOpIntBin, LAZY_NONE},
7692 [JIM_EXPROP_BITXOR] = {"^", 49, 2, JimExprOpIntBin, LAZY_NONE},
7693 [JIM_EXPROP_BITOR] = {"|", 48, 2, JimExprOpIntBin, LAZY_NONE},
7695 [JIM_EXPROP_LOGICAND] = {"&&", 10, 2, NULL, LAZY_OP},
7696 [JIM_EXPROP_LOGICOR] = {"||", 9, 2, NULL, LAZY_OP},
7698 [JIM_EXPROP_TERNARY] = {"?", 5, 2, JimExprOpNull, LAZY_OP},
7699 [JIM_EXPROP_COLON] = {":", 5, 2, JimExprOpNull, LAZY_OP},
7701 /* private operators */
7702 [JIM_EXPROP_TERNARY_LEFT] = {NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT},
7703 [JIM_EXPROP_TERNARY_RIGHT] = {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7704 [JIM_EXPROP_COLON_LEFT] = {NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT},
7705 [JIM_EXPROP_COLON_RIGHT] = {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7706 [JIM_EXPROP_LOGICAND_LEFT] = {NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT},
7707 [JIM_EXPROP_LOGICAND_RIGHT] = {NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7708 [JIM_EXPROP_LOGICOR_LEFT] = {NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT},
7709 [JIM_EXPROP_LOGICOR_RIGHT] = {NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7712 #define JIM_EXPR_OPERATORS_NUM \
7713 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
7715 static int JimParseExpression(struct JimParserCtx *pc)
7717 /* Discard spaces and quoted newline */
7718 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
7719 pc->p++;
7720 pc->len--;
7723 if (pc->len == 0) {
7724 pc->tstart = pc->tend = pc->p;
7725 pc->tline = pc->linenr;
7726 pc->tt = JIM_TT_EOL;
7727 pc->eof = 1;
7728 return JIM_OK;
7730 switch (*(pc->p)) {
7731 case '(':
7732 pc->tstart = pc->tend = pc->p;
7733 pc->tline = pc->linenr;
7734 pc->tt = JIM_TT_SUBEXPR_START;
7735 pc->p++;
7736 pc->len--;
7737 break;
7738 case ')':
7739 pc->tstart = pc->tend = pc->p;
7740 pc->tline = pc->linenr;
7741 pc->tt = JIM_TT_SUBEXPR_END;
7742 pc->p++;
7743 pc->len--;
7744 break;
7745 case '[':
7746 return JimParseCmd(pc);
7747 case '$':
7748 if (JimParseVar(pc) == JIM_ERR)
7749 return JimParseExprOperator(pc);
7750 else {
7751 /* Don't allow expr sugar in expressions */
7752 if (pc->tt == JIM_TT_EXPRSUGAR) {
7753 return JIM_ERR;
7755 return JIM_OK;
7757 break;
7758 case '0':
7759 case '1':
7760 case '2':
7761 case '3':
7762 case '4':
7763 case '5':
7764 case '6':
7765 case '7':
7766 case '8':
7767 case '9':
7768 case '.':
7769 return JimParseExprNumber(pc);
7770 case '"':
7771 return JimParseQuote(pc);
7772 case '{':
7773 return JimParseBrace(pc);
7775 case 'N':
7776 case 'I':
7777 case 'n':
7778 case 'i':
7779 if (JimParseExprIrrational(pc) == JIM_ERR)
7780 return JimParseExprOperator(pc);
7781 break;
7782 default:
7783 return JimParseExprOperator(pc);
7784 break;
7786 return JIM_OK;
7789 static int JimParseExprNumber(struct JimParserCtx *pc)
7791 int allowdot = 1;
7792 int allowhex = 0;
7794 /* Assume an integer for now */
7795 pc->tt = JIM_TT_EXPR_INT;
7796 pc->tstart = pc->p;
7797 pc->tline = pc->linenr;
7798 while (isdigit(UCHAR(*pc->p))
7799 || (allowhex && isxdigit(UCHAR(*pc->p)))
7800 || (allowdot && *pc->p == '.')
7801 || (pc->p - pc->tstart == 1 && *pc->tstart == '0' && (*pc->p == 'x' || *pc->p == 'X'))
7803 if ((*pc->p == 'x') || (*pc->p == 'X')) {
7804 allowhex = 1;
7805 allowdot = 0;
7807 if (*pc->p == '.') {
7808 allowdot = 0;
7809 pc->tt = JIM_TT_EXPR_DOUBLE;
7811 pc->p++;
7812 pc->len--;
7813 if (!allowhex && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
7814 || isdigit(UCHAR(pc->p[1])))) {
7815 pc->p += 2;
7816 pc->len -= 2;
7817 pc->tt = JIM_TT_EXPR_DOUBLE;
7820 pc->tend = pc->p - 1;
7821 return JIM_OK;
7824 static int JimParseExprIrrational(struct JimParserCtx *pc)
7826 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
7827 const char **token;
7829 for (token = Tokens; *token != NULL; token++) {
7830 int len = strlen(*token);
7832 if (strncmp(*token, pc->p, len) == 0) {
7833 pc->tstart = pc->p;
7834 pc->tend = pc->p + len - 1;
7835 pc->p += len;
7836 pc->len -= len;
7837 pc->tline = pc->linenr;
7838 pc->tt = JIM_TT_EXPR_DOUBLE;
7839 return JIM_OK;
7842 return JIM_ERR;
7845 static int JimParseExprOperator(struct JimParserCtx *pc)
7847 int i;
7848 int bestIdx = -1, bestLen = 0;
7850 /* Try to get the longest match. */
7851 for (i = JIM_TT_EXPR_OP; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
7852 const char *opname;
7853 int oplen;
7855 opname = Jim_ExprOperators[i].name;
7856 if (opname == NULL) {
7857 continue;
7859 oplen = strlen(opname);
7861 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
7862 bestIdx = i;
7863 bestLen = oplen;
7866 if (bestIdx == -1) {
7867 return JIM_ERR;
7870 /* Validate paretheses around function arguments */
7871 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
7872 const char *p = pc->p + bestLen;
7873 int len = pc->len - bestLen;
7875 while (len && isspace(UCHAR(*p))) {
7876 len--;
7877 p++;
7879 if (*p != '(') {
7880 return JIM_ERR;
7883 pc->tstart = pc->p;
7884 pc->tend = pc->p + bestLen - 1;
7885 pc->p += bestLen;
7886 pc->len -= bestLen;
7887 pc->tline = pc->linenr;
7889 pc->tt = bestIdx;
7890 return JIM_OK;
7893 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
7895 return &Jim_ExprOperators[opcode];
7898 const char *jim_tt_name(int type)
7900 static const char * const tt_names[JIM_TT_EXPR_OP] =
7901 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", "INT",
7902 "DBL", "$()" };
7903 if (type < JIM_TT_EXPR_OP) {
7904 return tt_names[type];
7906 else {
7907 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
7908 static char buf[20];
7910 if (op && op->name) {
7911 return op->name;
7913 sprintf(buf, "(%d)", type);
7914 return buf;
7918 /* -----------------------------------------------------------------------------
7919 * Expression Object
7920 * ---------------------------------------------------------------------------*/
7921 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7922 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7923 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7925 static const Jim_ObjType exprObjType = {
7926 "expression",
7927 FreeExprInternalRep,
7928 DupExprInternalRep,
7929 NULL,
7930 JIM_TYPE_REFERENCES,
7933 /* Expr bytecode structure */
7934 typedef struct ExprByteCode
7936 int len; /* Length as number of tokens. */
7937 ScriptToken *token; /* Tokens array. */
7938 int inUse; /* Used for sharing. */
7939 } ExprByteCode;
7941 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
7943 int i;
7945 for (i = 0; i < expr->len; i++) {
7946 Jim_DecrRefCount(interp, expr->token[i].objPtr);
7948 Jim_Free(expr->token);
7949 Jim_Free(expr);
7952 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7954 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
7956 if (expr) {
7957 if (--expr->inUse != 0) {
7958 return;
7961 ExprFreeByteCode(interp, expr);
7965 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7967 JIM_NOTUSED(interp);
7968 JIM_NOTUSED(srcPtr);
7970 /* Just returns an simple string. */
7971 dupPtr->typePtr = NULL;
7974 /* Check if an expr program looks correct. */
7975 static int ExprCheckCorrectness(ExprByteCode * expr)
7977 int i;
7978 int stacklen = 0;
7979 int ternary = 0;
7981 /* Try to check if there are stack underflows,
7982 * and make sure at the end of the program there is
7983 * a single result on the stack. */
7984 for (i = 0; i < expr->len; i++) {
7985 ScriptToken *t = &expr->token[i];
7986 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
7988 if (op) {
7989 stacklen -= op->arity;
7990 if (stacklen < 0) {
7991 break;
7993 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
7994 ternary++;
7996 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
7997 ternary--;
8001 /* All operations and operands add one to the stack */
8002 stacklen++;
8004 if (stacklen != 1 || ternary != 0) {
8005 return JIM_ERR;
8007 return JIM_OK;
8010 /* This procedure converts every occurrence of || and && opereators
8011 * in lazy unary versions.
8013 * a b || is converted into:
8015 * a <offset> |L b |R
8017 * a b && is converted into:
8019 * a <offset> &L b &R
8021 * "|L" checks if 'a' is true:
8022 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8023 * the opcode just after |R.
8024 * 2) if it is false does nothing.
8025 * "|R" checks if 'b' is true:
8026 * 1) if it is true pushes 1, otherwise pushes 0.
8028 * "&L" checks if 'a' is true:
8029 * 1) if it is true does nothing.
8030 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8031 * the opcode just after &R
8032 * "&R" checks if 'a' is true:
8033 * if it is true pushes 1, otherwise pushes 0.
8035 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8037 int i;
8039 int leftindex, arity, offset;
8041 /* Search for the end of the first operator */
8042 leftindex = expr->len - 1;
8044 arity = 1;
8045 while (arity) {
8046 ScriptToken *tt = &expr->token[leftindex];
8048 if (tt->type >= JIM_TT_EXPR_OP) {
8049 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8051 arity--;
8052 if (--leftindex < 0) {
8053 return JIM_ERR;
8056 leftindex++;
8058 /* Move them up */
8059 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8060 sizeof(*expr->token) * (expr->len - leftindex));
8061 expr->len += 2;
8062 offset = (expr->len - leftindex) - 1;
8064 /* Now we rely on the fact the the left and right version have opcodes
8065 * 1 and 2 after the main opcode respectively
8067 expr->token[leftindex + 1].type = t->type + 1;
8068 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8070 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8071 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8073 /* Now add the 'R' operator */
8074 expr->token[expr->len].objPtr = interp->emptyObj;
8075 expr->token[expr->len].type = t->type + 2;
8076 expr->len++;
8078 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8079 for (i = leftindex - 1; i > 0; i--) {
8080 if (JimExprOperatorInfoByOpcode(expr->token[i].type)->lazy == LAZY_LEFT) {
8081 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8082 JimWideValue(expr->token[i - 1].objPtr) += 2;
8086 return JIM_OK;
8089 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8091 struct ScriptToken *token = &expr->token[expr->len];
8093 if (JimExprOperatorInfoByOpcode(t->type)->lazy == LAZY_OP) {
8094 return ExprAddLazyOperator(interp, expr, t);
8096 else {
8097 token->objPtr = interp->emptyObj;
8098 token->type = t->type;
8099 expr->len++;
8100 return JIM_OK;
8105 * Returns the index of the COLON_LEFT to the left of 'right_index'
8106 * taking into account nesting.
8108 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8110 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8112 int ternary_count = 1;
8114 right_index--;
8116 while (right_index > 1) {
8117 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8118 ternary_count--;
8120 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8121 ternary_count++;
8123 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8124 return right_index;
8126 right_index--;
8129 /*notreached*/
8130 return -1;
8134 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8136 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8137 * Otherwise returns 0.
8139 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8141 int i = right_index - 1;
8142 int ternary_count = 1;
8144 while (i > 1) {
8145 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8146 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8147 *prev_right_index = i - 2;
8148 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8149 return 1;
8152 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8153 if (ternary_count == 0) {
8154 return 0;
8156 ternary_count++;
8158 i--;
8160 return 0;
8164 * ExprTernaryReorderExpression description
8165 * ========================================
8167 * ?: is right-to-left associative which doesn't work with the stack-based
8168 * expression engine. The fix is to reorder the bytecode.
8170 * The expression:
8172 * expr 1?2:0?3:4
8174 * Has initial bytecode:
8176 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8177 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8179 * The fix involves simulating this expression instead:
8181 * expr 1?2:(0?3:4)
8183 * With the following bytecode:
8185 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8186 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8188 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8189 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8190 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8191 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8193 * ExprTernaryReorderExpression works thus as follows :
8194 * - start from the end of the stack
8195 * - while walking towards the beginning of the stack
8196 * if token=JIM_EXPROP_COLON_RIGHT then
8197 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8198 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8199 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8200 * if all found then
8201 * perform the rotation
8202 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8203 * end if
8204 * end if
8206 * Note: care has to be taken for nested ternary constructs!!!
8208 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8210 int i;
8212 for (i = expr->len - 1; i > 1; i--) {
8213 int prev_right_index;
8214 int prev_left_index;
8215 int j;
8216 ScriptToken tmp;
8218 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8219 continue;
8222 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8223 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8224 continue;
8228 ** rotate tokens down
8230 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8231 ** | | |
8232 ** | V V
8233 ** | [...] : ...
8234 ** | | |
8235 ** | V V
8236 ** | [...] : ...
8237 ** | | |
8238 ** | V V
8239 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8241 tmp = expr->token[prev_right_index];
8242 for (j = prev_right_index; j < i; j++) {
8243 expr->token[j] = expr->token[j + 1];
8245 expr->token[i] = tmp;
8247 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8249 * This is 'colon left increment' = i - prev_right_index
8251 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8252 * [prev_left_index-1] : skip_count
8255 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8257 /* Adjust for i-- in the loop */
8258 i++;
8262 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist)
8264 Jim_Stack stack;
8265 ExprByteCode *expr;
8266 int ok = 1;
8267 int i;
8268 int prevtt = JIM_TT_NONE;
8269 int have_ternary = 0;
8271 /* -1 for EOL */
8272 int count = tokenlist->count - 1;
8274 expr = Jim_Alloc(sizeof(*expr));
8275 expr->inUse = 1;
8276 expr->len = 0;
8278 Jim_InitStack(&stack);
8280 /* Need extra bytecodes for lazy operators.
8281 * Also check for the ternary operator
8283 for (i = 0; i < tokenlist->count; i++) {
8284 ParseToken *t = &tokenlist->list[i];
8286 if (JimExprOperatorInfoByOpcode(t->type)->lazy == LAZY_OP) {
8287 count += 2;
8288 /* Ternary is a lazy op but also needs reordering */
8289 if (t->type == JIM_EXPROP_TERNARY) {
8290 have_ternary = 1;
8295 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8297 for (i = 0; i < tokenlist->count && ok; i++) {
8298 ParseToken *t = &tokenlist->list[i];
8300 /* Next token will be stored here */
8301 struct ScriptToken *token = &expr->token[expr->len];
8303 if (t->type == JIM_TT_EOL) {
8304 break;
8307 switch (t->type) {
8308 case JIM_TT_STR:
8309 case JIM_TT_ESC:
8310 case JIM_TT_VAR:
8311 case JIM_TT_DICTSUGAR:
8312 case JIM_TT_EXPRSUGAR:
8313 case JIM_TT_CMD:
8314 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8315 token->type = t->type;
8316 expr->len++;
8317 break;
8319 case JIM_TT_EXPR_INT:
8320 token->objPtr = Jim_NewIntObj(interp, strtoull(t->token, NULL, 0));
8321 token->type = t->type;
8322 expr->len++;
8323 break;
8325 case JIM_TT_EXPR_DOUBLE:
8326 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, NULL));
8327 token->type = t->type;
8328 expr->len++;
8329 break;
8331 case JIM_TT_SUBEXPR_START:
8332 Jim_StackPush(&stack, t);
8333 prevtt = JIM_TT_NONE;
8334 continue;
8336 case JIM_TT_SUBEXPR_END:
8337 ok = 0;
8338 while (Jim_StackLen(&stack)) {
8339 ParseToken *tt = Jim_StackPop(&stack);
8341 if (tt->type == JIM_TT_SUBEXPR_START) {
8342 ok = 1;
8343 break;
8346 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8347 goto err;
8350 if (!ok) {
8351 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8352 goto err;
8354 break;
8357 default:{
8358 /* Must be an operator */
8359 const struct Jim_ExprOperator *op;
8360 ParseToken *tt;
8362 /* Convert -/+ to unary minus or unary plus if necessary */
8363 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
8364 if (t->type == JIM_EXPROP_SUB) {
8365 t->type = JIM_EXPROP_UNARYMINUS;
8367 else if (t->type == JIM_EXPROP_ADD) {
8368 t->type = JIM_EXPROP_UNARYPLUS;
8372 op = JimExprOperatorInfoByOpcode(t->type);
8374 /* Now handle precedence */
8375 while ((tt = Jim_StackPeek(&stack)) != NULL) {
8376 const struct Jim_ExprOperator *tt_op =
8377 JimExprOperatorInfoByOpcode(tt->type);
8379 /* Note that right-to-left associativity of ?: operator is handled later */
8381 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
8382 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8383 ok = 0;
8384 goto err;
8386 Jim_StackPop(&stack);
8388 else {
8389 break;
8392 Jim_StackPush(&stack, t);
8393 break;
8396 prevtt = t->type;
8399 /* Reduce any remaining subexpr */
8400 while (Jim_StackLen(&stack)) {
8401 ParseToken *tt = Jim_StackPop(&stack);
8403 if (tt->type == JIM_TT_SUBEXPR_START) {
8404 ok = 0;
8405 Jim_SetResultString(interp, "Missing close parenthesis", -1);
8406 goto err;
8408 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8409 ok = 0;
8410 goto err;
8414 if (have_ternary) {
8415 ExprTernaryReorderExpression(interp, expr);
8418 err:
8419 /* Free the stack used for the compilation. */
8420 Jim_FreeStack(&stack);
8422 for (i = 0; i < expr->len; i++) {
8423 Jim_IncrRefCount(expr->token[i].objPtr);
8426 if (!ok) {
8427 ExprFreeByteCode(interp, expr);
8428 return NULL;
8431 return expr;
8435 /* This method takes the string representation of an expression
8436 * and generates a program for the Expr's stack-based VM. */
8437 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
8439 int exprTextLen;
8440 const char *exprText;
8441 struct JimParserCtx parser;
8442 struct ExprByteCode *expr;
8443 ParseTokenList tokenlist;
8444 int rc = JIM_ERR;
8446 exprText = Jim_GetString(objPtr, &exprTextLen);
8448 /* Initially tokenise the expression into tokenlist */
8449 ScriptTokenListInit(&tokenlist);
8451 JimParserInit(&parser, exprText, exprTextLen, 0);
8452 while (!parser.eof) {
8453 if (JimParseExpression(&parser) != JIM_OK) {
8454 ScriptTokenListFree(&tokenlist);
8455 invalidexpr:
8456 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
8457 expr = NULL;
8458 goto err;
8461 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
8462 parser.tline);
8465 #ifdef DEBUG_SHOW_EXPR_TOKENS
8467 int i;
8468 printf("==== Expr Tokens ====\n");
8469 for (i = 0; i < tokenlist.count; i++) {
8470 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
8471 tokenlist.list[i].len, tokenlist.list[i].token);
8474 #endif
8476 /* Now create the expression bytecode from the tokenlist */
8477 expr = ExprCreateByteCode(interp, &tokenlist);
8479 /* No longer need the token list */
8480 ScriptTokenListFree(&tokenlist);
8482 if (!expr) {
8483 goto err;
8486 #ifdef DEBUG_SHOW_EXPR
8488 int i;
8490 printf("==== Expr ====\n");
8491 for (i = 0; i < expr->len; i++) {
8492 ScriptToken *t = &expr->token[i];
8494 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
8497 #endif
8499 /* Check program correctness. */
8500 if (ExprCheckCorrectness(expr) != JIM_OK) {
8501 ExprFreeByteCode(interp, expr);
8502 goto invalidexpr;
8505 rc = JIM_OK;
8507 err:
8508 /* Free the old internal rep and set the new one. */
8509 Jim_FreeIntRep(interp, objPtr);
8510 Jim_SetIntRepPtr(objPtr, expr);
8511 objPtr->typePtr = &exprObjType;
8512 return rc;
8515 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
8517 if (objPtr->typePtr != &exprObjType) {
8518 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
8519 return NULL;
8522 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
8525 /* -----------------------------------------------------------------------------
8526 * Expressions evaluation.
8527 * Jim uses a specialized stack-based virtual machine for expressions,
8528 * that takes advantage of the fact that expr's operators
8529 * can't be redefined.
8531 * Jim_EvalExpression() uses the bytecode compiled by
8532 * SetExprFromAny() method of the "expression" object.
8534 * On success a Tcl Object containing the result of the evaluation
8535 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
8536 * returned.
8537 * On error the function returns a retcode != to JIM_OK and set a suitable
8538 * error on the interp.
8539 * ---------------------------------------------------------------------------*/
8540 #define JIM_EE_STATICSTACK_LEN 10
8542 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
8544 ExprByteCode *expr;
8545 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
8546 int i;
8547 int retcode = JIM_OK;
8548 struct JimExprState e;
8550 expr = JimGetExpression(interp, exprObjPtr);
8551 if (!expr) {
8552 return JIM_ERR; /* error in expression. */
8555 #ifdef JIM_OPTIMIZATION
8556 /* Check for one of the following common expressions used by while/for
8558 * CONST
8559 * $a
8560 * !$a
8561 * $a < CONST, $a < $b
8562 * $a <= CONST, $a <= $b
8563 * $a > CONST, $a > $b
8564 * $a >= CONST, $a >= $b
8565 * $a != CONST, $a != $b
8566 * $a == CONST, $a == $b
8569 Jim_Obj *objPtr;
8571 /* STEP 1 -- Check if there are the conditions to run the specialized
8572 * version of while */
8574 switch (expr->len) {
8575 case 1:
8576 if (expr->token[0].type == JIM_TT_EXPR_INT) {
8577 *exprResultPtrPtr = expr->token[0].objPtr;
8578 Jim_IncrRefCount(*exprResultPtrPtr);
8579 return JIM_OK;
8581 if (expr->token[0].type == JIM_TT_VAR) {
8582 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
8583 if (objPtr) {
8584 *exprResultPtrPtr = objPtr;
8585 Jim_IncrRefCount(*exprResultPtrPtr);
8586 return JIM_OK;
8589 break;
8591 case 2:
8592 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
8593 jim_wide wideValue;
8595 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8596 if (objPtr && JimIsWide(objPtr)
8597 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
8598 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
8599 Jim_IncrRefCount(*exprResultPtrPtr);
8600 return JIM_OK;
8603 break;
8605 case 3:
8606 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
8607 || expr->token[1].type == JIM_TT_VAR)) {
8608 switch (expr->token[2].type) {
8609 case JIM_EXPROP_LT:
8610 case JIM_EXPROP_LTE:
8611 case JIM_EXPROP_GT:
8612 case JIM_EXPROP_GTE:
8613 case JIM_EXPROP_NUMEQ:
8614 case JIM_EXPROP_NUMNE:{
8615 /* optimise ok */
8616 jim_wide wideValueA;
8617 jim_wide wideValueB;
8619 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8620 if (objPtr && JimIsWide(objPtr)
8621 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
8622 if (expr->token[1].type == JIM_TT_VAR) {
8623 objPtr =
8624 Jim_GetVariable(interp, expr->token[1].objPtr,
8625 JIM_NONE);
8627 else {
8628 objPtr = expr->token[1].objPtr;
8630 if (objPtr && JimIsWide(objPtr)
8631 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
8632 int cmpRes;
8634 switch (expr->token[2].type) {
8635 case JIM_EXPROP_LT:
8636 cmpRes = wideValueA < wideValueB;
8637 break;
8638 case JIM_EXPROP_LTE:
8639 cmpRes = wideValueA <= wideValueB;
8640 break;
8641 case JIM_EXPROP_GT:
8642 cmpRes = wideValueA > wideValueB;
8643 break;
8644 case JIM_EXPROP_GTE:
8645 cmpRes = wideValueA >= wideValueB;
8646 break;
8647 case JIM_EXPROP_NUMEQ:
8648 cmpRes = wideValueA == wideValueB;
8649 break;
8650 case JIM_EXPROP_NUMNE:
8651 cmpRes = wideValueA != wideValueB;
8652 break;
8653 default: /*notreached */
8654 cmpRes = 0;
8656 *exprResultPtrPtr =
8657 cmpRes ? interp->trueObj : interp->falseObj;
8658 Jim_IncrRefCount(*exprResultPtrPtr);
8659 return JIM_OK;
8665 break;
8668 #endif
8670 /* In order to avoid that the internal repr gets freed due to
8671 * shimmering of the exprObjPtr's object, we make the internal rep
8672 * shared. */
8673 expr->inUse++;
8675 /* The stack-based expr VM itself */
8677 /* Stack allocation. Expr programs have the feature that
8678 * a program of length N can't require a stack longer than
8679 * N. */
8680 if (expr->len > JIM_EE_STATICSTACK_LEN)
8681 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
8682 else
8683 e.stack = staticStack;
8685 e.stacklen = 0;
8687 /* Execute every instruction */
8688 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
8689 Jim_Obj *objPtr;
8691 switch (expr->token[i].type) {
8692 case JIM_TT_EXPR_INT:
8693 case JIM_TT_EXPR_DOUBLE:
8694 case JIM_TT_STR:
8695 ExprPush(&e, expr->token[i].objPtr);
8696 break;
8698 case JIM_TT_VAR:
8699 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
8700 if (objPtr) {
8701 ExprPush(&e, objPtr);
8703 else {
8704 retcode = JIM_ERR;
8706 break;
8708 case JIM_TT_DICTSUGAR:
8709 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
8710 if (objPtr) {
8711 ExprPush(&e, objPtr);
8713 else {
8714 retcode = JIM_ERR;
8716 break;
8718 case JIM_TT_ESC:
8719 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
8720 if (retcode == JIM_OK) {
8721 ExprPush(&e, objPtr);
8723 break;
8725 case JIM_TT_CMD:
8726 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
8727 if (retcode == JIM_OK) {
8728 ExprPush(&e, Jim_GetResult(interp));
8730 break;
8732 default:{
8733 /* Find and execute the operation */
8734 e.skip = 0;
8735 e.opcode = expr->token[i].type;
8737 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
8738 /* Skip some opcodes if necessary */
8739 i += e.skip;
8740 continue;
8745 expr->inUse--;
8747 if (retcode == JIM_OK) {
8748 *exprResultPtrPtr = ExprPop(&e);
8750 else {
8751 for (i = 0; i < e.stacklen; i++) {
8752 Jim_DecrRefCount(interp, e.stack[i]);
8755 if (e.stack != staticStack) {
8756 Jim_Free(e.stack);
8758 return retcode;
8761 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
8763 int retcode;
8764 jim_wide wideValue;
8765 double doubleValue;
8766 Jim_Obj *exprResultPtr;
8768 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
8769 if (retcode != JIM_OK)
8770 return retcode;
8772 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
8773 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
8774 Jim_DecrRefCount(interp, exprResultPtr);
8775 return JIM_ERR;
8777 else {
8778 Jim_DecrRefCount(interp, exprResultPtr);
8779 *boolPtr = doubleValue != 0;
8780 return JIM_OK;
8783 *boolPtr = wideValue != 0;
8785 Jim_DecrRefCount(interp, exprResultPtr);
8786 return JIM_OK;
8789 /* -----------------------------------------------------------------------------
8790 * ScanFormat String Object
8791 * ---------------------------------------------------------------------------*/
8793 /* This Jim_Obj will held a parsed representation of a format string passed to
8794 * the Jim_ScanString command. For error diagnostics, the scanformat string has
8795 * to be parsed in its entirely first and then, if correct, can be used for
8796 * scanning. To avoid endless re-parsing, the parsed representation will be
8797 * stored in an internal representation and re-used for performance reason. */
8799 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
8800 * scanformat string. This part will later be used to extract information
8801 * out from the string to be parsed by Jim_ScanString */
8803 typedef struct ScanFmtPartDescr
8805 char type; /* Type of conversion (e.g. c, d, f) */
8806 char modifier; /* Modify type (e.g. l - long, h - short */
8807 size_t width; /* Maximal width of input to be converted */
8808 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
8809 char *arg; /* Specification of a CHARSET conversion */
8810 char *prefix; /* Prefix to be scanned literally before conversion */
8811 } ScanFmtPartDescr;
8813 /* The ScanFmtStringObj will hold the internal representation of a scanformat
8814 * string parsed and separated in part descriptions. Furthermore it contains
8815 * the original string representation of the scanformat string to allow for
8816 * fast update of the Jim_Obj's string representation part.
8818 * As an add-on the internal object representation adds some scratch pad area
8819 * for usage by Jim_ScanString to avoid endless allocating and freeing of
8820 * memory for purpose of string scanning.
8822 * The error member points to a static allocated string in case of a mal-
8823 * formed scanformat string or it contains '0' (NULL) in case of a valid
8824 * parse representation.
8826 * The whole memory of the internal representation is allocated as a single
8827 * area of memory that will be internally separated. So freeing and duplicating
8828 * of such an object is cheap */
8830 typedef struct ScanFmtStringObj
8832 jim_wide size; /* Size of internal repr in bytes */
8833 char *stringRep; /* Original string representation */
8834 size_t count; /* Number of ScanFmtPartDescr contained */
8835 size_t convCount; /* Number of conversions that will assign */
8836 size_t maxPos; /* Max position index if XPG3 is used */
8837 const char *error; /* Ptr to error text (NULL if no error */
8838 char *scratch; /* Some scratch pad used by Jim_ScanString */
8839 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
8840 } ScanFmtStringObj;
8843 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8844 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8845 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
8847 static const Jim_ObjType scanFmtStringObjType = {
8848 "scanformatstring",
8849 FreeScanFmtInternalRep,
8850 DupScanFmtInternalRep,
8851 UpdateStringOfScanFmt,
8852 JIM_TYPE_NONE,
8855 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8857 JIM_NOTUSED(interp);
8858 Jim_Free((char *)objPtr->internalRep.ptr);
8859 objPtr->internalRep.ptr = 0;
8862 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8864 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
8865 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
8867 JIM_NOTUSED(interp);
8868 memcpy(newVec, srcPtr->internalRep.ptr, size);
8869 dupPtr->internalRep.ptr = newVec;
8870 dupPtr->typePtr = &scanFmtStringObjType;
8873 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
8875 char *bytes = ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep;
8877 objPtr->bytes = Jim_StrDup(bytes);
8878 objPtr->length = strlen(bytes);
8881 /* SetScanFmtFromAny will parse a given string and create the internal
8882 * representation of the format specification. In case of an error
8883 * the error data member of the internal representation will be set
8884 * to an descriptive error text and the function will be left with
8885 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
8886 * specification */
8888 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
8890 ScanFmtStringObj *fmtObj;
8891 char *buffer;
8892 int maxCount, i, approxSize, lastPos = -1;
8893 const char *fmt = objPtr->bytes;
8894 int maxFmtLen = objPtr->length;
8895 const char *fmtEnd = fmt + maxFmtLen;
8896 int curr;
8898 Jim_FreeIntRep(interp, objPtr);
8899 /* Count how many conversions could take place maximally */
8900 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
8901 if (fmt[i] == '%')
8902 ++maxCount;
8903 /* Calculate an approximation of the memory necessary */
8904 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
8905 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
8906 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
8907 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
8908 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
8909 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
8910 +1; /* safety byte */
8911 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
8912 memset(fmtObj, 0, approxSize);
8913 fmtObj->size = approxSize;
8914 fmtObj->maxPos = 0;
8915 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
8916 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
8917 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
8918 buffer = fmtObj->stringRep + maxFmtLen + 1;
8919 objPtr->internalRep.ptr = fmtObj;
8920 objPtr->typePtr = &scanFmtStringObjType;
8921 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
8922 int width = 0, skip;
8923 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
8925 fmtObj->count++;
8926 descr->width = 0; /* Assume width unspecified */
8927 /* Overread and store any "literal" prefix */
8928 if (*fmt != '%' || fmt[1] == '%') {
8929 descr->type = 0;
8930 descr->prefix = &buffer[i];
8931 for (; fmt < fmtEnd; ++fmt) {
8932 if (*fmt == '%') {
8933 if (fmt[1] != '%')
8934 break;
8935 ++fmt;
8937 buffer[i++] = *fmt;
8939 buffer[i++] = 0;
8941 /* Skip the conversion introducing '%' sign */
8942 ++fmt;
8943 /* End reached due to non-conversion literal only? */
8944 if (fmt >= fmtEnd)
8945 goto done;
8946 descr->pos = 0; /* Assume "natural" positioning */
8947 if (*fmt == '*') {
8948 descr->pos = -1; /* Okay, conversion will not be assigned */
8949 ++fmt;
8951 else
8952 fmtObj->convCount++; /* Otherwise count as assign-conversion */
8953 /* Check if next token is a number (could be width or pos */
8954 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
8955 fmt += skip;
8956 /* Was the number a XPG3 position specifier? */
8957 if (descr->pos != -1 && *fmt == '$') {
8958 int prev;
8960 ++fmt;
8961 descr->pos = width;
8962 width = 0;
8963 /* Look if "natural" postioning and XPG3 one was mixed */
8964 if ((lastPos == 0 && descr->pos > 0)
8965 || (lastPos > 0 && descr->pos == 0)) {
8966 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
8967 return JIM_ERR;
8969 /* Look if this position was already used */
8970 for (prev = 0; prev < curr; ++prev) {
8971 if (fmtObj->descr[prev].pos == -1)
8972 continue;
8973 if (fmtObj->descr[prev].pos == descr->pos) {
8974 fmtObj->error =
8975 "variable is assigned by multiple \"%n$\" conversion specifiers";
8976 return JIM_ERR;
8979 /* Try to find a width after the XPG3 specifier */
8980 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
8981 descr->width = width;
8982 fmt += skip;
8984 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
8985 fmtObj->maxPos = descr->pos;
8987 else {
8988 /* Number was not a XPG3, so it has to be a width */
8989 descr->width = width;
8992 /* If positioning mode was undetermined yet, fix this */
8993 if (lastPos == -1)
8994 lastPos = descr->pos;
8995 /* Handle CHARSET conversion type ... */
8996 if (*fmt == '[') {
8997 int swapped = 1, beg = i, end, j;
8999 descr->type = '[';
9000 descr->arg = &buffer[i];
9001 ++fmt;
9002 if (*fmt == '^')
9003 buffer[i++] = *fmt++;
9004 if (*fmt == ']')
9005 buffer[i++] = *fmt++;
9006 while (*fmt && *fmt != ']')
9007 buffer[i++] = *fmt++;
9008 if (*fmt != ']') {
9009 fmtObj->error = "unmatched [ in format string";
9010 return JIM_ERR;
9012 end = i;
9013 buffer[i++] = 0;
9014 /* In case a range fence was given "backwards", swap it */
9015 while (swapped) {
9016 swapped = 0;
9017 for (j = beg + 1; j < end - 1; ++j) {
9018 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9019 char tmp = buffer[j - 1];
9021 buffer[j - 1] = buffer[j + 1];
9022 buffer[j + 1] = tmp;
9023 swapped = 1;
9028 else {
9029 /* Remember any valid modifier if given */
9030 if (strchr("hlL", *fmt) != 0)
9031 descr->modifier = tolower((int)*fmt++);
9033 descr->type = *fmt;
9034 if (strchr("efgcsndoxui", *fmt) == 0) {
9035 fmtObj->error = "bad scan conversion character";
9036 return JIM_ERR;
9038 else if (*fmt == 'c' && descr->width != 0) {
9039 fmtObj->error = "field width may not be specified in %c " "conversion";
9040 return JIM_ERR;
9042 else if (*fmt == 'u' && descr->modifier == 'l') {
9043 fmtObj->error = "unsigned wide not supported";
9044 return JIM_ERR;
9047 curr++;
9049 done:
9050 return JIM_OK;
9053 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9055 #define FormatGetCnvCount(_fo_) \
9056 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9057 #define FormatGetMaxPos(_fo_) \
9058 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9059 #define FormatGetError(_fo_) \
9060 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9062 /* JimScanAString is used to scan an unspecified string that ends with
9063 * next WS, or a string that is specified via a charset.
9066 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9068 char *buffer = Jim_StrDup(str);
9069 char *p = buffer;
9071 while (*str) {
9072 int c;
9073 int n;
9075 if (!sdescr && isspace(UCHAR(*str)))
9076 break; /* EOS via WS if unspecified */
9078 n = utf8_tounicode(str, &c);
9079 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9080 break;
9081 while (n--)
9082 *p++ = *str++;
9084 *p = 0;
9085 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9088 /* ScanOneEntry will scan one entry out of the string passed as argument.
9089 * It use the sscanf() function for this task. After extracting and
9090 * converting of the value, the count of scanned characters will be
9091 * returned of -1 in case of no conversion tool place and string was
9092 * already scanned thru */
9094 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9095 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9097 const char *tok;
9098 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9099 size_t scanned = 0;
9100 size_t anchor = pos;
9101 int i;
9102 Jim_Obj *tmpObj = NULL;
9104 /* First pessimistically assume, we will not scan anything :-) */
9105 *valObjPtr = 0;
9106 if (descr->prefix) {
9107 /* There was a prefix given before the conversion, skip it and adjust
9108 * the string-to-be-parsed accordingly */
9109 /* XXX: Should be checking strLen, not str[pos] */
9110 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9111 /* If prefix require, skip WS */
9112 if (isspace(UCHAR(descr->prefix[i])))
9113 while (pos < strLen && isspace(UCHAR(str[pos])))
9114 ++pos;
9115 else if (descr->prefix[i] != str[pos])
9116 break; /* Prefix do not match here, leave the loop */
9117 else
9118 ++pos; /* Prefix matched so far, next round */
9120 if (pos >= strLen) {
9121 return -1; /* All of str consumed: EOF condition */
9123 else if (descr->prefix[i] != 0)
9124 return 0; /* Not whole prefix consumed, no conversion possible */
9126 /* For all but following conversion, skip leading WS */
9127 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9128 while (isspace(UCHAR(str[pos])))
9129 ++pos;
9130 /* Determine how much skipped/scanned so far */
9131 scanned = pos - anchor;
9133 /* %c is a special, simple case. no width */
9134 if (descr->type == 'n') {
9135 /* Return pseudo conversion means: how much scanned so far? */
9136 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9138 else if (pos >= strLen) {
9139 /* Cannot scan anything, as str is totally consumed */
9140 return -1;
9142 else if (descr->type == 'c') {
9143 int c;
9144 scanned += utf8_tounicode(&str[pos], &c);
9145 *valObjPtr = Jim_NewIntObj(interp, c);
9146 return scanned;
9148 else {
9149 /* Processing of conversions follows ... */
9150 if (descr->width > 0) {
9151 /* Do not try to scan as fas as possible but only the given width.
9152 * To ensure this, we copy the part that should be scanned. */
9153 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9154 size_t tLen = descr->width > sLen ? sLen : descr->width;
9156 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9157 tok = tmpObj->bytes;
9159 else {
9160 /* As no width was given, simply refer to the original string */
9161 tok = &str[pos];
9163 switch (descr->type) {
9164 case 'd':
9165 case 'o':
9166 case 'x':
9167 case 'u':
9168 case 'i':{
9169 char *endp; /* Position where the number finished */
9170 jim_wide w;
9172 int base = descr->type == 'o' ? 8
9173 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9175 /* Try to scan a number with the given base */
9176 w = strtoull(tok, &endp, base);
9177 if (endp == tok && base == 0) {
9178 /* If scanning failed, and base was undetermined, simply
9179 * put it to 10 and try once more. This should catch the
9180 * case where %i begin to parse a number prefix (e.g.
9181 * '0x' but no further digits follows. This will be
9182 * handled as a ZERO followed by a char 'x' by Tcl */
9183 w = strtoull(tok, &endp, 10);
9186 if (endp != tok) {
9187 /* There was some number sucessfully scanned! */
9188 *valObjPtr = Jim_NewIntObj(interp, w);
9190 /* Adjust the number-of-chars scanned so far */
9191 scanned += endp - tok;
9193 else {
9194 /* Nothing was scanned. We have to determine if this
9195 * happened due to e.g. prefix mismatch or input str
9196 * exhausted */
9197 scanned = *tok ? 0 : -1;
9199 break;
9201 case 's':
9202 case '[':{
9203 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9204 scanned += Jim_Length(*valObjPtr);
9205 break;
9207 case 'e':
9208 case 'f':
9209 case 'g':{
9210 char *endp;
9211 double value = strtod(tok, &endp);
9213 if (endp != tok) {
9214 /* There was some number sucessfully scanned! */
9215 *valObjPtr = Jim_NewDoubleObj(interp, value);
9216 /* Adjust the number-of-chars scanned so far */
9217 scanned += endp - tok;
9219 else {
9220 /* Nothing was scanned. We have to determine if this
9221 * happened due to e.g. prefix mismatch or input str
9222 * exhausted */
9223 scanned = *tok ? 0 : -1;
9225 break;
9228 /* If a substring was allocated (due to pre-defined width) do not
9229 * forget to free it */
9230 if (tmpObj) {
9231 Jim_FreeNewObj(interp, tmpObj);
9234 return scanned;
9237 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9238 * string and returns all converted (and not ignored) values in a list back
9239 * to the caller. If an error occured, a NULL pointer will be returned */
9241 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9243 size_t i, pos;
9244 int scanned = 1;
9245 const char *str = Jim_String(strObjPtr);
9246 int strLen = Jim_Utf8Length(interp, strObjPtr);
9247 Jim_Obj *resultList = 0;
9248 Jim_Obj **resultVec = 0;
9249 int resultc;
9250 Jim_Obj *emptyStr = 0;
9251 ScanFmtStringObj *fmtObj;
9253 /* This should never happen. The format object should already be of the correct type */
9254 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, interp, "Jim_ScanString() for non-scan format"));
9256 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9257 /* Check if format specification was valid */
9258 if (fmtObj->error != 0) {
9259 if (flags & JIM_ERRMSG)
9260 Jim_SetResultString(interp, fmtObj->error, -1);
9261 return 0;
9263 /* Allocate a new "shared" empty string for all unassigned conversions */
9264 emptyStr = Jim_NewEmptyStringObj(interp);
9265 Jim_IncrRefCount(emptyStr);
9266 /* Create a list and fill it with empty strings up to max specified XPG3 */
9267 resultList = Jim_NewListObj(interp, 0, 0);
9268 if (fmtObj->maxPos > 0) {
9269 for (i = 0; i < fmtObj->maxPos; ++i)
9270 Jim_ListAppendElement(interp, resultList, emptyStr);
9271 JimListGetElements(interp, resultList, &resultc, &resultVec);
9273 /* Now handle every partial format description */
9274 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9275 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9276 Jim_Obj *value = 0;
9278 /* Only last type may be "literal" w/o conversion - skip it! */
9279 if (descr->type == 0)
9280 continue;
9281 /* As long as any conversion could be done, we will proceed */
9282 if (scanned > 0)
9283 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9284 /* In case our first try results in EOF, we will leave */
9285 if (scanned == -1 && i == 0)
9286 goto eof;
9287 /* Advance next pos-to-be-scanned for the amount scanned already */
9288 pos += scanned;
9290 /* value == 0 means no conversion took place so take empty string */
9291 if (value == 0)
9292 value = Jim_NewEmptyStringObj(interp);
9293 /* If value is a non-assignable one, skip it */
9294 if (descr->pos == -1) {
9295 Jim_FreeNewObj(interp, value);
9297 else if (descr->pos == 0)
9298 /* Otherwise append it to the result list if no XPG3 was given */
9299 Jim_ListAppendElement(interp, resultList, value);
9300 else if (resultVec[descr->pos - 1] == emptyStr) {
9301 /* But due to given XPG3, put the value into the corr. slot */
9302 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9303 Jim_IncrRefCount(value);
9304 resultVec[descr->pos - 1] = value;
9306 else {
9307 /* Otherwise, the slot was already used - free obj and ERROR */
9308 Jim_FreeNewObj(interp, value);
9309 goto err;
9312 Jim_DecrRefCount(interp, emptyStr);
9313 return resultList;
9314 eof:
9315 Jim_DecrRefCount(interp, emptyStr);
9316 Jim_FreeNewObj(interp, resultList);
9317 return (Jim_Obj *)EOF;
9318 err:
9319 Jim_DecrRefCount(interp, emptyStr);
9320 Jim_FreeNewObj(interp, resultList);
9321 return 0;
9324 /* -----------------------------------------------------------------------------
9325 * Pseudo Random Number Generation
9326 * ---------------------------------------------------------------------------*/
9327 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
9329 /* Initialize the sbox with the numbers from 0 to 255 */
9330 static void JimPrngInit(Jim_Interp *interp)
9332 #define PRNG_SEED_SIZE 256
9333 int i;
9334 unsigned int *seed;
9335 time_t t = time(NULL);
9337 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9339 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9340 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9341 seed[i] = (rand() ^ t ^ clock());
9343 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9344 Jim_Free(seed);
9347 /* Generates N bytes of random data */
9348 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9350 Jim_PrngState *prng;
9351 unsigned char *destByte = (unsigned char *)dest;
9352 unsigned int si, sj, x;
9354 /* initialization, only needed the first time */
9355 if (interp->prngState == NULL)
9356 JimPrngInit(interp);
9357 prng = interp->prngState;
9358 /* generates 'len' bytes of pseudo-random numbers */
9359 for (x = 0; x < len; x++) {
9360 prng->i = (prng->i + 1) & 0xff;
9361 si = prng->sbox[prng->i];
9362 prng->j = (prng->j + si) & 0xff;
9363 sj = prng->sbox[prng->j];
9364 prng->sbox[prng->i] = sj;
9365 prng->sbox[prng->j] = si;
9366 *destByte++ = prng->sbox[(si + sj) & 0xff];
9370 /* Re-seed the generator with user-provided bytes */
9371 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9373 int i;
9374 Jim_PrngState *prng;
9376 /* initialization, only needed the first time */
9377 if (interp->prngState == NULL)
9378 JimPrngInit(interp);
9379 prng = interp->prngState;
9381 /* Set the sbox[i] with i */
9382 for (i = 0; i < 256; i++)
9383 prng->sbox[i] = i;
9384 /* Now use the seed to perform a random permutation of the sbox */
9385 for (i = 0; i < seedLen; i++) {
9386 unsigned char t;
9388 t = prng->sbox[i & 0xFF];
9389 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9390 prng->sbox[seed[i]] = t;
9392 prng->i = prng->j = 0;
9394 /* discard at least the first 256 bytes of stream.
9395 * borrow the seed buffer for this
9397 for (i = 0; i < 256; i += seedLen) {
9398 JimRandomBytes(interp, seed, seedLen);
9402 /* [incr] */
9403 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9405 jim_wide wideValue, increment = 1;
9406 Jim_Obj *intObjPtr;
9408 if (argc != 2 && argc != 3) {
9409 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9410 return JIM_ERR;
9412 if (argc == 3) {
9413 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9414 return JIM_ERR;
9416 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
9417 if (!intObjPtr) {
9418 /* Set missing variable to 0 */
9419 wideValue = 0;
9421 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
9422 return JIM_ERR;
9424 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
9425 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
9426 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9427 Jim_FreeNewObj(interp, intObjPtr);
9428 return JIM_ERR;
9431 else {
9432 /* Can do it the quick way */
9433 Jim_InvalidateStringRep(intObjPtr);
9434 JimWideValue(intObjPtr) = wideValue + increment;
9436 /* The following step is required in order to invalidate the
9437 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9438 if (argv[1]->typePtr != &variableObjType) {
9439 /* Note that this can't fail since GetVariable already succeeded */
9440 Jim_SetVariable(interp, argv[1], intObjPtr);
9443 Jim_SetResult(interp, intObjPtr);
9444 return JIM_OK;
9448 /* -----------------------------------------------------------------------------
9449 * Eval
9450 * ---------------------------------------------------------------------------*/
9451 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
9452 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
9454 /* Handle calls to the [unknown] command */
9455 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *filename,
9456 int linenr)
9458 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
9459 int retCode;
9461 /* If JimUnknown() is recursively called too many times...
9462 * done here
9464 if (interp->unknown_called > 50) {
9465 return JIM_ERR;
9468 /* If the [unknown] command does not exists returns
9469 * just now */
9470 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
9471 return JIM_ERR;
9473 /* The object interp->unknown just contains
9474 * the "unknown" string, it is used in order to
9475 * avoid to lookup the unknown command every time
9476 * but instread to cache the result. */
9477 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
9478 v = sv;
9479 else
9480 v = Jim_Alloc(sizeof(Jim_Obj *) * (argc + 1));
9481 /* Make a copy of the arguments vector, but shifted on
9482 * the right of one position. The command name of the
9483 * command will be instead the first argument of the
9484 * [unknown] call. */
9485 memcpy(v + 1, argv, sizeof(Jim_Obj *) * argc);
9486 v[0] = interp->unknown;
9487 /* Call it */
9488 interp->unknown_called++;
9489 retCode = JimEvalObjVector(interp, argc + 1, v, filename, linenr);
9490 interp->unknown_called--;
9492 /* Clean up */
9493 if (v != sv)
9494 Jim_Free(v);
9495 return retCode;
9498 /* Eval the object vector 'objv' composed of 'objc' elements.
9499 * Every element is used as single argument.
9500 * Jim_EvalObj() will call this function every time its object
9501 * argument is of "list" type, with no string representation.
9503 * This is possible because the string representation of a
9504 * list object generated by the UpdateStringOfList is made
9505 * in a way that ensures that every list element is a different
9506 * command argument. */
9507 static int JimEvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv,
9508 const char *filename, int linenr)
9510 int i, retcode;
9511 Jim_Cmd *cmdPtr;
9513 /* Incr refcount of arguments. */
9514 for (i = 0; i < objc; i++)
9515 Jim_IncrRefCount(objv[i]);
9516 /* Command lookup */
9517 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
9518 if (cmdPtr == NULL) {
9519 retcode = JimUnknown(interp, objc, objv, filename, linenr);
9521 else {
9522 /* Call it -- Make sure result is an empty object. */
9523 JimIncrCmdRefCount(cmdPtr);
9524 Jim_SetEmptyResult(interp);
9525 if (cmdPtr->isproc) {
9526 retcode = JimCallProcedure(interp, cmdPtr, filename, linenr, objc, objv);
9528 else {
9529 interp->cmdPrivData = cmdPtr->u.native.privData;
9530 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
9532 JimDecrCmdRefCount(interp, cmdPtr);
9534 /* Decr refcount of arguments and return the retcode */
9535 for (i = 0; i < objc; i++)
9536 Jim_DecrRefCount(interp, objv[i]);
9538 return retcode;
9541 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
9543 return JimEvalObjVector(interp, objc, objv, NULL, 0);
9547 * Invokes 'prefix' as a command with the objv array as arguments.
9549 int Jim_EvalObjPrefix(Jim_Interp *interp, const char *prefix, int objc, Jim_Obj *const *objv)
9551 int i;
9552 int ret;
9553 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
9555 nargv[0] = Jim_NewStringObj(interp, prefix, -1);
9556 for (i = 0; i < objc; i++) {
9557 nargv[i + 1] = objv[i];
9559 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
9560 Jim_Free(nargv);
9561 return ret;
9564 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filename, int line)
9566 int rc = retcode;
9568 if (rc == JIM_ERR && !interp->errorFlag) {
9569 /* This is the first error, so save the file/line information and reset the stack */
9570 interp->errorFlag = 1;
9571 JimSetErrorFileName(interp, filename);
9572 JimSetErrorLineNumber(interp, line);
9574 JimResetStackTrace(interp);
9575 /* Always add a level where the error first occurs */
9576 interp->addStackTrace++;
9579 /* Now if this is an "interesting" level, add it to the stack trace */
9580 if (rc == JIM_ERR && interp->addStackTrace > 0) {
9581 /* Add the stack info for the current level */
9583 JimAppendStackTrace(interp, Jim_String(interp->errorProc), filename, line);
9585 /* Note: if we didn't have a filename for this level,
9586 * don't clear the addStackTrace flag
9587 * so we can pick it up at the next level
9589 if (*filename) {
9590 interp->addStackTrace = 0;
9593 Jim_DecrRefCount(interp, interp->errorProc);
9594 interp->errorProc = interp->emptyObj;
9595 Jim_IncrRefCount(interp->errorProc);
9597 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
9598 /* Propagate the addStackTrace value through 'return -code error' */
9600 else {
9601 interp->addStackTrace = 0;
9605 /* And delete any local procs */
9606 static void JimDeleteLocalProcs(Jim_Interp *interp)
9608 if (interp->localProcs) {
9609 char *procname;
9611 while ((procname = Jim_StackPop(interp->localProcs)) != NULL) {
9612 /* If there is a pushed command, find it */
9613 Jim_Cmd *prevCmd = NULL;
9614 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, procname);
9615 if (he) {
9616 Jim_Cmd *cmd = (Jim_Cmd *)he->val;
9617 if (cmd->isproc && cmd->u.proc.prevCmd) {
9618 prevCmd = cmd->u.proc.prevCmd;
9619 cmd->u.proc.prevCmd = NULL;
9623 /* Delete the local proc */
9624 Jim_DeleteCommand(interp, procname);
9626 if (prevCmd) {
9627 /* And restore the pushed command */
9628 Jim_AddHashEntry(&interp->commands, procname, prevCmd);
9630 Jim_Free(procname);
9632 Jim_FreeStack(interp->localProcs);
9633 Jim_Free(interp->localProcs);
9634 interp->localProcs = NULL;
9638 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
9640 Jim_Obj *objPtr;
9642 switch (token->type) {
9643 case JIM_TT_STR:
9644 case JIM_TT_ESC:
9645 objPtr = token->objPtr;
9646 break;
9647 case JIM_TT_VAR:
9648 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
9649 break;
9650 case JIM_TT_DICTSUGAR:
9651 objPtr = JimExpandDictSugar(interp, token->objPtr);
9652 break;
9653 case JIM_TT_EXPRSUGAR:
9654 objPtr = JimExpandExprSugar(interp, token->objPtr);
9655 break;
9656 case JIM_TT_CMD:
9657 switch (Jim_EvalObj(interp, token->objPtr)) {
9658 case JIM_OK:
9659 case JIM_RETURN:
9660 objPtr = interp->result;
9661 break;
9662 case JIM_BREAK:
9663 /* Stop substituting */
9664 return JIM_BREAK;
9665 case JIM_CONTINUE:
9666 /* just skip this one */
9667 return JIM_CONTINUE;
9668 default:
9669 return JIM_ERR;
9671 break;
9672 default:
9673 JimPanic((1, interp,
9674 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
9675 objPtr = NULL;
9676 break;
9678 if (objPtr) {
9679 *objPtrPtr = objPtr;
9680 return JIM_OK;
9682 return JIM_ERR;
9685 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
9686 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
9687 * The returned object has refcount = 0.
9689 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
9691 int totlen = 0, i;
9692 Jim_Obj **intv;
9693 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
9694 Jim_Obj *objPtr;
9695 char *s;
9697 if (tokens <= JIM_EVAL_SINTV_LEN)
9698 intv = sintv;
9699 else
9700 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
9702 /* Compute every token forming the argument
9703 * in the intv objects vector. */
9704 for (i = 0; i < tokens; i++) {
9705 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
9706 case JIM_OK:
9707 case JIM_RETURN:
9708 break;
9709 case JIM_BREAK:
9710 if (flags & JIM_SUBST_FLAG) {
9711 /* Stop here */
9712 tokens = i;
9713 continue;
9715 /* XXX: Should probably set an error about break outside loop */
9716 /* fall through to error */
9717 case JIM_CONTINUE:
9718 if (flags & JIM_SUBST_FLAG) {
9719 intv[i] = NULL;
9720 continue;
9722 /* XXX: Ditto continue outside loop */
9723 /* fall through to error */
9724 default:
9725 while (i--) {
9726 Jim_DecrRefCount(interp, intv[i]);
9728 if (intv != sintv) {
9729 Jim_Free(intv);
9731 return NULL;
9733 Jim_IncrRefCount(intv[i]);
9734 Jim_String(intv[i]);
9735 totlen += intv[i]->length;
9738 /* Fast path return for a single token */
9739 if (tokens == 1 && intv[0] && intv == sintv) {
9740 Jim_DecrRefCount(interp, intv[0]);
9741 return intv[0];
9744 /* Concatenate every token in an unique
9745 * object. */
9746 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
9748 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
9749 && token[2].type == JIM_TT_VAR) {
9750 /* May be able to do fast interpolated object -> dictSubst */
9751 objPtr->typePtr = &interpolatedObjType;
9752 objPtr->internalRep.twoPtrValue.ptr1 = (void *)token;
9753 objPtr->internalRep.twoPtrValue.ptr2 = intv[2];
9754 Jim_IncrRefCount(intv[2]);
9757 s = objPtr->bytes = Jim_Alloc(totlen + 1);
9758 objPtr->length = totlen;
9759 for (i = 0; i < tokens; i++) {
9760 if (intv[i]) {
9761 memcpy(s, intv[i]->bytes, intv[i]->length);
9762 s += intv[i]->length;
9763 Jim_DecrRefCount(interp, intv[i]);
9766 objPtr->bytes[totlen] = '\0';
9767 /* Free the intv vector if not static. */
9768 if (intv != sintv) {
9769 Jim_Free(intv);
9772 return objPtr;
9776 /* If listPtr is a list, call JimEvalObjVector() with the given source info.
9777 * Otherwise eval with Jim_EvalObj()
9779 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr, const char *filename, int linenr)
9781 if (!Jim_IsList(listPtr)) {
9782 return Jim_EvalObj(interp, listPtr);
9784 else {
9785 int retcode = JIM_OK;
9787 if (listPtr->internalRep.listValue.len) {
9788 Jim_IncrRefCount(listPtr);
9789 retcode = JimEvalObjVector(interp,
9790 listPtr->internalRep.listValue.len,
9791 listPtr->internalRep.listValue.ele, filename, linenr);
9792 Jim_DecrRefCount(interp, listPtr);
9794 return retcode;
9798 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
9800 int i;
9801 ScriptObj *script;
9802 ScriptToken *token;
9803 int retcode = JIM_OK;
9804 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
9805 int linenr = 0;
9807 interp->errorFlag = 0;
9809 /* If the object is of type "list", we can call
9810 * a specialized version of Jim_EvalObj() */
9811 if (Jim_IsList(scriptObjPtr)) {
9812 return Jim_EvalObjList(interp, scriptObjPtr, NULL, 0);
9815 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
9816 script = Jim_GetScript(interp, scriptObjPtr);
9818 /* Reset the interpreter result. This is useful to
9819 * return the empty result in the case of empty program. */
9820 Jim_SetEmptyResult(interp);
9822 #ifdef JIM_OPTIMIZATION
9823 /* Check for one of the following common scripts used by for, while
9825 * {}
9826 * incr a
9828 if (script->len == 0) {
9829 Jim_DecrRefCount(interp, scriptObjPtr);
9830 return JIM_OK;
9832 if (script->len == 3
9833 && script->token[1].objPtr->typePtr == &commandObjType
9834 && script->token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
9835 && script->token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
9836 && script->token[2].objPtr->typePtr == &variableObjType) {
9838 Jim_Obj *objPtr = Jim_GetVariable(interp, script->token[2].objPtr, JIM_NONE);
9840 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
9841 JimWideValue(objPtr)++;
9842 Jim_InvalidateStringRep(objPtr);
9843 Jim_DecrRefCount(interp, scriptObjPtr);
9844 Jim_SetResult(interp, objPtr);
9845 return JIM_OK;
9848 #endif
9850 /* Now we have to make sure the internal repr will not be
9851 * freed on shimmering.
9853 * Think for example to this:
9855 * set x {llength $x; ... some more code ...}; eval $x
9857 * In order to preserve the internal rep, we increment the
9858 * inUse field of the script internal rep structure. */
9859 script->inUse++;
9861 token = script->token;
9862 argv = sargv;
9864 /* Execute every command sequentially until the end of the script
9865 * or an error occurs.
9867 for (i = 0; i < script->len && retcode == JIM_OK; ) {
9868 int argc;
9869 int j;
9870 Jim_Cmd *cmd;
9872 /* First token of the line is always JIM_TT_LINE */
9873 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
9874 linenr = token[i].objPtr->internalRep.scriptLineValue.line;
9876 /* Allocate the arguments vector if required */
9877 if (argc > JIM_EVAL_SARGV_LEN)
9878 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
9880 /* Skip the JIM_TT_LINE token */
9881 i++;
9883 /* Populate the arguments objects.
9884 * If an error occurs, retcode will be set and
9885 * 'j' will be set to the number of args expanded
9887 for (j = 0; j < argc; j++) {
9888 long wordtokens = 1;
9889 int expand = 0;
9890 Jim_Obj *wordObjPtr = NULL;
9892 if (token[i].type == JIM_TT_WORD) {
9893 wordtokens = JimWideValue(token[i++].objPtr);
9894 if (wordtokens < 0) {
9895 expand = 1;
9896 wordtokens = -wordtokens;
9900 if (wordtokens == 1) {
9901 /* Fast path if the token does not
9902 * need interpolation */
9904 switch (token[i].type) {
9905 case JIM_TT_ESC:
9906 case JIM_TT_STR:
9907 wordObjPtr = token[i].objPtr;
9908 break;
9909 case JIM_TT_VAR:
9910 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9911 break;
9912 case JIM_TT_EXPRSUGAR:
9913 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
9914 break;
9915 case JIM_TT_DICTSUGAR:
9916 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
9917 break;
9918 case JIM_TT_CMD:
9919 retcode = Jim_EvalObj(interp, token[i].objPtr);
9920 if (retcode == JIM_OK) {
9921 wordObjPtr = Jim_GetResult(interp);
9923 break;
9924 default:
9925 JimPanic((1, interp, "default token type reached " "in Jim_EvalObj()."));
9928 else {
9929 /* For interpolation we call a helper
9930 * function to do the work for us. */
9931 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
9934 if (!wordObjPtr) {
9935 if (retcode == JIM_OK) {
9936 retcode = JIM_ERR;
9938 break;
9941 Jim_IncrRefCount(wordObjPtr);
9942 i += wordtokens;
9944 if (!expand) {
9945 argv[j] = wordObjPtr;
9947 else {
9948 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
9949 int len = Jim_ListLength(interp, wordObjPtr);
9950 int newargc = argc + len - 1;
9951 int k;
9953 if (len > 1) {
9954 if (argv == sargv) {
9955 if (newargc > JIM_EVAL_SARGV_LEN) {
9956 argv = Jim_Alloc(sizeof(*argv) * newargc);
9957 memcpy(argv, sargv, sizeof(*argv) * j);
9960 else {
9961 /* Need to realloc to make room for (len - 1) more entries */
9962 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
9966 /* Now copy in the expanded version */
9967 for (k = 0; k < len; k++) {
9968 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
9969 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
9972 /* The original object reference is no longer needed,
9973 * after the expansion it is no longer present on
9974 * the argument vector, but the single elements are
9975 * in its place. */
9976 Jim_DecrRefCount(interp, wordObjPtr);
9978 /* And update the indexes */
9979 j--;
9980 argc += len - 1;
9984 if (retcode == JIM_OK && argc) {
9985 /* Lookup the command to call */
9986 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
9987 if (cmd != NULL) {
9988 /* Call it -- Make sure result is an empty object. */
9989 JimIncrCmdRefCount(cmd);
9990 Jim_SetEmptyResult(interp);
9991 if (cmd->isproc) {
9992 retcode =
9993 JimCallProcedure(interp, cmd, script->fileName, linenr, argc, argv);
9994 } else {
9995 interp->cmdPrivData = cmd->u.native.privData;
9996 retcode = cmd->u.native.cmdProc(interp, argc, argv);
9998 JimDecrCmdRefCount(interp, cmd);
10000 else {
10001 /* Call [unknown] */
10002 retcode = JimUnknown(interp, argc, argv, script->fileName, linenr);
10004 if (interp->signal_level && interp->sigmask) {
10005 /* Check for a signal after each command */
10006 retcode = JIM_SIGNAL;
10010 /* Finished with the command, so decrement ref counts of each argument */
10011 while (j-- > 0) {
10012 Jim_DecrRefCount(interp, argv[j]);
10015 if (argv != sargv) {
10016 Jim_Free(argv);
10017 argv = sargv;
10021 /* Possibly add to the error stack trace */
10022 JimAddErrorToStack(interp, retcode, script->fileName, linenr);
10024 /* Note that we don't have to decrement inUse, because the
10025 * following code transfers our use of the reference again to
10026 * the script object. */
10027 Jim_FreeIntRep(interp, scriptObjPtr);
10028 scriptObjPtr->typePtr = &scriptObjType;
10029 Jim_SetIntRepPtr(scriptObjPtr, script);
10030 Jim_DecrRefCount(interp, scriptObjPtr);
10032 return retcode;
10035 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10037 int retcode;
10038 /* If argObjPtr begins with '&', do an automatic upvar */
10039 const char *varname = Jim_String(argNameObj);
10040 if (*varname == '&') {
10041 /* First check that the target variable exists */
10042 Jim_Obj *objPtr;
10043 Jim_CallFrame *savedCallFrame = interp->framePtr;
10045 interp->framePtr = interp->framePtr->parentCallFrame;
10046 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10047 interp->framePtr = savedCallFrame;
10048 if (!objPtr) {
10049 return JIM_ERR;
10052 /* It exists, so perform the binding. */
10053 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10054 Jim_IncrRefCount(objPtr);
10055 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parentCallFrame);
10056 Jim_DecrRefCount(interp, objPtr);
10058 else {
10059 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10061 return retcode;
10064 /* Call a procedure implemented in Tcl.
10065 * It's possible to speed-up a lot this function, currently
10066 * the callframes are not cached, but allocated and
10067 * destroied every time. What is expecially costly is
10068 * to create/destroy the local vars hash table every time.
10070 * This can be fixed just implementing callframes caching
10071 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10072 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
10073 Jim_Obj *const *argv)
10075 int i, d, retcode;
10076 Jim_CallFrame *callFramePtr;
10077 Jim_Obj *argObjPtr;
10078 Jim_Obj *procname = argv[0];
10079 Jim_Stack *prevLocalProcs;
10081 /* Check arity */
10082 if (argc - 1 < cmd->u.proc.leftArity + cmd->u.proc.rightArity ||
10083 (!cmd->u.proc.args && argc - 1 > cmd->u.proc.leftArity + cmd->u.proc.rightArity + cmd->u.proc.optionalArgs)) {
10084 /* Create a nice error message, consistent with Tcl 8.5 */
10085 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10086 int arglen = Jim_ListLength(interp, cmd->u.proc.argListObjPtr);
10088 for (i = 0; i < arglen; i++) {
10089 Jim_Obj *objPtr;
10090 Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, i, &argObjPtr, JIM_NONE);
10092 Jim_AppendString(interp, argmsg, " ", 1);
10094 if (i < cmd->u.proc.leftArity || i >= arglen - cmd->u.proc.rightArity) {
10095 Jim_AppendObj(interp, argmsg, argObjPtr);
10097 else if (i == arglen - cmd->u.proc.rightArity - cmd->u.proc.args) {
10098 if (Jim_ListLength(interp, argObjPtr) == 1) {
10099 /* We have plain args */
10100 Jim_AppendString(interp, argmsg, "?argument ...?", -1);
10102 else {
10103 Jim_AppendString(interp, argmsg, "?", 1);
10104 Jim_ListIndex(interp, argObjPtr, 1, &objPtr, JIM_NONE);
10105 Jim_AppendObj(interp, argmsg, objPtr);
10106 Jim_AppendString(interp, argmsg, " ...?", -1);
10109 else {
10110 Jim_AppendString(interp, argmsg, "?", 1);
10111 Jim_ListIndex(interp, argObjPtr, 0, &objPtr, JIM_NONE);
10112 Jim_AppendObj(interp, argmsg, objPtr);
10113 Jim_AppendString(interp, argmsg, "?", 1);
10116 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procname, argmsg);
10117 Jim_FreeNewObj(interp, argmsg);
10118 return JIM_ERR;
10121 /* Check if there are too nested calls */
10122 if (interp->framePtr->level == interp->maxNestingDepth) {
10123 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10124 return JIM_ERR;
10127 /* Create a new callframe */
10128 callFramePtr = JimCreateCallFrame(interp, interp->framePtr);
10129 callFramePtr->argv = argv;
10130 callFramePtr->argc = argc;
10131 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10132 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10133 callFramePtr->staticVars = cmd->u.proc.staticVars;
10134 callFramePtr->filename = filename;
10135 callFramePtr->line = linenr;
10136 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10137 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10138 interp->framePtr = callFramePtr;
10140 /* Simplify arg counting */
10141 argv++;
10142 argc--;
10144 /* Set arguments */
10146 /* Assign in this order:
10147 * leftArity required args.
10148 * rightArity required args (but actually do it last for simplicity)
10149 * optionalArgs optional args
10150 * remaining args into 'args' if 'args'
10153 /* Note that 'd' steps along the arg list, whilst argc/argv follow the supplied args */
10155 /* leftArity required args */
10156 for (d = 0; d < cmd->u.proc.leftArity; d++) {
10157 Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d, &argObjPtr, JIM_NONE);
10158 retcode = JimSetProcArg(interp, argObjPtr, *argv++);
10159 if (retcode != JIM_OK) {
10160 goto badargset;
10162 argc--;
10165 /* Shorten our idea of the number of supplied args */
10166 argc -= cmd->u.proc.rightArity;
10168 /* optionalArgs optional args */
10169 for (i = 0; i < cmd->u.proc.optionalArgs; i++) {
10170 Jim_Obj *nameObjPtr;
10171 Jim_Obj *valueObjPtr;
10173 Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d++, &argObjPtr, JIM_NONE);
10175 /* The name is the first element of the list */
10176 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
10177 if (argc) {
10178 valueObjPtr = *argv++;
10179 argc--;
10181 else {
10182 /* No more values, so use default */
10183 /* The value is the second element of the list */
10184 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
10186 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
10189 /* Any remaining args go to 'args' */
10190 if (cmd->u.proc.args) {
10191 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
10193 /* Get the 'args' name from the procedure args */
10194 Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d, &argObjPtr, JIM_NONE);
10196 /* It is possible to rename args. */
10197 i = Jim_ListLength(interp, argObjPtr);
10198 if (i == 2) {
10199 Jim_ListIndex(interp, argObjPtr, 1, &argObjPtr, JIM_NONE);
10202 Jim_SetVariable(interp, argObjPtr, listObjPtr);
10203 argv += argc;
10204 d++;
10207 /* rightArity required args */
10208 for (i = 0; i < cmd->u.proc.rightArity; i++) {
10209 Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d++, &argObjPtr, JIM_NONE);
10210 retcode = JimSetProcArg(interp, argObjPtr, *argv++);
10211 if (retcode != JIM_OK) {
10212 goto badargset;
10216 /* Install a new stack for local procs */
10217 prevLocalProcs = interp->localProcs;
10218 interp->localProcs = NULL;
10220 /* Eval the body */
10221 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10223 /* Delete any local procs */
10224 JimDeleteLocalProcs(interp);
10225 interp->localProcs = prevLocalProcs;
10227 badargset:
10228 /* Destroy the callframe */
10229 interp->framePtr = interp->framePtr->parentCallFrame;
10230 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10231 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10233 else {
10234 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10236 /* Handle the JIM_EVAL return code */
10237 while (retcode == JIM_EVAL) {
10238 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
10240 Jim_IncrRefCount(resultScriptObjPtr);
10241 /* Should be a list! */
10242 retcode = Jim_EvalObjList(interp, resultScriptObjPtr, filename, linenr);
10243 Jim_DecrRefCount(interp, resultScriptObjPtr);
10245 /* Handle the JIM_RETURN return code */
10246 if (retcode == JIM_RETURN) {
10247 if (--interp->returnLevel <= 0) {
10248 retcode = interp->returnCode;
10249 interp->returnCode = JIM_OK;
10250 interp->returnLevel = 0;
10253 else if (retcode == JIM_ERR) {
10254 interp->addStackTrace++;
10255 Jim_DecrRefCount(interp, interp->errorProc);
10256 interp->errorProc = procname;
10257 Jim_IncrRefCount(interp->errorProc);
10259 return retcode;
10262 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
10264 int retval;
10265 Jim_Obj *scriptObjPtr;
10267 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10268 Jim_IncrRefCount(scriptObjPtr);
10271 if (filename) {
10272 Jim_Obj *prevScriptObj;
10274 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
10276 prevScriptObj = interp->currentScriptObj;
10277 interp->currentScriptObj = scriptObjPtr;
10279 retval = Jim_EvalObj(interp, scriptObjPtr);
10281 interp->currentScriptObj = prevScriptObj;
10283 else {
10284 retval = Jim_EvalObj(interp, scriptObjPtr);
10286 Jim_DecrRefCount(interp, scriptObjPtr);
10287 return retval;
10290 int Jim_Eval(Jim_Interp *interp, const char *script)
10292 return Jim_Eval_Named(interp, script, NULL, 0);
10295 /* Execute script in the scope of the global level */
10296 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10298 int retval;
10299 Jim_CallFrame *savedFramePtr = interp->framePtr;
10301 interp->framePtr = interp->topFramePtr;
10302 retval = Jim_Eval(interp, script);
10303 interp->framePtr = savedFramePtr;
10305 return retval;
10308 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10310 int retval;
10311 Jim_CallFrame *savedFramePtr = interp->framePtr;
10313 interp->framePtr = interp->topFramePtr;
10314 retval = Jim_EvalFile(interp, filename);
10315 interp->framePtr = savedFramePtr;
10317 return retval;
10320 #include <sys/stat.h>
10322 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10324 FILE *fp;
10325 char *buf;
10326 Jim_Obj *scriptObjPtr;
10327 Jim_Obj *prevScriptObj;
10328 Jim_Stack *prevLocalProcs;
10329 struct stat sb;
10330 int retcode;
10331 int readlen;
10332 char missing;
10334 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10335 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10336 return JIM_ERR;
10338 if (sb.st_size == 0) {
10339 fclose(fp);
10340 return JIM_OK;
10343 buf = Jim_Alloc(sb.st_size + 1);
10344 readlen = fread(buf, 1, sb.st_size, fp);
10345 if (ferror(fp)) {
10346 fclose(fp);
10347 Jim_Free(buf);
10348 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10349 return JIM_ERR;
10351 fclose(fp);
10352 buf[readlen] = 0;
10354 if (!Jim_ScriptIsComplete(buf, sb.st_size, &missing)) {
10355 Jim_SetResultFormatted(interp, "missing %s in \"%s\"",
10356 missing == '{' ? "close-brace" : "\"", filename);
10357 Jim_Free(buf);
10358 return JIM_ERR;
10361 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10362 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
10363 Jim_IncrRefCount(scriptObjPtr);
10365 prevScriptObj = interp->currentScriptObj;
10366 interp->currentScriptObj = scriptObjPtr;
10368 /* Install a new stack for local procs */
10369 prevLocalProcs = interp->localProcs;
10370 interp->localProcs = NULL;
10372 retcode = Jim_EvalObj(interp, scriptObjPtr);
10374 /* Delete any local procs */
10375 JimDeleteLocalProcs(interp);
10376 interp->localProcs = prevLocalProcs;
10378 /* Handle the JIM_RETURN return code */
10379 if (retcode == JIM_RETURN) {
10380 if (--interp->returnLevel <= 0) {
10381 retcode = interp->returnCode;
10382 interp->returnCode = JIM_OK;
10383 interp->returnLevel = 0;
10386 if (retcode == JIM_ERR) {
10387 /* EvalFile changes context, so add a stack frame here */
10388 interp->addStackTrace++;
10391 interp->currentScriptObj = prevScriptObj;
10393 Jim_DecrRefCount(interp, scriptObjPtr);
10395 return retcode;
10398 /* -----------------------------------------------------------------------------
10399 * Subst
10400 * ---------------------------------------------------------------------------*/
10401 static int JimParseSubstStr(struct JimParserCtx *pc)
10403 pc->tstart = pc->p;
10404 pc->tline = pc->linenr;
10405 while (pc->len && *pc->p != '$' && *pc->p != '[') {
10406 if (*pc->p == '\\' && pc->len > 1) {
10407 pc->p++;
10408 pc->len--;
10410 pc->p++;
10411 pc->len--;
10413 pc->tend = pc->p - 1;
10414 pc->tt = JIM_TT_ESC;
10415 return JIM_OK;
10418 static int JimParseSubst(struct JimParserCtx *pc, int flags)
10420 int retval;
10422 if (pc->len == 0) {
10423 pc->tstart = pc->tend = pc->p;
10424 pc->tline = pc->linenr;
10425 pc->tt = JIM_TT_EOL;
10426 pc->eof = 1;
10427 return JIM_OK;
10429 switch (*pc->p) {
10430 case '[':
10431 retval = JimParseCmd(pc);
10432 if (flags & JIM_SUBST_NOCMD) {
10433 pc->tstart--;
10434 pc->tend++;
10435 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
10437 return retval;
10438 break;
10439 case '$':
10440 if (JimParseVar(pc) == JIM_ERR) {
10441 pc->tstart = pc->tend = pc->p++;
10442 pc->len--;
10443 pc->tline = pc->linenr;
10444 pc->tt = JIM_TT_STR;
10446 else {
10447 if (flags & JIM_SUBST_NOVAR) {
10448 pc->tstart--;
10449 if (flags & JIM_SUBST_NOESC)
10450 pc->tt = JIM_TT_STR;
10451 else
10452 pc->tt = JIM_TT_ESC;
10453 if (*pc->tstart == '{') {
10454 pc->tstart--;
10455 if (*(pc->tend + 1))
10456 pc->tend++;
10460 break;
10461 default:
10462 retval = JimParseSubstStr(pc);
10463 if (flags & JIM_SUBST_NOESC)
10464 pc->tt = JIM_TT_STR;
10465 return retval;
10466 break;
10468 return JIM_OK;
10471 /* The subst object type reuses most of the data structures and functions
10472 * of the script object. Script's data structures are a bit more complex
10473 * for what is needed for [subst]itution tasks, but the reuse helps to
10474 * deal with a single data structure at the cost of some more memory
10475 * usage for substitutions. */
10477 /* This method takes the string representation of an object
10478 * as a Tcl string where to perform [subst]itution, and generates
10479 * the pre-parsed internal representation. */
10480 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
10482 int scriptTextLen;
10483 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
10484 struct JimParserCtx parser;
10485 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
10486 ParseTokenList tokenlist;
10488 /* Initially parse the subst into tokens (in tokenlist) */
10489 ScriptTokenListInit(&tokenlist);
10491 JimParserInit(&parser, scriptText, scriptTextLen, 1);
10492 while (1) {
10493 JimParseSubst(&parser, flags);
10494 if (parser.eof) {
10495 /* Note that subst doesn't need the EOL token */
10496 break;
10498 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
10499 parser.tline);
10502 /* Create the "real" subst/script tokens from the initial token list */
10503 script->inUse = 1;
10504 script->substFlags = flags;
10505 script->fileName = NULL;
10506 SubstObjAddTokens(interp, script, &tokenlist);
10508 /* No longer need the token list */
10509 ScriptTokenListFree(&tokenlist);
10511 #ifdef DEBUG_SHOW_SUBST
10513 int i;
10515 printf("==== Subst ====\n");
10516 for (i = 0; i < script->len; i++) {
10517 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
10518 Jim_String(script->token[i].objPtr));
10521 #endif
10523 /* Free the old internal rep and set the new one. */
10524 Jim_FreeIntRep(interp, objPtr);
10525 Jim_SetIntRepPtr(objPtr, script);
10526 objPtr->typePtr = &scriptObjType;
10527 return JIM_OK;
10530 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
10532 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
10533 SetSubstFromAny(interp, objPtr, flags);
10534 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
10537 /* Performs commands,variables,blackslashes substitution,
10538 * storing the result object (with refcount 0) into
10539 * resObjPtrPtr. */
10540 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
10542 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
10544 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
10545 /* In order to preserve the internal rep, we increment the
10546 * inUse field of the script internal rep structure. */
10547 script->inUse++;
10549 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
10551 script->inUse--;
10552 Jim_DecrRefCount(interp, substObjPtr);
10553 if (*resObjPtrPtr == NULL) {
10554 return JIM_ERR;
10556 return JIM_OK;
10559 /* -----------------------------------------------------------------------------
10560 * Core commands utility functions
10561 * ---------------------------------------------------------------------------*/
10562 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
10564 int i;
10565 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
10567 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
10568 for (i = 0; i < argc; i++) {
10569 Jim_AppendObj(interp, objPtr, argv[i]);
10570 if (!(i + 1 == argc && msg[0] == '\0'))
10571 Jim_AppendString(interp, objPtr, " ", 1);
10573 Jim_AppendString(interp, objPtr, msg, -1);
10574 Jim_AppendString(interp, objPtr, "\"", 1);
10575 Jim_SetResult(interp, objPtr);
10578 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
10580 /* type is: 0=commands, 1=procs, 2=channels */
10581 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
10583 Jim_HashTableIterator *htiter;
10584 Jim_HashEntry *he;
10585 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10587 /* Check for the non-pattern case. We can do this much more efficiently. */
10588 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
10589 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, patternObjPtr, JIM_NONE);
10590 if (cmdPtr) {
10591 if (type == 1 && !cmdPtr->isproc) {
10592 /* not a proc */
10594 else if (type == 2 && !Jim_AioFilehandle(interp, patternObjPtr)) {
10595 /* not a channel */
10597 else {
10598 Jim_ListAppendElement(interp, listObjPtr, patternObjPtr);
10601 return listObjPtr;
10604 htiter = Jim_GetHashTableIterator(&interp->commands);
10605 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10606 Jim_Cmd *cmdPtr = he->val;
10607 Jim_Obj *cmdNameObj;
10609 if (type == 1 && !cmdPtr->isproc) {
10610 /* not a proc */
10611 continue;
10613 if (patternObjPtr && !JimStringMatch(interp, patternObjPtr, he->key, 0))
10614 continue;
10616 cmdNameObj = Jim_NewStringObj(interp, he->key, -1);
10618 /* Is it a channel? */
10619 if (type == 2 && !Jim_AioFilehandle(interp, cmdNameObj)) {
10620 Jim_FreeNewObj(interp, cmdNameObj);
10621 continue;
10624 Jim_ListAppendElement(interp, listObjPtr, cmdNameObj);
10626 Jim_FreeHashTableIterator(htiter);
10627 return listObjPtr;
10630 /* Keep this in order */
10631 #define JIM_VARLIST_GLOBALS 0
10632 #define JIM_VARLIST_LOCALS 1
10633 #define JIM_VARLIST_VARS 2
10635 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
10637 Jim_HashTableIterator *htiter;
10638 Jim_HashEntry *he;
10639 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10641 if (mode == JIM_VARLIST_GLOBALS) {
10642 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
10644 else {
10645 /* For [info locals], if we are at top level an emtpy list
10646 * is returned. I don't agree, but we aim at compatibility (SS) */
10647 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr)
10648 return listObjPtr;
10649 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
10651 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10652 Jim_Var *varPtr = (Jim_Var *)he->val;
10654 if (mode == JIM_VARLIST_LOCALS) {
10655 if (varPtr->linkFramePtr != NULL)
10656 continue;
10658 if (patternObjPtr && !JimStringMatch(interp, patternObjPtr, he->key, 0))
10659 continue;
10660 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
10662 Jim_FreeHashTableIterator(htiter);
10663 return listObjPtr;
10666 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
10667 Jim_Obj **objPtrPtr, int info_level_cmd)
10669 Jim_CallFrame *targetCallFrame;
10671 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
10672 if (targetCallFrame == NULL) {
10673 return JIM_ERR;
10675 /* No proc call at toplevel callframe */
10676 if (targetCallFrame == interp->topFramePtr) {
10677 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
10678 return JIM_ERR;
10680 if (info_level_cmd) {
10681 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
10683 else {
10684 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
10686 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
10687 Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp,
10688 targetCallFrame->filename ? targetCallFrame->filename : "", -1));
10689 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
10690 *objPtrPtr = listObj;
10692 return JIM_OK;
10695 /* -----------------------------------------------------------------------------
10696 * Core commands
10697 * ---------------------------------------------------------------------------*/
10699 /* fake [puts] -- not the real puts, just for debugging. */
10700 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10702 if (argc != 2 && argc != 3) {
10703 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
10704 return JIM_ERR;
10706 if (argc == 3) {
10707 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
10708 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
10709 return JIM_ERR;
10711 else {
10712 fputs(Jim_String(argv[2]), stdout);
10715 else {
10716 puts(Jim_String(argv[1]));
10718 return JIM_OK;
10721 /* Helper for [+] and [*] */
10722 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10724 jim_wide wideValue, res;
10725 double doubleValue, doubleRes;
10726 int i;
10728 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
10730 for (i = 1; i < argc; i++) {
10731 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
10732 goto trydouble;
10733 if (op == JIM_EXPROP_ADD)
10734 res += wideValue;
10735 else
10736 res *= wideValue;
10738 Jim_SetResultInt(interp, res);
10739 return JIM_OK;
10740 trydouble:
10741 doubleRes = (double)res;
10742 for (; i < argc; i++) {
10743 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10744 return JIM_ERR;
10745 if (op == JIM_EXPROP_ADD)
10746 doubleRes += doubleValue;
10747 else
10748 doubleRes *= doubleValue;
10750 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10751 return JIM_OK;
10754 /* Helper for [-] and [/] */
10755 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10757 jim_wide wideValue, res = 0;
10758 double doubleValue, doubleRes = 0;
10759 int i = 2;
10761 if (argc < 2) {
10762 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
10763 return JIM_ERR;
10765 else if (argc == 2) {
10766 /* The arity = 2 case is different. For [- x] returns -x,
10767 * while [/ x] returns 1/x. */
10768 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
10769 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
10770 return JIM_ERR;
10772 else {
10773 if (op == JIM_EXPROP_SUB)
10774 doubleRes = -doubleValue;
10775 else
10776 doubleRes = 1.0 / doubleValue;
10777 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10778 return JIM_OK;
10781 if (op == JIM_EXPROP_SUB) {
10782 res = -wideValue;
10783 Jim_SetResultInt(interp, res);
10785 else {
10786 doubleRes = 1.0 / wideValue;
10787 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10789 return JIM_OK;
10791 else {
10792 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
10793 if (Jim_GetDouble(interp, argv[1], &doubleRes)
10794 != JIM_OK) {
10795 return JIM_ERR;
10797 else {
10798 goto trydouble;
10802 for (i = 2; i < argc; i++) {
10803 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
10804 doubleRes = (double)res;
10805 goto trydouble;
10807 if (op == JIM_EXPROP_SUB)
10808 res -= wideValue;
10809 else
10810 res /= wideValue;
10812 Jim_SetResultInt(interp, res);
10813 return JIM_OK;
10814 trydouble:
10815 for (; i < argc; i++) {
10816 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10817 return JIM_ERR;
10818 if (op == JIM_EXPROP_SUB)
10819 doubleRes -= doubleValue;
10820 else
10821 doubleRes /= doubleValue;
10823 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10824 return JIM_OK;
10828 /* [+] */
10829 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10831 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
10834 /* [*] */
10835 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10837 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
10840 /* [-] */
10841 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10843 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
10846 /* [/] */
10847 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10849 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
10852 /* [set] */
10853 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10855 if (argc != 2 && argc != 3) {
10856 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
10857 return JIM_ERR;
10859 if (argc == 2) {
10860 Jim_Obj *objPtr;
10862 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10863 if (!objPtr)
10864 return JIM_ERR;
10865 Jim_SetResult(interp, objPtr);
10866 return JIM_OK;
10868 /* argc == 3 case. */
10869 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10870 return JIM_ERR;
10871 Jim_SetResult(interp, argv[2]);
10872 return JIM_OK;
10875 /* [unset]
10877 * unset ?-nocomplain? ?--? ?varName ...?
10879 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10881 int i = 1;
10882 int complain = 1;
10884 while (i < argc) {
10885 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
10886 i++;
10887 break;
10889 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
10890 complain = 0;
10891 i++;
10892 continue;
10894 break;
10897 while (i < argc) {
10898 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
10899 && complain) {
10900 return JIM_ERR;
10902 i++;
10904 return JIM_OK;
10907 /* [while] */
10908 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10910 if (argc != 3) {
10911 Jim_WrongNumArgs(interp, 1, argv, "condition body");
10912 return JIM_ERR;
10915 /* The general purpose implementation of while starts here */
10916 while (1) {
10917 int boolean, retval;
10919 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
10920 return retval;
10921 if (!boolean)
10922 break;
10924 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
10925 switch (retval) {
10926 case JIM_BREAK:
10927 goto out;
10928 break;
10929 case JIM_CONTINUE:
10930 continue;
10931 break;
10932 default:
10933 return retval;
10937 out:
10938 Jim_SetEmptyResult(interp);
10939 return JIM_OK;
10942 /* [for] */
10943 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10945 int retval;
10946 int boolean = 1;
10947 Jim_Obj *varNamePtr = NULL;
10948 Jim_Obj *stopVarNamePtr = NULL;
10950 if (argc != 5) {
10951 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
10952 return JIM_ERR;
10955 /* Do the initialisation */
10956 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
10957 return retval;
10960 /* And do the first test now. Better for optimisation
10961 * if we can do next/test at the bottom of the loop
10963 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
10965 /* Ready to do the body as follows:
10966 * while (1) {
10967 * body // check retcode
10968 * next // check retcode
10969 * test // check retcode/test bool
10973 #ifdef JIM_OPTIMIZATION
10974 /* Check if the for is on the form:
10975 * for ... {$i < CONST} {incr i}
10976 * for ... {$i < $j} {incr i}
10978 if (retval == JIM_OK && boolean) {
10979 ScriptObj *incrScript;
10980 ExprByteCode *expr;
10981 jim_wide stop, currentVal;
10982 unsigned jim_wide procEpoch;
10983 Jim_Obj *objPtr;
10984 int cmpOffset;
10986 /* Do it only if there aren't shared arguments */
10987 expr = JimGetExpression(interp, argv[2]);
10988 incrScript = Jim_GetScript(interp, argv[3]);
10990 /* Ensure proper lengths to start */
10991 if (incrScript->len != 3 || !expr || expr->len != 3) {
10992 goto evalstart;
10994 /* Ensure proper token types. */
10995 if (incrScript->token[1].type != JIM_TT_ESC ||
10996 expr->token[0].type != JIM_TT_VAR ||
10997 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
10998 goto evalstart;
11001 if (expr->token[2].type == JIM_EXPROP_LT) {
11002 cmpOffset = 0;
11004 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11005 cmpOffset = 1;
11007 else {
11008 goto evalstart;
11011 /* Update command must be incr */
11012 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11013 goto evalstart;
11016 /* incr, expression must be about the same variable */
11017 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11018 goto evalstart;
11021 /* Get the stop condition (must be a variable or integer) */
11022 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11023 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11024 goto evalstart;
11027 else {
11028 stopVarNamePtr = expr->token[1].objPtr;
11029 Jim_IncrRefCount(stopVarNamePtr);
11030 /* Keep the compiler happy */
11031 stop = 0;
11034 /* Initialization */
11035 procEpoch = interp->procEpoch;
11036 varNamePtr = expr->token[0].objPtr;
11037 Jim_IncrRefCount(varNamePtr);
11039 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11040 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11041 goto testcond;
11044 /* --- OPTIMIZED FOR --- */
11045 while (retval == JIM_OK) {
11046 /* === Check condition === */
11047 /* Note that currentVal is already set here */
11049 /* Immediate or Variable? get the 'stop' value if the latter. */
11050 if (stopVarNamePtr) {
11051 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11052 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11053 goto testcond;
11057 if (currentVal >= stop + cmpOffset) {
11058 break;
11061 /* Eval body */
11062 retval = Jim_EvalObj(interp, argv[4]);
11063 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11064 retval = JIM_OK;
11065 /* If there was a change in procedures/command continue
11066 * with the usual [for] command implementation */
11067 if (procEpoch != interp->procEpoch) {
11068 goto evalnext;
11071 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11073 /* Increment */
11074 if (objPtr == NULL) {
11075 retval = JIM_ERR;
11076 goto out;
11078 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11079 currentVal = ++JimWideValue(objPtr);
11080 Jim_InvalidateStringRep(objPtr);
11082 else {
11083 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11084 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11085 ++currentVal)) != JIM_OK) {
11086 goto evalnext;
11091 goto out;
11093 evalstart:
11094 #endif
11096 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11097 /* Body */
11098 retval = Jim_EvalObj(interp, argv[4]);
11100 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11101 /* increment */
11102 evalnext:
11103 retval = Jim_EvalObj(interp, argv[3]);
11104 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11105 /* test */
11106 testcond:
11107 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11111 out:
11112 if (stopVarNamePtr) {
11113 Jim_DecrRefCount(interp, stopVarNamePtr);
11115 if (varNamePtr) {
11116 Jim_DecrRefCount(interp, varNamePtr);
11119 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11120 Jim_SetEmptyResult(interp);
11121 return JIM_OK;
11124 return retval;
11127 /* [loop] */
11128 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11130 int retval;
11131 jim_wide i;
11132 jim_wide limit;
11133 jim_wide incr = 1;
11134 Jim_Obj *bodyObjPtr;
11136 if (argc != 5 && argc != 6) {
11137 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11138 return JIM_ERR;
11141 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11142 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11143 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11144 return JIM_ERR;
11146 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11148 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11150 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11151 retval = Jim_EvalObj(interp, bodyObjPtr);
11152 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11153 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11155 retval = JIM_OK;
11157 /* Increment */
11158 i += incr;
11160 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11161 if (argv[1]->typePtr != &variableObjType) {
11162 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11163 return JIM_ERR;
11166 JimWideValue(objPtr) = i;
11167 Jim_InvalidateStringRep(objPtr);
11169 /* The following step is required in order to invalidate the
11170 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11171 if (argv[1]->typePtr != &variableObjType) {
11172 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11173 retval = JIM_ERR;
11174 break;
11178 else {
11179 objPtr = Jim_NewIntObj(interp, i);
11180 retval = Jim_SetVariable(interp, argv[1], objPtr);
11181 if (retval != JIM_OK) {
11182 Jim_FreeNewObj(interp, objPtr);
11188 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11189 Jim_SetEmptyResult(interp);
11190 return JIM_OK;
11192 return retval;
11195 /* foreach + lmap implementation. */
11196 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11198 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
11199 int nbrOfLoops = 0;
11200 Jim_Obj *emptyStr, *script, *mapRes = NULL;
11202 if (argc < 4 || argc % 2 != 0) {
11203 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11204 return JIM_ERR;
11206 if (doMap) {
11207 mapRes = Jim_NewListObj(interp, NULL, 0);
11208 Jim_IncrRefCount(mapRes);
11210 emptyStr = Jim_NewEmptyStringObj(interp);
11211 Jim_IncrRefCount(emptyStr);
11212 script = argv[argc - 1]; /* Last argument is a script */
11213 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
11214 listsIdx = (int *)Jim_Alloc(nbrOfLists * sizeof(int));
11215 listsEnd = (int *)Jim_Alloc(nbrOfLists * 2 * sizeof(int));
11216 /* Initialize iterators and remember max nbr elements each list */
11217 memset(listsIdx, 0, nbrOfLists * sizeof(int));
11218 /* Remember lengths of all lists and calculate how much rounds to loop */
11219 for (i = 0; i < nbrOfLists * 2; i += 2) {
11220 div_t cnt;
11221 int count;
11223 listsEnd[i] = Jim_ListLength(interp, argv[i + 1]);
11224 listsEnd[i + 1] = Jim_ListLength(interp, argv[i + 2]);
11225 if (listsEnd[i] == 0) {
11226 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11227 goto err;
11229 cnt = div(listsEnd[i + 1], listsEnd[i]);
11230 count = cnt.quot + (cnt.rem ? 1 : 0);
11231 if (count > nbrOfLoops)
11232 nbrOfLoops = count;
11234 for (; nbrOfLoops-- > 0;) {
11235 for (i = 0; i < nbrOfLists; ++i) {
11236 int varIdx = 0, var = i * 2;
11238 while (varIdx < listsEnd[var]) {
11239 Jim_Obj *varName, *ele;
11240 int lst = i * 2 + 1;
11242 /* List index operations below can't fail */
11243 Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_NONE);
11244 if (listsIdx[i] < listsEnd[lst]) {
11245 Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_NONE);
11246 /* Avoid shimmering */
11247 Jim_IncrRefCount(ele);
11248 result = Jim_SetVariable(interp, varName, ele);
11249 Jim_DecrRefCount(interp, ele);
11250 if (result == JIM_OK) {
11251 ++listsIdx[i]; /* Remember next iterator of current list */
11252 ++varIdx; /* Next variable */
11253 continue;
11256 else if (Jim_SetVariable(interp, varName, emptyStr) == JIM_OK) {
11257 ++varIdx; /* Next variable */
11258 continue;
11260 goto err;
11263 switch (result = Jim_EvalObj(interp, script)) {
11264 case JIM_OK:
11265 if (doMap)
11266 Jim_ListAppendElement(interp, mapRes, interp->result);
11267 break;
11268 case JIM_CONTINUE:
11269 break;
11270 case JIM_BREAK:
11271 goto out;
11272 break;
11273 default:
11274 goto err;
11277 out:
11278 result = JIM_OK;
11279 if (doMap)
11280 Jim_SetResult(interp, mapRes);
11281 else
11282 Jim_SetEmptyResult(interp);
11283 err:
11284 if (doMap)
11285 Jim_DecrRefCount(interp, mapRes);
11286 Jim_DecrRefCount(interp, emptyStr);
11287 Jim_Free(listsIdx);
11288 Jim_Free(listsEnd);
11289 return result;
11292 /* [foreach] */
11293 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11295 return JimForeachMapHelper(interp, argc, argv, 0);
11298 /* [lmap] */
11299 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11301 return JimForeachMapHelper(interp, argc, argv, 1);
11304 /* [if] */
11305 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11307 int boolean, retval, current = 1, falsebody = 0;
11309 if (argc >= 3) {
11310 while (1) {
11311 /* Far not enough arguments given! */
11312 if (current >= argc)
11313 goto err;
11314 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11315 != JIM_OK)
11316 return retval;
11317 /* There lacks something, isn't it? */
11318 if (current >= argc)
11319 goto err;
11320 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11321 current++;
11322 /* Tsk tsk, no then-clause? */
11323 if (current >= argc)
11324 goto err;
11325 if (boolean)
11326 return Jim_EvalObj(interp, argv[current]);
11327 /* Ok: no else-clause follows */
11328 if (++current >= argc) {
11329 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11330 return JIM_OK;
11332 falsebody = current++;
11333 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
11334 /* IIICKS - else-clause isn't last cmd? */
11335 if (current != argc - 1)
11336 goto err;
11337 return Jim_EvalObj(interp, argv[current]);
11339 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
11340 /* Ok: elseif follows meaning all the stuff
11341 * again (how boring...) */
11342 continue;
11343 /* OOPS - else-clause is not last cmd? */
11344 else if (falsebody != argc - 1)
11345 goto err;
11346 return Jim_EvalObj(interp, argv[falsebody]);
11348 return JIM_OK;
11350 err:
11351 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11352 return JIM_ERR;
11356 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11357 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
11358 Jim_Obj *stringObj, int nocase)
11360 Jim_Obj *parms[4];
11361 int argc = 0;
11362 long eq;
11363 int rc;
11365 parms[argc++] = commandObj;
11366 if (nocase) {
11367 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
11369 parms[argc++] = patternObj;
11370 parms[argc++] = stringObj;
11372 rc = Jim_EvalObjVector(interp, argc, parms);
11374 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
11375 eq = -rc;
11378 return eq;
11381 enum
11382 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
11384 /* [switch] */
11385 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11387 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
11388 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
11389 Jim_Obj *script = 0;
11391 if (argc < 3) {
11392 wrongnumargs:
11393 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
11394 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
11395 return JIM_ERR;
11397 for (opt = 1; opt < argc; ++opt) {
11398 const char *option = Jim_GetString(argv[opt], 0);
11400 if (*option != '-')
11401 break;
11402 else if (strncmp(option, "--", 2) == 0) {
11403 ++opt;
11404 break;
11406 else if (strncmp(option, "-exact", 2) == 0)
11407 matchOpt = SWITCH_EXACT;
11408 else if (strncmp(option, "-glob", 2) == 0)
11409 matchOpt = SWITCH_GLOB;
11410 else if (strncmp(option, "-regexp", 2) == 0)
11411 matchOpt = SWITCH_RE;
11412 else if (strncmp(option, "-command", 2) == 0) {
11413 matchOpt = SWITCH_CMD;
11414 if ((argc - opt) < 2)
11415 goto wrongnumargs;
11416 command = argv[++opt];
11418 else {
11419 Jim_SetResultFormatted(interp,
11420 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
11421 argv[opt]);
11422 return JIM_ERR;
11424 if ((argc - opt) < 2)
11425 goto wrongnumargs;
11427 strObj = argv[opt++];
11428 patCount = argc - opt;
11429 if (patCount == 1) {
11430 Jim_Obj **vector;
11432 JimListGetElements(interp, argv[opt], &patCount, &vector);
11433 caseList = vector;
11435 else
11436 caseList = &argv[opt];
11437 if (patCount == 0 || patCount % 2 != 0)
11438 goto wrongnumargs;
11439 for (i = 0; script == 0 && i < patCount; i += 2) {
11440 Jim_Obj *patObj = caseList[i];
11442 if (!Jim_CompareStringImmediate(interp, patObj, "default")
11443 || i < (patCount - 2)) {
11444 switch (matchOpt) {
11445 case SWITCH_EXACT:
11446 if (Jim_StringEqObj(strObj, patObj))
11447 script = caseList[i + 1];
11448 break;
11449 case SWITCH_GLOB:
11450 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
11451 script = caseList[i + 1];
11452 break;
11453 case SWITCH_RE:
11454 command = Jim_NewStringObj(interp, "regexp", -1);
11455 /* Fall thru intentionally */
11456 case SWITCH_CMD:{
11457 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
11459 /* After the execution of a command we need to
11460 * make sure to reconvert the object into a list
11461 * again. Only for the single-list style [switch]. */
11462 if (argc - opt == 1) {
11463 Jim_Obj **vector;
11465 JimListGetElements(interp, argv[opt], &patCount, &vector);
11466 caseList = vector;
11468 /* command is here already decref'd */
11469 if (rc < 0) {
11470 return -rc;
11472 if (rc)
11473 script = caseList[i + 1];
11474 break;
11478 else {
11479 script = caseList[i + 1];
11482 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
11483 script = caseList[i + 1];
11484 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
11485 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
11486 return JIM_ERR;
11488 Jim_SetEmptyResult(interp);
11489 if (script) {
11490 return Jim_EvalObj(interp, script);
11492 return JIM_OK;
11495 /* [list] */
11496 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11498 Jim_Obj *listObjPtr;
11500 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
11501 Jim_SetResult(interp, listObjPtr);
11502 return JIM_OK;
11505 /* [lindex] */
11506 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11508 Jim_Obj *objPtr, *listObjPtr;
11509 int i;
11510 int idx;
11512 if (argc < 3) {
11513 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
11514 return JIM_ERR;
11516 objPtr = argv[1];
11517 Jim_IncrRefCount(objPtr);
11518 for (i = 2; i < argc; i++) {
11519 listObjPtr = objPtr;
11520 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
11521 Jim_DecrRefCount(interp, listObjPtr);
11522 return JIM_ERR;
11524 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
11525 /* Returns an empty object if the index
11526 * is out of range. */
11527 Jim_DecrRefCount(interp, listObjPtr);
11528 Jim_SetEmptyResult(interp);
11529 return JIM_OK;
11531 Jim_IncrRefCount(objPtr);
11532 Jim_DecrRefCount(interp, listObjPtr);
11534 Jim_SetResult(interp, objPtr);
11535 Jim_DecrRefCount(interp, objPtr);
11536 return JIM_OK;
11539 /* [llength] */
11540 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11542 if (argc != 2) {
11543 Jim_WrongNumArgs(interp, 1, argv, "list");
11544 return JIM_ERR;
11546 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
11547 return JIM_OK;
11550 /* [lsearch] */
11551 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11553 static const char * const options[] = {
11554 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
11555 NULL
11557 enum
11558 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
11559 OPT_COMMAND };
11560 int i;
11561 int opt_bool = 0;
11562 int opt_not = 0;
11563 int opt_nocase = 0;
11564 int opt_all = 0;
11565 int opt_inline = 0;
11566 int opt_match = OPT_EXACT;
11567 int listlen;
11568 int rc = JIM_OK;
11569 Jim_Obj *listObjPtr = NULL;
11570 Jim_Obj *commandObj = NULL;
11572 if (argc < 3) {
11573 wrongargs:
11574 Jim_WrongNumArgs(interp, 1, argv,
11575 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
11576 return JIM_ERR;
11579 for (i = 1; i < argc - 2; i++) {
11580 int option;
11582 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
11583 return JIM_ERR;
11585 switch (option) {
11586 case OPT_BOOL:
11587 opt_bool = 1;
11588 opt_inline = 0;
11589 break;
11590 case OPT_NOT:
11591 opt_not = 1;
11592 break;
11593 case OPT_NOCASE:
11594 opt_nocase = 1;
11595 break;
11596 case OPT_INLINE:
11597 opt_inline = 1;
11598 opt_bool = 0;
11599 break;
11600 case OPT_ALL:
11601 opt_all = 1;
11602 break;
11603 case OPT_COMMAND:
11604 if (i >= argc - 2) {
11605 goto wrongargs;
11607 commandObj = argv[++i];
11608 /* fallthru */
11609 case OPT_EXACT:
11610 case OPT_GLOB:
11611 case OPT_REGEXP:
11612 opt_match = option;
11613 break;
11617 argv += i;
11619 if (opt_all) {
11620 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11622 if (opt_match == OPT_REGEXP) {
11623 commandObj = Jim_NewStringObj(interp, "regexp", -1);
11625 if (commandObj) {
11626 Jim_IncrRefCount(commandObj);
11629 listlen = Jim_ListLength(interp, argv[0]);
11630 for (i = 0; i < listlen; i++) {
11631 Jim_Obj *objPtr;
11632 int eq = 0;
11634 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
11635 switch (opt_match) {
11636 case OPT_EXACT:
11637 eq = Jim_StringCompareObj(interp, objPtr, argv[1], opt_nocase) == 0;
11638 break;
11640 case OPT_GLOB:
11641 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
11642 break;
11644 case OPT_REGEXP:
11645 case OPT_COMMAND:
11646 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
11647 if (eq < 0) {
11648 if (listObjPtr) {
11649 Jim_FreeNewObj(interp, listObjPtr);
11651 rc = JIM_ERR;
11652 goto done;
11654 break;
11657 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
11658 if (!eq && opt_bool && opt_not && !opt_all) {
11659 continue;
11662 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
11663 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
11664 Jim_Obj *resultObj;
11666 if (opt_bool) {
11667 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
11669 else if (!opt_inline) {
11670 resultObj = Jim_NewIntObj(interp, i);
11672 else {
11673 resultObj = objPtr;
11676 if (opt_all) {
11677 Jim_ListAppendElement(interp, listObjPtr, resultObj);
11679 else {
11680 Jim_SetResult(interp, resultObj);
11681 goto done;
11686 if (opt_all) {
11687 Jim_SetResult(interp, listObjPtr);
11689 else {
11690 /* No match */
11691 if (opt_bool) {
11692 Jim_SetResultBool(interp, opt_not);
11694 else if (!opt_inline) {
11695 Jim_SetResultInt(interp, -1);
11699 done:
11700 if (commandObj) {
11701 Jim_DecrRefCount(interp, commandObj);
11703 return rc;
11706 /* [lappend] */
11707 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11709 Jim_Obj *listObjPtr;
11710 int shared, i;
11712 if (argc < 2) {
11713 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
11714 return JIM_ERR;
11716 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
11717 if (!listObjPtr) {
11718 /* Create the list if it does not exists */
11719 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11720 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11721 Jim_FreeNewObj(interp, listObjPtr);
11722 return JIM_ERR;
11725 shared = Jim_IsShared(listObjPtr);
11726 if (shared)
11727 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
11728 for (i = 2; i < argc; i++)
11729 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
11730 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11731 if (shared)
11732 Jim_FreeNewObj(interp, listObjPtr);
11733 return JIM_ERR;
11735 Jim_SetResult(interp, listObjPtr);
11736 return JIM_OK;
11739 /* [linsert] */
11740 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11742 int idx, len;
11743 Jim_Obj *listPtr;
11745 if (argc < 4) {
11746 Jim_WrongNumArgs(interp, 1, argv, "list index element " "?element ...?");
11747 return JIM_ERR;
11749 listPtr = argv[1];
11750 if (Jim_IsShared(listPtr))
11751 listPtr = Jim_DuplicateObj(interp, listPtr);
11752 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
11753 goto err;
11754 len = Jim_ListLength(interp, listPtr);
11755 if (idx >= len)
11756 idx = len;
11757 else if (idx < 0)
11758 idx = len + idx + 1;
11759 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
11760 Jim_SetResult(interp, listPtr);
11761 return JIM_OK;
11762 err:
11763 if (listPtr != argv[1]) {
11764 Jim_FreeNewObj(interp, listPtr);
11766 return JIM_ERR;
11769 /* [lreplace] */
11770 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11772 int first, last, len, rangeLen;
11773 Jim_Obj *listObj;
11774 Jim_Obj *newListObj;
11775 int i;
11776 int shared;
11778 if (argc < 4) {
11779 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element element ...?");
11780 return JIM_ERR;
11782 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
11783 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
11784 return JIM_ERR;
11787 listObj = argv[1];
11788 len = Jim_ListLength(interp, listObj);
11790 first = JimRelToAbsIndex(len, first);
11791 last = JimRelToAbsIndex(len, last);
11792 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
11794 /* Now construct a new list which consists of:
11795 * <elements before first> <supplied elements> <elements after last>
11798 /* Check to see if trying to replace past the end of the list */
11799 if (first < len) {
11800 /* OK. Not past the end */
11802 else if (len == 0) {
11803 /* Special for empty list, adjust first to 0 */
11804 first = 0;
11806 else {
11807 Jim_SetResultString(interp, "list doesn't contain element ", -1);
11808 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
11809 return JIM_ERR;
11812 newListObj = Jim_NewListObj(interp, NULL, 0);
11814 shared = Jim_IsShared(listObj);
11815 if (shared) {
11816 listObj = Jim_DuplicateObj(interp, listObj);
11819 /* Add the first set of elements */
11820 for (i = 0; i < first; i++) {
11821 Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
11824 /* Add supplied elements */
11825 for (i = 4; i < argc; i++) {
11826 Jim_ListAppendElement(interp, newListObj, argv[i]);
11829 /* Add the remaining elements */
11830 for (i = first + rangeLen; i < len; i++) {
11831 Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
11833 Jim_SetResult(interp, newListObj);
11834 if (shared) {
11835 Jim_FreeNewObj(interp, listObj);
11837 return JIM_OK;
11840 /* [lset] */
11841 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11843 if (argc < 3) {
11844 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
11845 return JIM_ERR;
11847 else if (argc == 3) {
11848 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11849 return JIM_ERR;
11850 Jim_SetResult(interp, argv[2]);
11851 return JIM_OK;
11853 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
11854 == JIM_ERR)
11855 return JIM_ERR;
11856 return JIM_OK;
11859 /* [lsort] */
11860 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
11862 const char *options[] = {
11863 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
11865 enum
11866 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_INDEX };
11867 Jim_Obj *resObj;
11868 int i;
11869 int retCode;
11871 struct lsort_info info;
11873 if (argc < 2) {
11874 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
11875 return JIM_ERR;
11878 info.type = JIM_LSORT_ASCII;
11879 info.order = 1;
11880 info.indexed = 0;
11881 info.command = NULL;
11882 info.interp = interp;
11884 for (i = 1; i < (argc - 1); i++) {
11885 int option;
11887 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
11888 != JIM_OK)
11889 return JIM_ERR;
11890 switch (option) {
11891 case OPT_ASCII:
11892 info.type = JIM_LSORT_ASCII;
11893 break;
11894 case OPT_NOCASE:
11895 info.type = JIM_LSORT_NOCASE;
11896 break;
11897 case OPT_INTEGER:
11898 info.type = JIM_LSORT_INTEGER;
11899 break;
11900 case OPT_INCREASING:
11901 info.order = 1;
11902 break;
11903 case OPT_DECREASING:
11904 info.order = -1;
11905 break;
11906 case OPT_COMMAND:
11907 if (i >= (argc - 2)) {
11908 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
11909 return JIM_ERR;
11911 info.type = JIM_LSORT_COMMAND;
11912 info.command = argv[i + 1];
11913 i++;
11914 break;
11915 case OPT_INDEX:
11916 if (i >= (argc - 2)) {
11917 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
11918 return JIM_ERR;
11920 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
11921 return JIM_ERR;
11923 info.indexed = 1;
11924 i++;
11925 break;
11928 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
11929 retCode = ListSortElements(interp, resObj, &info);
11930 if (retCode == JIM_OK) {
11931 Jim_SetResult(interp, resObj);
11933 else {
11934 Jim_FreeNewObj(interp, resObj);
11936 return retCode;
11939 /* [append] */
11940 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11942 Jim_Obj *stringObjPtr;
11943 int i;
11945 if (argc < 2) {
11946 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
11947 return JIM_ERR;
11949 if (argc == 2) {
11950 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11951 if (!stringObjPtr)
11952 return JIM_ERR;
11954 else {
11955 int freeobj = 0;
11956 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
11957 if (!stringObjPtr) {
11958 /* Create the string if it doesn't exist */
11959 stringObjPtr = Jim_NewEmptyStringObj(interp);
11960 freeobj = 1;
11962 else if (Jim_IsShared(stringObjPtr)) {
11963 freeobj = 1;
11964 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
11966 for (i = 2; i < argc; i++) {
11967 Jim_AppendObj(interp, stringObjPtr, argv[i]);
11969 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
11970 if (freeobj) {
11971 Jim_FreeNewObj(interp, stringObjPtr);
11973 return JIM_ERR;
11976 Jim_SetResult(interp, stringObjPtr);
11977 return JIM_OK;
11980 /* [debug] */
11981 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11983 #ifdef JIM_DEBUG_COMMAND
11984 const char *options[] = {
11985 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
11986 "exprbc", "show",
11987 NULL
11989 enum
11991 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
11992 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
11994 int option;
11996 if (argc < 2) {
11997 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
11998 return JIM_ERR;
12000 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12001 return JIM_ERR;
12002 if (option == OPT_REFCOUNT) {
12003 if (argc != 3) {
12004 Jim_WrongNumArgs(interp, 2, argv, "object");
12005 return JIM_ERR;
12007 Jim_SetResultInt(interp, argv[2]->refCount);
12008 return JIM_OK;
12010 else if (option == OPT_OBJCOUNT) {
12011 int freeobj = 0, liveobj = 0;
12012 char buf[256];
12013 Jim_Obj *objPtr;
12015 if (argc != 2) {
12016 Jim_WrongNumArgs(interp, 2, argv, "");
12017 return JIM_ERR;
12019 /* Count the number of free objects. */
12020 objPtr = interp->freeList;
12021 while (objPtr) {
12022 freeobj++;
12023 objPtr = objPtr->nextObjPtr;
12025 /* Count the number of live objects. */
12026 objPtr = interp->liveList;
12027 while (objPtr) {
12028 liveobj++;
12029 objPtr = objPtr->nextObjPtr;
12031 /* Set the result string and return. */
12032 sprintf(buf, "free %d used %d", freeobj, liveobj);
12033 Jim_SetResultString(interp, buf, -1);
12034 return JIM_OK;
12036 else if (option == OPT_OBJECTS) {
12037 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12039 /* Count the number of live objects. */
12040 objPtr = interp->liveList;
12041 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12042 while (objPtr) {
12043 char buf[128];
12044 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12046 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12047 sprintf(buf, "%p", objPtr);
12048 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12049 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12050 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12051 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12052 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12053 objPtr = objPtr->nextObjPtr;
12055 Jim_SetResult(interp, listObjPtr);
12056 return JIM_OK;
12058 else if (option == OPT_INVSTR) {
12059 Jim_Obj *objPtr;
12061 if (argc != 3) {
12062 Jim_WrongNumArgs(interp, 2, argv, "object");
12063 return JIM_ERR;
12065 objPtr = argv[2];
12066 if (objPtr->typePtr != NULL)
12067 Jim_InvalidateStringRep(objPtr);
12068 Jim_SetEmptyResult(interp);
12069 return JIM_OK;
12071 else if (option == OPT_SHOW) {
12072 const char *s;
12073 int len, charlen;
12075 if (argc != 3) {
12076 Jim_WrongNumArgs(interp, 2, argv, "object");
12077 return JIM_ERR;
12079 s = Jim_GetString(argv[2], &len);
12080 charlen = Jim_Utf8Length(interp, argv[2]);
12081 printf("chars (%d): <<%s>>\n", charlen, s);
12082 printf("bytes (%d):", len);
12083 while (len--) {
12084 printf(" %02x", (unsigned char)*s++);
12086 printf("\n");
12087 return JIM_OK;
12089 else if (option == OPT_SCRIPTLEN) {
12090 ScriptObj *script;
12092 if (argc != 3) {
12093 Jim_WrongNumArgs(interp, 2, argv, "script");
12094 return JIM_ERR;
12096 script = Jim_GetScript(interp, argv[2]);
12097 Jim_SetResultInt(interp, script->len);
12098 return JIM_OK;
12100 else if (option == OPT_EXPRLEN) {
12101 ExprByteCode *expr;
12103 if (argc != 3) {
12104 Jim_WrongNumArgs(interp, 2, argv, "expression");
12105 return JIM_ERR;
12107 expr = JimGetExpression(interp, argv[2]);
12108 if (expr == NULL)
12109 return JIM_ERR;
12110 Jim_SetResultInt(interp, expr->len);
12111 return JIM_OK;
12113 else if (option == OPT_EXPRBC) {
12114 Jim_Obj *objPtr;
12115 ExprByteCode *expr;
12116 int i;
12118 if (argc != 3) {
12119 Jim_WrongNumArgs(interp, 2, argv, "expression");
12120 return JIM_ERR;
12122 expr = JimGetExpression(interp, argv[2]);
12123 if (expr == NULL)
12124 return JIM_ERR;
12125 objPtr = Jim_NewListObj(interp, NULL, 0);
12126 for (i = 0; i < expr->len; i++) {
12127 const char *type;
12128 const Jim_ExprOperator *op;
12129 Jim_Obj *obj = expr->token[i].objPtr;
12131 switch (expr->token[i].type) {
12132 case JIM_TT_EXPR_INT:
12133 type = "int";
12134 break;
12135 case JIM_TT_EXPR_DOUBLE:
12136 type = "double";
12137 break;
12138 case JIM_TT_CMD:
12139 type = "command";
12140 break;
12141 case JIM_TT_VAR:
12142 type = "variable";
12143 break;
12144 case JIM_TT_DICTSUGAR:
12145 type = "dictsugar";
12146 break;
12147 case JIM_TT_EXPRSUGAR:
12148 type = "exprsugar";
12149 break;
12150 case JIM_TT_ESC:
12151 type = "subst";
12152 break;
12153 case JIM_TT_STR:
12154 type = "string";
12155 break;
12156 default:
12157 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12158 if (op == NULL) {
12159 type = "private";
12161 else {
12162 type = "operator";
12164 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12165 break;
12167 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12168 Jim_ListAppendElement(interp, objPtr, obj);
12170 Jim_SetResult(interp, objPtr);
12171 return JIM_OK;
12173 else {
12174 Jim_SetResultString(interp,
12175 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12176 return JIM_ERR;
12178 /* unreached */
12179 #else
12180 Jim_SetResultString(interp, "unsupported", -1);
12181 return JIM_ERR;
12182 #endif
12185 /* [eval] */
12186 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12188 int rc;
12189 Jim_Stack *prevLocalProcs;
12191 if (argc < 2) {
12192 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12193 return JIM_ERR;
12196 /* Install a new stack for local procs */
12197 prevLocalProcs = interp->localProcs;
12198 interp->localProcs = NULL;
12200 if (argc == 2) {
12201 rc = Jim_EvalObj(interp, argv[1]);
12203 else {
12204 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12207 /* Delete any local procs */
12208 JimDeleteLocalProcs(interp);
12209 interp->localProcs = prevLocalProcs;
12211 if (rc == JIM_ERR) {
12212 /* eval is "interesting", so add a stack frame here */
12213 interp->addStackTrace++;
12215 return rc;
12218 /* [uplevel] */
12219 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12221 if (argc >= 2) {
12222 int retcode;
12223 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12224 Jim_Obj *objPtr;
12225 const char *str;
12227 /* Save the old callframe pointer */
12228 savedCallFrame = interp->framePtr;
12230 /* Lookup the target frame pointer */
12231 str = Jim_String(argv[1]);
12232 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12233 targetCallFrame =Jim_GetCallFrameByLevel(interp, argv[1]);
12234 argc--;
12235 argv++;
12237 else {
12238 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12240 if (targetCallFrame == NULL) {
12241 return JIM_ERR;
12243 if (argc < 2) {
12244 argv--;
12245 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12246 return JIM_ERR;
12248 /* Eval the code in the target callframe. */
12249 interp->framePtr = targetCallFrame;
12250 if (argc == 2) {
12251 retcode = Jim_EvalObj(interp, argv[1]);
12253 else {
12254 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12255 Jim_IncrRefCount(objPtr);
12256 retcode = Jim_EvalObj(interp, objPtr);
12257 Jim_DecrRefCount(interp, objPtr);
12259 interp->framePtr = savedCallFrame;
12260 return retcode;
12262 else {
12263 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12264 return JIM_ERR;
12268 /* [expr] */
12269 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12271 Jim_Obj *exprResultPtr;
12272 int retcode;
12274 if (argc == 2) {
12275 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12277 else if (argc > 2) {
12278 Jim_Obj *objPtr;
12280 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12281 Jim_IncrRefCount(objPtr);
12282 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12283 Jim_DecrRefCount(interp, objPtr);
12285 else {
12286 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12287 return JIM_ERR;
12289 if (retcode != JIM_OK)
12290 return retcode;
12291 Jim_SetResult(interp, exprResultPtr);
12292 Jim_DecrRefCount(interp, exprResultPtr);
12293 return JIM_OK;
12296 /* [break] */
12297 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12299 if (argc != 1) {
12300 Jim_WrongNumArgs(interp, 1, argv, "");
12301 return JIM_ERR;
12303 return JIM_BREAK;
12306 /* [continue] */
12307 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12309 if (argc != 1) {
12310 Jim_WrongNumArgs(interp, 1, argv, "");
12311 return JIM_ERR;
12313 return JIM_CONTINUE;
12316 /* [return] */
12317 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12319 int i;
12320 Jim_Obj *stackTraceObj = NULL;
12321 Jim_Obj *errorCodeObj = NULL;
12322 int returnCode = JIM_OK;
12323 long level = 1;
12325 for (i = 1; i < argc - 1; i += 2) {
12326 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12327 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12328 return JIM_ERR;
12331 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12332 stackTraceObj = argv[i + 1];
12334 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12335 errorCodeObj = argv[i + 1];
12337 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12338 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12339 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12340 return JIM_ERR;
12343 else {
12344 break;
12348 if (i != argc - 1 && i != argc) {
12349 Jim_WrongNumArgs(interp, 1, argv,
12350 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12353 /* If a stack trace is supplied and code is error, set the stack trace */
12354 if (stackTraceObj && returnCode == JIM_ERR) {
12355 JimSetStackTrace(interp, stackTraceObj);
12357 /* If an error code list is supplied, set the global $errorCode */
12358 if (errorCodeObj && returnCode == JIM_ERR) {
12359 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12361 interp->returnCode = returnCode;
12362 interp->returnLevel = level;
12364 if (i == argc - 1) {
12365 Jim_SetResult(interp, argv[i]);
12367 return JIM_RETURN;
12370 /* [tailcall] */
12371 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12373 Jim_Obj *objPtr;
12375 objPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12376 Jim_SetResult(interp, objPtr);
12377 return JIM_EVAL;
12380 /* [proc] */
12381 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12383 int argListLen;
12384 int leftArity, rightArity;
12385 int i;
12386 int optionalArgs = 0;
12387 int args = 0;
12389 if (argc != 4 && argc != 5) {
12390 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
12391 return JIM_ERR;
12394 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
12395 return JIM_ERR;
12398 argListLen = Jim_ListLength(interp, argv[2]);
12399 leftArity = 0;
12400 rightArity = 0;
12402 /* Examine the argument list for default parameters and 'args' */
12403 for (i = 0; i < argListLen; i++) {
12404 Jim_Obj *argPtr;
12405 int len;
12407 /* Examine a parameter */
12408 Jim_ListIndex(interp, argv[2], i, &argPtr, JIM_NONE);
12409 len = Jim_ListLength(interp, argPtr);
12410 if (len == 0) {
12411 Jim_SetResultString(interp, "procedure has argument with no name", -1);
12412 return JIM_ERR;
12414 if (len > 2) {
12415 Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
12416 return JIM_ERR;
12419 if (len == 2) {
12420 /* May be {args newname} */
12421 Jim_ListIndex(interp, argPtr, 0, &argPtr, JIM_NONE);
12424 if (Jim_CompareStringImmediate(interp, argPtr, "args")) {
12425 if (args) {
12426 Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
12427 return JIM_ERR;
12429 if (rightArity) {
12430 Jim_SetResultString(interp, "procedure has 'args' in invalid position", -1);
12431 return JIM_ERR;
12433 args = 1;
12434 continue;
12437 /* Does this parameter have a default? */
12438 if (len == 1) {
12439 /* A required arg. Is it part of leftArity or rightArity? */
12440 if (optionalArgs || args) {
12441 rightArity++;
12443 else {
12444 leftArity++;
12447 else {
12448 /* Optional arg. Can't be after rightArity */
12449 if (rightArity || args) {
12450 Jim_SetResultString(interp, "procedure has optional arg in invalid position", -1);
12451 return JIM_ERR;
12453 optionalArgs++;
12457 if (argc == 4) {
12458 return JimCreateProcedure(interp, Jim_String(argv[1]),
12459 argv[2], NULL, argv[3], leftArity, optionalArgs, args, rightArity);
12461 else {
12462 return JimCreateProcedure(interp, Jim_String(argv[1]),
12463 argv[2], argv[3], argv[4], leftArity, optionalArgs, args, rightArity);
12467 /* [local] */
12468 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12470 int retcode;
12472 /* Evaluate the arguments with 'local' in force */
12473 interp->local++;
12474 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12475 interp->local--;
12478 /* If OK, and the result is a proc, add it to the list of local procs */
12479 if (retcode == 0) {
12480 const char *procname = Jim_String(Jim_GetResult(interp));
12482 if (Jim_FindHashEntry(&interp->commands, procname) == NULL) {
12483 Jim_SetResultFormatted(interp, "not a proc: \"%s\"", procname);
12484 return JIM_ERR;
12486 if (interp->localProcs == NULL) {
12487 interp->localProcs = Jim_Alloc(sizeof(*interp->localProcs));
12488 Jim_InitStack(interp->localProcs);
12490 Jim_StackPush(interp->localProcs, Jim_StrDup(procname));
12493 return retcode;
12496 /* [upcall] */
12497 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12499 if (argc < 2) {
12500 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
12501 return JIM_ERR;
12503 else {
12504 int retcode;
12506 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
12507 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->u.proc.prevCmd) {
12508 Jim_SetResultFormatted(interp, "no previous proc: \"%#s\"", argv[1]);
12509 return JIM_ERR;
12511 /* OK. Mark this command as being in an upcall */
12512 cmdPtr->u.proc.upcall++;
12513 JimIncrCmdRefCount(cmdPtr);
12515 /* Invoke the command as normal */
12516 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12518 /* No longer in an upcall */
12519 cmdPtr->u.proc.upcall--;
12520 JimDecrCmdRefCount(interp, cmdPtr);
12522 return retcode;
12526 /* [concat] */
12527 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12529 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12530 return JIM_OK;
12533 /* [upvar] */
12534 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12536 int i;
12537 Jim_CallFrame *targetCallFrame;
12539 /* Lookup the target frame pointer */
12540 if (argc > 3 && (argc % 2 == 0)) {
12541 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12542 argc--;
12543 argv++;
12545 else {
12546 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12548 if (targetCallFrame == NULL) {
12549 return JIM_ERR;
12552 /* Check for arity */
12553 if (argc < 3) {
12554 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
12555 return JIM_ERR;
12558 /* Now... for every other/local couple: */
12559 for (i = 1; i < argc; i += 2) {
12560 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
12561 return JIM_ERR;
12563 return JIM_OK;
12566 /* [global] */
12567 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12569 int i;
12571 if (argc < 2) {
12572 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
12573 return JIM_ERR;
12575 /* Link every var to the toplevel having the same name */
12576 if (interp->framePtr->level == 0)
12577 return JIM_OK; /* global at toplevel... */
12578 for (i = 1; i < argc; i++) {
12579 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
12580 return JIM_ERR;
12582 return JIM_OK;
12585 /* does the [string map] operation. On error NULL is returned,
12586 * otherwise a new string object with the result, having refcount = 0,
12587 * is returned. */
12588 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
12589 Jim_Obj *objPtr, int nocase)
12591 int numMaps;
12592 const char *str, *noMatchStart = NULL;
12593 int strLen, i;
12594 Jim_Obj *resultObjPtr;
12596 numMaps = Jim_ListLength(interp, mapListObjPtr);
12597 if (numMaps % 2) {
12598 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
12599 return NULL;
12602 str = Jim_String(objPtr);
12603 strLen = Jim_Utf8Length(interp, objPtr);
12605 /* Map it */
12606 resultObjPtr = Jim_NewStringObj(interp, "", 0);
12607 while (strLen) {
12608 for (i = 0; i < numMaps; i += 2) {
12609 Jim_Obj *objPtr;
12610 const char *k;
12611 int kl;
12613 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
12614 k = Jim_String(objPtr);
12615 kl = Jim_Utf8Length(interp, objPtr);
12617 if (strLen >= kl && kl) {
12618 int rc;
12619 if (nocase) {
12620 rc = JimStringCompareNoCase(str, k, kl);
12622 else {
12623 rc = JimStringCompare(str, kl, k, kl);
12625 if (rc == 0) {
12626 if (noMatchStart) {
12627 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12628 noMatchStart = NULL;
12630 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
12631 Jim_AppendObj(interp, resultObjPtr, objPtr);
12632 str += utf8_index(str, kl);
12633 strLen -= kl;
12634 break;
12638 if (i == numMaps) { /* no match */
12639 int c;
12640 if (noMatchStart == NULL)
12641 noMatchStart = str;
12642 str += utf8_tounicode(str, &c);
12643 strLen--;
12646 if (noMatchStart) {
12647 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12649 return resultObjPtr;
12652 /* [string] */
12653 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12655 int len;
12656 int opt_case = 1;
12657 int option;
12658 static const char * const options[] = {
12659 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "map",
12660 "repeat", "reverse", "index", "first", "last",
12661 "trim", "trimleft", "trimright", "tolower", "toupper", NULL
12663 enum
12665 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_MAP,
12666 OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
12667 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER
12669 static const char * const nocase_options[] = {
12670 "-nocase", NULL
12673 if (argc < 2) {
12674 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12675 return JIM_ERR;
12677 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
12678 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
12679 return JIM_ERR;
12681 switch (option) {
12682 case OPT_LENGTH:
12683 case OPT_BYTELENGTH:
12684 if (argc != 3) {
12685 Jim_WrongNumArgs(interp, 2, argv, "string");
12686 return JIM_ERR;
12688 if (option == OPT_LENGTH) {
12689 len = Jim_Utf8Length(interp, argv[2]);
12691 else {
12692 len = Jim_Length(argv[2]);
12694 Jim_SetResultInt(interp, len);
12695 return JIM_OK;
12697 case OPT_COMPARE:
12698 case OPT_EQUAL:
12699 if (argc != 4 &&
12700 (argc != 5 ||
12701 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12702 JIM_ENUM_ABBREV) != JIM_OK)) {
12703 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? string1 string2");
12704 return JIM_ERR;
12706 if (opt_case == 0) {
12707 argv++;
12709 if (option == OPT_COMPARE || !opt_case) {
12710 Jim_SetResultInt(interp, Jim_StringCompareObj(interp, argv[2], argv[3], !opt_case));
12712 else {
12713 Jim_SetResultBool(interp, Jim_StringEqObj(argv[2], argv[3]));
12715 return JIM_OK;
12717 case OPT_MATCH:
12718 if (argc != 4 &&
12719 (argc != 5 ||
12720 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12721 JIM_ENUM_ABBREV) != JIM_OK)) {
12722 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
12723 return JIM_ERR;
12725 if (opt_case == 0) {
12726 argv++;
12728 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
12729 return JIM_OK;
12731 case OPT_MAP:{
12732 Jim_Obj *objPtr;
12734 if (argc != 4 &&
12735 (argc != 5 ||
12736 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12737 JIM_ENUM_ABBREV) != JIM_OK)) {
12738 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
12739 return JIM_ERR;
12742 if (opt_case == 0) {
12743 argv++;
12745 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
12746 if (objPtr == NULL) {
12747 return JIM_ERR;
12749 Jim_SetResult(interp, objPtr);
12750 return JIM_OK;
12753 case OPT_RANGE:
12754 case OPT_BYTERANGE:{
12755 Jim_Obj *objPtr;
12757 if (argc != 5) {
12758 Jim_WrongNumArgs(interp, 2, argv, "string first last");
12759 return JIM_ERR;
12761 if (option == OPT_RANGE) {
12762 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
12764 else
12766 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
12769 if (objPtr == NULL) {
12770 return JIM_ERR;
12772 Jim_SetResult(interp, objPtr);
12773 return JIM_OK;
12776 case OPT_REPEAT:{
12777 Jim_Obj *objPtr;
12778 jim_wide count;
12780 if (argc != 4) {
12781 Jim_WrongNumArgs(interp, 2, argv, "string count");
12782 return JIM_ERR;
12784 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
12785 return JIM_ERR;
12787 objPtr = Jim_NewStringObj(interp, "", 0);
12788 if (count > 0) {
12789 while (count--) {
12790 Jim_AppendObj(interp, objPtr, argv[2]);
12793 Jim_SetResult(interp, objPtr);
12794 return JIM_OK;
12797 case OPT_REVERSE:{
12798 char *buf, *p;
12799 const char *str;
12800 int len;
12801 int i;
12803 if (argc != 3) {
12804 Jim_WrongNumArgs(interp, 2, argv, "string");
12805 return JIM_ERR;
12808 str = Jim_GetString(argv[2], &len);
12809 if (!str) {
12810 return JIM_ERR;
12813 buf = Jim_Alloc(len + 1);
12814 p = buf + len;
12815 *p = 0;
12816 for (i = 0; i < len; ) {
12817 int c;
12818 int l = utf8_tounicode(str, &c);
12819 memcpy(p - l, str, l);
12820 p -= l;
12821 i += l;
12822 str += l;
12824 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
12825 return JIM_OK;
12828 case OPT_INDEX:{
12829 int idx;
12830 const char *str;
12832 if (argc != 4) {
12833 Jim_WrongNumArgs(interp, 2, argv, "string index");
12834 return JIM_ERR;
12836 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
12837 return JIM_ERR;
12839 str = Jim_String(argv[2]);
12840 len = Jim_Utf8Length(interp, argv[2]);
12841 if (idx != INT_MIN && idx != INT_MAX) {
12842 idx = JimRelToAbsIndex(len, idx);
12844 if (idx < 0 || idx >= len || str == NULL) {
12845 Jim_SetResultString(interp, "", 0);
12847 else if (len == Jim_Length(argv[2])) {
12848 /* ASCII optimisation */
12849 Jim_SetResultString(interp, str + idx, 1);
12851 else {
12852 int c;
12853 int i = utf8_index(str, idx);
12854 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
12856 return JIM_OK;
12859 case OPT_FIRST:
12860 case OPT_LAST:{
12861 int idx = 0, l1, l2;
12862 const char *s1, *s2;
12864 if (argc != 4 && argc != 5) {
12865 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
12866 return JIM_ERR;
12868 s1 = Jim_String(argv[2]);
12869 s2 = Jim_String(argv[3]);
12870 l1 = Jim_Utf8Length(interp, argv[2]);
12871 l2 = Jim_Utf8Length(interp, argv[3]);
12872 if (argc == 5) {
12873 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
12874 return JIM_ERR;
12876 idx = JimRelToAbsIndex(l2, idx);
12878 else if (option == OPT_LAST) {
12879 idx = l2;
12881 if (option == OPT_FIRST) {
12882 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
12884 else {
12885 #ifdef JIM_UTF8
12886 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
12887 #else
12888 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
12889 #endif
12891 return JIM_OK;
12894 case OPT_TRIM:
12895 case OPT_TRIMLEFT:
12896 case OPT_TRIMRIGHT:{
12897 Jim_Obj *trimchars;
12899 if (argc != 3 && argc != 4) {
12900 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
12901 return JIM_ERR;
12903 trimchars = (argc == 4 ? argv[3] : NULL);
12904 if (option == OPT_TRIM) {
12905 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
12907 else if (option == OPT_TRIMLEFT) {
12908 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
12910 else if (option == OPT_TRIMRIGHT) {
12911 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
12913 return JIM_OK;
12916 case OPT_TOLOWER:
12917 case OPT_TOUPPER:
12918 if (argc != 3) {
12919 Jim_WrongNumArgs(interp, 2, argv, "string");
12920 return JIM_ERR;
12922 if (option == OPT_TOLOWER) {
12923 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
12925 else {
12926 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
12928 return JIM_OK;
12930 case OPT_IS:
12931 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
12932 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
12934 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
12935 return JIM_ERR;
12937 return JIM_OK;
12940 /* [time] */
12941 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12943 long i, count = 1;
12944 jim_wide start, elapsed;
12945 char buf[60];
12946 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
12948 if (argc < 2) {
12949 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
12950 return JIM_ERR;
12952 if (argc == 3) {
12953 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
12954 return JIM_ERR;
12956 if (count < 0)
12957 return JIM_OK;
12958 i = count;
12959 start = JimClock();
12960 while (i-- > 0) {
12961 int retval;
12963 retval = Jim_EvalObj(interp, argv[1]);
12964 if (retval != JIM_OK) {
12965 return retval;
12968 elapsed = JimClock() - start;
12969 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
12970 Jim_SetResultString(interp, buf, -1);
12971 return JIM_OK;
12974 /* [exit] */
12975 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12977 long exitCode = 0;
12979 if (argc > 2) {
12980 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
12981 return JIM_ERR;
12983 if (argc == 2) {
12984 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
12985 return JIM_ERR;
12987 interp->exitCode = exitCode;
12988 return JIM_EXIT;
12991 /* [catch] */
12992 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12994 int exitCode = 0;
12995 int i;
12996 int sig = 0;
12998 /* Which return codes are caught? These are the defaults */
12999 jim_wide mask =
13000 (1 << JIM_OK | 1 << JIM_ERR | 1 << JIM_BREAK | 1 << JIM_CONTINUE | 1 << JIM_RETURN);
13002 /* Reset the error code before catch.
13003 * Note that this is not strictly correct.
13005 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13007 for (i = 1; i < argc - 1; i++) {
13008 const char *arg = Jim_String(argv[i]);
13009 jim_wide option;
13010 int add;
13012 /* It's a pity we can't use Jim_GetEnum here :-( */
13013 if (strcmp(arg, "--") == 0) {
13014 i++;
13015 break;
13017 if (*arg != '-') {
13018 break;
13021 if (strncmp(arg, "-no", 3) == 0) {
13022 arg += 3;
13023 add = 0;
13025 else {
13026 arg++;
13027 add = 1;
13030 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13031 option = -1;
13033 if (option < 0) {
13034 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13036 if (option < 0) {
13037 goto wrongargs;
13040 if (add) {
13041 mask |= (1 << option);
13043 else {
13044 mask &= ~(1 << option);
13048 argc -= i;
13049 if (argc < 1 || argc > 3) {
13050 wrongargs:
13051 Jim_WrongNumArgs(interp, 1, argv,
13052 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13053 return JIM_ERR;
13055 argv += i;
13057 if (mask & (1 << JIM_SIGNAL)) {
13058 sig++;
13061 interp->signal_level += sig;
13062 if (interp->signal_level && interp->sigmask) {
13063 /* If a signal is set, don't even try to execute the body */
13064 exitCode = JIM_SIGNAL;
13066 else {
13067 exitCode = Jim_EvalObj(interp, argv[0]);
13069 interp->signal_level -= sig;
13071 /* Catch or pass through? Only the first 64 codes can be passed through */
13072 if (exitCode >= 0 && exitCode < (int)sizeof(mask) && ((1 << exitCode) & mask) == 0) {
13073 /* Not caught, pass it up */
13074 return exitCode;
13077 if (sig && exitCode == JIM_SIGNAL) {
13078 /* Catch the signal at this level */
13079 if (interp->signal_set_result) {
13080 interp->signal_set_result(interp, interp->sigmask);
13082 else {
13083 Jim_SetResultInt(interp, interp->sigmask);
13085 interp->sigmask = 0;
13088 if (argc >= 2) {
13089 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13090 return JIM_ERR;
13092 if (argc == 3) {
13093 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13095 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13096 Jim_ListAppendElement(interp, optListObj,
13097 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13098 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13099 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13100 if (exitCode == JIM_ERR) {
13101 Jim_Obj *errorCode;
13102 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13103 -1));
13104 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13106 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13107 if (errorCode) {
13108 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13109 Jim_ListAppendElement(interp, optListObj, errorCode);
13112 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13113 return JIM_ERR;
13117 Jim_SetResultInt(interp, exitCode);
13118 return JIM_OK;
13121 #ifdef JIM_REFERENCES
13123 /* [ref] */
13124 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13126 if (argc != 3 && argc != 4) {
13127 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13128 return JIM_ERR;
13130 if (argc == 3) {
13131 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13133 else {
13134 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13136 return JIM_OK;
13139 /* [getref] */
13140 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13142 Jim_Reference *refPtr;
13144 if (argc != 2) {
13145 Jim_WrongNumArgs(interp, 1, argv, "reference");
13146 return JIM_ERR;
13148 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13149 return JIM_ERR;
13150 Jim_SetResult(interp, refPtr->objPtr);
13151 return JIM_OK;
13154 /* [setref] */
13155 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13157 Jim_Reference *refPtr;
13159 if (argc != 3) {
13160 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13161 return JIM_ERR;
13163 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13164 return JIM_ERR;
13165 Jim_IncrRefCount(argv[2]);
13166 Jim_DecrRefCount(interp, refPtr->objPtr);
13167 refPtr->objPtr = argv[2];
13168 Jim_SetResult(interp, argv[2]);
13169 return JIM_OK;
13172 /* [collect] */
13173 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13175 if (argc != 1) {
13176 Jim_WrongNumArgs(interp, 1, argv, "");
13177 return JIM_ERR;
13179 Jim_SetResultInt(interp, Jim_Collect(interp));
13181 /* Free all the freed objects. */
13182 while (interp->freeList) {
13183 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13184 Jim_Free(interp->freeList);
13185 interp->freeList = nextObjPtr;
13188 return JIM_OK;
13191 /* [finalize] reference ?newValue? */
13192 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13194 if (argc != 2 && argc != 3) {
13195 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13196 return JIM_ERR;
13198 if (argc == 2) {
13199 Jim_Obj *cmdNamePtr;
13201 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13202 return JIM_ERR;
13203 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13204 Jim_SetResult(interp, cmdNamePtr);
13206 else {
13207 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13208 return JIM_ERR;
13209 Jim_SetResult(interp, argv[2]);
13211 return JIM_OK;
13214 /* [info references] */
13215 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13217 Jim_Obj *listObjPtr;
13218 Jim_HashTableIterator *htiter;
13219 Jim_HashEntry *he;
13221 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13223 htiter = Jim_GetHashTableIterator(&interp->references);
13224 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
13225 char buf[JIM_REFERENCE_SPACE];
13226 Jim_Reference *refPtr = he->val;
13227 const jim_wide *refId = he->key;
13229 JimFormatReference(buf, refPtr, *refId);
13230 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
13232 Jim_FreeHashTableIterator(htiter);
13233 Jim_SetResult(interp, listObjPtr);
13234 return JIM_OK;
13236 #endif
13238 /* [rename] */
13239 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13241 const char *oldName, *newName;
13243 if (argc != 3) {
13244 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
13245 return JIM_ERR;
13248 if (JimValidName(interp, "new procedure", argv[2])) {
13249 return JIM_ERR;
13252 oldName = Jim_String(argv[1]);
13253 newName = Jim_String(argv[2]);
13254 return Jim_RenameCommand(interp, oldName, newName);
13257 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj)
13259 int i;
13260 int len;
13261 Jim_Obj *resultObj;
13262 Jim_Obj *dictObj;
13263 Jim_Obj **dictValuesObj;
13265 if (Jim_DictKeysVector(interp, objPtr, NULL, 0, &dictObj, JIM_ERRMSG) != JIM_OK) {
13266 return JIM_ERR;
13269 /* XXX: Could make the exact-match case much more efficient here.
13270 * See JimCommandsList()
13272 if (Jim_DictPairs(interp, dictObj, &dictValuesObj, &len) != JIM_OK) {
13273 return JIM_ERR;
13276 /* Only return the matching values */
13277 resultObj = Jim_NewListObj(interp, NULL, 0);
13279 for (i = 0; i < len; i += 2) {
13280 if (patternObj == NULL || Jim_StringMatchObj(interp, patternObj, dictValuesObj[i], 0)) {
13281 Jim_ListAppendElement(interp, resultObj, dictValuesObj[i]);
13284 Jim_Free(dictValuesObj);
13286 Jim_SetResult(interp, resultObj);
13287 return JIM_OK;
13290 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
13292 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13293 return -1;
13295 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
13298 /* [dict] */
13299 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13301 Jim_Obj *objPtr;
13302 int option;
13303 const char *options[] = {
13304 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
13306 enum
13308 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST, OPT_KEYS, OPT_MERGE, OPT_SIZE, OPT_WITH,
13311 if (argc < 2) {
13312 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
13313 return JIM_ERR;
13316 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
13317 return JIM_ERR;
13320 switch (option) {
13321 case OPT_GET:
13322 if (argc < 3) {
13323 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
13324 return JIM_ERR;
13326 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
13327 JIM_ERRMSG) != JIM_OK) {
13328 return JIM_ERR;
13330 Jim_SetResult(interp, objPtr);
13331 return JIM_OK;
13333 case OPT_SET:
13334 if (argc < 5) {
13335 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
13336 return JIM_ERR;
13338 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
13340 case OPT_EXIST:
13341 if (argc < 3) {
13342 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
13343 return JIM_ERR;
13345 Jim_SetResultBool(interp, Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3,
13346 &objPtr, JIM_ERRMSG) == JIM_OK);
13347 return JIM_OK;
13349 case OPT_UNSET:
13350 if (argc < 4) {
13351 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
13352 return JIM_ERR;
13354 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL);
13356 case OPT_KEYS:
13357 if (argc != 3 && argc != 4) {
13358 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?pattern?");
13359 return JIM_ERR;
13361 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
13363 case OPT_SIZE: {
13364 int size;
13366 if (argc != 3) {
13367 Jim_WrongNumArgs(interp, 2, argv, "dictVar");
13368 return JIM_ERR;
13371 size = Jim_DictSize(interp, argv[2]);
13372 if (size < 0) {
13373 return JIM_ERR;
13375 Jim_SetResultInt(interp, size);
13376 return JIM_OK;
13379 case OPT_MERGE:
13380 if (argc == 2) {
13381 return JIM_OK;
13383 else if (argv[2]->typePtr != &dictObjType && SetDictFromAny(interp, argv[2]) != JIM_OK) {
13384 return JIM_ERR;
13386 else {
13387 return Jim_EvalObjPrefix(interp, "dict merge", argc - 2, argv + 2);
13390 case OPT_WITH:
13391 if (argc < 4) {
13392 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
13393 return JIM_ERR;
13395 else if (Jim_GetVariable(interp, argv[2], JIM_ERRMSG) == NULL) {
13396 return JIM_ERR;
13398 else {
13399 return Jim_EvalObjPrefix(interp, "dict with", argc - 2, argv + 2);
13402 case OPT_CREATE:
13403 if (argc % 2) {
13404 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
13405 return JIM_ERR;
13407 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
13408 Jim_SetResult(interp, objPtr);
13409 return JIM_OK;
13411 default:
13412 abort();
13416 /* [subst] */
13417 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13419 const char *options[] = {
13420 "-nobackslashes", "-nocommands", "-novariables", NULL
13422 enum
13423 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
13424 int i;
13425 int flags = JIM_SUBST_FLAG;
13426 Jim_Obj *objPtr;
13428 if (argc < 2) {
13429 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
13430 return JIM_ERR;
13432 for (i = 1; i < (argc - 1); i++) {
13433 int option;
13435 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
13436 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
13437 return JIM_ERR;
13439 switch (option) {
13440 case OPT_NOBACKSLASHES:
13441 flags |= JIM_SUBST_NOESC;
13442 break;
13443 case OPT_NOCOMMANDS:
13444 flags |= JIM_SUBST_NOCMD;
13445 break;
13446 case OPT_NOVARIABLES:
13447 flags |= JIM_SUBST_NOVAR;
13448 break;
13451 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
13452 return JIM_ERR;
13454 Jim_SetResult(interp, objPtr);
13455 return JIM_OK;
13458 /* [info] */
13459 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13461 int cmd;
13462 Jim_Obj *objPtr;
13463 int mode = 0;
13465 static const char * const commands[] = {
13466 "body", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
13467 "vars", "version", "patchlevel", "complete", "args", "hostname",
13468 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
13469 "references", NULL
13471 enum
13472 { INFO_BODY, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
13473 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
13474 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
13475 INFO_RETURNCODES, INFO_REFERENCES,
13478 if (argc < 2) {
13479 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
13480 return JIM_ERR;
13482 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
13483 != JIM_OK) {
13484 return JIM_ERR;
13487 /* Test for the the most common commands first, just in case it makes a difference */
13488 switch (cmd) {
13489 case INFO_EXISTS:{
13490 if (argc != 3) {
13491 Jim_WrongNumArgs(interp, 2, argv, "varName");
13492 return JIM_ERR;
13494 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
13495 break;
13498 case INFO_CHANNELS:
13499 #ifndef jim_ext_aio
13500 Jim_SetResultString(interp, "aio not enabled", -1);
13501 return JIM_ERR;
13502 #endif
13503 case INFO_COMMANDS:
13504 case INFO_PROCS:
13505 if (argc != 2 && argc != 3) {
13506 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
13507 return JIM_ERR;
13509 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL,
13510 (cmd - INFO_COMMANDS)));
13511 break;
13513 case INFO_VARS:
13514 mode++; /* JIM_VARLIST_VARS */
13515 case INFO_LOCALS:
13516 mode++; /* JIM_VARLIST_LOCALS */
13517 case INFO_GLOBALS:
13518 /* mode 0 => JIM_VARLIST_GLOBALS */
13519 if (argc != 2 && argc != 3) {
13520 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
13521 return JIM_ERR;
13523 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
13524 break;
13526 case INFO_SCRIPT:
13527 if (argc != 2) {
13528 Jim_WrongNumArgs(interp, 2, argv, "");
13529 return JIM_ERR;
13531 Jim_SetResultString(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileName,
13532 -1);
13533 break;
13535 case INFO_SOURCE:{
13536 const char *filename = "";
13537 int line = 0;
13538 Jim_Obj *resObjPtr;
13540 if (argc != 3) {
13541 Jim_WrongNumArgs(interp, 2, argv, "source");
13542 return JIM_ERR;
13544 if (argv[2]->typePtr == &sourceObjType) {
13545 filename = argv[2]->internalRep.sourceValue.fileName;
13546 line = argv[2]->internalRep.sourceValue.lineNumber;
13548 else if (argv[2]->typePtr == &scriptObjType) {
13549 ScriptObj *script = Jim_GetScript(interp, argv[2]);
13550 filename = script->fileName;
13551 line = script->line;
13553 resObjPtr = Jim_NewListObj(interp, NULL, 0);
13554 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObj(interp, filename, -1));
13555 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
13556 Jim_SetResult(interp, resObjPtr);
13557 break;
13560 case INFO_STACKTRACE:
13561 Jim_SetResult(interp, interp->stackTrace);
13562 break;
13564 case INFO_LEVEL:
13565 case INFO_FRAME:
13566 switch (argc) {
13567 case 2:
13568 Jim_SetResultInt(interp, interp->framePtr->level);
13569 break;
13571 case 3:
13572 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
13573 return JIM_ERR;
13575 Jim_SetResult(interp, objPtr);
13576 break;
13578 default:
13579 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
13580 return JIM_ERR;
13582 break;
13584 case INFO_BODY:
13585 case INFO_ARGS:{
13586 Jim_Cmd *cmdPtr;
13588 if (argc != 3) {
13589 Jim_WrongNumArgs(interp, 2, argv, "procname");
13590 return JIM_ERR;
13592 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
13593 return JIM_ERR;
13595 if (!cmdPtr->isproc) {
13596 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
13597 return JIM_ERR;
13599 Jim_SetResult(interp,
13600 cmd == INFO_BODY ? cmdPtr->u.proc.bodyObjPtr : cmdPtr->u.proc.argListObjPtr);
13601 break;
13604 case INFO_VERSION:
13605 case INFO_PATCHLEVEL:{
13606 char buf[(JIM_INTEGER_SPACE * 2) + 1];
13608 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
13609 Jim_SetResultString(interp, buf, -1);
13610 break;
13613 case INFO_COMPLETE:
13614 if (argc != 3 && argc != 4) {
13615 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
13616 return JIM_ERR;
13618 else {
13619 int len;
13620 const char *s = Jim_GetString(argv[2], &len);
13621 char missing = '\0';
13623 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
13624 if (missing && argc == 4) {
13625 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
13628 break;
13630 case INFO_HOSTNAME:
13631 /* Redirect to os.gethostname if it exists */
13632 return Jim_Eval(interp, "os.gethostname");
13634 case INFO_NAMEOFEXECUTABLE:
13635 /* Redirect to Tcl proc */
13636 return Jim_Eval(interp, "{info nameofexecutable}");
13638 case INFO_RETURNCODES:
13639 if (argc == 2) {
13640 int i;
13641 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13643 for (i = 0; jimReturnCodes[i]; i++) {
13644 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
13645 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
13646 jimReturnCodes[i], -1));
13649 Jim_SetResult(interp, listObjPtr);
13651 else if (argc == 3) {
13652 long code;
13653 const char *name;
13655 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
13656 return JIM_ERR;
13658 name = Jim_ReturnCode(code);
13659 if (*name == '?') {
13660 Jim_SetResultInt(interp, code);
13662 else {
13663 Jim_SetResultString(interp, name, -1);
13666 else {
13667 Jim_WrongNumArgs(interp, 2, argv, "?code?");
13668 return JIM_ERR;
13670 break;
13671 case INFO_REFERENCES:
13672 #ifdef JIM_REFERENCES
13673 return JimInfoReferences(interp, argc, argv);
13674 #else
13675 Jim_SetResultString(interp, "not supported", -1);
13676 return JIM_ERR;
13677 #endif
13679 return JIM_OK;
13682 /* [exists] */
13683 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13685 Jim_Obj *objPtr;
13687 static const char * const options[] = {
13688 "-command", "-proc", "-var", NULL
13690 enum
13692 OPT_COMMAND, OPT_PROC, OPT_VAR
13694 int option;
13696 if (argc == 2) {
13697 option = OPT_VAR;
13698 objPtr = argv[1];
13700 else if (argc == 3) {
13701 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
13702 return JIM_ERR;
13704 objPtr = argv[2];
13706 else {
13707 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
13708 return JIM_ERR;
13711 /* Test for the the most common commands first, just in case it makes a difference */
13712 switch (option) {
13713 case OPT_VAR:
13714 Jim_SetResultBool(interp, Jim_GetVariable(interp, objPtr, 0) != NULL);
13715 break;
13717 case OPT_COMMAND:
13718 case OPT_PROC: {
13719 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
13720 Jim_SetResultBool(interp, cmd != NULL && (option == OPT_COMMAND || cmd->isproc));
13721 break;
13724 return JIM_OK;
13727 /* [split] */
13728 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13730 const char *str, *splitChars, *noMatchStart;
13731 int splitLen, strLen;
13732 Jim_Obj *resObjPtr;
13733 int c;
13734 int len;
13736 if (argc != 2 && argc != 3) {
13737 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
13738 return JIM_ERR;
13741 str = Jim_GetString(argv[1], &len);
13742 if (len == 0) {
13743 return JIM_OK;
13745 strLen = Jim_Utf8Length(interp, argv[1]);
13747 /* Init */
13748 if (argc == 2) {
13749 splitChars = " \n\t\r";
13750 splitLen = 4;
13752 else {
13753 splitChars = Jim_String(argv[2]);
13754 splitLen = Jim_Utf8Length(interp, argv[2]);
13757 noMatchStart = str;
13758 resObjPtr = Jim_NewListObj(interp, NULL, 0);
13760 /* Split */
13761 if (splitLen) {
13762 Jim_Obj *objPtr;
13763 while (strLen--) {
13764 const char *sc = splitChars;
13765 int scLen = splitLen;
13766 int sl = utf8_tounicode(str, &c);
13767 while (scLen--) {
13768 int pc;
13769 sc += utf8_tounicode(sc, &pc);
13770 if (c == pc) {
13771 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
13772 Jim_ListAppendElement(interp, resObjPtr, objPtr);
13773 noMatchStart = str + sl;
13774 break;
13777 str += sl;
13779 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
13780 Jim_ListAppendElement(interp, resObjPtr, objPtr);
13782 else {
13783 /* This handles the special case of splitchars eq {}
13784 * Optimise by sharing common (ASCII) characters
13786 Jim_Obj **commonObj = NULL;
13787 #define NUM_COMMON (128 - 32)
13788 while (strLen--) {
13789 int n = utf8_tounicode(str, &c);
13790 #ifdef JIM_OPTIMIZATION
13791 if (c >= 32 && c < 128) {
13792 /* Common ASCII char */
13793 c -= 32;
13794 if (!commonObj) {
13795 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
13796 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
13798 if (!commonObj[c]) {
13799 commonObj[c] = Jim_NewStringObj(interp, str, 1);
13801 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
13802 str++;
13803 continue;
13805 #endif
13806 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
13807 str += n;
13809 Jim_Free(commonObj);
13812 Jim_SetResult(interp, resObjPtr);
13813 return JIM_OK;
13816 /* [join] */
13817 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13819 const char *joinStr;
13820 int joinStrLen, i, listLen;
13821 Jim_Obj *resObjPtr;
13823 if (argc != 2 && argc != 3) {
13824 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
13825 return JIM_ERR;
13827 /* Init */
13828 if (argc == 2) {
13829 joinStr = " ";
13830 joinStrLen = 1;
13832 else {
13833 joinStr = Jim_GetString(argv[2], &joinStrLen);
13835 listLen = Jim_ListLength(interp, argv[1]);
13836 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
13837 /* Split */
13838 for (i = 0; i < listLen; i++) {
13839 Jim_Obj *objPtr = 0;
13841 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
13842 Jim_AppendObj(interp, resObjPtr, objPtr);
13843 if (i + 1 != listLen) {
13844 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
13847 Jim_SetResult(interp, resObjPtr);
13848 return JIM_OK;
13851 /* [format] */
13852 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13854 Jim_Obj *objPtr;
13856 if (argc < 2) {
13857 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
13858 return JIM_ERR;
13860 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
13861 if (objPtr == NULL)
13862 return JIM_ERR;
13863 Jim_SetResult(interp, objPtr);
13864 return JIM_OK;
13867 /* [scan] */
13868 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13870 Jim_Obj *listPtr, **outVec;
13871 int outc, i;
13873 if (argc < 3) {
13874 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
13875 return JIM_ERR;
13877 if (argv[2]->typePtr != &scanFmtStringObjType)
13878 SetScanFmtFromAny(interp, argv[2]);
13879 if (FormatGetError(argv[2]) != 0) {
13880 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
13881 return JIM_ERR;
13883 if (argc > 3) {
13884 int maxPos = FormatGetMaxPos(argv[2]);
13885 int count = FormatGetCnvCount(argv[2]);
13887 if (maxPos > argc - 3) {
13888 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
13889 return JIM_ERR;
13891 else if (count > argc - 3) {
13892 Jim_SetResultString(interp, "different numbers of variable names and "
13893 "field specifiers", -1);
13894 return JIM_ERR;
13896 else if (count < argc - 3) {
13897 Jim_SetResultString(interp, "variable is not assigned by any "
13898 "conversion specifiers", -1);
13899 return JIM_ERR;
13902 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
13903 if (listPtr == 0)
13904 return JIM_ERR;
13905 if (argc > 3) {
13906 int rc = JIM_OK;
13907 int count = 0;
13909 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
13910 int len = Jim_ListLength(interp, listPtr);
13912 if (len != 0) {
13913 JimListGetElements(interp, listPtr, &outc, &outVec);
13914 for (i = 0; i < outc; ++i) {
13915 if (Jim_Length(outVec[i]) > 0) {
13916 ++count;
13917 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
13918 rc = JIM_ERR;
13923 Jim_FreeNewObj(interp, listPtr);
13925 else {
13926 count = -1;
13928 if (rc == JIM_OK) {
13929 Jim_SetResultInt(interp, count);
13931 return rc;
13933 else {
13934 if (listPtr == (Jim_Obj *)EOF) {
13935 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
13936 return JIM_OK;
13938 Jim_SetResult(interp, listPtr);
13940 return JIM_OK;
13943 /* [error] */
13944 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13946 if (argc != 2 && argc != 3) {
13947 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
13948 return JIM_ERR;
13950 Jim_SetResult(interp, argv[1]);
13951 if (argc == 3) {
13952 JimSetStackTrace(interp, argv[2]);
13953 return JIM_ERR;
13955 interp->addStackTrace++;
13956 return JIM_ERR;
13959 /* [lrange] */
13960 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13962 Jim_Obj *objPtr;
13964 if (argc != 4) {
13965 Jim_WrongNumArgs(interp, 1, argv, "list first last");
13966 return JIM_ERR;
13968 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
13969 return JIM_ERR;
13970 Jim_SetResult(interp, objPtr);
13971 return JIM_OK;
13974 /* [lrepeat] */
13975 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13977 Jim_Obj *objPtr;
13978 long count;
13980 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
13981 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
13982 return JIM_ERR;
13985 if (count == 0 || argc == 2) {
13986 return JIM_OK;
13989 argc -= 2;
13990 argv += 2;
13992 objPtr = Jim_NewListObj(interp, argv, argc);
13993 while (--count) {
13994 int i;
13996 for (i = 0; i < argc; i++) {
13997 ListAppendElement(objPtr, argv[i]);
14001 Jim_SetResult(interp, objPtr);
14002 return JIM_OK;
14005 char **Jim_GetEnviron(void)
14007 #if defined(HAVE__NSGETENVIRON)
14008 return *_NSGetEnviron();
14009 #else
14010 #if !defined(NO_ENVIRON_EXTERN)
14011 extern char **environ;
14012 #endif
14014 return environ;
14015 #endif
14018 void Jim_SetEnviron(char **env)
14020 #if defined(HAVE__NSGETENVIRON)
14021 *_NSGetEnviron() = env;
14022 #else
14023 #if !defined(NO_ENVIRON_EXTERN)
14024 extern char **environ;
14025 #endif
14027 environ = env;
14028 #endif
14031 /* [env] */
14032 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14034 const char *key;
14035 const char *val;
14037 if (argc == 1) {
14038 char **e = Jim_GetEnviron();
14040 int i;
14041 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14043 for (i = 0; e[i]; i++) {
14044 const char *equals = strchr(e[i], '=');
14046 if (equals) {
14047 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14048 equals - e[i]));
14049 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14053 Jim_SetResult(interp, listObjPtr);
14054 return JIM_OK;
14057 if (argc < 2) {
14058 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14059 return JIM_ERR;
14061 key = Jim_String(argv[1]);
14062 val = getenv(key);
14063 if (val == NULL) {
14064 if (argc < 3) {
14065 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14066 return JIM_ERR;
14068 val = Jim_String(argv[2]);
14070 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
14071 return JIM_OK;
14074 /* [source] */
14075 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14077 int retval;
14079 if (argc != 2) {
14080 Jim_WrongNumArgs(interp, 1, argv, "fileName");
14081 return JIM_ERR;
14083 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
14084 if (retval == JIM_RETURN)
14085 return JIM_OK;
14086 return retval;
14089 /* [lreverse] */
14090 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14092 Jim_Obj *revObjPtr, **ele;
14093 int len;
14095 if (argc != 2) {
14096 Jim_WrongNumArgs(interp, 1, argv, "list");
14097 return JIM_ERR;
14099 JimListGetElements(interp, argv[1], &len, &ele);
14100 len--;
14101 revObjPtr = Jim_NewListObj(interp, NULL, 0);
14102 while (len >= 0)
14103 ListAppendElement(revObjPtr, ele[len--]);
14104 Jim_SetResult(interp, revObjPtr);
14105 return JIM_OK;
14108 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
14110 jim_wide len;
14112 if (step == 0)
14113 return -1;
14114 if (start == end)
14115 return 0;
14116 else if (step > 0 && start > end)
14117 return -1;
14118 else if (step < 0 && end > start)
14119 return -1;
14120 len = end - start;
14121 if (len < 0)
14122 len = -len; /* abs(len) */
14123 if (step < 0)
14124 step = -step; /* abs(step) */
14125 len = 1 + ((len - 1) / step);
14126 /* We can truncate safely to INT_MAX, the range command
14127 * will always return an error for a such long range
14128 * because Tcl lists can't be so long. */
14129 if (len > INT_MAX)
14130 len = INT_MAX;
14131 return (int)((len < 0) ? -1 : len);
14134 /* [range] */
14135 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14137 jim_wide start = 0, end, step = 1;
14138 int len, i;
14139 Jim_Obj *objPtr;
14141 if (argc < 2 || argc > 4) {
14142 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
14143 return JIM_ERR;
14145 if (argc == 2) {
14146 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
14147 return JIM_ERR;
14149 else {
14150 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
14151 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
14152 return JIM_ERR;
14153 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
14154 return JIM_ERR;
14156 if ((len = JimRangeLen(start, end, step)) == -1) {
14157 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
14158 return JIM_ERR;
14160 objPtr = Jim_NewListObj(interp, NULL, 0);
14161 for (i = 0; i < len; i++)
14162 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
14163 Jim_SetResult(interp, objPtr);
14164 return JIM_OK;
14167 /* [rand] */
14168 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14170 jim_wide min = 0, max = 0, len, maxMul;
14172 if (argc < 1 || argc > 3) {
14173 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
14174 return JIM_ERR;
14176 if (argc == 1) {
14177 max = JIM_WIDE_MAX;
14178 } else if (argc == 2) {
14179 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
14180 return JIM_ERR;
14181 } else if (argc == 3) {
14182 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
14183 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
14184 return JIM_ERR;
14186 len = max-min;
14187 if (len < 0) {
14188 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
14189 return JIM_ERR;
14191 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
14192 while (1) {
14193 jim_wide r;
14195 JimRandomBytes(interp, &r, sizeof(jim_wide));
14196 if (r < 0 || r >= maxMul) continue;
14197 r = (len == 0) ? 0 : r%len;
14198 Jim_SetResultInt(interp, min+r);
14199 return JIM_OK;
14203 static const struct {
14204 const char *name;
14205 Jim_CmdProc cmdProc;
14206 } Jim_CoreCommandsTable[] = {
14207 {"set", Jim_SetCoreCommand},
14208 {"unset", Jim_UnsetCoreCommand},
14209 {"puts", Jim_PutsCoreCommand},
14210 {"+", Jim_AddCoreCommand},
14211 {"*", Jim_MulCoreCommand},
14212 {"-", Jim_SubCoreCommand},
14213 {"/", Jim_DivCoreCommand},
14214 {"incr", Jim_IncrCoreCommand},
14215 {"while", Jim_WhileCoreCommand},
14216 {"loop", Jim_LoopCoreCommand},
14217 {"for", Jim_ForCoreCommand},
14218 {"foreach", Jim_ForeachCoreCommand},
14219 {"lmap", Jim_LmapCoreCommand},
14220 {"if", Jim_IfCoreCommand},
14221 {"switch", Jim_SwitchCoreCommand},
14222 {"list", Jim_ListCoreCommand},
14223 {"lindex", Jim_LindexCoreCommand},
14224 {"lset", Jim_LsetCoreCommand},
14225 {"lsearch", Jim_LsearchCoreCommand},
14226 {"llength", Jim_LlengthCoreCommand},
14227 {"lappend", Jim_LappendCoreCommand},
14228 {"linsert", Jim_LinsertCoreCommand},
14229 {"lreplace", Jim_LreplaceCoreCommand},
14230 {"lsort", Jim_LsortCoreCommand},
14231 {"append", Jim_AppendCoreCommand},
14232 {"debug", Jim_DebugCoreCommand},
14233 {"eval", Jim_EvalCoreCommand},
14234 {"uplevel", Jim_UplevelCoreCommand},
14235 {"expr", Jim_ExprCoreCommand},
14236 {"break", Jim_BreakCoreCommand},
14237 {"continue", Jim_ContinueCoreCommand},
14238 {"proc", Jim_ProcCoreCommand},
14239 {"concat", Jim_ConcatCoreCommand},
14240 {"return", Jim_ReturnCoreCommand},
14241 {"upvar", Jim_UpvarCoreCommand},
14242 {"global", Jim_GlobalCoreCommand},
14243 {"string", Jim_StringCoreCommand},
14244 {"time", Jim_TimeCoreCommand},
14245 {"exit", Jim_ExitCoreCommand},
14246 {"catch", Jim_CatchCoreCommand},
14247 #ifdef JIM_REFERENCES
14248 {"ref", Jim_RefCoreCommand},
14249 {"getref", Jim_GetrefCoreCommand},
14250 {"setref", Jim_SetrefCoreCommand},
14251 {"finalize", Jim_FinalizeCoreCommand},
14252 {"collect", Jim_CollectCoreCommand},
14253 #endif
14254 {"rename", Jim_RenameCoreCommand},
14255 {"dict", Jim_DictCoreCommand},
14256 {"subst", Jim_SubstCoreCommand},
14257 {"info", Jim_InfoCoreCommand},
14258 {"exists", Jim_ExistsCoreCommand},
14259 {"split", Jim_SplitCoreCommand},
14260 {"join", Jim_JoinCoreCommand},
14261 {"format", Jim_FormatCoreCommand},
14262 {"scan", Jim_ScanCoreCommand},
14263 {"error", Jim_ErrorCoreCommand},
14264 {"lrange", Jim_LrangeCoreCommand},
14265 {"lrepeat", Jim_LrepeatCoreCommand},
14266 {"env", Jim_EnvCoreCommand},
14267 {"source", Jim_SourceCoreCommand},
14268 {"lreverse", Jim_LreverseCoreCommand},
14269 {"range", Jim_RangeCoreCommand},
14270 {"rand", Jim_RandCoreCommand},
14271 {"tailcall", Jim_TailcallCoreCommand},
14272 {"local", Jim_LocalCoreCommand},
14273 {"upcall", Jim_UpcallCoreCommand},
14274 {NULL, NULL},
14277 void Jim_RegisterCoreCommands(Jim_Interp *interp)
14279 int i = 0;
14281 while (Jim_CoreCommandsTable[i].name != NULL) {
14282 Jim_CreateCommand(interp,
14283 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
14284 i++;
14288 /* -----------------------------------------------------------------------------
14289 * Interactive prompt
14290 * ---------------------------------------------------------------------------*/
14291 void Jim_MakeErrorMessage(Jim_Interp *interp)
14293 Jim_Obj *argv[2];
14295 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
14296 argv[1] = interp->result;
14298 Jim_EvalObjVector(interp, 2, argv);
14301 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
14302 const char *prefix, const char *const *tablePtr, const char *name)
14304 int count;
14305 char **tablePtrSorted;
14306 int i;
14308 for (count = 0; tablePtr[count]; count++) {
14311 if (name == NULL) {
14312 name = "option";
14315 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
14316 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
14317 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
14318 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
14319 for (i = 0; i < count; i++) {
14320 if (i + 1 == count && count > 1) {
14321 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
14323 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
14324 if (i + 1 != count) {
14325 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
14328 Jim_Free(tablePtrSorted);
14331 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
14332 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
14334 const char *bad = "bad ";
14335 const char *const *entryPtr = NULL;
14336 int i;
14337 int match = -1;
14338 int arglen;
14339 const char *arg = Jim_GetString(objPtr, &arglen);
14341 *indexPtr = -1;
14343 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
14344 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
14345 /* Found an exact match */
14346 *indexPtr = i;
14347 return JIM_OK;
14349 if (flags & JIM_ENUM_ABBREV) {
14350 /* Accept an unambiguous abbreviation.
14351 * Note that '-' doesnt' consitute a valid abbreviation
14353 if (strncmp(arg, *entryPtr, arglen) == 0) {
14354 if (*arg == '-' && arglen == 1) {
14355 break;
14357 if (match >= 0) {
14358 bad = "ambiguous ";
14359 goto ambiguous;
14361 match = i;
14366 /* If we had an unambiguous partial match */
14367 if (match >= 0) {
14368 *indexPtr = match;
14369 return JIM_OK;
14372 ambiguous:
14373 if (flags & JIM_ERRMSG) {
14374 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
14376 return JIM_ERR;
14379 int Jim_FindByName(const char *name, const char * const array[], size_t len)
14381 int i;
14383 for (i = 0; i < (int)len; i++) {
14384 if (array[i] && strcmp(array[i], name) == 0) {
14385 return i;
14388 return -1;
14391 int Jim_IsDict(Jim_Obj *objPtr)
14393 return objPtr->typePtr == &dictObjType;
14396 int Jim_IsList(Jim_Obj *objPtr)
14398 return objPtr->typePtr == &listObjType;
14402 * Very simple printf-like formatting, designed for error messages.
14404 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
14405 * The resulting string is created and set as the result.
14407 * Each '%s' should correspond to a regular string parameter.
14408 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
14409 * Any other printf specifier is not allowed (but %% is allowed for the % character).
14411 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
14413 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
14415 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
14417 /* Initial space needed */
14418 int len = strlen(format);
14419 int extra = 0;
14420 int n = 0;
14421 const char *params[5];
14422 char *buf;
14423 va_list args;
14424 int i;
14426 va_start(args, format);
14428 for (i = 0; i < len && n < 5; i++) {
14429 int l;
14431 if (strncmp(format + i, "%s", 2) == 0) {
14432 params[n] = va_arg(args, char *);
14434 l = strlen(params[n]);
14436 else if (strncmp(format + i, "%#s", 3) == 0) {
14437 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
14439 params[n] = Jim_GetString(objPtr, &l);
14441 else {
14442 if (format[i] == '%') {
14443 i++;
14445 continue;
14447 n++;
14448 extra += l;
14451 len += extra;
14452 buf = Jim_Alloc(len + 1);
14453 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
14455 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
14458 /* stubs */
14459 #ifndef jim_ext_package
14460 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
14462 return JIM_OK;
14464 #endif
14465 #ifndef jim_ext_aio
14466 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
14468 Jim_SetResultString(interp, "aio not enabled", -1);
14469 return NULL;
14471 #endif
14475 * Local Variables: ***
14476 * c-basic-offset: 4 ***
14477 * tab-width: 4 ***
14478 * End: ***