jim: highlight switch's case fall-through
[jimtcl.git] / jim.c
blob4a551ddf609d5e3435012b19d99aa22c5956bf14
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
130 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
131 int flags);
132 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
133 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
134 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
135 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
136 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
137 const char *prefix, const char *const *tablePtr, const char *name);
138 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
139 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
140 static int JimSign(jim_wide w);
141 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
142 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
143 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s, int *uc, int upper)
153 int l = utf8_tounicode(s, uc);
154 if (upper) {
155 *uc = utf8_upper(*uc);
157 return l;
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
182 int not = 0;
183 int pchar;
184 int match = 0;
185 int nocase = 0;
187 if (flags & JIM_NOCASE) {
188 nocase++;
189 c = utf8_upper(c);
192 if (flags & JIM_CHARSET_SCAN) {
193 if (*pattern == '^') {
194 not++;
195 pattern++;
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern == ']') {
200 goto first;
204 while (*pattern && *pattern != ']') {
205 /* Exact match */
206 if (pattern[0] == '\\') {
207 first:
208 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
210 else {
211 /* Is this a range? a-z */
212 int start;
213 int end;
215 pattern += utf8_tounicode_case(pattern, &start, nocase);
216 if (pattern[0] == '-' && pattern[1]) {
217 /* skip '-' */
218 pattern += utf8_tounicode(pattern, &pchar);
219 pattern += utf8_tounicode_case(pattern, &end, nocase);
221 /* Handle reversed range too */
222 if ((c >= start && c <= end) || (c >= end && c <= start)) {
223 match = 1;
225 continue;
227 pchar = start;
230 if (pchar == c) {
231 match = 1;
234 if (not) {
235 match = !match;
238 return match ? pattern : NULL;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
311 * string comparison. Works on binary data.
313 * Returns -1, 0 or 1
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
319 if (l1 < l2) {
320 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
322 else if (l2 < l1) {
323 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
325 else {
326 return JimSign(memcmp(s1, s2, l1));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
340 while (*s1 && *s2 && maxchars) {
341 int c1, c2;
342 s1 += utf8_tounicode_case(s1, &c1, nocase);
343 s2 += utf8_tounicode_case(s2, &c2, nocase);
344 if (c1 != c2) {
345 return JimSign(c1 - c2);
347 maxchars--;
349 if (!maxchars) {
350 return 0;
352 /* One string or both terminated */
353 if (*s1) {
354 return 1;
356 if (*s2) {
357 return -1;
359 return 0;
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
367 int i;
368 int l1bytelen;
370 if (!l1 || !l2 || l1 > l2) {
371 return -1;
373 if (idx < 0)
374 idx = 0;
375 s2 += utf8_index(s2, idx);
377 l1bytelen = utf8_index(s1, l1);
379 for (i = idx; i <= l2 - l1; i++) {
380 int c;
381 if (memcmp(s2, s1, l1bytelen) == 0) {
382 return i;
384 s2 += utf8_tounicode(s2, &c);
386 return -1;
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
394 const char *p;
396 if (!l1 || !l2 || l1 > l2)
397 return -1;
399 /* Now search for the needle */
400 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
401 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
402 return p - s2;
405 return -1;
408 #ifdef JIM_UTF8
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
414 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
415 if (n > 0) {
416 n = utf8_strlen(s2, n);
418 return n;
420 #endif
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str, const char *endptr)
431 if (str[0] == '\0' || str == endptr) {
432 return JIM_ERR;
435 if (endptr[0] != '\0') {
436 while (*endptr) {
437 if (!isspace(UCHAR(*endptr))) {
438 return JIM_ERR;
440 endptr++;
443 return JIM_OK;
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str, int *base, int *sign)
451 int i = 0;
453 *base = 10;
455 while (isspace(UCHAR(str[i]))) {
456 i++;
459 if (str[i] == '-') {
460 *sign = -1;
461 i++;
463 else {
464 if (str[i] == '+') {
465 i++;
467 *sign = 1;
470 if (str[i] != '0') {
471 /* base 10 */
472 return 0;
475 /* We have 0<x>, so see if we can convert it */
476 switch (str[i + 1]) {
477 case 'x': case 'X': *base = 16; break;
478 case 'o': case 'O': *base = 8; break;
479 case 'b': case 'B': *base = 2; break;
480 default: return 0;
482 i += 2;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
485 /* Parse according to this base */
486 return i;
488 /* Parse as base 10 */
489 *base = 10;
490 return 0;
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str, char **endptr)
498 int sign;
499 int base;
500 int i = JimNumberBase(str, &base, &sign);
502 if (base != 10) {
503 long value = strtol(str + i, endptr, base);
504 if (endptr == NULL || *endptr != str + i) {
505 return value * sign;
509 /* Can just do a regular base-10 conversion */
510 return strtol(str, endptr, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide jim_strtoull(const char *str, char **endptr)
519 #ifdef HAVE_LONG_LONG
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 jim_wide value = strtoull(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str, endptr, 10);
533 #else
534 return (unsigned long)jim_strtol(str, endptr);
535 #endif
538 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
540 char *endptr;
542 if (base) {
543 *widePtr = strtoull(str, &endptr, base);
545 else {
546 *widePtr = jim_strtoull(str, &endptr);
549 return JimCheckConversion(str, endptr);
552 int Jim_StringToDouble(const char *str, double *doublePtr)
554 char *endptr;
556 /* Callers can check for underflow via ERANGE */
557 errno = 0;
559 *doublePtr = strtod(str, &endptr);
561 return JimCheckConversion(str, endptr);
564 static jim_wide JimPowWide(jim_wide b, jim_wide e)
566 jim_wide i, res = 1;
568 if ((b == 0 && e != 0) || (e < 0))
569 return 0;
570 for (i = 0; i < e; i++) {
571 res *= b;
573 return res;
576 /* -----------------------------------------------------------------------------
577 * Special functions
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition, const char *fmt, ...)
582 va_list ap;
584 if (!condition) {
585 return;
588 va_start(ap, fmt);
590 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr, fmt, ap);
592 fprintf(stderr, "\n\n");
593 va_end(ap);
595 #ifdef HAVE_BACKTRACE
597 void *array[40];
598 int size, i;
599 char **strings;
601 size = backtrace(array, 40);
602 strings = backtrace_symbols(array, size);
603 for (i = 0; i < size; i++)
604 fprintf(stderr, "[backtrace] %s\n", strings[i]);
605 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
608 #endif
610 exit(1);
612 #endif
614 /* -----------------------------------------------------------------------------
615 * Memory allocation
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size)
620 return size ? malloc(size) : NULL;
623 void Jim_Free(void *ptr)
625 free(ptr);
628 void *Jim_Realloc(void *ptr, int size)
630 return realloc(ptr, size);
633 char *Jim_StrDup(const char *s)
635 return strdup(s);
638 char *Jim_StrDupLen(const char *s, int l)
640 char *copy = Jim_Alloc(l + 1);
642 memcpy(copy, s, l + 1);
643 copy[l] = 0; /* Just to be sure, original could be substring */
644 return copy;
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide JimClock(void)
654 struct timeval tv;
656 gettimeofday(&tv, NULL);
657 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
660 /* -----------------------------------------------------------------------------
661 * Hash Tables
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
666 static unsigned int JimHashTableNextPower(unsigned int size);
667 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key)
674 key += ~(key << 15);
675 key ^= (key >> 10);
676 key += (key << 3);
677 key ^= (key >> 6);
678 key += ~(key << 11);
679 key ^= (key >> 16);
680 return key;
683 /* Generic hash function (we are using to multiply by 9 and add the byte
684 * as Tcl) */
685 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
687 unsigned int h = 0;
689 while (len--)
690 h += (h << 3) + *buf++;
691 return h;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable *ht)
699 ht->table = NULL;
700 ht->size = 0;
701 ht->sizemask = 0;
702 ht->used = 0;
703 ht->collisions = 0;
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht->uniq = (rand() ^ time(NULL) ^ clock());
709 #else
710 ht->uniq = 0;
711 #endif
714 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
716 iter->ht = ht;
717 iter->index = -1;
718 iter->entry = NULL;
719 iter->nextEntry = NULL;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
725 JimResetHashTable(ht);
726 ht->type = type;
727 ht->privdata = privDataPtr;
728 return JIM_OK;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable *ht)
735 int minimal = ht->used;
737 if (minimal < JIM_HT_INITIAL_SIZE)
738 minimal = JIM_HT_INITIAL_SIZE;
739 Jim_ExpandHashTable(ht, minimal);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
745 Jim_HashTable n; /* the new hashtable */
746 unsigned int realsize = JimHashTableNextPower(size), i;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size <= ht->used)
751 return;
753 Jim_InitHashTable(&n, ht->type, ht->privdata);
754 n.size = realsize;
755 n.sizemask = realsize - 1;
756 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
757 /* Keep the same 'uniq' as the original */
758 n.uniq = ht->uniq;
760 /* Initialize all the pointers to NULL */
761 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
766 n.used = ht->used;
767 for (i = 0; ht->used > 0; i++) {
768 Jim_HashEntry *he, *nextHe;
770 if (ht->table[i] == NULL)
771 continue;
773 /* For each hash entry on this slot... */
774 he = ht->table[i];
775 while (he) {
776 unsigned int h;
778 nextHe = he->next;
779 /* Get the new element index */
780 h = Jim_HashKey(ht, he->key) & n.sizemask;
781 he->next = n.table[h];
782 n.table[h] = he;
783 ht->used--;
784 /* Pass to the next element */
785 he = nextHe;
788 assert(ht->used == 0);
789 Jim_Free(ht->table);
791 /* Remap the new hashtable in the old */
792 *ht = n;
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
798 Jim_HashEntry *entry;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry = JimInsertHashEntry(ht, key, 0);
803 if (entry == NULL)
804 return JIM_ERR;
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht, entry, key);
808 Jim_SetHashVal(ht, entry, val);
809 return JIM_OK;
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
815 int existed;
816 Jim_HashEntry *entry;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry = JimInsertHashEntry(ht, key, 1);
821 if (entry->key) {
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht->type->valDestructor && ht->type->valDup) {
828 void *newval = ht->type->valDup(ht->privdata, val);
829 ht->type->valDestructor(ht->privdata, entry->u.val);
830 entry->u.val = newval;
832 else {
833 Jim_FreeEntryVal(ht, entry);
834 Jim_SetHashVal(ht, entry, val);
836 existed = 1;
838 else {
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht, entry, key);
841 Jim_SetHashVal(ht, entry, val);
842 existed = 0;
845 return existed;
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
851 unsigned int h;
852 Jim_HashEntry *he, *prevHe;
854 if (ht->used == 0)
855 return JIM_ERR;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
859 prevHe = NULL;
860 while (he) {
861 if (Jim_CompareHashKeys(ht, key, he->key)) {
862 /* Unlink the element from the list */
863 if (prevHe)
864 prevHe->next = he->next;
865 else
866 ht->table[h] = he->next;
867 Jim_FreeEntryKey(ht, he);
868 Jim_FreeEntryVal(ht, he);
869 Jim_Free(he);
870 ht->used--;
871 return JIM_OK;
873 prevHe = he;
874 he = he->next;
876 return JIM_ERR; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable *ht)
882 unsigned int i;
884 /* Free all the elements */
885 for (i = 0; ht->used > 0; i++) {
886 Jim_HashEntry *he, *nextHe;
888 if ((he = ht->table[i]) == NULL)
889 continue;
890 while (he) {
891 nextHe = he->next;
892 Jim_FreeEntryKey(ht, he);
893 Jim_FreeEntryVal(ht, he);
894 Jim_Free(he);
895 ht->used--;
896 he = nextHe;
899 /* Free the table and the allocated cache structure */
900 Jim_Free(ht->table);
901 /* Re-initialize the table */
902 JimResetHashTable(ht);
903 return JIM_OK; /* never fails */
906 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
908 Jim_HashEntry *he;
909 unsigned int h;
911 if (ht->used == 0)
912 return NULL;
913 h = Jim_HashKey(ht, key) & ht->sizemask;
914 he = ht->table[h];
915 while (he) {
916 if (Jim_CompareHashKeys(ht, key, he->key))
917 return he;
918 he = he->next;
920 return NULL;
923 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
925 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
926 JimInitHashTableIterator(ht, iter);
927 return iter;
930 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
932 while (1) {
933 if (iter->entry == NULL) {
934 iter->index++;
935 if (iter->index >= (signed)iter->ht->size)
936 break;
937 iter->entry = iter->ht->table[iter->index];
939 else {
940 iter->entry = iter->nextEntry;
942 if (iter->entry) {
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter->nextEntry = iter->entry->next;
946 return iter->entry;
949 return NULL;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
959 if (ht->size == 0)
960 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
961 if (ht->size == ht->used)
962 Jim_ExpandHashTable(ht, ht->size * 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size)
968 unsigned int i = JIM_HT_INITIAL_SIZE;
970 if (size >= 2147483648U)
971 return 2147483648U;
972 while (1) {
973 if (i >= size)
974 return i;
975 i *= 2;
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
984 unsigned int h;
985 Jim_HashEntry *he;
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht);
990 /* Compute the key hash value */
991 h = Jim_HashKey(ht, key) & ht->sizemask;
992 /* Search if this slot does not already contain the given key */
993 he = ht->table[h];
994 while (he) {
995 if (Jim_CompareHashKeys(ht, key, he->key))
996 return replace ? he : NULL;
997 he = he->next;
1000 /* Allocates the memory and stores key */
1001 he = Jim_Alloc(sizeof(*he));
1002 he->next = ht->table[h];
1003 ht->table[h] = he;
1004 ht->used++;
1005 he->key = NULL;
1007 return he;
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key)
1014 return Jim_GenHashFunction(key, strlen(key));
1017 static void *JimStringCopyHTDup(void *privdata, const void *key)
1019 return Jim_StrDup(key);
1022 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1024 return strcmp(key1, key2) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1029 Jim_Free(key);
1032 static const Jim_HashTableType JimPackageHashTableType = {
1033 JimStringCopyHTHashFunction, /* hash function */
1034 JimStringCopyHTDup, /* key dup */
1035 NULL, /* val dup */
1036 JimStringCopyHTKeyCompare, /* key compare */
1037 JimStringCopyHTKeyDestructor, /* key destructor */
1038 NULL /* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc *delProc;
1044 void *data;
1045 } AssocDataValue;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1049 AssocDataValue *assocPtr = (AssocDataValue *) data;
1051 if (assocPtr->delProc != NULL)
1052 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1053 Jim_Free(data);
1056 static const Jim_HashTableType JimAssocDataHashTableType = {
1057 JimStringCopyHTHashFunction, /* hash function */
1058 JimStringCopyHTDup, /* key dup */
1059 NULL, /* val dup */
1060 JimStringCopyHTKeyCompare, /* key compare */
1061 JimStringCopyHTKeyDestructor, /* key destructor */
1062 JimAssocDataHashTableValueDestructor /* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack *stack)
1071 stack->len = 0;
1072 stack->maxlen = 0;
1073 stack->vector = NULL;
1076 void Jim_FreeStack(Jim_Stack *stack)
1078 Jim_Free(stack->vector);
1081 int Jim_StackLen(Jim_Stack *stack)
1083 return stack->len;
1086 void Jim_StackPush(Jim_Stack *stack, void *element)
1088 int neededLen = stack->len + 1;
1090 if (neededLen > stack->maxlen) {
1091 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1092 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1094 stack->vector[stack->len] = element;
1095 stack->len++;
1098 void *Jim_StackPop(Jim_Stack *stack)
1100 if (stack->len == 0)
1101 return NULL;
1102 stack->len--;
1103 return stack->vector[stack->len];
1106 void *Jim_StackPeek(Jim_Stack *stack)
1108 if (stack->len == 0)
1109 return NULL;
1110 return stack->vector[stack->len - 1];
1113 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1115 int i;
1117 for (i = 0; i < stack->len; i++)
1118 freeFunc(stack->vector[i]);
1121 /* -----------------------------------------------------------------------------
1122 * Tcl Parser
1123 * ---------------------------------------------------------------------------*/
1125 /* Token types */
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1154 /* Parser states */
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing {
1163 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1164 int line; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1169 struct JimParserCtx
1171 const char *p; /* Pointer to the point of the program we are parsing */
1172 int len; /* Remaining length */
1173 int linenr; /* Current line number */
1174 const char *tstart;
1175 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline; /* Line number of the returned token */
1177 int tt; /* Token type */
1178 int eof; /* Non zero if EOF condition is true. */
1179 int state; /* Parser state */
1180 int comment; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx *pc);
1185 static int JimParseSep(struct JimParserCtx *pc);
1186 static int JimParseEol(struct JimParserCtx *pc);
1187 static int JimParseCmd(struct JimParserCtx *pc);
1188 static int JimParseQuote(struct JimParserCtx *pc);
1189 static int JimParseVar(struct JimParserCtx *pc);
1190 static int JimParseBrace(struct JimParserCtx *pc);
1191 static int JimParseStr(struct JimParserCtx *pc);
1192 static int JimParseComment(struct JimParserCtx *pc);
1193 static void JimParseSubCmd(struct JimParserCtx *pc);
1194 static int JimParseSubQuote(struct JimParserCtx *pc);
1195 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1202 pc->p = prg;
1203 pc->len = len;
1204 pc->tstart = NULL;
1205 pc->tend = NULL;
1206 pc->tline = 0;
1207 pc->tt = JIM_TT_NONE;
1208 pc->eof = 0;
1209 pc->state = JIM_PS_DEF;
1210 pc->linenr = linenr;
1211 pc->comment = 1;
1212 pc->missing.ch = ' ';
1213 pc->missing.line = linenr;
1216 static int JimParseScript(struct JimParserCtx *pc)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1219 if (!pc->len) {
1220 pc->tstart = pc->p;
1221 pc->tend = pc->p - 1;
1222 pc->tline = pc->linenr;
1223 pc->tt = JIM_TT_EOL;
1224 pc->eof = 1;
1225 return JIM_OK;
1227 switch (*(pc->p)) {
1228 case '\\':
1229 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1230 return JimParseSep(pc);
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 case ' ':
1235 case '\t':
1236 case '\r':
1237 case '\f':
1238 if (pc->state == JIM_PS_DEF)
1239 return JimParseSep(pc);
1240 pc->comment = 0;
1241 return JimParseStr(pc);
1242 case '\n':
1243 case ';':
1244 pc->comment = 1;
1245 if (pc->state == JIM_PS_DEF)
1246 return JimParseEol(pc);
1247 return JimParseStr(pc);
1248 case '[':
1249 pc->comment = 0;
1250 return JimParseCmd(pc);
1251 case '$':
1252 pc->comment = 0;
1253 if (JimParseVar(pc) == JIM_ERR) {
1254 /* An orphan $. Create as a separate token */
1255 pc->tstart = pc->tend = pc->p++;
1256 pc->len--;
1257 pc->tt = JIM_TT_ESC;
1259 return JIM_OK;
1260 case '#':
1261 if (pc->comment) {
1262 JimParseComment(pc);
1263 continue;
1265 return JimParseStr(pc);
1266 default:
1267 pc->comment = 0;
1268 return JimParseStr(pc);
1270 return JIM_OK;
1274 static int JimParseSep(struct JimParserCtx *pc)
1276 pc->tstart = pc->p;
1277 pc->tline = pc->linenr;
1278 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1279 if (*pc->p == '\n') {
1280 break;
1282 if (*pc->p == '\\') {
1283 pc->p++;
1284 pc->len--;
1285 pc->linenr++;
1287 pc->p++;
1288 pc->len--;
1290 pc->tend = pc->p - 1;
1291 pc->tt = JIM_TT_SEP;
1292 return JIM_OK;
1295 static int JimParseEol(struct JimParserCtx *pc)
1297 pc->tstart = pc->p;
1298 pc->tline = pc->linenr;
1299 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1300 if (*pc->p == '\n')
1301 pc->linenr++;
1302 pc->p++;
1303 pc->len--;
1305 pc->tend = pc->p - 1;
1306 pc->tt = JIM_TT_EOL;
1307 return JIM_OK;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx *pc)
1340 int level = 1;
1342 /* Skip the brace */
1343 pc->p++;
1344 pc->len--;
1345 while (pc->len) {
1346 switch (*pc->p) {
1347 case '\\':
1348 if (pc->len > 1) {
1349 if (*++pc->p == '\n') {
1350 pc->linenr++;
1352 pc->len--;
1354 break;
1356 case '{':
1357 level++;
1358 break;
1360 case '}':
1361 if (--level == 0) {
1362 pc->tend = pc->p - 1;
1363 pc->p++;
1364 pc->len--;
1365 return;
1367 break;
1369 case '\n':
1370 pc->linenr++;
1371 break;
1373 pc->p++;
1374 pc->len--;
1376 pc->missing.ch = '{';
1377 pc->missing.line = pc->tline;
1378 pc->tend = pc->p - 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1389 * or JIM_TT_STR.
1391 static int JimParseSubQuote(struct JimParserCtx *pc)
1393 int tt = JIM_TT_STR;
1394 int line = pc->tline;
1396 /* Skip the quote */
1397 pc->p++;
1398 pc->len--;
1399 while (pc->len) {
1400 switch (*pc->p) {
1401 case '\\':
1402 if (pc->len > 1) {
1403 if (*++pc->p == '\n') {
1404 pc->linenr++;
1406 pc->len--;
1407 tt = JIM_TT_ESC;
1409 break;
1411 case '"':
1412 pc->tend = pc->p - 1;
1413 pc->p++;
1414 pc->len--;
1415 return tt;
1417 case '[':
1418 JimParseSubCmd(pc);
1419 tt = JIM_TT_ESC;
1420 continue;
1422 case '\n':
1423 pc->linenr++;
1424 break;
1426 case '$':
1427 tt = JIM_TT_ESC;
1428 break;
1430 pc->p++;
1431 pc->len--;
1433 pc->missing.ch = '"';
1434 pc->missing.line = line;
1435 pc->tend = pc->p - 1;
1436 return tt;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx *pc)
1447 int level = 1;
1448 int startofword = 1;
1449 int line = pc->tline;
1451 /* Skip the bracket */
1452 pc->p++;
1453 pc->len--;
1454 while (pc->len) {
1455 switch (*pc->p) {
1456 case '\\':
1457 if (pc->len > 1) {
1458 if (*++pc->p == '\n') {
1459 pc->linenr++;
1461 pc->len--;
1463 break;
1465 case '[':
1466 level++;
1467 break;
1469 case ']':
1470 if (--level == 0) {
1471 pc->tend = pc->p - 1;
1472 pc->p++;
1473 pc->len--;
1474 return;
1476 break;
1478 case '"':
1479 if (startofword) {
1480 JimParseSubQuote(pc);
1481 continue;
1483 break;
1485 case '{':
1486 JimParseSubBrace(pc);
1487 startofword = 0;
1488 continue;
1490 case '\n':
1491 pc->linenr++;
1492 break;
1494 startofword = isspace(UCHAR(*pc->p));
1495 pc->p++;
1496 pc->len--;
1498 pc->missing.ch = '[';
1499 pc->missing.line = line;
1500 pc->tend = pc->p - 1;
1503 static int JimParseBrace(struct JimParserCtx *pc)
1505 pc->tstart = pc->p + 1;
1506 pc->tline = pc->linenr;
1507 pc->tt = JIM_TT_STR;
1508 JimParseSubBrace(pc);
1509 return JIM_OK;
1512 static int JimParseCmd(struct JimParserCtx *pc)
1514 pc->tstart = pc->p + 1;
1515 pc->tline = pc->linenr;
1516 pc->tt = JIM_TT_CMD;
1517 JimParseSubCmd(pc);
1518 return JIM_OK;
1521 static int JimParseQuote(struct JimParserCtx *pc)
1523 pc->tstart = pc->p + 1;
1524 pc->tline = pc->linenr;
1525 pc->tt = JimParseSubQuote(pc);
1526 return JIM_OK;
1529 static int JimParseVar(struct JimParserCtx *pc)
1531 /* skip the $ */
1532 pc->p++;
1533 pc->len--;
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc->p == '[') {
1537 /* Parse $[...] expr shorthand syntax */
1538 JimParseCmd(pc);
1539 pc->tt = JIM_TT_EXPRSUGAR;
1540 return JIM_OK;
1542 #endif
1544 pc->tstart = pc->p;
1545 pc->tt = JIM_TT_VAR;
1546 pc->tline = pc->linenr;
1548 if (*pc->p == '{') {
1549 pc->tstart = ++pc->p;
1550 pc->len--;
1552 while (pc->len && *pc->p != '}') {
1553 if (*pc->p == '\n') {
1554 pc->linenr++;
1556 pc->p++;
1557 pc->len--;
1559 pc->tend = pc->p - 1;
1560 if (pc->len) {
1561 pc->p++;
1562 pc->len--;
1565 else {
1566 while (1) {
1567 /* Skip double colon, but not single colon! */
1568 if (pc->p[0] == ':' && pc->p[1] == ':') {
1569 while (*pc->p == ':') {
1570 pc->p++;
1571 pc->len--;
1573 continue;
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1579 pc->p++;
1580 pc->len--;
1581 continue;
1583 break;
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc->p == '(') {
1587 int count = 1;
1588 const char *paren = NULL;
1590 pc->tt = JIM_TT_DICTSUGAR;
1592 while (count && pc->len) {
1593 pc->p++;
1594 pc->len--;
1595 if (*pc->p == '\\' && pc->len >= 1) {
1596 pc->p++;
1597 pc->len--;
1599 else if (*pc->p == '(') {
1600 count++;
1602 else if (*pc->p == ')') {
1603 paren = pc->p;
1604 count--;
1607 if (count == 0) {
1608 pc->p++;
1609 pc->len--;
1611 else if (paren) {
1612 /* Did not find a matching paren. Back up */
1613 paren++;
1614 pc->len += (pc->p - paren);
1615 pc->p = paren;
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc->tstart == '(') {
1619 pc->tt = JIM_TT_EXPRSUGAR;
1621 #endif
1623 pc->tend = pc->p - 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1628 * a string. */
1629 if (pc->tstart == pc->p) {
1630 pc->p--;
1631 pc->len++;
1632 return JIM_ERR;
1634 return JIM_OK;
1637 static int JimParseStr(struct JimParserCtx *pc)
1639 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1640 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1641 /* Starting a new word */
1642 if (*pc->p == '{') {
1643 return JimParseBrace(pc);
1645 if (*pc->p == '"') {
1646 pc->state = JIM_PS_QUOTE;
1647 pc->p++;
1648 pc->len--;
1649 /* In case the end quote is missing */
1650 pc->missing.line = pc->tline;
1653 pc->tstart = pc->p;
1654 pc->tline = pc->linenr;
1655 while (1) {
1656 if (pc->len == 0) {
1657 if (pc->state == JIM_PS_QUOTE) {
1658 pc->missing.ch = '"';
1660 pc->tend = pc->p - 1;
1661 pc->tt = JIM_TT_ESC;
1662 return JIM_OK;
1664 switch (*pc->p) {
1665 case '\\':
1666 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1667 pc->tend = pc->p - 1;
1668 pc->tt = JIM_TT_ESC;
1669 return JIM_OK;
1671 if (pc->len >= 2) {
1672 if (*(pc->p + 1) == '\n') {
1673 pc->linenr++;
1675 pc->p++;
1676 pc->len--;
1678 else if (pc->len == 1) {
1679 /* End of script with trailing backslash */
1680 pc->missing.ch = '\\';
1682 break;
1683 case '(':
1684 /* If the following token is not '$' just keep going */
1685 if (pc->len > 1 && pc->p[1] != '$') {
1686 break;
1688 /* fall through */
1689 case ')':
1690 /* Only need a separate ')' token if the previous was a var */
1691 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1692 if (pc->p == pc->tstart) {
1693 /* At the start of the token, so just return this char */
1694 pc->p++;
1695 pc->len--;
1697 pc->tend = pc->p - 1;
1698 pc->tt = JIM_TT_ESC;
1699 return JIM_OK;
1701 break;
1703 case '$':
1704 case '[':
1705 pc->tend = pc->p - 1;
1706 pc->tt = JIM_TT_ESC;
1707 return JIM_OK;
1708 case ' ':
1709 case '\t':
1710 case '\n':
1711 case '\r':
1712 case '\f':
1713 case ';':
1714 if (pc->state == JIM_PS_DEF) {
1715 pc->tend = pc->p - 1;
1716 pc->tt = JIM_TT_ESC;
1717 return JIM_OK;
1719 else if (*pc->p == '\n') {
1720 pc->linenr++;
1722 break;
1723 case '"':
1724 if (pc->state == JIM_PS_QUOTE) {
1725 pc->tend = pc->p - 1;
1726 pc->tt = JIM_TT_ESC;
1727 pc->p++;
1728 pc->len--;
1729 pc->state = JIM_PS_DEF;
1730 return JIM_OK;
1732 break;
1734 pc->p++;
1735 pc->len--;
1737 return JIM_OK; /* unreached */
1740 static int JimParseComment(struct JimParserCtx *pc)
1742 while (*pc->p) {
1743 if (*pc->p == '\\') {
1744 pc->p++;
1745 pc->len--;
1746 if (pc->len == 0) {
1747 pc->missing.ch = '\\';
1748 return JIM_OK;
1750 if (*pc->p == '\n') {
1751 pc->linenr++;
1754 else if (*pc->p == '\n') {
1755 pc->p++;
1756 pc->len--;
1757 pc->linenr++;
1758 break;
1760 pc->p++;
1761 pc->len--;
1763 return JIM_OK;
1766 /* xdigitval and odigitval are helper functions for JimEscape() */
1767 static int xdigitval(int c)
1769 if (c >= '0' && c <= '9')
1770 return c - '0';
1771 if (c >= 'a' && c <= 'f')
1772 return c - 'a' + 10;
1773 if (c >= 'A' && c <= 'F')
1774 return c - 'A' + 10;
1775 return -1;
1778 static int odigitval(int c)
1780 if (c >= '0' && c <= '7')
1781 return c - '0';
1782 return -1;
1785 /* Perform Tcl escape substitution of 's', storing the result
1786 * string into 'dest'. The escaped string is guaranteed to
1787 * be the same length or shorted than the source string.
1788 * Slen is the length of the string at 's', if it's -1 the string
1789 * length will be calculated by the function.
1791 * The function returns the length of the resulting string. */
1792 static int JimEscape(char *dest, const char *s, int slen)
1794 char *p = dest;
1795 int i, len;
1797 if (slen == -1)
1798 slen = strlen(s);
1800 for (i = 0; i < slen; i++) {
1801 switch (s[i]) {
1802 case '\\':
1803 switch (s[i + 1]) {
1804 case 'a':
1805 *p++ = 0x7;
1806 i++;
1807 break;
1808 case 'b':
1809 *p++ = 0x8;
1810 i++;
1811 break;
1812 case 'f':
1813 *p++ = 0xc;
1814 i++;
1815 break;
1816 case 'n':
1817 *p++ = 0xa;
1818 i++;
1819 break;
1820 case 'r':
1821 *p++ = 0xd;
1822 i++;
1823 break;
1824 case 't':
1825 *p++ = 0x9;
1826 i++;
1827 break;
1828 case 'u':
1829 case 'U':
1830 case 'x':
1831 /* A unicode or hex sequence.
1832 * \x Expect 1-2 hex chars and convert to hex.
1833 * \u Expect 1-4 hex chars and convert to utf-8.
1834 * \U Expect 1-8 hex chars and convert to utf-8.
1835 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1836 * An invalid sequence means simply the escaped char.
1839 unsigned val = 0;
1840 int k;
1841 int maxchars = 2;
1843 i++;
1845 if (s[i] == 'U') {
1846 maxchars = 8;
1848 else if (s[i] == 'u') {
1849 if (s[i + 1] == '{') {
1850 maxchars = 6;
1851 i++;
1853 else {
1854 maxchars = 4;
1858 for (k = 0; k < maxchars; k++) {
1859 int c = xdigitval(s[i + k + 1]);
1860 if (c == -1) {
1861 break;
1863 val = (val << 4) | c;
1865 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1866 if (s[i] == '{') {
1867 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1868 /* Back up */
1869 i--;
1870 k = 0;
1872 else {
1873 /* Skip the closing brace */
1874 k++;
1877 if (k) {
1878 /* Got a valid sequence, so convert */
1879 if (s[i] == 'x') {
1880 *p++ = val;
1882 else {
1883 p += utf8_fromunicode(p, val);
1885 i += k;
1886 break;
1888 /* Not a valid codepoint, just an escaped char */
1889 *p++ = s[i];
1891 break;
1892 case 'v':
1893 *p++ = 0xb;
1894 i++;
1895 break;
1896 case '\0':
1897 *p++ = '\\';
1898 i++;
1899 break;
1900 case '\n':
1901 /* Replace all spaces and tabs after backslash newline with a single space*/
1902 *p++ = ' ';
1903 do {
1904 i++;
1905 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1906 break;
1907 case '0':
1908 case '1':
1909 case '2':
1910 case '3':
1911 case '4':
1912 case '5':
1913 case '6':
1914 case '7':
1915 /* octal escape */
1917 int val = 0;
1918 int c = odigitval(s[i + 1]);
1920 val = c;
1921 c = odigitval(s[i + 2]);
1922 if (c == -1) {
1923 *p++ = val;
1924 i++;
1925 break;
1927 val = (val * 8) + c;
1928 c = odigitval(s[i + 3]);
1929 if (c == -1) {
1930 *p++ = val;
1931 i += 2;
1932 break;
1934 val = (val * 8) + c;
1935 *p++ = val;
1936 i += 3;
1938 break;
1939 default:
1940 *p++ = s[i + 1];
1941 i++;
1942 break;
1944 break;
1945 default:
1946 *p++ = s[i];
1947 break;
1950 len = p - dest;
1951 *p = '\0';
1952 return len;
1955 /* Returns a dynamically allocated copy of the current token in the
1956 * parser context. The function performs conversion of escapes if
1957 * the token is of type JIM_TT_ESC.
1959 * Note that after the conversion, tokens that are grouped with
1960 * braces in the source code, are always recognizable from the
1961 * identical string obtained in a different way from the type.
1963 * For example the string:
1965 * {*}$a
1967 * will return as first token "*", of type JIM_TT_STR
1969 * While the string:
1971 * *$a
1973 * will return as first token "*", of type JIM_TT_ESC
1975 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1977 const char *start, *end;
1978 char *token;
1979 int len;
1981 start = pc->tstart;
1982 end = pc->tend;
1983 if (start > end) {
1984 len = 0;
1985 token = Jim_Alloc(1);
1986 token[0] = '\0';
1988 else {
1989 len = (end - start) + 1;
1990 token = Jim_Alloc(len + 1);
1991 if (pc->tt != JIM_TT_ESC) {
1992 /* No escape conversion needed? Just copy it. */
1993 memcpy(token, start, len);
1994 token[len] = '\0';
1996 else {
1997 /* Else convert the escape chars. */
1998 len = JimEscape(token, start, len);
2002 return Jim_NewStringObjNoAlloc(interp, token, len);
2005 /* Parses the given string to determine if it represents a complete script.
2007 * This is useful for interactive shells implementation, for [info complete].
2009 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2010 * '{' on scripts incomplete missing one or more '}' to be balanced.
2011 * '[' on scripts incomplete missing one or more ']' to be balanced.
2012 * '"' on scripts incomplete missing a '"' char.
2013 * '\\' on scripts with a trailing backslash.
2015 * If the script is complete, 1 is returned, otherwise 0.
2017 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2019 struct JimParserCtx parser;
2021 JimParserInit(&parser, s, len, 1);
2022 while (!parser.eof) {
2023 JimParseScript(&parser);
2025 if (stateCharPtr) {
2026 *stateCharPtr = parser.missing.ch;
2028 return parser.missing.ch == ' ';
2031 /* -----------------------------------------------------------------------------
2032 * Tcl Lists parsing
2033 * ---------------------------------------------------------------------------*/
2034 static int JimParseListSep(struct JimParserCtx *pc);
2035 static int JimParseListStr(struct JimParserCtx *pc);
2036 static int JimParseListQuote(struct JimParserCtx *pc);
2038 static int JimParseList(struct JimParserCtx *pc)
2040 if (isspace(UCHAR(*pc->p))) {
2041 return JimParseListSep(pc);
2043 switch (*pc->p) {
2044 case '"':
2045 return JimParseListQuote(pc);
2047 case '{':
2048 return JimParseBrace(pc);
2050 default:
2051 if (pc->len) {
2052 return JimParseListStr(pc);
2054 break;
2057 pc->tstart = pc->tend = pc->p;
2058 pc->tline = pc->linenr;
2059 pc->tt = JIM_TT_EOL;
2060 pc->eof = 1;
2061 return JIM_OK;
2064 static int JimParseListSep(struct JimParserCtx *pc)
2066 pc->tstart = pc->p;
2067 pc->tline = pc->linenr;
2068 while (isspace(UCHAR(*pc->p))) {
2069 if (*pc->p == '\n') {
2070 pc->linenr++;
2072 pc->p++;
2073 pc->len--;
2075 pc->tend = pc->p - 1;
2076 pc->tt = JIM_TT_SEP;
2077 return JIM_OK;
2080 static int JimParseListQuote(struct JimParserCtx *pc)
2082 pc->p++;
2083 pc->len--;
2085 pc->tstart = pc->p;
2086 pc->tline = pc->linenr;
2087 pc->tt = JIM_TT_STR;
2089 while (pc->len) {
2090 switch (*pc->p) {
2091 case '\\':
2092 pc->tt = JIM_TT_ESC;
2093 if (--pc->len == 0) {
2094 /* Trailing backslash */
2095 pc->tend = pc->p;
2096 return JIM_OK;
2098 pc->p++;
2099 break;
2100 case '\n':
2101 pc->linenr++;
2102 break;
2103 case '"':
2104 pc->tend = pc->p - 1;
2105 pc->p++;
2106 pc->len--;
2107 return JIM_OK;
2109 pc->p++;
2110 pc->len--;
2113 pc->tend = pc->p - 1;
2114 return JIM_OK;
2117 static int JimParseListStr(struct JimParserCtx *pc)
2119 pc->tstart = pc->p;
2120 pc->tline = pc->linenr;
2121 pc->tt = JIM_TT_STR;
2123 while (pc->len) {
2124 if (isspace(UCHAR(*pc->p))) {
2125 pc->tend = pc->p - 1;
2126 return JIM_OK;
2128 if (*pc->p == '\\') {
2129 if (--pc->len == 0) {
2130 /* Trailing backslash */
2131 pc->tend = pc->p;
2132 return JIM_OK;
2134 pc->tt = JIM_TT_ESC;
2135 pc->p++;
2137 pc->p++;
2138 pc->len--;
2140 pc->tend = pc->p - 1;
2141 return JIM_OK;
2144 /* -----------------------------------------------------------------------------
2145 * Jim_Obj related functions
2146 * ---------------------------------------------------------------------------*/
2148 /* Return a new initialized object. */
2149 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2151 Jim_Obj *objPtr;
2153 /* -- Check if there are objects in the free list -- */
2154 if (interp->freeList != NULL) {
2155 /* -- Unlink the object from the free list -- */
2156 objPtr = interp->freeList;
2157 interp->freeList = objPtr->nextObjPtr;
2159 else {
2160 /* -- No ready to use objects: allocate a new one -- */
2161 objPtr = Jim_Alloc(sizeof(*objPtr));
2164 /* Object is returned with refCount of 0. Every
2165 * kind of GC implemented should take care to don't try
2166 * to scan objects with refCount == 0. */
2167 objPtr->refCount = 0;
2168 /* All the other fields are left not initialized to save time.
2169 * The caller will probably want to set them to the right
2170 * value anyway. */
2172 /* -- Put the object into the live list -- */
2173 objPtr->prevObjPtr = NULL;
2174 objPtr->nextObjPtr = interp->liveList;
2175 if (interp->liveList)
2176 interp->liveList->prevObjPtr = objPtr;
2177 interp->liveList = objPtr;
2179 return objPtr;
2182 /* Free an object. Actually objects are never freed, but
2183 * just moved to the free objects list, where they will be
2184 * reused by Jim_NewObj(). */
2185 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2187 /* Check if the object was already freed, panic. */
2188 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2189 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2191 /* Free the internal representation */
2192 Jim_FreeIntRep(interp, objPtr);
2193 /* Free the string representation */
2194 if (objPtr->bytes != NULL) {
2195 if (objPtr->bytes != JimEmptyStringRep)
2196 Jim_Free(objPtr->bytes);
2198 /* Unlink the object from the live objects list */
2199 if (objPtr->prevObjPtr)
2200 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2201 if (objPtr->nextObjPtr)
2202 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2203 if (interp->liveList == objPtr)
2204 interp->liveList = objPtr->nextObjPtr;
2205 #ifdef JIM_DISABLE_OBJECT_POOL
2206 Jim_Free(objPtr);
2207 #else
2208 /* Link the object into the free objects list */
2209 objPtr->prevObjPtr = NULL;
2210 objPtr->nextObjPtr = interp->freeList;
2211 if (interp->freeList)
2212 interp->freeList->prevObjPtr = objPtr;
2213 interp->freeList = objPtr;
2214 objPtr->refCount = -1;
2215 #endif
2218 /* Invalidate the string representation of an object. */
2219 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2221 if (objPtr->bytes != NULL) {
2222 if (objPtr->bytes != JimEmptyStringRep)
2223 Jim_Free(objPtr->bytes);
2225 objPtr->bytes = NULL;
2228 /* Duplicate an object. The returned object has refcount = 0. */
2229 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2231 Jim_Obj *dupPtr;
2233 dupPtr = Jim_NewObj(interp);
2234 if (objPtr->bytes == NULL) {
2235 /* Object does not have a valid string representation. */
2236 dupPtr->bytes = NULL;
2238 else if (objPtr->length == 0) {
2239 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2240 dupPtr->bytes = JimEmptyStringRep;
2241 dupPtr->length = 0;
2242 dupPtr->typePtr = NULL;
2243 return dupPtr;
2245 else {
2246 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2247 dupPtr->length = objPtr->length;
2248 /* Copy the null byte too */
2249 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2252 /* By default, the new object has the same type as the old object */
2253 dupPtr->typePtr = objPtr->typePtr;
2254 if (objPtr->typePtr != NULL) {
2255 if (objPtr->typePtr->dupIntRepProc == NULL) {
2256 dupPtr->internalRep = objPtr->internalRep;
2258 else {
2259 /* The dup proc may set a different type, e.g. NULL */
2260 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2263 return dupPtr;
2266 /* Return the string representation for objPtr. If the object's
2267 * string representation is invalid, calls the updateStringProc method to create
2268 * a new one from the internal representation of the object.
2270 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2272 if (objPtr->bytes == NULL) {
2273 /* Invalid string repr. Generate it. */
2274 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2275 objPtr->typePtr->updateStringProc(objPtr);
2277 if (lenPtr)
2278 *lenPtr = objPtr->length;
2279 return objPtr->bytes;
2282 /* Just returns the length of the object's string rep */
2283 int Jim_Length(Jim_Obj *objPtr)
2285 if (objPtr->bytes == NULL) {
2286 /* Invalid string repr. Generate it. */
2287 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2288 objPtr->typePtr->updateStringProc(objPtr);
2290 return objPtr->length;
2293 /* Just returns object's string rep */
2294 const char *Jim_String(Jim_Obj *objPtr)
2296 if (objPtr->bytes == NULL) {
2297 /* Invalid string repr. Generate it. */
2298 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2299 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2300 objPtr->typePtr->updateStringProc(objPtr);
2302 return objPtr->bytes;
2305 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2307 objPtr->bytes = Jim_StrDup(str);
2308 objPtr->length = strlen(str);
2311 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2312 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2314 static const Jim_ObjType dictSubstObjType = {
2315 "dict-substitution",
2316 FreeDictSubstInternalRep,
2317 DupDictSubstInternalRep,
2318 NULL,
2319 JIM_TYPE_NONE,
2322 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2324 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2327 static const Jim_ObjType interpolatedObjType = {
2328 "interpolated",
2329 FreeInterpolatedInternalRep,
2330 NULL,
2331 NULL,
2332 JIM_TYPE_NONE,
2335 /* -----------------------------------------------------------------------------
2336 * String Object
2337 * ---------------------------------------------------------------------------*/
2338 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2339 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2341 static const Jim_ObjType stringObjType = {
2342 "string",
2343 NULL,
2344 DupStringInternalRep,
2345 NULL,
2346 JIM_TYPE_REFERENCES,
2349 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2351 JIM_NOTUSED(interp);
2353 /* This is a bit subtle: the only caller of this function
2354 * should be Jim_DuplicateObj(), that will copy the
2355 * string representaion. After the copy, the duplicated
2356 * object will not have more room in the buffer than
2357 * srcPtr->length bytes. So we just set it to length. */
2358 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2359 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2362 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2364 if (objPtr->typePtr != &stringObjType) {
2365 /* Get a fresh string representation. */
2366 if (objPtr->bytes == NULL) {
2367 /* Invalid string repr. Generate it. */
2368 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2369 objPtr->typePtr->updateStringProc(objPtr);
2371 /* Free any other internal representation. */
2372 Jim_FreeIntRep(interp, objPtr);
2373 /* Set it as string, i.e. just set the maxLength field. */
2374 objPtr->typePtr = &stringObjType;
2375 objPtr->internalRep.strValue.maxLength = objPtr->length;
2376 /* Don't know the utf-8 length yet */
2377 objPtr->internalRep.strValue.charLength = -1;
2379 return JIM_OK;
2383 * Returns the length of the object string in chars, not bytes.
2385 * These may be different for a utf-8 string.
2387 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2389 #ifdef JIM_UTF8
2390 SetStringFromAny(interp, objPtr);
2392 if (objPtr->internalRep.strValue.charLength < 0) {
2393 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2395 return objPtr->internalRep.strValue.charLength;
2396 #else
2397 return Jim_Length(objPtr);
2398 #endif
2401 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2402 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2404 Jim_Obj *objPtr = Jim_NewObj(interp);
2406 /* Need to find out how many bytes the string requires */
2407 if (len == -1)
2408 len = strlen(s);
2409 /* Alloc/Set the string rep. */
2410 if (len == 0) {
2411 objPtr->bytes = JimEmptyStringRep;
2413 else {
2414 objPtr->bytes = Jim_Alloc(len + 1);
2415 memcpy(objPtr->bytes, s, len);
2416 objPtr->bytes[len] = '\0';
2418 objPtr->length = len;
2420 /* No typePtr field for the vanilla string object. */
2421 objPtr->typePtr = NULL;
2422 return objPtr;
2425 /* charlen is in characters -- see also Jim_NewStringObj() */
2426 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2428 #ifdef JIM_UTF8
2429 /* Need to find out how many bytes the string requires */
2430 int bytelen = utf8_index(s, charlen);
2432 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2434 /* Remember the utf8 length, so set the type */
2435 objPtr->typePtr = &stringObjType;
2436 objPtr->internalRep.strValue.maxLength = bytelen;
2437 objPtr->internalRep.strValue.charLength = charlen;
2439 return objPtr;
2440 #else
2441 return Jim_NewStringObj(interp, s, charlen);
2442 #endif
2445 /* This version does not try to duplicate the 's' pointer, but
2446 * use it directly. */
2447 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2449 Jim_Obj *objPtr = Jim_NewObj(interp);
2451 objPtr->bytes = s;
2452 objPtr->length = (len == -1) ? strlen(s) : len;
2453 objPtr->typePtr = NULL;
2454 return objPtr;
2457 /* Low-level string append. Use it only against unshared objects
2458 * of type "string". */
2459 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2461 int needlen;
2463 if (len == -1)
2464 len = strlen(str);
2465 needlen = objPtr->length + len;
2466 if (objPtr->internalRep.strValue.maxLength < needlen ||
2467 objPtr->internalRep.strValue.maxLength == 0) {
2468 needlen *= 2;
2469 /* Inefficient to malloc() for less than 8 bytes */
2470 if (needlen < 7) {
2471 needlen = 7;
2473 if (objPtr->bytes == JimEmptyStringRep) {
2474 objPtr->bytes = Jim_Alloc(needlen + 1);
2476 else {
2477 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2479 objPtr->internalRep.strValue.maxLength = needlen;
2481 memcpy(objPtr->bytes + objPtr->length, str, len);
2482 objPtr->bytes[objPtr->length + len] = '\0';
2484 if (objPtr->internalRep.strValue.charLength >= 0) {
2485 /* Update the utf-8 char length */
2486 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2488 objPtr->length += len;
2491 /* Higher level API to append strings to objects.
2492 * Object must not be unshared for each of these.
2494 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2496 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2497 SetStringFromAny(interp, objPtr);
2498 StringAppendString(objPtr, str, len);
2501 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2503 int len;
2504 const char *str = Jim_GetString(appendObjPtr, &len);
2505 Jim_AppendString(interp, objPtr, str, len);
2508 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2510 va_list ap;
2512 SetStringFromAny(interp, objPtr);
2513 va_start(ap, objPtr);
2514 while (1) {
2515 const char *s = va_arg(ap, const char *);
2517 if (s == NULL)
2518 break;
2519 Jim_AppendString(interp, objPtr, s, -1);
2521 va_end(ap);
2524 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2526 if (aObjPtr == bObjPtr) {
2527 return 1;
2529 else {
2530 int Alen, Blen;
2531 const char *sA = Jim_GetString(aObjPtr, &Alen);
2532 const char *sB = Jim_GetString(bObjPtr, &Blen);
2534 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2539 * Note. Does not support embedded nulls in either the pattern or the object.
2541 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2543 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2547 * Note: does not support embedded nulls for the nocase option.
2549 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2551 int l1, l2;
2552 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2553 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2555 if (nocase) {
2556 /* Do a character compare for nocase */
2557 return JimStringCompareLen(s1, s2, -1, nocase);
2559 return JimStringCompare(s1, l1, s2, l2);
2563 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2565 * Note: does not support embedded nulls
2567 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2569 const char *s1 = Jim_String(firstObjPtr);
2570 const char *s2 = Jim_String(secondObjPtr);
2572 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2575 /* Convert a range, as returned by Jim_GetRange(), into
2576 * an absolute index into an object of the specified length.
2577 * This function may return negative values, or values
2578 * greater than or equal to the length of the list if the index
2579 * is out of range. */
2580 static int JimRelToAbsIndex(int len, int idx)
2582 if (idx < 0)
2583 return len + idx;
2584 return idx;
2587 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2588 * into a form suitable for implementation of commands like [string range] and [lrange].
2590 * The resulting range is guaranteed to address valid elements of
2591 * the structure.
2593 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2595 int rangeLen;
2597 if (*firstPtr > *lastPtr) {
2598 rangeLen = 0;
2600 else {
2601 rangeLen = *lastPtr - *firstPtr + 1;
2602 if (rangeLen) {
2603 if (*firstPtr < 0) {
2604 rangeLen += *firstPtr;
2605 *firstPtr = 0;
2607 if (*lastPtr >= len) {
2608 rangeLen -= (*lastPtr - (len - 1));
2609 *lastPtr = len - 1;
2613 if (rangeLen < 0)
2614 rangeLen = 0;
2616 *rangeLenPtr = rangeLen;
2619 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2620 int len, int *first, int *last, int *range)
2622 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2623 return JIM_ERR;
2625 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2626 return JIM_ERR;
2628 *first = JimRelToAbsIndex(len, *first);
2629 *last = JimRelToAbsIndex(len, *last);
2630 JimRelToAbsRange(len, first, last, range);
2631 return JIM_OK;
2634 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2635 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2637 int first, last;
2638 const char *str;
2639 int rangeLen;
2640 int bytelen;
2642 str = Jim_GetString(strObjPtr, &bytelen);
2644 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2645 return NULL;
2648 if (first == 0 && rangeLen == bytelen) {
2649 return strObjPtr;
2651 return Jim_NewStringObj(interp, str + first, rangeLen);
2654 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2655 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2657 #ifdef JIM_UTF8
2658 int first, last;
2659 const char *str;
2660 int len, rangeLen;
2661 int bytelen;
2663 str = Jim_GetString(strObjPtr, &bytelen);
2664 len = Jim_Utf8Length(interp, strObjPtr);
2666 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2667 return NULL;
2670 if (first == 0 && rangeLen == len) {
2671 return strObjPtr;
2673 if (len == bytelen) {
2674 /* ASCII optimisation */
2675 return Jim_NewStringObj(interp, str + first, rangeLen);
2677 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2678 #else
2679 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2680 #endif
2683 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2684 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2686 int first, last;
2687 const char *str;
2688 int len, rangeLen;
2689 Jim_Obj *objPtr;
2691 len = Jim_Utf8Length(interp, strObjPtr);
2693 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2694 return NULL;
2697 if (last < first) {
2698 return strObjPtr;
2701 str = Jim_String(strObjPtr);
2703 /* Before part */
2704 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2706 /* Replacement */
2707 if (newStrObj) {
2708 Jim_AppendObj(interp, objPtr, newStrObj);
2711 /* After part */
2712 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2714 return objPtr;
2718 * Note: does not support embedded nulls.
2720 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2722 while (*str) {
2723 int c;
2724 str += utf8_tounicode(str, &c);
2725 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2727 *dest = 0;
2731 * Note: does not support embedded nulls.
2733 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2735 char *buf;
2736 int len;
2737 const char *str;
2739 SetStringFromAny(interp, strObjPtr);
2741 str = Jim_GetString(strObjPtr, &len);
2743 #ifdef JIM_UTF8
2744 /* Case mapping can change the utf-8 length of the string.
2745 * But at worst it will be by one extra byte per char
2747 len *= 2;
2748 #endif
2749 buf = Jim_Alloc(len + 1);
2750 JimStrCopyUpperLower(buf, str, 0);
2751 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2755 * Note: does not support embedded nulls.
2757 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2759 char *buf;
2760 const char *str;
2761 int len;
2763 if (strObjPtr->typePtr != &stringObjType) {
2764 SetStringFromAny(interp, strObjPtr);
2767 str = Jim_GetString(strObjPtr, &len);
2769 #ifdef JIM_UTF8
2770 /* Case mapping can change the utf-8 length of the string.
2771 * But at worst it will be by one extra byte per char
2773 len *= 2;
2774 #endif
2775 buf = Jim_Alloc(len + 1);
2776 JimStrCopyUpperLower(buf, str, 1);
2777 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2781 * Note: does not support embedded nulls.
2783 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2785 char *buf, *p;
2786 int len;
2787 int c;
2788 const char *str;
2790 str = Jim_GetString(strObjPtr, &len);
2791 if (len == 0) {
2792 return strObjPtr;
2794 #ifdef JIM_UTF8
2795 /* Case mapping can change the utf-8 length of the string.
2796 * But at worst it will be by one extra byte per char
2798 len *= 2;
2799 #endif
2800 buf = p = Jim_Alloc(len + 1);
2802 str += utf8_tounicode(str, &c);
2803 p += utf8_getchars(p, utf8_title(c));
2805 JimStrCopyUpperLower(p, str, 0);
2807 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2810 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2811 * for unicode character 'c'.
2812 * Returns the position if found or NULL if not
2814 static const char *utf8_memchr(const char *str, int len, int c)
2816 #ifdef JIM_UTF8
2817 while (len) {
2818 int sc;
2819 int n = utf8_tounicode(str, &sc);
2820 if (sc == c) {
2821 return str;
2823 str += n;
2824 len -= n;
2826 return NULL;
2827 #else
2828 return memchr(str, c, len);
2829 #endif
2833 * Searches for the first non-trim char in string (str, len)
2835 * If none is found, returns just past the last char.
2837 * Lengths are in bytes.
2839 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2841 while (len) {
2842 int c;
2843 int n = utf8_tounicode(str, &c);
2845 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2846 /* Not a trim char, so stop */
2847 break;
2849 str += n;
2850 len -= n;
2852 return str;
2856 * Searches backwards for a non-trim char in string (str, len).
2858 * Returns a pointer to just after the non-trim char, or NULL if not found.
2860 * Lengths are in bytes.
2862 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2864 str += len;
2866 while (len) {
2867 int c;
2868 int n = utf8_prev_len(str, len);
2870 len -= n;
2871 str -= n;
2873 n = utf8_tounicode(str, &c);
2875 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2876 return str + n;
2880 return NULL;
2883 static const char default_trim_chars[] = " \t\n\r";
2884 /* sizeof() here includes the null byte */
2885 static int default_trim_chars_len = sizeof(default_trim_chars);
2887 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2889 int len;
2890 const char *str = Jim_GetString(strObjPtr, &len);
2891 const char *trimchars = default_trim_chars;
2892 int trimcharslen = default_trim_chars_len;
2893 const char *newstr;
2895 if (trimcharsObjPtr) {
2896 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2899 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2900 if (newstr == str) {
2901 return strObjPtr;
2904 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2907 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2909 int len;
2910 const char *trimchars = default_trim_chars;
2911 int trimcharslen = default_trim_chars_len;
2912 const char *nontrim;
2914 if (trimcharsObjPtr) {
2915 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2918 SetStringFromAny(interp, strObjPtr);
2920 len = Jim_Length(strObjPtr);
2921 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2923 if (nontrim == NULL) {
2924 /* All trim, so return a zero-length string */
2925 return Jim_NewEmptyStringObj(interp);
2927 if (nontrim == strObjPtr->bytes + len) {
2928 /* All non-trim, so return the original object */
2929 return strObjPtr;
2932 if (Jim_IsShared(strObjPtr)) {
2933 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2935 else {
2936 /* Can modify this string in place */
2937 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2938 strObjPtr->length = (nontrim - strObjPtr->bytes);
2941 return strObjPtr;
2944 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2946 /* First trim left. */
2947 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2949 /* Now trim right */
2950 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2952 /* Note: refCount check is needed since objPtr may be emptyObj */
2953 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2954 /* We don't want this object to be leaked */
2955 Jim_FreeNewObj(interp, objPtr);
2958 return strObjPtr;
2961 /* Some platforms don't have isascii - need a non-macro version */
2962 #ifdef HAVE_ISASCII
2963 #define jim_isascii isascii
2964 #else
2965 static int jim_isascii(int c)
2967 return !(c & ~0x7f);
2969 #endif
2971 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2973 static const char * const strclassnames[] = {
2974 "integer", "alpha", "alnum", "ascii", "digit",
2975 "double", "lower", "upper", "space", "xdigit",
2976 "control", "print", "graph", "punct",
2977 NULL
2979 enum {
2980 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2981 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2982 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2984 int strclass;
2985 int len;
2986 int i;
2987 const char *str;
2988 int (*isclassfunc)(int c) = NULL;
2990 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2991 return JIM_ERR;
2994 str = Jim_GetString(strObjPtr, &len);
2995 if (len == 0) {
2996 Jim_SetResultBool(interp, !strict);
2997 return JIM_OK;
3000 switch (strclass) {
3001 case STR_IS_INTEGER:
3003 jim_wide w;
3004 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3005 return JIM_OK;
3008 case STR_IS_DOUBLE:
3010 double d;
3011 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3012 return JIM_OK;
3015 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3016 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3017 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3018 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3019 case STR_IS_LOWER: isclassfunc = islower; break;
3020 case STR_IS_UPPER: isclassfunc = isupper; break;
3021 case STR_IS_SPACE: isclassfunc = isspace; break;
3022 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3023 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3024 case STR_IS_PRINT: isclassfunc = isprint; break;
3025 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3026 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3027 default:
3028 return JIM_ERR;
3031 for (i = 0; i < len; i++) {
3032 if (!isclassfunc(str[i])) {
3033 Jim_SetResultBool(interp, 0);
3034 return JIM_OK;
3037 Jim_SetResultBool(interp, 1);
3038 return JIM_OK;
3041 /* -----------------------------------------------------------------------------
3042 * Compared String Object
3043 * ---------------------------------------------------------------------------*/
3045 /* This is strange object that allows comparison of a C literal string
3046 * with a Jim object in a very short time if the same comparison is done
3047 * multiple times. For example every time the [if] command is executed,
3048 * Jim has to check if a given argument is "else".
3049 * If the code has no errors, this comparison is true most of the time,
3050 * so we can cache the pointer of the string of the last matching
3051 * comparison inside the object. Because most C compilers perform literal sharing,
3052 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3053 * this works pretty well even if comparisons are at different places
3054 * inside the C code. */
3056 static const Jim_ObjType comparedStringObjType = {
3057 "compared-string",
3058 NULL,
3059 NULL,
3060 NULL,
3061 JIM_TYPE_REFERENCES,
3064 /* The only way this object is exposed to the API is via the following
3065 * function. Returns true if the string and the object string repr.
3066 * are the same, otherwise zero is returned.
3068 * Note: this isn't binary safe, but it hardly needs to be.*/
3069 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3071 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3072 return 1;
3074 else {
3075 const char *objStr = Jim_String(objPtr);
3077 if (strcmp(str, objStr) != 0)
3078 return 0;
3080 if (objPtr->typePtr != &comparedStringObjType) {
3081 Jim_FreeIntRep(interp, objPtr);
3082 objPtr->typePtr = &comparedStringObjType;
3084 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3085 return 1;
3089 static int qsortCompareStringPointers(const void *a, const void *b)
3091 char *const *sa = (char *const *)a;
3092 char *const *sb = (char *const *)b;
3094 return strcmp(*sa, *sb);
3098 /* -----------------------------------------------------------------------------
3099 * Source Object
3101 * This object is just a string from the language point of view, but
3102 * the internal representation contains the filename and line number
3103 * where this token was read. This information is used by
3104 * Jim_EvalObj() if the object passed happens to be of type "source".
3106 * This allows propagation of the information about line numbers and file
3107 * names and gives error messages with absolute line numbers.
3109 * Note that this object uses the internal representation of the Jim_Object,
3110 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3112 * Also the object will be converted to something else if the given
3113 * token it represents in the source file is not something to be
3114 * evaluated (not a script), and will be specialized in some other way,
3115 * so the time overhead is also almost zero.
3116 * ---------------------------------------------------------------------------*/
3118 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3119 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3121 static const Jim_ObjType sourceObjType = {
3122 "source",
3123 FreeSourceInternalRep,
3124 DupSourceInternalRep,
3125 NULL,
3126 JIM_TYPE_REFERENCES,
3129 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3131 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3134 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3136 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3137 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3140 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3141 Jim_Obj *fileNameObj, int lineNumber)
3143 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3144 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3145 Jim_IncrRefCount(fileNameObj);
3146 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3147 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3148 objPtr->typePtr = &sourceObjType;
3151 /* -----------------------------------------------------------------------------
3152 * ScriptLine Object
3154 * This object is used only in the Script internal represenation.
3155 * For each line of the script, it holds the number of tokens on the line
3156 * and the source line number.
3158 static const Jim_ObjType scriptLineObjType = {
3159 "scriptline",
3160 NULL,
3161 NULL,
3162 NULL,
3163 JIM_NONE,
3166 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3168 Jim_Obj *objPtr;
3170 #ifdef DEBUG_SHOW_SCRIPT
3171 char buf[100];
3172 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3173 objPtr = Jim_NewStringObj(interp, buf, -1);
3174 #else
3175 objPtr = Jim_NewEmptyStringObj(interp);
3176 #endif
3177 objPtr->typePtr = &scriptLineObjType;
3178 objPtr->internalRep.scriptLineValue.argc = argc;
3179 objPtr->internalRep.scriptLineValue.line = line;
3181 return objPtr;
3184 /* -----------------------------------------------------------------------------
3185 * Script Object
3187 * This object holds the parsed internal representation of a script.
3188 * This representation is help within an allocated ScriptObj (see below)
3190 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3191 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3192 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3193 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3195 static const Jim_ObjType scriptObjType = {
3196 "script",
3197 FreeScriptInternalRep,
3198 DupScriptInternalRep,
3199 NULL,
3200 JIM_TYPE_REFERENCES,
3203 /* Each token of a script is represented by a ScriptToken.
3204 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3205 * can be specialized by commands operating on it.
3207 typedef struct ScriptToken
3209 Jim_Obj *objPtr;
3210 int type;
3211 } ScriptToken;
3213 /* This is the script object internal representation. An array of
3214 * ScriptToken structures, including a pre-computed representation of the
3215 * command length and arguments.
3217 * For example the script:
3219 * puts hello
3220 * set $i $x$y [foo]BAR
3222 * will produce a ScriptObj with the following ScriptToken's:
3224 * LIN 2
3225 * ESC puts
3226 * ESC hello
3227 * LIN 4
3228 * ESC set
3229 * VAR i
3230 * WRD 2
3231 * VAR x
3232 * VAR y
3233 * WRD 2
3234 * CMD foo
3235 * ESC BAR
3237 * "puts hello" has two args (LIN 2), composed of single tokens.
3238 * (Note that the WRD token is omitted for the common case of a single token.)
3240 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3241 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3243 * The precomputation of the command structure makes Jim_Eval() faster,
3244 * and simpler because there aren't dynamic lengths / allocations.
3246 * -- {expand}/{*} handling --
3248 * Expand is handled in a special way.
3250 * If a "word" begins with {*}, the word token count is -ve.
3252 * For example the command:
3254 * list {*}{a b}
3256 * Will produce the following cmdstruct array:
3258 * LIN 2
3259 * ESC list
3260 * WRD -1
3261 * STR a b
3263 * Note that the 'LIN' token also contains the source information for the
3264 * first word of the line for error reporting purposes
3266 * -- the substFlags field of the structure --
3268 * The scriptObj structure is used to represent both "script" objects
3269 * and "subst" objects. In the second case, the there are no LIN and WRD
3270 * tokens. Instead SEP and EOL tokens are added as-is.
3271 * In addition, the field 'substFlags' is used to represent the flags used to turn
3272 * the string into the internal representation.
3273 * If these flags do not match what the application requires,
3274 * the scriptObj is created again. For example the script:
3276 * subst -nocommands $string
3277 * subst -novariables $string
3279 * Will (re)create the internal representation of the $string object
3280 * two times.
3282 typedef struct ScriptObj
3284 ScriptToken *token; /* Tokens array. */
3285 Jim_Obj *fileNameObj; /* Filename */
3286 int len; /* Length of token[] */
3287 int substFlags; /* flags used for the compilation of "subst" objects */
3288 int inUse; /* Used to share a ScriptObj. Currently
3289 only used by Jim_EvalObj() as protection against
3290 shimmering of the currently evaluated object. */
3291 int firstline; /* Line number of the first line */
3292 int linenr; /* Error line number, if any */
3293 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3294 } ScriptObj;
3296 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3298 int i;
3299 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3301 if (--script->inUse != 0)
3302 return;
3303 for (i = 0; i < script->len; i++) {
3304 Jim_DecrRefCount(interp, script->token[i].objPtr);
3306 Jim_Free(script->token);
3307 Jim_DecrRefCount(interp, script->fileNameObj);
3308 Jim_Free(script);
3311 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3313 JIM_NOTUSED(interp);
3314 JIM_NOTUSED(srcPtr);
3316 /* Just return a simple string. We don't try to preserve the source info
3317 * since in practice scripts are never duplicated
3319 dupPtr->typePtr = NULL;
3322 /* A simple parse token.
3323 * As the script is parsed, the created tokens point into the script string rep.
3325 typedef struct
3327 const char *token; /* Pointer to the start of the token */
3328 int len; /* Length of this token */
3329 int type; /* Token type */
3330 int line; /* Line number */
3331 } ParseToken;
3333 /* A list of parsed tokens representing a script.
3334 * Tokens are added to this list as the script is parsed.
3335 * It grows as needed.
3337 typedef struct
3339 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3340 ParseToken *list; /* Array of tokens */
3341 int size; /* Current size of the list */
3342 int count; /* Number of entries used */
3343 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3344 } ParseTokenList;
3346 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3348 tokenlist->list = tokenlist->static_list;
3349 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3350 tokenlist->count = 0;
3353 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3355 if (tokenlist->list != tokenlist->static_list) {
3356 Jim_Free(tokenlist->list);
3361 * Adds the new token to the tokenlist.
3362 * The token has the given length, type and line number.
3363 * The token list is resized as necessary.
3365 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3366 int line)
3368 ParseToken *t;
3370 if (tokenlist->count == tokenlist->size) {
3371 /* Resize the list */
3372 tokenlist->size *= 2;
3373 if (tokenlist->list != tokenlist->static_list) {
3374 tokenlist->list =
3375 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3377 else {
3378 /* The list needs to become allocated */
3379 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3380 memcpy(tokenlist->list, tokenlist->static_list,
3381 tokenlist->count * sizeof(*tokenlist->list));
3384 t = &tokenlist->list[tokenlist->count++];
3385 t->token = token;
3386 t->len = len;
3387 t->type = type;
3388 t->line = line;
3391 /* Counts the number of adjoining non-separator tokens.
3393 * Returns -ve if the first token is the expansion
3394 * operator (in which case the count doesn't include
3395 * that token).
3397 static int JimCountWordTokens(ParseToken *t)
3399 int expand = 1;
3400 int count = 0;
3402 /* Is the first word {*} or {expand}? */
3403 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3404 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3405 /* Create an expand token */
3406 expand = -1;
3407 t++;
3411 /* Now count non-separator words */
3412 while (!TOKEN_IS_SEP(t->type)) {
3413 t++;
3414 count++;
3417 return count * expand;
3421 * Create a script/subst object from the given token.
3423 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3425 Jim_Obj *objPtr;
3427 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3428 /* Convert backlash escapes. The result will never be longer than the original */
3429 int len = t->len;
3430 char *str = Jim_Alloc(len + 1);
3431 len = JimEscape(str, t->token, len);
3432 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3434 else {
3435 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3436 * with a single space.
3438 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3440 return objPtr;
3444 * Takes a tokenlist and creates the allocated list of script tokens
3445 * in script->token, of length script->len.
3447 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3448 * as required.
3450 * Also sets script->line to the line number of the first token
3452 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3453 ParseTokenList *tokenlist)
3455 int i;
3456 struct ScriptToken *token;
3457 /* Number of tokens so far for the current command */
3458 int lineargs = 0;
3459 /* This is the first token for the current command */
3460 ScriptToken *linefirst;
3461 int count;
3462 int linenr;
3464 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3465 printf("==== Tokens ====\n");
3466 for (i = 0; i < tokenlist->count; i++) {
3467 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3468 tokenlist->list[i].len, tokenlist->list[i].token);
3470 #endif
3472 /* May need up to one extra script token for each EOL in the worst case */
3473 count = tokenlist->count;
3474 for (i = 0; i < tokenlist->count; i++) {
3475 if (tokenlist->list[i].type == JIM_TT_EOL) {
3476 count++;
3479 linenr = script->firstline = tokenlist->list[0].line;
3481 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3483 /* This is the first token for the current command */
3484 linefirst = token++;
3486 for (i = 0; i < tokenlist->count; ) {
3487 /* Look ahead to find out how many tokens make up the next word */
3488 int wordtokens;
3490 /* Skip any leading separators */
3491 while (tokenlist->list[i].type == JIM_TT_SEP) {
3492 i++;
3495 wordtokens = JimCountWordTokens(tokenlist->list + i);
3497 if (wordtokens == 0) {
3498 /* None, so at end of line */
3499 if (lineargs) {
3500 linefirst->type = JIM_TT_LINE;
3501 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3502 Jim_IncrRefCount(linefirst->objPtr);
3504 /* Reset for new line */
3505 lineargs = 0;
3506 linefirst = token++;
3508 i++;
3509 continue;
3511 else if (wordtokens != 1) {
3512 /* More than 1, or {*}, so insert a WORD token */
3513 token->type = JIM_TT_WORD;
3514 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3515 Jim_IncrRefCount(token->objPtr);
3516 token++;
3517 if (wordtokens < 0) {
3518 /* Skip the expand token */
3519 i++;
3520 wordtokens = -wordtokens - 1;
3521 lineargs--;
3525 if (lineargs == 0) {
3526 /* First real token on the line, so record the line number */
3527 linenr = tokenlist->list[i].line;
3529 lineargs++;
3531 /* Add each non-separator word token to the line */
3532 while (wordtokens--) {
3533 const ParseToken *t = &tokenlist->list[i++];
3535 token->type = t->type;
3536 token->objPtr = JimMakeScriptObj(interp, t);
3537 Jim_IncrRefCount(token->objPtr);
3539 /* Every object is initially a string of type 'source', but the
3540 * internal type may be specialized during execution of the
3541 * script. */
3542 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3543 token++;
3547 if (lineargs == 0) {
3548 token--;
3551 script->len = token - script->token;
3553 JimPanic((script->len >= count, "allocated script array is too short"));
3555 #ifdef DEBUG_SHOW_SCRIPT
3556 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3557 for (i = 0; i < script->len; i++) {
3558 const ScriptToken *t = &script->token[i];
3559 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3561 #endif
3566 * Sets an appropriate error message for a missing script/expression terminator.
3568 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3570 * Note that a trailing backslash is not considered to be an error.
3572 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3574 const char *msg;
3576 switch (ch) {
3577 case '\\':
3578 case ' ':
3579 return JIM_OK;
3581 case '[':
3582 msg = "unmatched \"[\"";
3583 break;
3584 case '{':
3585 msg = "missing close-brace";
3586 break;
3587 case '"':
3588 default:
3589 msg = "missing quote";
3590 break;
3593 Jim_SetResultString(interp, msg, -1);
3594 return JIM_ERR;
3598 * Similar to ScriptObjAddTokens(), but for subst objects.
3600 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3601 ParseTokenList *tokenlist)
3603 int i;
3604 struct ScriptToken *token;
3606 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3608 for (i = 0; i < tokenlist->count; i++) {
3609 const ParseToken *t = &tokenlist->list[i];
3611 /* Create a token for 't' */
3612 token->type = t->type;
3613 token->objPtr = JimMakeScriptObj(interp, t);
3614 Jim_IncrRefCount(token->objPtr);
3615 token++;
3618 script->len = i;
3621 /* This method takes the string representation of an object
3622 * as a Tcl script, and generates the pre-parsed internal representation
3623 * of the script.
3625 * On parse error, sets an error message and returns JIM_ERR
3626 * (Note: the object is still converted to a script, even if an error occurs)
3628 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3630 int scriptTextLen;
3631 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3632 struct JimParserCtx parser;
3633 struct ScriptObj *script;
3634 ParseTokenList tokenlist;
3635 int line = 1;
3637 /* Try to get information about filename / line number */
3638 if (objPtr->typePtr == &sourceObjType) {
3639 line = objPtr->internalRep.sourceValue.lineNumber;
3642 /* Initially parse the script into tokens (in tokenlist) */
3643 ScriptTokenListInit(&tokenlist);
3645 JimParserInit(&parser, scriptText, scriptTextLen, line);
3646 while (!parser.eof) {
3647 JimParseScript(&parser);
3648 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3649 parser.tline);
3652 /* Add a final EOF token */
3653 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3655 /* Create the "real" script tokens from the parsed tokens */
3656 script = Jim_Alloc(sizeof(*script));
3657 memset(script, 0, sizeof(*script));
3658 script->inUse = 1;
3659 if (objPtr->typePtr == &sourceObjType) {
3660 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3662 else {
3663 script->fileNameObj = interp->emptyObj;
3665 Jim_IncrRefCount(script->fileNameObj);
3666 script->missing = parser.missing.ch;
3667 script->linenr = parser.missing.line;
3669 ScriptObjAddTokens(interp, script, &tokenlist);
3671 /* No longer need the token list */
3672 ScriptTokenListFree(&tokenlist);
3674 /* Free the old internal rep and set the new one. */
3675 Jim_FreeIntRep(interp, objPtr);
3676 Jim_SetIntRepPtr(objPtr, script);
3677 objPtr->typePtr = &scriptObjType;
3680 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3683 * Returns the parsed script.
3684 * Note that if there is any possibility that the script is not valid,
3685 * call JimScriptValid() to check
3687 ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3689 if (objPtr == interp->emptyObj) {
3690 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3691 objPtr = interp->nullScriptObj;
3694 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3695 JimSetScriptFromAny(interp, objPtr);
3698 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3702 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3703 * and leaves an error message in the interp result.
3706 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3708 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3709 JimAddErrorToStack(interp, script);
3710 return 0;
3712 return 1;
3716 /* -----------------------------------------------------------------------------
3717 * Commands
3718 * ---------------------------------------------------------------------------*/
3719 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3721 cmdPtr->inUse++;
3724 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3726 if (--cmdPtr->inUse == 0) {
3727 if (cmdPtr->isproc) {
3728 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3729 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3730 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3731 if (cmdPtr->u.proc.staticVars) {
3732 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3733 Jim_Free(cmdPtr->u.proc.staticVars);
3736 else {
3737 /* native (C) */
3738 if (cmdPtr->u.native.delProc) {
3739 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3742 if (cmdPtr->prevCmd) {
3743 /* Delete any pushed command too */
3744 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3746 Jim_Free(cmdPtr);
3750 /* Variables HashTable Type.
3752 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3755 /* Variables HashTable Type.
3757 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3758 static void JimVariablesHTValDestructor(void *interp, void *val)
3760 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3761 Jim_Free(val);
3764 static const Jim_HashTableType JimVariablesHashTableType = {
3765 JimStringCopyHTHashFunction, /* hash function */
3766 JimStringCopyHTDup, /* key dup */
3767 NULL, /* val dup */
3768 JimStringCopyHTKeyCompare, /* key compare */
3769 JimStringCopyHTKeyDestructor, /* key destructor */
3770 JimVariablesHTValDestructor /* val destructor */
3773 /* Commands HashTable Type.
3775 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3777 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3779 JimDecrCmdRefCount(interp, val);
3782 static const Jim_HashTableType JimCommandsHashTableType = {
3783 JimStringCopyHTHashFunction, /* hash function */
3784 JimStringCopyHTDup, /* key dup */
3785 NULL, /* val dup */
3786 JimStringCopyHTKeyCompare, /* key compare */
3787 JimStringCopyHTKeyDestructor, /* key destructor */
3788 JimCommandsHT_ValDestructor /* val destructor */
3791 /* ------------------------- Commands related functions --------------------- */
3793 #ifdef jim_ext_namespace
3795 * Returns the "unscoped" version of the given namespace.
3796 * That is, the fully qualified name without the leading ::
3797 * The returned value is either nsObj, or an object with a zero ref count.
3799 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3801 const char *name = Jim_String(nsObj);
3802 if (name[0] == ':' && name[1] == ':') {
3803 /* This command is being defined in the global namespace */
3804 while (*++name == ':') {
3806 nsObj = Jim_NewStringObj(interp, name, -1);
3808 else if (Jim_Length(interp->framePtr->nsObj)) {
3809 /* This command is being defined in a non-global namespace */
3810 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3811 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3813 return nsObj;
3816 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3818 Jim_Obj *resultObj;
3820 const char *name = Jim_String(nameObjPtr);
3821 if (name[0] == ':' && name[1] == ':') {
3822 return nameObjPtr;
3824 Jim_IncrRefCount(nameObjPtr);
3825 resultObj = Jim_NewStringObj(interp, "::", -1);
3826 Jim_AppendObj(interp, resultObj, nameObjPtr);
3827 Jim_DecrRefCount(interp, nameObjPtr);
3829 return resultObj;
3833 * An efficient version of JimQualifyNameObj() where the name is
3834 * available (and needed) as a 'const char *'.
3835 * Avoids creating an object if not necessary.
3836 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3838 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3840 Jim_Obj *objPtr = interp->emptyObj;
3842 if (name[0] == ':' && name[1] == ':') {
3843 /* This command is being defined in the global namespace */
3844 while (*++name == ':') {
3847 else if (Jim_Length(interp->framePtr->nsObj)) {
3848 /* This command is being defined in a non-global namespace */
3849 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3850 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3851 name = Jim_String(objPtr);
3853 Jim_IncrRefCount(objPtr);
3854 *objPtrPtr = objPtr;
3855 return name;
3858 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3860 #else
3861 /* We can be more efficient in the no-namespace case */
3862 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3863 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3865 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3867 return nameObjPtr;
3869 #endif
3871 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3873 /* It may already exist, so we try to delete the old one.
3874 * Note that reference count means that it won't be deleted yet if
3875 * it exists in the call stack.
3877 * BUT, if 'local' is in force, instead of deleting the existing
3878 * proc, we stash a reference to the old proc here.
3880 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3881 if (he) {
3882 /* There was an old cmd with the same name,
3883 * so this requires a 'proc epoch' update. */
3885 /* If a procedure with the same name didn't exist there is no need
3886 * to increment the 'proc epoch' because creation of a new procedure
3887 * can never affect existing cached commands. We don't do
3888 * negative caching. */
3889 Jim_InterpIncrProcEpoch(interp);
3892 if (he && interp->local) {
3893 /* Push this command over the top of the previous one */
3894 cmd->prevCmd = Jim_GetHashEntryVal(he);
3895 Jim_SetHashVal(&interp->commands, he, cmd);
3897 else {
3898 if (he) {
3899 /* Replace the existing command */
3900 Jim_DeleteHashEntry(&interp->commands, name);
3903 Jim_AddHashEntry(&interp->commands, name, cmd);
3905 return JIM_OK;
3909 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3910 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3912 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3914 /* Store the new details for this command */
3915 memset(cmdPtr, 0, sizeof(*cmdPtr));
3916 cmdPtr->inUse = 1;
3917 cmdPtr->u.native.delProc = delProc;
3918 cmdPtr->u.native.cmdProc = cmdProc;
3919 cmdPtr->u.native.privData = privData;
3921 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3923 return JIM_OK;
3926 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3928 int len, i;
3930 len = Jim_ListLength(interp, staticsListObjPtr);
3931 if (len == 0) {
3932 return JIM_OK;
3935 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3936 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3937 for (i = 0; i < len; i++) {
3938 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3939 Jim_Var *varPtr;
3940 int subLen;
3942 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3943 /* Check if it's composed of two elements. */
3944 subLen = Jim_ListLength(interp, objPtr);
3945 if (subLen == 1 || subLen == 2) {
3946 /* Try to get the variable value from the current
3947 * environment. */
3948 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3949 if (subLen == 1) {
3950 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3951 if (initObjPtr == NULL) {
3952 Jim_SetResultFormatted(interp,
3953 "variable for initialization of static \"%#s\" not found in the local context",
3954 nameObjPtr);
3955 return JIM_ERR;
3958 else {
3959 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3961 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3962 return JIM_ERR;
3965 varPtr = Jim_Alloc(sizeof(*varPtr));
3966 varPtr->objPtr = initObjPtr;
3967 Jim_IncrRefCount(initObjPtr);
3968 varPtr->linkFramePtr = NULL;
3969 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3970 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3971 Jim_SetResultFormatted(interp,
3972 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3973 Jim_DecrRefCount(interp, initObjPtr);
3974 Jim_Free(varPtr);
3975 return JIM_ERR;
3978 else {
3979 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3980 objPtr);
3981 return JIM_ERR;
3984 return JIM_OK;
3987 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3989 #ifdef jim_ext_namespace
3990 if (cmdPtr->isproc) {
3991 /* XXX: Really need JimNamespaceSplit() */
3992 const char *pt = strrchr(cmdname, ':');
3993 if (pt && pt != cmdname && pt[-1] == ':') {
3994 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3995 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3996 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3998 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3999 /* This commands shadows a global command, so a proc epoch update is required */
4000 Jim_InterpIncrProcEpoch(interp);
4004 #endif
4007 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4008 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4010 Jim_Cmd *cmdPtr;
4011 int argListLen;
4012 int i;
4014 argListLen = Jim_ListLength(interp, argListObjPtr);
4016 /* Allocate space for both the command pointer and the arg list */
4017 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4018 memset(cmdPtr, 0, sizeof(*cmdPtr));
4019 cmdPtr->inUse = 1;
4020 cmdPtr->isproc = 1;
4021 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4022 cmdPtr->u.proc.argListLen = argListLen;
4023 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4024 cmdPtr->u.proc.argsPos = -1;
4025 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4026 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4027 Jim_IncrRefCount(argListObjPtr);
4028 Jim_IncrRefCount(bodyObjPtr);
4029 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4031 /* Create the statics hash table. */
4032 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4033 goto err;
4036 /* Parse the args out into arglist, validating as we go */
4037 /* Examine the argument list for default parameters and 'args' */
4038 for (i = 0; i < argListLen; i++) {
4039 Jim_Obj *argPtr;
4040 Jim_Obj *nameObjPtr;
4041 Jim_Obj *defaultObjPtr;
4042 int len;
4044 /* Examine a parameter */
4045 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4046 len = Jim_ListLength(interp, argPtr);
4047 if (len == 0) {
4048 Jim_SetResultString(interp, "argument with no name", -1);
4049 err:
4050 JimDecrCmdRefCount(interp, cmdPtr);
4051 return NULL;
4053 if (len > 2) {
4054 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4055 goto err;
4058 if (len == 2) {
4059 /* Optional parameter */
4060 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4061 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4063 else {
4064 /* Required parameter */
4065 nameObjPtr = argPtr;
4066 defaultObjPtr = NULL;
4070 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4071 if (cmdPtr->u.proc.argsPos >= 0) {
4072 Jim_SetResultString(interp, "'args' specified more than once", -1);
4073 goto err;
4075 cmdPtr->u.proc.argsPos = i;
4077 else {
4078 if (len == 2) {
4079 cmdPtr->u.proc.optArity++;
4081 else {
4082 cmdPtr->u.proc.reqArity++;
4086 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4087 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4090 return cmdPtr;
4093 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4095 int ret = JIM_OK;
4096 Jim_Obj *qualifiedNameObj;
4097 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4099 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4100 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4101 ret = JIM_ERR;
4103 else {
4104 Jim_InterpIncrProcEpoch(interp);
4107 JimFreeQualifiedName(interp, qualifiedNameObj);
4109 return ret;
4112 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4114 int ret = JIM_ERR;
4115 Jim_HashEntry *he;
4116 Jim_Cmd *cmdPtr;
4117 Jim_Obj *qualifiedOldNameObj;
4118 Jim_Obj *qualifiedNewNameObj;
4119 const char *fqold;
4120 const char *fqnew;
4122 if (newName[0] == 0) {
4123 return Jim_DeleteCommand(interp, oldName);
4126 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4127 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4129 /* Does it exist? */
4130 he = Jim_FindHashEntry(&interp->commands, fqold);
4131 if (he == NULL) {
4132 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4134 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4135 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4137 else {
4138 /* Add the new name first */
4139 cmdPtr = Jim_GetHashEntryVal(he);
4140 JimIncrCmdRefCount(cmdPtr);
4141 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4142 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4144 /* Now remove the old name */
4145 Jim_DeleteHashEntry(&interp->commands, fqold);
4147 /* Increment the epoch */
4148 Jim_InterpIncrProcEpoch(interp);
4150 ret = JIM_OK;
4153 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4154 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4156 return ret;
4159 /* -----------------------------------------------------------------------------
4160 * Command object
4161 * ---------------------------------------------------------------------------*/
4163 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4165 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4168 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4170 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4171 dupPtr->typePtr = srcPtr->typePtr;
4172 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4175 static const Jim_ObjType commandObjType = {
4176 "command",
4177 FreeCommandInternalRep,
4178 DupCommandInternalRep,
4179 NULL,
4180 JIM_TYPE_REFERENCES,
4183 /* This function returns the command structure for the command name
4184 * stored in objPtr. It tries to specialize the objPtr to contain
4185 * a cached info instead to perform the lookup into the hash table
4186 * every time. The information cached may not be uptodate, in such
4187 * a case the lookup is performed and the cache updated.
4189 * Respects the 'upcall' setting
4191 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4193 Jim_Cmd *cmd;
4195 /* In order to be valid, the proc epoch must match and
4196 * the lookup must have occurred in the same namespace
4198 if (objPtr->typePtr != &commandObjType ||
4199 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4200 #ifdef jim_ext_namespace
4201 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4202 #endif
4204 /* Not cached or out of date, so lookup */
4206 /* Do we need to try the local namespace? */
4207 const char *name = Jim_String(objPtr);
4208 Jim_HashEntry *he;
4210 if (name[0] == ':' && name[1] == ':') {
4211 while (*++name == ':') {
4214 #ifdef jim_ext_namespace
4215 else if (Jim_Length(interp->framePtr->nsObj)) {
4216 /* This command is being defined in a non-global namespace */
4217 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4218 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4219 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4220 Jim_FreeNewObj(interp, nameObj);
4221 if (he) {
4222 goto found;
4225 #endif
4227 /* Lookup in the global namespace */
4228 he = Jim_FindHashEntry(&interp->commands, name);
4229 if (he == NULL) {
4230 if (flags & JIM_ERRMSG) {
4231 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4233 return NULL;
4235 #ifdef jim_ext_namespace
4236 found:
4237 #endif
4238 cmd = Jim_GetHashEntryVal(he);
4240 /* Free the old internal repr and set the new one. */
4241 Jim_FreeIntRep(interp, objPtr);
4242 objPtr->typePtr = &commandObjType;
4243 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4244 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4245 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4246 Jim_IncrRefCount(interp->framePtr->nsObj);
4248 else {
4249 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4251 while (cmd->u.proc.upcall) {
4252 cmd = cmd->prevCmd;
4254 return cmd;
4257 /* -----------------------------------------------------------------------------
4258 * Variables
4259 * ---------------------------------------------------------------------------*/
4261 /* -----------------------------------------------------------------------------
4262 * Variable object
4263 * ---------------------------------------------------------------------------*/
4265 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4267 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4269 static const Jim_ObjType variableObjType = {
4270 "variable",
4271 NULL,
4272 NULL,
4273 NULL,
4274 JIM_TYPE_REFERENCES,
4278 * Check that the name does not contain embedded nulls.
4280 * Variable and procedure names are manipulated as null terminated strings, so
4281 * don't allow names with embedded nulls.
4283 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4285 /* Variable names and proc names can't contain embedded nulls */
4286 if (nameObjPtr->typePtr != &variableObjType) {
4287 int len;
4288 const char *str = Jim_GetString(nameObjPtr, &len);
4289 if (memchr(str, '\0', len)) {
4290 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4291 return JIM_ERR;
4294 return JIM_OK;
4297 /* This method should be called only by the variable API.
4298 * It returns JIM_OK on success (variable already exists),
4299 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4300 * a variable name, but syntax glue for [dict] i.e. the last
4301 * character is ')' */
4302 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4304 const char *varName;
4305 Jim_CallFrame *framePtr;
4306 Jim_HashEntry *he;
4307 int global;
4308 int len;
4310 /* Check if the object is already an uptodate variable */
4311 if (objPtr->typePtr == &variableObjType) {
4312 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4313 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4314 /* nothing to do */
4315 return JIM_OK;
4317 /* Need to re-resolve the variable in the updated callframe */
4319 else if (objPtr->typePtr == &dictSubstObjType) {
4320 return JIM_DICT_SUGAR;
4322 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4323 return JIM_ERR;
4327 varName = Jim_GetString(objPtr, &len);
4329 /* Make sure it's not syntax glue to get/set dict. */
4330 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4331 return JIM_DICT_SUGAR;
4334 if (varName[0] == ':' && varName[1] == ':') {
4335 while (*++varName == ':') {
4337 global = 1;
4338 framePtr = interp->topFramePtr;
4340 else {
4341 global = 0;
4342 framePtr = interp->framePtr;
4345 /* Resolve this name in the variables hash table */
4346 he = Jim_FindHashEntry(&framePtr->vars, varName);
4347 if (he == NULL) {
4348 if (!global && framePtr->staticVars) {
4349 /* Try with static vars. */
4350 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4352 if (he == NULL) {
4353 return JIM_ERR;
4357 /* Free the old internal repr and set the new one. */
4358 Jim_FreeIntRep(interp, objPtr);
4359 objPtr->typePtr = &variableObjType;
4360 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4361 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4362 objPtr->internalRep.varValue.global = global;
4363 return JIM_OK;
4366 /* -------------------- Variables related functions ------------------------- */
4367 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4368 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4370 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4372 const char *name;
4373 Jim_CallFrame *framePtr;
4374 int global;
4376 /* New variable to create */
4377 Jim_Var *var = Jim_Alloc(sizeof(*var));
4379 var->objPtr = valObjPtr;
4380 Jim_IncrRefCount(valObjPtr);
4381 var->linkFramePtr = NULL;
4383 name = Jim_String(nameObjPtr);
4384 if (name[0] == ':' && name[1] == ':') {
4385 while (*++name == ':') {
4387 framePtr = interp->topFramePtr;
4388 global = 1;
4390 else {
4391 framePtr = interp->framePtr;
4392 global = 0;
4395 /* Insert the new variable */
4396 Jim_AddHashEntry(&framePtr->vars, name, var);
4398 /* Make the object int rep a variable */
4399 Jim_FreeIntRep(interp, nameObjPtr);
4400 nameObjPtr->typePtr = &variableObjType;
4401 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4402 nameObjPtr->internalRep.varValue.varPtr = var;
4403 nameObjPtr->internalRep.varValue.global = global;
4405 return var;
4408 /* For now that's dummy. Variables lookup should be optimized
4409 * in many ways, with caching of lookups, and possibly with
4410 * a table of pre-allocated vars in every CallFrame for local vars.
4411 * All the caching should also have an 'epoch' mechanism similar
4412 * to the one used by Tcl for procedures lookup caching. */
4414 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4416 int err;
4417 Jim_Var *var;
4419 switch (SetVariableFromAny(interp, nameObjPtr)) {
4420 case JIM_DICT_SUGAR:
4421 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4423 case JIM_ERR:
4424 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4425 return JIM_ERR;
4427 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4428 break;
4430 case JIM_OK:
4431 var = nameObjPtr->internalRep.varValue.varPtr;
4432 if (var->linkFramePtr == NULL) {
4433 Jim_IncrRefCount(valObjPtr);
4434 Jim_DecrRefCount(interp, var->objPtr);
4435 var->objPtr = valObjPtr;
4437 else { /* Else handle the link */
4438 Jim_CallFrame *savedCallFrame;
4440 savedCallFrame = interp->framePtr;
4441 interp->framePtr = var->linkFramePtr;
4442 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4443 interp->framePtr = savedCallFrame;
4444 if (err != JIM_OK)
4445 return err;
4448 return JIM_OK;
4451 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4453 Jim_Obj *nameObjPtr;
4454 int result;
4456 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4457 Jim_IncrRefCount(nameObjPtr);
4458 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4459 Jim_DecrRefCount(interp, nameObjPtr);
4460 return result;
4463 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4465 Jim_CallFrame *savedFramePtr;
4466 int result;
4468 savedFramePtr = interp->framePtr;
4469 interp->framePtr = interp->topFramePtr;
4470 result = Jim_SetVariableStr(interp, name, objPtr);
4471 interp->framePtr = savedFramePtr;
4472 return result;
4475 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4477 Jim_Obj *nameObjPtr, *valObjPtr;
4478 int result;
4480 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4481 valObjPtr = Jim_NewStringObj(interp, val, -1);
4482 Jim_IncrRefCount(nameObjPtr);
4483 Jim_IncrRefCount(valObjPtr);
4484 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4485 Jim_DecrRefCount(interp, nameObjPtr);
4486 Jim_DecrRefCount(interp, valObjPtr);
4487 return result;
4490 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4491 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4493 const char *varName;
4494 const char *targetName;
4495 Jim_CallFrame *framePtr;
4496 Jim_Var *varPtr;
4498 /* Check for an existing variable or link */
4499 switch (SetVariableFromAny(interp, nameObjPtr)) {
4500 case JIM_DICT_SUGAR:
4501 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4502 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4503 return JIM_ERR;
4505 case JIM_OK:
4506 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4508 if (varPtr->linkFramePtr == NULL) {
4509 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4510 return JIM_ERR;
4513 /* It exists, but is a link, so first delete the link */
4514 varPtr->linkFramePtr = NULL;
4515 break;
4518 /* Resolve the call frames for both variables */
4519 /* XXX: SetVariableFromAny() already did this! */
4520 varName = Jim_String(nameObjPtr);
4522 if (varName[0] == ':' && varName[1] == ':') {
4523 while (*++varName == ':') {
4525 /* Linking a global var does nothing */
4526 framePtr = interp->topFramePtr;
4528 else {
4529 framePtr = interp->framePtr;
4532 targetName = Jim_String(targetNameObjPtr);
4533 if (targetName[0] == ':' && targetName[1] == ':') {
4534 while (*++targetName == ':') {
4536 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4537 targetCallFrame = interp->topFramePtr;
4539 Jim_IncrRefCount(targetNameObjPtr);
4541 if (framePtr->level < targetCallFrame->level) {
4542 Jim_SetResultFormatted(interp,
4543 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4544 nameObjPtr);
4545 Jim_DecrRefCount(interp, targetNameObjPtr);
4546 return JIM_ERR;
4549 /* Check for cycles. */
4550 if (framePtr == targetCallFrame) {
4551 Jim_Obj *objPtr = targetNameObjPtr;
4553 /* Cycles are only possible with 'uplevel 0' */
4554 while (1) {
4555 if (strcmp(Jim_String(objPtr), varName) == 0) {
4556 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4557 Jim_DecrRefCount(interp, targetNameObjPtr);
4558 return JIM_ERR;
4560 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4561 break;
4562 varPtr = objPtr->internalRep.varValue.varPtr;
4563 if (varPtr->linkFramePtr != targetCallFrame)
4564 break;
4565 objPtr = varPtr->objPtr;
4569 /* Perform the binding */
4570 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4571 /* We are now sure 'nameObjPtr' type is variableObjType */
4572 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4573 Jim_DecrRefCount(interp, targetNameObjPtr);
4574 return JIM_OK;
4577 /* Return the Jim_Obj pointer associated with a variable name,
4578 * or NULL if the variable was not found in the current context.
4579 * The same optimization discussed in the comment to the
4580 * 'SetVariable' function should apply here.
4582 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4583 * in a dictionary which is shared, the array variable value is duplicated first.
4584 * This allows the array element to be updated (e.g. append, lappend) without
4585 * affecting other references to the dictionary.
4587 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4589 switch (SetVariableFromAny(interp, nameObjPtr)) {
4590 case JIM_OK:{
4591 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4593 if (varPtr->linkFramePtr == NULL) {
4594 return varPtr->objPtr;
4596 else {
4597 Jim_Obj *objPtr;
4599 /* The variable is a link? Resolve it. */
4600 Jim_CallFrame *savedCallFrame = interp->framePtr;
4602 interp->framePtr = varPtr->linkFramePtr;
4603 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4604 interp->framePtr = savedCallFrame;
4605 if (objPtr) {
4606 return objPtr;
4608 /* Error, so fall through to the error message */
4611 break;
4613 case JIM_DICT_SUGAR:
4614 /* [dict] syntax sugar. */
4615 return JimDictSugarGet(interp, nameObjPtr, flags);
4617 if (flags & JIM_ERRMSG) {
4618 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4620 return NULL;
4623 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4625 Jim_CallFrame *savedFramePtr;
4626 Jim_Obj *objPtr;
4628 savedFramePtr = interp->framePtr;
4629 interp->framePtr = interp->topFramePtr;
4630 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4631 interp->framePtr = savedFramePtr;
4633 return objPtr;
4636 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4638 Jim_Obj *nameObjPtr, *varObjPtr;
4640 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4641 Jim_IncrRefCount(nameObjPtr);
4642 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4643 Jim_DecrRefCount(interp, nameObjPtr);
4644 return varObjPtr;
4647 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4649 Jim_CallFrame *savedFramePtr;
4650 Jim_Obj *objPtr;
4652 savedFramePtr = interp->framePtr;
4653 interp->framePtr = interp->topFramePtr;
4654 objPtr = Jim_GetVariableStr(interp, name, flags);
4655 interp->framePtr = savedFramePtr;
4657 return objPtr;
4660 /* Unset a variable.
4661 * Note: On success unset invalidates all the variable objects created
4662 * in the current call frame incrementing. */
4663 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4665 Jim_Var *varPtr;
4666 int retval;
4667 Jim_CallFrame *framePtr;
4669 retval = SetVariableFromAny(interp, nameObjPtr);
4670 if (retval == JIM_DICT_SUGAR) {
4671 /* [dict] syntax sugar. */
4672 return JimDictSugarSet(interp, nameObjPtr, NULL);
4674 else if (retval == JIM_OK) {
4675 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4677 /* If it's a link call UnsetVariable recursively */
4678 if (varPtr->linkFramePtr) {
4679 framePtr = interp->framePtr;
4680 interp->framePtr = varPtr->linkFramePtr;
4681 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4682 interp->framePtr = framePtr;
4684 else {
4685 const char *name = Jim_String(nameObjPtr);
4686 if (nameObjPtr->internalRep.varValue.global) {
4687 name += 2;
4688 framePtr = interp->topFramePtr;
4690 else {
4691 framePtr = interp->framePtr;
4694 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4695 if (retval == JIM_OK) {
4696 /* Change the callframe id, invalidating var lookup caching */
4697 framePtr->id = interp->callFrameEpoch++;
4701 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4702 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4704 return retval;
4707 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4709 /* Given a variable name for [dict] operation syntax sugar,
4710 * this function returns two objects, the first with the name
4711 * of the variable to set, and the second with the respective key.
4712 * For example "foo(bar)" will return objects with string repr. of
4713 * "foo" and "bar".
4715 * The returned objects have refcount = 1. The function can't fail. */
4716 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4717 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4719 const char *str, *p;
4720 int len, keyLen;
4721 Jim_Obj *varObjPtr, *keyObjPtr;
4723 str = Jim_GetString(objPtr, &len);
4725 p = strchr(str, '(');
4726 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4728 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4730 p++;
4731 keyLen = (str + len) - p;
4732 if (str[len - 1] == ')') {
4733 keyLen--;
4736 /* Create the objects with the variable name and key. */
4737 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4739 Jim_IncrRefCount(varObjPtr);
4740 Jim_IncrRefCount(keyObjPtr);
4741 *varPtrPtr = varObjPtr;
4742 *keyPtrPtr = keyObjPtr;
4745 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4746 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4747 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4749 int err;
4751 SetDictSubstFromAny(interp, objPtr);
4753 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4754 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4756 if (err == JIM_OK) {
4757 /* Don't keep an extra ref to the result */
4758 Jim_SetEmptyResult(interp);
4760 else {
4761 if (!valObjPtr) {
4762 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4763 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4764 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4765 objPtr);
4766 return err;
4769 /* Make the error more informative and Tcl-compatible */
4770 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4771 (valObjPtr ? "set" : "unset"), objPtr);
4773 return err;
4777 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4779 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4780 * and stored back to the variable before expansion.
4782 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4783 Jim_Obj *keyObjPtr, int flags)
4785 Jim_Obj *dictObjPtr;
4786 Jim_Obj *resObjPtr = NULL;
4787 int ret;
4789 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4790 if (!dictObjPtr) {
4791 return NULL;
4794 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4795 if (ret != JIM_OK) {
4796 Jim_SetResultFormatted(interp,
4797 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4798 ret < 0 ? "variable isn't" : "no such element in");
4800 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4801 /* Update the variable to have an unshared copy */
4802 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4805 return resObjPtr;
4808 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4809 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4811 SetDictSubstFromAny(interp, objPtr);
4813 return JimDictExpandArrayVariable(interp,
4814 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4815 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4818 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4820 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4822 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4823 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4826 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4828 JIM_NOTUSED(interp);
4830 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4831 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4832 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4833 dupPtr->typePtr = &dictSubstObjType;
4836 /* Note: The object *must* be in dict-sugar format */
4837 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4839 if (objPtr->typePtr != &dictSubstObjType) {
4840 Jim_Obj *varObjPtr, *keyObjPtr;
4842 if (objPtr->typePtr == &interpolatedObjType) {
4843 /* An interpolated object in dict-sugar form */
4845 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4846 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4848 Jim_IncrRefCount(varObjPtr);
4849 Jim_IncrRefCount(keyObjPtr);
4851 else {
4852 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4855 Jim_FreeIntRep(interp, objPtr);
4856 objPtr->typePtr = &dictSubstObjType;
4857 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4858 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4862 /* This function is used to expand [dict get] sugar in the form
4863 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4864 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4865 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4866 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4867 * the [dict]ionary contained in variable VARNAME. */
4868 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4870 Jim_Obj *resObjPtr = NULL;
4871 Jim_Obj *substKeyObjPtr = NULL;
4873 SetDictSubstFromAny(interp, objPtr);
4875 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4876 &substKeyObjPtr, JIM_NONE)
4877 != JIM_OK) {
4878 return NULL;
4880 Jim_IncrRefCount(substKeyObjPtr);
4881 resObjPtr =
4882 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4883 substKeyObjPtr, 0);
4884 Jim_DecrRefCount(interp, substKeyObjPtr);
4886 return resObjPtr;
4889 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4891 Jim_Obj *resultObjPtr;
4893 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4894 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4895 resultObjPtr->refCount--;
4896 return resultObjPtr;
4898 return NULL;
4901 /* -----------------------------------------------------------------------------
4902 * CallFrame
4903 * ---------------------------------------------------------------------------*/
4905 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4907 Jim_CallFrame *cf;
4909 if (interp->freeFramesList) {
4910 cf = interp->freeFramesList;
4911 interp->freeFramesList = cf->next;
4913 cf->argv = NULL;
4914 cf->argc = 0;
4915 cf->procArgsObjPtr = NULL;
4916 cf->procBodyObjPtr = NULL;
4917 cf->next = NULL;
4918 cf->staticVars = NULL;
4919 cf->localCommands = NULL;
4920 cf->tailcallObj = NULL;
4921 cf->tailcallCmd = NULL;
4923 else {
4924 cf = Jim_Alloc(sizeof(*cf));
4925 memset(cf, 0, sizeof(*cf));
4927 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4930 cf->id = interp->callFrameEpoch++;
4931 cf->parent = parent;
4932 cf->level = parent ? parent->level + 1 : 0;
4933 cf->nsObj = nsObj;
4934 Jim_IncrRefCount(nsObj);
4936 return cf;
4939 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4941 /* Delete any local procs */
4942 if (localCommands) {
4943 Jim_Obj *cmdNameObj;
4945 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4946 Jim_HashEntry *he;
4947 Jim_Obj *fqObjName;
4948 Jim_HashTable *ht = &interp->commands;
4950 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4952 he = Jim_FindHashEntry(ht, fqname);
4954 if (he) {
4955 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4956 if (cmd->prevCmd) {
4957 Jim_Cmd *prevCmd = cmd->prevCmd;
4958 cmd->prevCmd = NULL;
4960 /* Delete the old command */
4961 JimDecrCmdRefCount(interp, cmd);
4963 /* And restore the original */
4964 Jim_SetHashVal(ht, he, prevCmd);
4966 else {
4967 Jim_DeleteHashEntry(ht, fqname);
4968 Jim_InterpIncrProcEpoch(interp);
4971 Jim_DecrRefCount(interp, cmdNameObj);
4972 JimFreeQualifiedName(interp, fqObjName);
4974 Jim_FreeStack(localCommands);
4975 Jim_Free(localCommands);
4977 return JIM_OK;
4981 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4982 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4983 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4985 JimDeleteLocalProcs(interp, cf->localCommands);
4987 if (cf->procArgsObjPtr)
4988 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4989 if (cf->procBodyObjPtr)
4990 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4991 Jim_DecrRefCount(interp, cf->nsObj);
4992 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4993 Jim_FreeHashTable(&cf->vars);
4994 else {
4995 int i;
4996 Jim_HashEntry **table = cf->vars.table, *he;
4998 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4999 he = table[i];
5000 while (he != NULL) {
5001 Jim_HashEntry *nextEntry = he->next;
5002 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5004 Jim_DecrRefCount(interp, varPtr->objPtr);
5005 Jim_Free(Jim_GetHashEntryKey(he));
5006 Jim_Free(varPtr);
5007 Jim_Free(he);
5008 table[i] = NULL;
5009 he = nextEntry;
5012 cf->vars.used = 0;
5014 cf->next = interp->freeFramesList;
5015 interp->freeFramesList = cf;
5019 /* -----------------------------------------------------------------------------
5020 * References
5021 * ---------------------------------------------------------------------------*/
5022 #ifdef JIM_REFERENCES
5024 /* References HashTable Type.
5026 * Keys are unsigned long integers, dynamically allocated for now but in the
5027 * future it's worth to cache this 4 bytes objects. Values are pointers
5028 * to Jim_References. */
5029 static void JimReferencesHTValDestructor(void *interp, void *val)
5031 Jim_Reference *refPtr = (void *)val;
5033 Jim_DecrRefCount(interp, refPtr->objPtr);
5034 if (refPtr->finalizerCmdNamePtr != NULL) {
5035 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5037 Jim_Free(val);
5040 static unsigned int JimReferencesHTHashFunction(const void *key)
5042 /* Only the least significant bits are used. */
5043 const unsigned long *widePtr = key;
5044 unsigned int intValue = (unsigned int)*widePtr;
5046 return Jim_IntHashFunction(intValue);
5049 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5051 void *copy = Jim_Alloc(sizeof(unsigned long));
5053 JIM_NOTUSED(privdata);
5055 memcpy(copy, key, sizeof(unsigned long));
5056 return copy;
5059 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5061 JIM_NOTUSED(privdata);
5063 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5066 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5068 JIM_NOTUSED(privdata);
5070 Jim_Free(key);
5073 static const Jim_HashTableType JimReferencesHashTableType = {
5074 JimReferencesHTHashFunction, /* hash function */
5075 JimReferencesHTKeyDup, /* key dup */
5076 NULL, /* val dup */
5077 JimReferencesHTKeyCompare, /* key compare */
5078 JimReferencesHTKeyDestructor, /* key destructor */
5079 JimReferencesHTValDestructor /* val destructor */
5082 /* -----------------------------------------------------------------------------
5083 * Reference object type and References API
5084 * ---------------------------------------------------------------------------*/
5086 /* The string representation of references has two features in order
5087 * to make the GC faster. The first is that every reference starts
5088 * with a non common character '<', in order to make the string matching
5089 * faster. The second is that the reference string rep is 42 characters
5090 * in length, this means that it is not necessary to check any object with a string
5091 * repr < 42, and usually there aren't many of these objects. */
5093 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5095 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5097 const char *fmt = "<reference.<%s>.%020lu>";
5099 sprintf(buf, fmt, refPtr->tag, id);
5100 return JIM_REFERENCE_SPACE;
5103 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5105 static const Jim_ObjType referenceObjType = {
5106 "reference",
5107 NULL,
5108 NULL,
5109 UpdateStringOfReference,
5110 JIM_TYPE_REFERENCES,
5113 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5115 char buf[JIM_REFERENCE_SPACE + 1];
5117 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5118 JimSetStringBytes(objPtr, buf);
5121 /* returns true if 'c' is a valid reference tag character.
5122 * i.e. inside the range [_a-zA-Z0-9] */
5123 static int isrefchar(int c)
5125 return (c == '_' || isalnum(c));
5128 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5130 unsigned long value;
5131 int i, len;
5132 const char *str, *start, *end;
5133 char refId[21];
5134 Jim_Reference *refPtr;
5135 Jim_HashEntry *he;
5136 char *endptr;
5138 /* Get the string representation */
5139 str = Jim_GetString(objPtr, &len);
5140 /* Check if it looks like a reference */
5141 if (len < JIM_REFERENCE_SPACE)
5142 goto badformat;
5143 /* Trim spaces */
5144 start = str;
5145 end = str + len - 1;
5146 while (*start == ' ')
5147 start++;
5148 while (*end == ' ' && end > start)
5149 end--;
5150 if (end - start + 1 != JIM_REFERENCE_SPACE)
5151 goto badformat;
5152 /* <reference.<1234567>.%020> */
5153 if (memcmp(start, "<reference.<", 12) != 0)
5154 goto badformat;
5155 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5156 goto badformat;
5157 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5158 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5159 if (!isrefchar(start[12 + i]))
5160 goto badformat;
5162 /* Extract info from the reference. */
5163 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5164 refId[20] = '\0';
5165 /* Try to convert the ID into an unsigned long */
5166 value = strtoul(refId, &endptr, 10);
5167 if (JimCheckConversion(refId, endptr) != JIM_OK)
5168 goto badformat;
5169 /* Check if the reference really exists! */
5170 he = Jim_FindHashEntry(&interp->references, &value);
5171 if (he == NULL) {
5172 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5173 return JIM_ERR;
5175 refPtr = Jim_GetHashEntryVal(he);
5176 /* Free the old internal repr and set the new one. */
5177 Jim_FreeIntRep(interp, objPtr);
5178 objPtr->typePtr = &referenceObjType;
5179 objPtr->internalRep.refValue.id = value;
5180 objPtr->internalRep.refValue.refPtr = refPtr;
5181 return JIM_OK;
5183 badformat:
5184 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5185 return JIM_ERR;
5188 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5189 * as finalizer command (or NULL if there is no finalizer).
5190 * The returned reference object has refcount = 0. */
5191 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5193 struct Jim_Reference *refPtr;
5194 unsigned long id;
5195 Jim_Obj *refObjPtr;
5196 const char *tag;
5197 int tagLen, i;
5199 /* Perform the Garbage Collection if needed. */
5200 Jim_CollectIfNeeded(interp);
5202 refPtr = Jim_Alloc(sizeof(*refPtr));
5203 refPtr->objPtr = objPtr;
5204 Jim_IncrRefCount(objPtr);
5205 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5206 if (cmdNamePtr)
5207 Jim_IncrRefCount(cmdNamePtr);
5208 id = interp->referenceNextId++;
5209 Jim_AddHashEntry(&interp->references, &id, refPtr);
5210 refObjPtr = Jim_NewObj(interp);
5211 refObjPtr->typePtr = &referenceObjType;
5212 refObjPtr->bytes = NULL;
5213 refObjPtr->internalRep.refValue.id = id;
5214 refObjPtr->internalRep.refValue.refPtr = refPtr;
5215 interp->referenceNextId++;
5216 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5217 * that does not pass the 'isrefchar' test is replaced with '_' */
5218 tag = Jim_GetString(tagPtr, &tagLen);
5219 if (tagLen > JIM_REFERENCE_TAGLEN)
5220 tagLen = JIM_REFERENCE_TAGLEN;
5221 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5222 if (i < tagLen && isrefchar(tag[i]))
5223 refPtr->tag[i] = tag[i];
5224 else
5225 refPtr->tag[i] = '_';
5227 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5228 return refObjPtr;
5231 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5233 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5234 return NULL;
5235 return objPtr->internalRep.refValue.refPtr;
5238 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5240 Jim_Reference *refPtr;
5242 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5243 return JIM_ERR;
5244 Jim_IncrRefCount(cmdNamePtr);
5245 if (refPtr->finalizerCmdNamePtr)
5246 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5247 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5248 return JIM_OK;
5251 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5253 Jim_Reference *refPtr;
5255 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5256 return JIM_ERR;
5257 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5258 return JIM_OK;
5261 /* -----------------------------------------------------------------------------
5262 * References Garbage Collection
5263 * ---------------------------------------------------------------------------*/
5265 /* This the hash table type for the "MARK" phase of the GC */
5266 static const Jim_HashTableType JimRefMarkHashTableType = {
5267 JimReferencesHTHashFunction, /* hash function */
5268 JimReferencesHTKeyDup, /* key dup */
5269 NULL, /* val dup */
5270 JimReferencesHTKeyCompare, /* key compare */
5271 JimReferencesHTKeyDestructor, /* key destructor */
5272 NULL /* val destructor */
5275 /* Performs the garbage collection. */
5276 int Jim_Collect(Jim_Interp *interp)
5278 int collected = 0;
5279 #ifndef JIM_BOOTSTRAP
5280 Jim_HashTable marks;
5281 Jim_HashTableIterator htiter;
5282 Jim_HashEntry *he;
5283 Jim_Obj *objPtr;
5285 /* Avoid recursive calls */
5286 if (interp->lastCollectId == -1) {
5287 /* Jim_Collect() already running. Return just now. */
5288 return 0;
5290 interp->lastCollectId = -1;
5292 /* Mark all the references found into the 'mark' hash table.
5293 * The references are searched in every live object that
5294 * is of a type that can contain references. */
5295 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5296 objPtr = interp->liveList;
5297 while (objPtr) {
5298 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5299 const char *str, *p;
5300 int len;
5302 /* If the object is of type reference, to get the
5303 * Id is simple... */
5304 if (objPtr->typePtr == &referenceObjType) {
5305 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5306 #ifdef JIM_DEBUG_GC
5307 printf("MARK (reference): %d refcount: %d\n",
5308 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5309 #endif
5310 objPtr = objPtr->nextObjPtr;
5311 continue;
5313 /* Get the string repr of the object we want
5314 * to scan for references. */
5315 p = str = Jim_GetString(objPtr, &len);
5316 /* Skip objects too little to contain references. */
5317 if (len < JIM_REFERENCE_SPACE) {
5318 objPtr = objPtr->nextObjPtr;
5319 continue;
5321 /* Extract references from the object string repr. */
5322 while (1) {
5323 int i;
5324 unsigned long id;
5326 if ((p = strstr(p, "<reference.<")) == NULL)
5327 break;
5328 /* Check if it's a valid reference. */
5329 if (len - (p - str) < JIM_REFERENCE_SPACE)
5330 break;
5331 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5332 break;
5333 for (i = 21; i <= 40; i++)
5334 if (!isdigit(UCHAR(p[i])))
5335 break;
5336 /* Get the ID */
5337 id = strtoul(p + 21, NULL, 10);
5339 /* Ok, a reference for the given ID
5340 * was found. Mark it. */
5341 Jim_AddHashEntry(&marks, &id, NULL);
5342 #ifdef JIM_DEBUG_GC
5343 printf("MARK: %d\n", (int)id);
5344 #endif
5345 p += JIM_REFERENCE_SPACE;
5348 objPtr = objPtr->nextObjPtr;
5351 /* Run the references hash table to destroy every reference that
5352 * is not referenced outside (not present in the mark HT). */
5353 JimInitHashTableIterator(&interp->references, &htiter);
5354 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5355 const unsigned long *refId;
5356 Jim_Reference *refPtr;
5358 refId = he->key;
5359 /* Check if in the mark phase we encountered
5360 * this reference. */
5361 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5362 #ifdef JIM_DEBUG_GC
5363 printf("COLLECTING %d\n", (int)*refId);
5364 #endif
5365 collected++;
5366 /* Drop the reference, but call the
5367 * finalizer first if registered. */
5368 refPtr = Jim_GetHashEntryVal(he);
5369 if (refPtr->finalizerCmdNamePtr) {
5370 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5371 Jim_Obj *objv[3], *oldResult;
5373 JimFormatReference(refstr, refPtr, *refId);
5375 objv[0] = refPtr->finalizerCmdNamePtr;
5376 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5377 objv[2] = refPtr->objPtr;
5379 /* Drop the reference itself */
5380 /* Avoid the finaliser being freed here */
5381 Jim_IncrRefCount(objv[0]);
5382 /* Don't remove the reference from the hash table just yet
5383 * since that will free refPtr, and hence refPtr->objPtr
5386 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5387 oldResult = interp->result;
5388 Jim_IncrRefCount(oldResult);
5389 Jim_EvalObjVector(interp, 3, objv);
5390 Jim_SetResult(interp, oldResult);
5391 Jim_DecrRefCount(interp, oldResult);
5393 Jim_DecrRefCount(interp, objv[0]);
5395 Jim_DeleteHashEntry(&interp->references, refId);
5398 Jim_FreeHashTable(&marks);
5399 interp->lastCollectId = interp->referenceNextId;
5400 interp->lastCollectTime = time(NULL);
5401 #endif /* JIM_BOOTSTRAP */
5402 return collected;
5405 #define JIM_COLLECT_ID_PERIOD 5000
5406 #define JIM_COLLECT_TIME_PERIOD 300
5408 void Jim_CollectIfNeeded(Jim_Interp *interp)
5410 unsigned long elapsedId;
5411 int elapsedTime;
5413 elapsedId = interp->referenceNextId - interp->lastCollectId;
5414 elapsedTime = time(NULL) - interp->lastCollectTime;
5417 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5418 Jim_Collect(interp);
5421 #endif
5423 int Jim_IsBigEndian(void)
5425 union {
5426 unsigned short s;
5427 unsigned char c[2];
5428 } uval = {0x0102};
5430 return uval.c[0] == 1;
5433 /* -----------------------------------------------------------------------------
5434 * Interpreter related functions
5435 * ---------------------------------------------------------------------------*/
5437 Jim_Interp *Jim_CreateInterp(void)
5439 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5441 memset(i, 0, sizeof(*i));
5443 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5444 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5445 i->lastCollectTime = time(NULL);
5447 /* Note that we can create objects only after the
5448 * interpreter liveList and freeList pointers are
5449 * initialized to NULL. */
5450 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5451 #ifdef JIM_REFERENCES
5452 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5453 #endif
5454 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5455 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5456 i->emptyObj = Jim_NewEmptyStringObj(i);
5457 i->trueObj = Jim_NewIntObj(i, 1);
5458 i->falseObj = Jim_NewIntObj(i, 0);
5459 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5460 i->errorFileNameObj = i->emptyObj;
5461 i->result = i->emptyObj;
5462 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5463 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5464 i->errorProc = i->emptyObj;
5465 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5466 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5467 Jim_IncrRefCount(i->emptyObj);
5468 Jim_IncrRefCount(i->errorFileNameObj);
5469 Jim_IncrRefCount(i->result);
5470 Jim_IncrRefCount(i->stackTrace);
5471 Jim_IncrRefCount(i->unknown);
5472 Jim_IncrRefCount(i->currentScriptObj);
5473 Jim_IncrRefCount(i->nullScriptObj);
5474 Jim_IncrRefCount(i->errorProc);
5475 Jim_IncrRefCount(i->trueObj);
5476 Jim_IncrRefCount(i->falseObj);
5478 /* Initialize key variables every interpreter should contain */
5479 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5480 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5482 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5483 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5484 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5485 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5486 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5487 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5488 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5490 return i;
5493 void Jim_FreeInterp(Jim_Interp *i)
5495 Jim_CallFrame *cf, *cfx;
5497 Jim_Obj *objPtr, *nextObjPtr;
5499 /* Free the active call frames list - must be done before i->commands is destroyed */
5500 for (cf = i->framePtr; cf; cf = cfx) {
5501 cfx = cf->parent;
5502 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5505 Jim_DecrRefCount(i, i->emptyObj);
5506 Jim_DecrRefCount(i, i->trueObj);
5507 Jim_DecrRefCount(i, i->falseObj);
5508 Jim_DecrRefCount(i, i->result);
5509 Jim_DecrRefCount(i, i->stackTrace);
5510 Jim_DecrRefCount(i, i->errorProc);
5511 Jim_DecrRefCount(i, i->unknown);
5512 Jim_DecrRefCount(i, i->errorFileNameObj);
5513 Jim_DecrRefCount(i, i->currentScriptObj);
5514 Jim_DecrRefCount(i, i->nullScriptObj);
5515 Jim_FreeHashTable(&i->commands);
5516 #ifdef JIM_REFERENCES
5517 Jim_FreeHashTable(&i->references);
5518 #endif
5519 Jim_FreeHashTable(&i->packages);
5520 Jim_Free(i->prngState);
5521 Jim_FreeHashTable(&i->assocData);
5523 /* Check that the live object list is empty, otherwise
5524 * there is a memory leak. */
5525 #ifdef JIM_MAINTAINER
5526 if (i->liveList != NULL) {
5527 objPtr = i->liveList;
5529 printf("\n-------------------------------------\n");
5530 printf("Objects still in the free list:\n");
5531 while (objPtr) {
5532 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5534 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5535 printf("%p (%d) %-10s: '%.20s...'\n",
5536 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5538 else {
5539 printf("%p (%d) %-10s: '%s'\n",
5540 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5542 if (objPtr->typePtr == &sourceObjType) {
5543 printf("FILE %s LINE %d\n",
5544 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5545 objPtr->internalRep.sourceValue.lineNumber);
5547 objPtr = objPtr->nextObjPtr;
5549 printf("-------------------------------------\n\n");
5550 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5552 #endif
5554 /* Free all the freed objects. */
5555 objPtr = i->freeList;
5556 while (objPtr) {
5557 nextObjPtr = objPtr->nextObjPtr;
5558 Jim_Free(objPtr);
5559 objPtr = nextObjPtr;
5562 /* Free the free call frames list */
5563 for (cf = i->freeFramesList; cf; cf = cfx) {
5564 cfx = cf->next;
5565 if (cf->vars.table)
5566 Jim_FreeHashTable(&cf->vars);
5567 Jim_Free(cf);
5570 /* Free the interpreter structure. */
5571 Jim_Free(i);
5574 /* Returns the call frame relative to the level represented by
5575 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5577 * This function accepts the 'level' argument in the form
5578 * of the commands [uplevel] and [upvar].
5580 * Returns NULL on error.
5582 * Note: for a function accepting a relative integer as level suitable
5583 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5585 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5587 long level;
5588 const char *str;
5589 Jim_CallFrame *framePtr;
5591 if (levelObjPtr) {
5592 str = Jim_String(levelObjPtr);
5593 if (str[0] == '#') {
5594 char *endptr;
5596 level = jim_strtol(str + 1, &endptr);
5597 if (str[1] == '\0' || endptr[0] != '\0') {
5598 level = -1;
5601 else {
5602 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5603 level = -1;
5605 else {
5606 /* Convert from a relative to an absolute level */
5607 level = interp->framePtr->level - level;
5611 else {
5612 str = "1"; /* Needed to format the error message. */
5613 level = interp->framePtr->level - 1;
5616 if (level == 0) {
5617 return interp->topFramePtr;
5619 if (level > 0) {
5620 /* Lookup */
5621 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5622 if (framePtr->level == level) {
5623 return framePtr;
5628 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5629 return NULL;
5632 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5633 * as a relative integer like in the [info level ?level?] command.
5635 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5637 long level;
5638 Jim_CallFrame *framePtr;
5640 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5641 if (level <= 0) {
5642 /* Convert from a relative to an absolute level */
5643 level = interp->framePtr->level + level;
5646 if (level == 0) {
5647 return interp->topFramePtr;
5650 /* Lookup */
5651 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5652 if (framePtr->level == level) {
5653 return framePtr;
5658 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5659 return NULL;
5662 static void JimResetStackTrace(Jim_Interp *interp)
5664 Jim_DecrRefCount(interp, interp->stackTrace);
5665 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5666 Jim_IncrRefCount(interp->stackTrace);
5669 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5671 int len;
5673 /* Increment reference first in case these are the same object */
5674 Jim_IncrRefCount(stackTraceObj);
5675 Jim_DecrRefCount(interp, interp->stackTrace);
5676 interp->stackTrace = stackTraceObj;
5677 interp->errorFlag = 1;
5679 /* This is a bit ugly.
5680 * If the filename of the last entry of the stack trace is empty,
5681 * the next stack level should be added.
5683 len = Jim_ListLength(interp, interp->stackTrace);
5684 if (len >= 3) {
5685 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5686 interp->addStackTrace = 1;
5691 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5692 Jim_Obj *fileNameObj, int linenr)
5694 if (strcmp(procname, "unknown") == 0) {
5695 procname = "";
5697 if (!*procname && !Jim_Length(fileNameObj)) {
5698 /* No useful info here */
5699 return;
5702 if (Jim_IsShared(interp->stackTrace)) {
5703 Jim_DecrRefCount(interp, interp->stackTrace);
5704 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5705 Jim_IncrRefCount(interp->stackTrace);
5708 /* If we have no procname but the previous element did, merge with that frame */
5709 if (!*procname && Jim_Length(fileNameObj)) {
5710 /* Just a filename. Check the previous entry */
5711 int len = Jim_ListLength(interp, interp->stackTrace);
5713 if (len >= 3) {
5714 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5715 if (Jim_Length(objPtr)) {
5716 /* Yes, the previous level had procname */
5717 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5718 if (Jim_Length(objPtr) == 0) {
5719 /* But no filename, so merge the new info with that frame */
5720 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5721 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5722 return;
5728 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5729 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5730 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5733 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5734 void *data)
5736 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5738 assocEntryPtr->delProc = delProc;
5739 assocEntryPtr->data = data;
5740 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5743 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5745 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5747 if (entryPtr != NULL) {
5748 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5749 return assocEntryPtr->data;
5751 return NULL;
5754 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5756 return Jim_DeleteHashEntry(&interp->assocData, key);
5759 int Jim_GetExitCode(Jim_Interp *interp)
5761 return interp->exitCode;
5764 /* -----------------------------------------------------------------------------
5765 * Integer object
5766 * ---------------------------------------------------------------------------*/
5767 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5768 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5770 static const Jim_ObjType intObjType = {
5771 "int",
5772 NULL,
5773 NULL,
5774 UpdateStringOfInt,
5775 JIM_TYPE_NONE,
5778 /* A coerced double is closer to an int than a double.
5779 * It is an int value temporarily masquerading as a double value.
5780 * i.e. it has the same string value as an int and Jim_GetWide()
5781 * succeeds, but also Jim_GetDouble() returns the value directly.
5783 static const Jim_ObjType coercedDoubleObjType = {
5784 "coerced-double",
5785 NULL,
5786 NULL,
5787 UpdateStringOfInt,
5788 JIM_TYPE_NONE,
5792 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5794 char buf[JIM_INTEGER_SPACE + 1];
5795 jim_wide wideValue = JimWideValue(objPtr);
5796 int pos = 0;
5798 if (wideValue == 0) {
5799 buf[pos++] = '0';
5801 else {
5802 char tmp[JIM_INTEGER_SPACE];
5803 int num = 0;
5804 int i;
5806 if (wideValue < 0) {
5807 buf[pos++] = '-';
5808 i = wideValue % 10;
5809 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5810 * whereas C99 is always -6
5811 * coverity[dead_error_line]
5813 tmp[num++] = (i > 0) ? (10 - i) : -i;
5814 wideValue /= -10;
5817 while (wideValue) {
5818 tmp[num++] = wideValue % 10;
5819 wideValue /= 10;
5822 for (i = 0; i < num; i++) {
5823 buf[pos++] = '0' + tmp[num - i - 1];
5826 buf[pos] = 0;
5828 JimSetStringBytes(objPtr, buf);
5831 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5833 jim_wide wideValue;
5834 const char *str;
5836 if (objPtr->typePtr == &coercedDoubleObjType) {
5837 /* Simple switch */
5838 objPtr->typePtr = &intObjType;
5839 return JIM_OK;
5842 /* Get the string representation */
5843 str = Jim_String(objPtr);
5844 /* Try to convert into a jim_wide */
5845 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5846 if (flags & JIM_ERRMSG) {
5847 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5849 return JIM_ERR;
5851 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5852 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5853 return JIM_ERR;
5855 /* Free the old internal repr and set the new one. */
5856 Jim_FreeIntRep(interp, objPtr);
5857 objPtr->typePtr = &intObjType;
5858 objPtr->internalRep.wideValue = wideValue;
5859 return JIM_OK;
5862 #ifdef JIM_OPTIMIZATION
5863 static int JimIsWide(Jim_Obj *objPtr)
5865 return objPtr->typePtr == &intObjType;
5867 #endif
5869 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5871 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5872 return JIM_ERR;
5873 *widePtr = JimWideValue(objPtr);
5874 return JIM_OK;
5877 /* Get a wide but does not set an error if the format is bad. */
5878 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5880 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5881 return JIM_ERR;
5882 *widePtr = JimWideValue(objPtr);
5883 return JIM_OK;
5886 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5888 jim_wide wideValue;
5889 int retval;
5891 retval = Jim_GetWide(interp, objPtr, &wideValue);
5892 if (retval == JIM_OK) {
5893 *longPtr = (long)wideValue;
5894 return JIM_OK;
5896 return JIM_ERR;
5899 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5901 Jim_Obj *objPtr;
5903 objPtr = Jim_NewObj(interp);
5904 objPtr->typePtr = &intObjType;
5905 objPtr->bytes = NULL;
5906 objPtr->internalRep.wideValue = wideValue;
5907 return objPtr;
5910 /* -----------------------------------------------------------------------------
5911 * Double object
5912 * ---------------------------------------------------------------------------*/
5913 #define JIM_DOUBLE_SPACE 30
5915 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5916 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5918 static const Jim_ObjType doubleObjType = {
5919 "double",
5920 NULL,
5921 NULL,
5922 UpdateStringOfDouble,
5923 JIM_TYPE_NONE,
5926 #ifndef HAVE_ISNAN
5927 #undef isnan
5928 #define isnan(X) ((X) != (X))
5929 #endif
5930 #ifndef HAVE_ISINF
5931 #undef isinf
5932 #define isinf(X) (1.0 / (X) == 0.0)
5933 #endif
5935 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5937 double value = objPtr->internalRep.doubleValue;
5939 if (isnan(value)) {
5940 JimSetStringBytes(objPtr, "NaN");
5941 return;
5943 if (isinf(value)) {
5944 if (value < 0) {
5945 JimSetStringBytes(objPtr, "-Inf");
5947 else {
5948 JimSetStringBytes(objPtr, "Inf");
5950 return;
5953 char buf[JIM_DOUBLE_SPACE + 1];
5954 int i;
5955 int len = sprintf(buf, "%.12g", value);
5957 /* Add a final ".0" if necessary */
5958 for (i = 0; i < len; i++) {
5959 if (buf[i] == '.' || buf[i] == 'e') {
5960 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5961 /* If 'buf' ends in e-0nn or e+0nn, remove
5962 * the 0 after the + or - and reduce the length by 1
5964 char *e = strchr(buf, 'e');
5965 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5966 /* Move it up */
5967 e += 2;
5968 memmove(e, e + 1, len - (e - buf));
5970 #endif
5971 break;
5974 if (buf[i] == '\0') {
5975 buf[i++] = '.';
5976 buf[i++] = '0';
5977 buf[i] = '\0';
5979 JimSetStringBytes(objPtr, buf);
5983 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5985 double doubleValue;
5986 jim_wide wideValue;
5987 const char *str;
5989 /* Preserve the string representation.
5990 * Needed so we can convert back to int without loss
5992 str = Jim_String(objPtr);
5994 #ifdef HAVE_LONG_LONG
5995 /* Assume a 53 bit mantissa */
5996 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5997 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5999 if (objPtr->typePtr == &intObjType
6000 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6001 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6003 /* Direct conversion to coerced double */
6004 objPtr->typePtr = &coercedDoubleObjType;
6005 return JIM_OK;
6007 else
6008 #endif
6009 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6010 /* Managed to convert to an int, so we can use this as a cooerced double */
6011 Jim_FreeIntRep(interp, objPtr);
6012 objPtr->typePtr = &coercedDoubleObjType;
6013 objPtr->internalRep.wideValue = wideValue;
6014 return JIM_OK;
6016 else {
6017 /* Try to convert into a double */
6018 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6019 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6020 return JIM_ERR;
6022 /* Free the old internal repr and set the new one. */
6023 Jim_FreeIntRep(interp, objPtr);
6025 objPtr->typePtr = &doubleObjType;
6026 objPtr->internalRep.doubleValue = doubleValue;
6027 return JIM_OK;
6030 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6032 if (objPtr->typePtr == &coercedDoubleObjType) {
6033 *doublePtr = JimWideValue(objPtr);
6034 return JIM_OK;
6036 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6037 return JIM_ERR;
6039 if (objPtr->typePtr == &coercedDoubleObjType) {
6040 *doublePtr = JimWideValue(objPtr);
6042 else {
6043 *doublePtr = objPtr->internalRep.doubleValue;
6045 return JIM_OK;
6048 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6050 Jim_Obj *objPtr;
6052 objPtr = Jim_NewObj(interp);
6053 objPtr->typePtr = &doubleObjType;
6054 objPtr->bytes = NULL;
6055 objPtr->internalRep.doubleValue = doubleValue;
6056 return objPtr;
6059 /* -----------------------------------------------------------------------------
6060 * List object
6061 * ---------------------------------------------------------------------------*/
6062 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6063 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6064 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6065 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6066 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6067 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6069 /* Note that while the elements of the list may contain references,
6070 * the list object itself can't. This basically means that the
6071 * list object string representation as a whole can't contain references
6072 * that are not presents in the single elements. */
6073 static const Jim_ObjType listObjType = {
6074 "list",
6075 FreeListInternalRep,
6076 DupListInternalRep,
6077 UpdateStringOfList,
6078 JIM_TYPE_NONE,
6081 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6083 int i;
6085 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6086 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6088 Jim_Free(objPtr->internalRep.listValue.ele);
6091 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6093 int i;
6095 JIM_NOTUSED(interp);
6097 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6098 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6099 dupPtr->internalRep.listValue.ele =
6100 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6101 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6102 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6103 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6104 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6106 dupPtr->typePtr = &listObjType;
6109 /* The following function checks if a given string can be encoded
6110 * into a list element without any kind of quoting, surrounded by braces,
6111 * or using escapes to quote. */
6112 #define JIM_ELESTR_SIMPLE 0
6113 #define JIM_ELESTR_BRACE 1
6114 #define JIM_ELESTR_QUOTE 2
6115 static unsigned char ListElementQuotingType(const char *s, int len)
6117 int i, level, blevel, trySimple = 1;
6119 /* Try with the SIMPLE case */
6120 if (len == 0)
6121 return JIM_ELESTR_BRACE;
6122 if (s[0] == '"' || s[0] == '{') {
6123 trySimple = 0;
6124 goto testbrace;
6126 for (i = 0; i < len; i++) {
6127 switch (s[i]) {
6128 case ' ':
6129 case '$':
6130 case '"':
6131 case '[':
6132 case ']':
6133 case ';':
6134 case '\\':
6135 case '\r':
6136 case '\n':
6137 case '\t':
6138 case '\f':
6139 case '\v':
6140 trySimple = 0;
6141 /* fall through */
6142 case '{':
6143 case '}':
6144 goto testbrace;
6147 return JIM_ELESTR_SIMPLE;
6149 testbrace:
6150 /* Test if it's possible to do with braces */
6151 if (s[len - 1] == '\\')
6152 return JIM_ELESTR_QUOTE;
6153 level = 0;
6154 blevel = 0;
6155 for (i = 0; i < len; i++) {
6156 switch (s[i]) {
6157 case '{':
6158 level++;
6159 break;
6160 case '}':
6161 level--;
6162 if (level < 0)
6163 return JIM_ELESTR_QUOTE;
6164 break;
6165 case '[':
6166 blevel++;
6167 break;
6168 case ']':
6169 blevel--;
6170 break;
6171 case '\\':
6172 if (s[i + 1] == '\n')
6173 return JIM_ELESTR_QUOTE;
6174 else if (s[i + 1] != '\0')
6175 i++;
6176 break;
6179 if (blevel < 0) {
6180 return JIM_ELESTR_QUOTE;
6183 if (level == 0) {
6184 if (!trySimple)
6185 return JIM_ELESTR_BRACE;
6186 for (i = 0; i < len; i++) {
6187 switch (s[i]) {
6188 case ' ':
6189 case '$':
6190 case '"':
6191 case '[':
6192 case ']':
6193 case ';':
6194 case '\\':
6195 case '\r':
6196 case '\n':
6197 case '\t':
6198 case '\f':
6199 case '\v':
6200 return JIM_ELESTR_BRACE;
6201 break;
6204 return JIM_ELESTR_SIMPLE;
6206 return JIM_ELESTR_QUOTE;
6209 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6210 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6211 * scenario.
6212 * Returns the length of the result.
6214 static int BackslashQuoteString(const char *s, int len, char *q)
6216 char *p = q;
6218 while (len--) {
6219 switch (*s) {
6220 case ' ':
6221 case '$':
6222 case '"':
6223 case '[':
6224 case ']':
6225 case '{':
6226 case '}':
6227 case ';':
6228 case '\\':
6229 *p++ = '\\';
6230 *p++ = *s++;
6231 break;
6232 case '\n':
6233 *p++ = '\\';
6234 *p++ = 'n';
6235 s++;
6236 break;
6237 case '\r':
6238 *p++ = '\\';
6239 *p++ = 'r';
6240 s++;
6241 break;
6242 case '\t':
6243 *p++ = '\\';
6244 *p++ = 't';
6245 s++;
6246 break;
6247 case '\f':
6248 *p++ = '\\';
6249 *p++ = 'f';
6250 s++;
6251 break;
6252 case '\v':
6253 *p++ = '\\';
6254 *p++ = 'v';
6255 s++;
6256 break;
6257 default:
6258 *p++ = *s++;
6259 break;
6262 *p = '\0';
6264 return p - q;
6267 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6269 #define STATIC_QUOTING_LEN 32
6270 int i, bufLen, realLength;
6271 const char *strRep;
6272 char *p;
6273 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6275 /* Estimate the space needed. */
6276 if (objc > STATIC_QUOTING_LEN) {
6277 quotingType = Jim_Alloc(objc);
6279 else {
6280 quotingType = staticQuoting;
6282 bufLen = 0;
6283 for (i = 0; i < objc; i++) {
6284 int len;
6286 strRep = Jim_GetString(objv[i], &len);
6287 quotingType[i] = ListElementQuotingType(strRep, len);
6288 switch (quotingType[i]) {
6289 case JIM_ELESTR_SIMPLE:
6290 if (i != 0 || strRep[0] != '#') {
6291 bufLen += len;
6292 break;
6294 /* Special case '#' on first element needs braces */
6295 quotingType[i] = JIM_ELESTR_BRACE;
6296 /* fall through */
6297 case JIM_ELESTR_BRACE:
6298 bufLen += len + 2;
6299 break;
6300 case JIM_ELESTR_QUOTE:
6301 bufLen += len * 2;
6302 break;
6304 bufLen++; /* elements separator. */
6306 bufLen++;
6308 /* Generate the string rep. */
6309 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6310 realLength = 0;
6311 for (i = 0; i < objc; i++) {
6312 int len, qlen;
6314 strRep = Jim_GetString(objv[i], &len);
6316 switch (quotingType[i]) {
6317 case JIM_ELESTR_SIMPLE:
6318 memcpy(p, strRep, len);
6319 p += len;
6320 realLength += len;
6321 break;
6322 case JIM_ELESTR_BRACE:
6323 *p++ = '{';
6324 memcpy(p, strRep, len);
6325 p += len;
6326 *p++ = '}';
6327 realLength += len + 2;
6328 break;
6329 case JIM_ELESTR_QUOTE:
6330 if (i == 0 && strRep[0] == '#') {
6331 *p++ = '\\';
6332 realLength++;
6334 qlen = BackslashQuoteString(strRep, len, p);
6335 p += qlen;
6336 realLength += qlen;
6337 break;
6339 /* Add a separating space */
6340 if (i + 1 != objc) {
6341 *p++ = ' ';
6342 realLength++;
6345 *p = '\0'; /* nul term. */
6346 objPtr->length = realLength;
6348 if (quotingType != staticQuoting) {
6349 Jim_Free(quotingType);
6353 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6355 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6358 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6360 struct JimParserCtx parser;
6361 const char *str;
6362 int strLen;
6363 Jim_Obj *fileNameObj;
6364 int linenr;
6366 if (objPtr->typePtr == &listObjType) {
6367 return JIM_OK;
6370 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6371 * it also preserves any source location of the dict elements
6372 * which can be very useful
6374 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6375 Jim_Obj **listObjPtrPtr;
6376 int len;
6377 int i;
6379 listObjPtrPtr = JimDictPairs(objPtr, &len);
6380 for (i = 0; i < len; i++) {
6381 Jim_IncrRefCount(listObjPtrPtr[i]);
6384 /* Now just switch the internal rep */
6385 Jim_FreeIntRep(interp, objPtr);
6386 objPtr->typePtr = &listObjType;
6387 objPtr->internalRep.listValue.len = len;
6388 objPtr->internalRep.listValue.maxLen = len;
6389 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6391 return JIM_OK;
6394 /* Try to preserve information about filename / line number */
6395 if (objPtr->typePtr == &sourceObjType) {
6396 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6397 linenr = objPtr->internalRep.sourceValue.lineNumber;
6399 else {
6400 fileNameObj = interp->emptyObj;
6401 linenr = 1;
6403 Jim_IncrRefCount(fileNameObj);
6405 /* Get the string representation */
6406 str = Jim_GetString(objPtr, &strLen);
6408 /* Free the old internal repr just now and initialize the
6409 * new one just now. The string->list conversion can't fail. */
6410 Jim_FreeIntRep(interp, objPtr);
6411 objPtr->typePtr = &listObjType;
6412 objPtr->internalRep.listValue.len = 0;
6413 objPtr->internalRep.listValue.maxLen = 0;
6414 objPtr->internalRep.listValue.ele = NULL;
6416 /* Convert into a list */
6417 if (strLen) {
6418 JimParserInit(&parser, str, strLen, linenr);
6419 while (!parser.eof) {
6420 Jim_Obj *elementPtr;
6422 JimParseList(&parser);
6423 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6424 continue;
6425 elementPtr = JimParserGetTokenObj(interp, &parser);
6426 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6427 ListAppendElement(objPtr, elementPtr);
6430 Jim_DecrRefCount(interp, fileNameObj);
6431 return JIM_OK;
6434 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6436 Jim_Obj *objPtr;
6438 objPtr = Jim_NewObj(interp);
6439 objPtr->typePtr = &listObjType;
6440 objPtr->bytes = NULL;
6441 objPtr->internalRep.listValue.ele = NULL;
6442 objPtr->internalRep.listValue.len = 0;
6443 objPtr->internalRep.listValue.maxLen = 0;
6445 if (len) {
6446 ListInsertElements(objPtr, 0, len, elements);
6449 return objPtr;
6452 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6453 * length of the vector. Note that the user of this function should make
6454 * sure that the list object can't shimmer while the vector returned
6455 * is in use, this vector is the one stored inside the internal representation
6456 * of the list object. This function is not exported, extensions should
6457 * always access to the List object elements using Jim_ListIndex(). */
6458 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6459 Jim_Obj ***listVec)
6461 *listLen = Jim_ListLength(interp, listObj);
6462 *listVec = listObj->internalRep.listValue.ele;
6465 /* Sorting uses ints, but commands may return wide */
6466 static int JimSign(jim_wide w)
6468 if (w == 0) {
6469 return 0;
6471 else if (w < 0) {
6472 return -1;
6474 return 1;
6477 /* ListSortElements type values */
6478 struct lsort_info {
6479 jmp_buf jmpbuf;
6480 Jim_Obj *command;
6481 Jim_Interp *interp;
6482 enum {
6483 JIM_LSORT_ASCII,
6484 JIM_LSORT_NOCASE,
6485 JIM_LSORT_INTEGER,
6486 JIM_LSORT_REAL,
6487 JIM_LSORT_COMMAND
6488 } type;
6489 int order;
6490 int index;
6491 int indexed;
6492 int unique;
6493 int (*subfn)(Jim_Obj **, Jim_Obj **);
6496 static struct lsort_info *sort_info;
6498 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6500 Jim_Obj *lObj, *rObj;
6502 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6503 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6504 longjmp(sort_info->jmpbuf, JIM_ERR);
6506 return sort_info->subfn(&lObj, &rObj);
6509 /* Sort the internal rep of a list. */
6510 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6512 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6515 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6517 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6520 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6522 jim_wide lhs = 0, rhs = 0;
6524 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6525 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6526 longjmp(sort_info->jmpbuf, JIM_ERR);
6529 return JimSign(lhs - rhs) * sort_info->order;
6532 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6534 double lhs = 0, rhs = 0;
6536 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6537 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6538 longjmp(sort_info->jmpbuf, JIM_ERR);
6540 if (lhs == rhs) {
6541 return 0;
6543 if (lhs > rhs) {
6544 return sort_info->order;
6546 return -sort_info->order;
6549 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6551 Jim_Obj *compare_script;
6552 int rc;
6554 jim_wide ret = 0;
6556 /* This must be a valid list */
6557 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6558 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6559 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6561 rc = Jim_EvalObj(sort_info->interp, compare_script);
6563 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6564 longjmp(sort_info->jmpbuf, rc);
6567 return JimSign(ret) * sort_info->order;
6570 /* Remove duplicate elements from the (sorted) list in-place, according to the
6571 * comparison function, comp.
6573 * Note that the last unique value is kept, not the first
6575 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6577 int src;
6578 int dst = 0;
6579 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6581 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6582 if (comp(&ele[dst], &ele[src]) == 0) {
6583 /* Match, so replace the dest with the current source */
6584 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6586 else {
6587 /* No match, so keep the current source and move to the next destination */
6588 dst++;
6590 ele[dst] = ele[src];
6592 /* At end of list, keep the final element */
6593 ele[++dst] = ele[src];
6595 /* Set the new length */
6596 listObjPtr->internalRep.listValue.len = dst;
6599 /* Sort a list *in place*. MUST be called with a non-shared list. */
6600 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6602 struct lsort_info *prev_info;
6604 typedef int (qsort_comparator) (const void *, const void *);
6605 int (*fn) (Jim_Obj **, Jim_Obj **);
6606 Jim_Obj **vector;
6607 int len;
6608 int rc;
6610 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6611 SetListFromAny(interp, listObjPtr);
6613 /* Allow lsort to be called reentrantly */
6614 prev_info = sort_info;
6615 sort_info = info;
6617 vector = listObjPtr->internalRep.listValue.ele;
6618 len = listObjPtr->internalRep.listValue.len;
6619 switch (info->type) {
6620 case JIM_LSORT_ASCII:
6621 fn = ListSortString;
6622 break;
6623 case JIM_LSORT_NOCASE:
6624 fn = ListSortStringNoCase;
6625 break;
6626 case JIM_LSORT_INTEGER:
6627 fn = ListSortInteger;
6628 break;
6629 case JIM_LSORT_REAL:
6630 fn = ListSortReal;
6631 break;
6632 case JIM_LSORT_COMMAND:
6633 fn = ListSortCommand;
6634 break;
6635 default:
6636 fn = NULL; /* avoid warning */
6637 JimPanic((1, "ListSort called with invalid sort type"));
6640 if (info->indexed) {
6641 /* Need to interpose a "list index" function */
6642 info->subfn = fn;
6643 fn = ListSortIndexHelper;
6646 if ((rc = setjmp(info->jmpbuf)) == 0) {
6647 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6649 if (info->unique && len > 1) {
6650 ListRemoveDuplicates(listObjPtr, fn);
6653 Jim_InvalidateStringRep(listObjPtr);
6655 sort_info = prev_info;
6657 return rc;
6660 /* This is the low-level function to insert elements into a list.
6661 * The higher-level Jim_ListInsertElements() performs shared object
6662 * check and invalidates the string repr. This version is used
6663 * in the internals of the List Object and is not exported.
6665 * NOTE: this function can be called only against objects
6666 * with internal type of List.
6668 * An insertion point (idx) of -1 means end-of-list.
6670 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6672 int currentLen = listPtr->internalRep.listValue.len;
6673 int requiredLen = currentLen + elemc;
6674 int i;
6675 Jim_Obj **point;
6677 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6678 if (requiredLen < 2) {
6679 /* Don't do allocations of under 4 pointers. */
6680 requiredLen = 4;
6682 else {
6683 requiredLen *= 2;
6686 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6687 sizeof(Jim_Obj *) * requiredLen);
6689 listPtr->internalRep.listValue.maxLen = requiredLen;
6691 if (idx < 0) {
6692 idx = currentLen;
6694 point = listPtr->internalRep.listValue.ele + idx;
6695 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6696 for (i = 0; i < elemc; ++i) {
6697 point[i] = elemVec[i];
6698 Jim_IncrRefCount(point[i]);
6700 listPtr->internalRep.listValue.len += elemc;
6703 /* Convenience call to ListInsertElements() to append a single element.
6705 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6707 ListInsertElements(listPtr, -1, 1, &objPtr);
6710 /* Appends every element of appendListPtr into listPtr.
6711 * Both have to be of the list type.
6712 * Convenience call to ListInsertElements()
6714 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6716 ListInsertElements(listPtr, -1,
6717 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6720 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6722 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6723 SetListFromAny(interp, listPtr);
6724 Jim_InvalidateStringRep(listPtr);
6725 ListAppendElement(listPtr, objPtr);
6728 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6730 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6731 SetListFromAny(interp, listPtr);
6732 SetListFromAny(interp, appendListPtr);
6733 Jim_InvalidateStringRep(listPtr);
6734 ListAppendList(listPtr, appendListPtr);
6737 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6739 SetListFromAny(interp, objPtr);
6740 return objPtr->internalRep.listValue.len;
6743 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6744 int objc, Jim_Obj *const *objVec)
6746 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6747 SetListFromAny(interp, listPtr);
6748 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6749 idx = listPtr->internalRep.listValue.len;
6750 else if (idx < 0)
6751 idx = 0;
6752 Jim_InvalidateStringRep(listPtr);
6753 ListInsertElements(listPtr, idx, objc, objVec);
6756 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6758 SetListFromAny(interp, listPtr);
6759 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6760 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6761 return NULL;
6763 if (idx < 0)
6764 idx = listPtr->internalRep.listValue.len + idx;
6765 return listPtr->internalRep.listValue.ele[idx];
6768 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6770 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6771 if (*objPtrPtr == NULL) {
6772 if (flags & JIM_ERRMSG) {
6773 Jim_SetResultString(interp, "list index out of range", -1);
6775 return JIM_ERR;
6777 return JIM_OK;
6780 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6781 Jim_Obj *newObjPtr, int flags)
6783 SetListFromAny(interp, listPtr);
6784 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6785 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6786 if (flags & JIM_ERRMSG) {
6787 Jim_SetResultString(interp, "list index out of range", -1);
6789 return JIM_ERR;
6791 if (idx < 0)
6792 idx = listPtr->internalRep.listValue.len + idx;
6793 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6794 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6795 Jim_IncrRefCount(newObjPtr);
6796 return JIM_OK;
6799 /* Modify the list stored in the variable named 'varNamePtr'
6800 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6801 * with the new element 'newObjptr'. (implements the [lset] command) */
6802 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6803 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6805 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6806 int shared, i, idx;
6808 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6809 if (objPtr == NULL)
6810 return JIM_ERR;
6811 if ((shared = Jim_IsShared(objPtr)))
6812 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6813 for (i = 0; i < indexc - 1; i++) {
6814 listObjPtr = objPtr;
6815 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6816 goto err;
6817 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6818 goto err;
6820 if (Jim_IsShared(objPtr)) {
6821 objPtr = Jim_DuplicateObj(interp, objPtr);
6822 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6824 Jim_InvalidateStringRep(listObjPtr);
6826 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6827 goto err;
6828 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6829 goto err;
6830 Jim_InvalidateStringRep(objPtr);
6831 Jim_InvalidateStringRep(varObjPtr);
6832 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6833 goto err;
6834 Jim_SetResult(interp, varObjPtr);
6835 return JIM_OK;
6836 err:
6837 if (shared) {
6838 Jim_FreeNewObj(interp, varObjPtr);
6840 return JIM_ERR;
6843 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6845 int i;
6846 int listLen = Jim_ListLength(interp, listObjPtr);
6847 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6849 for (i = 0; i < listLen; ) {
6850 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6851 if (++i != listLen) {
6852 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6855 return resObjPtr;
6858 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6860 int i;
6862 /* If all the objects in objv are lists,
6863 * it's possible to return a list as result, that's the
6864 * concatenation of all the lists. */
6865 for (i = 0; i < objc; i++) {
6866 if (!Jim_IsList(objv[i]))
6867 break;
6869 if (i == objc) {
6870 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6872 for (i = 0; i < objc; i++)
6873 ListAppendList(objPtr, objv[i]);
6874 return objPtr;
6876 else {
6877 /* Else... we have to glue strings together */
6878 int len = 0, objLen;
6879 char *bytes, *p;
6881 /* Compute the length */
6882 for (i = 0; i < objc; i++) {
6883 len += Jim_Length(objv[i]);
6885 if (objc)
6886 len += objc - 1;
6887 /* Create the string rep, and a string object holding it. */
6888 p = bytes = Jim_Alloc(len + 1);
6889 for (i = 0; i < objc; i++) {
6890 const char *s = Jim_GetString(objv[i], &objLen);
6892 /* Remove leading space */
6893 while (objLen && isspace(UCHAR(*s))) {
6894 s++;
6895 objLen--;
6896 len--;
6898 /* And trailing space */
6899 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6900 /* Handle trailing backslash-space case */
6901 if (objLen > 1 && s[objLen - 2] == '\\') {
6902 break;
6904 objLen--;
6905 len--;
6907 memcpy(p, s, objLen);
6908 p += objLen;
6909 if (i + 1 != objc) {
6910 if (objLen)
6911 *p++ = ' ';
6912 else {
6913 /* Drop the space calculated for this
6914 * element that is instead null. */
6915 len--;
6919 *p = '\0';
6920 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6924 /* Returns a list composed of the elements in the specified range.
6925 * first and start are directly accepted as Jim_Objects and
6926 * processed for the end?-index? case. */
6927 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6928 Jim_Obj *lastObjPtr)
6930 int first, last;
6931 int len, rangeLen;
6933 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6934 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6935 return NULL;
6936 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6937 first = JimRelToAbsIndex(len, first);
6938 last = JimRelToAbsIndex(len, last);
6939 JimRelToAbsRange(len, &first, &last, &rangeLen);
6940 if (first == 0 && last == len) {
6941 return listObjPtr;
6943 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6946 /* -----------------------------------------------------------------------------
6947 * Dict object
6948 * ---------------------------------------------------------------------------*/
6949 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6950 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6951 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6952 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6954 /* Dict HashTable Type.
6956 * Keys and Values are Jim objects. */
6958 static unsigned int JimObjectHTHashFunction(const void *key)
6960 int len;
6961 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6962 return Jim_GenHashFunction((const unsigned char *)str, len);
6965 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6967 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6970 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6972 Jim_IncrRefCount((Jim_Obj *)val);
6973 return (void *)val;
6976 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6978 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6981 static const Jim_HashTableType JimDictHashTableType = {
6982 JimObjectHTHashFunction, /* hash function */
6983 JimObjectHTKeyValDup, /* key dup */
6984 JimObjectHTKeyValDup, /* val dup */
6985 JimObjectHTKeyCompare, /* key compare */
6986 JimObjectHTKeyValDestructor, /* key destructor */
6987 JimObjectHTKeyValDestructor /* val destructor */
6990 /* Note that while the elements of the dict may contain references,
6991 * the list object itself can't. This basically means that the
6992 * dict object string representation as a whole can't contain references
6993 * that are not presents in the single elements. */
6994 static const Jim_ObjType dictObjType = {
6995 "dict",
6996 FreeDictInternalRep,
6997 DupDictInternalRep,
6998 UpdateStringOfDict,
6999 JIM_TYPE_NONE,
7002 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7004 JIM_NOTUSED(interp);
7006 Jim_FreeHashTable(objPtr->internalRep.ptr);
7007 Jim_Free(objPtr->internalRep.ptr);
7010 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7012 Jim_HashTable *ht, *dupHt;
7013 Jim_HashTableIterator htiter;
7014 Jim_HashEntry *he;
7016 /* Create a new hash table */
7017 ht = srcPtr->internalRep.ptr;
7018 dupHt = Jim_Alloc(sizeof(*dupHt));
7019 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7020 if (ht->size != 0)
7021 Jim_ExpandHashTable(dupHt, ht->size);
7022 /* Copy every element from the source to the dup hash table */
7023 JimInitHashTableIterator(ht, &htiter);
7024 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7025 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7028 dupPtr->internalRep.ptr = dupHt;
7029 dupPtr->typePtr = &dictObjType;
7032 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7034 Jim_HashTable *ht;
7035 Jim_HashTableIterator htiter;
7036 Jim_HashEntry *he;
7037 Jim_Obj **objv;
7038 int i;
7040 ht = dictPtr->internalRep.ptr;
7042 /* Turn the hash table into a flat vector of Jim_Objects. */
7043 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7044 JimInitHashTableIterator(ht, &htiter);
7045 i = 0;
7046 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7047 objv[i++] = Jim_GetHashEntryKey(he);
7048 objv[i++] = Jim_GetHashEntryVal(he);
7050 *len = i;
7051 return objv;
7054 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7056 /* Turn the hash table into a flat vector of Jim_Objects. */
7057 int len;
7058 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7060 /* And now generate the string rep as a list */
7061 JimMakeListStringRep(objPtr, objv, len);
7063 Jim_Free(objv);
7066 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7068 int listlen;
7070 if (objPtr->typePtr == &dictObjType) {
7071 return JIM_OK;
7074 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7075 /* A shared list, so get the string representation now to avoid
7076 * changing the order in case of fast conversion to dict.
7078 Jim_String(objPtr);
7081 /* For simplicity, convert a non-list object to a list and then to a dict */
7082 listlen = Jim_ListLength(interp, objPtr);
7083 if (listlen % 2) {
7084 Jim_SetResultString(interp, "missing value to go with key", -1);
7085 return JIM_ERR;
7087 else {
7088 /* Converting from a list to a dict can't fail */
7089 Jim_HashTable *ht;
7090 int i;
7092 ht = Jim_Alloc(sizeof(*ht));
7093 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7095 for (i = 0; i < listlen; i += 2) {
7096 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7097 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7099 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7102 Jim_FreeIntRep(interp, objPtr);
7103 objPtr->typePtr = &dictObjType;
7104 objPtr->internalRep.ptr = ht;
7106 return JIM_OK;
7110 /* Dict object API */
7112 /* Add an element to a dict. objPtr must be of the "dict" type.
7113 * The higher-level exported function is Jim_DictAddElement().
7114 * If an element with the specified key already exists, the value
7115 * associated is replaced with the new one.
7117 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7118 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7119 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7121 Jim_HashTable *ht = objPtr->internalRep.ptr;
7123 if (valueObjPtr == NULL) { /* unset */
7124 return Jim_DeleteHashEntry(ht, keyObjPtr);
7126 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7127 return JIM_OK;
7130 /* Add an element, higher-level interface for DictAddElement().
7131 * If valueObjPtr == NULL, the key is removed if it exists. */
7132 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7133 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7135 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7136 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7137 return JIM_ERR;
7139 Jim_InvalidateStringRep(objPtr);
7140 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7143 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7145 Jim_Obj *objPtr;
7146 int i;
7148 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7150 objPtr = Jim_NewObj(interp);
7151 objPtr->typePtr = &dictObjType;
7152 objPtr->bytes = NULL;
7153 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7154 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7155 for (i = 0; i < len; i += 2)
7156 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7157 return objPtr;
7160 /* Return the value associated to the specified dict key
7161 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7163 * Sets *objPtrPtr to non-NULL only upon success.
7165 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7166 Jim_Obj **objPtrPtr, int flags)
7168 Jim_HashEntry *he;
7169 Jim_HashTable *ht;
7171 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7172 return -1;
7174 ht = dictPtr->internalRep.ptr;
7175 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7176 if (flags & JIM_ERRMSG) {
7177 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7179 return JIM_ERR;
7181 *objPtrPtr = he->u.val;
7182 return JIM_OK;
7185 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7186 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7188 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7189 return JIM_ERR;
7191 *objPtrPtr = JimDictPairs(dictPtr, len);
7193 return JIM_OK;
7197 /* Return the value associated to the specified dict keys */
7198 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7199 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7201 int i;
7203 if (keyc == 0) {
7204 *objPtrPtr = dictPtr;
7205 return JIM_OK;
7208 for (i = 0; i < keyc; i++) {
7209 Jim_Obj *objPtr;
7211 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7212 if (rc != JIM_OK) {
7213 return rc;
7215 dictPtr = objPtr;
7217 *objPtrPtr = dictPtr;
7218 return JIM_OK;
7221 /* Modify the dict stored into the variable named 'varNamePtr'
7222 * setting the element specified by the 'keyc' keys objects in 'keyv',
7223 * with the new value of the element 'newObjPtr'.
7225 * If newObjPtr == NULL the operation is to remove the given key
7226 * from the dictionary.
7228 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7229 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7231 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7232 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7234 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7235 int shared, i;
7237 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7238 if (objPtr == NULL) {
7239 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7240 /* Cannot remove a key from non existing var */
7241 return JIM_ERR;
7243 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7244 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7245 Jim_FreeNewObj(interp, varObjPtr);
7246 return JIM_ERR;
7249 if ((shared = Jim_IsShared(objPtr)))
7250 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7251 for (i = 0; i < keyc; i++) {
7252 dictObjPtr = objPtr;
7254 /* Check if it's a valid dictionary */
7255 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7256 goto err;
7259 if (i == keyc - 1) {
7260 /* Last key: Note that error on unset with missing last key is OK */
7261 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7262 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7263 goto err;
7266 break;
7269 /* Check if the given key exists. */
7270 Jim_InvalidateStringRep(dictObjPtr);
7271 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7272 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7273 /* This key exists at the current level.
7274 * Make sure it's not shared!. */
7275 if (Jim_IsShared(objPtr)) {
7276 objPtr = Jim_DuplicateObj(interp, objPtr);
7277 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7280 else {
7281 /* Key not found. If it's an [unset] operation
7282 * this is an error. Only the last key may not
7283 * exist. */
7284 if (newObjPtr == NULL) {
7285 goto err;
7287 /* Otherwise set an empty dictionary
7288 * as key's value. */
7289 objPtr = Jim_NewDictObj(interp, NULL, 0);
7290 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7293 /* XXX: Is this necessary? */
7294 Jim_InvalidateStringRep(objPtr);
7295 Jim_InvalidateStringRep(varObjPtr);
7296 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7297 goto err;
7299 Jim_SetResult(interp, varObjPtr);
7300 return JIM_OK;
7301 err:
7302 if (shared) {
7303 Jim_FreeNewObj(interp, varObjPtr);
7305 return JIM_ERR;
7308 /* -----------------------------------------------------------------------------
7309 * Index object
7310 * ---------------------------------------------------------------------------*/
7311 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7312 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7314 static const Jim_ObjType indexObjType = {
7315 "index",
7316 NULL,
7317 NULL,
7318 UpdateStringOfIndex,
7319 JIM_TYPE_NONE,
7322 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7324 if (objPtr->internalRep.intValue == -1) {
7325 JimSetStringBytes(objPtr, "end");
7327 else {
7328 char buf[JIM_INTEGER_SPACE + 1];
7329 if (objPtr->internalRep.intValue >= 0) {
7330 sprintf(buf, "%d", objPtr->internalRep.intValue);
7332 else {
7333 /* Must be <= -2 */
7334 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7336 JimSetStringBytes(objPtr, buf);
7340 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7342 int idx, end = 0;
7343 const char *str;
7344 char *endptr;
7346 /* Get the string representation */
7347 str = Jim_String(objPtr);
7349 /* Try to convert into an index */
7350 if (strncmp(str, "end", 3) == 0) {
7351 end = 1;
7352 str += 3;
7353 idx = 0;
7355 else {
7356 idx = jim_strtol(str, &endptr);
7358 if (endptr == str) {
7359 goto badindex;
7361 str = endptr;
7364 /* Now str may include or +<num> or -<num> */
7365 if (*str == '+' || *str == '-') {
7366 int sign = (*str == '+' ? 1 : -1);
7368 idx += sign * jim_strtol(++str, &endptr);
7369 if (str == endptr || *endptr) {
7370 goto badindex;
7372 str = endptr;
7374 /* The only thing left should be spaces */
7375 while (isspace(UCHAR(*str))) {
7376 str++;
7378 if (*str) {
7379 goto badindex;
7381 if (end) {
7382 if (idx > 0) {
7383 idx = INT_MAX;
7385 else {
7386 /* end-1 is repesented as -2 */
7387 idx--;
7390 else if (idx < 0) {
7391 idx = -INT_MAX;
7394 /* Free the old internal repr and set the new one. */
7395 Jim_FreeIntRep(interp, objPtr);
7396 objPtr->typePtr = &indexObjType;
7397 objPtr->internalRep.intValue = idx;
7398 return JIM_OK;
7400 badindex:
7401 Jim_SetResultFormatted(interp,
7402 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7403 return JIM_ERR;
7406 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7408 /* Avoid shimmering if the object is an integer. */
7409 if (objPtr->typePtr == &intObjType) {
7410 jim_wide val = JimWideValue(objPtr);
7412 if (val < 0)
7413 *indexPtr = -INT_MAX;
7414 else if (val > INT_MAX)
7415 *indexPtr = INT_MAX;
7416 else
7417 *indexPtr = (int)val;
7418 return JIM_OK;
7420 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7421 return JIM_ERR;
7422 *indexPtr = objPtr->internalRep.intValue;
7423 return JIM_OK;
7426 /* -----------------------------------------------------------------------------
7427 * Return Code Object.
7428 * ---------------------------------------------------------------------------*/
7430 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7431 static const char * const jimReturnCodes[] = {
7432 "ok",
7433 "error",
7434 "return",
7435 "break",
7436 "continue",
7437 "signal",
7438 "exit",
7439 "eval",
7440 NULL
7443 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7445 static const Jim_ObjType returnCodeObjType = {
7446 "return-code",
7447 NULL,
7448 NULL,
7449 NULL,
7450 JIM_TYPE_NONE,
7453 /* Converts a (standard) return code to a string. Returns "?" for
7454 * non-standard return codes.
7456 const char *Jim_ReturnCode(int code)
7458 if (code < 0 || code >= (int)jimReturnCodesSize) {
7459 return "?";
7461 else {
7462 return jimReturnCodes[code];
7466 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7468 int returnCode;
7469 jim_wide wideValue;
7471 /* Try to convert into an integer */
7472 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7473 returnCode = (int)wideValue;
7474 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7475 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7476 return JIM_ERR;
7478 /* Free the old internal repr and set the new one. */
7479 Jim_FreeIntRep(interp, objPtr);
7480 objPtr->typePtr = &returnCodeObjType;
7481 objPtr->internalRep.intValue = returnCode;
7482 return JIM_OK;
7485 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7487 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7488 return JIM_ERR;
7489 *intPtr = objPtr->internalRep.intValue;
7490 return JIM_OK;
7493 /* -----------------------------------------------------------------------------
7494 * Expression Parsing
7495 * ---------------------------------------------------------------------------*/
7496 static int JimParseExprOperator(struct JimParserCtx *pc);
7497 static int JimParseExprNumber(struct JimParserCtx *pc);
7498 static int JimParseExprIrrational(struct JimParserCtx *pc);
7500 /* Exrp's Stack machine operators opcodes. */
7502 /* Binary operators (numbers) */
7503 enum
7505 /* Continues on from the JIM_TT_ space */
7506 /* Operations */
7507 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7508 JIM_EXPROP_DIV,
7509 JIM_EXPROP_MOD,
7510 JIM_EXPROP_SUB,
7511 JIM_EXPROP_ADD,
7512 JIM_EXPROP_LSHIFT,
7513 JIM_EXPROP_RSHIFT,
7514 JIM_EXPROP_ROTL,
7515 JIM_EXPROP_ROTR,
7516 JIM_EXPROP_LT,
7517 JIM_EXPROP_GT,
7518 JIM_EXPROP_LTE,
7519 JIM_EXPROP_GTE,
7520 JIM_EXPROP_NUMEQ,
7521 JIM_EXPROP_NUMNE,
7522 JIM_EXPROP_BITAND, /* 35 */
7523 JIM_EXPROP_BITXOR,
7524 JIM_EXPROP_BITOR,
7526 /* Note must keep these together */
7527 JIM_EXPROP_LOGICAND, /* 38 */
7528 JIM_EXPROP_LOGICAND_LEFT,
7529 JIM_EXPROP_LOGICAND_RIGHT,
7531 /* and these */
7532 JIM_EXPROP_LOGICOR, /* 41 */
7533 JIM_EXPROP_LOGICOR_LEFT,
7534 JIM_EXPROP_LOGICOR_RIGHT,
7536 /* and these */
7537 /* Ternary operators */
7538 JIM_EXPROP_TERNARY, /* 44 */
7539 JIM_EXPROP_TERNARY_LEFT,
7540 JIM_EXPROP_TERNARY_RIGHT,
7542 /* and these */
7543 JIM_EXPROP_COLON, /* 47 */
7544 JIM_EXPROP_COLON_LEFT,
7545 JIM_EXPROP_COLON_RIGHT,
7547 JIM_EXPROP_POW, /* 50 */
7549 /* Binary operators (strings) */
7550 JIM_EXPROP_STREQ, /* 51 */
7551 JIM_EXPROP_STRNE,
7552 JIM_EXPROP_STRIN,
7553 JIM_EXPROP_STRNI,
7555 /* Unary operators (numbers) */
7556 JIM_EXPROP_NOT, /* 55 */
7557 JIM_EXPROP_BITNOT,
7558 JIM_EXPROP_UNARYMINUS,
7559 JIM_EXPROP_UNARYPLUS,
7561 /* Functions */
7562 JIM_EXPROP_FUNC_FIRST, /* 59 */
7563 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7564 JIM_EXPROP_FUNC_WIDE,
7565 JIM_EXPROP_FUNC_ABS,
7566 JIM_EXPROP_FUNC_DOUBLE,
7567 JIM_EXPROP_FUNC_ROUND,
7568 JIM_EXPROP_FUNC_RAND,
7569 JIM_EXPROP_FUNC_SRAND,
7571 /* math functions from libm */
7572 JIM_EXPROP_FUNC_SIN, /* 65 */
7573 JIM_EXPROP_FUNC_COS,
7574 JIM_EXPROP_FUNC_TAN,
7575 JIM_EXPROP_FUNC_ASIN,
7576 JIM_EXPROP_FUNC_ACOS,
7577 JIM_EXPROP_FUNC_ATAN,
7578 JIM_EXPROP_FUNC_SINH,
7579 JIM_EXPROP_FUNC_COSH,
7580 JIM_EXPROP_FUNC_TANH,
7581 JIM_EXPROP_FUNC_CEIL,
7582 JIM_EXPROP_FUNC_FLOOR,
7583 JIM_EXPROP_FUNC_EXP,
7584 JIM_EXPROP_FUNC_LOG,
7585 JIM_EXPROP_FUNC_LOG10,
7586 JIM_EXPROP_FUNC_SQRT,
7587 JIM_EXPROP_FUNC_POW,
7590 struct JimExprState
7592 Jim_Obj **stack;
7593 int stacklen;
7594 int opcode;
7595 int skip;
7598 /* Operators table */
7599 typedef struct Jim_ExprOperator
7601 const char *name;
7602 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7603 unsigned char precedence;
7604 unsigned char arity;
7605 unsigned char lazy;
7606 unsigned char namelen;
7607 } Jim_ExprOperator;
7609 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7611 Jim_IncrRefCount(obj);
7612 e->stack[e->stacklen++] = obj;
7615 static Jim_Obj *ExprPop(struct JimExprState *e)
7617 return e->stack[--e->stacklen];
7620 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7622 int intresult = 1;
7623 int rc = JIM_OK;
7624 Jim_Obj *A = ExprPop(e);
7625 double dA, dC = 0;
7626 jim_wide wA, wC = 0;
7628 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7629 switch (e->opcode) {
7630 case JIM_EXPROP_FUNC_INT:
7631 case JIM_EXPROP_FUNC_WIDE:
7632 case JIM_EXPROP_FUNC_ROUND:
7633 case JIM_EXPROP_UNARYPLUS:
7634 wC = wA;
7635 break;
7636 case JIM_EXPROP_FUNC_DOUBLE:
7637 dC = wA;
7638 intresult = 0;
7639 break;
7640 case JIM_EXPROP_FUNC_ABS:
7641 wC = wA >= 0 ? wA : -wA;
7642 break;
7643 case JIM_EXPROP_UNARYMINUS:
7644 wC = -wA;
7645 break;
7646 case JIM_EXPROP_NOT:
7647 wC = !wA;
7648 break;
7649 default:
7650 abort();
7653 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7654 switch (e->opcode) {
7655 case JIM_EXPROP_FUNC_INT:
7656 case JIM_EXPROP_FUNC_WIDE:
7657 wC = dA;
7658 break;
7659 case JIM_EXPROP_FUNC_ROUND:
7660 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7661 break;
7662 case JIM_EXPROP_FUNC_DOUBLE:
7663 case JIM_EXPROP_UNARYPLUS:
7664 dC = dA;
7665 intresult = 0;
7666 break;
7667 case JIM_EXPROP_FUNC_ABS:
7668 dC = dA >= 0 ? dA : -dA;
7669 intresult = 0;
7670 break;
7671 case JIM_EXPROP_UNARYMINUS:
7672 dC = -dA;
7673 intresult = 0;
7674 break;
7675 case JIM_EXPROP_NOT:
7676 wC = !dA;
7677 break;
7678 default:
7679 abort();
7683 if (rc == JIM_OK) {
7684 if (intresult) {
7685 ExprPush(e, Jim_NewIntObj(interp, wC));
7687 else {
7688 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7692 Jim_DecrRefCount(interp, A);
7694 return rc;
7697 static double JimRandDouble(Jim_Interp *interp)
7699 unsigned long x;
7700 JimRandomBytes(interp, &x, sizeof(x));
7702 return (double)x / (unsigned long)~0;
7705 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7707 Jim_Obj *A = ExprPop(e);
7708 jim_wide wA;
7710 int rc = Jim_GetWide(interp, A, &wA);
7711 if (rc == JIM_OK) {
7712 switch (e->opcode) {
7713 case JIM_EXPROP_BITNOT:
7714 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7715 break;
7716 case JIM_EXPROP_FUNC_SRAND:
7717 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7718 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7719 break;
7720 default:
7721 abort();
7725 Jim_DecrRefCount(interp, A);
7727 return rc;
7730 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7732 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7734 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7736 return JIM_OK;
7739 #ifdef JIM_MATH_FUNCTIONS
7740 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7742 int rc;
7743 Jim_Obj *A = ExprPop(e);
7744 double dA, dC;
7746 rc = Jim_GetDouble(interp, A, &dA);
7747 if (rc == JIM_OK) {
7748 switch (e->opcode) {
7749 case JIM_EXPROP_FUNC_SIN:
7750 dC = sin(dA);
7751 break;
7752 case JIM_EXPROP_FUNC_COS:
7753 dC = cos(dA);
7754 break;
7755 case JIM_EXPROP_FUNC_TAN:
7756 dC = tan(dA);
7757 break;
7758 case JIM_EXPROP_FUNC_ASIN:
7759 dC = asin(dA);
7760 break;
7761 case JIM_EXPROP_FUNC_ACOS:
7762 dC = acos(dA);
7763 break;
7764 case JIM_EXPROP_FUNC_ATAN:
7765 dC = atan(dA);
7766 break;
7767 case JIM_EXPROP_FUNC_SINH:
7768 dC = sinh(dA);
7769 break;
7770 case JIM_EXPROP_FUNC_COSH:
7771 dC = cosh(dA);
7772 break;
7773 case JIM_EXPROP_FUNC_TANH:
7774 dC = tanh(dA);
7775 break;
7776 case JIM_EXPROP_FUNC_CEIL:
7777 dC = ceil(dA);
7778 break;
7779 case JIM_EXPROP_FUNC_FLOOR:
7780 dC = floor(dA);
7781 break;
7782 case JIM_EXPROP_FUNC_EXP:
7783 dC = exp(dA);
7784 break;
7785 case JIM_EXPROP_FUNC_LOG:
7786 dC = log(dA);
7787 break;
7788 case JIM_EXPROP_FUNC_LOG10:
7789 dC = log10(dA);
7790 break;
7791 case JIM_EXPROP_FUNC_SQRT:
7792 dC = sqrt(dA);
7793 break;
7794 default:
7795 abort();
7797 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7800 Jim_DecrRefCount(interp, A);
7802 return rc;
7804 #endif
7806 /* A binary operation on two ints */
7807 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7809 Jim_Obj *B = ExprPop(e);
7810 Jim_Obj *A = ExprPop(e);
7811 jim_wide wA, wB;
7812 int rc = JIM_ERR;
7814 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7815 jim_wide wC;
7817 rc = JIM_OK;
7819 switch (e->opcode) {
7820 case JIM_EXPROP_LSHIFT:
7821 wC = wA << wB;
7822 break;
7823 case JIM_EXPROP_RSHIFT:
7824 wC = wA >> wB;
7825 break;
7826 case JIM_EXPROP_BITAND:
7827 wC = wA & wB;
7828 break;
7829 case JIM_EXPROP_BITXOR:
7830 wC = wA ^ wB;
7831 break;
7832 case JIM_EXPROP_BITOR:
7833 wC = wA | wB;
7834 break;
7835 case JIM_EXPROP_MOD:
7836 if (wB == 0) {
7837 wC = 0;
7838 Jim_SetResultString(interp, "Division by zero", -1);
7839 rc = JIM_ERR;
7841 else {
7843 * From Tcl 8.x
7845 * This code is tricky: C doesn't guarantee much
7846 * about the quotient or remainder, but Tcl does.
7847 * The remainder always has the same sign as the
7848 * divisor and a smaller absolute value.
7850 int negative = 0;
7852 if (wB < 0) {
7853 wB = -wB;
7854 wA = -wA;
7855 negative = 1;
7857 wC = wA % wB;
7858 if (wC < 0) {
7859 wC += wB;
7861 if (negative) {
7862 wC = -wC;
7865 break;
7866 case JIM_EXPROP_ROTL:
7867 case JIM_EXPROP_ROTR:{
7868 /* uint32_t would be better. But not everyone has inttypes.h? */
7869 unsigned long uA = (unsigned long)wA;
7870 unsigned long uB = (unsigned long)wB;
7871 const unsigned int S = sizeof(unsigned long) * 8;
7873 /* Shift left by the word size or more is undefined. */
7874 uB %= S;
7876 if (e->opcode == JIM_EXPROP_ROTR) {
7877 uB = S - uB;
7879 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7880 break;
7882 default:
7883 abort();
7885 ExprPush(e, Jim_NewIntObj(interp, wC));
7889 Jim_DecrRefCount(interp, A);
7890 Jim_DecrRefCount(interp, B);
7892 return rc;
7896 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7897 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7899 int intresult = 1;
7900 int rc = JIM_OK;
7901 double dA, dB, dC = 0;
7902 jim_wide wA, wB, wC = 0;
7904 Jim_Obj *B = ExprPop(e);
7905 Jim_Obj *A = ExprPop(e);
7907 if ((A->typePtr != &doubleObjType || A->bytes) &&
7908 (B->typePtr != &doubleObjType || B->bytes) &&
7909 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7911 /* Both are ints */
7913 switch (e->opcode) {
7914 case JIM_EXPROP_POW:
7915 case JIM_EXPROP_FUNC_POW:
7916 wC = JimPowWide(wA, wB);
7917 break;
7918 case JIM_EXPROP_ADD:
7919 wC = wA + wB;
7920 break;
7921 case JIM_EXPROP_SUB:
7922 wC = wA - wB;
7923 break;
7924 case JIM_EXPROP_MUL:
7925 wC = wA * wB;
7926 break;
7927 case JIM_EXPROP_DIV:
7928 if (wB == 0) {
7929 Jim_SetResultString(interp, "Division by zero", -1);
7930 rc = JIM_ERR;
7932 else {
7934 * From Tcl 8.x
7936 * This code is tricky: C doesn't guarantee much
7937 * about the quotient or remainder, but Tcl does.
7938 * The remainder always has the same sign as the
7939 * divisor and a smaller absolute value.
7941 if (wB < 0) {
7942 wB = -wB;
7943 wA = -wA;
7945 wC = wA / wB;
7946 if (wA % wB < 0) {
7947 wC--;
7950 break;
7951 case JIM_EXPROP_LT:
7952 wC = wA < wB;
7953 break;
7954 case JIM_EXPROP_GT:
7955 wC = wA > wB;
7956 break;
7957 case JIM_EXPROP_LTE:
7958 wC = wA <= wB;
7959 break;
7960 case JIM_EXPROP_GTE:
7961 wC = wA >= wB;
7962 break;
7963 case JIM_EXPROP_NUMEQ:
7964 wC = wA == wB;
7965 break;
7966 case JIM_EXPROP_NUMNE:
7967 wC = wA != wB;
7968 break;
7969 default:
7970 abort();
7973 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7974 intresult = 0;
7975 switch (e->opcode) {
7976 case JIM_EXPROP_POW:
7977 case JIM_EXPROP_FUNC_POW:
7978 #ifdef JIM_MATH_FUNCTIONS
7979 dC = pow(dA, dB);
7980 #else
7981 Jim_SetResultString(interp, "unsupported", -1);
7982 rc = JIM_ERR;
7983 #endif
7984 break;
7985 case JIM_EXPROP_ADD:
7986 dC = dA + dB;
7987 break;
7988 case JIM_EXPROP_SUB:
7989 dC = dA - dB;
7990 break;
7991 case JIM_EXPROP_MUL:
7992 dC = dA * dB;
7993 break;
7994 case JIM_EXPROP_DIV:
7995 if (dB == 0) {
7996 #ifdef INFINITY
7997 dC = dA < 0 ? -INFINITY : INFINITY;
7998 #else
7999 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8000 #endif
8002 else {
8003 dC = dA / dB;
8005 break;
8006 case JIM_EXPROP_LT:
8007 wC = dA < dB;
8008 intresult = 1;
8009 break;
8010 case JIM_EXPROP_GT:
8011 wC = dA > dB;
8012 intresult = 1;
8013 break;
8014 case JIM_EXPROP_LTE:
8015 wC = dA <= dB;
8016 intresult = 1;
8017 break;
8018 case JIM_EXPROP_GTE:
8019 wC = dA >= dB;
8020 intresult = 1;
8021 break;
8022 case JIM_EXPROP_NUMEQ:
8023 wC = dA == dB;
8024 intresult = 1;
8025 break;
8026 case JIM_EXPROP_NUMNE:
8027 wC = dA != dB;
8028 intresult = 1;
8029 break;
8030 default:
8031 abort();
8034 else {
8035 /* Handle the string case */
8037 /* XXX: Could optimise the eq/ne case by checking lengths */
8038 int i = Jim_StringCompareObj(interp, A, B, 0);
8040 switch (e->opcode) {
8041 case JIM_EXPROP_LT:
8042 wC = i < 0;
8043 break;
8044 case JIM_EXPROP_GT:
8045 wC = i > 0;
8046 break;
8047 case JIM_EXPROP_LTE:
8048 wC = i <= 0;
8049 break;
8050 case JIM_EXPROP_GTE:
8051 wC = i >= 0;
8052 break;
8053 case JIM_EXPROP_NUMEQ:
8054 wC = i == 0;
8055 break;
8056 case JIM_EXPROP_NUMNE:
8057 wC = i != 0;
8058 break;
8059 default:
8060 rc = JIM_ERR;
8061 break;
8065 if (rc == JIM_OK) {
8066 if (intresult) {
8067 ExprPush(e, Jim_NewIntObj(interp, wC));
8069 else {
8070 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8074 Jim_DecrRefCount(interp, A);
8075 Jim_DecrRefCount(interp, B);
8077 return rc;
8080 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8082 int listlen;
8083 int i;
8085 listlen = Jim_ListLength(interp, listObjPtr);
8086 for (i = 0; i < listlen; i++) {
8087 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8088 return 1;
8091 return 0;
8094 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8096 Jim_Obj *B = ExprPop(e);
8097 Jim_Obj *A = ExprPop(e);
8099 jim_wide wC;
8101 switch (e->opcode) {
8102 case JIM_EXPROP_STREQ:
8103 case JIM_EXPROP_STRNE:
8104 wC = Jim_StringEqObj(A, B);
8105 if (e->opcode == JIM_EXPROP_STRNE) {
8106 wC = !wC;
8108 break;
8109 case JIM_EXPROP_STRIN:
8110 wC = JimSearchList(interp, B, A);
8111 break;
8112 case JIM_EXPROP_STRNI:
8113 wC = !JimSearchList(interp, B, A);
8114 break;
8115 default:
8116 abort();
8118 ExprPush(e, Jim_NewIntObj(interp, wC));
8120 Jim_DecrRefCount(interp, A);
8121 Jim_DecrRefCount(interp, B);
8123 return JIM_OK;
8126 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8128 long l;
8129 double d;
8131 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8132 return l != 0;
8134 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8135 return d != 0;
8137 return -1;
8140 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8142 Jim_Obj *skip = ExprPop(e);
8143 Jim_Obj *A = ExprPop(e);
8144 int rc = JIM_OK;
8146 switch (ExprBool(interp, A)) {
8147 case 0:
8148 /* false, so skip RHS opcodes with a 0 result */
8149 e->skip = JimWideValue(skip);
8150 ExprPush(e, Jim_NewIntObj(interp, 0));
8151 break;
8153 case 1:
8154 /* true so continue */
8155 break;
8157 case -1:
8158 /* Invalid */
8159 rc = JIM_ERR;
8161 Jim_DecrRefCount(interp, A);
8162 Jim_DecrRefCount(interp, skip);
8164 return rc;
8167 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8169 Jim_Obj *skip = ExprPop(e);
8170 Jim_Obj *A = ExprPop(e);
8171 int rc = JIM_OK;
8173 switch (ExprBool(interp, A)) {
8174 case 0:
8175 /* false, so do nothing */
8176 break;
8178 case 1:
8179 /* true so skip RHS opcodes with a 1 result */
8180 e->skip = JimWideValue(skip);
8181 ExprPush(e, Jim_NewIntObj(interp, 1));
8182 break;
8184 case -1:
8185 /* Invalid */
8186 rc = JIM_ERR;
8187 break;
8189 Jim_DecrRefCount(interp, A);
8190 Jim_DecrRefCount(interp, skip);
8192 return rc;
8195 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8197 Jim_Obj *A = ExprPop(e);
8198 int rc = JIM_OK;
8200 switch (ExprBool(interp, A)) {
8201 case 0:
8202 ExprPush(e, Jim_NewIntObj(interp, 0));
8203 break;
8205 case 1:
8206 ExprPush(e, Jim_NewIntObj(interp, 1));
8207 break;
8209 case -1:
8210 /* Invalid */
8211 rc = JIM_ERR;
8212 break;
8214 Jim_DecrRefCount(interp, A);
8216 return rc;
8219 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8221 Jim_Obj *skip = ExprPop(e);
8222 Jim_Obj *A = ExprPop(e);
8223 int rc = JIM_OK;
8225 /* Repush A */
8226 ExprPush(e, A);
8228 switch (ExprBool(interp, A)) {
8229 case 0:
8230 /* false, skip RHS opcodes */
8231 e->skip = JimWideValue(skip);
8232 /* Push a dummy value */
8233 ExprPush(e, Jim_NewIntObj(interp, 0));
8234 break;
8236 case 1:
8237 /* true so do nothing */
8238 break;
8240 case -1:
8241 /* Invalid */
8242 rc = JIM_ERR;
8243 break;
8245 Jim_DecrRefCount(interp, A);
8246 Jim_DecrRefCount(interp, skip);
8248 return rc;
8251 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8253 Jim_Obj *skip = ExprPop(e);
8254 Jim_Obj *B = ExprPop(e);
8255 Jim_Obj *A = ExprPop(e);
8257 /* No need to check for A as non-boolean */
8258 if (ExprBool(interp, A)) {
8259 /* true, so skip RHS opcodes */
8260 e->skip = JimWideValue(skip);
8261 /* Repush B as the answer */
8262 ExprPush(e, B);
8265 Jim_DecrRefCount(interp, skip);
8266 Jim_DecrRefCount(interp, A);
8267 Jim_DecrRefCount(interp, B);
8268 return JIM_OK;
8271 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8273 return JIM_OK;
8276 enum
8278 LAZY_NONE,
8279 LAZY_OP,
8280 LAZY_LEFT,
8281 LAZY_RIGHT
8284 /* name - precedence - arity - opcode
8286 * This array *must* be kept in sync with the JIM_EXPROP enum.
8288 * The following macros pre-compute the string length at compile time.
8290 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8291 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8293 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8294 OPRINIT("*", 110, 2, JimExprOpBin),
8295 OPRINIT("/", 110, 2, JimExprOpBin),
8296 OPRINIT("%", 110, 2, JimExprOpIntBin),
8298 OPRINIT("-", 100, 2, JimExprOpBin),
8299 OPRINIT("+", 100, 2, JimExprOpBin),
8301 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8302 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8304 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8305 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8307 OPRINIT("<", 80, 2, JimExprOpBin),
8308 OPRINIT(">", 80, 2, JimExprOpBin),
8309 OPRINIT("<=", 80, 2, JimExprOpBin),
8310 OPRINIT(">=", 80, 2, JimExprOpBin),
8312 OPRINIT("==", 70, 2, JimExprOpBin),
8313 OPRINIT("!=", 70, 2, JimExprOpBin),
8315 OPRINIT("&", 50, 2, JimExprOpIntBin),
8316 OPRINIT("^", 49, 2, JimExprOpIntBin),
8317 OPRINIT("|", 48, 2, JimExprOpIntBin),
8319 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8320 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8321 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8323 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8324 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8325 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8327 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8328 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8329 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8331 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8332 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8333 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8335 OPRINIT("**", 250, 2, JimExprOpBin),
8337 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8338 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8340 OPRINIT("in", 55, 2, JimExprOpStrBin),
8341 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8343 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8344 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8345 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8346 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8350 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8351 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8352 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8353 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8354 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8355 OPRINIT("rand", 200, 0, JimExprOpNone),
8356 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8358 #ifdef JIM_MATH_FUNCTIONS
8359 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8360 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8361 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8362 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8363 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8364 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8365 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8366 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8367 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8368 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8369 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8370 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8371 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8372 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8373 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8374 OPRINIT("pow", 200, 2, JimExprOpBin),
8375 #endif
8377 #undef OPRINIT
8378 #undef OPRINIT_LAZY
8380 #define JIM_EXPR_OPERATORS_NUM \
8381 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8383 static int JimParseExpression(struct JimParserCtx *pc)
8385 /* Discard spaces and quoted newline */
8386 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8387 if (*pc->p == '\n') {
8388 pc->linenr++;
8390 pc->p++;
8391 pc->len--;
8394 /* Common case */
8395 pc->tline = pc->linenr;
8396 pc->tstart = pc->p;
8398 if (pc->len == 0) {
8399 pc->tend = pc->p;
8400 pc->tt = JIM_TT_EOL;
8401 pc->eof = 1;
8402 return JIM_OK;
8404 switch (*(pc->p)) {
8405 case '(':
8406 pc->tt = JIM_TT_SUBEXPR_START;
8407 goto singlechar;
8408 case ')':
8409 pc->tt = JIM_TT_SUBEXPR_END;
8410 goto singlechar;
8411 case ',':
8412 pc->tt = JIM_TT_SUBEXPR_COMMA;
8413 singlechar:
8414 pc->tend = pc->p;
8415 pc->p++;
8416 pc->len--;
8417 break;
8418 case '[':
8419 return JimParseCmd(pc);
8420 case '$':
8421 if (JimParseVar(pc) == JIM_ERR)
8422 return JimParseExprOperator(pc);
8423 else {
8424 /* Don't allow expr sugar in expressions */
8425 if (pc->tt == JIM_TT_EXPRSUGAR) {
8426 return JIM_ERR;
8428 return JIM_OK;
8430 break;
8431 case '0':
8432 case '1':
8433 case '2':
8434 case '3':
8435 case '4':
8436 case '5':
8437 case '6':
8438 case '7':
8439 case '8':
8440 case '9':
8441 case '.':
8442 return JimParseExprNumber(pc);
8443 case '"':
8444 return JimParseQuote(pc);
8445 case '{':
8446 return JimParseBrace(pc);
8448 case 'N':
8449 case 'I':
8450 case 'n':
8451 case 'i':
8452 if (JimParseExprIrrational(pc) == JIM_ERR)
8453 return JimParseExprOperator(pc);
8454 break;
8455 default:
8456 return JimParseExprOperator(pc);
8457 break;
8459 return JIM_OK;
8462 static int JimParseExprNumber(struct JimParserCtx *pc)
8464 char *end;
8466 /* Assume an integer for now */
8467 pc->tt = JIM_TT_EXPR_INT;
8469 jim_strtoull(pc->p, (char **)&pc->p);
8470 /* Tried as an integer, but perhaps it parses as a double */
8471 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8472 /* Some stupid compilers insist they are cleverer that
8473 * we are. Even a (void) cast doesn't prevent this warning!
8475 if (strtod(pc->tstart, &end)) { /* nothing */ }
8476 if (end == pc->tstart)
8477 return JIM_ERR;
8478 if (end > pc->p) {
8479 /* Yes, double captured more chars */
8480 pc->tt = JIM_TT_EXPR_DOUBLE;
8481 pc->p = end;
8484 pc->tend = pc->p - 1;
8485 pc->len -= (pc->p - pc->tstart);
8486 return JIM_OK;
8489 static int JimParseExprIrrational(struct JimParserCtx *pc)
8491 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8492 int i;
8494 for (i = 0; irrationals[i]; i++) {
8495 const char *irr = irrationals[i];
8497 if (strncmp(irr, pc->p, 3) == 0) {
8498 pc->p += 3;
8499 pc->len -= 3;
8500 pc->tend = pc->p - 1;
8501 pc->tt = JIM_TT_EXPR_DOUBLE;
8502 return JIM_OK;
8505 return JIM_ERR;
8508 static int JimParseExprOperator(struct JimParserCtx *pc)
8510 int i;
8511 int bestIdx = -1, bestLen = 0;
8513 /* Try to get the longest match. */
8514 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8515 const char * const opname = Jim_ExprOperators[i].name;
8516 const int oplen = Jim_ExprOperators[i].namelen;
8518 if (opname == NULL || opname[0] != pc->p[0]) {
8519 continue;
8522 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8523 bestIdx = i + JIM_TT_EXPR_OP;
8524 bestLen = oplen;
8527 if (bestIdx == -1) {
8528 return JIM_ERR;
8531 /* Validate paretheses around function arguments */
8532 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8533 const char *p = pc->p + bestLen;
8534 int len = pc->len - bestLen;
8536 while (len && isspace(UCHAR(*p))) {
8537 len--;
8538 p++;
8540 if (*p != '(') {
8541 return JIM_ERR;
8544 pc->tend = pc->p + bestLen - 1;
8545 pc->p += bestLen;
8546 pc->len -= bestLen;
8548 pc->tt = bestIdx;
8549 return JIM_OK;
8552 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8554 static Jim_ExprOperator dummy_op;
8555 if (opcode < JIM_TT_EXPR_OP) {
8556 return &dummy_op;
8558 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8561 const char *jim_tt_name(int type)
8563 static const char * const tt_names[JIM_TT_EXPR_OP] =
8564 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8565 "DBL", "$()" };
8566 if (type < JIM_TT_EXPR_OP) {
8567 return tt_names[type];
8569 else {
8570 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8571 static char buf[20];
8573 if (op->name) {
8574 return op->name;
8576 sprintf(buf, "(%d)", type);
8577 return buf;
8581 /* -----------------------------------------------------------------------------
8582 * Expression Object
8583 * ---------------------------------------------------------------------------*/
8584 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8585 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8586 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8588 static const Jim_ObjType exprObjType = {
8589 "expression",
8590 FreeExprInternalRep,
8591 DupExprInternalRep,
8592 NULL,
8593 JIM_TYPE_REFERENCES,
8596 /* Expr bytecode structure */
8597 typedef struct ExprByteCode
8599 ScriptToken *token; /* Tokens array. */
8600 int len; /* Length as number of tokens. */
8601 int inUse; /* Used for sharing. */
8602 } ExprByteCode;
8604 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8606 int i;
8608 for (i = 0; i < expr->len; i++) {
8609 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8611 Jim_Free(expr->token);
8612 Jim_Free(expr);
8615 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8617 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8619 if (expr) {
8620 if (--expr->inUse != 0) {
8621 return;
8624 ExprFreeByteCode(interp, expr);
8628 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8630 JIM_NOTUSED(interp);
8631 JIM_NOTUSED(srcPtr);
8633 /* Just returns an simple string. */
8634 dupPtr->typePtr = NULL;
8637 /* Check if an expr program looks correct. */
8638 static int ExprCheckCorrectness(ExprByteCode * expr)
8640 int i;
8641 int stacklen = 0;
8642 int ternary = 0;
8644 /* Try to check if there are stack underflows,
8645 * and make sure at the end of the program there is
8646 * a single result on the stack. */
8647 for (i = 0; i < expr->len; i++) {
8648 ScriptToken *t = &expr->token[i];
8649 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8651 stacklen -= op->arity;
8652 if (stacklen < 0) {
8653 break;
8655 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8656 ternary++;
8658 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8659 ternary--;
8662 /* All operations and operands add one to the stack */
8663 stacklen++;
8665 if (stacklen != 1 || ternary != 0) {
8666 return JIM_ERR;
8668 return JIM_OK;
8671 /* This procedure converts every occurrence of || and && opereators
8672 * in lazy unary versions.
8674 * a b || is converted into:
8676 * a <offset> |L b |R
8678 * a b && is converted into:
8680 * a <offset> &L b &R
8682 * "|L" checks if 'a' is true:
8683 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8684 * the opcode just after |R.
8685 * 2) if it is false does nothing.
8686 * "|R" checks if 'b' is true:
8687 * 1) if it is true pushes 1, otherwise pushes 0.
8689 * "&L" checks if 'a' is true:
8690 * 1) if it is true does nothing.
8691 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8692 * the opcode just after &R
8693 * "&R" checks if 'a' is true:
8694 * if it is true pushes 1, otherwise pushes 0.
8696 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8698 int i;
8700 int leftindex, arity, offset;
8702 /* Search for the end of the first operator */
8703 leftindex = expr->len - 1;
8705 arity = 1;
8706 while (arity) {
8707 ScriptToken *tt = &expr->token[leftindex];
8709 if (tt->type >= JIM_TT_EXPR_OP) {
8710 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8712 arity--;
8713 if (--leftindex < 0) {
8714 return JIM_ERR;
8717 leftindex++;
8719 /* Move them up */
8720 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8721 sizeof(*expr->token) * (expr->len - leftindex));
8722 expr->len += 2;
8723 offset = (expr->len - leftindex) - 1;
8725 /* Now we rely on the fact the the left and right version have opcodes
8726 * 1 and 2 after the main opcode respectively
8728 expr->token[leftindex + 1].type = t->type + 1;
8729 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8731 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8732 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8734 /* Now add the 'R' operator */
8735 expr->token[expr->len].objPtr = interp->emptyObj;
8736 expr->token[expr->len].type = t->type + 2;
8737 expr->len++;
8739 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8740 for (i = leftindex - 1; i > 0; i--) {
8741 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8742 if (op->lazy == LAZY_LEFT) {
8743 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8744 JimWideValue(expr->token[i - 1].objPtr) += 2;
8748 return JIM_OK;
8751 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8753 struct ScriptToken *token = &expr->token[expr->len];
8754 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8756 if (op->lazy == LAZY_OP) {
8757 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8758 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8759 return JIM_ERR;
8762 else {
8763 token->objPtr = interp->emptyObj;
8764 token->type = t->type;
8765 expr->len++;
8767 return JIM_OK;
8771 * Returns the index of the COLON_LEFT to the left of 'right_index'
8772 * taking into account nesting.
8774 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8776 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8778 int ternary_count = 1;
8780 right_index--;
8782 while (right_index > 1) {
8783 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8784 ternary_count--;
8786 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8787 ternary_count++;
8789 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8790 return right_index;
8792 right_index--;
8795 /*notreached*/
8796 return -1;
8800 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8802 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8803 * Otherwise returns 0.
8805 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8807 int i = right_index - 1;
8808 int ternary_count = 1;
8810 while (i > 1) {
8811 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8812 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8813 *prev_right_index = i - 2;
8814 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8815 return 1;
8818 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8819 if (ternary_count == 0) {
8820 return 0;
8822 ternary_count++;
8824 i--;
8826 return 0;
8830 * ExprTernaryReorderExpression description
8831 * ========================================
8833 * ?: is right-to-left associative which doesn't work with the stack-based
8834 * expression engine. The fix is to reorder the bytecode.
8836 * The expression:
8838 * expr 1?2:0?3:4
8840 * Has initial bytecode:
8842 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8843 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8845 * The fix involves simulating this expression instead:
8847 * expr 1?2:(0?3:4)
8849 * With the following bytecode:
8851 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8852 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8854 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8855 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8856 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8857 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8859 * ExprTernaryReorderExpression works thus as follows :
8860 * - start from the end of the stack
8861 * - while walking towards the beginning of the stack
8862 * if token=JIM_EXPROP_COLON_RIGHT then
8863 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8864 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8865 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8866 * if all found then
8867 * perform the rotation
8868 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8869 * end if
8870 * end if
8872 * Note: care has to be taken for nested ternary constructs!!!
8874 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8876 int i;
8878 for (i = expr->len - 1; i > 1; i--) {
8879 int prev_right_index;
8880 int prev_left_index;
8881 int j;
8882 ScriptToken tmp;
8884 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8885 continue;
8888 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8889 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8890 continue;
8894 ** rotate tokens down
8896 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8897 ** | | |
8898 ** | V V
8899 ** | [...] : ...
8900 ** | | |
8901 ** | V V
8902 ** | [...] : ...
8903 ** | | |
8904 ** | V V
8905 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8907 tmp = expr->token[prev_right_index];
8908 for (j = prev_right_index; j < i; j++) {
8909 expr->token[j] = expr->token[j + 1];
8911 expr->token[i] = tmp;
8913 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8915 * This is 'colon left increment' = i - prev_right_index
8917 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8918 * [prev_left_index-1] : skip_count
8921 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8923 /* Adjust for i-- in the loop */
8924 i++;
8928 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8930 Jim_Stack stack;
8931 ExprByteCode *expr;
8932 int ok = 1;
8933 int i;
8934 int prevtt = JIM_TT_NONE;
8935 int have_ternary = 0;
8937 /* -1 for EOL */
8938 int count = tokenlist->count - 1;
8940 expr = Jim_Alloc(sizeof(*expr));
8941 expr->inUse = 1;
8942 expr->len = 0;
8944 Jim_InitStack(&stack);
8946 /* Need extra bytecodes for lazy operators.
8947 * Also check for the ternary operator
8949 for (i = 0; i < tokenlist->count; i++) {
8950 ParseToken *t = &tokenlist->list[i];
8951 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8953 if (op->lazy == LAZY_OP) {
8954 count += 2;
8955 /* Ternary is a lazy op but also needs reordering */
8956 if (t->type == JIM_EXPROP_TERNARY) {
8957 have_ternary = 1;
8962 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8964 for (i = 0; i < tokenlist->count && ok; i++) {
8965 ParseToken *t = &tokenlist->list[i];
8967 /* Next token will be stored here */
8968 struct ScriptToken *token = &expr->token[expr->len];
8970 if (t->type == JIM_TT_EOL) {
8971 break;
8974 switch (t->type) {
8975 case JIM_TT_STR:
8976 case JIM_TT_ESC:
8977 case JIM_TT_VAR:
8978 case JIM_TT_DICTSUGAR:
8979 case JIM_TT_EXPRSUGAR:
8980 case JIM_TT_CMD:
8981 token->type = t->type;
8982 strexpr:
8983 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8984 if (t->type == JIM_TT_CMD) {
8985 /* Only commands need source info */
8986 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8988 expr->len++;
8989 break;
8991 case JIM_TT_EXPR_INT:
8992 case JIM_TT_EXPR_DOUBLE:
8994 char *endptr;
8995 if (t->type == JIM_TT_EXPR_INT) {
8996 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8998 else {
8999 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9001 if (endptr != t->token + t->len) {
9002 /* Conversion failed, so just store it as a string */
9003 Jim_FreeNewObj(interp, token->objPtr);
9004 token->type = JIM_TT_STR;
9005 goto strexpr;
9007 token->type = t->type;
9008 expr->len++;
9010 break;
9012 case JIM_TT_SUBEXPR_START:
9013 Jim_StackPush(&stack, t);
9014 prevtt = JIM_TT_NONE;
9015 continue;
9017 case JIM_TT_SUBEXPR_COMMA:
9018 /* Simple approach. Comma is simply ignored */
9019 continue;
9021 case JIM_TT_SUBEXPR_END:
9022 ok = 0;
9023 while (Jim_StackLen(&stack)) {
9024 ParseToken *tt = Jim_StackPop(&stack);
9026 if (tt->type == JIM_TT_SUBEXPR_START) {
9027 ok = 1;
9028 break;
9031 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9032 goto err;
9035 if (!ok) {
9036 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9037 goto err;
9039 break;
9042 default:{
9043 /* Must be an operator */
9044 const struct Jim_ExprOperator *op;
9045 ParseToken *tt;
9047 /* Convert -/+ to unary minus or unary plus if necessary */
9048 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9049 if (t->type == JIM_EXPROP_SUB) {
9050 t->type = JIM_EXPROP_UNARYMINUS;
9052 else if (t->type == JIM_EXPROP_ADD) {
9053 t->type = JIM_EXPROP_UNARYPLUS;
9057 op = JimExprOperatorInfoByOpcode(t->type);
9059 /* Now handle precedence */
9060 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9061 const struct Jim_ExprOperator *tt_op =
9062 JimExprOperatorInfoByOpcode(tt->type);
9064 /* Note that right-to-left associativity of ?: operator is handled later */
9066 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9067 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9068 ok = 0;
9069 goto err;
9071 Jim_StackPop(&stack);
9073 else {
9074 break;
9077 Jim_StackPush(&stack, t);
9078 break;
9081 prevtt = t->type;
9084 /* Reduce any remaining subexpr */
9085 while (Jim_StackLen(&stack)) {
9086 ParseToken *tt = Jim_StackPop(&stack);
9088 if (tt->type == JIM_TT_SUBEXPR_START) {
9089 ok = 0;
9090 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9091 goto err;
9093 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9094 ok = 0;
9095 goto err;
9099 if (have_ternary) {
9100 ExprTernaryReorderExpression(interp, expr);
9103 err:
9104 /* Free the stack used for the compilation. */
9105 Jim_FreeStack(&stack);
9107 for (i = 0; i < expr->len; i++) {
9108 Jim_IncrRefCount(expr->token[i].objPtr);
9111 if (!ok) {
9112 ExprFreeByteCode(interp, expr);
9113 return NULL;
9116 return expr;
9120 /* This method takes the string representation of an expression
9121 * and generates a program for the Expr's stack-based VM. */
9122 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9124 int exprTextLen;
9125 const char *exprText;
9126 struct JimParserCtx parser;
9127 struct ExprByteCode *expr;
9128 ParseTokenList tokenlist;
9129 int line;
9130 Jim_Obj *fileNameObj;
9131 int rc = JIM_ERR;
9133 /* Try to get information about filename / line number */
9134 if (objPtr->typePtr == &sourceObjType) {
9135 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9136 line = objPtr->internalRep.sourceValue.lineNumber;
9138 else {
9139 fileNameObj = interp->emptyObj;
9140 line = 1;
9142 Jim_IncrRefCount(fileNameObj);
9144 exprText = Jim_GetString(objPtr, &exprTextLen);
9146 /* Initially tokenise the expression into tokenlist */
9147 ScriptTokenListInit(&tokenlist);
9149 JimParserInit(&parser, exprText, exprTextLen, line);
9150 while (!parser.eof) {
9151 if (JimParseExpression(&parser) != JIM_OK) {
9152 ScriptTokenListFree(&tokenlist);
9153 invalidexpr:
9154 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9155 expr = NULL;
9156 goto err;
9159 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9160 parser.tline);
9163 #ifdef DEBUG_SHOW_EXPR_TOKENS
9165 int i;
9166 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9167 for (i = 0; i < tokenlist.count; i++) {
9168 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9169 tokenlist.list[i].len, tokenlist.list[i].token);
9172 #endif
9174 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9175 ScriptTokenListFree(&tokenlist);
9176 Jim_DecrRefCount(interp, fileNameObj);
9177 return JIM_ERR;
9180 /* Now create the expression bytecode from the tokenlist */
9181 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9183 /* No longer need the token list */
9184 ScriptTokenListFree(&tokenlist);
9186 if (!expr) {
9187 goto err;
9190 #ifdef DEBUG_SHOW_EXPR
9192 int i;
9194 printf("==== Expr ====\n");
9195 for (i = 0; i < expr->len; i++) {
9196 ScriptToken *t = &expr->token[i];
9198 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9201 #endif
9203 /* Check program correctness. */
9204 if (ExprCheckCorrectness(expr) != JIM_OK) {
9205 ExprFreeByteCode(interp, expr);
9206 goto invalidexpr;
9209 rc = JIM_OK;
9211 err:
9212 /* Free the old internal rep and set the new one. */
9213 Jim_DecrRefCount(interp, fileNameObj);
9214 Jim_FreeIntRep(interp, objPtr);
9215 Jim_SetIntRepPtr(objPtr, expr);
9216 objPtr->typePtr = &exprObjType;
9217 return rc;
9220 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9222 if (objPtr->typePtr != &exprObjType) {
9223 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9224 return NULL;
9227 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9230 #ifdef JIM_OPTIMIZATION
9231 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9233 if (token->type == JIM_TT_EXPR_INT)
9234 return token->objPtr;
9235 else if (token->type == JIM_TT_VAR)
9236 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9237 else if (token->type == JIM_TT_DICTSUGAR)
9238 return JimExpandDictSugar(interp, token->objPtr);
9239 else
9240 return NULL;
9242 #endif
9244 /* -----------------------------------------------------------------------------
9245 * Expressions evaluation.
9246 * Jim uses a specialized stack-based virtual machine for expressions,
9247 * that takes advantage of the fact that expr's operators
9248 * can't be redefined.
9250 * Jim_EvalExpression() uses the bytecode compiled by
9251 * SetExprFromAny() method of the "expression" object.
9253 * On success a Tcl Object containing the result of the evaluation
9254 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9255 * returned.
9256 * On error the function returns a retcode != to JIM_OK and set a suitable
9257 * error on the interp.
9258 * ---------------------------------------------------------------------------*/
9259 #define JIM_EE_STATICSTACK_LEN 10
9261 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9263 ExprByteCode *expr;
9264 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9265 int i;
9266 int retcode = JIM_OK;
9267 struct JimExprState e;
9269 expr = JimGetExpression(interp, exprObjPtr);
9270 if (!expr) {
9271 return JIM_ERR; /* error in expression. */
9274 #ifdef JIM_OPTIMIZATION
9275 /* Check for one of the following common expressions used by while/for
9277 * CONST
9278 * $a
9279 * !$a
9280 * $a < CONST, $a < $b
9281 * $a <= CONST, $a <= $b
9282 * $a > CONST, $a > $b
9283 * $a >= CONST, $a >= $b
9284 * $a != CONST, $a != $b
9285 * $a == CONST, $a == $b
9288 Jim_Obj *objPtr;
9290 /* STEP 1 -- Check if there are the conditions to run the specialized
9291 * version of while */
9293 switch (expr->len) {
9294 case 1:
9295 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9296 if (objPtr) {
9297 Jim_IncrRefCount(objPtr);
9298 *exprResultPtrPtr = objPtr;
9299 return JIM_OK;
9301 break;
9303 case 2:
9304 if (expr->token[1].type == JIM_EXPROP_NOT) {
9305 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9307 if (objPtr && JimIsWide(objPtr)) {
9308 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9309 Jim_IncrRefCount(*exprResultPtrPtr);
9310 return JIM_OK;
9313 break;
9315 case 3:
9316 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9317 if (objPtr && JimIsWide(objPtr)) {
9318 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9319 if (objPtr2 && JimIsWide(objPtr2)) {
9320 jim_wide wideValueA = JimWideValue(objPtr);
9321 jim_wide wideValueB = JimWideValue(objPtr2);
9322 int cmpRes;
9323 switch (expr->token[2].type) {
9324 case JIM_EXPROP_LT:
9325 cmpRes = wideValueA < wideValueB;
9326 break;
9327 case JIM_EXPROP_LTE:
9328 cmpRes = wideValueA <= wideValueB;
9329 break;
9330 case JIM_EXPROP_GT:
9331 cmpRes = wideValueA > wideValueB;
9332 break;
9333 case JIM_EXPROP_GTE:
9334 cmpRes = wideValueA >= wideValueB;
9335 break;
9336 case JIM_EXPROP_NUMEQ:
9337 cmpRes = wideValueA == wideValueB;
9338 break;
9339 case JIM_EXPROP_NUMNE:
9340 cmpRes = wideValueA != wideValueB;
9341 break;
9342 default:
9343 goto noopt;
9345 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9346 Jim_IncrRefCount(*exprResultPtrPtr);
9347 return JIM_OK;
9350 break;
9353 noopt:
9354 #endif
9356 /* In order to avoid that the internal repr gets freed due to
9357 * shimmering of the exprObjPtr's object, we make the internal rep
9358 * shared. */
9359 expr->inUse++;
9361 /* The stack-based expr VM itself */
9363 /* Stack allocation. Expr programs have the feature that
9364 * a program of length N can't require a stack longer than
9365 * N. */
9366 if (expr->len > JIM_EE_STATICSTACK_LEN)
9367 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9368 else
9369 e.stack = staticStack;
9371 e.stacklen = 0;
9373 /* Execute every instruction */
9374 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9375 Jim_Obj *objPtr;
9377 switch (expr->token[i].type) {
9378 case JIM_TT_EXPR_INT:
9379 case JIM_TT_EXPR_DOUBLE:
9380 case JIM_TT_STR:
9381 ExprPush(&e, expr->token[i].objPtr);
9382 break;
9384 case JIM_TT_VAR:
9385 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9386 if (objPtr) {
9387 ExprPush(&e, objPtr);
9389 else {
9390 retcode = JIM_ERR;
9392 break;
9394 case JIM_TT_DICTSUGAR:
9395 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9396 if (objPtr) {
9397 ExprPush(&e, objPtr);
9399 else {
9400 retcode = JIM_ERR;
9402 break;
9404 case JIM_TT_ESC:
9405 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9406 if (retcode == JIM_OK) {
9407 ExprPush(&e, objPtr);
9409 break;
9411 case JIM_TT_CMD:
9412 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9413 if (retcode == JIM_OK) {
9414 ExprPush(&e, Jim_GetResult(interp));
9416 break;
9418 default:{
9419 /* Find and execute the operation */
9420 e.skip = 0;
9421 e.opcode = expr->token[i].type;
9423 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9424 /* Skip some opcodes if necessary */
9425 i += e.skip;
9426 continue;
9431 expr->inUse--;
9433 if (retcode == JIM_OK) {
9434 *exprResultPtrPtr = ExprPop(&e);
9436 else {
9437 for (i = 0; i < e.stacklen; i++) {
9438 Jim_DecrRefCount(interp, e.stack[i]);
9441 if (e.stack != staticStack) {
9442 Jim_Free(e.stack);
9444 return retcode;
9447 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9449 int retcode;
9450 jim_wide wideValue;
9451 double doubleValue;
9452 Jim_Obj *exprResultPtr;
9454 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9455 if (retcode != JIM_OK)
9456 return retcode;
9458 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9459 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9460 Jim_DecrRefCount(interp, exprResultPtr);
9461 return JIM_ERR;
9463 else {
9464 Jim_DecrRefCount(interp, exprResultPtr);
9465 *boolPtr = doubleValue != 0;
9466 return JIM_OK;
9469 *boolPtr = wideValue != 0;
9471 Jim_DecrRefCount(interp, exprResultPtr);
9472 return JIM_OK;
9475 /* -----------------------------------------------------------------------------
9476 * ScanFormat String Object
9477 * ---------------------------------------------------------------------------*/
9479 /* This Jim_Obj will held a parsed representation of a format string passed to
9480 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9481 * to be parsed in its entirely first and then, if correct, can be used for
9482 * scanning. To avoid endless re-parsing, the parsed representation will be
9483 * stored in an internal representation and re-used for performance reason. */
9485 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9486 * scanformat string. This part will later be used to extract information
9487 * out from the string to be parsed by Jim_ScanString */
9489 typedef struct ScanFmtPartDescr
9491 char *arg; /* Specification of a CHARSET conversion */
9492 char *prefix; /* Prefix to be scanned literally before conversion */
9493 size_t width; /* Maximal width of input to be converted */
9494 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9495 char type; /* Type of conversion (e.g. c, d, f) */
9496 char modifier; /* Modify type (e.g. l - long, h - short */
9497 } ScanFmtPartDescr;
9499 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9500 * string parsed and separated in part descriptions. Furthermore it contains
9501 * the original string representation of the scanformat string to allow for
9502 * fast update of the Jim_Obj's string representation part.
9504 * As an add-on the internal object representation adds some scratch pad area
9505 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9506 * memory for purpose of string scanning.
9508 * The error member points to a static allocated string in case of a mal-
9509 * formed scanformat string or it contains '0' (NULL) in case of a valid
9510 * parse representation.
9512 * The whole memory of the internal representation is allocated as a single
9513 * area of memory that will be internally separated. So freeing and duplicating
9514 * of such an object is cheap */
9516 typedef struct ScanFmtStringObj
9518 jim_wide size; /* Size of internal repr in bytes */
9519 char *stringRep; /* Original string representation */
9520 size_t count; /* Number of ScanFmtPartDescr contained */
9521 size_t convCount; /* Number of conversions that will assign */
9522 size_t maxPos; /* Max position index if XPG3 is used */
9523 const char *error; /* Ptr to error text (NULL if no error */
9524 char *scratch; /* Some scratch pad used by Jim_ScanString */
9525 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9526 } ScanFmtStringObj;
9529 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9530 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9531 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9533 static const Jim_ObjType scanFmtStringObjType = {
9534 "scanformatstring",
9535 FreeScanFmtInternalRep,
9536 DupScanFmtInternalRep,
9537 UpdateStringOfScanFmt,
9538 JIM_TYPE_NONE,
9541 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9543 JIM_NOTUSED(interp);
9544 Jim_Free((char *)objPtr->internalRep.ptr);
9545 objPtr->internalRep.ptr = 0;
9548 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9550 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9551 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9553 JIM_NOTUSED(interp);
9554 memcpy(newVec, srcPtr->internalRep.ptr, size);
9555 dupPtr->internalRep.ptr = newVec;
9556 dupPtr->typePtr = &scanFmtStringObjType;
9559 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9561 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9564 /* SetScanFmtFromAny will parse a given string and create the internal
9565 * representation of the format specification. In case of an error
9566 * the error data member of the internal representation will be set
9567 * to an descriptive error text and the function will be left with
9568 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9569 * specification */
9571 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9573 ScanFmtStringObj *fmtObj;
9574 char *buffer;
9575 int maxCount, i, approxSize, lastPos = -1;
9576 const char *fmt = objPtr->bytes;
9577 int maxFmtLen = objPtr->length;
9578 const char *fmtEnd = fmt + maxFmtLen;
9579 int curr;
9581 Jim_FreeIntRep(interp, objPtr);
9582 /* Count how many conversions could take place maximally */
9583 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9584 if (fmt[i] == '%')
9585 ++maxCount;
9586 /* Calculate an approximation of the memory necessary */
9587 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9588 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9589 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9590 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9591 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9592 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9593 +1; /* safety byte */
9594 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9595 memset(fmtObj, 0, approxSize);
9596 fmtObj->size = approxSize;
9597 fmtObj->maxPos = 0;
9598 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9599 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9600 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9601 buffer = fmtObj->stringRep + maxFmtLen + 1;
9602 objPtr->internalRep.ptr = fmtObj;
9603 objPtr->typePtr = &scanFmtStringObjType;
9604 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9605 int width = 0, skip;
9606 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9608 fmtObj->count++;
9609 descr->width = 0; /* Assume width unspecified */
9610 /* Overread and store any "literal" prefix */
9611 if (*fmt != '%' || fmt[1] == '%') {
9612 descr->type = 0;
9613 descr->prefix = &buffer[i];
9614 for (; fmt < fmtEnd; ++fmt) {
9615 if (*fmt == '%') {
9616 if (fmt[1] != '%')
9617 break;
9618 ++fmt;
9620 buffer[i++] = *fmt;
9622 buffer[i++] = 0;
9624 /* Skip the conversion introducing '%' sign */
9625 ++fmt;
9626 /* End reached due to non-conversion literal only? */
9627 if (fmt >= fmtEnd)
9628 goto done;
9629 descr->pos = 0; /* Assume "natural" positioning */
9630 if (*fmt == '*') {
9631 descr->pos = -1; /* Okay, conversion will not be assigned */
9632 ++fmt;
9634 else
9635 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9636 /* Check if next token is a number (could be width or pos */
9637 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9638 fmt += skip;
9639 /* Was the number a XPG3 position specifier? */
9640 if (descr->pos != -1 && *fmt == '$') {
9641 int prev;
9643 ++fmt;
9644 descr->pos = width;
9645 width = 0;
9646 /* Look if "natural" postioning and XPG3 one was mixed */
9647 if ((lastPos == 0 && descr->pos > 0)
9648 || (lastPos > 0 && descr->pos == 0)) {
9649 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9650 return JIM_ERR;
9652 /* Look if this position was already used */
9653 for (prev = 0; prev < curr; ++prev) {
9654 if (fmtObj->descr[prev].pos == -1)
9655 continue;
9656 if (fmtObj->descr[prev].pos == descr->pos) {
9657 fmtObj->error =
9658 "variable is assigned by multiple \"%n$\" conversion specifiers";
9659 return JIM_ERR;
9662 /* Try to find a width after the XPG3 specifier */
9663 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9664 descr->width = width;
9665 fmt += skip;
9667 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9668 fmtObj->maxPos = descr->pos;
9670 else {
9671 /* Number was not a XPG3, so it has to be a width */
9672 descr->width = width;
9675 /* If positioning mode was undetermined yet, fix this */
9676 if (lastPos == -1)
9677 lastPos = descr->pos;
9678 /* Handle CHARSET conversion type ... */
9679 if (*fmt == '[') {
9680 int swapped = 1, beg = i, end, j;
9682 descr->type = '[';
9683 descr->arg = &buffer[i];
9684 ++fmt;
9685 if (*fmt == '^')
9686 buffer[i++] = *fmt++;
9687 if (*fmt == ']')
9688 buffer[i++] = *fmt++;
9689 while (*fmt && *fmt != ']')
9690 buffer[i++] = *fmt++;
9691 if (*fmt != ']') {
9692 fmtObj->error = "unmatched [ in format string";
9693 return JIM_ERR;
9695 end = i;
9696 buffer[i++] = 0;
9697 /* In case a range fence was given "backwards", swap it */
9698 while (swapped) {
9699 swapped = 0;
9700 for (j = beg + 1; j < end - 1; ++j) {
9701 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9702 char tmp = buffer[j - 1];
9704 buffer[j - 1] = buffer[j + 1];
9705 buffer[j + 1] = tmp;
9706 swapped = 1;
9711 else {
9712 /* Remember any valid modifier if given */
9713 if (strchr("hlL", *fmt) != 0)
9714 descr->modifier = tolower((int)*fmt++);
9716 descr->type = *fmt;
9717 if (strchr("efgcsndoxui", *fmt) == 0) {
9718 fmtObj->error = "bad scan conversion character";
9719 return JIM_ERR;
9721 else if (*fmt == 'c' && descr->width != 0) {
9722 fmtObj->error = "field width may not be specified in %c " "conversion";
9723 return JIM_ERR;
9725 else if (*fmt == 'u' && descr->modifier == 'l') {
9726 fmtObj->error = "unsigned wide not supported";
9727 return JIM_ERR;
9730 curr++;
9732 done:
9733 return JIM_OK;
9736 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9738 #define FormatGetCnvCount(_fo_) \
9739 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9740 #define FormatGetMaxPos(_fo_) \
9741 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9742 #define FormatGetError(_fo_) \
9743 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9745 /* JimScanAString is used to scan an unspecified string that ends with
9746 * next WS, or a string that is specified via a charset.
9749 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9751 char *buffer = Jim_StrDup(str);
9752 char *p = buffer;
9754 while (*str) {
9755 int c;
9756 int n;
9758 if (!sdescr && isspace(UCHAR(*str)))
9759 break; /* EOS via WS if unspecified */
9761 n = utf8_tounicode(str, &c);
9762 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9763 break;
9764 while (n--)
9765 *p++ = *str++;
9767 *p = 0;
9768 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9771 /* ScanOneEntry will scan one entry out of the string passed as argument.
9772 * It use the sscanf() function for this task. After extracting and
9773 * converting of the value, the count of scanned characters will be
9774 * returned of -1 in case of no conversion tool place and string was
9775 * already scanned thru */
9777 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9778 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9780 const char *tok;
9781 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9782 size_t scanned = 0;
9783 size_t anchor = pos;
9784 int i;
9785 Jim_Obj *tmpObj = NULL;
9787 /* First pessimistically assume, we will not scan anything :-) */
9788 *valObjPtr = 0;
9789 if (descr->prefix) {
9790 /* There was a prefix given before the conversion, skip it and adjust
9791 * the string-to-be-parsed accordingly */
9792 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9793 /* If prefix require, skip WS */
9794 if (isspace(UCHAR(descr->prefix[i])))
9795 while (pos < strLen && isspace(UCHAR(str[pos])))
9796 ++pos;
9797 else if (descr->prefix[i] != str[pos])
9798 break; /* Prefix do not match here, leave the loop */
9799 else
9800 ++pos; /* Prefix matched so far, next round */
9802 if (pos >= strLen) {
9803 return -1; /* All of str consumed: EOF condition */
9805 else if (descr->prefix[i] != 0)
9806 return 0; /* Not whole prefix consumed, no conversion possible */
9808 /* For all but following conversion, skip leading WS */
9809 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9810 while (isspace(UCHAR(str[pos])))
9811 ++pos;
9812 /* Determine how much skipped/scanned so far */
9813 scanned = pos - anchor;
9815 /* %c is a special, simple case. no width */
9816 if (descr->type == 'n') {
9817 /* Return pseudo conversion means: how much scanned so far? */
9818 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9820 else if (pos >= strLen) {
9821 /* Cannot scan anything, as str is totally consumed */
9822 return -1;
9824 else if (descr->type == 'c') {
9825 int c;
9826 scanned += utf8_tounicode(&str[pos], &c);
9827 *valObjPtr = Jim_NewIntObj(interp, c);
9828 return scanned;
9830 else {
9831 /* Processing of conversions follows ... */
9832 if (descr->width > 0) {
9833 /* Do not try to scan as fas as possible but only the given width.
9834 * To ensure this, we copy the part that should be scanned. */
9835 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9836 size_t tLen = descr->width > sLen ? sLen : descr->width;
9838 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9839 tok = tmpObj->bytes;
9841 else {
9842 /* As no width was given, simply refer to the original string */
9843 tok = &str[pos];
9845 switch (descr->type) {
9846 case 'd':
9847 case 'o':
9848 case 'x':
9849 case 'u':
9850 case 'i':{
9851 char *endp; /* Position where the number finished */
9852 jim_wide w;
9854 int base = descr->type == 'o' ? 8
9855 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9857 /* Try to scan a number with the given base */
9858 if (base == 0) {
9859 w = jim_strtoull(tok, &endp);
9861 else {
9862 w = strtoull(tok, &endp, base);
9865 if (endp != tok) {
9866 /* There was some number sucessfully scanned! */
9867 *valObjPtr = Jim_NewIntObj(interp, w);
9869 /* Adjust the number-of-chars scanned so far */
9870 scanned += endp - tok;
9872 else {
9873 /* Nothing was scanned. We have to determine if this
9874 * happened due to e.g. prefix mismatch or input str
9875 * exhausted */
9876 scanned = *tok ? 0 : -1;
9878 break;
9880 case 's':
9881 case '[':{
9882 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9883 scanned += Jim_Length(*valObjPtr);
9884 break;
9886 case 'e':
9887 case 'f':
9888 case 'g':{
9889 char *endp;
9890 double value = strtod(tok, &endp);
9892 if (endp != tok) {
9893 /* There was some number sucessfully scanned! */
9894 *valObjPtr = Jim_NewDoubleObj(interp, value);
9895 /* Adjust the number-of-chars scanned so far */
9896 scanned += endp - tok;
9898 else {
9899 /* Nothing was scanned. We have to determine if this
9900 * happened due to e.g. prefix mismatch or input str
9901 * exhausted */
9902 scanned = *tok ? 0 : -1;
9904 break;
9907 /* If a substring was allocated (due to pre-defined width) do not
9908 * forget to free it */
9909 if (tmpObj) {
9910 Jim_FreeNewObj(interp, tmpObj);
9913 return scanned;
9916 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9917 * string and returns all converted (and not ignored) values in a list back
9918 * to the caller. If an error occured, a NULL pointer will be returned */
9920 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9922 size_t i, pos;
9923 int scanned = 1;
9924 const char *str = Jim_String(strObjPtr);
9925 int strLen = Jim_Utf8Length(interp, strObjPtr);
9926 Jim_Obj *resultList = 0;
9927 Jim_Obj **resultVec = 0;
9928 int resultc;
9929 Jim_Obj *emptyStr = 0;
9930 ScanFmtStringObj *fmtObj;
9932 /* This should never happen. The format object should already be of the correct type */
9933 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9935 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9936 /* Check if format specification was valid */
9937 if (fmtObj->error != 0) {
9938 if (flags & JIM_ERRMSG)
9939 Jim_SetResultString(interp, fmtObj->error, -1);
9940 return 0;
9942 /* Allocate a new "shared" empty string for all unassigned conversions */
9943 emptyStr = Jim_NewEmptyStringObj(interp);
9944 Jim_IncrRefCount(emptyStr);
9945 /* Create a list and fill it with empty strings up to max specified XPG3 */
9946 resultList = Jim_NewListObj(interp, NULL, 0);
9947 if (fmtObj->maxPos > 0) {
9948 for (i = 0; i < fmtObj->maxPos; ++i)
9949 Jim_ListAppendElement(interp, resultList, emptyStr);
9950 JimListGetElements(interp, resultList, &resultc, &resultVec);
9952 /* Now handle every partial format description */
9953 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9954 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9955 Jim_Obj *value = 0;
9957 /* Only last type may be "literal" w/o conversion - skip it! */
9958 if (descr->type == 0)
9959 continue;
9960 /* As long as any conversion could be done, we will proceed */
9961 if (scanned > 0)
9962 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9963 /* In case our first try results in EOF, we will leave */
9964 if (scanned == -1 && i == 0)
9965 goto eof;
9966 /* Advance next pos-to-be-scanned for the amount scanned already */
9967 pos += scanned;
9969 /* value == 0 means no conversion took place so take empty string */
9970 if (value == 0)
9971 value = Jim_NewEmptyStringObj(interp);
9972 /* If value is a non-assignable one, skip it */
9973 if (descr->pos == -1) {
9974 Jim_FreeNewObj(interp, value);
9976 else if (descr->pos == 0)
9977 /* Otherwise append it to the result list if no XPG3 was given */
9978 Jim_ListAppendElement(interp, resultList, value);
9979 else if (resultVec[descr->pos - 1] == emptyStr) {
9980 /* But due to given XPG3, put the value into the corr. slot */
9981 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9982 Jim_IncrRefCount(value);
9983 resultVec[descr->pos - 1] = value;
9985 else {
9986 /* Otherwise, the slot was already used - free obj and ERROR */
9987 Jim_FreeNewObj(interp, value);
9988 goto err;
9991 Jim_DecrRefCount(interp, emptyStr);
9992 return resultList;
9993 eof:
9994 Jim_DecrRefCount(interp, emptyStr);
9995 Jim_FreeNewObj(interp, resultList);
9996 return (Jim_Obj *)EOF;
9997 err:
9998 Jim_DecrRefCount(interp, emptyStr);
9999 Jim_FreeNewObj(interp, resultList);
10000 return 0;
10003 /* -----------------------------------------------------------------------------
10004 * Pseudo Random Number Generation
10005 * ---------------------------------------------------------------------------*/
10006 /* Initialize the sbox with the numbers from 0 to 255 */
10007 static void JimPrngInit(Jim_Interp *interp)
10009 #define PRNG_SEED_SIZE 256
10010 int i;
10011 unsigned int *seed;
10012 time_t t = time(NULL);
10014 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10016 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10017 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10018 seed[i] = (rand() ^ t ^ clock());
10020 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10021 Jim_Free(seed);
10024 /* Generates N bytes of random data */
10025 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10027 Jim_PrngState *prng;
10028 unsigned char *destByte = (unsigned char *)dest;
10029 unsigned int si, sj, x;
10031 /* initialization, only needed the first time */
10032 if (interp->prngState == NULL)
10033 JimPrngInit(interp);
10034 prng = interp->prngState;
10035 /* generates 'len' bytes of pseudo-random numbers */
10036 for (x = 0; x < len; x++) {
10037 prng->i = (prng->i + 1) & 0xff;
10038 si = prng->sbox[prng->i];
10039 prng->j = (prng->j + si) & 0xff;
10040 sj = prng->sbox[prng->j];
10041 prng->sbox[prng->i] = sj;
10042 prng->sbox[prng->j] = si;
10043 *destByte++ = prng->sbox[(si + sj) & 0xff];
10047 /* Re-seed the generator with user-provided bytes */
10048 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10050 int i;
10051 Jim_PrngState *prng;
10053 /* initialization, only needed the first time */
10054 if (interp->prngState == NULL)
10055 JimPrngInit(interp);
10056 prng = interp->prngState;
10058 /* Set the sbox[i] with i */
10059 for (i = 0; i < 256; i++)
10060 prng->sbox[i] = i;
10061 /* Now use the seed to perform a random permutation of the sbox */
10062 for (i = 0; i < seedLen; i++) {
10063 unsigned char t;
10065 t = prng->sbox[i & 0xFF];
10066 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10067 prng->sbox[seed[i]] = t;
10069 prng->i = prng->j = 0;
10071 /* discard at least the first 256 bytes of stream.
10072 * borrow the seed buffer for this
10074 for (i = 0; i < 256; i += seedLen) {
10075 JimRandomBytes(interp, seed, seedLen);
10079 /* [incr] */
10080 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10082 jim_wide wideValue, increment = 1;
10083 Jim_Obj *intObjPtr;
10085 if (argc != 2 && argc != 3) {
10086 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10087 return JIM_ERR;
10089 if (argc == 3) {
10090 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10091 return JIM_ERR;
10093 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10094 if (!intObjPtr) {
10095 /* Set missing variable to 0 */
10096 wideValue = 0;
10098 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10099 return JIM_ERR;
10101 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10102 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10103 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10104 Jim_FreeNewObj(interp, intObjPtr);
10105 return JIM_ERR;
10108 else {
10109 /* Can do it the quick way */
10110 Jim_InvalidateStringRep(intObjPtr);
10111 JimWideValue(intObjPtr) = wideValue + increment;
10113 /* The following step is required in order to invalidate the
10114 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10115 if (argv[1]->typePtr != &variableObjType) {
10116 /* Note that this can't fail since GetVariable already succeeded */
10117 Jim_SetVariable(interp, argv[1], intObjPtr);
10120 Jim_SetResult(interp, intObjPtr);
10121 return JIM_OK;
10125 /* -----------------------------------------------------------------------------
10126 * Eval
10127 * ---------------------------------------------------------------------------*/
10128 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10129 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10131 /* Handle calls to the [unknown] command */
10132 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10134 int retcode;
10136 /* If JimUnknown() is recursively called too many times...
10137 * done here
10139 if (interp->unknown_called > 50) {
10140 return JIM_ERR;
10143 /* The object interp->unknown just contains
10144 * the "unknown" string, it is used in order to
10145 * avoid to lookup the unknown command every time
10146 * but instead to cache the result. */
10148 /* If the [unknown] command does not exist ... */
10149 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10150 return JIM_ERR;
10152 interp->unknown_called++;
10153 /* XXX: Are we losing fileNameObj and linenr? */
10154 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10155 interp->unknown_called--;
10157 return retcode;
10160 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10162 int retcode;
10163 Jim_Cmd *cmdPtr;
10165 #if 0
10166 printf("invoke");
10167 int j;
10168 for (j = 0; j < objc; j++) {
10169 printf(" '%s'", Jim_String(objv[j]));
10171 printf("\n");
10172 #endif
10174 if (interp->framePtr->tailcallCmd) {
10175 /* Special tailcall command was pre-resolved */
10176 cmdPtr = interp->framePtr->tailcallCmd;
10177 interp->framePtr->tailcallCmd = NULL;
10179 else {
10180 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10181 if (cmdPtr == NULL) {
10182 return JimUnknown(interp, objc, objv);
10184 JimIncrCmdRefCount(cmdPtr);
10187 if (interp->evalDepth == interp->maxEvalDepth) {
10188 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10189 retcode = JIM_ERR;
10190 goto out;
10192 interp->evalDepth++;
10194 /* Call it -- Make sure result is an empty object. */
10195 Jim_SetEmptyResult(interp);
10196 if (cmdPtr->isproc) {
10197 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10199 else {
10200 interp->cmdPrivData = cmdPtr->u.native.privData;
10201 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10203 interp->evalDepth--;
10205 out:
10206 JimDecrCmdRefCount(interp, cmdPtr);
10208 return retcode;
10211 /* Eval the object vector 'objv' composed of 'objc' elements.
10212 * Every element is used as single argument.
10213 * Jim_EvalObj() will call this function every time its object
10214 * argument is of "list" type, with no string representation.
10216 * This is possible because the string representation of a
10217 * list object generated by the UpdateStringOfList is made
10218 * in a way that ensures that every list element is a different
10219 * command argument. */
10220 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10222 int i, retcode;
10224 /* Incr refcount of arguments. */
10225 for (i = 0; i < objc; i++)
10226 Jim_IncrRefCount(objv[i]);
10228 retcode = JimInvokeCommand(interp, objc, objv);
10230 /* Decr refcount of arguments and return the retcode */
10231 for (i = 0; i < objc; i++)
10232 Jim_DecrRefCount(interp, objv[i]);
10234 return retcode;
10238 * Invokes 'prefix' as a command with the objv array as arguments.
10240 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10242 int ret;
10243 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10245 nargv[0] = prefix;
10246 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10247 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10248 Jim_Free(nargv);
10249 return ret;
10252 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10254 if (!interp->errorFlag) {
10255 /* This is the first error, so save the file/line information and reset the stack */
10256 interp->errorFlag = 1;
10257 Jim_IncrRefCount(script->fileNameObj);
10258 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10259 interp->errorFileNameObj = script->fileNameObj;
10260 interp->errorLine = script->linenr;
10262 JimResetStackTrace(interp);
10263 /* Always add a level where the error first occurs */
10264 interp->addStackTrace++;
10267 /* Now if this is an "interesting" level, add it to the stack trace */
10268 if (interp->addStackTrace > 0) {
10269 /* Add the stack info for the current level */
10271 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10273 /* Note: if we didn't have a filename for this level,
10274 * don't clear the addStackTrace flag
10275 * so we can pick it up at the next level
10277 if (Jim_Length(script->fileNameObj)) {
10278 interp->addStackTrace = 0;
10281 Jim_DecrRefCount(interp, interp->errorProc);
10282 interp->errorProc = interp->emptyObj;
10283 Jim_IncrRefCount(interp->errorProc);
10287 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10289 Jim_Obj *objPtr;
10291 switch (token->type) {
10292 case JIM_TT_STR:
10293 case JIM_TT_ESC:
10294 objPtr = token->objPtr;
10295 break;
10296 case JIM_TT_VAR:
10297 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10298 break;
10299 case JIM_TT_DICTSUGAR:
10300 objPtr = JimExpandDictSugar(interp, token->objPtr);
10301 break;
10302 case JIM_TT_EXPRSUGAR:
10303 objPtr = JimExpandExprSugar(interp, token->objPtr);
10304 break;
10305 case JIM_TT_CMD:
10306 switch (Jim_EvalObj(interp, token->objPtr)) {
10307 case JIM_OK:
10308 case JIM_RETURN:
10309 objPtr = interp->result;
10310 break;
10311 case JIM_BREAK:
10312 /* Stop substituting */
10313 return JIM_BREAK;
10314 case JIM_CONTINUE:
10315 /* just skip this one */
10316 return JIM_CONTINUE;
10317 default:
10318 return JIM_ERR;
10320 break;
10321 default:
10322 JimPanic((1,
10323 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10324 objPtr = NULL;
10325 break;
10327 if (objPtr) {
10328 *objPtrPtr = objPtr;
10329 return JIM_OK;
10331 return JIM_ERR;
10334 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10335 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10336 * The returned object has refcount = 0.
10338 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10340 int totlen = 0, i;
10341 Jim_Obj **intv;
10342 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10343 Jim_Obj *objPtr;
10344 char *s;
10346 if (tokens <= JIM_EVAL_SINTV_LEN)
10347 intv = sintv;
10348 else
10349 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10351 /* Compute every token forming the argument
10352 * in the intv objects vector. */
10353 for (i = 0; i < tokens; i++) {
10354 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10355 case JIM_OK:
10356 case JIM_RETURN:
10357 break;
10358 case JIM_BREAK:
10359 if (flags & JIM_SUBST_FLAG) {
10360 /* Stop here */
10361 tokens = i;
10362 continue;
10364 /* XXX: Should probably set an error about break outside loop */
10365 /* fall through to error */
10366 case JIM_CONTINUE:
10367 if (flags & JIM_SUBST_FLAG) {
10368 intv[i] = NULL;
10369 continue;
10371 /* XXX: Ditto continue outside loop */
10372 /* fall through to error */
10373 default:
10374 while (i--) {
10375 Jim_DecrRefCount(interp, intv[i]);
10377 if (intv != sintv) {
10378 Jim_Free(intv);
10380 return NULL;
10382 Jim_IncrRefCount(intv[i]);
10383 Jim_String(intv[i]);
10384 totlen += intv[i]->length;
10387 /* Fast path return for a single token */
10388 if (tokens == 1 && intv[0] && intv == sintv) {
10389 Jim_DecrRefCount(interp, intv[0]);
10390 return intv[0];
10393 /* Concatenate every token in an unique
10394 * object. */
10395 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10397 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10398 && token[2].type == JIM_TT_VAR) {
10399 /* May be able to do fast interpolated object -> dictSubst */
10400 objPtr->typePtr = &interpolatedObjType;
10401 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10402 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10403 Jim_IncrRefCount(intv[2]);
10405 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10406 /* The first interpolated token is source, so preserve the source info */
10407 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10411 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10412 objPtr->length = totlen;
10413 for (i = 0; i < tokens; i++) {
10414 if (intv[i]) {
10415 memcpy(s, intv[i]->bytes, intv[i]->length);
10416 s += intv[i]->length;
10417 Jim_DecrRefCount(interp, intv[i]);
10420 objPtr->bytes[totlen] = '\0';
10421 /* Free the intv vector if not static. */
10422 if (intv != sintv) {
10423 Jim_Free(intv);
10426 return objPtr;
10430 /* listPtr *must* be a list.
10431 * The contents of the list is evaluated with the first element as the command and
10432 * the remaining elements as the arguments.
10434 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10436 int retcode = JIM_OK;
10438 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10440 if (listPtr->internalRep.listValue.len) {
10441 Jim_IncrRefCount(listPtr);
10442 retcode = JimInvokeCommand(interp,
10443 listPtr->internalRep.listValue.len,
10444 listPtr->internalRep.listValue.ele);
10445 Jim_DecrRefCount(interp, listPtr);
10447 return retcode;
10450 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10452 SetListFromAny(interp, listPtr);
10453 return JimEvalObjList(interp, listPtr);
10456 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10458 int i;
10459 ScriptObj *script;
10460 ScriptToken *token;
10461 int retcode = JIM_OK;
10462 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10463 Jim_Obj *prevScriptObj;
10465 /* If the object is of type "list", with no string rep we can call
10466 * a specialized version of Jim_EvalObj() */
10467 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10468 return JimEvalObjList(interp, scriptObjPtr);
10471 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10472 script = JimGetScript(interp, scriptObjPtr);
10473 if (!JimScriptValid(interp, script)) {
10474 Jim_DecrRefCount(interp, scriptObjPtr);
10475 return JIM_ERR;
10478 /* Reset the interpreter result. This is useful to
10479 * return the empty result in the case of empty program. */
10480 Jim_SetEmptyResult(interp);
10482 token = script->token;
10484 #ifdef JIM_OPTIMIZATION
10485 /* Check for one of the following common scripts used by for, while
10487 * {}
10488 * incr a
10490 if (script->len == 0) {
10491 Jim_DecrRefCount(interp, scriptObjPtr);
10492 return JIM_OK;
10494 if (script->len == 3
10495 && token[1].objPtr->typePtr == &commandObjType
10496 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10497 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10498 && token[2].objPtr->typePtr == &variableObjType) {
10500 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10502 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10503 JimWideValue(objPtr)++;
10504 Jim_InvalidateStringRep(objPtr);
10505 Jim_DecrRefCount(interp, scriptObjPtr);
10506 Jim_SetResult(interp, objPtr);
10507 return JIM_OK;
10510 #endif
10512 /* Now we have to make sure the internal repr will not be
10513 * freed on shimmering.
10515 * Think for example to this:
10517 * set x {llength $x; ... some more code ...}; eval $x
10519 * In order to preserve the internal rep, we increment the
10520 * inUse field of the script internal rep structure. */
10521 script->inUse++;
10523 /* Stash the current script */
10524 prevScriptObj = interp->currentScriptObj;
10525 interp->currentScriptObj = scriptObjPtr;
10527 interp->errorFlag = 0;
10528 argv = sargv;
10530 /* Execute every command sequentially until the end of the script
10531 * or an error occurs.
10533 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10534 int argc;
10535 int j;
10537 /* First token of the line is always JIM_TT_LINE */
10538 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10539 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10541 /* Allocate the arguments vector if required */
10542 if (argc > JIM_EVAL_SARGV_LEN)
10543 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10545 /* Skip the JIM_TT_LINE token */
10546 i++;
10548 /* Populate the arguments objects.
10549 * If an error occurs, retcode will be set and
10550 * 'j' will be set to the number of args expanded
10552 for (j = 0; j < argc; j++) {
10553 long wordtokens = 1;
10554 int expand = 0;
10555 Jim_Obj *wordObjPtr = NULL;
10557 if (token[i].type == JIM_TT_WORD) {
10558 wordtokens = JimWideValue(token[i++].objPtr);
10559 if (wordtokens < 0) {
10560 expand = 1;
10561 wordtokens = -wordtokens;
10565 if (wordtokens == 1) {
10566 /* Fast path if the token does not
10567 * need interpolation */
10569 switch (token[i].type) {
10570 case JIM_TT_ESC:
10571 case JIM_TT_STR:
10572 wordObjPtr = token[i].objPtr;
10573 break;
10574 case JIM_TT_VAR:
10575 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10576 break;
10577 case JIM_TT_EXPRSUGAR:
10578 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10579 break;
10580 case JIM_TT_DICTSUGAR:
10581 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10582 break;
10583 case JIM_TT_CMD:
10584 retcode = Jim_EvalObj(interp, token[i].objPtr);
10585 if (retcode == JIM_OK) {
10586 wordObjPtr = Jim_GetResult(interp);
10588 break;
10589 default:
10590 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10593 else {
10594 /* For interpolation we call a helper
10595 * function to do the work for us. */
10596 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10599 if (!wordObjPtr) {
10600 if (retcode == JIM_OK) {
10601 retcode = JIM_ERR;
10603 break;
10606 Jim_IncrRefCount(wordObjPtr);
10607 i += wordtokens;
10609 if (!expand) {
10610 argv[j] = wordObjPtr;
10612 else {
10613 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10614 int len = Jim_ListLength(interp, wordObjPtr);
10615 int newargc = argc + len - 1;
10616 int k;
10618 if (len > 1) {
10619 if (argv == sargv) {
10620 if (newargc > JIM_EVAL_SARGV_LEN) {
10621 argv = Jim_Alloc(sizeof(*argv) * newargc);
10622 memcpy(argv, sargv, sizeof(*argv) * j);
10625 else {
10626 /* Need to realloc to make room for (len - 1) more entries */
10627 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10631 /* Now copy in the expanded version */
10632 for (k = 0; k < len; k++) {
10633 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10634 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10637 /* The original object reference is no longer needed,
10638 * after the expansion it is no longer present on
10639 * the argument vector, but the single elements are
10640 * in its place. */
10641 Jim_DecrRefCount(interp, wordObjPtr);
10643 /* And update the indexes */
10644 j--;
10645 argc += len - 1;
10649 if (retcode == JIM_OK && argc) {
10650 /* Invoke the command */
10651 retcode = JimInvokeCommand(interp, argc, argv);
10652 /* Check for a signal after each command */
10653 if (Jim_CheckSignal(interp)) {
10654 retcode = JIM_SIGNAL;
10658 /* Finished with the command, so decrement ref counts of each argument */
10659 while (j-- > 0) {
10660 Jim_DecrRefCount(interp, argv[j]);
10663 if (argv != sargv) {
10664 Jim_Free(argv);
10665 argv = sargv;
10669 /* Possibly add to the error stack trace */
10670 if (retcode == JIM_ERR) {
10671 JimAddErrorToStack(interp, script);
10673 /* Propagate the addStackTrace value through 'return -code error' */
10674 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10675 /* No need to add stack trace */
10676 interp->addStackTrace = 0;
10679 /* Restore the current script */
10680 interp->currentScriptObj = prevScriptObj;
10682 /* Note that we don't have to decrement inUse, because the
10683 * following code transfers our use of the reference again to
10684 * the script object. */
10685 Jim_FreeIntRep(interp, scriptObjPtr);
10686 scriptObjPtr->typePtr = &scriptObjType;
10687 Jim_SetIntRepPtr(scriptObjPtr, script);
10688 Jim_DecrRefCount(interp, scriptObjPtr);
10690 return retcode;
10693 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10695 int retcode;
10696 /* If argObjPtr begins with '&', do an automatic upvar */
10697 const char *varname = Jim_String(argNameObj);
10698 if (*varname == '&') {
10699 /* First check that the target variable exists */
10700 Jim_Obj *objPtr;
10701 Jim_CallFrame *savedCallFrame = interp->framePtr;
10703 interp->framePtr = interp->framePtr->parent;
10704 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10705 interp->framePtr = savedCallFrame;
10706 if (!objPtr) {
10707 return JIM_ERR;
10710 /* It exists, so perform the binding. */
10711 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10712 Jim_IncrRefCount(objPtr);
10713 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10714 Jim_DecrRefCount(interp, objPtr);
10716 else {
10717 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10719 return retcode;
10723 * Sets the interp result to be an error message indicating the required proc args.
10725 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10727 /* Create a nice error message, consistent with Tcl 8.5 */
10728 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10729 int i;
10731 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10732 Jim_AppendString(interp, argmsg, " ", 1);
10734 if (i == cmd->u.proc.argsPos) {
10735 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10736 /* Renamed args */
10737 Jim_AppendString(interp, argmsg, "?", 1);
10738 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10739 Jim_AppendString(interp, argmsg, " ...?", -1);
10741 else {
10742 /* We have plain args */
10743 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10746 else {
10747 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10748 Jim_AppendString(interp, argmsg, "?", 1);
10749 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10750 Jim_AppendString(interp, argmsg, "?", 1);
10752 else {
10753 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10754 if (*arg == '&') {
10755 arg++;
10757 Jim_AppendString(interp, argmsg, arg, -1);
10761 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10762 Jim_FreeNewObj(interp, argmsg);
10765 #ifdef jim_ext_namespace
10767 * [namespace eval]
10769 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10771 Jim_CallFrame *callFramePtr;
10772 int retcode;
10774 /* Create a new callframe */
10775 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10776 callFramePtr->argv = &interp->emptyObj;
10777 callFramePtr->argc = 0;
10778 callFramePtr->procArgsObjPtr = NULL;
10779 callFramePtr->procBodyObjPtr = scriptObj;
10780 callFramePtr->staticVars = NULL;
10781 callFramePtr->fileNameObj = interp->emptyObj;
10782 callFramePtr->line = 0;
10783 Jim_IncrRefCount(scriptObj);
10784 interp->framePtr = callFramePtr;
10786 /* Check if there are too nested calls */
10787 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10788 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10789 retcode = JIM_ERR;
10791 else {
10792 /* Eval the body */
10793 retcode = Jim_EvalObj(interp, scriptObj);
10796 /* Destroy the callframe */
10797 interp->framePtr = interp->framePtr->parent;
10798 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10800 return retcode;
10802 #endif
10804 /* Call a procedure implemented in Tcl.
10805 * It's possible to speed-up a lot this function, currently
10806 * the callframes are not cached, but allocated and
10807 * destroied every time. What is expecially costly is
10808 * to create/destroy the local vars hash table every time.
10810 * This can be fixed just implementing callframes caching
10811 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10812 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10814 Jim_CallFrame *callFramePtr;
10815 int i, d, retcode, optargs;
10816 ScriptObj *script;
10818 /* Check arity */
10819 if (argc - 1 < cmd->u.proc.reqArity ||
10820 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10821 JimSetProcWrongArgs(interp, argv[0], cmd);
10822 return JIM_ERR;
10825 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10826 /* Optimise for procedure with no body - useful for optional debugging */
10827 return JIM_OK;
10830 /* Check if there are too nested calls */
10831 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10832 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10833 return JIM_ERR;
10836 /* Create a new callframe */
10837 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10838 callFramePtr->argv = argv;
10839 callFramePtr->argc = argc;
10840 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10841 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10842 callFramePtr->staticVars = cmd->u.proc.staticVars;
10844 /* Remember where we were called from. */
10845 script = JimGetScript(interp, interp->currentScriptObj);
10846 callFramePtr->fileNameObj = script->fileNameObj;
10847 callFramePtr->line = script->linenr;
10849 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10850 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10851 interp->framePtr = callFramePtr;
10853 /* How many optional args are available */
10854 optargs = (argc - 1 - cmd->u.proc.reqArity);
10856 /* Step 'i' along the actual args, and step 'd' along the formal args */
10857 i = 1;
10858 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10859 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10860 if (d == cmd->u.proc.argsPos) {
10861 /* assign $args */
10862 Jim_Obj *listObjPtr;
10863 int argsLen = 0;
10864 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10865 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10867 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10869 /* It is possible to rename args. */
10870 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10871 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10873 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10874 if (retcode != JIM_OK) {
10875 goto badargset;
10878 i += argsLen;
10879 continue;
10882 /* Optional or required? */
10883 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10884 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10886 else {
10887 /* Ran out, so use the default */
10888 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10890 if (retcode != JIM_OK) {
10891 goto badargset;
10895 /* Eval the body */
10896 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10898 badargset:
10900 /* Free the callframe */
10901 interp->framePtr = interp->framePtr->parent;
10902 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10904 /* Now chain any tailcalls in the parent frame */
10905 if (interp->framePtr->tailcallObj) {
10906 do {
10907 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10909 interp->framePtr->tailcallObj = NULL;
10911 if (retcode == JIM_EVAL) {
10912 retcode = Jim_EvalObjList(interp, tailcallObj);
10913 if (retcode == JIM_RETURN) {
10914 /* If the result of the tailcall is 'return', push
10915 * it up to the caller
10917 interp->returnLevel++;
10920 Jim_DecrRefCount(interp, tailcallObj);
10921 } while (interp->framePtr->tailcallObj);
10923 /* If the tailcall chain finished early, may need to manually discard the command */
10924 if (interp->framePtr->tailcallCmd) {
10925 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10926 interp->framePtr->tailcallCmd = NULL;
10930 /* Handle the JIM_RETURN return code */
10931 if (retcode == JIM_RETURN) {
10932 if (--interp->returnLevel <= 0) {
10933 retcode = interp->returnCode;
10934 interp->returnCode = JIM_OK;
10935 interp->returnLevel = 0;
10938 else if (retcode == JIM_ERR) {
10939 interp->addStackTrace++;
10940 Jim_DecrRefCount(interp, interp->errorProc);
10941 interp->errorProc = argv[0];
10942 Jim_IncrRefCount(interp->errorProc);
10945 return retcode;
10948 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10950 int retval;
10951 Jim_Obj *scriptObjPtr;
10953 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10954 Jim_IncrRefCount(scriptObjPtr);
10956 if (filename) {
10957 Jim_Obj *prevScriptObj;
10959 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10961 prevScriptObj = interp->currentScriptObj;
10962 interp->currentScriptObj = scriptObjPtr;
10964 retval = Jim_EvalObj(interp, scriptObjPtr);
10966 interp->currentScriptObj = prevScriptObj;
10968 else {
10969 retval = Jim_EvalObj(interp, scriptObjPtr);
10971 Jim_DecrRefCount(interp, scriptObjPtr);
10972 return retval;
10975 int Jim_Eval(Jim_Interp *interp, const char *script)
10977 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10980 /* Execute script in the scope of the global level */
10981 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10983 int retval;
10984 Jim_CallFrame *savedFramePtr = interp->framePtr;
10986 interp->framePtr = interp->topFramePtr;
10987 retval = Jim_Eval(interp, script);
10988 interp->framePtr = savedFramePtr;
10990 return retval;
10993 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10995 int retval;
10996 Jim_CallFrame *savedFramePtr = interp->framePtr;
10998 interp->framePtr = interp->topFramePtr;
10999 retval = Jim_EvalFile(interp, filename);
11000 interp->framePtr = savedFramePtr;
11002 return retval;
11005 #include <sys/stat.h>
11007 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11009 FILE *fp;
11010 char *buf;
11011 Jim_Obj *scriptObjPtr;
11012 Jim_Obj *prevScriptObj;
11013 struct stat sb;
11014 int retcode;
11015 int readlen;
11017 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11018 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11019 return JIM_ERR;
11021 if (sb.st_size == 0) {
11022 fclose(fp);
11023 return JIM_OK;
11026 buf = Jim_Alloc(sb.st_size + 1);
11027 readlen = fread(buf, 1, sb.st_size, fp);
11028 if (ferror(fp)) {
11029 fclose(fp);
11030 Jim_Free(buf);
11031 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11032 return JIM_ERR;
11034 fclose(fp);
11035 buf[readlen] = 0;
11037 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11038 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11039 Jim_IncrRefCount(scriptObjPtr);
11041 prevScriptObj = interp->currentScriptObj;
11042 interp->currentScriptObj = scriptObjPtr;
11044 retcode = Jim_EvalObj(interp, scriptObjPtr);
11046 /* Handle the JIM_RETURN return code */
11047 if (retcode == JIM_RETURN) {
11048 if (--interp->returnLevel <= 0) {
11049 retcode = interp->returnCode;
11050 interp->returnCode = JIM_OK;
11051 interp->returnLevel = 0;
11054 if (retcode == JIM_ERR) {
11055 /* EvalFile changes context, so add a stack frame here */
11056 interp->addStackTrace++;
11059 interp->currentScriptObj = prevScriptObj;
11061 Jim_DecrRefCount(interp, scriptObjPtr);
11063 return retcode;
11066 /* -----------------------------------------------------------------------------
11067 * Subst
11068 * ---------------------------------------------------------------------------*/
11069 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11071 pc->tstart = pc->p;
11072 pc->tline = pc->linenr;
11074 if (pc->len == 0) {
11075 pc->tend = pc->p;
11076 pc->tt = JIM_TT_EOL;
11077 pc->eof = 1;
11078 return;
11080 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11081 JimParseCmd(pc);
11082 return;
11084 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11085 if (JimParseVar(pc) == JIM_OK) {
11086 return;
11088 /* Not a var, so treat as a string */
11089 pc->tstart = pc->p;
11090 flags |= JIM_SUBST_NOVAR;
11092 while (pc->len) {
11093 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11094 break;
11096 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11097 break;
11099 if (*pc->p == '\\' && pc->len > 1) {
11100 pc->p++;
11101 pc->len--;
11103 pc->p++;
11104 pc->len--;
11106 pc->tend = pc->p - 1;
11107 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11110 /* The subst object type reuses most of the data structures and functions
11111 * of the script object. Script's data structures are a bit more complex
11112 * for what is needed for [subst]itution tasks, but the reuse helps to
11113 * deal with a single data structure at the cost of some more memory
11114 * usage for substitutions. */
11116 /* This method takes the string representation of an object
11117 * as a Tcl string where to perform [subst]itution, and generates
11118 * the pre-parsed internal representation. */
11119 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11121 int scriptTextLen;
11122 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11123 struct JimParserCtx parser;
11124 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11125 ParseTokenList tokenlist;
11127 /* Initially parse the subst into tokens (in tokenlist) */
11128 ScriptTokenListInit(&tokenlist);
11130 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11131 while (1) {
11132 JimParseSubst(&parser, flags);
11133 if (parser.eof) {
11134 /* Note that subst doesn't need the EOL token */
11135 break;
11137 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11138 parser.tline);
11141 /* Create the "real" subst/script tokens from the initial token list */
11142 script->inUse = 1;
11143 script->substFlags = flags;
11144 script->fileNameObj = interp->emptyObj;
11145 Jim_IncrRefCount(script->fileNameObj);
11146 SubstObjAddTokens(interp, script, &tokenlist);
11148 /* No longer need the token list */
11149 ScriptTokenListFree(&tokenlist);
11151 #ifdef DEBUG_SHOW_SUBST
11153 int i;
11155 printf("==== Subst ====\n");
11156 for (i = 0; i < script->len; i++) {
11157 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11158 Jim_String(script->token[i].objPtr));
11161 #endif
11163 /* Free the old internal rep and set the new one. */
11164 Jim_FreeIntRep(interp, objPtr);
11165 Jim_SetIntRepPtr(objPtr, script);
11166 objPtr->typePtr = &scriptObjType;
11167 return JIM_OK;
11170 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11172 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11173 SetSubstFromAny(interp, objPtr, flags);
11174 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11177 /* Performs commands,variables,blackslashes substitution,
11178 * storing the result object (with refcount 0) into
11179 * resObjPtrPtr. */
11180 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11182 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11184 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11185 /* In order to preserve the internal rep, we increment the
11186 * inUse field of the script internal rep structure. */
11187 script->inUse++;
11189 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11191 script->inUse--;
11192 Jim_DecrRefCount(interp, substObjPtr);
11193 if (*resObjPtrPtr == NULL) {
11194 return JIM_ERR;
11196 return JIM_OK;
11199 /* -----------------------------------------------------------------------------
11200 * Core commands utility functions
11201 * ---------------------------------------------------------------------------*/
11202 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11204 Jim_Obj *objPtr;
11205 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11207 if (*msg) {
11208 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11210 Jim_IncrRefCount(listObjPtr);
11211 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11212 Jim_DecrRefCount(interp, listObjPtr);
11214 Jim_IncrRefCount(objPtr);
11215 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11216 Jim_DecrRefCount(interp, objPtr);
11220 * May add the key and/or value to the list.
11222 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11223 Jim_HashEntry *he, int type);
11225 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11228 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11229 * invoke the callback to add entries to a list.
11230 * Returns the list.
11232 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11233 JimHashtableIteratorCallbackType *callback, int type)
11235 Jim_HashEntry *he;
11236 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11238 /* Check for the non-pattern case. We can do this much more efficiently. */
11239 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11240 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11241 if (he) {
11242 callback(interp, listObjPtr, he, type);
11245 else {
11246 Jim_HashTableIterator htiter;
11247 JimInitHashTableIterator(ht, &htiter);
11248 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11249 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11250 callback(interp, listObjPtr, he, type);
11254 return listObjPtr;
11257 /* Keep these in order */
11258 #define JIM_CMDLIST_COMMANDS 0
11259 #define JIM_CMDLIST_PROCS 1
11260 #define JIM_CMDLIST_CHANNELS 2
11263 * Adds matching command names (procs, channels) to the list.
11265 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11266 Jim_HashEntry *he, int type)
11268 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11269 Jim_Obj *objPtr;
11271 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11272 /* not a proc */
11273 return;
11276 objPtr = Jim_NewStringObj(interp, he->key, -1);
11277 Jim_IncrRefCount(objPtr);
11279 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11280 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11282 Jim_DecrRefCount(interp, objPtr);
11285 /* type is JIM_CMDLIST_xxx */
11286 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11288 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11291 /* Keep these in order */
11292 #define JIM_VARLIST_GLOBALS 0
11293 #define JIM_VARLIST_LOCALS 1
11294 #define JIM_VARLIST_VARS 2
11296 #define JIM_VARLIST_VALUES 0x1000
11299 * Adds matching variable names to the list.
11301 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11302 Jim_HashEntry *he, int type)
11304 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11306 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11307 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11308 if (type & JIM_VARLIST_VALUES) {
11309 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11314 /* mode is JIM_VARLIST_xxx */
11315 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11317 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11318 /* For [info locals], if we are at top level an emtpy list
11319 * is returned. I don't agree, but we aim at compatibility (SS) */
11320 return interp->emptyObj;
11322 else {
11323 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11324 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11328 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11329 Jim_Obj **objPtrPtr, int info_level_cmd)
11331 Jim_CallFrame *targetCallFrame;
11333 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11334 if (targetCallFrame == NULL) {
11335 return JIM_ERR;
11337 /* No proc call at toplevel callframe */
11338 if (targetCallFrame == interp->topFramePtr) {
11339 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11340 return JIM_ERR;
11342 if (info_level_cmd) {
11343 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11345 else {
11346 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11348 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11349 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11350 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11351 *objPtrPtr = listObj;
11353 return JIM_OK;
11356 /* -----------------------------------------------------------------------------
11357 * Core commands
11358 * ---------------------------------------------------------------------------*/
11360 /* fake [puts] -- not the real puts, just for debugging. */
11361 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11363 if (argc != 2 && argc != 3) {
11364 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11365 return JIM_ERR;
11367 if (argc == 3) {
11368 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11369 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11370 return JIM_ERR;
11372 else {
11373 fputs(Jim_String(argv[2]), stdout);
11376 else {
11377 puts(Jim_String(argv[1]));
11379 return JIM_OK;
11382 /* Helper for [+] and [*] */
11383 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11385 jim_wide wideValue, res;
11386 double doubleValue, doubleRes;
11387 int i;
11389 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11391 for (i = 1; i < argc; i++) {
11392 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11393 goto trydouble;
11394 if (op == JIM_EXPROP_ADD)
11395 res += wideValue;
11396 else
11397 res *= wideValue;
11399 Jim_SetResultInt(interp, res);
11400 return JIM_OK;
11401 trydouble:
11402 doubleRes = (double)res;
11403 for (; i < argc; i++) {
11404 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11405 return JIM_ERR;
11406 if (op == JIM_EXPROP_ADD)
11407 doubleRes += doubleValue;
11408 else
11409 doubleRes *= doubleValue;
11411 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11412 return JIM_OK;
11415 /* Helper for [-] and [/] */
11416 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11418 jim_wide wideValue, res = 0;
11419 double doubleValue, doubleRes = 0;
11420 int i = 2;
11422 if (argc < 2) {
11423 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11424 return JIM_ERR;
11426 else if (argc == 2) {
11427 /* The arity = 2 case is different. For [- x] returns -x,
11428 * while [/ x] returns 1/x. */
11429 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11430 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11431 return JIM_ERR;
11433 else {
11434 if (op == JIM_EXPROP_SUB)
11435 doubleRes = -doubleValue;
11436 else
11437 doubleRes = 1.0 / doubleValue;
11438 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11439 return JIM_OK;
11442 if (op == JIM_EXPROP_SUB) {
11443 res = -wideValue;
11444 Jim_SetResultInt(interp, res);
11446 else {
11447 doubleRes = 1.0 / wideValue;
11448 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11450 return JIM_OK;
11452 else {
11453 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11454 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11455 != JIM_OK) {
11456 return JIM_ERR;
11458 else {
11459 goto trydouble;
11463 for (i = 2; i < argc; i++) {
11464 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11465 doubleRes = (double)res;
11466 goto trydouble;
11468 if (op == JIM_EXPROP_SUB)
11469 res -= wideValue;
11470 else
11471 res /= wideValue;
11473 Jim_SetResultInt(interp, res);
11474 return JIM_OK;
11475 trydouble:
11476 for (; i < argc; i++) {
11477 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11478 return JIM_ERR;
11479 if (op == JIM_EXPROP_SUB)
11480 doubleRes -= doubleValue;
11481 else
11482 doubleRes /= doubleValue;
11484 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11485 return JIM_OK;
11489 /* [+] */
11490 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11492 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11495 /* [*] */
11496 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11498 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11501 /* [-] */
11502 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11504 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11507 /* [/] */
11508 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11510 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11513 /* [set] */
11514 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11516 if (argc != 2 && argc != 3) {
11517 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11518 return JIM_ERR;
11520 if (argc == 2) {
11521 Jim_Obj *objPtr;
11523 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11524 if (!objPtr)
11525 return JIM_ERR;
11526 Jim_SetResult(interp, objPtr);
11527 return JIM_OK;
11529 /* argc == 3 case. */
11530 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11531 return JIM_ERR;
11532 Jim_SetResult(interp, argv[2]);
11533 return JIM_OK;
11536 /* [unset]
11538 * unset ?-nocomplain? ?--? ?varName ...?
11540 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11542 int i = 1;
11543 int complain = 1;
11545 while (i < argc) {
11546 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11547 i++;
11548 break;
11550 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11551 complain = 0;
11552 i++;
11553 continue;
11555 break;
11558 while (i < argc) {
11559 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11560 && complain) {
11561 return JIM_ERR;
11563 i++;
11565 return JIM_OK;
11568 /* [while] */
11569 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11571 if (argc != 3) {
11572 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11573 return JIM_ERR;
11576 /* The general purpose implementation of while starts here */
11577 while (1) {
11578 int boolean, retval;
11580 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11581 return retval;
11582 if (!boolean)
11583 break;
11585 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11586 switch (retval) {
11587 case JIM_BREAK:
11588 goto out;
11589 break;
11590 case JIM_CONTINUE:
11591 continue;
11592 break;
11593 default:
11594 return retval;
11598 out:
11599 Jim_SetEmptyResult(interp);
11600 return JIM_OK;
11603 /* [for] */
11604 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11606 int retval;
11607 int boolean = 1;
11608 Jim_Obj *varNamePtr = NULL;
11609 Jim_Obj *stopVarNamePtr = NULL;
11611 if (argc != 5) {
11612 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11613 return JIM_ERR;
11616 /* Do the initialisation */
11617 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11618 return retval;
11621 /* And do the first test now. Better for optimisation
11622 * if we can do next/test at the bottom of the loop
11624 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11626 /* Ready to do the body as follows:
11627 * while (1) {
11628 * body // check retcode
11629 * next // check retcode
11630 * test // check retcode/test bool
11634 #ifdef JIM_OPTIMIZATION
11635 /* Check if the for is on the form:
11636 * for ... {$i < CONST} {incr i}
11637 * for ... {$i < $j} {incr i}
11639 if (retval == JIM_OK && boolean) {
11640 ScriptObj *incrScript;
11641 ExprByteCode *expr;
11642 jim_wide stop, currentVal;
11643 Jim_Obj *objPtr;
11644 int cmpOffset;
11646 /* Do it only if there aren't shared arguments */
11647 expr = JimGetExpression(interp, argv[2]);
11648 incrScript = JimGetScript(interp, argv[3]);
11650 /* Ensure proper lengths to start */
11651 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11652 goto evalstart;
11654 /* Ensure proper token types. */
11655 if (incrScript->token[1].type != JIM_TT_ESC ||
11656 expr->token[0].type != JIM_TT_VAR ||
11657 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11658 goto evalstart;
11661 if (expr->token[2].type == JIM_EXPROP_LT) {
11662 cmpOffset = 0;
11664 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11665 cmpOffset = 1;
11667 else {
11668 goto evalstart;
11671 /* Update command must be incr */
11672 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11673 goto evalstart;
11676 /* incr, expression must be about the same variable */
11677 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11678 goto evalstart;
11681 /* Get the stop condition (must be a variable or integer) */
11682 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11683 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11684 goto evalstart;
11687 else {
11688 stopVarNamePtr = expr->token[1].objPtr;
11689 Jim_IncrRefCount(stopVarNamePtr);
11690 /* Keep the compiler happy */
11691 stop = 0;
11694 /* Initialization */
11695 varNamePtr = expr->token[0].objPtr;
11696 Jim_IncrRefCount(varNamePtr);
11698 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11699 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11700 goto testcond;
11703 /* --- OPTIMIZED FOR --- */
11704 while (retval == JIM_OK) {
11705 /* === Check condition === */
11706 /* Note that currentVal is already set here */
11708 /* Immediate or Variable? get the 'stop' value if the latter. */
11709 if (stopVarNamePtr) {
11710 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11711 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11712 goto testcond;
11716 if (currentVal >= stop + cmpOffset) {
11717 break;
11720 /* Eval body */
11721 retval = Jim_EvalObj(interp, argv[4]);
11722 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11723 retval = JIM_OK;
11725 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11727 /* Increment */
11728 if (objPtr == NULL) {
11729 retval = JIM_ERR;
11730 goto out;
11732 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11733 currentVal = ++JimWideValue(objPtr);
11734 Jim_InvalidateStringRep(objPtr);
11736 else {
11737 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11738 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11739 ++currentVal)) != JIM_OK) {
11740 goto evalnext;
11745 goto out;
11747 evalstart:
11748 #endif
11750 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11751 /* Body */
11752 retval = Jim_EvalObj(interp, argv[4]);
11754 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11755 /* increment */
11756 evalnext:
11757 retval = Jim_EvalObj(interp, argv[3]);
11758 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11759 /* test */
11760 testcond:
11761 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11765 out:
11766 if (stopVarNamePtr) {
11767 Jim_DecrRefCount(interp, stopVarNamePtr);
11769 if (varNamePtr) {
11770 Jim_DecrRefCount(interp, varNamePtr);
11773 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11774 Jim_SetEmptyResult(interp);
11775 return JIM_OK;
11778 return retval;
11781 /* [loop] */
11782 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11784 int retval;
11785 jim_wide i;
11786 jim_wide limit;
11787 jim_wide incr = 1;
11788 Jim_Obj *bodyObjPtr;
11790 if (argc != 5 && argc != 6) {
11791 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11792 return JIM_ERR;
11795 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11796 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11797 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11798 return JIM_ERR;
11800 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11802 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11804 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11805 retval = Jim_EvalObj(interp, bodyObjPtr);
11806 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11807 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11809 retval = JIM_OK;
11811 /* Increment */
11812 i += incr;
11814 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11815 if (argv[1]->typePtr != &variableObjType) {
11816 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11817 return JIM_ERR;
11820 JimWideValue(objPtr) = i;
11821 Jim_InvalidateStringRep(objPtr);
11823 /* The following step is required in order to invalidate the
11824 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11825 if (argv[1]->typePtr != &variableObjType) {
11826 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11827 retval = JIM_ERR;
11828 break;
11832 else {
11833 objPtr = Jim_NewIntObj(interp, i);
11834 retval = Jim_SetVariable(interp, argv[1], objPtr);
11835 if (retval != JIM_OK) {
11836 Jim_FreeNewObj(interp, objPtr);
11842 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11843 Jim_SetEmptyResult(interp);
11844 return JIM_OK;
11846 return retval;
11849 /* List iterators make it easy to iterate over a list.
11850 * At some point iterators will be expanded to support generators.
11852 typedef struct {
11853 Jim_Obj *objPtr;
11854 int idx;
11855 } Jim_ListIter;
11858 * Initialise the iterator at the start of the list.
11860 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11862 iter->objPtr = objPtr;
11863 iter->idx = 0;
11867 * Returns the next object from the list, or NULL on end-of-list.
11869 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11871 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11872 return NULL;
11874 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11878 * Returns 1 if end-of-list has been reached.
11880 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11882 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11885 /* foreach + lmap implementation. */
11886 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11888 int result = JIM_OK;
11889 int i, numargs;
11890 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11891 Jim_ListIter *iters;
11892 Jim_Obj *script;
11893 Jim_Obj *resultObj;
11895 if (argc < 4 || argc % 2 != 0) {
11896 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11897 return JIM_ERR;
11899 script = argv[argc - 1]; /* Last argument is a script */
11900 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11902 if (numargs == 2) {
11903 iters = twoiters;
11905 else {
11906 iters = Jim_Alloc(numargs * sizeof(*iters));
11908 for (i = 0; i < numargs; i++) {
11909 JimListIterInit(&iters[i], argv[i + 1]);
11910 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11911 result = JIM_ERR;
11914 if (result != JIM_OK) {
11915 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11916 return result;
11919 if (doMap) {
11920 resultObj = Jim_NewListObj(interp, NULL, 0);
11922 else {
11923 resultObj = interp->emptyObj;
11925 Jim_IncrRefCount(resultObj);
11927 while (1) {
11928 /* Have we expired all lists? */
11929 for (i = 0; i < numargs; i += 2) {
11930 if (!JimListIterDone(interp, &iters[i + 1])) {
11931 break;
11934 if (i == numargs) {
11935 /* All done */
11936 break;
11939 /* For each list */
11940 for (i = 0; i < numargs; i += 2) {
11941 Jim_Obj *varName;
11943 /* foreach var */
11944 JimListIterInit(&iters[i], argv[i + 1]);
11945 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11946 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11947 if (!valObj) {
11948 /* Ran out, so store the empty string */
11949 valObj = interp->emptyObj;
11951 /* Avoid shimmering */
11952 Jim_IncrRefCount(valObj);
11953 result = Jim_SetVariable(interp, varName, valObj);
11954 Jim_DecrRefCount(interp, valObj);
11955 if (result != JIM_OK) {
11956 goto err;
11960 switch (result = Jim_EvalObj(interp, script)) {
11961 case JIM_OK:
11962 if (doMap) {
11963 Jim_ListAppendElement(interp, resultObj, interp->result);
11965 break;
11966 case JIM_CONTINUE:
11967 break;
11968 case JIM_BREAK:
11969 goto out;
11970 default:
11971 goto err;
11974 out:
11975 result = JIM_OK;
11976 Jim_SetResult(interp, resultObj);
11977 err:
11978 Jim_DecrRefCount(interp, resultObj);
11979 if (numargs > 2) {
11980 Jim_Free(iters);
11982 return result;
11985 /* [foreach] */
11986 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11988 return JimForeachMapHelper(interp, argc, argv, 0);
11991 /* [lmap] */
11992 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11994 return JimForeachMapHelper(interp, argc, argv, 1);
11997 /* [lassign] */
11998 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12000 int result = JIM_ERR;
12001 int i;
12002 Jim_ListIter iter;
12003 Jim_Obj *resultObj;
12005 if (argc < 2) {
12006 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12007 return JIM_ERR;
12010 JimListIterInit(&iter, argv[1]);
12012 for (i = 2; i < argc; i++) {
12013 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12014 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12015 if (result != JIM_OK) {
12016 return result;
12020 resultObj = Jim_NewListObj(interp, NULL, 0);
12021 while (!JimListIterDone(interp, &iter)) {
12022 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12025 Jim_SetResult(interp, resultObj);
12027 return JIM_OK;
12030 /* [if] */
12031 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12033 int boolean, retval, current = 1, falsebody = 0;
12035 if (argc >= 3) {
12036 while (1) {
12037 /* Far not enough arguments given! */
12038 if (current >= argc)
12039 goto err;
12040 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12041 != JIM_OK)
12042 return retval;
12043 /* There lacks something, isn't it? */
12044 if (current >= argc)
12045 goto err;
12046 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12047 current++;
12048 /* Tsk tsk, no then-clause? */
12049 if (current >= argc)
12050 goto err;
12051 if (boolean)
12052 return Jim_EvalObj(interp, argv[current]);
12053 /* Ok: no else-clause follows */
12054 if (++current >= argc) {
12055 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12056 return JIM_OK;
12058 falsebody = current++;
12059 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12060 /* IIICKS - else-clause isn't last cmd? */
12061 if (current != argc - 1)
12062 goto err;
12063 return Jim_EvalObj(interp, argv[current]);
12065 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12066 /* Ok: elseif follows meaning all the stuff
12067 * again (how boring...) */
12068 continue;
12069 /* OOPS - else-clause is not last cmd? */
12070 else if (falsebody != argc - 1)
12071 goto err;
12072 return Jim_EvalObj(interp, argv[falsebody]);
12074 return JIM_OK;
12076 err:
12077 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12078 return JIM_ERR;
12082 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12083 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12084 Jim_Obj *stringObj, int nocase)
12086 Jim_Obj *parms[4];
12087 int argc = 0;
12088 long eq;
12089 int rc;
12091 parms[argc++] = commandObj;
12092 if (nocase) {
12093 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12095 parms[argc++] = patternObj;
12096 parms[argc++] = stringObj;
12098 rc = Jim_EvalObjVector(interp, argc, parms);
12100 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12101 eq = -rc;
12104 return eq;
12107 enum
12108 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12110 /* [switch] */
12111 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12113 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12114 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12115 Jim_Obj *script = 0;
12117 if (argc < 3) {
12118 wrongnumargs:
12119 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12120 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12121 return JIM_ERR;
12123 for (opt = 1; opt < argc; ++opt) {
12124 const char *option = Jim_String(argv[opt]);
12126 if (*option != '-')
12127 break;
12128 else if (strncmp(option, "--", 2) == 0) {
12129 ++opt;
12130 break;
12132 else if (strncmp(option, "-exact", 2) == 0)
12133 matchOpt = SWITCH_EXACT;
12134 else if (strncmp(option, "-glob", 2) == 0)
12135 matchOpt = SWITCH_GLOB;
12136 else if (strncmp(option, "-regexp", 2) == 0)
12137 matchOpt = SWITCH_RE;
12138 else if (strncmp(option, "-command", 2) == 0) {
12139 matchOpt = SWITCH_CMD;
12140 if ((argc - opt) < 2)
12141 goto wrongnumargs;
12142 command = argv[++opt];
12144 else {
12145 Jim_SetResultFormatted(interp,
12146 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12147 argv[opt]);
12148 return JIM_ERR;
12150 if ((argc - opt) < 2)
12151 goto wrongnumargs;
12153 strObj = argv[opt++];
12154 patCount = argc - opt;
12155 if (patCount == 1) {
12156 Jim_Obj **vector;
12158 JimListGetElements(interp, argv[opt], &patCount, &vector);
12159 caseList = vector;
12161 else
12162 caseList = &argv[opt];
12163 if (patCount == 0 || patCount % 2 != 0)
12164 goto wrongnumargs;
12165 for (i = 0; script == 0 && i < patCount; i += 2) {
12166 Jim_Obj *patObj = caseList[i];
12168 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12169 || i < (patCount - 2)) {
12170 switch (matchOpt) {
12171 case SWITCH_EXACT:
12172 if (Jim_StringEqObj(strObj, patObj))
12173 script = caseList[i + 1];
12174 break;
12175 case SWITCH_GLOB:
12176 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12177 script = caseList[i + 1];
12178 break;
12179 case SWITCH_RE:
12180 command = Jim_NewStringObj(interp, "regexp", -1);
12181 /* Fall thru intentionally */
12182 case SWITCH_CMD:{
12183 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12185 /* After the execution of a command we need to
12186 * make sure to reconvert the object into a list
12187 * again. Only for the single-list style [switch]. */
12188 if (argc - opt == 1) {
12189 Jim_Obj **vector;
12191 JimListGetElements(interp, argv[opt], &patCount, &vector);
12192 caseList = vector;
12194 /* command is here already decref'd */
12195 if (rc < 0) {
12196 return -rc;
12198 if (rc)
12199 script = caseList[i + 1];
12200 break;
12204 else {
12205 script = caseList[i + 1];
12208 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12209 script = caseList[i + 1];
12210 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12211 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12212 return JIM_ERR;
12214 Jim_SetEmptyResult(interp);
12215 if (script) {
12216 return Jim_EvalObj(interp, script);
12218 return JIM_OK;
12221 /* [list] */
12222 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12224 Jim_Obj *listObjPtr;
12226 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12227 Jim_SetResult(interp, listObjPtr);
12228 return JIM_OK;
12231 /* [lindex] */
12232 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12234 Jim_Obj *objPtr, *listObjPtr;
12235 int i;
12236 int idx;
12238 if (argc < 2) {
12239 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12240 return JIM_ERR;
12242 objPtr = argv[1];
12243 Jim_IncrRefCount(objPtr);
12244 for (i = 2; i < argc; i++) {
12245 listObjPtr = objPtr;
12246 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12247 Jim_DecrRefCount(interp, listObjPtr);
12248 return JIM_ERR;
12250 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12251 /* Returns an empty object if the index
12252 * is out of range. */
12253 Jim_DecrRefCount(interp, listObjPtr);
12254 Jim_SetEmptyResult(interp);
12255 return JIM_OK;
12257 Jim_IncrRefCount(objPtr);
12258 Jim_DecrRefCount(interp, listObjPtr);
12260 Jim_SetResult(interp, objPtr);
12261 Jim_DecrRefCount(interp, objPtr);
12262 return JIM_OK;
12265 /* [llength] */
12266 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12268 if (argc != 2) {
12269 Jim_WrongNumArgs(interp, 1, argv, "list");
12270 return JIM_ERR;
12272 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12273 return JIM_OK;
12276 /* [lsearch] */
12277 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12279 static const char * const options[] = {
12280 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12281 NULL
12283 enum
12284 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12285 OPT_COMMAND };
12286 int i;
12287 int opt_bool = 0;
12288 int opt_not = 0;
12289 int opt_nocase = 0;
12290 int opt_all = 0;
12291 int opt_inline = 0;
12292 int opt_match = OPT_EXACT;
12293 int listlen;
12294 int rc = JIM_OK;
12295 Jim_Obj *listObjPtr = NULL;
12296 Jim_Obj *commandObj = NULL;
12298 if (argc < 3) {
12299 wrongargs:
12300 Jim_WrongNumArgs(interp, 1, argv,
12301 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12302 return JIM_ERR;
12305 for (i = 1; i < argc - 2; i++) {
12306 int option;
12308 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12309 return JIM_ERR;
12311 switch (option) {
12312 case OPT_BOOL:
12313 opt_bool = 1;
12314 opt_inline = 0;
12315 break;
12316 case OPT_NOT:
12317 opt_not = 1;
12318 break;
12319 case OPT_NOCASE:
12320 opt_nocase = 1;
12321 break;
12322 case OPT_INLINE:
12323 opt_inline = 1;
12324 opt_bool = 0;
12325 break;
12326 case OPT_ALL:
12327 opt_all = 1;
12328 break;
12329 case OPT_COMMAND:
12330 if (i >= argc - 2) {
12331 goto wrongargs;
12333 commandObj = argv[++i];
12334 /* fallthru */
12335 case OPT_EXACT:
12336 case OPT_GLOB:
12337 case OPT_REGEXP:
12338 opt_match = option;
12339 break;
12343 argv += i;
12345 if (opt_all) {
12346 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12348 if (opt_match == OPT_REGEXP) {
12349 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12351 if (commandObj) {
12352 Jim_IncrRefCount(commandObj);
12355 listlen = Jim_ListLength(interp, argv[0]);
12356 for (i = 0; i < listlen; i++) {
12357 int eq = 0;
12358 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12360 switch (opt_match) {
12361 case OPT_EXACT:
12362 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12363 break;
12365 case OPT_GLOB:
12366 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12367 break;
12369 case OPT_REGEXP:
12370 case OPT_COMMAND:
12371 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12372 if (eq < 0) {
12373 if (listObjPtr) {
12374 Jim_FreeNewObj(interp, listObjPtr);
12376 rc = JIM_ERR;
12377 goto done;
12379 break;
12382 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12383 if (!eq && opt_bool && opt_not && !opt_all) {
12384 continue;
12387 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12388 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12389 Jim_Obj *resultObj;
12391 if (opt_bool) {
12392 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12394 else if (!opt_inline) {
12395 resultObj = Jim_NewIntObj(interp, i);
12397 else {
12398 resultObj = objPtr;
12401 if (opt_all) {
12402 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12404 else {
12405 Jim_SetResult(interp, resultObj);
12406 goto done;
12411 if (opt_all) {
12412 Jim_SetResult(interp, listObjPtr);
12414 else {
12415 /* No match */
12416 if (opt_bool) {
12417 Jim_SetResultBool(interp, opt_not);
12419 else if (!opt_inline) {
12420 Jim_SetResultInt(interp, -1);
12424 done:
12425 if (commandObj) {
12426 Jim_DecrRefCount(interp, commandObj);
12428 return rc;
12431 /* [lappend] */
12432 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12434 Jim_Obj *listObjPtr;
12435 int shared, i;
12437 if (argc < 2) {
12438 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12439 return JIM_ERR;
12441 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12442 if (!listObjPtr) {
12443 /* Create the list if it does not exist */
12444 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12445 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12446 Jim_FreeNewObj(interp, listObjPtr);
12447 return JIM_ERR;
12450 shared = Jim_IsShared(listObjPtr);
12451 if (shared)
12452 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12453 for (i = 2; i < argc; i++)
12454 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12455 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12456 if (shared)
12457 Jim_FreeNewObj(interp, listObjPtr);
12458 return JIM_ERR;
12460 Jim_SetResult(interp, listObjPtr);
12461 return JIM_OK;
12464 /* [linsert] */
12465 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12467 int idx, len;
12468 Jim_Obj *listPtr;
12470 if (argc < 3) {
12471 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12472 return JIM_ERR;
12474 listPtr = argv[1];
12475 if (Jim_IsShared(listPtr))
12476 listPtr = Jim_DuplicateObj(interp, listPtr);
12477 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12478 goto err;
12479 len = Jim_ListLength(interp, listPtr);
12480 if (idx >= len)
12481 idx = len;
12482 else if (idx < 0)
12483 idx = len + idx + 1;
12484 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12485 Jim_SetResult(interp, listPtr);
12486 return JIM_OK;
12487 err:
12488 if (listPtr != argv[1]) {
12489 Jim_FreeNewObj(interp, listPtr);
12491 return JIM_ERR;
12494 /* [lreplace] */
12495 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12497 int first, last, len, rangeLen;
12498 Jim_Obj *listObj;
12499 Jim_Obj *newListObj;
12501 if (argc < 4) {
12502 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12503 return JIM_ERR;
12505 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12506 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12507 return JIM_ERR;
12510 listObj = argv[1];
12511 len = Jim_ListLength(interp, listObj);
12513 first = JimRelToAbsIndex(len, first);
12514 last = JimRelToAbsIndex(len, last);
12515 JimRelToAbsRange(len, &first, &last, &rangeLen);
12517 /* Now construct a new list which consists of:
12518 * <elements before first> <supplied elements> <elements after last>
12521 /* Check to see if trying to replace past the end of the list */
12522 if (first < len) {
12523 /* OK. Not past the end */
12525 else if (len == 0) {
12526 /* Special for empty list, adjust first to 0 */
12527 first = 0;
12529 else {
12530 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12531 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12532 return JIM_ERR;
12535 /* Add the first set of elements */
12536 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12538 /* Add supplied elements */
12539 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12541 /* Add the remaining elements */
12542 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12544 Jim_SetResult(interp, newListObj);
12545 return JIM_OK;
12548 /* [lset] */
12549 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12551 if (argc < 3) {
12552 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12553 return JIM_ERR;
12555 else if (argc == 3) {
12556 /* With no indexes, simply implements [set] */
12557 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12558 return JIM_ERR;
12559 Jim_SetResult(interp, argv[2]);
12560 return JIM_OK;
12562 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12565 /* [lsort] */
12566 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12568 static const char * const options[] = {
12569 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12571 enum
12572 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12573 Jim_Obj *resObj;
12574 int i;
12575 int retCode;
12577 struct lsort_info info;
12579 if (argc < 2) {
12580 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12581 return JIM_ERR;
12584 info.type = JIM_LSORT_ASCII;
12585 info.order = 1;
12586 info.indexed = 0;
12587 info.unique = 0;
12588 info.command = NULL;
12589 info.interp = interp;
12591 for (i = 1; i < (argc - 1); i++) {
12592 int option;
12594 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12595 != JIM_OK)
12596 return JIM_ERR;
12597 switch (option) {
12598 case OPT_ASCII:
12599 info.type = JIM_LSORT_ASCII;
12600 break;
12601 case OPT_NOCASE:
12602 info.type = JIM_LSORT_NOCASE;
12603 break;
12604 case OPT_INTEGER:
12605 info.type = JIM_LSORT_INTEGER;
12606 break;
12607 case OPT_REAL:
12608 info.type = JIM_LSORT_REAL;
12609 break;
12610 case OPT_INCREASING:
12611 info.order = 1;
12612 break;
12613 case OPT_DECREASING:
12614 info.order = -1;
12615 break;
12616 case OPT_UNIQUE:
12617 info.unique = 1;
12618 break;
12619 case OPT_COMMAND:
12620 if (i >= (argc - 2)) {
12621 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12622 return JIM_ERR;
12624 info.type = JIM_LSORT_COMMAND;
12625 info.command = argv[i + 1];
12626 i++;
12627 break;
12628 case OPT_INDEX:
12629 if (i >= (argc - 2)) {
12630 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12631 return JIM_ERR;
12633 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12634 return JIM_ERR;
12636 info.indexed = 1;
12637 i++;
12638 break;
12641 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12642 retCode = ListSortElements(interp, resObj, &info);
12643 if (retCode == JIM_OK) {
12644 Jim_SetResult(interp, resObj);
12646 else {
12647 Jim_FreeNewObj(interp, resObj);
12649 return retCode;
12652 /* [append] */
12653 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12655 Jim_Obj *stringObjPtr;
12656 int i;
12658 if (argc < 2) {
12659 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12660 return JIM_ERR;
12662 if (argc == 2) {
12663 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12664 if (!stringObjPtr)
12665 return JIM_ERR;
12667 else {
12668 int freeobj = 0;
12669 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12670 if (!stringObjPtr) {
12671 /* Create the string if it doesn't exist */
12672 stringObjPtr = Jim_NewEmptyStringObj(interp);
12673 freeobj = 1;
12675 else if (Jim_IsShared(stringObjPtr)) {
12676 freeobj = 1;
12677 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12679 for (i = 2; i < argc; i++) {
12680 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12682 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12683 if (freeobj) {
12684 Jim_FreeNewObj(interp, stringObjPtr);
12686 return JIM_ERR;
12689 Jim_SetResult(interp, stringObjPtr);
12690 return JIM_OK;
12693 /* [debug] */
12694 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12696 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12697 static const char * const options[] = {
12698 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12699 "exprbc", "show",
12700 NULL
12702 enum
12704 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12705 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12707 int option;
12709 if (argc < 2) {
12710 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12711 return JIM_ERR;
12713 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12714 return JIM_ERR;
12715 if (option == OPT_REFCOUNT) {
12716 if (argc != 3) {
12717 Jim_WrongNumArgs(interp, 2, argv, "object");
12718 return JIM_ERR;
12720 Jim_SetResultInt(interp, argv[2]->refCount);
12721 return JIM_OK;
12723 else if (option == OPT_OBJCOUNT) {
12724 int freeobj = 0, liveobj = 0;
12725 char buf[256];
12726 Jim_Obj *objPtr;
12728 if (argc != 2) {
12729 Jim_WrongNumArgs(interp, 2, argv, "");
12730 return JIM_ERR;
12732 /* Count the number of free objects. */
12733 objPtr = interp->freeList;
12734 while (objPtr) {
12735 freeobj++;
12736 objPtr = objPtr->nextObjPtr;
12738 /* Count the number of live objects. */
12739 objPtr = interp->liveList;
12740 while (objPtr) {
12741 liveobj++;
12742 objPtr = objPtr->nextObjPtr;
12744 /* Set the result string and return. */
12745 sprintf(buf, "free %d used %d", freeobj, liveobj);
12746 Jim_SetResultString(interp, buf, -1);
12747 return JIM_OK;
12749 else if (option == OPT_OBJECTS) {
12750 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12752 /* Count the number of live objects. */
12753 objPtr = interp->liveList;
12754 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12755 while (objPtr) {
12756 char buf[128];
12757 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12759 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12760 sprintf(buf, "%p", objPtr);
12761 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12762 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12763 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12764 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12765 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12766 objPtr = objPtr->nextObjPtr;
12768 Jim_SetResult(interp, listObjPtr);
12769 return JIM_OK;
12771 else if (option == OPT_INVSTR) {
12772 Jim_Obj *objPtr;
12774 if (argc != 3) {
12775 Jim_WrongNumArgs(interp, 2, argv, "object");
12776 return JIM_ERR;
12778 objPtr = argv[2];
12779 if (objPtr->typePtr != NULL)
12780 Jim_InvalidateStringRep(objPtr);
12781 Jim_SetEmptyResult(interp);
12782 return JIM_OK;
12784 else if (option == OPT_SHOW) {
12785 const char *s;
12786 int len, charlen;
12788 if (argc != 3) {
12789 Jim_WrongNumArgs(interp, 2, argv, "object");
12790 return JIM_ERR;
12792 s = Jim_GetString(argv[2], &len);
12793 #ifdef JIM_UTF8
12794 charlen = utf8_strlen(s, len);
12795 #else
12796 charlen = len;
12797 #endif
12798 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12799 printf("chars (%d): <<%s>>\n", charlen, s);
12800 printf("bytes (%d):", len);
12801 while (len--) {
12802 printf(" %02x", (unsigned char)*s++);
12804 printf("\n");
12805 return JIM_OK;
12807 else if (option == OPT_SCRIPTLEN) {
12808 ScriptObj *script;
12810 if (argc != 3) {
12811 Jim_WrongNumArgs(interp, 2, argv, "script");
12812 return JIM_ERR;
12814 script = JimGetScript(interp, argv[2]);
12815 if (script == NULL)
12816 return JIM_ERR;
12817 Jim_SetResultInt(interp, script->len);
12818 return JIM_OK;
12820 else if (option == OPT_EXPRLEN) {
12821 ExprByteCode *expr;
12823 if (argc != 3) {
12824 Jim_WrongNumArgs(interp, 2, argv, "expression");
12825 return JIM_ERR;
12827 expr = JimGetExpression(interp, argv[2]);
12828 if (expr == NULL)
12829 return JIM_ERR;
12830 Jim_SetResultInt(interp, expr->len);
12831 return JIM_OK;
12833 else if (option == OPT_EXPRBC) {
12834 Jim_Obj *objPtr;
12835 ExprByteCode *expr;
12836 int i;
12838 if (argc != 3) {
12839 Jim_WrongNumArgs(interp, 2, argv, "expression");
12840 return JIM_ERR;
12842 expr = JimGetExpression(interp, argv[2]);
12843 if (expr == NULL)
12844 return JIM_ERR;
12845 objPtr = Jim_NewListObj(interp, NULL, 0);
12846 for (i = 0; i < expr->len; i++) {
12847 const char *type;
12848 const Jim_ExprOperator *op;
12849 Jim_Obj *obj = expr->token[i].objPtr;
12851 switch (expr->token[i].type) {
12852 case JIM_TT_EXPR_INT:
12853 type = "int";
12854 break;
12855 case JIM_TT_EXPR_DOUBLE:
12856 type = "double";
12857 break;
12858 case JIM_TT_CMD:
12859 type = "command";
12860 break;
12861 case JIM_TT_VAR:
12862 type = "variable";
12863 break;
12864 case JIM_TT_DICTSUGAR:
12865 type = "dictsugar";
12866 break;
12867 case JIM_TT_EXPRSUGAR:
12868 type = "exprsugar";
12869 break;
12870 case JIM_TT_ESC:
12871 type = "subst";
12872 break;
12873 case JIM_TT_STR:
12874 type = "string";
12875 break;
12876 default:
12877 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12878 if (op == NULL) {
12879 type = "private";
12881 else {
12882 type = "operator";
12884 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12885 break;
12887 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12888 Jim_ListAppendElement(interp, objPtr, obj);
12890 Jim_SetResult(interp, objPtr);
12891 return JIM_OK;
12893 else {
12894 Jim_SetResultString(interp,
12895 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12896 return JIM_ERR;
12898 /* unreached */
12899 #endif /* JIM_BOOTSTRAP */
12900 #if !defined(JIM_DEBUG_COMMAND)
12901 Jim_SetResultString(interp, "unsupported", -1);
12902 return JIM_ERR;
12903 #endif
12906 /* [eval] */
12907 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12909 int rc;
12911 if (argc < 2) {
12912 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12913 return JIM_ERR;
12916 if (argc == 2) {
12917 rc = Jim_EvalObj(interp, argv[1]);
12919 else {
12920 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12923 if (rc == JIM_ERR) {
12924 /* eval is "interesting", so add a stack frame here */
12925 interp->addStackTrace++;
12927 return rc;
12930 /* [uplevel] */
12931 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12933 if (argc >= 2) {
12934 int retcode;
12935 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12936 const char *str;
12938 /* Save the old callframe pointer */
12939 savedCallFrame = interp->framePtr;
12941 /* Lookup the target frame pointer */
12942 str = Jim_String(argv[1]);
12943 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12944 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12945 argc--;
12946 argv++;
12948 else {
12949 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12951 if (targetCallFrame == NULL) {
12952 return JIM_ERR;
12954 if (argc < 2) {
12955 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12956 return JIM_ERR;
12958 /* Eval the code in the target callframe. */
12959 interp->framePtr = targetCallFrame;
12960 if (argc == 2) {
12961 retcode = Jim_EvalObj(interp, argv[1]);
12963 else {
12964 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12966 interp->framePtr = savedCallFrame;
12967 return retcode;
12969 else {
12970 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12971 return JIM_ERR;
12975 /* [expr] */
12976 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12978 Jim_Obj *exprResultPtr;
12979 int retcode;
12981 if (argc == 2) {
12982 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12984 else if (argc > 2) {
12985 Jim_Obj *objPtr;
12987 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12988 Jim_IncrRefCount(objPtr);
12989 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12990 Jim_DecrRefCount(interp, objPtr);
12992 else {
12993 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12994 return JIM_ERR;
12996 if (retcode != JIM_OK)
12997 return retcode;
12998 Jim_SetResult(interp, exprResultPtr);
12999 Jim_DecrRefCount(interp, exprResultPtr);
13000 return JIM_OK;
13003 /* [break] */
13004 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13006 if (argc != 1) {
13007 Jim_WrongNumArgs(interp, 1, argv, "");
13008 return JIM_ERR;
13010 return JIM_BREAK;
13013 /* [continue] */
13014 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13016 if (argc != 1) {
13017 Jim_WrongNumArgs(interp, 1, argv, "");
13018 return JIM_ERR;
13020 return JIM_CONTINUE;
13023 /* [return] */
13024 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13026 int i;
13027 Jim_Obj *stackTraceObj = NULL;
13028 Jim_Obj *errorCodeObj = NULL;
13029 int returnCode = JIM_OK;
13030 long level = 1;
13032 for (i = 1; i < argc - 1; i += 2) {
13033 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13034 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13035 return JIM_ERR;
13038 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13039 stackTraceObj = argv[i + 1];
13041 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13042 errorCodeObj = argv[i + 1];
13044 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13045 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13046 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13047 return JIM_ERR;
13050 else {
13051 break;
13055 if (i != argc - 1 && i != argc) {
13056 Jim_WrongNumArgs(interp, 1, argv,
13057 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13060 /* If a stack trace is supplied and code is error, set the stack trace */
13061 if (stackTraceObj && returnCode == JIM_ERR) {
13062 JimSetStackTrace(interp, stackTraceObj);
13064 /* If an error code list is supplied, set the global $errorCode */
13065 if (errorCodeObj && returnCode == JIM_ERR) {
13066 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13068 interp->returnCode = returnCode;
13069 interp->returnLevel = level;
13071 if (i == argc - 1) {
13072 Jim_SetResult(interp, argv[i]);
13074 return JIM_RETURN;
13077 /* [tailcall] */
13078 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13080 if (interp->framePtr->level == 0) {
13081 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13082 return JIM_ERR;
13084 else if (argc >= 2) {
13085 /* Need to resolve the tailcall command in the current context */
13086 Jim_CallFrame *cf = interp->framePtr->parent;
13088 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13089 if (cmdPtr == NULL) {
13090 return JIM_ERR;
13093 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13095 /* And stash this pre-resolved command */
13096 JimIncrCmdRefCount(cmdPtr);
13097 cf->tailcallCmd = cmdPtr;
13099 /* And stash the command list */
13100 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13102 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13103 Jim_IncrRefCount(cf->tailcallObj);
13105 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13106 return JIM_EVAL;
13108 return JIM_OK;
13111 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13113 Jim_Obj *cmdList;
13114 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13116 /* prefixListObj is a list to which the args need to be appended */
13117 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13118 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13120 return JimEvalObjList(interp, cmdList);
13123 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13125 Jim_Obj *prefixListObj = privData;
13126 Jim_DecrRefCount(interp, prefixListObj);
13129 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13131 Jim_Obj *prefixListObj;
13132 const char *newname;
13134 if (argc < 3) {
13135 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13136 return JIM_ERR;
13139 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13140 Jim_IncrRefCount(prefixListObj);
13141 newname = Jim_String(argv[1]);
13142 if (newname[0] == ':' && newname[1] == ':') {
13143 while (*++newname == ':') {
13147 Jim_SetResult(interp, argv[1]);
13149 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13152 /* [proc] */
13153 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13155 Jim_Cmd *cmd;
13157 if (argc != 4 && argc != 5) {
13158 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13159 return JIM_ERR;
13162 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13163 return JIM_ERR;
13166 if (argc == 4) {
13167 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13169 else {
13170 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13173 if (cmd) {
13174 /* Add the new command */
13175 Jim_Obj *qualifiedCmdNameObj;
13176 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13178 JimCreateCommand(interp, cmdname, cmd);
13180 /* Calculate and set the namespace for this proc */
13181 JimUpdateProcNamespace(interp, cmd, cmdname);
13183 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13185 /* Unlike Tcl, set the name of the proc as the result */
13186 Jim_SetResult(interp, argv[1]);
13187 return JIM_OK;
13189 return JIM_ERR;
13192 /* [local] */
13193 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13195 int retcode;
13197 if (argc < 2) {
13198 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13199 return JIM_ERR;
13202 /* Evaluate the arguments with 'local' in force */
13203 interp->local++;
13204 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13205 interp->local--;
13208 /* If OK, and the result is a proc, add it to the list of local procs */
13209 if (retcode == 0) {
13210 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13212 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13213 return JIM_ERR;
13215 if (interp->framePtr->localCommands == NULL) {
13216 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13217 Jim_InitStack(interp->framePtr->localCommands);
13219 Jim_IncrRefCount(cmdNameObj);
13220 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13223 return retcode;
13226 /* [upcall] */
13227 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13229 if (argc < 2) {
13230 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13231 return JIM_ERR;
13233 else {
13234 int retcode;
13236 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13237 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13238 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13239 return JIM_ERR;
13241 /* OK. Mark this command as being in an upcall */
13242 cmdPtr->u.proc.upcall++;
13243 JimIncrCmdRefCount(cmdPtr);
13245 /* Invoke the command as normal */
13246 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13248 /* No longer in an upcall */
13249 cmdPtr->u.proc.upcall--;
13250 JimDecrCmdRefCount(interp, cmdPtr);
13252 return retcode;
13256 /* [apply] */
13257 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13259 if (argc < 2) {
13260 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13261 return JIM_ERR;
13263 else {
13264 int ret;
13265 Jim_Cmd *cmd;
13266 Jim_Obj *argListObjPtr;
13267 Jim_Obj *bodyObjPtr;
13268 Jim_Obj *nsObj = NULL;
13269 Jim_Obj **nargv;
13271 int len = Jim_ListLength(interp, argv[1]);
13272 if (len != 2 && len != 3) {
13273 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13274 return JIM_ERR;
13277 if (len == 3) {
13278 #ifdef jim_ext_namespace
13279 /* Need to canonicalise the given namespace. */
13280 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13281 #else
13282 Jim_SetResultString(interp, "namespaces not enabled", -1);
13283 return JIM_ERR;
13284 #endif
13286 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13287 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13289 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13291 if (cmd) {
13292 /* Create a new argv array with a dummy argv[0], for error messages */
13293 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13294 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13295 Jim_IncrRefCount(nargv[0]);
13296 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13297 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13298 Jim_DecrRefCount(interp, nargv[0]);
13299 Jim_Free(nargv);
13301 JimDecrCmdRefCount(interp, cmd);
13302 return ret;
13304 return JIM_ERR;
13309 /* [concat] */
13310 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13312 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13313 return JIM_OK;
13316 /* [upvar] */
13317 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13319 int i;
13320 Jim_CallFrame *targetCallFrame;
13322 /* Lookup the target frame pointer */
13323 if (argc > 3 && (argc % 2 == 0)) {
13324 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13325 argc--;
13326 argv++;
13328 else {
13329 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13331 if (targetCallFrame == NULL) {
13332 return JIM_ERR;
13335 /* Check for arity */
13336 if (argc < 3) {
13337 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13338 return JIM_ERR;
13341 /* Now... for every other/local couple: */
13342 for (i = 1; i < argc; i += 2) {
13343 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13344 return JIM_ERR;
13346 return JIM_OK;
13349 /* [global] */
13350 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13352 int i;
13354 if (argc < 2) {
13355 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13356 return JIM_ERR;
13358 /* Link every var to the toplevel having the same name */
13359 if (interp->framePtr->level == 0)
13360 return JIM_OK; /* global at toplevel... */
13361 for (i = 1; i < argc; i++) {
13362 /* global ::blah does nothing */
13363 const char *name = Jim_String(argv[i]);
13364 if (name[0] != ':' || name[1] != ':') {
13365 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13366 return JIM_ERR;
13369 return JIM_OK;
13372 /* does the [string map] operation. On error NULL is returned,
13373 * otherwise a new string object with the result, having refcount = 0,
13374 * is returned. */
13375 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13376 Jim_Obj *objPtr, int nocase)
13378 int numMaps;
13379 const char *str, *noMatchStart = NULL;
13380 int strLen, i;
13381 Jim_Obj *resultObjPtr;
13383 numMaps = Jim_ListLength(interp, mapListObjPtr);
13384 if (numMaps % 2) {
13385 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13386 return NULL;
13389 str = Jim_String(objPtr);
13390 strLen = Jim_Utf8Length(interp, objPtr);
13392 /* Map it */
13393 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13394 while (strLen) {
13395 for (i = 0; i < numMaps; i += 2) {
13396 Jim_Obj *objPtr;
13397 const char *k;
13398 int kl;
13400 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13401 k = Jim_String(objPtr);
13402 kl = Jim_Utf8Length(interp, objPtr);
13404 if (strLen >= kl && kl) {
13405 int rc;
13406 rc = JimStringCompareLen(str, k, kl, nocase);
13407 if (rc == 0) {
13408 if (noMatchStart) {
13409 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13410 noMatchStart = NULL;
13412 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13413 str += utf8_index(str, kl);
13414 strLen -= kl;
13415 break;
13419 if (i == numMaps) { /* no match */
13420 int c;
13421 if (noMatchStart == NULL)
13422 noMatchStart = str;
13423 str += utf8_tounicode(str, &c);
13424 strLen--;
13427 if (noMatchStart) {
13428 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13430 return resultObjPtr;
13433 /* [string] */
13434 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13436 int len;
13437 int opt_case = 1;
13438 int option;
13439 static const char * const options[] = {
13440 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13441 "map", "repeat", "reverse", "index", "first", "last", "cat",
13442 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13444 enum
13446 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13447 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13448 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13450 static const char * const nocase_options[] = {
13451 "-nocase", NULL
13453 static const char * const nocase_length_options[] = {
13454 "-nocase", "-length", NULL
13457 if (argc < 2) {
13458 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13459 return JIM_ERR;
13461 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13462 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13463 return JIM_ERR;
13465 switch (option) {
13466 case OPT_LENGTH:
13467 case OPT_BYTELENGTH:
13468 if (argc != 3) {
13469 Jim_WrongNumArgs(interp, 2, argv, "string");
13470 return JIM_ERR;
13472 if (option == OPT_LENGTH) {
13473 len = Jim_Utf8Length(interp, argv[2]);
13475 else {
13476 len = Jim_Length(argv[2]);
13478 Jim_SetResultInt(interp, len);
13479 return JIM_OK;
13481 case OPT_CAT:{
13482 Jim_Obj *objPtr;
13483 if (argc == 3) {
13484 /* optimise the one-arg case */
13485 objPtr = argv[2];
13487 else {
13488 int i;
13490 objPtr = Jim_NewStringObj(interp, "", 0);
13492 for (i = 2; i < argc; i++) {
13493 Jim_AppendObj(interp, objPtr, argv[i]);
13496 Jim_SetResult(interp, objPtr);
13497 return JIM_OK;
13500 case OPT_COMPARE:
13501 case OPT_EQUAL:
13503 /* n is the number of remaining option args */
13504 long opt_length = -1;
13505 int n = argc - 4;
13506 int i = 2;
13507 while (n > 0) {
13508 int subopt;
13509 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13510 JIM_ENUM_ABBREV) != JIM_OK) {
13511 badcompareargs:
13512 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13513 return JIM_ERR;
13515 if (subopt == 0) {
13516 /* -nocase */
13517 opt_case = 0;
13518 n--;
13520 else {
13521 /* -length */
13522 if (n < 2) {
13523 goto badcompareargs;
13525 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13526 return JIM_ERR;
13528 n -= 2;
13531 if (n) {
13532 goto badcompareargs;
13534 argv += argc - 2;
13535 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13536 /* Fast version - [string equal], case sensitive, no length */
13537 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13539 else {
13540 if (opt_length >= 0) {
13541 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13543 else {
13544 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13546 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13548 return JIM_OK;
13551 case OPT_MATCH:
13552 if (argc != 4 &&
13553 (argc != 5 ||
13554 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13555 JIM_ENUM_ABBREV) != JIM_OK)) {
13556 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13557 return JIM_ERR;
13559 if (opt_case == 0) {
13560 argv++;
13562 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13563 return JIM_OK;
13565 case OPT_MAP:{
13566 Jim_Obj *objPtr;
13568 if (argc != 4 &&
13569 (argc != 5 ||
13570 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13571 JIM_ENUM_ABBREV) != JIM_OK)) {
13572 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13573 return JIM_ERR;
13576 if (opt_case == 0) {
13577 argv++;
13579 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13580 if (objPtr == NULL) {
13581 return JIM_ERR;
13583 Jim_SetResult(interp, objPtr);
13584 return JIM_OK;
13587 case OPT_RANGE:
13588 case OPT_BYTERANGE:{
13589 Jim_Obj *objPtr;
13591 if (argc != 5) {
13592 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13593 return JIM_ERR;
13595 if (option == OPT_RANGE) {
13596 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13598 else
13600 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13603 if (objPtr == NULL) {
13604 return JIM_ERR;
13606 Jim_SetResult(interp, objPtr);
13607 return JIM_OK;
13610 case OPT_REPLACE:{
13611 Jim_Obj *objPtr;
13613 if (argc != 5 && argc != 6) {
13614 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13615 return JIM_ERR;
13617 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13618 if (objPtr == NULL) {
13619 return JIM_ERR;
13621 Jim_SetResult(interp, objPtr);
13622 return JIM_OK;
13626 case OPT_REPEAT:{
13627 Jim_Obj *objPtr;
13628 jim_wide count;
13630 if (argc != 4) {
13631 Jim_WrongNumArgs(interp, 2, argv, "string count");
13632 return JIM_ERR;
13634 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13635 return JIM_ERR;
13637 objPtr = Jim_NewStringObj(interp, "", 0);
13638 if (count > 0) {
13639 while (count--) {
13640 Jim_AppendObj(interp, objPtr, argv[2]);
13643 Jim_SetResult(interp, objPtr);
13644 return JIM_OK;
13647 case OPT_REVERSE:{
13648 char *buf, *p;
13649 const char *str;
13650 int len;
13651 int i;
13653 if (argc != 3) {
13654 Jim_WrongNumArgs(interp, 2, argv, "string");
13655 return JIM_ERR;
13658 str = Jim_GetString(argv[2], &len);
13659 buf = Jim_Alloc(len + 1);
13660 p = buf + len;
13661 *p = 0;
13662 for (i = 0; i < len; ) {
13663 int c;
13664 int l = utf8_tounicode(str, &c);
13665 memcpy(p - l, str, l);
13666 p -= l;
13667 i += l;
13668 str += l;
13670 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13671 return JIM_OK;
13674 case OPT_INDEX:{
13675 int idx;
13676 const char *str;
13678 if (argc != 4) {
13679 Jim_WrongNumArgs(interp, 2, argv, "string index");
13680 return JIM_ERR;
13682 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13683 return JIM_ERR;
13685 str = Jim_String(argv[2]);
13686 len = Jim_Utf8Length(interp, argv[2]);
13687 if (idx != INT_MIN && idx != INT_MAX) {
13688 idx = JimRelToAbsIndex(len, idx);
13690 if (idx < 0 || idx >= len || str == NULL) {
13691 Jim_SetResultString(interp, "", 0);
13693 else if (len == Jim_Length(argv[2])) {
13694 /* ASCII optimisation */
13695 Jim_SetResultString(interp, str + idx, 1);
13697 else {
13698 int c;
13699 int i = utf8_index(str, idx);
13700 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13702 return JIM_OK;
13705 case OPT_FIRST:
13706 case OPT_LAST:{
13707 int idx = 0, l1, l2;
13708 const char *s1, *s2;
13710 if (argc != 4 && argc != 5) {
13711 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13712 return JIM_ERR;
13714 s1 = Jim_String(argv[2]);
13715 s2 = Jim_String(argv[3]);
13716 l1 = Jim_Utf8Length(interp, argv[2]);
13717 l2 = Jim_Utf8Length(interp, argv[3]);
13718 if (argc == 5) {
13719 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13720 return JIM_ERR;
13722 idx = JimRelToAbsIndex(l2, idx);
13724 else if (option == OPT_LAST) {
13725 idx = l2;
13727 if (option == OPT_FIRST) {
13728 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13730 else {
13731 #ifdef JIM_UTF8
13732 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13733 #else
13734 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13735 #endif
13737 return JIM_OK;
13740 case OPT_TRIM:
13741 case OPT_TRIMLEFT:
13742 case OPT_TRIMRIGHT:{
13743 Jim_Obj *trimchars;
13745 if (argc != 3 && argc != 4) {
13746 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13747 return JIM_ERR;
13749 trimchars = (argc == 4 ? argv[3] : NULL);
13750 if (option == OPT_TRIM) {
13751 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13753 else if (option == OPT_TRIMLEFT) {
13754 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13756 else if (option == OPT_TRIMRIGHT) {
13757 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13759 return JIM_OK;
13762 case OPT_TOLOWER:
13763 case OPT_TOUPPER:
13764 case OPT_TOTITLE:
13765 if (argc != 3) {
13766 Jim_WrongNumArgs(interp, 2, argv, "string");
13767 return JIM_ERR;
13769 if (option == OPT_TOLOWER) {
13770 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13772 else if (option == OPT_TOUPPER) {
13773 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13775 else {
13776 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13778 return JIM_OK;
13780 case OPT_IS:
13781 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13782 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13784 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13785 return JIM_ERR;
13787 return JIM_OK;
13790 /* [time] */
13791 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13793 long i, count = 1;
13794 jim_wide start, elapsed;
13795 char buf[60];
13796 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13798 if (argc < 2) {
13799 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13800 return JIM_ERR;
13802 if (argc == 3) {
13803 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13804 return JIM_ERR;
13806 if (count < 0)
13807 return JIM_OK;
13808 i = count;
13809 start = JimClock();
13810 while (i-- > 0) {
13811 int retval;
13813 retval = Jim_EvalObj(interp, argv[1]);
13814 if (retval != JIM_OK) {
13815 return retval;
13818 elapsed = JimClock() - start;
13819 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13820 Jim_SetResultString(interp, buf, -1);
13821 return JIM_OK;
13824 /* [exit] */
13825 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13827 long exitCode = 0;
13829 if (argc > 2) {
13830 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13831 return JIM_ERR;
13833 if (argc == 2) {
13834 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13835 return JIM_ERR;
13837 interp->exitCode = exitCode;
13838 return JIM_EXIT;
13841 /* [catch] */
13842 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13844 int exitCode = 0;
13845 int i;
13846 int sig = 0;
13848 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13849 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13850 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13852 /* Reset the error code before catch.
13853 * Note that this is not strictly correct.
13855 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13857 for (i = 1; i < argc - 1; i++) {
13858 const char *arg = Jim_String(argv[i]);
13859 jim_wide option;
13860 int ignore;
13862 /* It's a pity we can't use Jim_GetEnum here :-( */
13863 if (strcmp(arg, "--") == 0) {
13864 i++;
13865 break;
13867 if (*arg != '-') {
13868 break;
13871 if (strncmp(arg, "-no", 3) == 0) {
13872 arg += 3;
13873 ignore = 1;
13875 else {
13876 arg++;
13877 ignore = 0;
13880 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13881 option = -1;
13883 if (option < 0) {
13884 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13886 if (option < 0) {
13887 goto wrongargs;
13890 if (ignore) {
13891 ignore_mask |= (1 << option);
13893 else {
13894 ignore_mask &= ~(1 << option);
13898 argc -= i;
13899 if (argc < 1 || argc > 3) {
13900 wrongargs:
13901 Jim_WrongNumArgs(interp, 1, argv,
13902 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13903 return JIM_ERR;
13905 argv += i;
13907 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13908 sig++;
13911 interp->signal_level += sig;
13912 if (Jim_CheckSignal(interp)) {
13913 /* If a signal is set, don't even try to execute the body */
13914 exitCode = JIM_SIGNAL;
13916 else {
13917 exitCode = Jim_EvalObj(interp, argv[0]);
13918 /* Don't want any caught error included in a later stack trace */
13919 interp->errorFlag = 0;
13921 interp->signal_level -= sig;
13923 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13924 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13925 /* Not caught, pass it up */
13926 return exitCode;
13929 if (sig && exitCode == JIM_SIGNAL) {
13930 /* Catch the signal at this level */
13931 if (interp->signal_set_result) {
13932 interp->signal_set_result(interp, interp->sigmask);
13934 else {
13935 Jim_SetResultInt(interp, interp->sigmask);
13937 interp->sigmask = 0;
13940 if (argc >= 2) {
13941 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13942 return JIM_ERR;
13944 if (argc == 3) {
13945 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13947 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13948 Jim_ListAppendElement(interp, optListObj,
13949 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13950 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13951 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13952 if (exitCode == JIM_ERR) {
13953 Jim_Obj *errorCode;
13954 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13955 -1));
13956 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13958 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13959 if (errorCode) {
13960 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13961 Jim_ListAppendElement(interp, optListObj, errorCode);
13964 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13965 return JIM_ERR;
13969 Jim_SetResultInt(interp, exitCode);
13970 return JIM_OK;
13973 #ifdef JIM_REFERENCES
13975 /* [ref] */
13976 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13978 if (argc != 3 && argc != 4) {
13979 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13980 return JIM_ERR;
13982 if (argc == 3) {
13983 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13985 else {
13986 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13988 return JIM_OK;
13991 /* [getref] */
13992 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13994 Jim_Reference *refPtr;
13996 if (argc != 2) {
13997 Jim_WrongNumArgs(interp, 1, argv, "reference");
13998 return JIM_ERR;
14000 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14001 return JIM_ERR;
14002 Jim_SetResult(interp, refPtr->objPtr);
14003 return JIM_OK;
14006 /* [setref] */
14007 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14009 Jim_Reference *refPtr;
14011 if (argc != 3) {
14012 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14013 return JIM_ERR;
14015 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14016 return JIM_ERR;
14017 Jim_IncrRefCount(argv[2]);
14018 Jim_DecrRefCount(interp, refPtr->objPtr);
14019 refPtr->objPtr = argv[2];
14020 Jim_SetResult(interp, argv[2]);
14021 return JIM_OK;
14024 /* [collect] */
14025 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14027 if (argc != 1) {
14028 Jim_WrongNumArgs(interp, 1, argv, "");
14029 return JIM_ERR;
14031 Jim_SetResultInt(interp, Jim_Collect(interp));
14033 /* Free all the freed objects. */
14034 while (interp->freeList) {
14035 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14036 Jim_Free(interp->freeList);
14037 interp->freeList = nextObjPtr;
14040 return JIM_OK;
14043 /* [finalize] reference ?newValue? */
14044 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14046 if (argc != 2 && argc != 3) {
14047 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14048 return JIM_ERR;
14050 if (argc == 2) {
14051 Jim_Obj *cmdNamePtr;
14053 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14054 return JIM_ERR;
14055 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14056 Jim_SetResult(interp, cmdNamePtr);
14058 else {
14059 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14060 return JIM_ERR;
14061 Jim_SetResult(interp, argv[2]);
14063 return JIM_OK;
14066 /* [info references] */
14067 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14069 Jim_Obj *listObjPtr;
14070 Jim_HashTableIterator htiter;
14071 Jim_HashEntry *he;
14073 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14075 JimInitHashTableIterator(&interp->references, &htiter);
14076 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14077 char buf[JIM_REFERENCE_SPACE + 1];
14078 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14079 const unsigned long *refId = he->key;
14081 JimFormatReference(buf, refPtr, *refId);
14082 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14084 Jim_SetResult(interp, listObjPtr);
14085 return JIM_OK;
14087 #endif
14089 /* [rename] */
14090 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14092 if (argc != 3) {
14093 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14094 return JIM_ERR;
14097 if (JimValidName(interp, "new procedure", argv[2])) {
14098 return JIM_ERR;
14101 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14104 #define JIM_DICTMATCH_VALUES 0x0001
14106 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14108 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14110 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14111 if (type & JIM_DICTMATCH_VALUES) {
14112 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14117 * Like JimHashtablePatternMatch, but for dictionaries.
14119 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14120 JimDictMatchCallbackType *callback, int type)
14122 Jim_HashEntry *he;
14123 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14125 /* Check for the non-pattern case. We can do this much more efficiently. */
14126 Jim_HashTableIterator htiter;
14127 JimInitHashTableIterator(ht, &htiter);
14128 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14129 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14130 callback(interp, listObjPtr, he, type);
14134 return listObjPtr;
14138 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14140 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14141 return JIM_ERR;
14143 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14144 return JIM_OK;
14147 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14149 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14150 return JIM_ERR;
14152 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14153 return JIM_OK;
14156 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14158 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14159 return -1;
14161 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14164 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14166 Jim_HashTable *ht;
14167 unsigned int i;
14169 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14170 return JIM_ERR;
14173 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14175 /* Note that this uses internal knowledge of the hash table */
14176 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14178 for (i = 0; i < ht->size; i++) {
14179 Jim_HashEntry *he = ht->table[i];
14181 if (he) {
14182 printf("%d: ", i);
14184 while (he) {
14185 printf(" %s", Jim_String(he->key));
14186 he = he->next;
14188 printf("\n");
14191 return JIM_OK;
14194 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14196 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14198 Jim_AppendString(interp, prefixObj, " ", 1);
14199 Jim_AppendString(interp, prefixObj, subcmd, -1);
14201 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14204 /* [dict] */
14205 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14207 Jim_Obj *objPtr;
14208 int option;
14209 static const char * const options[] = {
14210 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14211 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14212 "replace", "update", NULL
14214 enum
14216 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14217 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14218 OPT_REPLACE, OPT_UPDATE,
14221 if (argc < 2) {
14222 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14223 return JIM_ERR;
14226 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14227 return JIM_ERR;
14230 switch (option) {
14231 case OPT_GET:
14232 if (argc < 3) {
14233 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14234 return JIM_ERR;
14236 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14237 JIM_ERRMSG) != JIM_OK) {
14238 return JIM_ERR;
14240 Jim_SetResult(interp, objPtr);
14241 return JIM_OK;
14243 case OPT_SET:
14244 if (argc < 5) {
14245 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14246 return JIM_ERR;
14248 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14250 case OPT_EXISTS:
14251 if (argc < 4) {
14252 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14253 return JIM_ERR;
14255 else {
14256 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14257 if (rc < 0) {
14258 return JIM_ERR;
14260 Jim_SetResultBool(interp, rc == JIM_OK);
14261 return JIM_OK;
14264 case OPT_UNSET:
14265 if (argc < 4) {
14266 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14267 return JIM_ERR;
14269 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14270 return JIM_ERR;
14272 return JIM_OK;
14274 case OPT_KEYS:
14275 if (argc != 3 && argc != 4) {
14276 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14277 return JIM_ERR;
14279 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14281 case OPT_SIZE:
14282 if (argc != 3) {
14283 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14284 return JIM_ERR;
14286 else if (Jim_DictSize(interp, argv[2]) < 0) {
14287 return JIM_ERR;
14289 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14290 return JIM_OK;
14292 case OPT_MERGE:
14293 if (argc == 2) {
14294 return JIM_OK;
14296 if (Jim_DictSize(interp, argv[2]) < 0) {
14297 return JIM_ERR;
14299 /* Handle as ensemble */
14300 break;
14302 case OPT_UPDATE:
14303 if (argc < 6 || argc % 2) {
14304 /* Better error message */
14305 argc = 2;
14307 break;
14309 case OPT_CREATE:
14310 if (argc % 2) {
14311 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14312 return JIM_ERR;
14314 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14315 Jim_SetResult(interp, objPtr);
14316 return JIM_OK;
14318 case OPT_INFO:
14319 if (argc != 3) {
14320 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14321 return JIM_ERR;
14323 return Jim_DictInfo(interp, argv[2]);
14325 /* Handle command as an ensemble */
14326 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14329 /* [subst] */
14330 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14332 static const char * const options[] = {
14333 "-nobackslashes", "-nocommands", "-novariables", NULL
14335 enum
14336 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14337 int i;
14338 int flags = JIM_SUBST_FLAG;
14339 Jim_Obj *objPtr;
14341 if (argc < 2) {
14342 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14343 return JIM_ERR;
14345 for (i = 1; i < (argc - 1); i++) {
14346 int option;
14348 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14349 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14350 return JIM_ERR;
14352 switch (option) {
14353 case OPT_NOBACKSLASHES:
14354 flags |= JIM_SUBST_NOESC;
14355 break;
14356 case OPT_NOCOMMANDS:
14357 flags |= JIM_SUBST_NOCMD;
14358 break;
14359 case OPT_NOVARIABLES:
14360 flags |= JIM_SUBST_NOVAR;
14361 break;
14364 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14365 return JIM_ERR;
14367 Jim_SetResult(interp, objPtr);
14368 return JIM_OK;
14371 /* [info] */
14372 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14374 int cmd;
14375 Jim_Obj *objPtr;
14376 int mode = 0;
14378 static const char * const commands[] = {
14379 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14380 "vars", "version", "patchlevel", "complete", "args", "hostname",
14381 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14382 "references", "alias", NULL
14384 enum
14385 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14386 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14387 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14388 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14391 #ifdef jim_ext_namespace
14392 int nons = 0;
14394 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14395 /* This is for internal use only */
14396 argc--;
14397 argv++;
14398 nons = 1;
14400 #endif
14402 if (argc < 2) {
14403 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14404 return JIM_ERR;
14406 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14407 != JIM_OK) {
14408 return JIM_ERR;
14411 /* Test for the the most common commands first, just in case it makes a difference */
14412 switch (cmd) {
14413 case INFO_EXISTS:
14414 if (argc != 3) {
14415 Jim_WrongNumArgs(interp, 2, argv, "varName");
14416 return JIM_ERR;
14418 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14419 break;
14421 case INFO_ALIAS:{
14422 Jim_Cmd *cmdPtr;
14424 if (argc != 3) {
14425 Jim_WrongNumArgs(interp, 2, argv, "command");
14426 return JIM_ERR;
14428 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14429 return JIM_ERR;
14431 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14432 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14433 return JIM_ERR;
14435 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14436 return JIM_OK;
14439 case INFO_CHANNELS:
14440 mode++; /* JIM_CMDLIST_CHANNELS */
14441 #ifndef jim_ext_aio
14442 Jim_SetResultString(interp, "aio not enabled", -1);
14443 return JIM_ERR;
14444 #endif
14445 /* fall through */
14446 case INFO_PROCS:
14447 mode++; /* JIM_CMDLIST_PROCS */
14448 /* fall through */
14449 case INFO_COMMANDS:
14450 /* mode 0 => JIM_CMDLIST_COMMANDS */
14451 if (argc != 2 && argc != 3) {
14452 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14453 return JIM_ERR;
14455 #ifdef jim_ext_namespace
14456 if (!nons) {
14457 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14458 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14461 #endif
14462 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14463 break;
14465 case INFO_VARS:
14466 mode++; /* JIM_VARLIST_VARS */
14467 /* fall through */
14468 case INFO_LOCALS:
14469 mode++; /* JIM_VARLIST_LOCALS */
14470 /* fall through */
14471 case INFO_GLOBALS:
14472 /* mode 0 => JIM_VARLIST_GLOBALS */
14473 if (argc != 2 && argc != 3) {
14474 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14475 return JIM_ERR;
14477 #ifdef jim_ext_namespace
14478 if (!nons) {
14479 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14480 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14483 #endif
14484 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14485 break;
14487 case INFO_SCRIPT:
14488 if (argc != 2) {
14489 Jim_WrongNumArgs(interp, 2, argv, "");
14490 return JIM_ERR;
14492 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14493 break;
14495 case INFO_SOURCE:{
14496 jim_wide line;
14497 Jim_Obj *resObjPtr;
14498 Jim_Obj *fileNameObj;
14500 if (argc != 3 && argc != 5) {
14501 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14502 return JIM_ERR;
14504 if (argc == 5) {
14505 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14506 return JIM_ERR;
14508 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14509 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14511 else {
14512 if (argv[2]->typePtr == &sourceObjType) {
14513 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14514 line = argv[2]->internalRep.sourceValue.lineNumber;
14516 else if (argv[2]->typePtr == &scriptObjType) {
14517 ScriptObj *script = JimGetScript(interp, argv[2]);
14518 fileNameObj = script->fileNameObj;
14519 line = script->firstline;
14521 else {
14522 fileNameObj = interp->emptyObj;
14523 line = 1;
14525 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14526 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14527 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14529 Jim_SetResult(interp, resObjPtr);
14530 break;
14533 case INFO_STACKTRACE:
14534 Jim_SetResult(interp, interp->stackTrace);
14535 break;
14537 case INFO_LEVEL:
14538 case INFO_FRAME:
14539 switch (argc) {
14540 case 2:
14541 Jim_SetResultInt(interp, interp->framePtr->level);
14542 break;
14544 case 3:
14545 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14546 return JIM_ERR;
14548 Jim_SetResult(interp, objPtr);
14549 break;
14551 default:
14552 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14553 return JIM_ERR;
14555 break;
14557 case INFO_BODY:
14558 case INFO_STATICS:
14559 case INFO_ARGS:{
14560 Jim_Cmd *cmdPtr;
14562 if (argc != 3) {
14563 Jim_WrongNumArgs(interp, 2, argv, "procname");
14564 return JIM_ERR;
14566 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14567 return JIM_ERR;
14569 if (!cmdPtr->isproc) {
14570 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14571 return JIM_ERR;
14573 switch (cmd) {
14574 case INFO_BODY:
14575 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14576 break;
14577 case INFO_ARGS:
14578 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14579 break;
14580 case INFO_STATICS:
14581 if (cmdPtr->u.proc.staticVars) {
14582 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14583 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14584 NULL, JimVariablesMatch, mode));
14586 break;
14588 break;
14591 case INFO_VERSION:
14592 case INFO_PATCHLEVEL:{
14593 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14595 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14596 Jim_SetResultString(interp, buf, -1);
14597 break;
14600 case INFO_COMPLETE:
14601 if (argc != 3 && argc != 4) {
14602 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14603 return JIM_ERR;
14605 else {
14606 int len;
14607 const char *s = Jim_GetString(argv[2], &len);
14608 char missing;
14610 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14611 if (missing != ' ' && argc == 4) {
14612 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14615 break;
14617 case INFO_HOSTNAME:
14618 /* Redirect to os.gethostname if it exists */
14619 return Jim_Eval(interp, "os.gethostname");
14621 case INFO_NAMEOFEXECUTABLE:
14622 /* Redirect to Tcl proc */
14623 return Jim_Eval(interp, "{info nameofexecutable}");
14625 case INFO_RETURNCODES:
14626 if (argc == 2) {
14627 int i;
14628 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14630 for (i = 0; jimReturnCodes[i]; i++) {
14631 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14632 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14633 jimReturnCodes[i], -1));
14636 Jim_SetResult(interp, listObjPtr);
14638 else if (argc == 3) {
14639 long code;
14640 const char *name;
14642 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14643 return JIM_ERR;
14645 name = Jim_ReturnCode(code);
14646 if (*name == '?') {
14647 Jim_SetResultInt(interp, code);
14649 else {
14650 Jim_SetResultString(interp, name, -1);
14653 else {
14654 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14655 return JIM_ERR;
14657 break;
14658 case INFO_REFERENCES:
14659 #ifdef JIM_REFERENCES
14660 return JimInfoReferences(interp, argc, argv);
14661 #else
14662 Jim_SetResultString(interp, "not supported", -1);
14663 return JIM_ERR;
14664 #endif
14666 return JIM_OK;
14669 /* [exists] */
14670 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14672 Jim_Obj *objPtr;
14673 int result = 0;
14675 static const char * const options[] = {
14676 "-command", "-proc", "-alias", "-var", NULL
14678 enum
14680 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14682 int option;
14684 if (argc == 2) {
14685 option = OPT_VAR;
14686 objPtr = argv[1];
14688 else if (argc == 3) {
14689 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14690 return JIM_ERR;
14692 objPtr = argv[2];
14694 else {
14695 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14696 return JIM_ERR;
14699 if (option == OPT_VAR) {
14700 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14702 else {
14703 /* Now different kinds of commands */
14704 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14706 if (cmd) {
14707 switch (option) {
14708 case OPT_COMMAND:
14709 result = 1;
14710 break;
14712 case OPT_ALIAS:
14713 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14714 break;
14716 case OPT_PROC:
14717 result = cmd->isproc;
14718 break;
14722 Jim_SetResultBool(interp, result);
14723 return JIM_OK;
14726 /* [split] */
14727 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14729 const char *str, *splitChars, *noMatchStart;
14730 int splitLen, strLen;
14731 Jim_Obj *resObjPtr;
14732 int c;
14733 int len;
14735 if (argc != 2 && argc != 3) {
14736 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14737 return JIM_ERR;
14740 str = Jim_GetString(argv[1], &len);
14741 if (len == 0) {
14742 return JIM_OK;
14744 strLen = Jim_Utf8Length(interp, argv[1]);
14746 /* Init */
14747 if (argc == 2) {
14748 splitChars = " \n\t\r";
14749 splitLen = 4;
14751 else {
14752 splitChars = Jim_String(argv[2]);
14753 splitLen = Jim_Utf8Length(interp, argv[2]);
14756 noMatchStart = str;
14757 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14759 /* Split */
14760 if (splitLen) {
14761 Jim_Obj *objPtr;
14762 while (strLen--) {
14763 const char *sc = splitChars;
14764 int scLen = splitLen;
14765 int sl = utf8_tounicode(str, &c);
14766 while (scLen--) {
14767 int pc;
14768 sc += utf8_tounicode(sc, &pc);
14769 if (c == pc) {
14770 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14771 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14772 noMatchStart = str + sl;
14773 break;
14776 str += sl;
14778 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14779 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14781 else {
14782 /* This handles the special case of splitchars eq {}
14783 * Optimise by sharing common (ASCII) characters
14785 Jim_Obj **commonObj = NULL;
14786 #define NUM_COMMON (128 - 9)
14787 while (strLen--) {
14788 int n = utf8_tounicode(str, &c);
14789 #ifdef JIM_OPTIMIZATION
14790 if (c >= 9 && c < 128) {
14791 /* Common ASCII char. Note that 9 is the tab character */
14792 c -= 9;
14793 if (!commonObj) {
14794 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14795 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14797 if (!commonObj[c]) {
14798 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14800 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14801 str++;
14802 continue;
14804 #endif
14805 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14806 str += n;
14808 Jim_Free(commonObj);
14811 Jim_SetResult(interp, resObjPtr);
14812 return JIM_OK;
14815 /* [join] */
14816 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14818 const char *joinStr;
14819 int joinStrLen;
14821 if (argc != 2 && argc != 3) {
14822 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14823 return JIM_ERR;
14825 /* Init */
14826 if (argc == 2) {
14827 joinStr = " ";
14828 joinStrLen = 1;
14830 else {
14831 joinStr = Jim_GetString(argv[2], &joinStrLen);
14833 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14834 return JIM_OK;
14837 /* [format] */
14838 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14840 Jim_Obj *objPtr;
14842 if (argc < 2) {
14843 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14844 return JIM_ERR;
14846 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14847 if (objPtr == NULL)
14848 return JIM_ERR;
14849 Jim_SetResult(interp, objPtr);
14850 return JIM_OK;
14853 /* [scan] */
14854 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14856 Jim_Obj *listPtr, **outVec;
14857 int outc, i;
14859 if (argc < 3) {
14860 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14861 return JIM_ERR;
14863 if (argv[2]->typePtr != &scanFmtStringObjType)
14864 SetScanFmtFromAny(interp, argv[2]);
14865 if (FormatGetError(argv[2]) != 0) {
14866 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14867 return JIM_ERR;
14869 if (argc > 3) {
14870 int maxPos = FormatGetMaxPos(argv[2]);
14871 int count = FormatGetCnvCount(argv[2]);
14873 if (maxPos > argc - 3) {
14874 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14875 return JIM_ERR;
14877 else if (count > argc - 3) {
14878 Jim_SetResultString(interp, "different numbers of variable names and "
14879 "field specifiers", -1);
14880 return JIM_ERR;
14882 else if (count < argc - 3) {
14883 Jim_SetResultString(interp, "variable is not assigned by any "
14884 "conversion specifiers", -1);
14885 return JIM_ERR;
14888 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14889 if (listPtr == 0)
14890 return JIM_ERR;
14891 if (argc > 3) {
14892 int rc = JIM_OK;
14893 int count = 0;
14895 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14896 int len = Jim_ListLength(interp, listPtr);
14898 if (len != 0) {
14899 JimListGetElements(interp, listPtr, &outc, &outVec);
14900 for (i = 0; i < outc; ++i) {
14901 if (Jim_Length(outVec[i]) > 0) {
14902 ++count;
14903 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14904 rc = JIM_ERR;
14909 Jim_FreeNewObj(interp, listPtr);
14911 else {
14912 count = -1;
14914 if (rc == JIM_OK) {
14915 Jim_SetResultInt(interp, count);
14917 return rc;
14919 else {
14920 if (listPtr == (Jim_Obj *)EOF) {
14921 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14922 return JIM_OK;
14924 Jim_SetResult(interp, listPtr);
14926 return JIM_OK;
14929 /* [error] */
14930 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14932 if (argc != 2 && argc != 3) {
14933 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14934 return JIM_ERR;
14936 Jim_SetResult(interp, argv[1]);
14937 if (argc == 3) {
14938 JimSetStackTrace(interp, argv[2]);
14939 return JIM_ERR;
14941 interp->addStackTrace++;
14942 return JIM_ERR;
14945 /* [lrange] */
14946 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14948 Jim_Obj *objPtr;
14950 if (argc != 4) {
14951 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14952 return JIM_ERR;
14954 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14955 return JIM_ERR;
14956 Jim_SetResult(interp, objPtr);
14957 return JIM_OK;
14960 /* [lrepeat] */
14961 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14963 Jim_Obj *objPtr;
14964 long count;
14966 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14967 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14968 return JIM_ERR;
14971 if (count == 0 || argc == 2) {
14972 return JIM_OK;
14975 argc -= 2;
14976 argv += 2;
14978 objPtr = Jim_NewListObj(interp, argv, argc);
14979 while (--count) {
14980 ListInsertElements(objPtr, -1, argc, argv);
14983 Jim_SetResult(interp, objPtr);
14984 return JIM_OK;
14987 char **Jim_GetEnviron(void)
14989 #if defined(HAVE__NSGETENVIRON)
14990 return *_NSGetEnviron();
14991 #else
14992 #if !defined(NO_ENVIRON_EXTERN)
14993 extern char **environ;
14994 #endif
14996 return environ;
14997 #endif
15000 void Jim_SetEnviron(char **env)
15002 #if defined(HAVE__NSGETENVIRON)
15003 *_NSGetEnviron() = env;
15004 #else
15005 #if !defined(NO_ENVIRON_EXTERN)
15006 extern char **environ;
15007 #endif
15009 environ = env;
15010 #endif
15013 /* [env] */
15014 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15016 const char *key;
15017 const char *val;
15019 if (argc == 1) {
15020 char **e = Jim_GetEnviron();
15022 int i;
15023 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15025 for (i = 0; e[i]; i++) {
15026 const char *equals = strchr(e[i], '=');
15028 if (equals) {
15029 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15030 equals - e[i]));
15031 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15035 Jim_SetResult(interp, listObjPtr);
15036 return JIM_OK;
15039 if (argc < 2) {
15040 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15041 return JIM_ERR;
15043 key = Jim_String(argv[1]);
15044 val = getenv(key);
15045 if (val == NULL) {
15046 if (argc < 3) {
15047 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15048 return JIM_ERR;
15050 val = Jim_String(argv[2]);
15052 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15053 return JIM_OK;
15056 /* [source] */
15057 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15059 int retval;
15061 if (argc != 2) {
15062 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15063 return JIM_ERR;
15065 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15066 if (retval == JIM_RETURN)
15067 return JIM_OK;
15068 return retval;
15071 /* [lreverse] */
15072 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15074 Jim_Obj *revObjPtr, **ele;
15075 int len;
15077 if (argc != 2) {
15078 Jim_WrongNumArgs(interp, 1, argv, "list");
15079 return JIM_ERR;
15081 JimListGetElements(interp, argv[1], &len, &ele);
15082 len--;
15083 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15084 while (len >= 0)
15085 ListAppendElement(revObjPtr, ele[len--]);
15086 Jim_SetResult(interp, revObjPtr);
15087 return JIM_OK;
15090 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15092 jim_wide len;
15094 if (step == 0)
15095 return -1;
15096 if (start == end)
15097 return 0;
15098 else if (step > 0 && start > end)
15099 return -1;
15100 else if (step < 0 && end > start)
15101 return -1;
15102 len = end - start;
15103 if (len < 0)
15104 len = -len; /* abs(len) */
15105 if (step < 0)
15106 step = -step; /* abs(step) */
15107 len = 1 + ((len - 1) / step);
15108 /* We can truncate safely to INT_MAX, the range command
15109 * will always return an error for a such long range
15110 * because Tcl lists can't be so long. */
15111 if (len > INT_MAX)
15112 len = INT_MAX;
15113 return (int)((len < 0) ? -1 : len);
15116 /* [range] */
15117 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15119 jim_wide start = 0, end, step = 1;
15120 int len, i;
15121 Jim_Obj *objPtr;
15123 if (argc < 2 || argc > 4) {
15124 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15125 return JIM_ERR;
15127 if (argc == 2) {
15128 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15129 return JIM_ERR;
15131 else {
15132 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15133 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15134 return JIM_ERR;
15135 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15136 return JIM_ERR;
15138 if ((len = JimRangeLen(start, end, step)) == -1) {
15139 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15140 return JIM_ERR;
15142 objPtr = Jim_NewListObj(interp, NULL, 0);
15143 for (i = 0; i < len; i++)
15144 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15145 Jim_SetResult(interp, objPtr);
15146 return JIM_OK;
15149 /* [rand] */
15150 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15152 jim_wide min = 0, max = 0, len, maxMul;
15154 if (argc < 1 || argc > 3) {
15155 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15156 return JIM_ERR;
15158 if (argc == 1) {
15159 max = JIM_WIDE_MAX;
15160 } else if (argc == 2) {
15161 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15162 return JIM_ERR;
15163 } else if (argc == 3) {
15164 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15165 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15166 return JIM_ERR;
15168 len = max-min;
15169 if (len < 0) {
15170 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15171 return JIM_ERR;
15173 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15174 while (1) {
15175 jim_wide r;
15177 JimRandomBytes(interp, &r, sizeof(jim_wide));
15178 if (r < 0 || r >= maxMul) continue;
15179 r = (len == 0) ? 0 : r%len;
15180 Jim_SetResultInt(interp, min+r);
15181 return JIM_OK;
15185 static const struct {
15186 const char *name;
15187 Jim_CmdProc *cmdProc;
15188 } Jim_CoreCommandsTable[] = {
15189 {"alias", Jim_AliasCoreCommand},
15190 {"set", Jim_SetCoreCommand},
15191 {"unset", Jim_UnsetCoreCommand},
15192 {"puts", Jim_PutsCoreCommand},
15193 {"+", Jim_AddCoreCommand},
15194 {"*", Jim_MulCoreCommand},
15195 {"-", Jim_SubCoreCommand},
15196 {"/", Jim_DivCoreCommand},
15197 {"incr", Jim_IncrCoreCommand},
15198 {"while", Jim_WhileCoreCommand},
15199 {"loop", Jim_LoopCoreCommand},
15200 {"for", Jim_ForCoreCommand},
15201 {"foreach", Jim_ForeachCoreCommand},
15202 {"lmap", Jim_LmapCoreCommand},
15203 {"lassign", Jim_LassignCoreCommand},
15204 {"if", Jim_IfCoreCommand},
15205 {"switch", Jim_SwitchCoreCommand},
15206 {"list", Jim_ListCoreCommand},
15207 {"lindex", Jim_LindexCoreCommand},
15208 {"lset", Jim_LsetCoreCommand},
15209 {"lsearch", Jim_LsearchCoreCommand},
15210 {"llength", Jim_LlengthCoreCommand},
15211 {"lappend", Jim_LappendCoreCommand},
15212 {"linsert", Jim_LinsertCoreCommand},
15213 {"lreplace", Jim_LreplaceCoreCommand},
15214 {"lsort", Jim_LsortCoreCommand},
15215 {"append", Jim_AppendCoreCommand},
15216 {"debug", Jim_DebugCoreCommand},
15217 {"eval", Jim_EvalCoreCommand},
15218 {"uplevel", Jim_UplevelCoreCommand},
15219 {"expr", Jim_ExprCoreCommand},
15220 {"break", Jim_BreakCoreCommand},
15221 {"continue", Jim_ContinueCoreCommand},
15222 {"proc", Jim_ProcCoreCommand},
15223 {"concat", Jim_ConcatCoreCommand},
15224 {"return", Jim_ReturnCoreCommand},
15225 {"upvar", Jim_UpvarCoreCommand},
15226 {"global", Jim_GlobalCoreCommand},
15227 {"string", Jim_StringCoreCommand},
15228 {"time", Jim_TimeCoreCommand},
15229 {"exit", Jim_ExitCoreCommand},
15230 {"catch", Jim_CatchCoreCommand},
15231 #ifdef JIM_REFERENCES
15232 {"ref", Jim_RefCoreCommand},
15233 {"getref", Jim_GetrefCoreCommand},
15234 {"setref", Jim_SetrefCoreCommand},
15235 {"finalize", Jim_FinalizeCoreCommand},
15236 {"collect", Jim_CollectCoreCommand},
15237 #endif
15238 {"rename", Jim_RenameCoreCommand},
15239 {"dict", Jim_DictCoreCommand},
15240 {"subst", Jim_SubstCoreCommand},
15241 {"info", Jim_InfoCoreCommand},
15242 {"exists", Jim_ExistsCoreCommand},
15243 {"split", Jim_SplitCoreCommand},
15244 {"join", Jim_JoinCoreCommand},
15245 {"format", Jim_FormatCoreCommand},
15246 {"scan", Jim_ScanCoreCommand},
15247 {"error", Jim_ErrorCoreCommand},
15248 {"lrange", Jim_LrangeCoreCommand},
15249 {"lrepeat", Jim_LrepeatCoreCommand},
15250 {"env", Jim_EnvCoreCommand},
15251 {"source", Jim_SourceCoreCommand},
15252 {"lreverse", Jim_LreverseCoreCommand},
15253 {"range", Jim_RangeCoreCommand},
15254 {"rand", Jim_RandCoreCommand},
15255 {"tailcall", Jim_TailcallCoreCommand},
15256 {"local", Jim_LocalCoreCommand},
15257 {"upcall", Jim_UpcallCoreCommand},
15258 {"apply", Jim_ApplyCoreCommand},
15259 {NULL, NULL},
15262 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15264 int i = 0;
15266 while (Jim_CoreCommandsTable[i].name != NULL) {
15267 Jim_CreateCommand(interp,
15268 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15269 i++;
15273 /* -----------------------------------------------------------------------------
15274 * Interactive prompt
15275 * ---------------------------------------------------------------------------*/
15276 void Jim_MakeErrorMessage(Jim_Interp *interp)
15278 Jim_Obj *argv[2];
15280 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15281 argv[1] = interp->result;
15283 Jim_EvalObjVector(interp, 2, argv);
15286 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15287 const char *prefix, const char *const *tablePtr, const char *name)
15289 int count;
15290 char **tablePtrSorted;
15291 int i;
15293 for (count = 0; tablePtr[count]; count++) {
15296 if (name == NULL) {
15297 name = "option";
15300 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15301 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15302 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15303 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15304 for (i = 0; i < count; i++) {
15305 if (i + 1 == count && count > 1) {
15306 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15308 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15309 if (i + 1 != count) {
15310 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15313 Jim_Free(tablePtrSorted);
15316 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15317 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15319 const char *bad = "bad ";
15320 const char *const *entryPtr = NULL;
15321 int i;
15322 int match = -1;
15323 int arglen;
15324 const char *arg = Jim_GetString(objPtr, &arglen);
15326 *indexPtr = -1;
15328 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15329 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15330 /* Found an exact match */
15331 *indexPtr = i;
15332 return JIM_OK;
15334 if (flags & JIM_ENUM_ABBREV) {
15335 /* Accept an unambiguous abbreviation.
15336 * Note that '-' doesnt' consitute a valid abbreviation
15338 if (strncmp(arg, *entryPtr, arglen) == 0) {
15339 if (*arg == '-' && arglen == 1) {
15340 break;
15342 if (match >= 0) {
15343 bad = "ambiguous ";
15344 goto ambiguous;
15346 match = i;
15351 /* If we had an unambiguous partial match */
15352 if (match >= 0) {
15353 *indexPtr = match;
15354 return JIM_OK;
15357 ambiguous:
15358 if (flags & JIM_ERRMSG) {
15359 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15361 return JIM_ERR;
15364 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15366 int i;
15368 for (i = 0; i < (int)len; i++) {
15369 if (array[i] && strcmp(array[i], name) == 0) {
15370 return i;
15373 return -1;
15376 int Jim_IsDict(Jim_Obj *objPtr)
15378 return objPtr->typePtr == &dictObjType;
15381 int Jim_IsList(Jim_Obj *objPtr)
15383 return objPtr->typePtr == &listObjType;
15387 * Very simple printf-like formatting, designed for error messages.
15389 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15390 * The resulting string is created and set as the result.
15392 * Each '%s' should correspond to a regular string parameter.
15393 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15394 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15396 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15398 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15400 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15402 /* Initial space needed */
15403 int len = strlen(format);
15404 int extra = 0;
15405 int n = 0;
15406 const char *params[5];
15407 char *buf;
15408 va_list args;
15409 int i;
15411 va_start(args, format);
15413 for (i = 0; i < len && n < 5; i++) {
15414 int l;
15416 if (strncmp(format + i, "%s", 2) == 0) {
15417 params[n] = va_arg(args, char *);
15419 l = strlen(params[n]);
15421 else if (strncmp(format + i, "%#s", 3) == 0) {
15422 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15424 params[n] = Jim_GetString(objPtr, &l);
15426 else {
15427 if (format[i] == '%') {
15428 i++;
15430 continue;
15432 n++;
15433 extra += l;
15436 len += extra;
15437 buf = Jim_Alloc(len + 1);
15438 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15440 va_end(args);
15442 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15445 /* stubs */
15446 #ifndef jim_ext_package
15447 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15449 return JIM_OK;
15451 #endif
15452 #ifndef jim_ext_aio
15453 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15455 Jim_SetResultString(interp, "aio not enabled", -1);
15456 return NULL;
15458 #endif
15462 * Local Variables: ***
15463 * c-basic-offset: 4 ***
15464 * tab-width: 4 ***
15465 * End: ***