build: Fix exit code on test failure
[jimtcl.git] / jim.c
blob5b61a5d724e74ff80d14b06dcb2e4597c1a1754b
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 case ')':
1689 /* Only need a separate ')' token if the previous was a var */
1690 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1691 if (pc->p == pc->tstart) {
1692 /* At the start of the token, so just return this char */
1693 pc->p++;
1694 pc->len--;
1696 pc->tend = pc->p - 1;
1697 pc->tt = JIM_TT_ESC;
1698 return JIM_OK;
1700 break;
1702 case '$':
1703 case '[':
1704 pc->tend = pc->p - 1;
1705 pc->tt = JIM_TT_ESC;
1706 return JIM_OK;
1707 case ' ':
1708 case '\t':
1709 case '\n':
1710 case '\r':
1711 case '\f':
1712 case ';':
1713 if (pc->state == JIM_PS_DEF) {
1714 pc->tend = pc->p - 1;
1715 pc->tt = JIM_TT_ESC;
1716 return JIM_OK;
1718 else if (*pc->p == '\n') {
1719 pc->linenr++;
1721 break;
1722 case '"':
1723 if (pc->state == JIM_PS_QUOTE) {
1724 pc->tend = pc->p - 1;
1725 pc->tt = JIM_TT_ESC;
1726 pc->p++;
1727 pc->len--;
1728 pc->state = JIM_PS_DEF;
1729 return JIM_OK;
1731 break;
1733 pc->p++;
1734 pc->len--;
1736 return JIM_OK; /* unreached */
1739 static int JimParseComment(struct JimParserCtx *pc)
1741 while (*pc->p) {
1742 if (*pc->p == '\\') {
1743 pc->p++;
1744 pc->len--;
1745 if (pc->len == 0) {
1746 pc->missing.ch = '\\';
1747 return JIM_OK;
1749 if (*pc->p == '\n') {
1750 pc->linenr++;
1753 else if (*pc->p == '\n') {
1754 pc->p++;
1755 pc->len--;
1756 pc->linenr++;
1757 break;
1759 pc->p++;
1760 pc->len--;
1762 return JIM_OK;
1765 /* xdigitval and odigitval are helper functions for JimEscape() */
1766 static int xdigitval(int c)
1768 if (c >= '0' && c <= '9')
1769 return c - '0';
1770 if (c >= 'a' && c <= 'f')
1771 return c - 'a' + 10;
1772 if (c >= 'A' && c <= 'F')
1773 return c - 'A' + 10;
1774 return -1;
1777 static int odigitval(int c)
1779 if (c >= '0' && c <= '7')
1780 return c - '0';
1781 return -1;
1784 /* Perform Tcl escape substitution of 's', storing the result
1785 * string into 'dest'. The escaped string is guaranteed to
1786 * be the same length or shorted than the source string.
1787 * Slen is the length of the string at 's', if it's -1 the string
1788 * length will be calculated by the function.
1790 * The function returns the length of the resulting string. */
1791 static int JimEscape(char *dest, const char *s, int slen)
1793 char *p = dest;
1794 int i, len;
1796 if (slen == -1)
1797 slen = strlen(s);
1799 for (i = 0; i < slen; i++) {
1800 switch (s[i]) {
1801 case '\\':
1802 switch (s[i + 1]) {
1803 case 'a':
1804 *p++ = 0x7;
1805 i++;
1806 break;
1807 case 'b':
1808 *p++ = 0x8;
1809 i++;
1810 break;
1811 case 'f':
1812 *p++ = 0xc;
1813 i++;
1814 break;
1815 case 'n':
1816 *p++ = 0xa;
1817 i++;
1818 break;
1819 case 'r':
1820 *p++ = 0xd;
1821 i++;
1822 break;
1823 case 't':
1824 *p++ = 0x9;
1825 i++;
1826 break;
1827 case 'u':
1828 case 'U':
1829 case 'x':
1830 /* A unicode or hex sequence.
1831 * \x Expect 1-2 hex chars and convert to hex.
1832 * \u Expect 1-4 hex chars and convert to utf-8.
1833 * \U Expect 1-8 hex chars and convert to utf-8.
1834 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1835 * An invalid sequence means simply the escaped char.
1838 unsigned val = 0;
1839 int k;
1840 int maxchars = 2;
1842 i++;
1844 if (s[i] == 'U') {
1845 maxchars = 8;
1847 else if (s[i] == 'u') {
1848 if (s[i + 1] == '{') {
1849 maxchars = 6;
1850 i++;
1852 else {
1853 maxchars = 4;
1857 for (k = 0; k < maxchars; k++) {
1858 int c = xdigitval(s[i + k + 1]);
1859 if (c == -1) {
1860 break;
1862 val = (val << 4) | c;
1864 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1865 if (s[i] == '{') {
1866 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1867 /* Back up */
1868 i--;
1869 k = 0;
1871 else {
1872 /* Skip the closing brace */
1873 k++;
1876 if (k) {
1877 /* Got a valid sequence, so convert */
1878 if (s[i] == 'x') {
1879 *p++ = val;
1881 else {
1882 p += utf8_fromunicode(p, val);
1884 i += k;
1885 break;
1887 /* Not a valid codepoint, just an escaped char */
1888 *p++ = s[i];
1890 break;
1891 case 'v':
1892 *p++ = 0xb;
1893 i++;
1894 break;
1895 case '\0':
1896 *p++ = '\\';
1897 i++;
1898 break;
1899 case '\n':
1900 /* Replace all spaces and tabs after backslash newline with a single space*/
1901 *p++ = ' ';
1902 do {
1903 i++;
1904 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1905 break;
1906 case '0':
1907 case '1':
1908 case '2':
1909 case '3':
1910 case '4':
1911 case '5':
1912 case '6':
1913 case '7':
1914 /* octal escape */
1916 int val = 0;
1917 int c = odigitval(s[i + 1]);
1919 val = c;
1920 c = odigitval(s[i + 2]);
1921 if (c == -1) {
1922 *p++ = val;
1923 i++;
1924 break;
1926 val = (val * 8) + c;
1927 c = odigitval(s[i + 3]);
1928 if (c == -1) {
1929 *p++ = val;
1930 i += 2;
1931 break;
1933 val = (val * 8) + c;
1934 *p++ = val;
1935 i += 3;
1937 break;
1938 default:
1939 *p++ = s[i + 1];
1940 i++;
1941 break;
1943 break;
1944 default:
1945 *p++ = s[i];
1946 break;
1949 len = p - dest;
1950 *p = '\0';
1951 return len;
1954 /* Returns a dynamically allocated copy of the current token in the
1955 * parser context. The function performs conversion of escapes if
1956 * the token is of type JIM_TT_ESC.
1958 * Note that after the conversion, tokens that are grouped with
1959 * braces in the source code, are always recognizable from the
1960 * identical string obtained in a different way from the type.
1962 * For example the string:
1964 * {*}$a
1966 * will return as first token "*", of type JIM_TT_STR
1968 * While the string:
1970 * *$a
1972 * will return as first token "*", of type JIM_TT_ESC
1974 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1976 const char *start, *end;
1977 char *token;
1978 int len;
1980 start = pc->tstart;
1981 end = pc->tend;
1982 if (start > end) {
1983 len = 0;
1984 token = Jim_Alloc(1);
1985 token[0] = '\0';
1987 else {
1988 len = (end - start) + 1;
1989 token = Jim_Alloc(len + 1);
1990 if (pc->tt != JIM_TT_ESC) {
1991 /* No escape conversion needed? Just copy it. */
1992 memcpy(token, start, len);
1993 token[len] = '\0';
1995 else {
1996 /* Else convert the escape chars. */
1997 len = JimEscape(token, start, len);
2001 return Jim_NewStringObjNoAlloc(interp, token, len);
2004 /* Parses the given string to determine if it represents a complete script.
2006 * This is useful for interactive shells implementation, for [info complete].
2008 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2009 * '{' on scripts incomplete missing one or more '}' to be balanced.
2010 * '[' on scripts incomplete missing one or more ']' to be balanced.
2011 * '"' on scripts incomplete missing a '"' char.
2012 * '\\' on scripts with a trailing backslash.
2014 * If the script is complete, 1 is returned, otherwise 0.
2016 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2018 struct JimParserCtx parser;
2020 JimParserInit(&parser, s, len, 1);
2021 while (!parser.eof) {
2022 JimParseScript(&parser);
2024 if (stateCharPtr) {
2025 *stateCharPtr = parser.missing.ch;
2027 return parser.missing.ch == ' ';
2030 /* -----------------------------------------------------------------------------
2031 * Tcl Lists parsing
2032 * ---------------------------------------------------------------------------*/
2033 static int JimParseListSep(struct JimParserCtx *pc);
2034 static int JimParseListStr(struct JimParserCtx *pc);
2035 static int JimParseListQuote(struct JimParserCtx *pc);
2037 static int JimParseList(struct JimParserCtx *pc)
2039 if (isspace(UCHAR(*pc->p))) {
2040 return JimParseListSep(pc);
2042 switch (*pc->p) {
2043 case '"':
2044 return JimParseListQuote(pc);
2046 case '{':
2047 return JimParseBrace(pc);
2049 default:
2050 if (pc->len) {
2051 return JimParseListStr(pc);
2053 break;
2056 pc->tstart = pc->tend = pc->p;
2057 pc->tline = pc->linenr;
2058 pc->tt = JIM_TT_EOL;
2059 pc->eof = 1;
2060 return JIM_OK;
2063 static int JimParseListSep(struct JimParserCtx *pc)
2065 pc->tstart = pc->p;
2066 pc->tline = pc->linenr;
2067 while (isspace(UCHAR(*pc->p))) {
2068 if (*pc->p == '\n') {
2069 pc->linenr++;
2071 pc->p++;
2072 pc->len--;
2074 pc->tend = pc->p - 1;
2075 pc->tt = JIM_TT_SEP;
2076 return JIM_OK;
2079 static int JimParseListQuote(struct JimParserCtx *pc)
2081 pc->p++;
2082 pc->len--;
2084 pc->tstart = pc->p;
2085 pc->tline = pc->linenr;
2086 pc->tt = JIM_TT_STR;
2088 while (pc->len) {
2089 switch (*pc->p) {
2090 case '\\':
2091 pc->tt = JIM_TT_ESC;
2092 if (--pc->len == 0) {
2093 /* Trailing backslash */
2094 pc->tend = pc->p;
2095 return JIM_OK;
2097 pc->p++;
2098 break;
2099 case '\n':
2100 pc->linenr++;
2101 break;
2102 case '"':
2103 pc->tend = pc->p - 1;
2104 pc->p++;
2105 pc->len--;
2106 return JIM_OK;
2108 pc->p++;
2109 pc->len--;
2112 pc->tend = pc->p - 1;
2113 return JIM_OK;
2116 static int JimParseListStr(struct JimParserCtx *pc)
2118 pc->tstart = pc->p;
2119 pc->tline = pc->linenr;
2120 pc->tt = JIM_TT_STR;
2122 while (pc->len) {
2123 if (isspace(UCHAR(*pc->p))) {
2124 pc->tend = pc->p - 1;
2125 return JIM_OK;
2127 if (*pc->p == '\\') {
2128 if (--pc->len == 0) {
2129 /* Trailing backslash */
2130 pc->tend = pc->p;
2131 return JIM_OK;
2133 pc->tt = JIM_TT_ESC;
2134 pc->p++;
2136 pc->p++;
2137 pc->len--;
2139 pc->tend = pc->p - 1;
2140 return JIM_OK;
2143 /* -----------------------------------------------------------------------------
2144 * Jim_Obj related functions
2145 * ---------------------------------------------------------------------------*/
2147 /* Return a new initialized object. */
2148 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2150 Jim_Obj *objPtr;
2152 /* -- Check if there are objects in the free list -- */
2153 if (interp->freeList != NULL) {
2154 /* -- Unlink the object from the free list -- */
2155 objPtr = interp->freeList;
2156 interp->freeList = objPtr->nextObjPtr;
2158 else {
2159 /* -- No ready to use objects: allocate a new one -- */
2160 objPtr = Jim_Alloc(sizeof(*objPtr));
2163 /* Object is returned with refCount of 0. Every
2164 * kind of GC implemented should take care to don't try
2165 * to scan objects with refCount == 0. */
2166 objPtr->refCount = 0;
2167 /* All the other fields are left not initialized to save time.
2168 * The caller will probably want to set them to the right
2169 * value anyway. */
2171 /* -- Put the object into the live list -- */
2172 objPtr->prevObjPtr = NULL;
2173 objPtr->nextObjPtr = interp->liveList;
2174 if (interp->liveList)
2175 interp->liveList->prevObjPtr = objPtr;
2176 interp->liveList = objPtr;
2178 return objPtr;
2181 /* Free an object. Actually objects are never freed, but
2182 * just moved to the free objects list, where they will be
2183 * reused by Jim_NewObj(). */
2184 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2186 /* Check if the object was already freed, panic. */
2187 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2188 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2190 /* Free the internal representation */
2191 Jim_FreeIntRep(interp, objPtr);
2192 /* Free the string representation */
2193 if (objPtr->bytes != NULL) {
2194 if (objPtr->bytes != JimEmptyStringRep)
2195 Jim_Free(objPtr->bytes);
2197 /* Unlink the object from the live objects list */
2198 if (objPtr->prevObjPtr)
2199 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2200 if (objPtr->nextObjPtr)
2201 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2202 if (interp->liveList == objPtr)
2203 interp->liveList = objPtr->nextObjPtr;
2204 #ifdef JIM_DISABLE_OBJECT_POOL
2205 Jim_Free(objPtr);
2206 #else
2207 /* Link the object into the free objects list */
2208 objPtr->prevObjPtr = NULL;
2209 objPtr->nextObjPtr = interp->freeList;
2210 if (interp->freeList)
2211 interp->freeList->prevObjPtr = objPtr;
2212 interp->freeList = objPtr;
2213 objPtr->refCount = -1;
2214 #endif
2217 /* Invalidate the string representation of an object. */
2218 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2220 if (objPtr->bytes != NULL) {
2221 if (objPtr->bytes != JimEmptyStringRep)
2222 Jim_Free(objPtr->bytes);
2224 objPtr->bytes = NULL;
2227 /* Duplicate an object. The returned object has refcount = 0. */
2228 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2230 Jim_Obj *dupPtr;
2232 dupPtr = Jim_NewObj(interp);
2233 if (objPtr->bytes == NULL) {
2234 /* Object does not have a valid string representation. */
2235 dupPtr->bytes = NULL;
2237 else if (objPtr->length == 0) {
2238 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2239 dupPtr->bytes = JimEmptyStringRep;
2240 dupPtr->length = 0;
2241 dupPtr->typePtr = NULL;
2242 return dupPtr;
2244 else {
2245 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2246 dupPtr->length = objPtr->length;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr->typePtr = objPtr->typePtr;
2253 if (objPtr->typePtr != NULL) {
2254 if (objPtr->typePtr->dupIntRepProc == NULL) {
2255 dupPtr->internalRep = objPtr->internalRep;
2257 else {
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2262 return dupPtr;
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2271 if (objPtr->bytes == NULL) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2274 objPtr->typePtr->updateStringProc(objPtr);
2276 if (lenPtr)
2277 *lenPtr = objPtr->length;
2278 return objPtr->bytes;
2281 /* Just returns the length of the object's string rep */
2282 int Jim_Length(Jim_Obj *objPtr)
2284 if (objPtr->bytes == NULL) {
2285 /* Invalid string repr. Generate it. */
2286 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2287 objPtr->typePtr->updateStringProc(objPtr);
2289 return objPtr->length;
2292 /* Just returns object's string rep */
2293 const char *Jim_String(Jim_Obj *objPtr)
2295 if (objPtr->bytes == NULL) {
2296 /* Invalid string repr. Generate it. */
2297 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2298 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2299 objPtr->typePtr->updateStringProc(objPtr);
2301 return objPtr->bytes;
2304 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2306 objPtr->bytes = Jim_StrDup(str);
2307 objPtr->length = strlen(str);
2310 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2311 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2313 static const Jim_ObjType dictSubstObjType = {
2314 "dict-substitution",
2315 FreeDictSubstInternalRep,
2316 DupDictSubstInternalRep,
2317 NULL,
2318 JIM_TYPE_NONE,
2321 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2323 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2326 static const Jim_ObjType interpolatedObjType = {
2327 "interpolated",
2328 FreeInterpolatedInternalRep,
2329 NULL,
2330 NULL,
2331 JIM_TYPE_NONE,
2334 /* -----------------------------------------------------------------------------
2335 * String Object
2336 * ---------------------------------------------------------------------------*/
2337 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2338 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2340 static const Jim_ObjType stringObjType = {
2341 "string",
2342 NULL,
2343 DupStringInternalRep,
2344 NULL,
2345 JIM_TYPE_REFERENCES,
2348 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2350 JIM_NOTUSED(interp);
2352 /* This is a bit subtle: the only caller of this function
2353 * should be Jim_DuplicateObj(), that will copy the
2354 * string representaion. After the copy, the duplicated
2355 * object will not have more room in the buffer than
2356 * srcPtr->length bytes. So we just set it to length. */
2357 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2358 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2361 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2363 if (objPtr->typePtr != &stringObjType) {
2364 /* Get a fresh string representation. */
2365 if (objPtr->bytes == NULL) {
2366 /* Invalid string repr. Generate it. */
2367 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2368 objPtr->typePtr->updateStringProc(objPtr);
2370 /* Free any other internal representation. */
2371 Jim_FreeIntRep(interp, objPtr);
2372 /* Set it as string, i.e. just set the maxLength field. */
2373 objPtr->typePtr = &stringObjType;
2374 objPtr->internalRep.strValue.maxLength = objPtr->length;
2375 /* Don't know the utf-8 length yet */
2376 objPtr->internalRep.strValue.charLength = -1;
2378 return JIM_OK;
2382 * Returns the length of the object string in chars, not bytes.
2384 * These may be different for a utf-8 string.
2386 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2388 #ifdef JIM_UTF8
2389 SetStringFromAny(interp, objPtr);
2391 if (objPtr->internalRep.strValue.charLength < 0) {
2392 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2394 return objPtr->internalRep.strValue.charLength;
2395 #else
2396 return Jim_Length(objPtr);
2397 #endif
2400 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2401 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2403 Jim_Obj *objPtr = Jim_NewObj(interp);
2405 /* Need to find out how many bytes the string requires */
2406 if (len == -1)
2407 len = strlen(s);
2408 /* Alloc/Set the string rep. */
2409 if (len == 0) {
2410 objPtr->bytes = JimEmptyStringRep;
2412 else {
2413 objPtr->bytes = Jim_Alloc(len + 1);
2414 memcpy(objPtr->bytes, s, len);
2415 objPtr->bytes[len] = '\0';
2417 objPtr->length = len;
2419 /* No typePtr field for the vanilla string object. */
2420 objPtr->typePtr = NULL;
2421 return objPtr;
2424 /* charlen is in characters -- see also Jim_NewStringObj() */
2425 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2427 #ifdef JIM_UTF8
2428 /* Need to find out how many bytes the string requires */
2429 int bytelen = utf8_index(s, charlen);
2431 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2433 /* Remember the utf8 length, so set the type */
2434 objPtr->typePtr = &stringObjType;
2435 objPtr->internalRep.strValue.maxLength = bytelen;
2436 objPtr->internalRep.strValue.charLength = charlen;
2438 return objPtr;
2439 #else
2440 return Jim_NewStringObj(interp, s, charlen);
2441 #endif
2444 /* This version does not try to duplicate the 's' pointer, but
2445 * use it directly. */
2446 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2448 Jim_Obj *objPtr = Jim_NewObj(interp);
2450 objPtr->bytes = s;
2451 objPtr->length = (len == -1) ? strlen(s) : len;
2452 objPtr->typePtr = NULL;
2453 return objPtr;
2456 /* Low-level string append. Use it only against unshared objects
2457 * of type "string". */
2458 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2460 int needlen;
2462 if (len == -1)
2463 len = strlen(str);
2464 needlen = objPtr->length + len;
2465 if (objPtr->internalRep.strValue.maxLength < needlen ||
2466 objPtr->internalRep.strValue.maxLength == 0) {
2467 needlen *= 2;
2468 /* Inefficient to malloc() for less than 8 bytes */
2469 if (needlen < 7) {
2470 needlen = 7;
2472 if (objPtr->bytes == JimEmptyStringRep) {
2473 objPtr->bytes = Jim_Alloc(needlen + 1);
2475 else {
2476 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2478 objPtr->internalRep.strValue.maxLength = needlen;
2480 memcpy(objPtr->bytes + objPtr->length, str, len);
2481 objPtr->bytes[objPtr->length + len] = '\0';
2483 if (objPtr->internalRep.strValue.charLength >= 0) {
2484 /* Update the utf-8 char length */
2485 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2487 objPtr->length += len;
2490 /* Higher level API to append strings to objects.
2491 * Object must not be unshared for each of these.
2493 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2495 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2496 SetStringFromAny(interp, objPtr);
2497 StringAppendString(objPtr, str, len);
2500 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2502 int len;
2503 const char *str = Jim_GetString(appendObjPtr, &len);
2504 Jim_AppendString(interp, objPtr, str, len);
2507 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2509 va_list ap;
2511 SetStringFromAny(interp, objPtr);
2512 va_start(ap, objPtr);
2513 while (1) {
2514 const char *s = va_arg(ap, const char *);
2516 if (s == NULL)
2517 break;
2518 Jim_AppendString(interp, objPtr, s, -1);
2520 va_end(ap);
2523 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2525 if (aObjPtr == bObjPtr) {
2526 return 1;
2528 else {
2529 int Alen, Blen;
2530 const char *sA = Jim_GetString(aObjPtr, &Alen);
2531 const char *sB = Jim_GetString(bObjPtr, &Blen);
2533 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2538 * Note. Does not support embedded nulls in either the pattern or the object.
2540 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2542 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2546 * Note: does not support embedded nulls for the nocase option.
2548 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2550 int l1, l2;
2551 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2552 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2554 if (nocase) {
2555 /* Do a character compare for nocase */
2556 return JimStringCompareLen(s1, s2, -1, nocase);
2558 return JimStringCompare(s1, l1, s2, l2);
2562 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2564 * Note: does not support embedded nulls
2566 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2568 const char *s1 = Jim_String(firstObjPtr);
2569 const char *s2 = Jim_String(secondObjPtr);
2571 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2574 /* Convert a range, as returned by Jim_GetRange(), into
2575 * an absolute index into an object of the specified length.
2576 * This function may return negative values, or values
2577 * greater than or equal to the length of the list if the index
2578 * is out of range. */
2579 static int JimRelToAbsIndex(int len, int idx)
2581 if (idx < 0)
2582 return len + idx;
2583 return idx;
2586 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2587 * into a form suitable for implementation of commands like [string range] and [lrange].
2589 * The resulting range is guaranteed to address valid elements of
2590 * the structure.
2592 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2594 int rangeLen;
2596 if (*firstPtr > *lastPtr) {
2597 rangeLen = 0;
2599 else {
2600 rangeLen = *lastPtr - *firstPtr + 1;
2601 if (rangeLen) {
2602 if (*firstPtr < 0) {
2603 rangeLen += *firstPtr;
2604 *firstPtr = 0;
2606 if (*lastPtr >= len) {
2607 rangeLen -= (*lastPtr - (len - 1));
2608 *lastPtr = len - 1;
2612 if (rangeLen < 0)
2613 rangeLen = 0;
2615 *rangeLenPtr = rangeLen;
2618 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2619 int len, int *first, int *last, int *range)
2621 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2622 return JIM_ERR;
2624 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2625 return JIM_ERR;
2627 *first = JimRelToAbsIndex(len, *first);
2628 *last = JimRelToAbsIndex(len, *last);
2629 JimRelToAbsRange(len, first, last, range);
2630 return JIM_OK;
2633 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2634 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2636 int first, last;
2637 const char *str;
2638 int rangeLen;
2639 int bytelen;
2641 str = Jim_GetString(strObjPtr, &bytelen);
2643 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2644 return NULL;
2647 if (first == 0 && rangeLen == bytelen) {
2648 return strObjPtr;
2650 return Jim_NewStringObj(interp, str + first, rangeLen);
2653 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2654 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2656 #ifdef JIM_UTF8
2657 int first, last;
2658 const char *str;
2659 int len, rangeLen;
2660 int bytelen;
2662 str = Jim_GetString(strObjPtr, &bytelen);
2663 len = Jim_Utf8Length(interp, strObjPtr);
2665 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2666 return NULL;
2669 if (first == 0 && rangeLen == len) {
2670 return strObjPtr;
2672 if (len == bytelen) {
2673 /* ASCII optimisation */
2674 return Jim_NewStringObj(interp, str + first, rangeLen);
2676 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2677 #else
2678 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2679 #endif
2682 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2683 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2685 int first, last;
2686 const char *str;
2687 int len, rangeLen;
2688 Jim_Obj *objPtr;
2690 len = Jim_Utf8Length(interp, strObjPtr);
2692 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2693 return NULL;
2696 if (last < first) {
2697 return strObjPtr;
2700 str = Jim_String(strObjPtr);
2702 /* Before part */
2703 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2705 /* Replacement */
2706 if (newStrObj) {
2707 Jim_AppendObj(interp, objPtr, newStrObj);
2710 /* After part */
2711 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2713 return objPtr;
2717 * Note: does not support embedded nulls.
2719 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2721 while (*str) {
2722 int c;
2723 str += utf8_tounicode(str, &c);
2724 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2726 *dest = 0;
2730 * Note: does not support embedded nulls.
2732 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2734 char *buf;
2735 int len;
2736 const char *str;
2738 SetStringFromAny(interp, strObjPtr);
2740 str = Jim_GetString(strObjPtr, &len);
2742 #ifdef JIM_UTF8
2743 /* Case mapping can change the utf-8 length of the string.
2744 * But at worst it will be by one extra byte per char
2746 len *= 2;
2747 #endif
2748 buf = Jim_Alloc(len + 1);
2749 JimStrCopyUpperLower(buf, str, 0);
2750 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2754 * Note: does not support embedded nulls.
2756 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2758 char *buf;
2759 const char *str;
2760 int len;
2762 if (strObjPtr->typePtr != &stringObjType) {
2763 SetStringFromAny(interp, strObjPtr);
2766 str = Jim_GetString(strObjPtr, &len);
2768 #ifdef JIM_UTF8
2769 /* Case mapping can change the utf-8 length of the string.
2770 * But at worst it will be by one extra byte per char
2772 len *= 2;
2773 #endif
2774 buf = Jim_Alloc(len + 1);
2775 JimStrCopyUpperLower(buf, str, 1);
2776 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2780 * Note: does not support embedded nulls.
2782 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2784 char *buf, *p;
2785 int len;
2786 int c;
2787 const char *str;
2789 str = Jim_GetString(strObjPtr, &len);
2790 if (len == 0) {
2791 return strObjPtr;
2793 #ifdef JIM_UTF8
2794 /* Case mapping can change the utf-8 length of the string.
2795 * But at worst it will be by one extra byte per char
2797 len *= 2;
2798 #endif
2799 buf = p = Jim_Alloc(len + 1);
2801 str += utf8_tounicode(str, &c);
2802 p += utf8_getchars(p, utf8_title(c));
2804 JimStrCopyUpperLower(p, str, 0);
2806 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2809 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2810 * for unicode character 'c'.
2811 * Returns the position if found or NULL if not
2813 static const char *utf8_memchr(const char *str, int len, int c)
2815 #ifdef JIM_UTF8
2816 while (len) {
2817 int sc;
2818 int n = utf8_tounicode(str, &sc);
2819 if (sc == c) {
2820 return str;
2822 str += n;
2823 len -= n;
2825 return NULL;
2826 #else
2827 return memchr(str, c, len);
2828 #endif
2832 * Searches for the first non-trim char in string (str, len)
2834 * If none is found, returns just past the last char.
2836 * Lengths are in bytes.
2838 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2840 while (len) {
2841 int c;
2842 int n = utf8_tounicode(str, &c);
2844 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2845 /* Not a trim char, so stop */
2846 break;
2848 str += n;
2849 len -= n;
2851 return str;
2855 * Searches backwards for a non-trim char in string (str, len).
2857 * Returns a pointer to just after the non-trim char, or NULL if not found.
2859 * Lengths are in bytes.
2861 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2863 str += len;
2865 while (len) {
2866 int c;
2867 int n = utf8_prev_len(str, len);
2869 len -= n;
2870 str -= n;
2872 n = utf8_tounicode(str, &c);
2874 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2875 return str + n;
2879 return NULL;
2882 static const char default_trim_chars[] = " \t\n\r";
2883 /* sizeof() here includes the null byte */
2884 static int default_trim_chars_len = sizeof(default_trim_chars);
2886 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2888 int len;
2889 const char *str = Jim_GetString(strObjPtr, &len);
2890 const char *trimchars = default_trim_chars;
2891 int trimcharslen = default_trim_chars_len;
2892 const char *newstr;
2894 if (trimcharsObjPtr) {
2895 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2898 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2899 if (newstr == str) {
2900 return strObjPtr;
2903 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2906 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2908 int len;
2909 const char *trimchars = default_trim_chars;
2910 int trimcharslen = default_trim_chars_len;
2911 const char *nontrim;
2913 if (trimcharsObjPtr) {
2914 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2917 SetStringFromAny(interp, strObjPtr);
2919 len = Jim_Length(strObjPtr);
2920 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2922 if (nontrim == NULL) {
2923 /* All trim, so return a zero-length string */
2924 return Jim_NewEmptyStringObj(interp);
2926 if (nontrim == strObjPtr->bytes + len) {
2927 /* All non-trim, so return the original object */
2928 return strObjPtr;
2931 if (Jim_IsShared(strObjPtr)) {
2932 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2934 else {
2935 /* Can modify this string in place */
2936 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2937 strObjPtr->length = (nontrim - strObjPtr->bytes);
2940 return strObjPtr;
2943 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2945 /* First trim left. */
2946 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2948 /* Now trim right */
2949 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2951 /* Note: refCount check is needed since objPtr may be emptyObj */
2952 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2953 /* We don't want this object to be leaked */
2954 Jim_FreeNewObj(interp, objPtr);
2957 return strObjPtr;
2960 /* Some platforms don't have isascii - need a non-macro version */
2961 #ifdef HAVE_ISASCII
2962 #define jim_isascii isascii
2963 #else
2964 static int jim_isascii(int c)
2966 return !(c & ~0x7f);
2968 #endif
2970 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2972 static const char * const strclassnames[] = {
2973 "integer", "alpha", "alnum", "ascii", "digit",
2974 "double", "lower", "upper", "space", "xdigit",
2975 "control", "print", "graph", "punct",
2976 NULL
2978 enum {
2979 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2980 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2981 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2983 int strclass;
2984 int len;
2985 int i;
2986 const char *str;
2987 int (*isclassfunc)(int c) = NULL;
2989 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2990 return JIM_ERR;
2993 str = Jim_GetString(strObjPtr, &len);
2994 if (len == 0) {
2995 Jim_SetResultBool(interp, !strict);
2996 return JIM_OK;
2999 switch (strclass) {
3000 case STR_IS_INTEGER:
3002 jim_wide w;
3003 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3004 return JIM_OK;
3007 case STR_IS_DOUBLE:
3009 double d;
3010 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3011 return JIM_OK;
3014 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3015 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3016 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3017 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3018 case STR_IS_LOWER: isclassfunc = islower; break;
3019 case STR_IS_UPPER: isclassfunc = isupper; break;
3020 case STR_IS_SPACE: isclassfunc = isspace; break;
3021 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3022 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3023 case STR_IS_PRINT: isclassfunc = isprint; break;
3024 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3025 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3026 default:
3027 return JIM_ERR;
3030 for (i = 0; i < len; i++) {
3031 if (!isclassfunc(str[i])) {
3032 Jim_SetResultBool(interp, 0);
3033 return JIM_OK;
3036 Jim_SetResultBool(interp, 1);
3037 return JIM_OK;
3040 /* -----------------------------------------------------------------------------
3041 * Compared String Object
3042 * ---------------------------------------------------------------------------*/
3044 /* This is strange object that allows comparison of a C literal string
3045 * with a Jim object in a very short time if the same comparison is done
3046 * multiple times. For example every time the [if] command is executed,
3047 * Jim has to check if a given argument is "else".
3048 * If the code has no errors, this comparison is true most of the time,
3049 * so we can cache the pointer of the string of the last matching
3050 * comparison inside the object. Because most C compilers perform literal sharing,
3051 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3052 * this works pretty well even if comparisons are at different places
3053 * inside the C code. */
3055 static const Jim_ObjType comparedStringObjType = {
3056 "compared-string",
3057 NULL,
3058 NULL,
3059 NULL,
3060 JIM_TYPE_REFERENCES,
3063 /* The only way this object is exposed to the API is via the following
3064 * function. Returns true if the string and the object string repr.
3065 * are the same, otherwise zero is returned.
3067 * Note: this isn't binary safe, but it hardly needs to be.*/
3068 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3070 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3071 return 1;
3073 else {
3074 const char *objStr = Jim_String(objPtr);
3076 if (strcmp(str, objStr) != 0)
3077 return 0;
3079 if (objPtr->typePtr != &comparedStringObjType) {
3080 Jim_FreeIntRep(interp, objPtr);
3081 objPtr->typePtr = &comparedStringObjType;
3083 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3084 return 1;
3088 static int qsortCompareStringPointers(const void *a, const void *b)
3090 char *const *sa = (char *const *)a;
3091 char *const *sb = (char *const *)b;
3093 return strcmp(*sa, *sb);
3097 /* -----------------------------------------------------------------------------
3098 * Source Object
3100 * This object is just a string from the language point of view, but
3101 * the internal representation contains the filename and line number
3102 * where this token was read. This information is used by
3103 * Jim_EvalObj() if the object passed happens to be of type "source".
3105 * This allows propagation of the information about line numbers and file
3106 * names and gives error messages with absolute line numbers.
3108 * Note that this object uses the internal representation of the Jim_Object,
3109 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3111 * Also the object will be converted to something else if the given
3112 * token it represents in the source file is not something to be
3113 * evaluated (not a script), and will be specialized in some other way,
3114 * so the time overhead is also almost zero.
3115 * ---------------------------------------------------------------------------*/
3117 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3118 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3120 static const Jim_ObjType sourceObjType = {
3121 "source",
3122 FreeSourceInternalRep,
3123 DupSourceInternalRep,
3124 NULL,
3125 JIM_TYPE_REFERENCES,
3128 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3130 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3133 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3135 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3136 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3139 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3140 Jim_Obj *fileNameObj, int lineNumber)
3142 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3143 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3144 Jim_IncrRefCount(fileNameObj);
3145 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3146 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3147 objPtr->typePtr = &sourceObjType;
3150 /* -----------------------------------------------------------------------------
3151 * ScriptLine Object
3153 * This object is used only in the Script internal represenation.
3154 * For each line of the script, it holds the number of tokens on the line
3155 * and the source line number.
3157 static const Jim_ObjType scriptLineObjType = {
3158 "scriptline",
3159 NULL,
3160 NULL,
3161 NULL,
3162 JIM_NONE,
3165 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3167 Jim_Obj *objPtr;
3169 #ifdef DEBUG_SHOW_SCRIPT
3170 char buf[100];
3171 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3172 objPtr = Jim_NewStringObj(interp, buf, -1);
3173 #else
3174 objPtr = Jim_NewEmptyStringObj(interp);
3175 #endif
3176 objPtr->typePtr = &scriptLineObjType;
3177 objPtr->internalRep.scriptLineValue.argc = argc;
3178 objPtr->internalRep.scriptLineValue.line = line;
3180 return objPtr;
3183 /* -----------------------------------------------------------------------------
3184 * Script Object
3186 * This object holds the parsed internal representation of a script.
3187 * This representation is help within an allocated ScriptObj (see below)
3189 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3190 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3191 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3192 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3194 static const Jim_ObjType scriptObjType = {
3195 "script",
3196 FreeScriptInternalRep,
3197 DupScriptInternalRep,
3198 NULL,
3199 JIM_TYPE_REFERENCES,
3202 /* Each token of a script is represented by a ScriptToken.
3203 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3204 * can be specialized by commands operating on it.
3206 typedef struct ScriptToken
3208 Jim_Obj *objPtr;
3209 int type;
3210 } ScriptToken;
3212 /* This is the script object internal representation. An array of
3213 * ScriptToken structures, including a pre-computed representation of the
3214 * command length and arguments.
3216 * For example the script:
3218 * puts hello
3219 * set $i $x$y [foo]BAR
3221 * will produce a ScriptObj with the following ScriptToken's:
3223 * LIN 2
3224 * ESC puts
3225 * ESC hello
3226 * LIN 4
3227 * ESC set
3228 * VAR i
3229 * WRD 2
3230 * VAR x
3231 * VAR y
3232 * WRD 2
3233 * CMD foo
3234 * ESC BAR
3236 * "puts hello" has two args (LIN 2), composed of single tokens.
3237 * (Note that the WRD token is omitted for the common case of a single token.)
3239 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3240 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3242 * The precomputation of the command structure makes Jim_Eval() faster,
3243 * and simpler because there aren't dynamic lengths / allocations.
3245 * -- {expand}/{*} handling --
3247 * Expand is handled in a special way.
3249 * If a "word" begins with {*}, the word token count is -ve.
3251 * For example the command:
3253 * list {*}{a b}
3255 * Will produce the following cmdstruct array:
3257 * LIN 2
3258 * ESC list
3259 * WRD -1
3260 * STR a b
3262 * Note that the 'LIN' token also contains the source information for the
3263 * first word of the line for error reporting purposes
3265 * -- the substFlags field of the structure --
3267 * The scriptObj structure is used to represent both "script" objects
3268 * and "subst" objects. In the second case, the there are no LIN and WRD
3269 * tokens. Instead SEP and EOL tokens are added as-is.
3270 * In addition, the field 'substFlags' is used to represent the flags used to turn
3271 * the string into the internal representation.
3272 * If these flags do not match what the application requires,
3273 * the scriptObj is created again. For example the script:
3275 * subst -nocommands $string
3276 * subst -novariables $string
3278 * Will (re)create the internal representation of the $string object
3279 * two times.
3281 typedef struct ScriptObj
3283 ScriptToken *token; /* Tokens array. */
3284 Jim_Obj *fileNameObj; /* Filename */
3285 int len; /* Length of token[] */
3286 int substFlags; /* flags used for the compilation of "subst" objects */
3287 int inUse; /* Used to share a ScriptObj. Currently
3288 only used by Jim_EvalObj() as protection against
3289 shimmering of the currently evaluated object. */
3290 int firstline; /* Line number of the first line */
3291 int linenr; /* Error line number, if any */
3292 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3293 } ScriptObj;
3295 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3297 int i;
3298 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3300 if (--script->inUse != 0)
3301 return;
3302 for (i = 0; i < script->len; i++) {
3303 Jim_DecrRefCount(interp, script->token[i].objPtr);
3305 Jim_Free(script->token);
3306 Jim_DecrRefCount(interp, script->fileNameObj);
3307 Jim_Free(script);
3310 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3312 JIM_NOTUSED(interp);
3313 JIM_NOTUSED(srcPtr);
3315 /* Just return a simple string. We don't try to preserve the source info
3316 * since in practice scripts are never duplicated
3318 dupPtr->typePtr = NULL;
3321 /* A simple parse token.
3322 * As the script is parsed, the created tokens point into the script string rep.
3324 typedef struct
3326 const char *token; /* Pointer to the start of the token */
3327 int len; /* Length of this token */
3328 int type; /* Token type */
3329 int line; /* Line number */
3330 } ParseToken;
3332 /* A list of parsed tokens representing a script.
3333 * Tokens are added to this list as the script is parsed.
3334 * It grows as needed.
3336 typedef struct
3338 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3339 ParseToken *list; /* Array of tokens */
3340 int size; /* Current size of the list */
3341 int count; /* Number of entries used */
3342 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3343 } ParseTokenList;
3345 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3347 tokenlist->list = tokenlist->static_list;
3348 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3349 tokenlist->count = 0;
3352 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3354 if (tokenlist->list != tokenlist->static_list) {
3355 Jim_Free(tokenlist->list);
3360 * Adds the new token to the tokenlist.
3361 * The token has the given length, type and line number.
3362 * The token list is resized as necessary.
3364 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3365 int line)
3367 ParseToken *t;
3369 if (tokenlist->count == tokenlist->size) {
3370 /* Resize the list */
3371 tokenlist->size *= 2;
3372 if (tokenlist->list != tokenlist->static_list) {
3373 tokenlist->list =
3374 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3376 else {
3377 /* The list needs to become allocated */
3378 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3379 memcpy(tokenlist->list, tokenlist->static_list,
3380 tokenlist->count * sizeof(*tokenlist->list));
3383 t = &tokenlist->list[tokenlist->count++];
3384 t->token = token;
3385 t->len = len;
3386 t->type = type;
3387 t->line = line;
3390 /* Counts the number of adjoining non-separator tokens.
3392 * Returns -ve if the first token is the expansion
3393 * operator (in which case the count doesn't include
3394 * that token).
3396 static int JimCountWordTokens(ParseToken *t)
3398 int expand = 1;
3399 int count = 0;
3401 /* Is the first word {*} or {expand}? */
3402 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3403 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3404 /* Create an expand token */
3405 expand = -1;
3406 t++;
3410 /* Now count non-separator words */
3411 while (!TOKEN_IS_SEP(t->type)) {
3412 t++;
3413 count++;
3416 return count * expand;
3420 * Create a script/subst object from the given token.
3422 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3424 Jim_Obj *objPtr;
3426 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3427 /* Convert backlash escapes. The result will never be longer than the original */
3428 int len = t->len;
3429 char *str = Jim_Alloc(len + 1);
3430 len = JimEscape(str, t->token, len);
3431 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3433 else {
3434 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3435 * with a single space.
3437 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3439 return objPtr;
3443 * Takes a tokenlist and creates the allocated list of script tokens
3444 * in script->token, of length script->len.
3446 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3447 * as required.
3449 * Also sets script->line to the line number of the first token
3451 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3452 ParseTokenList *tokenlist)
3454 int i;
3455 struct ScriptToken *token;
3456 /* Number of tokens so far for the current command */
3457 int lineargs = 0;
3458 /* This is the first token for the current command */
3459 ScriptToken *linefirst;
3460 int count;
3461 int linenr;
3463 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3464 printf("==== Tokens ====\n");
3465 for (i = 0; i < tokenlist->count; i++) {
3466 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3467 tokenlist->list[i].len, tokenlist->list[i].token);
3469 #endif
3471 /* May need up to one extra script token for each EOL in the worst case */
3472 count = tokenlist->count;
3473 for (i = 0; i < tokenlist->count; i++) {
3474 if (tokenlist->list[i].type == JIM_TT_EOL) {
3475 count++;
3478 linenr = script->firstline = tokenlist->list[0].line;
3480 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3482 /* This is the first token for the current command */
3483 linefirst = token++;
3485 for (i = 0; i < tokenlist->count; ) {
3486 /* Look ahead to find out how many tokens make up the next word */
3487 int wordtokens;
3489 /* Skip any leading separators */
3490 while (tokenlist->list[i].type == JIM_TT_SEP) {
3491 i++;
3494 wordtokens = JimCountWordTokens(tokenlist->list + i);
3496 if (wordtokens == 0) {
3497 /* None, so at end of line */
3498 if (lineargs) {
3499 linefirst->type = JIM_TT_LINE;
3500 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3501 Jim_IncrRefCount(linefirst->objPtr);
3503 /* Reset for new line */
3504 lineargs = 0;
3505 linefirst = token++;
3507 i++;
3508 continue;
3510 else if (wordtokens != 1) {
3511 /* More than 1, or {*}, so insert a WORD token */
3512 token->type = JIM_TT_WORD;
3513 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3514 Jim_IncrRefCount(token->objPtr);
3515 token++;
3516 if (wordtokens < 0) {
3517 /* Skip the expand token */
3518 i++;
3519 wordtokens = -wordtokens - 1;
3520 lineargs--;
3524 if (lineargs == 0) {
3525 /* First real token on the line, so record the line number */
3526 linenr = tokenlist->list[i].line;
3528 lineargs++;
3530 /* Add each non-separator word token to the line */
3531 while (wordtokens--) {
3532 const ParseToken *t = &tokenlist->list[i++];
3534 token->type = t->type;
3535 token->objPtr = JimMakeScriptObj(interp, t);
3536 Jim_IncrRefCount(token->objPtr);
3538 /* Every object is initially a string of type 'source', but the
3539 * internal type may be specialized during execution of the
3540 * script. */
3541 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3542 token++;
3546 if (lineargs == 0) {
3547 token--;
3550 script->len = token - script->token;
3552 JimPanic((script->len >= count, "allocated script array is too short"));
3554 #ifdef DEBUG_SHOW_SCRIPT
3555 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3556 for (i = 0; i < script->len; i++) {
3557 const ScriptToken *t = &script->token[i];
3558 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3560 #endif
3565 * Sets an appropriate error message for a missing script/expression terminator.
3567 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3569 * Note that a trailing backslash is not considered to be an error.
3571 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3573 const char *msg;
3575 switch (ch) {
3576 case '\\':
3577 case ' ':
3578 return JIM_OK;
3580 case '[':
3581 msg = "unmatched \"[\"";
3582 break;
3583 case '{':
3584 msg = "missing close-brace";
3585 break;
3586 case '"':
3587 default:
3588 msg = "missing quote";
3589 break;
3592 Jim_SetResultString(interp, msg, -1);
3593 return JIM_ERR;
3597 * Similar to ScriptObjAddTokens(), but for subst objects.
3599 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3600 ParseTokenList *tokenlist)
3602 int i;
3603 struct ScriptToken *token;
3605 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3607 for (i = 0; i < tokenlist->count; i++) {
3608 const ParseToken *t = &tokenlist->list[i];
3610 /* Create a token for 't' */
3611 token->type = t->type;
3612 token->objPtr = JimMakeScriptObj(interp, t);
3613 Jim_IncrRefCount(token->objPtr);
3614 token++;
3617 script->len = i;
3620 /* This method takes the string representation of an object
3621 * as a Tcl script, and generates the pre-parsed internal representation
3622 * of the script.
3624 * On parse error, sets an error message and returns JIM_ERR
3625 * (Note: the object is still converted to a script, even if an error occurs)
3627 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3629 int scriptTextLen;
3630 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3631 struct JimParserCtx parser;
3632 struct ScriptObj *script;
3633 ParseTokenList tokenlist;
3634 int line = 1;
3636 /* Try to get information about filename / line number */
3637 if (objPtr->typePtr == &sourceObjType) {
3638 line = objPtr->internalRep.sourceValue.lineNumber;
3641 /* Initially parse the script into tokens (in tokenlist) */
3642 ScriptTokenListInit(&tokenlist);
3644 JimParserInit(&parser, scriptText, scriptTextLen, line);
3645 while (!parser.eof) {
3646 JimParseScript(&parser);
3647 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3648 parser.tline);
3651 /* Add a final EOF token */
3652 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3654 /* Create the "real" script tokens from the parsed tokens */
3655 script = Jim_Alloc(sizeof(*script));
3656 memset(script, 0, sizeof(*script));
3657 script->inUse = 1;
3658 if (objPtr->typePtr == &sourceObjType) {
3659 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3661 else {
3662 script->fileNameObj = interp->emptyObj;
3664 Jim_IncrRefCount(script->fileNameObj);
3665 script->missing = parser.missing.ch;
3666 script->linenr = parser.missing.line;
3668 ScriptObjAddTokens(interp, script, &tokenlist);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp, objPtr);
3675 Jim_SetIntRepPtr(objPtr, script);
3676 objPtr->typePtr = &scriptObjType;
3679 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3682 * Returns the parsed script.
3683 * Note that if there is any possibility that the script is not valid,
3684 * call JimScriptValid() to check
3686 ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3688 if (objPtr == interp->emptyObj) {
3689 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3690 objPtr = interp->nullScriptObj;
3693 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3694 JimSetScriptFromAny(interp, objPtr);
3697 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3701 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3702 * and leaves an error message in the interp result.
3705 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3707 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3708 JimAddErrorToStack(interp, script);
3709 return 0;
3711 return 1;
3715 /* -----------------------------------------------------------------------------
3716 * Commands
3717 * ---------------------------------------------------------------------------*/
3718 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3720 cmdPtr->inUse++;
3723 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3725 if (--cmdPtr->inUse == 0) {
3726 if (cmdPtr->isproc) {
3727 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3728 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3729 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3730 if (cmdPtr->u.proc.staticVars) {
3731 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3732 Jim_Free(cmdPtr->u.proc.staticVars);
3735 else {
3736 /* native (C) */
3737 if (cmdPtr->u.native.delProc) {
3738 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3741 if (cmdPtr->prevCmd) {
3742 /* Delete any pushed command too */
3743 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3745 Jim_Free(cmdPtr);
3749 /* Variables HashTable Type.
3751 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3754 /* Variables HashTable Type.
3756 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3757 static void JimVariablesHTValDestructor(void *interp, void *val)
3759 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3760 Jim_Free(val);
3763 static const Jim_HashTableType JimVariablesHashTableType = {
3764 JimStringCopyHTHashFunction, /* hash function */
3765 JimStringCopyHTDup, /* key dup */
3766 NULL, /* val dup */
3767 JimStringCopyHTKeyCompare, /* key compare */
3768 JimStringCopyHTKeyDestructor, /* key destructor */
3769 JimVariablesHTValDestructor /* val destructor */
3772 /* Commands HashTable Type.
3774 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3776 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3778 JimDecrCmdRefCount(interp, val);
3781 static const Jim_HashTableType JimCommandsHashTableType = {
3782 JimStringCopyHTHashFunction, /* hash function */
3783 JimStringCopyHTDup, /* key dup */
3784 NULL, /* val dup */
3785 JimStringCopyHTKeyCompare, /* key compare */
3786 JimStringCopyHTKeyDestructor, /* key destructor */
3787 JimCommandsHT_ValDestructor /* val destructor */
3790 /* ------------------------- Commands related functions --------------------- */
3792 #ifdef jim_ext_namespace
3794 * Returns the "unscoped" version of the given namespace.
3795 * That is, the fully qualified name without the leading ::
3796 * The returned value is either nsObj, or an object with a zero ref count.
3798 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3800 const char *name = Jim_String(nsObj);
3801 if (name[0] == ':' && name[1] == ':') {
3802 /* This command is being defined in the global namespace */
3803 while (*++name == ':') {
3805 nsObj = Jim_NewStringObj(interp, name, -1);
3807 else if (Jim_Length(interp->framePtr->nsObj)) {
3808 /* This command is being defined in a non-global namespace */
3809 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3810 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3812 return nsObj;
3815 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3817 Jim_Obj *resultObj;
3819 const char *name = Jim_String(nameObjPtr);
3820 if (name[0] == ':' && name[1] == ':') {
3821 return nameObjPtr;
3823 Jim_IncrRefCount(nameObjPtr);
3824 resultObj = Jim_NewStringObj(interp, "::", -1);
3825 Jim_AppendObj(interp, resultObj, nameObjPtr);
3826 Jim_DecrRefCount(interp, nameObjPtr);
3828 return resultObj;
3832 * An efficient version of JimQualifyNameObj() where the name is
3833 * available (and needed) as a 'const char *'.
3834 * Avoids creating an object if not necessary.
3835 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3837 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3839 Jim_Obj *objPtr = interp->emptyObj;
3841 if (name[0] == ':' && name[1] == ':') {
3842 /* This command is being defined in the global namespace */
3843 while (*++name == ':') {
3846 else if (Jim_Length(interp->framePtr->nsObj)) {
3847 /* This command is being defined in a non-global namespace */
3848 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3849 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3850 name = Jim_String(objPtr);
3852 Jim_IncrRefCount(objPtr);
3853 *objPtrPtr = objPtr;
3854 return name;
3857 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3859 #else
3860 /* We can be more efficient in the no-namespace case */
3861 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3862 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3864 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3866 return nameObjPtr;
3868 #endif
3870 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3872 /* It may already exist, so we try to delete the old one.
3873 * Note that reference count means that it won't be deleted yet if
3874 * it exists in the call stack.
3876 * BUT, if 'local' is in force, instead of deleting the existing
3877 * proc, we stash a reference to the old proc here.
3879 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3880 if (he) {
3881 /* There was an old cmd with the same name,
3882 * so this requires a 'proc epoch' update. */
3884 /* If a procedure with the same name didn't exist there is no need
3885 * to increment the 'proc epoch' because creation of a new procedure
3886 * can never affect existing cached commands. We don't do
3887 * negative caching. */
3888 Jim_InterpIncrProcEpoch(interp);
3891 if (he && interp->local) {
3892 /* Push this command over the top of the previous one */
3893 cmd->prevCmd = Jim_GetHashEntryVal(he);
3894 Jim_SetHashVal(&interp->commands, he, cmd);
3896 else {
3897 if (he) {
3898 /* Replace the existing command */
3899 Jim_DeleteHashEntry(&interp->commands, name);
3902 Jim_AddHashEntry(&interp->commands, name, cmd);
3904 return JIM_OK;
3908 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3909 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3911 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3913 /* Store the new details for this command */
3914 memset(cmdPtr, 0, sizeof(*cmdPtr));
3915 cmdPtr->inUse = 1;
3916 cmdPtr->u.native.delProc = delProc;
3917 cmdPtr->u.native.cmdProc = cmdProc;
3918 cmdPtr->u.native.privData = privData;
3920 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3922 return JIM_OK;
3925 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3927 int len, i;
3929 len = Jim_ListLength(interp, staticsListObjPtr);
3930 if (len == 0) {
3931 return JIM_OK;
3934 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3935 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3936 for (i = 0; i < len; i++) {
3937 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3938 Jim_Var *varPtr;
3939 int subLen;
3941 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3942 /* Check if it's composed of two elements. */
3943 subLen = Jim_ListLength(interp, objPtr);
3944 if (subLen == 1 || subLen == 2) {
3945 /* Try to get the variable value from the current
3946 * environment. */
3947 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3948 if (subLen == 1) {
3949 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3950 if (initObjPtr == NULL) {
3951 Jim_SetResultFormatted(interp,
3952 "variable for initialization of static \"%#s\" not found in the local context",
3953 nameObjPtr);
3954 return JIM_ERR;
3957 else {
3958 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3960 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3961 return JIM_ERR;
3964 varPtr = Jim_Alloc(sizeof(*varPtr));
3965 varPtr->objPtr = initObjPtr;
3966 Jim_IncrRefCount(initObjPtr);
3967 varPtr->linkFramePtr = NULL;
3968 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3969 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3970 Jim_SetResultFormatted(interp,
3971 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3972 Jim_DecrRefCount(interp, initObjPtr);
3973 Jim_Free(varPtr);
3974 return JIM_ERR;
3977 else {
3978 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3979 objPtr);
3980 return JIM_ERR;
3983 return JIM_OK;
3986 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3988 #ifdef jim_ext_namespace
3989 if (cmdPtr->isproc) {
3990 /* XXX: Really need JimNamespaceSplit() */
3991 const char *pt = strrchr(cmdname, ':');
3992 if (pt && pt != cmdname && pt[-1] == ':') {
3993 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3994 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3995 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3997 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3998 /* This commands shadows a global command, so a proc epoch update is required */
3999 Jim_InterpIncrProcEpoch(interp);
4003 #endif
4006 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4007 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4009 Jim_Cmd *cmdPtr;
4010 int argListLen;
4011 int i;
4013 argListLen = Jim_ListLength(interp, argListObjPtr);
4015 /* Allocate space for both the command pointer and the arg list */
4016 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4017 memset(cmdPtr, 0, sizeof(*cmdPtr));
4018 cmdPtr->inUse = 1;
4019 cmdPtr->isproc = 1;
4020 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4021 cmdPtr->u.proc.argListLen = argListLen;
4022 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4023 cmdPtr->u.proc.argsPos = -1;
4024 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4025 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4026 Jim_IncrRefCount(argListObjPtr);
4027 Jim_IncrRefCount(bodyObjPtr);
4028 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4030 /* Create the statics hash table. */
4031 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4032 goto err;
4035 /* Parse the args out into arglist, validating as we go */
4036 /* Examine the argument list for default parameters and 'args' */
4037 for (i = 0; i < argListLen; i++) {
4038 Jim_Obj *argPtr;
4039 Jim_Obj *nameObjPtr;
4040 Jim_Obj *defaultObjPtr;
4041 int len;
4043 /* Examine a parameter */
4044 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4045 len = Jim_ListLength(interp, argPtr);
4046 if (len == 0) {
4047 Jim_SetResultString(interp, "argument with no name", -1);
4048 err:
4049 JimDecrCmdRefCount(interp, cmdPtr);
4050 return NULL;
4052 if (len > 2) {
4053 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4054 goto err;
4057 if (len == 2) {
4058 /* Optional parameter */
4059 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4060 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4062 else {
4063 /* Required parameter */
4064 nameObjPtr = argPtr;
4065 defaultObjPtr = NULL;
4069 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4070 if (cmdPtr->u.proc.argsPos >= 0) {
4071 Jim_SetResultString(interp, "'args' specified more than once", -1);
4072 goto err;
4074 cmdPtr->u.proc.argsPos = i;
4076 else {
4077 if (len == 2) {
4078 cmdPtr->u.proc.optArity++;
4080 else {
4081 cmdPtr->u.proc.reqArity++;
4085 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4086 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4089 return cmdPtr;
4092 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4094 int ret = JIM_OK;
4095 Jim_Obj *qualifiedNameObj;
4096 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4098 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4099 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4100 ret = JIM_ERR;
4102 else {
4103 Jim_InterpIncrProcEpoch(interp);
4106 JimFreeQualifiedName(interp, qualifiedNameObj);
4108 return ret;
4111 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4113 int ret = JIM_ERR;
4114 Jim_HashEntry *he;
4115 Jim_Cmd *cmdPtr;
4116 Jim_Obj *qualifiedOldNameObj;
4117 Jim_Obj *qualifiedNewNameObj;
4118 const char *fqold;
4119 const char *fqnew;
4121 if (newName[0] == 0) {
4122 return Jim_DeleteCommand(interp, oldName);
4125 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4126 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4128 /* Does it exist? */
4129 he = Jim_FindHashEntry(&interp->commands, fqold);
4130 if (he == NULL) {
4131 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4133 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4134 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4136 else {
4137 /* Add the new name first */
4138 cmdPtr = Jim_GetHashEntryVal(he);
4139 JimIncrCmdRefCount(cmdPtr);
4140 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4141 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4143 /* Now remove the old name */
4144 Jim_DeleteHashEntry(&interp->commands, fqold);
4146 /* Increment the epoch */
4147 Jim_InterpIncrProcEpoch(interp);
4149 ret = JIM_OK;
4152 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4153 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4155 return ret;
4158 /* -----------------------------------------------------------------------------
4159 * Command object
4160 * ---------------------------------------------------------------------------*/
4162 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4164 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4167 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4169 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4170 dupPtr->typePtr = srcPtr->typePtr;
4171 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4174 static const Jim_ObjType commandObjType = {
4175 "command",
4176 FreeCommandInternalRep,
4177 DupCommandInternalRep,
4178 NULL,
4179 JIM_TYPE_REFERENCES,
4182 /* This function returns the command structure for the command name
4183 * stored in objPtr. It tries to specialize the objPtr to contain
4184 * a cached info instead to perform the lookup into the hash table
4185 * every time. The information cached may not be uptodate, in such
4186 * a case the lookup is performed and the cache updated.
4188 * Respects the 'upcall' setting
4190 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4192 Jim_Cmd *cmd;
4194 /* In order to be valid, the proc epoch must match and
4195 * the lookup must have occurred in the same namespace
4197 if (objPtr->typePtr != &commandObjType ||
4198 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4199 #ifdef jim_ext_namespace
4200 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4201 #endif
4203 /* Not cached or out of date, so lookup */
4205 /* Do we need to try the local namespace? */
4206 const char *name = Jim_String(objPtr);
4207 Jim_HashEntry *he;
4209 if (name[0] == ':' && name[1] == ':') {
4210 while (*++name == ':') {
4213 #ifdef jim_ext_namespace
4214 else if (Jim_Length(interp->framePtr->nsObj)) {
4215 /* This command is being defined in a non-global namespace */
4216 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4217 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4218 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4219 Jim_FreeNewObj(interp, nameObj);
4220 if (he) {
4221 goto found;
4224 #endif
4226 /* Lookup in the global namespace */
4227 he = Jim_FindHashEntry(&interp->commands, name);
4228 if (he == NULL) {
4229 if (flags & JIM_ERRMSG) {
4230 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4232 return NULL;
4234 #ifdef jim_ext_namespace
4235 found:
4236 #endif
4237 cmd = Jim_GetHashEntryVal(he);
4239 /* Free the old internal repr and set the new one. */
4240 Jim_FreeIntRep(interp, objPtr);
4241 objPtr->typePtr = &commandObjType;
4242 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4243 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4244 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4245 Jim_IncrRefCount(interp->framePtr->nsObj);
4247 else {
4248 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4250 while (cmd->u.proc.upcall) {
4251 cmd = cmd->prevCmd;
4253 return cmd;
4256 /* -----------------------------------------------------------------------------
4257 * Variables
4258 * ---------------------------------------------------------------------------*/
4260 /* -----------------------------------------------------------------------------
4261 * Variable object
4262 * ---------------------------------------------------------------------------*/
4264 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4266 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4268 static const Jim_ObjType variableObjType = {
4269 "variable",
4270 NULL,
4271 NULL,
4272 NULL,
4273 JIM_TYPE_REFERENCES,
4277 * Check that the name does not contain embedded nulls.
4279 * Variable and procedure names are manipulated as null terminated strings, so
4280 * don't allow names with embedded nulls.
4282 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4284 /* Variable names and proc names can't contain embedded nulls */
4285 if (nameObjPtr->typePtr != &variableObjType) {
4286 int len;
4287 const char *str = Jim_GetString(nameObjPtr, &len);
4288 if (memchr(str, '\0', len)) {
4289 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4290 return JIM_ERR;
4293 return JIM_OK;
4296 /* This method should be called only by the variable API.
4297 * It returns JIM_OK on success (variable already exists),
4298 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4299 * a variable name, but syntax glue for [dict] i.e. the last
4300 * character is ')' */
4301 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4303 const char *varName;
4304 Jim_CallFrame *framePtr;
4305 Jim_HashEntry *he;
4306 int global;
4307 int len;
4309 /* Check if the object is already an uptodate variable */
4310 if (objPtr->typePtr == &variableObjType) {
4311 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4312 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4313 /* nothing to do */
4314 return JIM_OK;
4316 /* Need to re-resolve the variable in the updated callframe */
4318 else if (objPtr->typePtr == &dictSubstObjType) {
4319 return JIM_DICT_SUGAR;
4321 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4322 return JIM_ERR;
4326 varName = Jim_GetString(objPtr, &len);
4328 /* Make sure it's not syntax glue to get/set dict. */
4329 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4330 return JIM_DICT_SUGAR;
4333 if (varName[0] == ':' && varName[1] == ':') {
4334 while (*++varName == ':') {
4336 global = 1;
4337 framePtr = interp->topFramePtr;
4339 else {
4340 global = 0;
4341 framePtr = interp->framePtr;
4344 /* Resolve this name in the variables hash table */
4345 he = Jim_FindHashEntry(&framePtr->vars, varName);
4346 if (he == NULL) {
4347 if (!global && framePtr->staticVars) {
4348 /* Try with static vars. */
4349 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4351 if (he == NULL) {
4352 return JIM_ERR;
4356 /* Free the old internal repr and set the new one. */
4357 Jim_FreeIntRep(interp, objPtr);
4358 objPtr->typePtr = &variableObjType;
4359 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4360 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4361 objPtr->internalRep.varValue.global = global;
4362 return JIM_OK;
4365 /* -------------------- Variables related functions ------------------------- */
4366 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4367 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4369 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4371 const char *name;
4372 Jim_CallFrame *framePtr;
4373 int global;
4375 /* New variable to create */
4376 Jim_Var *var = Jim_Alloc(sizeof(*var));
4378 var->objPtr = valObjPtr;
4379 Jim_IncrRefCount(valObjPtr);
4380 var->linkFramePtr = NULL;
4382 name = Jim_String(nameObjPtr);
4383 if (name[0] == ':' && name[1] == ':') {
4384 while (*++name == ':') {
4386 framePtr = interp->topFramePtr;
4387 global = 1;
4389 else {
4390 framePtr = interp->framePtr;
4391 global = 0;
4394 /* Insert the new variable */
4395 Jim_AddHashEntry(&framePtr->vars, name, var);
4397 /* Make the object int rep a variable */
4398 Jim_FreeIntRep(interp, nameObjPtr);
4399 nameObjPtr->typePtr = &variableObjType;
4400 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4401 nameObjPtr->internalRep.varValue.varPtr = var;
4402 nameObjPtr->internalRep.varValue.global = global;
4404 return var;
4407 /* For now that's dummy. Variables lookup should be optimized
4408 * in many ways, with caching of lookups, and possibly with
4409 * a table of pre-allocated vars in every CallFrame for local vars.
4410 * All the caching should also have an 'epoch' mechanism similar
4411 * to the one used by Tcl for procedures lookup caching. */
4413 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4415 int err;
4416 Jim_Var *var;
4418 switch (SetVariableFromAny(interp, nameObjPtr)) {
4419 case JIM_DICT_SUGAR:
4420 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4422 case JIM_ERR:
4423 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4424 return JIM_ERR;
4426 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4427 break;
4429 case JIM_OK:
4430 var = nameObjPtr->internalRep.varValue.varPtr;
4431 if (var->linkFramePtr == NULL) {
4432 Jim_IncrRefCount(valObjPtr);
4433 Jim_DecrRefCount(interp, var->objPtr);
4434 var->objPtr = valObjPtr;
4436 else { /* Else handle the link */
4437 Jim_CallFrame *savedCallFrame;
4439 savedCallFrame = interp->framePtr;
4440 interp->framePtr = var->linkFramePtr;
4441 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4442 interp->framePtr = savedCallFrame;
4443 if (err != JIM_OK)
4444 return err;
4447 return JIM_OK;
4450 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4452 Jim_Obj *nameObjPtr;
4453 int result;
4455 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4456 Jim_IncrRefCount(nameObjPtr);
4457 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4458 Jim_DecrRefCount(interp, nameObjPtr);
4459 return result;
4462 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4464 Jim_CallFrame *savedFramePtr;
4465 int result;
4467 savedFramePtr = interp->framePtr;
4468 interp->framePtr = interp->topFramePtr;
4469 result = Jim_SetVariableStr(interp, name, objPtr);
4470 interp->framePtr = savedFramePtr;
4471 return result;
4474 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4476 Jim_Obj *nameObjPtr, *valObjPtr;
4477 int result;
4479 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4480 valObjPtr = Jim_NewStringObj(interp, val, -1);
4481 Jim_IncrRefCount(nameObjPtr);
4482 Jim_IncrRefCount(valObjPtr);
4483 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4484 Jim_DecrRefCount(interp, nameObjPtr);
4485 Jim_DecrRefCount(interp, valObjPtr);
4486 return result;
4489 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4490 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4492 const char *varName;
4493 const char *targetName;
4494 Jim_CallFrame *framePtr;
4495 Jim_Var *varPtr;
4497 /* Check for an existing variable or link */
4498 switch (SetVariableFromAny(interp, nameObjPtr)) {
4499 case JIM_DICT_SUGAR:
4500 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4501 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4502 return JIM_ERR;
4504 case JIM_OK:
4505 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4507 if (varPtr->linkFramePtr == NULL) {
4508 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4509 return JIM_ERR;
4512 /* It exists, but is a link, so first delete the link */
4513 varPtr->linkFramePtr = NULL;
4514 break;
4517 /* Resolve the call frames for both variables */
4518 /* XXX: SetVariableFromAny() already did this! */
4519 varName = Jim_String(nameObjPtr);
4521 if (varName[0] == ':' && varName[1] == ':') {
4522 while (*++varName == ':') {
4524 /* Linking a global var does nothing */
4525 framePtr = interp->topFramePtr;
4527 else {
4528 framePtr = interp->framePtr;
4531 targetName = Jim_String(targetNameObjPtr);
4532 if (targetName[0] == ':' && targetName[1] == ':') {
4533 while (*++targetName == ':') {
4535 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4536 targetCallFrame = interp->topFramePtr;
4538 Jim_IncrRefCount(targetNameObjPtr);
4540 if (framePtr->level < targetCallFrame->level) {
4541 Jim_SetResultFormatted(interp,
4542 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4543 nameObjPtr);
4544 Jim_DecrRefCount(interp, targetNameObjPtr);
4545 return JIM_ERR;
4548 /* Check for cycles. */
4549 if (framePtr == targetCallFrame) {
4550 Jim_Obj *objPtr = targetNameObjPtr;
4552 /* Cycles are only possible with 'uplevel 0' */
4553 while (1) {
4554 if (strcmp(Jim_String(objPtr), varName) == 0) {
4555 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4556 Jim_DecrRefCount(interp, targetNameObjPtr);
4557 return JIM_ERR;
4559 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4560 break;
4561 varPtr = objPtr->internalRep.varValue.varPtr;
4562 if (varPtr->linkFramePtr != targetCallFrame)
4563 break;
4564 objPtr = varPtr->objPtr;
4568 /* Perform the binding */
4569 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4570 /* We are now sure 'nameObjPtr' type is variableObjType */
4571 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4572 Jim_DecrRefCount(interp, targetNameObjPtr);
4573 return JIM_OK;
4576 /* Return the Jim_Obj pointer associated with a variable name,
4577 * or NULL if the variable was not found in the current context.
4578 * The same optimization discussed in the comment to the
4579 * 'SetVariable' function should apply here.
4581 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4582 * in a dictionary which is shared, the array variable value is duplicated first.
4583 * This allows the array element to be updated (e.g. append, lappend) without
4584 * affecting other references to the dictionary.
4586 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4588 switch (SetVariableFromAny(interp, nameObjPtr)) {
4589 case JIM_OK:{
4590 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4592 if (varPtr->linkFramePtr == NULL) {
4593 return varPtr->objPtr;
4595 else {
4596 Jim_Obj *objPtr;
4598 /* The variable is a link? Resolve it. */
4599 Jim_CallFrame *savedCallFrame = interp->framePtr;
4601 interp->framePtr = varPtr->linkFramePtr;
4602 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4603 interp->framePtr = savedCallFrame;
4604 if (objPtr) {
4605 return objPtr;
4607 /* Error, so fall through to the error message */
4610 break;
4612 case JIM_DICT_SUGAR:
4613 /* [dict] syntax sugar. */
4614 return JimDictSugarGet(interp, nameObjPtr, flags);
4616 if (flags & JIM_ERRMSG) {
4617 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4619 return NULL;
4622 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4624 Jim_CallFrame *savedFramePtr;
4625 Jim_Obj *objPtr;
4627 savedFramePtr = interp->framePtr;
4628 interp->framePtr = interp->topFramePtr;
4629 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4630 interp->framePtr = savedFramePtr;
4632 return objPtr;
4635 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4637 Jim_Obj *nameObjPtr, *varObjPtr;
4639 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4640 Jim_IncrRefCount(nameObjPtr);
4641 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4642 Jim_DecrRefCount(interp, nameObjPtr);
4643 return varObjPtr;
4646 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4648 Jim_CallFrame *savedFramePtr;
4649 Jim_Obj *objPtr;
4651 savedFramePtr = interp->framePtr;
4652 interp->framePtr = interp->topFramePtr;
4653 objPtr = Jim_GetVariableStr(interp, name, flags);
4654 interp->framePtr = savedFramePtr;
4656 return objPtr;
4659 /* Unset a variable.
4660 * Note: On success unset invalidates all the variable objects created
4661 * in the current call frame incrementing. */
4662 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4664 Jim_Var *varPtr;
4665 int retval;
4666 Jim_CallFrame *framePtr;
4668 retval = SetVariableFromAny(interp, nameObjPtr);
4669 if (retval == JIM_DICT_SUGAR) {
4670 /* [dict] syntax sugar. */
4671 return JimDictSugarSet(interp, nameObjPtr, NULL);
4673 else if (retval == JIM_OK) {
4674 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4676 /* If it's a link call UnsetVariable recursively */
4677 if (varPtr->linkFramePtr) {
4678 framePtr = interp->framePtr;
4679 interp->framePtr = varPtr->linkFramePtr;
4680 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4681 interp->framePtr = framePtr;
4683 else {
4684 const char *name = Jim_String(nameObjPtr);
4685 if (nameObjPtr->internalRep.varValue.global) {
4686 name += 2;
4687 framePtr = interp->topFramePtr;
4689 else {
4690 framePtr = interp->framePtr;
4693 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4694 if (retval == JIM_OK) {
4695 /* Change the callframe id, invalidating var lookup caching */
4696 framePtr->id = interp->callFrameEpoch++;
4700 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4701 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4703 return retval;
4706 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4708 /* Given a variable name for [dict] operation syntax sugar,
4709 * this function returns two objects, the first with the name
4710 * of the variable to set, and the second with the respective key.
4711 * For example "foo(bar)" will return objects with string repr. of
4712 * "foo" and "bar".
4714 * The returned objects have refcount = 1. The function can't fail. */
4715 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4716 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4718 const char *str, *p;
4719 int len, keyLen;
4720 Jim_Obj *varObjPtr, *keyObjPtr;
4722 str = Jim_GetString(objPtr, &len);
4724 p = strchr(str, '(');
4725 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4727 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4729 p++;
4730 keyLen = (str + len) - p;
4731 if (str[len - 1] == ')') {
4732 keyLen--;
4735 /* Create the objects with the variable name and key. */
4736 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4738 Jim_IncrRefCount(varObjPtr);
4739 Jim_IncrRefCount(keyObjPtr);
4740 *varPtrPtr = varObjPtr;
4741 *keyPtrPtr = keyObjPtr;
4744 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4745 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4746 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4748 int err;
4750 SetDictSubstFromAny(interp, objPtr);
4752 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4753 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4755 if (err == JIM_OK) {
4756 /* Don't keep an extra ref to the result */
4757 Jim_SetEmptyResult(interp);
4759 else {
4760 if (!valObjPtr) {
4761 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4762 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4763 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4764 objPtr);
4765 return err;
4768 /* Make the error more informative and Tcl-compatible */
4769 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4770 (valObjPtr ? "set" : "unset"), objPtr);
4772 return err;
4776 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4778 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4779 * and stored back to the variable before expansion.
4781 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4782 Jim_Obj *keyObjPtr, int flags)
4784 Jim_Obj *dictObjPtr;
4785 Jim_Obj *resObjPtr = NULL;
4786 int ret;
4788 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4789 if (!dictObjPtr) {
4790 return NULL;
4793 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4794 if (ret != JIM_OK) {
4795 Jim_SetResultFormatted(interp,
4796 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4797 ret < 0 ? "variable isn't" : "no such element in");
4799 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4800 /* Update the variable to have an unshared copy */
4801 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4804 return resObjPtr;
4807 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4808 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4810 SetDictSubstFromAny(interp, objPtr);
4812 return JimDictExpandArrayVariable(interp,
4813 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4814 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4817 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4819 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4821 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4822 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4825 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4827 JIM_NOTUSED(interp);
4829 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4830 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4831 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4832 dupPtr->typePtr = &dictSubstObjType;
4835 /* Note: The object *must* be in dict-sugar format */
4836 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4838 if (objPtr->typePtr != &dictSubstObjType) {
4839 Jim_Obj *varObjPtr, *keyObjPtr;
4841 if (objPtr->typePtr == &interpolatedObjType) {
4842 /* An interpolated object in dict-sugar form */
4844 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4845 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4847 Jim_IncrRefCount(varObjPtr);
4848 Jim_IncrRefCount(keyObjPtr);
4850 else {
4851 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4854 Jim_FreeIntRep(interp, objPtr);
4855 objPtr->typePtr = &dictSubstObjType;
4856 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4857 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4861 /* This function is used to expand [dict get] sugar in the form
4862 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4863 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4864 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4865 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4866 * the [dict]ionary contained in variable VARNAME. */
4867 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4869 Jim_Obj *resObjPtr = NULL;
4870 Jim_Obj *substKeyObjPtr = NULL;
4872 SetDictSubstFromAny(interp, objPtr);
4874 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4875 &substKeyObjPtr, JIM_NONE)
4876 != JIM_OK) {
4877 return NULL;
4879 Jim_IncrRefCount(substKeyObjPtr);
4880 resObjPtr =
4881 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4882 substKeyObjPtr, 0);
4883 Jim_DecrRefCount(interp, substKeyObjPtr);
4885 return resObjPtr;
4888 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4890 Jim_Obj *resultObjPtr;
4892 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4893 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4894 resultObjPtr->refCount--;
4895 return resultObjPtr;
4897 return NULL;
4900 /* -----------------------------------------------------------------------------
4901 * CallFrame
4902 * ---------------------------------------------------------------------------*/
4904 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4906 Jim_CallFrame *cf;
4908 if (interp->freeFramesList) {
4909 cf = interp->freeFramesList;
4910 interp->freeFramesList = cf->next;
4912 cf->argv = NULL;
4913 cf->argc = 0;
4914 cf->procArgsObjPtr = NULL;
4915 cf->procBodyObjPtr = NULL;
4916 cf->next = NULL;
4917 cf->staticVars = NULL;
4918 cf->localCommands = NULL;
4919 cf->tailcallObj = NULL;
4920 cf->tailcallCmd = NULL;
4922 else {
4923 cf = Jim_Alloc(sizeof(*cf));
4924 memset(cf, 0, sizeof(*cf));
4926 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4929 cf->id = interp->callFrameEpoch++;
4930 cf->parent = parent;
4931 cf->level = parent ? parent->level + 1 : 0;
4932 cf->nsObj = nsObj;
4933 Jim_IncrRefCount(nsObj);
4935 return cf;
4938 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4940 /* Delete any local procs */
4941 if (localCommands) {
4942 Jim_Obj *cmdNameObj;
4944 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4945 Jim_HashEntry *he;
4946 Jim_Obj *fqObjName;
4947 Jim_HashTable *ht = &interp->commands;
4949 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4951 he = Jim_FindHashEntry(ht, fqname);
4953 if (he) {
4954 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4955 if (cmd->prevCmd) {
4956 Jim_Cmd *prevCmd = cmd->prevCmd;
4957 cmd->prevCmd = NULL;
4959 /* Delete the old command */
4960 JimDecrCmdRefCount(interp, cmd);
4962 /* And restore the original */
4963 Jim_SetHashVal(ht, he, prevCmd);
4965 else {
4966 Jim_DeleteHashEntry(ht, fqname);
4967 Jim_InterpIncrProcEpoch(interp);
4970 Jim_DecrRefCount(interp, cmdNameObj);
4971 JimFreeQualifiedName(interp, fqObjName);
4973 Jim_FreeStack(localCommands);
4974 Jim_Free(localCommands);
4976 return JIM_OK;
4980 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4981 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4982 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4984 JimDeleteLocalProcs(interp, cf->localCommands);
4986 if (cf->procArgsObjPtr)
4987 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4988 if (cf->procBodyObjPtr)
4989 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4990 Jim_DecrRefCount(interp, cf->nsObj);
4991 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4992 Jim_FreeHashTable(&cf->vars);
4993 else {
4994 int i;
4995 Jim_HashEntry **table = cf->vars.table, *he;
4997 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4998 he = table[i];
4999 while (he != NULL) {
5000 Jim_HashEntry *nextEntry = he->next;
5001 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5003 Jim_DecrRefCount(interp, varPtr->objPtr);
5004 Jim_Free(Jim_GetHashEntryKey(he));
5005 Jim_Free(varPtr);
5006 Jim_Free(he);
5007 table[i] = NULL;
5008 he = nextEntry;
5011 cf->vars.used = 0;
5013 cf->next = interp->freeFramesList;
5014 interp->freeFramesList = cf;
5018 /* -----------------------------------------------------------------------------
5019 * References
5020 * ---------------------------------------------------------------------------*/
5021 #ifdef JIM_REFERENCES
5023 /* References HashTable Type.
5025 * Keys are unsigned long integers, dynamically allocated for now but in the
5026 * future it's worth to cache this 4 bytes objects. Values are pointers
5027 * to Jim_References. */
5028 static void JimReferencesHTValDestructor(void *interp, void *val)
5030 Jim_Reference *refPtr = (void *)val;
5032 Jim_DecrRefCount(interp, refPtr->objPtr);
5033 if (refPtr->finalizerCmdNamePtr != NULL) {
5034 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5036 Jim_Free(val);
5039 static unsigned int JimReferencesHTHashFunction(const void *key)
5041 /* Only the least significant bits are used. */
5042 const unsigned long *widePtr = key;
5043 unsigned int intValue = (unsigned int)*widePtr;
5045 return Jim_IntHashFunction(intValue);
5048 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5050 void *copy = Jim_Alloc(sizeof(unsigned long));
5052 JIM_NOTUSED(privdata);
5054 memcpy(copy, key, sizeof(unsigned long));
5055 return copy;
5058 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5060 JIM_NOTUSED(privdata);
5062 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5065 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5067 JIM_NOTUSED(privdata);
5069 Jim_Free(key);
5072 static const Jim_HashTableType JimReferencesHashTableType = {
5073 JimReferencesHTHashFunction, /* hash function */
5074 JimReferencesHTKeyDup, /* key dup */
5075 NULL, /* val dup */
5076 JimReferencesHTKeyCompare, /* key compare */
5077 JimReferencesHTKeyDestructor, /* key destructor */
5078 JimReferencesHTValDestructor /* val destructor */
5081 /* -----------------------------------------------------------------------------
5082 * Reference object type and References API
5083 * ---------------------------------------------------------------------------*/
5085 /* The string representation of references has two features in order
5086 * to make the GC faster. The first is that every reference starts
5087 * with a non common character '<', in order to make the string matching
5088 * faster. The second is that the reference string rep is 42 characters
5089 * in length, this means that it is not necessary to check any object with a string
5090 * repr < 42, and usually there aren't many of these objects. */
5092 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5094 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5096 const char *fmt = "<reference.<%s>.%020lu>";
5098 sprintf(buf, fmt, refPtr->tag, id);
5099 return JIM_REFERENCE_SPACE;
5102 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5104 static const Jim_ObjType referenceObjType = {
5105 "reference",
5106 NULL,
5107 NULL,
5108 UpdateStringOfReference,
5109 JIM_TYPE_REFERENCES,
5112 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5114 char buf[JIM_REFERENCE_SPACE + 1];
5116 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5117 JimSetStringBytes(objPtr, buf);
5120 /* returns true if 'c' is a valid reference tag character.
5121 * i.e. inside the range [_a-zA-Z0-9] */
5122 static int isrefchar(int c)
5124 return (c == '_' || isalnum(c));
5127 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5129 unsigned long value;
5130 int i, len;
5131 const char *str, *start, *end;
5132 char refId[21];
5133 Jim_Reference *refPtr;
5134 Jim_HashEntry *he;
5135 char *endptr;
5137 /* Get the string representation */
5138 str = Jim_GetString(objPtr, &len);
5139 /* Check if it looks like a reference */
5140 if (len < JIM_REFERENCE_SPACE)
5141 goto badformat;
5142 /* Trim spaces */
5143 start = str;
5144 end = str + len - 1;
5145 while (*start == ' ')
5146 start++;
5147 while (*end == ' ' && end > start)
5148 end--;
5149 if (end - start + 1 != JIM_REFERENCE_SPACE)
5150 goto badformat;
5151 /* <reference.<1234567>.%020> */
5152 if (memcmp(start, "<reference.<", 12) != 0)
5153 goto badformat;
5154 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5155 goto badformat;
5156 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5157 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5158 if (!isrefchar(start[12 + i]))
5159 goto badformat;
5161 /* Extract info from the reference. */
5162 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5163 refId[20] = '\0';
5164 /* Try to convert the ID into an unsigned long */
5165 value = strtoul(refId, &endptr, 10);
5166 if (JimCheckConversion(refId, endptr) != JIM_OK)
5167 goto badformat;
5168 /* Check if the reference really exists! */
5169 he = Jim_FindHashEntry(&interp->references, &value);
5170 if (he == NULL) {
5171 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5172 return JIM_ERR;
5174 refPtr = Jim_GetHashEntryVal(he);
5175 /* Free the old internal repr and set the new one. */
5176 Jim_FreeIntRep(interp, objPtr);
5177 objPtr->typePtr = &referenceObjType;
5178 objPtr->internalRep.refValue.id = value;
5179 objPtr->internalRep.refValue.refPtr = refPtr;
5180 return JIM_OK;
5182 badformat:
5183 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5184 return JIM_ERR;
5187 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5188 * as finalizer command (or NULL if there is no finalizer).
5189 * The returned reference object has refcount = 0. */
5190 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5192 struct Jim_Reference *refPtr;
5193 unsigned long id;
5194 Jim_Obj *refObjPtr;
5195 const char *tag;
5196 int tagLen, i;
5198 /* Perform the Garbage Collection if needed. */
5199 Jim_CollectIfNeeded(interp);
5201 refPtr = Jim_Alloc(sizeof(*refPtr));
5202 refPtr->objPtr = objPtr;
5203 Jim_IncrRefCount(objPtr);
5204 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5205 if (cmdNamePtr)
5206 Jim_IncrRefCount(cmdNamePtr);
5207 id = interp->referenceNextId++;
5208 Jim_AddHashEntry(&interp->references, &id, refPtr);
5209 refObjPtr = Jim_NewObj(interp);
5210 refObjPtr->typePtr = &referenceObjType;
5211 refObjPtr->bytes = NULL;
5212 refObjPtr->internalRep.refValue.id = id;
5213 refObjPtr->internalRep.refValue.refPtr = refPtr;
5214 interp->referenceNextId++;
5215 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5216 * that does not pass the 'isrefchar' test is replaced with '_' */
5217 tag = Jim_GetString(tagPtr, &tagLen);
5218 if (tagLen > JIM_REFERENCE_TAGLEN)
5219 tagLen = JIM_REFERENCE_TAGLEN;
5220 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5221 if (i < tagLen && isrefchar(tag[i]))
5222 refPtr->tag[i] = tag[i];
5223 else
5224 refPtr->tag[i] = '_';
5226 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5227 return refObjPtr;
5230 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5232 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5233 return NULL;
5234 return objPtr->internalRep.refValue.refPtr;
5237 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5239 Jim_Reference *refPtr;
5241 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5242 return JIM_ERR;
5243 Jim_IncrRefCount(cmdNamePtr);
5244 if (refPtr->finalizerCmdNamePtr)
5245 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5246 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5247 return JIM_OK;
5250 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5252 Jim_Reference *refPtr;
5254 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5255 return JIM_ERR;
5256 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5257 return JIM_OK;
5260 /* -----------------------------------------------------------------------------
5261 * References Garbage Collection
5262 * ---------------------------------------------------------------------------*/
5264 /* This the hash table type for the "MARK" phase of the GC */
5265 static const Jim_HashTableType JimRefMarkHashTableType = {
5266 JimReferencesHTHashFunction, /* hash function */
5267 JimReferencesHTKeyDup, /* key dup */
5268 NULL, /* val dup */
5269 JimReferencesHTKeyCompare, /* key compare */
5270 JimReferencesHTKeyDestructor, /* key destructor */
5271 NULL /* val destructor */
5274 /* Performs the garbage collection. */
5275 int Jim_Collect(Jim_Interp *interp)
5277 int collected = 0;
5278 #ifndef JIM_BOOTSTRAP
5279 Jim_HashTable marks;
5280 Jim_HashTableIterator htiter;
5281 Jim_HashEntry *he;
5282 Jim_Obj *objPtr;
5284 /* Avoid recursive calls */
5285 if (interp->lastCollectId == -1) {
5286 /* Jim_Collect() already running. Return just now. */
5287 return 0;
5289 interp->lastCollectId = -1;
5291 /* Mark all the references found into the 'mark' hash table.
5292 * The references are searched in every live object that
5293 * is of a type that can contain references. */
5294 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5295 objPtr = interp->liveList;
5296 while (objPtr) {
5297 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5298 const char *str, *p;
5299 int len;
5301 /* If the object is of type reference, to get the
5302 * Id is simple... */
5303 if (objPtr->typePtr == &referenceObjType) {
5304 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5305 #ifdef JIM_DEBUG_GC
5306 printf("MARK (reference): %d refcount: %d\n",
5307 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5308 #endif
5309 objPtr = objPtr->nextObjPtr;
5310 continue;
5312 /* Get the string repr of the object we want
5313 * to scan for references. */
5314 p = str = Jim_GetString(objPtr, &len);
5315 /* Skip objects too little to contain references. */
5316 if (len < JIM_REFERENCE_SPACE) {
5317 objPtr = objPtr->nextObjPtr;
5318 continue;
5320 /* Extract references from the object string repr. */
5321 while (1) {
5322 int i;
5323 unsigned long id;
5325 if ((p = strstr(p, "<reference.<")) == NULL)
5326 break;
5327 /* Check if it's a valid reference. */
5328 if (len - (p - str) < JIM_REFERENCE_SPACE)
5329 break;
5330 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5331 break;
5332 for (i = 21; i <= 40; i++)
5333 if (!isdigit(UCHAR(p[i])))
5334 break;
5335 /* Get the ID */
5336 id = strtoul(p + 21, NULL, 10);
5338 /* Ok, a reference for the given ID
5339 * was found. Mark it. */
5340 Jim_AddHashEntry(&marks, &id, NULL);
5341 #ifdef JIM_DEBUG_GC
5342 printf("MARK: %d\n", (int)id);
5343 #endif
5344 p += JIM_REFERENCE_SPACE;
5347 objPtr = objPtr->nextObjPtr;
5350 /* Run the references hash table to destroy every reference that
5351 * is not referenced outside (not present in the mark HT). */
5352 JimInitHashTableIterator(&interp->references, &htiter);
5353 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5354 const unsigned long *refId;
5355 Jim_Reference *refPtr;
5357 refId = he->key;
5358 /* Check if in the mark phase we encountered
5359 * this reference. */
5360 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5361 #ifdef JIM_DEBUG_GC
5362 printf("COLLECTING %d\n", (int)*refId);
5363 #endif
5364 collected++;
5365 /* Drop the reference, but call the
5366 * finalizer first if registered. */
5367 refPtr = Jim_GetHashEntryVal(he);
5368 if (refPtr->finalizerCmdNamePtr) {
5369 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5370 Jim_Obj *objv[3], *oldResult;
5372 JimFormatReference(refstr, refPtr, *refId);
5374 objv[0] = refPtr->finalizerCmdNamePtr;
5375 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5376 objv[2] = refPtr->objPtr;
5378 /* Drop the reference itself */
5379 /* Avoid the finaliser being freed here */
5380 Jim_IncrRefCount(objv[0]);
5381 /* Don't remove the reference from the hash table just yet
5382 * since that will free refPtr, and hence refPtr->objPtr
5385 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5386 oldResult = interp->result;
5387 Jim_IncrRefCount(oldResult);
5388 Jim_EvalObjVector(interp, 3, objv);
5389 Jim_SetResult(interp, oldResult);
5390 Jim_DecrRefCount(interp, oldResult);
5392 Jim_DecrRefCount(interp, objv[0]);
5394 Jim_DeleteHashEntry(&interp->references, refId);
5397 Jim_FreeHashTable(&marks);
5398 interp->lastCollectId = interp->referenceNextId;
5399 interp->lastCollectTime = time(NULL);
5400 #endif /* JIM_BOOTSTRAP */
5401 return collected;
5404 #define JIM_COLLECT_ID_PERIOD 5000
5405 #define JIM_COLLECT_TIME_PERIOD 300
5407 void Jim_CollectIfNeeded(Jim_Interp *interp)
5409 unsigned long elapsedId;
5410 int elapsedTime;
5412 elapsedId = interp->referenceNextId - interp->lastCollectId;
5413 elapsedTime = time(NULL) - interp->lastCollectTime;
5416 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5417 Jim_Collect(interp);
5420 #endif
5422 int Jim_IsBigEndian(void)
5424 union {
5425 unsigned short s;
5426 unsigned char c[2];
5427 } uval = {0x0102};
5429 return uval.c[0] == 1;
5432 /* -----------------------------------------------------------------------------
5433 * Interpreter related functions
5434 * ---------------------------------------------------------------------------*/
5436 Jim_Interp *Jim_CreateInterp(void)
5438 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5440 memset(i, 0, sizeof(*i));
5442 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5443 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5444 i->lastCollectTime = time(NULL);
5446 /* Note that we can create objects only after the
5447 * interpreter liveList and freeList pointers are
5448 * initialized to NULL. */
5449 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5450 #ifdef JIM_REFERENCES
5451 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5452 #endif
5453 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5454 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5455 i->emptyObj = Jim_NewEmptyStringObj(i);
5456 i->trueObj = Jim_NewIntObj(i, 1);
5457 i->falseObj = Jim_NewIntObj(i, 0);
5458 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5459 i->errorFileNameObj = i->emptyObj;
5460 i->result = i->emptyObj;
5461 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5462 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5463 i->errorProc = i->emptyObj;
5464 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5465 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5466 Jim_IncrRefCount(i->emptyObj);
5467 Jim_IncrRefCount(i->errorFileNameObj);
5468 Jim_IncrRefCount(i->result);
5469 Jim_IncrRefCount(i->stackTrace);
5470 Jim_IncrRefCount(i->unknown);
5471 Jim_IncrRefCount(i->currentScriptObj);
5472 Jim_IncrRefCount(i->nullScriptObj);
5473 Jim_IncrRefCount(i->errorProc);
5474 Jim_IncrRefCount(i->trueObj);
5475 Jim_IncrRefCount(i->falseObj);
5477 /* Initialize key variables every interpreter should contain */
5478 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5479 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5481 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5482 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5483 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5484 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5485 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5486 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5487 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5489 return i;
5492 void Jim_FreeInterp(Jim_Interp *i)
5494 Jim_CallFrame *cf, *cfx;
5496 Jim_Obj *objPtr, *nextObjPtr;
5498 /* Free the active call frames list - must be done before i->commands is destroyed */
5499 for (cf = i->framePtr; cf; cf = cfx) {
5500 cfx = cf->parent;
5501 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5504 Jim_DecrRefCount(i, i->emptyObj);
5505 Jim_DecrRefCount(i, i->trueObj);
5506 Jim_DecrRefCount(i, i->falseObj);
5507 Jim_DecrRefCount(i, i->result);
5508 Jim_DecrRefCount(i, i->stackTrace);
5509 Jim_DecrRefCount(i, i->errorProc);
5510 Jim_DecrRefCount(i, i->unknown);
5511 Jim_DecrRefCount(i, i->errorFileNameObj);
5512 Jim_DecrRefCount(i, i->currentScriptObj);
5513 Jim_DecrRefCount(i, i->nullScriptObj);
5514 Jim_FreeHashTable(&i->commands);
5515 #ifdef JIM_REFERENCES
5516 Jim_FreeHashTable(&i->references);
5517 #endif
5518 Jim_FreeHashTable(&i->packages);
5519 Jim_Free(i->prngState);
5520 Jim_FreeHashTable(&i->assocData);
5522 /* Check that the live object list is empty, otherwise
5523 * there is a memory leak. */
5524 #ifdef JIM_MAINTAINER
5525 if (i->liveList != NULL) {
5526 objPtr = i->liveList;
5528 printf("\n-------------------------------------\n");
5529 printf("Objects still in the free list:\n");
5530 while (objPtr) {
5531 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5533 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5534 printf("%p (%d) %-10s: '%.20s...'\n",
5535 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5537 else {
5538 printf("%p (%d) %-10s: '%s'\n",
5539 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5541 if (objPtr->typePtr == &sourceObjType) {
5542 printf("FILE %s LINE %d\n",
5543 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5544 objPtr->internalRep.sourceValue.lineNumber);
5546 objPtr = objPtr->nextObjPtr;
5548 printf("-------------------------------------\n\n");
5549 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5551 #endif
5553 /* Free all the freed objects. */
5554 objPtr = i->freeList;
5555 while (objPtr) {
5556 nextObjPtr = objPtr->nextObjPtr;
5557 Jim_Free(objPtr);
5558 objPtr = nextObjPtr;
5561 /* Free the free call frames list */
5562 for (cf = i->freeFramesList; cf; cf = cfx) {
5563 cfx = cf->next;
5564 if (cf->vars.table)
5565 Jim_FreeHashTable(&cf->vars);
5566 Jim_Free(cf);
5569 /* Free the interpreter structure. */
5570 Jim_Free(i);
5573 /* Returns the call frame relative to the level represented by
5574 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5576 * This function accepts the 'level' argument in the form
5577 * of the commands [uplevel] and [upvar].
5579 * Returns NULL on error.
5581 * Note: for a function accepting a relative integer as level suitable
5582 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5584 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5586 long level;
5587 const char *str;
5588 Jim_CallFrame *framePtr;
5590 if (levelObjPtr) {
5591 str = Jim_String(levelObjPtr);
5592 if (str[0] == '#') {
5593 char *endptr;
5595 level = jim_strtol(str + 1, &endptr);
5596 if (str[1] == '\0' || endptr[0] != '\0') {
5597 level = -1;
5600 else {
5601 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5602 level = -1;
5604 else {
5605 /* Convert from a relative to an absolute level */
5606 level = interp->framePtr->level - level;
5610 else {
5611 str = "1"; /* Needed to format the error message. */
5612 level = interp->framePtr->level - 1;
5615 if (level == 0) {
5616 return interp->topFramePtr;
5618 if (level > 0) {
5619 /* Lookup */
5620 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5621 if (framePtr->level == level) {
5622 return framePtr;
5627 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5628 return NULL;
5631 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5632 * as a relative integer like in the [info level ?level?] command.
5634 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5636 long level;
5637 Jim_CallFrame *framePtr;
5639 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5640 if (level <= 0) {
5641 /* Convert from a relative to an absolute level */
5642 level = interp->framePtr->level + level;
5645 if (level == 0) {
5646 return interp->topFramePtr;
5649 /* Lookup */
5650 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5651 if (framePtr->level == level) {
5652 return framePtr;
5657 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5658 return NULL;
5661 static void JimResetStackTrace(Jim_Interp *interp)
5663 Jim_DecrRefCount(interp, interp->stackTrace);
5664 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5665 Jim_IncrRefCount(interp->stackTrace);
5668 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5670 int len;
5672 /* Increment reference first in case these are the same object */
5673 Jim_IncrRefCount(stackTraceObj);
5674 Jim_DecrRefCount(interp, interp->stackTrace);
5675 interp->stackTrace = stackTraceObj;
5676 interp->errorFlag = 1;
5678 /* This is a bit ugly.
5679 * If the filename of the last entry of the stack trace is empty,
5680 * the next stack level should be added.
5682 len = Jim_ListLength(interp, interp->stackTrace);
5683 if (len >= 3) {
5684 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5685 interp->addStackTrace = 1;
5690 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5691 Jim_Obj *fileNameObj, int linenr)
5693 if (strcmp(procname, "unknown") == 0) {
5694 procname = "";
5696 if (!*procname && !Jim_Length(fileNameObj)) {
5697 /* No useful info here */
5698 return;
5701 if (Jim_IsShared(interp->stackTrace)) {
5702 Jim_DecrRefCount(interp, interp->stackTrace);
5703 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5704 Jim_IncrRefCount(interp->stackTrace);
5707 /* If we have no procname but the previous element did, merge with that frame */
5708 if (!*procname && Jim_Length(fileNameObj)) {
5709 /* Just a filename. Check the previous entry */
5710 int len = Jim_ListLength(interp, interp->stackTrace);
5712 if (len >= 3) {
5713 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5714 if (Jim_Length(objPtr)) {
5715 /* Yes, the previous level had procname */
5716 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5717 if (Jim_Length(objPtr) == 0) {
5718 /* But no filename, so merge the new info with that frame */
5719 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5720 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5721 return;
5727 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5728 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5729 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5732 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5733 void *data)
5735 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5737 assocEntryPtr->delProc = delProc;
5738 assocEntryPtr->data = data;
5739 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5742 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5744 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5746 if (entryPtr != NULL) {
5747 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5748 return assocEntryPtr->data;
5750 return NULL;
5753 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5755 return Jim_DeleteHashEntry(&interp->assocData, key);
5758 int Jim_GetExitCode(Jim_Interp *interp)
5760 return interp->exitCode;
5763 /* -----------------------------------------------------------------------------
5764 * Integer object
5765 * ---------------------------------------------------------------------------*/
5766 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5767 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5769 static const Jim_ObjType intObjType = {
5770 "int",
5771 NULL,
5772 NULL,
5773 UpdateStringOfInt,
5774 JIM_TYPE_NONE,
5777 /* A coerced double is closer to an int than a double.
5778 * It is an int value temporarily masquerading as a double value.
5779 * i.e. it has the same string value as an int and Jim_GetWide()
5780 * succeeds, but also Jim_GetDouble() returns the value directly.
5782 static const Jim_ObjType coercedDoubleObjType = {
5783 "coerced-double",
5784 NULL,
5785 NULL,
5786 UpdateStringOfInt,
5787 JIM_TYPE_NONE,
5791 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5793 char buf[JIM_INTEGER_SPACE + 1];
5794 jim_wide wideValue = JimWideValue(objPtr);
5795 int pos = 0;
5797 if (wideValue == 0) {
5798 buf[pos++] = '0';
5800 else {
5801 char tmp[JIM_INTEGER_SPACE];
5802 int num = 0;
5803 int i;
5805 if (wideValue < 0) {
5806 buf[pos++] = '-';
5807 i = wideValue % 10;
5808 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5809 * whereas C99 is always -6
5810 * coverity[dead_error_line]
5812 tmp[num++] = (i > 0) ? (10 - i) : -i;
5813 wideValue /= -10;
5816 while (wideValue) {
5817 tmp[num++] = wideValue % 10;
5818 wideValue /= 10;
5821 for (i = 0; i < num; i++) {
5822 buf[pos++] = '0' + tmp[num - i - 1];
5825 buf[pos] = 0;
5827 JimSetStringBytes(objPtr, buf);
5830 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5832 jim_wide wideValue;
5833 const char *str;
5835 if (objPtr->typePtr == &coercedDoubleObjType) {
5836 /* Simple switch */
5837 objPtr->typePtr = &intObjType;
5838 return JIM_OK;
5841 /* Get the string representation */
5842 str = Jim_String(objPtr);
5843 /* Try to convert into a jim_wide */
5844 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5845 if (flags & JIM_ERRMSG) {
5846 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5848 return JIM_ERR;
5850 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5851 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5852 return JIM_ERR;
5854 /* Free the old internal repr and set the new one. */
5855 Jim_FreeIntRep(interp, objPtr);
5856 objPtr->typePtr = &intObjType;
5857 objPtr->internalRep.wideValue = wideValue;
5858 return JIM_OK;
5861 #ifdef JIM_OPTIMIZATION
5862 static int JimIsWide(Jim_Obj *objPtr)
5864 return objPtr->typePtr == &intObjType;
5866 #endif
5868 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5870 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5871 return JIM_ERR;
5872 *widePtr = JimWideValue(objPtr);
5873 return JIM_OK;
5876 /* Get a wide but does not set an error if the format is bad. */
5877 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5879 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5880 return JIM_ERR;
5881 *widePtr = JimWideValue(objPtr);
5882 return JIM_OK;
5885 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5887 jim_wide wideValue;
5888 int retval;
5890 retval = Jim_GetWide(interp, objPtr, &wideValue);
5891 if (retval == JIM_OK) {
5892 *longPtr = (long)wideValue;
5893 return JIM_OK;
5895 return JIM_ERR;
5898 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5900 Jim_Obj *objPtr;
5902 objPtr = Jim_NewObj(interp);
5903 objPtr->typePtr = &intObjType;
5904 objPtr->bytes = NULL;
5905 objPtr->internalRep.wideValue = wideValue;
5906 return objPtr;
5909 /* -----------------------------------------------------------------------------
5910 * Double object
5911 * ---------------------------------------------------------------------------*/
5912 #define JIM_DOUBLE_SPACE 30
5914 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5915 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5917 static const Jim_ObjType doubleObjType = {
5918 "double",
5919 NULL,
5920 NULL,
5921 UpdateStringOfDouble,
5922 JIM_TYPE_NONE,
5925 #ifndef HAVE_ISNAN
5926 #undef isnan
5927 #define isnan(X) ((X) != (X))
5928 #endif
5929 #ifndef HAVE_ISINF
5930 #undef isinf
5931 #define isinf(X) (1.0 / (X) == 0.0)
5932 #endif
5934 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5936 double value = objPtr->internalRep.doubleValue;
5938 if (isnan(value)) {
5939 JimSetStringBytes(objPtr, "NaN");
5940 return;
5942 if (isinf(value)) {
5943 if (value < 0) {
5944 JimSetStringBytes(objPtr, "-Inf");
5946 else {
5947 JimSetStringBytes(objPtr, "Inf");
5949 return;
5952 char buf[JIM_DOUBLE_SPACE + 1];
5953 int i;
5954 int len = sprintf(buf, "%.12g", value);
5956 /* Add a final ".0" if necessary */
5957 for (i = 0; i < len; i++) {
5958 if (buf[i] == '.' || buf[i] == 'e') {
5959 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5960 /* If 'buf' ends in e-0nn or e+0nn, remove
5961 * the 0 after the + or - and reduce the length by 1
5963 char *e = strchr(buf, 'e');
5964 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5965 /* Move it up */
5966 e += 2;
5967 memmove(e, e + 1, len - (e - buf));
5969 #endif
5970 break;
5973 if (buf[i] == '\0') {
5974 buf[i++] = '.';
5975 buf[i++] = '0';
5976 buf[i] = '\0';
5978 JimSetStringBytes(objPtr, buf);
5982 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5984 double doubleValue;
5985 jim_wide wideValue;
5986 const char *str;
5988 /* Preserve the string representation.
5989 * Needed so we can convert back to int without loss
5991 str = Jim_String(objPtr);
5993 #ifdef HAVE_LONG_LONG
5994 /* Assume a 53 bit mantissa */
5995 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5996 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5998 if (objPtr->typePtr == &intObjType
5999 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6000 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6002 /* Direct conversion to coerced double */
6003 objPtr->typePtr = &coercedDoubleObjType;
6004 return JIM_OK;
6006 else
6007 #endif
6008 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6009 /* Managed to convert to an int, so we can use this as a cooerced double */
6010 Jim_FreeIntRep(interp, objPtr);
6011 objPtr->typePtr = &coercedDoubleObjType;
6012 objPtr->internalRep.wideValue = wideValue;
6013 return JIM_OK;
6015 else {
6016 /* Try to convert into a double */
6017 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6018 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6019 return JIM_ERR;
6021 /* Free the old internal repr and set the new one. */
6022 Jim_FreeIntRep(interp, objPtr);
6024 objPtr->typePtr = &doubleObjType;
6025 objPtr->internalRep.doubleValue = doubleValue;
6026 return JIM_OK;
6029 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6031 if (objPtr->typePtr == &coercedDoubleObjType) {
6032 *doublePtr = JimWideValue(objPtr);
6033 return JIM_OK;
6035 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6036 return JIM_ERR;
6038 if (objPtr->typePtr == &coercedDoubleObjType) {
6039 *doublePtr = JimWideValue(objPtr);
6041 else {
6042 *doublePtr = objPtr->internalRep.doubleValue;
6044 return JIM_OK;
6047 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6049 Jim_Obj *objPtr;
6051 objPtr = Jim_NewObj(interp);
6052 objPtr->typePtr = &doubleObjType;
6053 objPtr->bytes = NULL;
6054 objPtr->internalRep.doubleValue = doubleValue;
6055 return objPtr;
6058 /* -----------------------------------------------------------------------------
6059 * List object
6060 * ---------------------------------------------------------------------------*/
6061 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6062 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6063 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6064 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6065 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6066 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6068 /* Note that while the elements of the list may contain references,
6069 * the list object itself can't. This basically means that the
6070 * list object string representation as a whole can't contain references
6071 * that are not presents in the single elements. */
6072 static const Jim_ObjType listObjType = {
6073 "list",
6074 FreeListInternalRep,
6075 DupListInternalRep,
6076 UpdateStringOfList,
6077 JIM_TYPE_NONE,
6080 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6082 int i;
6084 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6085 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6087 Jim_Free(objPtr->internalRep.listValue.ele);
6090 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6092 int i;
6094 JIM_NOTUSED(interp);
6096 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6097 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6098 dupPtr->internalRep.listValue.ele =
6099 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6100 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6101 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6102 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6103 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6105 dupPtr->typePtr = &listObjType;
6108 /* The following function checks if a given string can be encoded
6109 * into a list element without any kind of quoting, surrounded by braces,
6110 * or using escapes to quote. */
6111 #define JIM_ELESTR_SIMPLE 0
6112 #define JIM_ELESTR_BRACE 1
6113 #define JIM_ELESTR_QUOTE 2
6114 static unsigned char ListElementQuotingType(const char *s, int len)
6116 int i, level, blevel, trySimple = 1;
6118 /* Try with the SIMPLE case */
6119 if (len == 0)
6120 return JIM_ELESTR_BRACE;
6121 if (s[0] == '"' || s[0] == '{') {
6122 trySimple = 0;
6123 goto testbrace;
6125 for (i = 0; i < len; i++) {
6126 switch (s[i]) {
6127 case ' ':
6128 case '$':
6129 case '"':
6130 case '[':
6131 case ']':
6132 case ';':
6133 case '\\':
6134 case '\r':
6135 case '\n':
6136 case '\t':
6137 case '\f':
6138 case '\v':
6139 trySimple = 0;
6140 case '{':
6141 case '}':
6142 goto testbrace;
6145 return JIM_ELESTR_SIMPLE;
6147 testbrace:
6148 /* Test if it's possible to do with braces */
6149 if (s[len - 1] == '\\')
6150 return JIM_ELESTR_QUOTE;
6151 level = 0;
6152 blevel = 0;
6153 for (i = 0; i < len; i++) {
6154 switch (s[i]) {
6155 case '{':
6156 level++;
6157 break;
6158 case '}':
6159 level--;
6160 if (level < 0)
6161 return JIM_ELESTR_QUOTE;
6162 break;
6163 case '[':
6164 blevel++;
6165 break;
6166 case ']':
6167 blevel--;
6168 break;
6169 case '\\':
6170 if (s[i + 1] == '\n')
6171 return JIM_ELESTR_QUOTE;
6172 else if (s[i + 1] != '\0')
6173 i++;
6174 break;
6177 if (blevel < 0) {
6178 return JIM_ELESTR_QUOTE;
6181 if (level == 0) {
6182 if (!trySimple)
6183 return JIM_ELESTR_BRACE;
6184 for (i = 0; i < len; i++) {
6185 switch (s[i]) {
6186 case ' ':
6187 case '$':
6188 case '"':
6189 case '[':
6190 case ']':
6191 case ';':
6192 case '\\':
6193 case '\r':
6194 case '\n':
6195 case '\t':
6196 case '\f':
6197 case '\v':
6198 return JIM_ELESTR_BRACE;
6199 break;
6202 return JIM_ELESTR_SIMPLE;
6204 return JIM_ELESTR_QUOTE;
6207 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6208 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6209 * scenario.
6210 * Returns the length of the result.
6212 static int BackslashQuoteString(const char *s, int len, char *q)
6214 char *p = q;
6216 while (len--) {
6217 switch (*s) {
6218 case ' ':
6219 case '$':
6220 case '"':
6221 case '[':
6222 case ']':
6223 case '{':
6224 case '}':
6225 case ';':
6226 case '\\':
6227 *p++ = '\\';
6228 *p++ = *s++;
6229 break;
6230 case '\n':
6231 *p++ = '\\';
6232 *p++ = 'n';
6233 s++;
6234 break;
6235 case '\r':
6236 *p++ = '\\';
6237 *p++ = 'r';
6238 s++;
6239 break;
6240 case '\t':
6241 *p++ = '\\';
6242 *p++ = 't';
6243 s++;
6244 break;
6245 case '\f':
6246 *p++ = '\\';
6247 *p++ = 'f';
6248 s++;
6249 break;
6250 case '\v':
6251 *p++ = '\\';
6252 *p++ = 'v';
6253 s++;
6254 break;
6255 default:
6256 *p++ = *s++;
6257 break;
6260 *p = '\0';
6262 return p - q;
6265 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6267 #define STATIC_QUOTING_LEN 32
6268 int i, bufLen, realLength;
6269 const char *strRep;
6270 char *p;
6271 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6273 /* Estimate the space needed. */
6274 if (objc > STATIC_QUOTING_LEN) {
6275 quotingType = Jim_Alloc(objc);
6277 else {
6278 quotingType = staticQuoting;
6280 bufLen = 0;
6281 for (i = 0; i < objc; i++) {
6282 int len;
6284 strRep = Jim_GetString(objv[i], &len);
6285 quotingType[i] = ListElementQuotingType(strRep, len);
6286 switch (quotingType[i]) {
6287 case JIM_ELESTR_SIMPLE:
6288 if (i != 0 || strRep[0] != '#') {
6289 bufLen += len;
6290 break;
6292 /* Special case '#' on first element needs braces */
6293 quotingType[i] = JIM_ELESTR_BRACE;
6294 /* fall through */
6295 case JIM_ELESTR_BRACE:
6296 bufLen += len + 2;
6297 break;
6298 case JIM_ELESTR_QUOTE:
6299 bufLen += len * 2;
6300 break;
6302 bufLen++; /* elements separator. */
6304 bufLen++;
6306 /* Generate the string rep. */
6307 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6308 realLength = 0;
6309 for (i = 0; i < objc; i++) {
6310 int len, qlen;
6312 strRep = Jim_GetString(objv[i], &len);
6314 switch (quotingType[i]) {
6315 case JIM_ELESTR_SIMPLE:
6316 memcpy(p, strRep, len);
6317 p += len;
6318 realLength += len;
6319 break;
6320 case JIM_ELESTR_BRACE:
6321 *p++ = '{';
6322 memcpy(p, strRep, len);
6323 p += len;
6324 *p++ = '}';
6325 realLength += len + 2;
6326 break;
6327 case JIM_ELESTR_QUOTE:
6328 if (i == 0 && strRep[0] == '#') {
6329 *p++ = '\\';
6330 realLength++;
6332 qlen = BackslashQuoteString(strRep, len, p);
6333 p += qlen;
6334 realLength += qlen;
6335 break;
6337 /* Add a separating space */
6338 if (i + 1 != objc) {
6339 *p++ = ' ';
6340 realLength++;
6343 *p = '\0'; /* nul term. */
6344 objPtr->length = realLength;
6346 if (quotingType != staticQuoting) {
6347 Jim_Free(quotingType);
6351 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6353 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6356 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6358 struct JimParserCtx parser;
6359 const char *str;
6360 int strLen;
6361 Jim_Obj *fileNameObj;
6362 int linenr;
6364 if (objPtr->typePtr == &listObjType) {
6365 return JIM_OK;
6368 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6369 * it also preserves any source location of the dict elements
6370 * which can be very useful
6372 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6373 Jim_Obj **listObjPtrPtr;
6374 int len;
6375 int i;
6377 listObjPtrPtr = JimDictPairs(objPtr, &len);
6378 for (i = 0; i < len; i++) {
6379 Jim_IncrRefCount(listObjPtrPtr[i]);
6382 /* Now just switch the internal rep */
6383 Jim_FreeIntRep(interp, objPtr);
6384 objPtr->typePtr = &listObjType;
6385 objPtr->internalRep.listValue.len = len;
6386 objPtr->internalRep.listValue.maxLen = len;
6387 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6389 return JIM_OK;
6392 /* Try to preserve information about filename / line number */
6393 if (objPtr->typePtr == &sourceObjType) {
6394 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6395 linenr = objPtr->internalRep.sourceValue.lineNumber;
6397 else {
6398 fileNameObj = interp->emptyObj;
6399 linenr = 1;
6401 Jim_IncrRefCount(fileNameObj);
6403 /* Get the string representation */
6404 str = Jim_GetString(objPtr, &strLen);
6406 /* Free the old internal repr just now and initialize the
6407 * new one just now. The string->list conversion can't fail. */
6408 Jim_FreeIntRep(interp, objPtr);
6409 objPtr->typePtr = &listObjType;
6410 objPtr->internalRep.listValue.len = 0;
6411 objPtr->internalRep.listValue.maxLen = 0;
6412 objPtr->internalRep.listValue.ele = NULL;
6414 /* Convert into a list */
6415 if (strLen) {
6416 JimParserInit(&parser, str, strLen, linenr);
6417 while (!parser.eof) {
6418 Jim_Obj *elementPtr;
6420 JimParseList(&parser);
6421 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6422 continue;
6423 elementPtr = JimParserGetTokenObj(interp, &parser);
6424 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6425 ListAppendElement(objPtr, elementPtr);
6428 Jim_DecrRefCount(interp, fileNameObj);
6429 return JIM_OK;
6432 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6434 Jim_Obj *objPtr;
6436 objPtr = Jim_NewObj(interp);
6437 objPtr->typePtr = &listObjType;
6438 objPtr->bytes = NULL;
6439 objPtr->internalRep.listValue.ele = NULL;
6440 objPtr->internalRep.listValue.len = 0;
6441 objPtr->internalRep.listValue.maxLen = 0;
6443 if (len) {
6444 ListInsertElements(objPtr, 0, len, elements);
6447 return objPtr;
6450 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6451 * length of the vector. Note that the user of this function should make
6452 * sure that the list object can't shimmer while the vector returned
6453 * is in use, this vector is the one stored inside the internal representation
6454 * of the list object. This function is not exported, extensions should
6455 * always access to the List object elements using Jim_ListIndex(). */
6456 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6457 Jim_Obj ***listVec)
6459 *listLen = Jim_ListLength(interp, listObj);
6460 *listVec = listObj->internalRep.listValue.ele;
6463 /* Sorting uses ints, but commands may return wide */
6464 static int JimSign(jim_wide w)
6466 if (w == 0) {
6467 return 0;
6469 else if (w < 0) {
6470 return -1;
6472 return 1;
6475 /* ListSortElements type values */
6476 struct lsort_info {
6477 jmp_buf jmpbuf;
6478 Jim_Obj *command;
6479 Jim_Interp *interp;
6480 enum {
6481 JIM_LSORT_ASCII,
6482 JIM_LSORT_NOCASE,
6483 JIM_LSORT_INTEGER,
6484 JIM_LSORT_REAL,
6485 JIM_LSORT_COMMAND
6486 } type;
6487 int order;
6488 int index;
6489 int indexed;
6490 int unique;
6491 int (*subfn)(Jim_Obj **, Jim_Obj **);
6494 static struct lsort_info *sort_info;
6496 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6498 Jim_Obj *lObj, *rObj;
6500 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6501 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6502 longjmp(sort_info->jmpbuf, JIM_ERR);
6504 return sort_info->subfn(&lObj, &rObj);
6507 /* Sort the internal rep of a list. */
6508 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6510 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6513 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6515 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6518 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6520 jim_wide lhs = 0, rhs = 0;
6522 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6523 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6524 longjmp(sort_info->jmpbuf, JIM_ERR);
6527 return JimSign(lhs - rhs) * sort_info->order;
6530 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6532 double lhs = 0, rhs = 0;
6534 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6535 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6536 longjmp(sort_info->jmpbuf, JIM_ERR);
6538 if (lhs == rhs) {
6539 return 0;
6541 if (lhs > rhs) {
6542 return sort_info->order;
6544 return -sort_info->order;
6547 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6549 Jim_Obj *compare_script;
6550 int rc;
6552 jim_wide ret = 0;
6554 /* This must be a valid list */
6555 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6556 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6557 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6559 rc = Jim_EvalObj(sort_info->interp, compare_script);
6561 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6562 longjmp(sort_info->jmpbuf, rc);
6565 return JimSign(ret) * sort_info->order;
6568 /* Remove duplicate elements from the (sorted) list in-place, according to the
6569 * comparison function, comp.
6571 * Note that the last unique value is kept, not the first
6573 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6575 int src;
6576 int dst = 0;
6577 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6579 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6580 if (comp(&ele[dst], &ele[src]) == 0) {
6581 /* Match, so replace the dest with the current source */
6582 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6584 else {
6585 /* No match, so keep the current source and move to the next destination */
6586 dst++;
6588 ele[dst] = ele[src];
6590 /* At end of list, keep the final element */
6591 ele[++dst] = ele[src];
6593 /* Set the new length */
6594 listObjPtr->internalRep.listValue.len = dst;
6597 /* Sort a list *in place*. MUST be called with a non-shared list. */
6598 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6600 struct lsort_info *prev_info;
6602 typedef int (qsort_comparator) (const void *, const void *);
6603 int (*fn) (Jim_Obj **, Jim_Obj **);
6604 Jim_Obj **vector;
6605 int len;
6606 int rc;
6608 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6609 SetListFromAny(interp, listObjPtr);
6611 /* Allow lsort to be called reentrantly */
6612 prev_info = sort_info;
6613 sort_info = info;
6615 vector = listObjPtr->internalRep.listValue.ele;
6616 len = listObjPtr->internalRep.listValue.len;
6617 switch (info->type) {
6618 case JIM_LSORT_ASCII:
6619 fn = ListSortString;
6620 break;
6621 case JIM_LSORT_NOCASE:
6622 fn = ListSortStringNoCase;
6623 break;
6624 case JIM_LSORT_INTEGER:
6625 fn = ListSortInteger;
6626 break;
6627 case JIM_LSORT_REAL:
6628 fn = ListSortReal;
6629 break;
6630 case JIM_LSORT_COMMAND:
6631 fn = ListSortCommand;
6632 break;
6633 default:
6634 fn = NULL; /* avoid warning */
6635 JimPanic((1, "ListSort called with invalid sort type"));
6638 if (info->indexed) {
6639 /* Need to interpose a "list index" function */
6640 info->subfn = fn;
6641 fn = ListSortIndexHelper;
6644 if ((rc = setjmp(info->jmpbuf)) == 0) {
6645 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6647 if (info->unique && len > 1) {
6648 ListRemoveDuplicates(listObjPtr, fn);
6651 Jim_InvalidateStringRep(listObjPtr);
6653 sort_info = prev_info;
6655 return rc;
6658 /* This is the low-level function to insert elements into a list.
6659 * The higher-level Jim_ListInsertElements() performs shared object
6660 * check and invalidates the string repr. This version is used
6661 * in the internals of the List Object and is not exported.
6663 * NOTE: this function can be called only against objects
6664 * with internal type of List.
6666 * An insertion point (idx) of -1 means end-of-list.
6668 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6670 int currentLen = listPtr->internalRep.listValue.len;
6671 int requiredLen = currentLen + elemc;
6672 int i;
6673 Jim_Obj **point;
6675 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6676 if (requiredLen < 2) {
6677 /* Don't do allocations of under 4 pointers. */
6678 requiredLen = 4;
6680 else {
6681 requiredLen *= 2;
6684 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6685 sizeof(Jim_Obj *) * requiredLen);
6687 listPtr->internalRep.listValue.maxLen = requiredLen;
6689 if (idx < 0) {
6690 idx = currentLen;
6692 point = listPtr->internalRep.listValue.ele + idx;
6693 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6694 for (i = 0; i < elemc; ++i) {
6695 point[i] = elemVec[i];
6696 Jim_IncrRefCount(point[i]);
6698 listPtr->internalRep.listValue.len += elemc;
6701 /* Convenience call to ListInsertElements() to append a single element.
6703 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6705 ListInsertElements(listPtr, -1, 1, &objPtr);
6708 /* Appends every element of appendListPtr into listPtr.
6709 * Both have to be of the list type.
6710 * Convenience call to ListInsertElements()
6712 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6714 ListInsertElements(listPtr, -1,
6715 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6718 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6720 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6721 SetListFromAny(interp, listPtr);
6722 Jim_InvalidateStringRep(listPtr);
6723 ListAppendElement(listPtr, objPtr);
6726 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6728 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6729 SetListFromAny(interp, listPtr);
6730 SetListFromAny(interp, appendListPtr);
6731 Jim_InvalidateStringRep(listPtr);
6732 ListAppendList(listPtr, appendListPtr);
6735 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6737 SetListFromAny(interp, objPtr);
6738 return objPtr->internalRep.listValue.len;
6741 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6742 int objc, Jim_Obj *const *objVec)
6744 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6745 SetListFromAny(interp, listPtr);
6746 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6747 idx = listPtr->internalRep.listValue.len;
6748 else if (idx < 0)
6749 idx = 0;
6750 Jim_InvalidateStringRep(listPtr);
6751 ListInsertElements(listPtr, idx, objc, objVec);
6754 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6756 SetListFromAny(interp, listPtr);
6757 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6758 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6759 return NULL;
6761 if (idx < 0)
6762 idx = listPtr->internalRep.listValue.len + idx;
6763 return listPtr->internalRep.listValue.ele[idx];
6766 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6768 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6769 if (*objPtrPtr == NULL) {
6770 if (flags & JIM_ERRMSG) {
6771 Jim_SetResultString(interp, "list index out of range", -1);
6773 return JIM_ERR;
6775 return JIM_OK;
6778 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6779 Jim_Obj *newObjPtr, int flags)
6781 SetListFromAny(interp, listPtr);
6782 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6783 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6784 if (flags & JIM_ERRMSG) {
6785 Jim_SetResultString(interp, "list index out of range", -1);
6787 return JIM_ERR;
6789 if (idx < 0)
6790 idx = listPtr->internalRep.listValue.len + idx;
6791 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6792 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6793 Jim_IncrRefCount(newObjPtr);
6794 return JIM_OK;
6797 /* Modify the list stored in the variable named 'varNamePtr'
6798 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6799 * with the new element 'newObjptr'. (implements the [lset] command) */
6800 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6801 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6803 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6804 int shared, i, idx;
6806 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6807 if (objPtr == NULL)
6808 return JIM_ERR;
6809 if ((shared = Jim_IsShared(objPtr)))
6810 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6811 for (i = 0; i < indexc - 1; i++) {
6812 listObjPtr = objPtr;
6813 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6814 goto err;
6815 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6816 goto err;
6818 if (Jim_IsShared(objPtr)) {
6819 objPtr = Jim_DuplicateObj(interp, objPtr);
6820 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6822 Jim_InvalidateStringRep(listObjPtr);
6824 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6825 goto err;
6826 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6827 goto err;
6828 Jim_InvalidateStringRep(objPtr);
6829 Jim_InvalidateStringRep(varObjPtr);
6830 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6831 goto err;
6832 Jim_SetResult(interp, varObjPtr);
6833 return JIM_OK;
6834 err:
6835 if (shared) {
6836 Jim_FreeNewObj(interp, varObjPtr);
6838 return JIM_ERR;
6841 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6843 int i;
6844 int listLen = Jim_ListLength(interp, listObjPtr);
6845 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6847 for (i = 0; i < listLen; ) {
6848 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6849 if (++i != listLen) {
6850 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6853 return resObjPtr;
6856 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6858 int i;
6860 /* If all the objects in objv are lists,
6861 * it's possible to return a list as result, that's the
6862 * concatenation of all the lists. */
6863 for (i = 0; i < objc; i++) {
6864 if (!Jim_IsList(objv[i]))
6865 break;
6867 if (i == objc) {
6868 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6870 for (i = 0; i < objc; i++)
6871 ListAppendList(objPtr, objv[i]);
6872 return objPtr;
6874 else {
6875 /* Else... we have to glue strings together */
6876 int len = 0, objLen;
6877 char *bytes, *p;
6879 /* Compute the length */
6880 for (i = 0; i < objc; i++) {
6881 len += Jim_Length(objv[i]);
6883 if (objc)
6884 len += objc - 1;
6885 /* Create the string rep, and a string object holding it. */
6886 p = bytes = Jim_Alloc(len + 1);
6887 for (i = 0; i < objc; i++) {
6888 const char *s = Jim_GetString(objv[i], &objLen);
6890 /* Remove leading space */
6891 while (objLen && isspace(UCHAR(*s))) {
6892 s++;
6893 objLen--;
6894 len--;
6896 /* And trailing space */
6897 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6898 /* Handle trailing backslash-space case */
6899 if (objLen > 1 && s[objLen - 2] == '\\') {
6900 break;
6902 objLen--;
6903 len--;
6905 memcpy(p, s, objLen);
6906 p += objLen;
6907 if (i + 1 != objc) {
6908 if (objLen)
6909 *p++ = ' ';
6910 else {
6911 /* Drop the space calculated for this
6912 * element that is instead null. */
6913 len--;
6917 *p = '\0';
6918 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6922 /* Returns a list composed of the elements in the specified range.
6923 * first and start are directly accepted as Jim_Objects and
6924 * processed for the end?-index? case. */
6925 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6926 Jim_Obj *lastObjPtr)
6928 int first, last;
6929 int len, rangeLen;
6931 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6932 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6933 return NULL;
6934 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6935 first = JimRelToAbsIndex(len, first);
6936 last = JimRelToAbsIndex(len, last);
6937 JimRelToAbsRange(len, &first, &last, &rangeLen);
6938 if (first == 0 && last == len) {
6939 return listObjPtr;
6941 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6944 /* -----------------------------------------------------------------------------
6945 * Dict object
6946 * ---------------------------------------------------------------------------*/
6947 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6948 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6949 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6950 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6952 /* Dict HashTable Type.
6954 * Keys and Values are Jim objects. */
6956 static unsigned int JimObjectHTHashFunction(const void *key)
6958 int len;
6959 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6960 return Jim_GenHashFunction((const unsigned char *)str, len);
6963 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6965 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6968 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6970 Jim_IncrRefCount((Jim_Obj *)val);
6971 return (void *)val;
6974 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6976 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6979 static const Jim_HashTableType JimDictHashTableType = {
6980 JimObjectHTHashFunction, /* hash function */
6981 JimObjectHTKeyValDup, /* key dup */
6982 JimObjectHTKeyValDup, /* val dup */
6983 JimObjectHTKeyCompare, /* key compare */
6984 JimObjectHTKeyValDestructor, /* key destructor */
6985 JimObjectHTKeyValDestructor /* val destructor */
6988 /* Note that while the elements of the dict may contain references,
6989 * the list object itself can't. This basically means that the
6990 * dict object string representation as a whole can't contain references
6991 * that are not presents in the single elements. */
6992 static const Jim_ObjType dictObjType = {
6993 "dict",
6994 FreeDictInternalRep,
6995 DupDictInternalRep,
6996 UpdateStringOfDict,
6997 JIM_TYPE_NONE,
7000 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7002 JIM_NOTUSED(interp);
7004 Jim_FreeHashTable(objPtr->internalRep.ptr);
7005 Jim_Free(objPtr->internalRep.ptr);
7008 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7010 Jim_HashTable *ht, *dupHt;
7011 Jim_HashTableIterator htiter;
7012 Jim_HashEntry *he;
7014 /* Create a new hash table */
7015 ht = srcPtr->internalRep.ptr;
7016 dupHt = Jim_Alloc(sizeof(*dupHt));
7017 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7018 if (ht->size != 0)
7019 Jim_ExpandHashTable(dupHt, ht->size);
7020 /* Copy every element from the source to the dup hash table */
7021 JimInitHashTableIterator(ht, &htiter);
7022 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7023 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7026 dupPtr->internalRep.ptr = dupHt;
7027 dupPtr->typePtr = &dictObjType;
7030 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7032 Jim_HashTable *ht;
7033 Jim_HashTableIterator htiter;
7034 Jim_HashEntry *he;
7035 Jim_Obj **objv;
7036 int i;
7038 ht = dictPtr->internalRep.ptr;
7040 /* Turn the hash table into a flat vector of Jim_Objects. */
7041 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7042 JimInitHashTableIterator(ht, &htiter);
7043 i = 0;
7044 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7045 objv[i++] = Jim_GetHashEntryKey(he);
7046 objv[i++] = Jim_GetHashEntryVal(he);
7048 *len = i;
7049 return objv;
7052 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7054 /* Turn the hash table into a flat vector of Jim_Objects. */
7055 int len;
7056 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7058 /* And now generate the string rep as a list */
7059 JimMakeListStringRep(objPtr, objv, len);
7061 Jim_Free(objv);
7064 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7066 int listlen;
7068 if (objPtr->typePtr == &dictObjType) {
7069 return JIM_OK;
7072 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7073 /* A shared list, so get the string representation now to avoid
7074 * changing the order in case of fast conversion to dict.
7076 Jim_String(objPtr);
7079 /* For simplicity, convert a non-list object to a list and then to a dict */
7080 listlen = Jim_ListLength(interp, objPtr);
7081 if (listlen % 2) {
7082 Jim_SetResultString(interp, "missing value to go with key", -1);
7083 return JIM_ERR;
7085 else {
7086 /* Converting from a list to a dict can't fail */
7087 Jim_HashTable *ht;
7088 int i;
7090 ht = Jim_Alloc(sizeof(*ht));
7091 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7093 for (i = 0; i < listlen; i += 2) {
7094 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7095 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7097 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7100 Jim_FreeIntRep(interp, objPtr);
7101 objPtr->typePtr = &dictObjType;
7102 objPtr->internalRep.ptr = ht;
7104 return JIM_OK;
7108 /* Dict object API */
7110 /* Add an element to a dict. objPtr must be of the "dict" type.
7111 * The higher-level exported function is Jim_DictAddElement().
7112 * If an element with the specified key already exists, the value
7113 * associated is replaced with the new one.
7115 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7116 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7117 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7119 Jim_HashTable *ht = objPtr->internalRep.ptr;
7121 if (valueObjPtr == NULL) { /* unset */
7122 return Jim_DeleteHashEntry(ht, keyObjPtr);
7124 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7125 return JIM_OK;
7128 /* Add an element, higher-level interface for DictAddElement().
7129 * If valueObjPtr == NULL, the key is removed if it exists. */
7130 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7131 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7133 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7134 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7135 return JIM_ERR;
7137 Jim_InvalidateStringRep(objPtr);
7138 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7141 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7143 Jim_Obj *objPtr;
7144 int i;
7146 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7148 objPtr = Jim_NewObj(interp);
7149 objPtr->typePtr = &dictObjType;
7150 objPtr->bytes = NULL;
7151 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7152 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7153 for (i = 0; i < len; i += 2)
7154 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7155 return objPtr;
7158 /* Return the value associated to the specified dict key
7159 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7161 * Sets *objPtrPtr to non-NULL only upon success.
7163 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7164 Jim_Obj **objPtrPtr, int flags)
7166 Jim_HashEntry *he;
7167 Jim_HashTable *ht;
7169 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7170 return -1;
7172 ht = dictPtr->internalRep.ptr;
7173 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7174 if (flags & JIM_ERRMSG) {
7175 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7177 return JIM_ERR;
7179 *objPtrPtr = he->u.val;
7180 return JIM_OK;
7183 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7184 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7186 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7187 return JIM_ERR;
7189 *objPtrPtr = JimDictPairs(dictPtr, len);
7191 return JIM_OK;
7195 /* Return the value associated to the specified dict keys */
7196 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7197 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7199 int i;
7201 if (keyc == 0) {
7202 *objPtrPtr = dictPtr;
7203 return JIM_OK;
7206 for (i = 0; i < keyc; i++) {
7207 Jim_Obj *objPtr;
7209 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7210 if (rc != JIM_OK) {
7211 return rc;
7213 dictPtr = objPtr;
7215 *objPtrPtr = dictPtr;
7216 return JIM_OK;
7219 /* Modify the dict stored into the variable named 'varNamePtr'
7220 * setting the element specified by the 'keyc' keys objects in 'keyv',
7221 * with the new value of the element 'newObjPtr'.
7223 * If newObjPtr == NULL the operation is to remove the given key
7224 * from the dictionary.
7226 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7227 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7229 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7230 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7232 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7233 int shared, i;
7235 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7236 if (objPtr == NULL) {
7237 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7238 /* Cannot remove a key from non existing var */
7239 return JIM_ERR;
7241 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7242 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7243 Jim_FreeNewObj(interp, varObjPtr);
7244 return JIM_ERR;
7247 if ((shared = Jim_IsShared(objPtr)))
7248 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7249 for (i = 0; i < keyc; i++) {
7250 dictObjPtr = objPtr;
7252 /* Check if it's a valid dictionary */
7253 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7254 goto err;
7257 if (i == keyc - 1) {
7258 /* Last key: Note that error on unset with missing last key is OK */
7259 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7260 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7261 goto err;
7264 break;
7267 /* Check if the given key exists. */
7268 Jim_InvalidateStringRep(dictObjPtr);
7269 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7270 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7271 /* This key exists at the current level.
7272 * Make sure it's not shared!. */
7273 if (Jim_IsShared(objPtr)) {
7274 objPtr = Jim_DuplicateObj(interp, objPtr);
7275 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7278 else {
7279 /* Key not found. If it's an [unset] operation
7280 * this is an error. Only the last key may not
7281 * exist. */
7282 if (newObjPtr == NULL) {
7283 goto err;
7285 /* Otherwise set an empty dictionary
7286 * as key's value. */
7287 objPtr = Jim_NewDictObj(interp, NULL, 0);
7288 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7291 /* XXX: Is this necessary? */
7292 Jim_InvalidateStringRep(objPtr);
7293 Jim_InvalidateStringRep(varObjPtr);
7294 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7295 goto err;
7297 Jim_SetResult(interp, varObjPtr);
7298 return JIM_OK;
7299 err:
7300 if (shared) {
7301 Jim_FreeNewObj(interp, varObjPtr);
7303 return JIM_ERR;
7306 /* -----------------------------------------------------------------------------
7307 * Index object
7308 * ---------------------------------------------------------------------------*/
7309 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7310 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7312 static const Jim_ObjType indexObjType = {
7313 "index",
7314 NULL,
7315 NULL,
7316 UpdateStringOfIndex,
7317 JIM_TYPE_NONE,
7320 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7322 if (objPtr->internalRep.intValue == -1) {
7323 JimSetStringBytes(objPtr, "end");
7325 else {
7326 char buf[JIM_INTEGER_SPACE + 1];
7327 if (objPtr->internalRep.intValue >= 0) {
7328 sprintf(buf, "%d", objPtr->internalRep.intValue);
7330 else {
7331 /* Must be <= -2 */
7332 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7334 JimSetStringBytes(objPtr, buf);
7338 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7340 int idx, end = 0;
7341 const char *str;
7342 char *endptr;
7344 /* Get the string representation */
7345 str = Jim_String(objPtr);
7347 /* Try to convert into an index */
7348 if (strncmp(str, "end", 3) == 0) {
7349 end = 1;
7350 str += 3;
7351 idx = 0;
7353 else {
7354 idx = jim_strtol(str, &endptr);
7356 if (endptr == str) {
7357 goto badindex;
7359 str = endptr;
7362 /* Now str may include or +<num> or -<num> */
7363 if (*str == '+' || *str == '-') {
7364 int sign = (*str == '+' ? 1 : -1);
7366 idx += sign * jim_strtol(++str, &endptr);
7367 if (str == endptr || *endptr) {
7368 goto badindex;
7370 str = endptr;
7372 /* The only thing left should be spaces */
7373 while (isspace(UCHAR(*str))) {
7374 str++;
7376 if (*str) {
7377 goto badindex;
7379 if (end) {
7380 if (idx > 0) {
7381 idx = INT_MAX;
7383 else {
7384 /* end-1 is repesented as -2 */
7385 idx--;
7388 else if (idx < 0) {
7389 idx = -INT_MAX;
7392 /* Free the old internal repr and set the new one. */
7393 Jim_FreeIntRep(interp, objPtr);
7394 objPtr->typePtr = &indexObjType;
7395 objPtr->internalRep.intValue = idx;
7396 return JIM_OK;
7398 badindex:
7399 Jim_SetResultFormatted(interp,
7400 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7401 return JIM_ERR;
7404 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7406 /* Avoid shimmering if the object is an integer. */
7407 if (objPtr->typePtr == &intObjType) {
7408 jim_wide val = JimWideValue(objPtr);
7410 if (val < 0)
7411 *indexPtr = -INT_MAX;
7412 else if (val > INT_MAX)
7413 *indexPtr = INT_MAX;
7414 else
7415 *indexPtr = (int)val;
7416 return JIM_OK;
7418 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7419 return JIM_ERR;
7420 *indexPtr = objPtr->internalRep.intValue;
7421 return JIM_OK;
7424 /* -----------------------------------------------------------------------------
7425 * Return Code Object.
7426 * ---------------------------------------------------------------------------*/
7428 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7429 static const char * const jimReturnCodes[] = {
7430 "ok",
7431 "error",
7432 "return",
7433 "break",
7434 "continue",
7435 "signal",
7436 "exit",
7437 "eval",
7438 NULL
7441 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7443 static const Jim_ObjType returnCodeObjType = {
7444 "return-code",
7445 NULL,
7446 NULL,
7447 NULL,
7448 JIM_TYPE_NONE,
7451 /* Converts a (standard) return code to a string. Returns "?" for
7452 * non-standard return codes.
7454 const char *Jim_ReturnCode(int code)
7456 if (code < 0 || code >= (int)jimReturnCodesSize) {
7457 return "?";
7459 else {
7460 return jimReturnCodes[code];
7464 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7466 int returnCode;
7467 jim_wide wideValue;
7469 /* Try to convert into an integer */
7470 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7471 returnCode = (int)wideValue;
7472 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7473 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7474 return JIM_ERR;
7476 /* Free the old internal repr and set the new one. */
7477 Jim_FreeIntRep(interp, objPtr);
7478 objPtr->typePtr = &returnCodeObjType;
7479 objPtr->internalRep.intValue = returnCode;
7480 return JIM_OK;
7483 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7485 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7486 return JIM_ERR;
7487 *intPtr = objPtr->internalRep.intValue;
7488 return JIM_OK;
7491 /* -----------------------------------------------------------------------------
7492 * Expression Parsing
7493 * ---------------------------------------------------------------------------*/
7494 static int JimParseExprOperator(struct JimParserCtx *pc);
7495 static int JimParseExprNumber(struct JimParserCtx *pc);
7496 static int JimParseExprIrrational(struct JimParserCtx *pc);
7498 /* Exrp's Stack machine operators opcodes. */
7500 /* Binary operators (numbers) */
7501 enum
7503 /* Continues on from the JIM_TT_ space */
7504 /* Operations */
7505 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7506 JIM_EXPROP_DIV,
7507 JIM_EXPROP_MOD,
7508 JIM_EXPROP_SUB,
7509 JIM_EXPROP_ADD,
7510 JIM_EXPROP_LSHIFT,
7511 JIM_EXPROP_RSHIFT,
7512 JIM_EXPROP_ROTL,
7513 JIM_EXPROP_ROTR,
7514 JIM_EXPROP_LT,
7515 JIM_EXPROP_GT,
7516 JIM_EXPROP_LTE,
7517 JIM_EXPROP_GTE,
7518 JIM_EXPROP_NUMEQ,
7519 JIM_EXPROP_NUMNE,
7520 JIM_EXPROP_BITAND, /* 35 */
7521 JIM_EXPROP_BITXOR,
7522 JIM_EXPROP_BITOR,
7524 /* Note must keep these together */
7525 JIM_EXPROP_LOGICAND, /* 38 */
7526 JIM_EXPROP_LOGICAND_LEFT,
7527 JIM_EXPROP_LOGICAND_RIGHT,
7529 /* and these */
7530 JIM_EXPROP_LOGICOR, /* 41 */
7531 JIM_EXPROP_LOGICOR_LEFT,
7532 JIM_EXPROP_LOGICOR_RIGHT,
7534 /* and these */
7535 /* Ternary operators */
7536 JIM_EXPROP_TERNARY, /* 44 */
7537 JIM_EXPROP_TERNARY_LEFT,
7538 JIM_EXPROP_TERNARY_RIGHT,
7540 /* and these */
7541 JIM_EXPROP_COLON, /* 47 */
7542 JIM_EXPROP_COLON_LEFT,
7543 JIM_EXPROP_COLON_RIGHT,
7545 JIM_EXPROP_POW, /* 50 */
7547 /* Binary operators (strings) */
7548 JIM_EXPROP_STREQ, /* 51 */
7549 JIM_EXPROP_STRNE,
7550 JIM_EXPROP_STRIN,
7551 JIM_EXPROP_STRNI,
7553 /* Unary operators (numbers) */
7554 JIM_EXPROP_NOT, /* 55 */
7555 JIM_EXPROP_BITNOT,
7556 JIM_EXPROP_UNARYMINUS,
7557 JIM_EXPROP_UNARYPLUS,
7559 /* Functions */
7560 JIM_EXPROP_FUNC_FIRST, /* 59 */
7561 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7562 JIM_EXPROP_FUNC_WIDE,
7563 JIM_EXPROP_FUNC_ABS,
7564 JIM_EXPROP_FUNC_DOUBLE,
7565 JIM_EXPROP_FUNC_ROUND,
7566 JIM_EXPROP_FUNC_RAND,
7567 JIM_EXPROP_FUNC_SRAND,
7569 /* math functions from libm */
7570 JIM_EXPROP_FUNC_SIN, /* 65 */
7571 JIM_EXPROP_FUNC_COS,
7572 JIM_EXPROP_FUNC_TAN,
7573 JIM_EXPROP_FUNC_ASIN,
7574 JIM_EXPROP_FUNC_ACOS,
7575 JIM_EXPROP_FUNC_ATAN,
7576 JIM_EXPROP_FUNC_SINH,
7577 JIM_EXPROP_FUNC_COSH,
7578 JIM_EXPROP_FUNC_TANH,
7579 JIM_EXPROP_FUNC_CEIL,
7580 JIM_EXPROP_FUNC_FLOOR,
7581 JIM_EXPROP_FUNC_EXP,
7582 JIM_EXPROP_FUNC_LOG,
7583 JIM_EXPROP_FUNC_LOG10,
7584 JIM_EXPROP_FUNC_SQRT,
7585 JIM_EXPROP_FUNC_POW,
7588 struct JimExprState
7590 Jim_Obj **stack;
7591 int stacklen;
7592 int opcode;
7593 int skip;
7596 /* Operators table */
7597 typedef struct Jim_ExprOperator
7599 const char *name;
7600 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7601 unsigned char precedence;
7602 unsigned char arity;
7603 unsigned char lazy;
7604 unsigned char namelen;
7605 } Jim_ExprOperator;
7607 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7609 Jim_IncrRefCount(obj);
7610 e->stack[e->stacklen++] = obj;
7613 static Jim_Obj *ExprPop(struct JimExprState *e)
7615 return e->stack[--e->stacklen];
7618 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7620 int intresult = 1;
7621 int rc = JIM_OK;
7622 Jim_Obj *A = ExprPop(e);
7623 double dA, dC = 0;
7624 jim_wide wA, wC = 0;
7626 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7627 switch (e->opcode) {
7628 case JIM_EXPROP_FUNC_INT:
7629 case JIM_EXPROP_FUNC_WIDE:
7630 case JIM_EXPROP_FUNC_ROUND:
7631 case JIM_EXPROP_UNARYPLUS:
7632 wC = wA;
7633 break;
7634 case JIM_EXPROP_FUNC_DOUBLE:
7635 dC = wA;
7636 intresult = 0;
7637 break;
7638 case JIM_EXPROP_FUNC_ABS:
7639 wC = wA >= 0 ? wA : -wA;
7640 break;
7641 case JIM_EXPROP_UNARYMINUS:
7642 wC = -wA;
7643 break;
7644 case JIM_EXPROP_NOT:
7645 wC = !wA;
7646 break;
7647 default:
7648 abort();
7651 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7652 switch (e->opcode) {
7653 case JIM_EXPROP_FUNC_INT:
7654 case JIM_EXPROP_FUNC_WIDE:
7655 wC = dA;
7656 break;
7657 case JIM_EXPROP_FUNC_ROUND:
7658 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7659 break;
7660 case JIM_EXPROP_FUNC_DOUBLE:
7661 case JIM_EXPROP_UNARYPLUS:
7662 dC = dA;
7663 intresult = 0;
7664 break;
7665 case JIM_EXPROP_FUNC_ABS:
7666 dC = dA >= 0 ? dA : -dA;
7667 intresult = 0;
7668 break;
7669 case JIM_EXPROP_UNARYMINUS:
7670 dC = -dA;
7671 intresult = 0;
7672 break;
7673 case JIM_EXPROP_NOT:
7674 wC = !dA;
7675 break;
7676 default:
7677 abort();
7681 if (rc == JIM_OK) {
7682 if (intresult) {
7683 ExprPush(e, Jim_NewIntObj(interp, wC));
7685 else {
7686 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7690 Jim_DecrRefCount(interp, A);
7692 return rc;
7695 static double JimRandDouble(Jim_Interp *interp)
7697 unsigned long x;
7698 JimRandomBytes(interp, &x, sizeof(x));
7700 return (double)x / (unsigned long)~0;
7703 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7705 Jim_Obj *A = ExprPop(e);
7706 jim_wide wA;
7708 int rc = Jim_GetWide(interp, A, &wA);
7709 if (rc == JIM_OK) {
7710 switch (e->opcode) {
7711 case JIM_EXPROP_BITNOT:
7712 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7713 break;
7714 case JIM_EXPROP_FUNC_SRAND:
7715 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7716 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7717 break;
7718 default:
7719 abort();
7723 Jim_DecrRefCount(interp, A);
7725 return rc;
7728 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7730 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7732 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7734 return JIM_OK;
7737 #ifdef JIM_MATH_FUNCTIONS
7738 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7740 int rc;
7741 Jim_Obj *A = ExprPop(e);
7742 double dA, dC;
7744 rc = Jim_GetDouble(interp, A, &dA);
7745 if (rc == JIM_OK) {
7746 switch (e->opcode) {
7747 case JIM_EXPROP_FUNC_SIN:
7748 dC = sin(dA);
7749 break;
7750 case JIM_EXPROP_FUNC_COS:
7751 dC = cos(dA);
7752 break;
7753 case JIM_EXPROP_FUNC_TAN:
7754 dC = tan(dA);
7755 break;
7756 case JIM_EXPROP_FUNC_ASIN:
7757 dC = asin(dA);
7758 break;
7759 case JIM_EXPROP_FUNC_ACOS:
7760 dC = acos(dA);
7761 break;
7762 case JIM_EXPROP_FUNC_ATAN:
7763 dC = atan(dA);
7764 break;
7765 case JIM_EXPROP_FUNC_SINH:
7766 dC = sinh(dA);
7767 break;
7768 case JIM_EXPROP_FUNC_COSH:
7769 dC = cosh(dA);
7770 break;
7771 case JIM_EXPROP_FUNC_TANH:
7772 dC = tanh(dA);
7773 break;
7774 case JIM_EXPROP_FUNC_CEIL:
7775 dC = ceil(dA);
7776 break;
7777 case JIM_EXPROP_FUNC_FLOOR:
7778 dC = floor(dA);
7779 break;
7780 case JIM_EXPROP_FUNC_EXP:
7781 dC = exp(dA);
7782 break;
7783 case JIM_EXPROP_FUNC_LOG:
7784 dC = log(dA);
7785 break;
7786 case JIM_EXPROP_FUNC_LOG10:
7787 dC = log10(dA);
7788 break;
7789 case JIM_EXPROP_FUNC_SQRT:
7790 dC = sqrt(dA);
7791 break;
7792 default:
7793 abort();
7795 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7798 Jim_DecrRefCount(interp, A);
7800 return rc;
7802 #endif
7804 /* A binary operation on two ints */
7805 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7807 Jim_Obj *B = ExprPop(e);
7808 Jim_Obj *A = ExprPop(e);
7809 jim_wide wA, wB;
7810 int rc = JIM_ERR;
7812 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7813 jim_wide wC;
7815 rc = JIM_OK;
7817 switch (e->opcode) {
7818 case JIM_EXPROP_LSHIFT:
7819 wC = wA << wB;
7820 break;
7821 case JIM_EXPROP_RSHIFT:
7822 wC = wA >> wB;
7823 break;
7824 case JIM_EXPROP_BITAND:
7825 wC = wA & wB;
7826 break;
7827 case JIM_EXPROP_BITXOR:
7828 wC = wA ^ wB;
7829 break;
7830 case JIM_EXPROP_BITOR:
7831 wC = wA | wB;
7832 break;
7833 case JIM_EXPROP_MOD:
7834 if (wB == 0) {
7835 wC = 0;
7836 Jim_SetResultString(interp, "Division by zero", -1);
7837 rc = JIM_ERR;
7839 else {
7841 * From Tcl 8.x
7843 * This code is tricky: C doesn't guarantee much
7844 * about the quotient or remainder, but Tcl does.
7845 * The remainder always has the same sign as the
7846 * divisor and a smaller absolute value.
7848 int negative = 0;
7850 if (wB < 0) {
7851 wB = -wB;
7852 wA = -wA;
7853 negative = 1;
7855 wC = wA % wB;
7856 if (wC < 0) {
7857 wC += wB;
7859 if (negative) {
7860 wC = -wC;
7863 break;
7864 case JIM_EXPROP_ROTL:
7865 case JIM_EXPROP_ROTR:{
7866 /* uint32_t would be better. But not everyone has inttypes.h? */
7867 unsigned long uA = (unsigned long)wA;
7868 unsigned long uB = (unsigned long)wB;
7869 const unsigned int S = sizeof(unsigned long) * 8;
7871 /* Shift left by the word size or more is undefined. */
7872 uB %= S;
7874 if (e->opcode == JIM_EXPROP_ROTR) {
7875 uB = S - uB;
7877 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7878 break;
7880 default:
7881 abort();
7883 ExprPush(e, Jim_NewIntObj(interp, wC));
7887 Jim_DecrRefCount(interp, A);
7888 Jim_DecrRefCount(interp, B);
7890 return rc;
7894 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7895 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7897 int intresult = 1;
7898 int rc = JIM_OK;
7899 double dA, dB, dC = 0;
7900 jim_wide wA, wB, wC = 0;
7902 Jim_Obj *B = ExprPop(e);
7903 Jim_Obj *A = ExprPop(e);
7905 if ((A->typePtr != &doubleObjType || A->bytes) &&
7906 (B->typePtr != &doubleObjType || B->bytes) &&
7907 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7909 /* Both are ints */
7911 switch (e->opcode) {
7912 case JIM_EXPROP_POW:
7913 case JIM_EXPROP_FUNC_POW:
7914 wC = JimPowWide(wA, wB);
7915 break;
7916 case JIM_EXPROP_ADD:
7917 wC = wA + wB;
7918 break;
7919 case JIM_EXPROP_SUB:
7920 wC = wA - wB;
7921 break;
7922 case JIM_EXPROP_MUL:
7923 wC = wA * wB;
7924 break;
7925 case JIM_EXPROP_DIV:
7926 if (wB == 0) {
7927 Jim_SetResultString(interp, "Division by zero", -1);
7928 rc = JIM_ERR;
7930 else {
7932 * From Tcl 8.x
7934 * This code is tricky: C doesn't guarantee much
7935 * about the quotient or remainder, but Tcl does.
7936 * The remainder always has the same sign as the
7937 * divisor and a smaller absolute value.
7939 if (wB < 0) {
7940 wB = -wB;
7941 wA = -wA;
7943 wC = wA / wB;
7944 if (wA % wB < 0) {
7945 wC--;
7948 break;
7949 case JIM_EXPROP_LT:
7950 wC = wA < wB;
7951 break;
7952 case JIM_EXPROP_GT:
7953 wC = wA > wB;
7954 break;
7955 case JIM_EXPROP_LTE:
7956 wC = wA <= wB;
7957 break;
7958 case JIM_EXPROP_GTE:
7959 wC = wA >= wB;
7960 break;
7961 case JIM_EXPROP_NUMEQ:
7962 wC = wA == wB;
7963 break;
7964 case JIM_EXPROP_NUMNE:
7965 wC = wA != wB;
7966 break;
7967 default:
7968 abort();
7971 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7972 intresult = 0;
7973 switch (e->opcode) {
7974 case JIM_EXPROP_POW:
7975 case JIM_EXPROP_FUNC_POW:
7976 #ifdef JIM_MATH_FUNCTIONS
7977 dC = pow(dA, dB);
7978 #else
7979 Jim_SetResultString(interp, "unsupported", -1);
7980 rc = JIM_ERR;
7981 #endif
7982 break;
7983 case JIM_EXPROP_ADD:
7984 dC = dA + dB;
7985 break;
7986 case JIM_EXPROP_SUB:
7987 dC = dA - dB;
7988 break;
7989 case JIM_EXPROP_MUL:
7990 dC = dA * dB;
7991 break;
7992 case JIM_EXPROP_DIV:
7993 if (dB == 0) {
7994 #ifdef INFINITY
7995 dC = dA < 0 ? -INFINITY : INFINITY;
7996 #else
7997 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7998 #endif
8000 else {
8001 dC = dA / dB;
8003 break;
8004 case JIM_EXPROP_LT:
8005 wC = dA < dB;
8006 intresult = 1;
8007 break;
8008 case JIM_EXPROP_GT:
8009 wC = dA > dB;
8010 intresult = 1;
8011 break;
8012 case JIM_EXPROP_LTE:
8013 wC = dA <= dB;
8014 intresult = 1;
8015 break;
8016 case JIM_EXPROP_GTE:
8017 wC = dA >= dB;
8018 intresult = 1;
8019 break;
8020 case JIM_EXPROP_NUMEQ:
8021 wC = dA == dB;
8022 intresult = 1;
8023 break;
8024 case JIM_EXPROP_NUMNE:
8025 wC = dA != dB;
8026 intresult = 1;
8027 break;
8028 default:
8029 abort();
8032 else {
8033 /* Handle the string case */
8035 /* XXX: Could optimise the eq/ne case by checking lengths */
8036 int i = Jim_StringCompareObj(interp, A, B, 0);
8038 switch (e->opcode) {
8039 case JIM_EXPROP_LT:
8040 wC = i < 0;
8041 break;
8042 case JIM_EXPROP_GT:
8043 wC = i > 0;
8044 break;
8045 case JIM_EXPROP_LTE:
8046 wC = i <= 0;
8047 break;
8048 case JIM_EXPROP_GTE:
8049 wC = i >= 0;
8050 break;
8051 case JIM_EXPROP_NUMEQ:
8052 wC = i == 0;
8053 break;
8054 case JIM_EXPROP_NUMNE:
8055 wC = i != 0;
8056 break;
8057 default:
8058 rc = JIM_ERR;
8059 break;
8063 if (rc == JIM_OK) {
8064 if (intresult) {
8065 ExprPush(e, Jim_NewIntObj(interp, wC));
8067 else {
8068 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8072 Jim_DecrRefCount(interp, A);
8073 Jim_DecrRefCount(interp, B);
8075 return rc;
8078 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8080 int listlen;
8081 int i;
8083 listlen = Jim_ListLength(interp, listObjPtr);
8084 for (i = 0; i < listlen; i++) {
8085 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8086 return 1;
8089 return 0;
8092 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8094 Jim_Obj *B = ExprPop(e);
8095 Jim_Obj *A = ExprPop(e);
8097 jim_wide wC;
8099 switch (e->opcode) {
8100 case JIM_EXPROP_STREQ:
8101 case JIM_EXPROP_STRNE:
8102 wC = Jim_StringEqObj(A, B);
8103 if (e->opcode == JIM_EXPROP_STRNE) {
8104 wC = !wC;
8106 break;
8107 case JIM_EXPROP_STRIN:
8108 wC = JimSearchList(interp, B, A);
8109 break;
8110 case JIM_EXPROP_STRNI:
8111 wC = !JimSearchList(interp, B, A);
8112 break;
8113 default:
8114 abort();
8116 ExprPush(e, Jim_NewIntObj(interp, wC));
8118 Jim_DecrRefCount(interp, A);
8119 Jim_DecrRefCount(interp, B);
8121 return JIM_OK;
8124 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8126 long l;
8127 double d;
8129 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8130 return l != 0;
8132 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8133 return d != 0;
8135 return -1;
8138 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8140 Jim_Obj *skip = ExprPop(e);
8141 Jim_Obj *A = ExprPop(e);
8142 int rc = JIM_OK;
8144 switch (ExprBool(interp, A)) {
8145 case 0:
8146 /* false, so skip RHS opcodes with a 0 result */
8147 e->skip = JimWideValue(skip);
8148 ExprPush(e, Jim_NewIntObj(interp, 0));
8149 break;
8151 case 1:
8152 /* true so continue */
8153 break;
8155 case -1:
8156 /* Invalid */
8157 rc = JIM_ERR;
8159 Jim_DecrRefCount(interp, A);
8160 Jim_DecrRefCount(interp, skip);
8162 return rc;
8165 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8167 Jim_Obj *skip = ExprPop(e);
8168 Jim_Obj *A = ExprPop(e);
8169 int rc = JIM_OK;
8171 switch (ExprBool(interp, A)) {
8172 case 0:
8173 /* false, so do nothing */
8174 break;
8176 case 1:
8177 /* true so skip RHS opcodes with a 1 result */
8178 e->skip = JimWideValue(skip);
8179 ExprPush(e, Jim_NewIntObj(interp, 1));
8180 break;
8182 case -1:
8183 /* Invalid */
8184 rc = JIM_ERR;
8185 break;
8187 Jim_DecrRefCount(interp, A);
8188 Jim_DecrRefCount(interp, skip);
8190 return rc;
8193 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8195 Jim_Obj *A = ExprPop(e);
8196 int rc = JIM_OK;
8198 switch (ExprBool(interp, A)) {
8199 case 0:
8200 ExprPush(e, Jim_NewIntObj(interp, 0));
8201 break;
8203 case 1:
8204 ExprPush(e, Jim_NewIntObj(interp, 1));
8205 break;
8207 case -1:
8208 /* Invalid */
8209 rc = JIM_ERR;
8210 break;
8212 Jim_DecrRefCount(interp, A);
8214 return rc;
8217 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8219 Jim_Obj *skip = ExprPop(e);
8220 Jim_Obj *A = ExprPop(e);
8221 int rc = JIM_OK;
8223 /* Repush A */
8224 ExprPush(e, A);
8226 switch (ExprBool(interp, A)) {
8227 case 0:
8228 /* false, skip RHS opcodes */
8229 e->skip = JimWideValue(skip);
8230 /* Push a dummy value */
8231 ExprPush(e, Jim_NewIntObj(interp, 0));
8232 break;
8234 case 1:
8235 /* true so do nothing */
8236 break;
8238 case -1:
8239 /* Invalid */
8240 rc = JIM_ERR;
8241 break;
8243 Jim_DecrRefCount(interp, A);
8244 Jim_DecrRefCount(interp, skip);
8246 return rc;
8249 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8251 Jim_Obj *skip = ExprPop(e);
8252 Jim_Obj *B = ExprPop(e);
8253 Jim_Obj *A = ExprPop(e);
8255 /* No need to check for A as non-boolean */
8256 if (ExprBool(interp, A)) {
8257 /* true, so skip RHS opcodes */
8258 e->skip = JimWideValue(skip);
8259 /* Repush B as the answer */
8260 ExprPush(e, B);
8263 Jim_DecrRefCount(interp, skip);
8264 Jim_DecrRefCount(interp, A);
8265 Jim_DecrRefCount(interp, B);
8266 return JIM_OK;
8269 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8271 return JIM_OK;
8274 enum
8276 LAZY_NONE,
8277 LAZY_OP,
8278 LAZY_LEFT,
8279 LAZY_RIGHT
8282 /* name - precedence - arity - opcode
8284 * This array *must* be kept in sync with the JIM_EXPROP enum.
8286 * The following macros pre-compute the string length at compile time.
8288 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8289 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8291 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8292 OPRINIT("*", 110, 2, JimExprOpBin),
8293 OPRINIT("/", 110, 2, JimExprOpBin),
8294 OPRINIT("%", 110, 2, JimExprOpIntBin),
8296 OPRINIT("-", 100, 2, JimExprOpBin),
8297 OPRINIT("+", 100, 2, JimExprOpBin),
8299 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8300 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8302 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8303 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8305 OPRINIT("<", 80, 2, JimExprOpBin),
8306 OPRINIT(">", 80, 2, JimExprOpBin),
8307 OPRINIT("<=", 80, 2, JimExprOpBin),
8308 OPRINIT(">=", 80, 2, JimExprOpBin),
8310 OPRINIT("==", 70, 2, JimExprOpBin),
8311 OPRINIT("!=", 70, 2, JimExprOpBin),
8313 OPRINIT("&", 50, 2, JimExprOpIntBin),
8314 OPRINIT("^", 49, 2, JimExprOpIntBin),
8315 OPRINIT("|", 48, 2, JimExprOpIntBin),
8317 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8318 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8319 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8321 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8322 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8323 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8325 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8326 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8327 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8329 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8330 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8331 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8333 OPRINIT("**", 250, 2, JimExprOpBin),
8335 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8336 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8338 OPRINIT("in", 55, 2, JimExprOpStrBin),
8339 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8341 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8342 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8343 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8344 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8348 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8349 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8350 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8351 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8352 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8353 OPRINIT("rand", 200, 0, JimExprOpNone),
8354 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8356 #ifdef JIM_MATH_FUNCTIONS
8357 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8358 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8359 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8360 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8361 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8362 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8363 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8364 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8365 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8366 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8367 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8368 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8369 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8370 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8371 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8372 OPRINIT("pow", 200, 2, JimExprOpBin),
8373 #endif
8375 #undef OPRINIT
8376 #undef OPRINIT_LAZY
8378 #define JIM_EXPR_OPERATORS_NUM \
8379 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8381 static int JimParseExpression(struct JimParserCtx *pc)
8383 /* Discard spaces and quoted newline */
8384 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8385 if (*pc->p == '\n') {
8386 pc->linenr++;
8388 pc->p++;
8389 pc->len--;
8392 /* Common case */
8393 pc->tline = pc->linenr;
8394 pc->tstart = pc->p;
8396 if (pc->len == 0) {
8397 pc->tend = pc->p;
8398 pc->tt = JIM_TT_EOL;
8399 pc->eof = 1;
8400 return JIM_OK;
8402 switch (*(pc->p)) {
8403 case '(':
8404 pc->tt = JIM_TT_SUBEXPR_START;
8405 goto singlechar;
8406 case ')':
8407 pc->tt = JIM_TT_SUBEXPR_END;
8408 goto singlechar;
8409 case ',':
8410 pc->tt = JIM_TT_SUBEXPR_COMMA;
8411 singlechar:
8412 pc->tend = pc->p;
8413 pc->p++;
8414 pc->len--;
8415 break;
8416 case '[':
8417 return JimParseCmd(pc);
8418 case '$':
8419 if (JimParseVar(pc) == JIM_ERR)
8420 return JimParseExprOperator(pc);
8421 else {
8422 /* Don't allow expr sugar in expressions */
8423 if (pc->tt == JIM_TT_EXPRSUGAR) {
8424 return JIM_ERR;
8426 return JIM_OK;
8428 break;
8429 case '0':
8430 case '1':
8431 case '2':
8432 case '3':
8433 case '4':
8434 case '5':
8435 case '6':
8436 case '7':
8437 case '8':
8438 case '9':
8439 case '.':
8440 return JimParseExprNumber(pc);
8441 case '"':
8442 return JimParseQuote(pc);
8443 case '{':
8444 return JimParseBrace(pc);
8446 case 'N':
8447 case 'I':
8448 case 'n':
8449 case 'i':
8450 if (JimParseExprIrrational(pc) == JIM_ERR)
8451 return JimParseExprOperator(pc);
8452 break;
8453 default:
8454 return JimParseExprOperator(pc);
8455 break;
8457 return JIM_OK;
8460 static int JimParseExprNumber(struct JimParserCtx *pc)
8462 char *end;
8464 /* Assume an integer for now */
8465 pc->tt = JIM_TT_EXPR_INT;
8467 jim_strtoull(pc->p, (char **)&pc->p);
8468 /* Tried as an integer, but perhaps it parses as a double */
8469 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8470 /* Some stupid compilers insist they are cleverer that
8471 * we are. Even a (void) cast doesn't prevent this warning!
8473 if (strtod(pc->tstart, &end)) { /* nothing */ }
8474 if (end == pc->tstart)
8475 return JIM_ERR;
8476 if (end > pc->p) {
8477 /* Yes, double captured more chars */
8478 pc->tt = JIM_TT_EXPR_DOUBLE;
8479 pc->p = end;
8482 pc->tend = pc->p - 1;
8483 pc->len -= (pc->p - pc->tstart);
8484 return JIM_OK;
8487 static int JimParseExprIrrational(struct JimParserCtx *pc)
8489 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8490 int i;
8492 for (i = 0; irrationals[i]; i++) {
8493 const char *irr = irrationals[i];
8495 if (strncmp(irr, pc->p, 3) == 0) {
8496 pc->p += 3;
8497 pc->len -= 3;
8498 pc->tend = pc->p - 1;
8499 pc->tt = JIM_TT_EXPR_DOUBLE;
8500 return JIM_OK;
8503 return JIM_ERR;
8506 static int JimParseExprOperator(struct JimParserCtx *pc)
8508 int i;
8509 int bestIdx = -1, bestLen = 0;
8511 /* Try to get the longest match. */
8512 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8513 const char * const opname = Jim_ExprOperators[i].name;
8514 const int oplen = Jim_ExprOperators[i].namelen;
8516 if (opname == NULL || opname[0] != pc->p[0]) {
8517 continue;
8520 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8521 bestIdx = i + JIM_TT_EXPR_OP;
8522 bestLen = oplen;
8525 if (bestIdx == -1) {
8526 return JIM_ERR;
8529 /* Validate paretheses around function arguments */
8530 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8531 const char *p = pc->p + bestLen;
8532 int len = pc->len - bestLen;
8534 while (len && isspace(UCHAR(*p))) {
8535 len--;
8536 p++;
8538 if (*p != '(') {
8539 return JIM_ERR;
8542 pc->tend = pc->p + bestLen - 1;
8543 pc->p += bestLen;
8544 pc->len -= bestLen;
8546 pc->tt = bestIdx;
8547 return JIM_OK;
8550 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8552 static Jim_ExprOperator dummy_op;
8553 if (opcode < JIM_TT_EXPR_OP) {
8554 return &dummy_op;
8556 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8559 const char *jim_tt_name(int type)
8561 static const char * const tt_names[JIM_TT_EXPR_OP] =
8562 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8563 "DBL", "$()" };
8564 if (type < JIM_TT_EXPR_OP) {
8565 return tt_names[type];
8567 else {
8568 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8569 static char buf[20];
8571 if (op->name) {
8572 return op->name;
8574 sprintf(buf, "(%d)", type);
8575 return buf;
8579 /* -----------------------------------------------------------------------------
8580 * Expression Object
8581 * ---------------------------------------------------------------------------*/
8582 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8583 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8584 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8586 static const Jim_ObjType exprObjType = {
8587 "expression",
8588 FreeExprInternalRep,
8589 DupExprInternalRep,
8590 NULL,
8591 JIM_TYPE_REFERENCES,
8594 /* Expr bytecode structure */
8595 typedef struct ExprByteCode
8597 ScriptToken *token; /* Tokens array. */
8598 int len; /* Length as number of tokens. */
8599 int inUse; /* Used for sharing. */
8600 } ExprByteCode;
8602 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8604 int i;
8606 for (i = 0; i < expr->len; i++) {
8607 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8609 Jim_Free(expr->token);
8610 Jim_Free(expr);
8613 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8615 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8617 if (expr) {
8618 if (--expr->inUse != 0) {
8619 return;
8622 ExprFreeByteCode(interp, expr);
8626 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8628 JIM_NOTUSED(interp);
8629 JIM_NOTUSED(srcPtr);
8631 /* Just returns an simple string. */
8632 dupPtr->typePtr = NULL;
8635 /* Check if an expr program looks correct. */
8636 static int ExprCheckCorrectness(ExprByteCode * expr)
8638 int i;
8639 int stacklen = 0;
8640 int ternary = 0;
8642 /* Try to check if there are stack underflows,
8643 * and make sure at the end of the program there is
8644 * a single result on the stack. */
8645 for (i = 0; i < expr->len; i++) {
8646 ScriptToken *t = &expr->token[i];
8647 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8649 stacklen -= op->arity;
8650 if (stacklen < 0) {
8651 break;
8653 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8654 ternary++;
8656 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8657 ternary--;
8660 /* All operations and operands add one to the stack */
8661 stacklen++;
8663 if (stacklen != 1 || ternary != 0) {
8664 return JIM_ERR;
8666 return JIM_OK;
8669 /* This procedure converts every occurrence of || and && opereators
8670 * in lazy unary versions.
8672 * a b || is converted into:
8674 * a <offset> |L b |R
8676 * a b && is converted into:
8678 * a <offset> &L b &R
8680 * "|L" checks if 'a' is true:
8681 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8682 * the opcode just after |R.
8683 * 2) if it is false does nothing.
8684 * "|R" checks if 'b' is true:
8685 * 1) if it is true pushes 1, otherwise pushes 0.
8687 * "&L" checks if 'a' is true:
8688 * 1) if it is true does nothing.
8689 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8690 * the opcode just after &R
8691 * "&R" checks if 'a' is true:
8692 * if it is true pushes 1, otherwise pushes 0.
8694 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8696 int i;
8698 int leftindex, arity, offset;
8700 /* Search for the end of the first operator */
8701 leftindex = expr->len - 1;
8703 arity = 1;
8704 while (arity) {
8705 ScriptToken *tt = &expr->token[leftindex];
8707 if (tt->type >= JIM_TT_EXPR_OP) {
8708 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8710 arity--;
8711 if (--leftindex < 0) {
8712 return JIM_ERR;
8715 leftindex++;
8717 /* Move them up */
8718 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8719 sizeof(*expr->token) * (expr->len - leftindex));
8720 expr->len += 2;
8721 offset = (expr->len - leftindex) - 1;
8723 /* Now we rely on the fact the the left and right version have opcodes
8724 * 1 and 2 after the main opcode respectively
8726 expr->token[leftindex + 1].type = t->type + 1;
8727 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8729 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8730 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8732 /* Now add the 'R' operator */
8733 expr->token[expr->len].objPtr = interp->emptyObj;
8734 expr->token[expr->len].type = t->type + 2;
8735 expr->len++;
8737 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8738 for (i = leftindex - 1; i > 0; i--) {
8739 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8740 if (op->lazy == LAZY_LEFT) {
8741 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8742 JimWideValue(expr->token[i - 1].objPtr) += 2;
8746 return JIM_OK;
8749 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8751 struct ScriptToken *token = &expr->token[expr->len];
8752 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8754 if (op->lazy == LAZY_OP) {
8755 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8756 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8757 return JIM_ERR;
8760 else {
8761 token->objPtr = interp->emptyObj;
8762 token->type = t->type;
8763 expr->len++;
8765 return JIM_OK;
8769 * Returns the index of the COLON_LEFT to the left of 'right_index'
8770 * taking into account nesting.
8772 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8774 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8776 int ternary_count = 1;
8778 right_index--;
8780 while (right_index > 1) {
8781 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8782 ternary_count--;
8784 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8785 ternary_count++;
8787 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8788 return right_index;
8790 right_index--;
8793 /*notreached*/
8794 return -1;
8798 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8800 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8801 * Otherwise returns 0.
8803 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8805 int i = right_index - 1;
8806 int ternary_count = 1;
8808 while (i > 1) {
8809 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8810 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8811 *prev_right_index = i - 2;
8812 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8813 return 1;
8816 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8817 if (ternary_count == 0) {
8818 return 0;
8820 ternary_count++;
8822 i--;
8824 return 0;
8828 * ExprTernaryReorderExpression description
8829 * ========================================
8831 * ?: is right-to-left associative which doesn't work with the stack-based
8832 * expression engine. The fix is to reorder the bytecode.
8834 * The expression:
8836 * expr 1?2:0?3:4
8838 * Has initial bytecode:
8840 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8841 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8843 * The fix involves simulating this expression instead:
8845 * expr 1?2:(0?3:4)
8847 * With the following bytecode:
8849 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8850 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8852 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8853 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8854 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8855 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8857 * ExprTernaryReorderExpression works thus as follows :
8858 * - start from the end of the stack
8859 * - while walking towards the beginning of the stack
8860 * if token=JIM_EXPROP_COLON_RIGHT then
8861 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8862 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8863 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8864 * if all found then
8865 * perform the rotation
8866 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8867 * end if
8868 * end if
8870 * Note: care has to be taken for nested ternary constructs!!!
8872 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8874 int i;
8876 for (i = expr->len - 1; i > 1; i--) {
8877 int prev_right_index;
8878 int prev_left_index;
8879 int j;
8880 ScriptToken tmp;
8882 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8883 continue;
8886 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8887 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8888 continue;
8892 ** rotate tokens down
8894 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8895 ** | | |
8896 ** | V V
8897 ** | [...] : ...
8898 ** | | |
8899 ** | V V
8900 ** | [...] : ...
8901 ** | | |
8902 ** | V V
8903 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8905 tmp = expr->token[prev_right_index];
8906 for (j = prev_right_index; j < i; j++) {
8907 expr->token[j] = expr->token[j + 1];
8909 expr->token[i] = tmp;
8911 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8913 * This is 'colon left increment' = i - prev_right_index
8915 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8916 * [prev_left_index-1] : skip_count
8919 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8921 /* Adjust for i-- in the loop */
8922 i++;
8926 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8928 Jim_Stack stack;
8929 ExprByteCode *expr;
8930 int ok = 1;
8931 int i;
8932 int prevtt = JIM_TT_NONE;
8933 int have_ternary = 0;
8935 /* -1 for EOL */
8936 int count = tokenlist->count - 1;
8938 expr = Jim_Alloc(sizeof(*expr));
8939 expr->inUse = 1;
8940 expr->len = 0;
8942 Jim_InitStack(&stack);
8944 /* Need extra bytecodes for lazy operators.
8945 * Also check for the ternary operator
8947 for (i = 0; i < tokenlist->count; i++) {
8948 ParseToken *t = &tokenlist->list[i];
8949 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8951 if (op->lazy == LAZY_OP) {
8952 count += 2;
8953 /* Ternary is a lazy op but also needs reordering */
8954 if (t->type == JIM_EXPROP_TERNARY) {
8955 have_ternary = 1;
8960 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8962 for (i = 0; i < tokenlist->count && ok; i++) {
8963 ParseToken *t = &tokenlist->list[i];
8965 /* Next token will be stored here */
8966 struct ScriptToken *token = &expr->token[expr->len];
8968 if (t->type == JIM_TT_EOL) {
8969 break;
8972 switch (t->type) {
8973 case JIM_TT_STR:
8974 case JIM_TT_ESC:
8975 case JIM_TT_VAR:
8976 case JIM_TT_DICTSUGAR:
8977 case JIM_TT_EXPRSUGAR:
8978 case JIM_TT_CMD:
8979 token->type = t->type;
8980 strexpr:
8981 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8982 if (t->type == JIM_TT_CMD) {
8983 /* Only commands need source info */
8984 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8986 expr->len++;
8987 break;
8989 case JIM_TT_EXPR_INT:
8990 case JIM_TT_EXPR_DOUBLE:
8992 char *endptr;
8993 if (t->type == JIM_TT_EXPR_INT) {
8994 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8996 else {
8997 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8999 if (endptr != t->token + t->len) {
9000 /* Conversion failed, so just store it as a string */
9001 Jim_FreeNewObj(interp, token->objPtr);
9002 token->type = JIM_TT_STR;
9003 goto strexpr;
9005 token->type = t->type;
9006 expr->len++;
9008 break;
9010 case JIM_TT_SUBEXPR_START:
9011 Jim_StackPush(&stack, t);
9012 prevtt = JIM_TT_NONE;
9013 continue;
9015 case JIM_TT_SUBEXPR_COMMA:
9016 /* Simple approach. Comma is simply ignored */
9017 continue;
9019 case JIM_TT_SUBEXPR_END:
9020 ok = 0;
9021 while (Jim_StackLen(&stack)) {
9022 ParseToken *tt = Jim_StackPop(&stack);
9024 if (tt->type == JIM_TT_SUBEXPR_START) {
9025 ok = 1;
9026 break;
9029 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9030 goto err;
9033 if (!ok) {
9034 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9035 goto err;
9037 break;
9040 default:{
9041 /* Must be an operator */
9042 const struct Jim_ExprOperator *op;
9043 ParseToken *tt;
9045 /* Convert -/+ to unary minus or unary plus if necessary */
9046 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9047 if (t->type == JIM_EXPROP_SUB) {
9048 t->type = JIM_EXPROP_UNARYMINUS;
9050 else if (t->type == JIM_EXPROP_ADD) {
9051 t->type = JIM_EXPROP_UNARYPLUS;
9055 op = JimExprOperatorInfoByOpcode(t->type);
9057 /* Now handle precedence */
9058 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9059 const struct Jim_ExprOperator *tt_op =
9060 JimExprOperatorInfoByOpcode(tt->type);
9062 /* Note that right-to-left associativity of ?: operator is handled later */
9064 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9065 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9066 ok = 0;
9067 goto err;
9069 Jim_StackPop(&stack);
9071 else {
9072 break;
9075 Jim_StackPush(&stack, t);
9076 break;
9079 prevtt = t->type;
9082 /* Reduce any remaining subexpr */
9083 while (Jim_StackLen(&stack)) {
9084 ParseToken *tt = Jim_StackPop(&stack);
9086 if (tt->type == JIM_TT_SUBEXPR_START) {
9087 ok = 0;
9088 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9089 goto err;
9091 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9092 ok = 0;
9093 goto err;
9097 if (have_ternary) {
9098 ExprTernaryReorderExpression(interp, expr);
9101 err:
9102 /* Free the stack used for the compilation. */
9103 Jim_FreeStack(&stack);
9105 for (i = 0; i < expr->len; i++) {
9106 Jim_IncrRefCount(expr->token[i].objPtr);
9109 if (!ok) {
9110 ExprFreeByteCode(interp, expr);
9111 return NULL;
9114 return expr;
9118 /* This method takes the string representation of an expression
9119 * and generates a program for the Expr's stack-based VM. */
9120 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9122 int exprTextLen;
9123 const char *exprText;
9124 struct JimParserCtx parser;
9125 struct ExprByteCode *expr;
9126 ParseTokenList tokenlist;
9127 int line;
9128 Jim_Obj *fileNameObj;
9129 int rc = JIM_ERR;
9131 /* Try to get information about filename / line number */
9132 if (objPtr->typePtr == &sourceObjType) {
9133 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9134 line = objPtr->internalRep.sourceValue.lineNumber;
9136 else {
9137 fileNameObj = interp->emptyObj;
9138 line = 1;
9140 Jim_IncrRefCount(fileNameObj);
9142 exprText = Jim_GetString(objPtr, &exprTextLen);
9144 /* Initially tokenise the expression into tokenlist */
9145 ScriptTokenListInit(&tokenlist);
9147 JimParserInit(&parser, exprText, exprTextLen, line);
9148 while (!parser.eof) {
9149 if (JimParseExpression(&parser) != JIM_OK) {
9150 ScriptTokenListFree(&tokenlist);
9151 invalidexpr:
9152 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9153 expr = NULL;
9154 goto err;
9157 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9158 parser.tline);
9161 #ifdef DEBUG_SHOW_EXPR_TOKENS
9163 int i;
9164 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9165 for (i = 0; i < tokenlist.count; i++) {
9166 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9167 tokenlist.list[i].len, tokenlist.list[i].token);
9170 #endif
9172 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9173 ScriptTokenListFree(&tokenlist);
9174 Jim_DecrRefCount(interp, fileNameObj);
9175 return JIM_ERR;
9178 /* Now create the expression bytecode from the tokenlist */
9179 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9181 /* No longer need the token list */
9182 ScriptTokenListFree(&tokenlist);
9184 if (!expr) {
9185 goto err;
9188 #ifdef DEBUG_SHOW_EXPR
9190 int i;
9192 printf("==== Expr ====\n");
9193 for (i = 0; i < expr->len; i++) {
9194 ScriptToken *t = &expr->token[i];
9196 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9199 #endif
9201 /* Check program correctness. */
9202 if (ExprCheckCorrectness(expr) != JIM_OK) {
9203 ExprFreeByteCode(interp, expr);
9204 goto invalidexpr;
9207 rc = JIM_OK;
9209 err:
9210 /* Free the old internal rep and set the new one. */
9211 Jim_DecrRefCount(interp, fileNameObj);
9212 Jim_FreeIntRep(interp, objPtr);
9213 Jim_SetIntRepPtr(objPtr, expr);
9214 objPtr->typePtr = &exprObjType;
9215 return rc;
9218 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9220 if (objPtr->typePtr != &exprObjType) {
9221 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9222 return NULL;
9225 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9228 #ifdef JIM_OPTIMIZATION
9229 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9231 if (token->type == JIM_TT_EXPR_INT)
9232 return token->objPtr;
9233 else if (token->type == JIM_TT_VAR)
9234 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9235 else if (token->type == JIM_TT_DICTSUGAR)
9236 return JimExpandDictSugar(interp, token->objPtr);
9237 else
9238 return NULL;
9240 #endif
9242 /* -----------------------------------------------------------------------------
9243 * Expressions evaluation.
9244 * Jim uses a specialized stack-based virtual machine for expressions,
9245 * that takes advantage of the fact that expr's operators
9246 * can't be redefined.
9248 * Jim_EvalExpression() uses the bytecode compiled by
9249 * SetExprFromAny() method of the "expression" object.
9251 * On success a Tcl Object containing the result of the evaluation
9252 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9253 * returned.
9254 * On error the function returns a retcode != to JIM_OK and set a suitable
9255 * error on the interp.
9256 * ---------------------------------------------------------------------------*/
9257 #define JIM_EE_STATICSTACK_LEN 10
9259 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9261 ExprByteCode *expr;
9262 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9263 int i;
9264 int retcode = JIM_OK;
9265 struct JimExprState e;
9267 expr = JimGetExpression(interp, exprObjPtr);
9268 if (!expr) {
9269 return JIM_ERR; /* error in expression. */
9272 #ifdef JIM_OPTIMIZATION
9273 /* Check for one of the following common expressions used by while/for
9275 * CONST
9276 * $a
9277 * !$a
9278 * $a < CONST, $a < $b
9279 * $a <= CONST, $a <= $b
9280 * $a > CONST, $a > $b
9281 * $a >= CONST, $a >= $b
9282 * $a != CONST, $a != $b
9283 * $a == CONST, $a == $b
9286 Jim_Obj *objPtr;
9288 /* STEP 1 -- Check if there are the conditions to run the specialized
9289 * version of while */
9291 switch (expr->len) {
9292 case 1:
9293 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9294 if (objPtr) {
9295 Jim_IncrRefCount(objPtr);
9296 *exprResultPtrPtr = objPtr;
9297 return JIM_OK;
9299 break;
9301 case 2:
9302 if (expr->token[1].type == JIM_EXPROP_NOT) {
9303 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9305 if (objPtr && JimIsWide(objPtr)) {
9306 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9307 Jim_IncrRefCount(*exprResultPtrPtr);
9308 return JIM_OK;
9311 break;
9313 case 3:
9314 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9315 if (objPtr && JimIsWide(objPtr)) {
9316 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9317 if (objPtr2 && JimIsWide(objPtr2)) {
9318 jim_wide wideValueA = JimWideValue(objPtr);
9319 jim_wide wideValueB = JimWideValue(objPtr2);
9320 int cmpRes;
9321 switch (expr->token[2].type) {
9322 case JIM_EXPROP_LT:
9323 cmpRes = wideValueA < wideValueB;
9324 break;
9325 case JIM_EXPROP_LTE:
9326 cmpRes = wideValueA <= wideValueB;
9327 break;
9328 case JIM_EXPROP_GT:
9329 cmpRes = wideValueA > wideValueB;
9330 break;
9331 case JIM_EXPROP_GTE:
9332 cmpRes = wideValueA >= wideValueB;
9333 break;
9334 case JIM_EXPROP_NUMEQ:
9335 cmpRes = wideValueA == wideValueB;
9336 break;
9337 case JIM_EXPROP_NUMNE:
9338 cmpRes = wideValueA != wideValueB;
9339 break;
9340 default:
9341 goto noopt;
9343 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9344 Jim_IncrRefCount(*exprResultPtrPtr);
9345 return JIM_OK;
9348 break;
9351 noopt:
9352 #endif
9354 /* In order to avoid that the internal repr gets freed due to
9355 * shimmering of the exprObjPtr's object, we make the internal rep
9356 * shared. */
9357 expr->inUse++;
9359 /* The stack-based expr VM itself */
9361 /* Stack allocation. Expr programs have the feature that
9362 * a program of length N can't require a stack longer than
9363 * N. */
9364 if (expr->len > JIM_EE_STATICSTACK_LEN)
9365 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9366 else
9367 e.stack = staticStack;
9369 e.stacklen = 0;
9371 /* Execute every instruction */
9372 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9373 Jim_Obj *objPtr;
9375 switch (expr->token[i].type) {
9376 case JIM_TT_EXPR_INT:
9377 case JIM_TT_EXPR_DOUBLE:
9378 case JIM_TT_STR:
9379 ExprPush(&e, expr->token[i].objPtr);
9380 break;
9382 case JIM_TT_VAR:
9383 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9384 if (objPtr) {
9385 ExprPush(&e, objPtr);
9387 else {
9388 retcode = JIM_ERR;
9390 break;
9392 case JIM_TT_DICTSUGAR:
9393 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9394 if (objPtr) {
9395 ExprPush(&e, objPtr);
9397 else {
9398 retcode = JIM_ERR;
9400 break;
9402 case JIM_TT_ESC:
9403 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9404 if (retcode == JIM_OK) {
9405 ExprPush(&e, objPtr);
9407 break;
9409 case JIM_TT_CMD:
9410 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9411 if (retcode == JIM_OK) {
9412 ExprPush(&e, Jim_GetResult(interp));
9414 break;
9416 default:{
9417 /* Find and execute the operation */
9418 e.skip = 0;
9419 e.opcode = expr->token[i].type;
9421 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9422 /* Skip some opcodes if necessary */
9423 i += e.skip;
9424 continue;
9429 expr->inUse--;
9431 if (retcode == JIM_OK) {
9432 *exprResultPtrPtr = ExprPop(&e);
9434 else {
9435 for (i = 0; i < e.stacklen; i++) {
9436 Jim_DecrRefCount(interp, e.stack[i]);
9439 if (e.stack != staticStack) {
9440 Jim_Free(e.stack);
9442 return retcode;
9445 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9447 int retcode;
9448 jim_wide wideValue;
9449 double doubleValue;
9450 Jim_Obj *exprResultPtr;
9452 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9453 if (retcode != JIM_OK)
9454 return retcode;
9456 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9457 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9458 Jim_DecrRefCount(interp, exprResultPtr);
9459 return JIM_ERR;
9461 else {
9462 Jim_DecrRefCount(interp, exprResultPtr);
9463 *boolPtr = doubleValue != 0;
9464 return JIM_OK;
9467 *boolPtr = wideValue != 0;
9469 Jim_DecrRefCount(interp, exprResultPtr);
9470 return JIM_OK;
9473 /* -----------------------------------------------------------------------------
9474 * ScanFormat String Object
9475 * ---------------------------------------------------------------------------*/
9477 /* This Jim_Obj will held a parsed representation of a format string passed to
9478 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9479 * to be parsed in its entirely first and then, if correct, can be used for
9480 * scanning. To avoid endless re-parsing, the parsed representation will be
9481 * stored in an internal representation and re-used for performance reason. */
9483 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9484 * scanformat string. This part will later be used to extract information
9485 * out from the string to be parsed by Jim_ScanString */
9487 typedef struct ScanFmtPartDescr
9489 char *arg; /* Specification of a CHARSET conversion */
9490 char *prefix; /* Prefix to be scanned literally before conversion */
9491 size_t width; /* Maximal width of input to be converted */
9492 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9493 char type; /* Type of conversion (e.g. c, d, f) */
9494 char modifier; /* Modify type (e.g. l - long, h - short */
9495 } ScanFmtPartDescr;
9497 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9498 * string parsed and separated in part descriptions. Furthermore it contains
9499 * the original string representation of the scanformat string to allow for
9500 * fast update of the Jim_Obj's string representation part.
9502 * As an add-on the internal object representation adds some scratch pad area
9503 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9504 * memory for purpose of string scanning.
9506 * The error member points to a static allocated string in case of a mal-
9507 * formed scanformat string or it contains '0' (NULL) in case of a valid
9508 * parse representation.
9510 * The whole memory of the internal representation is allocated as a single
9511 * area of memory that will be internally separated. So freeing and duplicating
9512 * of such an object is cheap */
9514 typedef struct ScanFmtStringObj
9516 jim_wide size; /* Size of internal repr in bytes */
9517 char *stringRep; /* Original string representation */
9518 size_t count; /* Number of ScanFmtPartDescr contained */
9519 size_t convCount; /* Number of conversions that will assign */
9520 size_t maxPos; /* Max position index if XPG3 is used */
9521 const char *error; /* Ptr to error text (NULL if no error */
9522 char *scratch; /* Some scratch pad used by Jim_ScanString */
9523 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9524 } ScanFmtStringObj;
9527 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9528 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9529 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9531 static const Jim_ObjType scanFmtStringObjType = {
9532 "scanformatstring",
9533 FreeScanFmtInternalRep,
9534 DupScanFmtInternalRep,
9535 UpdateStringOfScanFmt,
9536 JIM_TYPE_NONE,
9539 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9541 JIM_NOTUSED(interp);
9542 Jim_Free((char *)objPtr->internalRep.ptr);
9543 objPtr->internalRep.ptr = 0;
9546 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9548 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9549 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9551 JIM_NOTUSED(interp);
9552 memcpy(newVec, srcPtr->internalRep.ptr, size);
9553 dupPtr->internalRep.ptr = newVec;
9554 dupPtr->typePtr = &scanFmtStringObjType;
9557 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9559 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9562 /* SetScanFmtFromAny will parse a given string and create the internal
9563 * representation of the format specification. In case of an error
9564 * the error data member of the internal representation will be set
9565 * to an descriptive error text and the function will be left with
9566 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9567 * specification */
9569 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9571 ScanFmtStringObj *fmtObj;
9572 char *buffer;
9573 int maxCount, i, approxSize, lastPos = -1;
9574 const char *fmt = objPtr->bytes;
9575 int maxFmtLen = objPtr->length;
9576 const char *fmtEnd = fmt + maxFmtLen;
9577 int curr;
9579 Jim_FreeIntRep(interp, objPtr);
9580 /* Count how many conversions could take place maximally */
9581 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9582 if (fmt[i] == '%')
9583 ++maxCount;
9584 /* Calculate an approximation of the memory necessary */
9585 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9586 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9587 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9588 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9589 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9590 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9591 +1; /* safety byte */
9592 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9593 memset(fmtObj, 0, approxSize);
9594 fmtObj->size = approxSize;
9595 fmtObj->maxPos = 0;
9596 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9597 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9598 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9599 buffer = fmtObj->stringRep + maxFmtLen + 1;
9600 objPtr->internalRep.ptr = fmtObj;
9601 objPtr->typePtr = &scanFmtStringObjType;
9602 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9603 int width = 0, skip;
9604 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9606 fmtObj->count++;
9607 descr->width = 0; /* Assume width unspecified */
9608 /* Overread and store any "literal" prefix */
9609 if (*fmt != '%' || fmt[1] == '%') {
9610 descr->type = 0;
9611 descr->prefix = &buffer[i];
9612 for (; fmt < fmtEnd; ++fmt) {
9613 if (*fmt == '%') {
9614 if (fmt[1] != '%')
9615 break;
9616 ++fmt;
9618 buffer[i++] = *fmt;
9620 buffer[i++] = 0;
9622 /* Skip the conversion introducing '%' sign */
9623 ++fmt;
9624 /* End reached due to non-conversion literal only? */
9625 if (fmt >= fmtEnd)
9626 goto done;
9627 descr->pos = 0; /* Assume "natural" positioning */
9628 if (*fmt == '*') {
9629 descr->pos = -1; /* Okay, conversion will not be assigned */
9630 ++fmt;
9632 else
9633 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9634 /* Check if next token is a number (could be width or pos */
9635 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9636 fmt += skip;
9637 /* Was the number a XPG3 position specifier? */
9638 if (descr->pos != -1 && *fmt == '$') {
9639 int prev;
9641 ++fmt;
9642 descr->pos = width;
9643 width = 0;
9644 /* Look if "natural" postioning and XPG3 one was mixed */
9645 if ((lastPos == 0 && descr->pos > 0)
9646 || (lastPos > 0 && descr->pos == 0)) {
9647 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9648 return JIM_ERR;
9650 /* Look if this position was already used */
9651 for (prev = 0; prev < curr; ++prev) {
9652 if (fmtObj->descr[prev].pos == -1)
9653 continue;
9654 if (fmtObj->descr[prev].pos == descr->pos) {
9655 fmtObj->error =
9656 "variable is assigned by multiple \"%n$\" conversion specifiers";
9657 return JIM_ERR;
9660 /* Try to find a width after the XPG3 specifier */
9661 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9662 descr->width = width;
9663 fmt += skip;
9665 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9666 fmtObj->maxPos = descr->pos;
9668 else {
9669 /* Number was not a XPG3, so it has to be a width */
9670 descr->width = width;
9673 /* If positioning mode was undetermined yet, fix this */
9674 if (lastPos == -1)
9675 lastPos = descr->pos;
9676 /* Handle CHARSET conversion type ... */
9677 if (*fmt == '[') {
9678 int swapped = 1, beg = i, end, j;
9680 descr->type = '[';
9681 descr->arg = &buffer[i];
9682 ++fmt;
9683 if (*fmt == '^')
9684 buffer[i++] = *fmt++;
9685 if (*fmt == ']')
9686 buffer[i++] = *fmt++;
9687 while (*fmt && *fmt != ']')
9688 buffer[i++] = *fmt++;
9689 if (*fmt != ']') {
9690 fmtObj->error = "unmatched [ in format string";
9691 return JIM_ERR;
9693 end = i;
9694 buffer[i++] = 0;
9695 /* In case a range fence was given "backwards", swap it */
9696 while (swapped) {
9697 swapped = 0;
9698 for (j = beg + 1; j < end - 1; ++j) {
9699 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9700 char tmp = buffer[j - 1];
9702 buffer[j - 1] = buffer[j + 1];
9703 buffer[j + 1] = tmp;
9704 swapped = 1;
9709 else {
9710 /* Remember any valid modifier if given */
9711 if (strchr("hlL", *fmt) != 0)
9712 descr->modifier = tolower((int)*fmt++);
9714 descr->type = *fmt;
9715 if (strchr("efgcsndoxui", *fmt) == 0) {
9716 fmtObj->error = "bad scan conversion character";
9717 return JIM_ERR;
9719 else if (*fmt == 'c' && descr->width != 0) {
9720 fmtObj->error = "field width may not be specified in %c " "conversion";
9721 return JIM_ERR;
9723 else if (*fmt == 'u' && descr->modifier == 'l') {
9724 fmtObj->error = "unsigned wide not supported";
9725 return JIM_ERR;
9728 curr++;
9730 done:
9731 return JIM_OK;
9734 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9736 #define FormatGetCnvCount(_fo_) \
9737 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9738 #define FormatGetMaxPos(_fo_) \
9739 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9740 #define FormatGetError(_fo_) \
9741 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9743 /* JimScanAString is used to scan an unspecified string that ends with
9744 * next WS, or a string that is specified via a charset.
9747 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9749 char *buffer = Jim_StrDup(str);
9750 char *p = buffer;
9752 while (*str) {
9753 int c;
9754 int n;
9756 if (!sdescr && isspace(UCHAR(*str)))
9757 break; /* EOS via WS if unspecified */
9759 n = utf8_tounicode(str, &c);
9760 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9761 break;
9762 while (n--)
9763 *p++ = *str++;
9765 *p = 0;
9766 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9769 /* ScanOneEntry will scan one entry out of the string passed as argument.
9770 * It use the sscanf() function for this task. After extracting and
9771 * converting of the value, the count of scanned characters will be
9772 * returned of -1 in case of no conversion tool place and string was
9773 * already scanned thru */
9775 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9776 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9778 const char *tok;
9779 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9780 size_t scanned = 0;
9781 size_t anchor = pos;
9782 int i;
9783 Jim_Obj *tmpObj = NULL;
9785 /* First pessimistically assume, we will not scan anything :-) */
9786 *valObjPtr = 0;
9787 if (descr->prefix) {
9788 /* There was a prefix given before the conversion, skip it and adjust
9789 * the string-to-be-parsed accordingly */
9790 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9791 /* If prefix require, skip WS */
9792 if (isspace(UCHAR(descr->prefix[i])))
9793 while (pos < strLen && isspace(UCHAR(str[pos])))
9794 ++pos;
9795 else if (descr->prefix[i] != str[pos])
9796 break; /* Prefix do not match here, leave the loop */
9797 else
9798 ++pos; /* Prefix matched so far, next round */
9800 if (pos >= strLen) {
9801 return -1; /* All of str consumed: EOF condition */
9803 else if (descr->prefix[i] != 0)
9804 return 0; /* Not whole prefix consumed, no conversion possible */
9806 /* For all but following conversion, skip leading WS */
9807 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9808 while (isspace(UCHAR(str[pos])))
9809 ++pos;
9810 /* Determine how much skipped/scanned so far */
9811 scanned = pos - anchor;
9813 /* %c is a special, simple case. no width */
9814 if (descr->type == 'n') {
9815 /* Return pseudo conversion means: how much scanned so far? */
9816 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9818 else if (pos >= strLen) {
9819 /* Cannot scan anything, as str is totally consumed */
9820 return -1;
9822 else if (descr->type == 'c') {
9823 int c;
9824 scanned += utf8_tounicode(&str[pos], &c);
9825 *valObjPtr = Jim_NewIntObj(interp, c);
9826 return scanned;
9828 else {
9829 /* Processing of conversions follows ... */
9830 if (descr->width > 0) {
9831 /* Do not try to scan as fas as possible but only the given width.
9832 * To ensure this, we copy the part that should be scanned. */
9833 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9834 size_t tLen = descr->width > sLen ? sLen : descr->width;
9836 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9837 tok = tmpObj->bytes;
9839 else {
9840 /* As no width was given, simply refer to the original string */
9841 tok = &str[pos];
9843 switch (descr->type) {
9844 case 'd':
9845 case 'o':
9846 case 'x':
9847 case 'u':
9848 case 'i':{
9849 char *endp; /* Position where the number finished */
9850 jim_wide w;
9852 int base = descr->type == 'o' ? 8
9853 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9855 /* Try to scan a number with the given base */
9856 if (base == 0) {
9857 w = jim_strtoull(tok, &endp);
9859 else {
9860 w = strtoull(tok, &endp, base);
9863 if (endp != tok) {
9864 /* There was some number sucessfully scanned! */
9865 *valObjPtr = Jim_NewIntObj(interp, w);
9867 /* Adjust the number-of-chars scanned so far */
9868 scanned += endp - tok;
9870 else {
9871 /* Nothing was scanned. We have to determine if this
9872 * happened due to e.g. prefix mismatch or input str
9873 * exhausted */
9874 scanned = *tok ? 0 : -1;
9876 break;
9878 case 's':
9879 case '[':{
9880 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9881 scanned += Jim_Length(*valObjPtr);
9882 break;
9884 case 'e':
9885 case 'f':
9886 case 'g':{
9887 char *endp;
9888 double value = strtod(tok, &endp);
9890 if (endp != tok) {
9891 /* There was some number sucessfully scanned! */
9892 *valObjPtr = Jim_NewDoubleObj(interp, value);
9893 /* Adjust the number-of-chars scanned so far */
9894 scanned += endp - tok;
9896 else {
9897 /* Nothing was scanned. We have to determine if this
9898 * happened due to e.g. prefix mismatch or input str
9899 * exhausted */
9900 scanned = *tok ? 0 : -1;
9902 break;
9905 /* If a substring was allocated (due to pre-defined width) do not
9906 * forget to free it */
9907 if (tmpObj) {
9908 Jim_FreeNewObj(interp, tmpObj);
9911 return scanned;
9914 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9915 * string and returns all converted (and not ignored) values in a list back
9916 * to the caller. If an error occured, a NULL pointer will be returned */
9918 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9920 size_t i, pos;
9921 int scanned = 1;
9922 const char *str = Jim_String(strObjPtr);
9923 int strLen = Jim_Utf8Length(interp, strObjPtr);
9924 Jim_Obj *resultList = 0;
9925 Jim_Obj **resultVec = 0;
9926 int resultc;
9927 Jim_Obj *emptyStr = 0;
9928 ScanFmtStringObj *fmtObj;
9930 /* This should never happen. The format object should already be of the correct type */
9931 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9933 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9934 /* Check if format specification was valid */
9935 if (fmtObj->error != 0) {
9936 if (flags & JIM_ERRMSG)
9937 Jim_SetResultString(interp, fmtObj->error, -1);
9938 return 0;
9940 /* Allocate a new "shared" empty string for all unassigned conversions */
9941 emptyStr = Jim_NewEmptyStringObj(interp);
9942 Jim_IncrRefCount(emptyStr);
9943 /* Create a list and fill it with empty strings up to max specified XPG3 */
9944 resultList = Jim_NewListObj(interp, NULL, 0);
9945 if (fmtObj->maxPos > 0) {
9946 for (i = 0; i < fmtObj->maxPos; ++i)
9947 Jim_ListAppendElement(interp, resultList, emptyStr);
9948 JimListGetElements(interp, resultList, &resultc, &resultVec);
9950 /* Now handle every partial format description */
9951 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9952 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9953 Jim_Obj *value = 0;
9955 /* Only last type may be "literal" w/o conversion - skip it! */
9956 if (descr->type == 0)
9957 continue;
9958 /* As long as any conversion could be done, we will proceed */
9959 if (scanned > 0)
9960 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9961 /* In case our first try results in EOF, we will leave */
9962 if (scanned == -1 && i == 0)
9963 goto eof;
9964 /* Advance next pos-to-be-scanned for the amount scanned already */
9965 pos += scanned;
9967 /* value == 0 means no conversion took place so take empty string */
9968 if (value == 0)
9969 value = Jim_NewEmptyStringObj(interp);
9970 /* If value is a non-assignable one, skip it */
9971 if (descr->pos == -1) {
9972 Jim_FreeNewObj(interp, value);
9974 else if (descr->pos == 0)
9975 /* Otherwise append it to the result list if no XPG3 was given */
9976 Jim_ListAppendElement(interp, resultList, value);
9977 else if (resultVec[descr->pos - 1] == emptyStr) {
9978 /* But due to given XPG3, put the value into the corr. slot */
9979 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9980 Jim_IncrRefCount(value);
9981 resultVec[descr->pos - 1] = value;
9983 else {
9984 /* Otherwise, the slot was already used - free obj and ERROR */
9985 Jim_FreeNewObj(interp, value);
9986 goto err;
9989 Jim_DecrRefCount(interp, emptyStr);
9990 return resultList;
9991 eof:
9992 Jim_DecrRefCount(interp, emptyStr);
9993 Jim_FreeNewObj(interp, resultList);
9994 return (Jim_Obj *)EOF;
9995 err:
9996 Jim_DecrRefCount(interp, emptyStr);
9997 Jim_FreeNewObj(interp, resultList);
9998 return 0;
10001 /* -----------------------------------------------------------------------------
10002 * Pseudo Random Number Generation
10003 * ---------------------------------------------------------------------------*/
10004 /* Initialize the sbox with the numbers from 0 to 255 */
10005 static void JimPrngInit(Jim_Interp *interp)
10007 #define PRNG_SEED_SIZE 256
10008 int i;
10009 unsigned int *seed;
10010 time_t t = time(NULL);
10012 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10014 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10015 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10016 seed[i] = (rand() ^ t ^ clock());
10018 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10019 Jim_Free(seed);
10022 /* Generates N bytes of random data */
10023 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10025 Jim_PrngState *prng;
10026 unsigned char *destByte = (unsigned char *)dest;
10027 unsigned int si, sj, x;
10029 /* initialization, only needed the first time */
10030 if (interp->prngState == NULL)
10031 JimPrngInit(interp);
10032 prng = interp->prngState;
10033 /* generates 'len' bytes of pseudo-random numbers */
10034 for (x = 0; x < len; x++) {
10035 prng->i = (prng->i + 1) & 0xff;
10036 si = prng->sbox[prng->i];
10037 prng->j = (prng->j + si) & 0xff;
10038 sj = prng->sbox[prng->j];
10039 prng->sbox[prng->i] = sj;
10040 prng->sbox[prng->j] = si;
10041 *destByte++ = prng->sbox[(si + sj) & 0xff];
10045 /* Re-seed the generator with user-provided bytes */
10046 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10048 int i;
10049 Jim_PrngState *prng;
10051 /* initialization, only needed the first time */
10052 if (interp->prngState == NULL)
10053 JimPrngInit(interp);
10054 prng = interp->prngState;
10056 /* Set the sbox[i] with i */
10057 for (i = 0; i < 256; i++)
10058 prng->sbox[i] = i;
10059 /* Now use the seed to perform a random permutation of the sbox */
10060 for (i = 0; i < seedLen; i++) {
10061 unsigned char t;
10063 t = prng->sbox[i & 0xFF];
10064 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10065 prng->sbox[seed[i]] = t;
10067 prng->i = prng->j = 0;
10069 /* discard at least the first 256 bytes of stream.
10070 * borrow the seed buffer for this
10072 for (i = 0; i < 256; i += seedLen) {
10073 JimRandomBytes(interp, seed, seedLen);
10077 /* [incr] */
10078 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10080 jim_wide wideValue, increment = 1;
10081 Jim_Obj *intObjPtr;
10083 if (argc != 2 && argc != 3) {
10084 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10085 return JIM_ERR;
10087 if (argc == 3) {
10088 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10089 return JIM_ERR;
10091 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10092 if (!intObjPtr) {
10093 /* Set missing variable to 0 */
10094 wideValue = 0;
10096 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10097 return JIM_ERR;
10099 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10100 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10101 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10102 Jim_FreeNewObj(interp, intObjPtr);
10103 return JIM_ERR;
10106 else {
10107 /* Can do it the quick way */
10108 Jim_InvalidateStringRep(intObjPtr);
10109 JimWideValue(intObjPtr) = wideValue + increment;
10111 /* The following step is required in order to invalidate the
10112 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10113 if (argv[1]->typePtr != &variableObjType) {
10114 /* Note that this can't fail since GetVariable already succeeded */
10115 Jim_SetVariable(interp, argv[1], intObjPtr);
10118 Jim_SetResult(interp, intObjPtr);
10119 return JIM_OK;
10123 /* -----------------------------------------------------------------------------
10124 * Eval
10125 * ---------------------------------------------------------------------------*/
10126 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10127 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10129 /* Handle calls to the [unknown] command */
10130 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10132 int retcode;
10134 /* If JimUnknown() is recursively called too many times...
10135 * done here
10137 if (interp->unknown_called > 50) {
10138 return JIM_ERR;
10141 /* The object interp->unknown just contains
10142 * the "unknown" string, it is used in order to
10143 * avoid to lookup the unknown command every time
10144 * but instead to cache the result. */
10146 /* If the [unknown] command does not exist ... */
10147 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10148 return JIM_ERR;
10150 interp->unknown_called++;
10151 /* XXX: Are we losing fileNameObj and linenr? */
10152 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10153 interp->unknown_called--;
10155 return retcode;
10158 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10160 int retcode;
10161 Jim_Cmd *cmdPtr;
10163 #if 0
10164 printf("invoke");
10165 int j;
10166 for (j = 0; j < objc; j++) {
10167 printf(" '%s'", Jim_String(objv[j]));
10169 printf("\n");
10170 #endif
10172 if (interp->framePtr->tailcallCmd) {
10173 /* Special tailcall command was pre-resolved */
10174 cmdPtr = interp->framePtr->tailcallCmd;
10175 interp->framePtr->tailcallCmd = NULL;
10177 else {
10178 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10179 if (cmdPtr == NULL) {
10180 return JimUnknown(interp, objc, objv);
10182 JimIncrCmdRefCount(cmdPtr);
10185 if (interp->evalDepth == interp->maxEvalDepth) {
10186 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10187 retcode = JIM_ERR;
10188 goto out;
10190 interp->evalDepth++;
10192 /* Call it -- Make sure result is an empty object. */
10193 Jim_SetEmptyResult(interp);
10194 if (cmdPtr->isproc) {
10195 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10197 else {
10198 interp->cmdPrivData = cmdPtr->u.native.privData;
10199 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10201 interp->evalDepth--;
10203 out:
10204 JimDecrCmdRefCount(interp, cmdPtr);
10206 return retcode;
10209 /* Eval the object vector 'objv' composed of 'objc' elements.
10210 * Every element is used as single argument.
10211 * Jim_EvalObj() will call this function every time its object
10212 * argument is of "list" type, with no string representation.
10214 * This is possible because the string representation of a
10215 * list object generated by the UpdateStringOfList is made
10216 * in a way that ensures that every list element is a different
10217 * command argument. */
10218 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10220 int i, retcode;
10222 /* Incr refcount of arguments. */
10223 for (i = 0; i < objc; i++)
10224 Jim_IncrRefCount(objv[i]);
10226 retcode = JimInvokeCommand(interp, objc, objv);
10228 /* Decr refcount of arguments and return the retcode */
10229 for (i = 0; i < objc; i++)
10230 Jim_DecrRefCount(interp, objv[i]);
10232 return retcode;
10236 * Invokes 'prefix' as a command with the objv array as arguments.
10238 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10240 int ret;
10241 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10243 nargv[0] = prefix;
10244 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10245 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10246 Jim_Free(nargv);
10247 return ret;
10250 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10252 if (!interp->errorFlag) {
10253 /* This is the first error, so save the file/line information and reset the stack */
10254 interp->errorFlag = 1;
10255 Jim_IncrRefCount(script->fileNameObj);
10256 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10257 interp->errorFileNameObj = script->fileNameObj;
10258 interp->errorLine = script->linenr;
10260 JimResetStackTrace(interp);
10261 /* Always add a level where the error first occurs */
10262 interp->addStackTrace++;
10265 /* Now if this is an "interesting" level, add it to the stack trace */
10266 if (interp->addStackTrace > 0) {
10267 /* Add the stack info for the current level */
10269 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10271 /* Note: if we didn't have a filename for this level,
10272 * don't clear the addStackTrace flag
10273 * so we can pick it up at the next level
10275 if (Jim_Length(script->fileNameObj)) {
10276 interp->addStackTrace = 0;
10279 Jim_DecrRefCount(interp, interp->errorProc);
10280 interp->errorProc = interp->emptyObj;
10281 Jim_IncrRefCount(interp->errorProc);
10285 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10287 Jim_Obj *objPtr;
10289 switch (token->type) {
10290 case JIM_TT_STR:
10291 case JIM_TT_ESC:
10292 objPtr = token->objPtr;
10293 break;
10294 case JIM_TT_VAR:
10295 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10296 break;
10297 case JIM_TT_DICTSUGAR:
10298 objPtr = JimExpandDictSugar(interp, token->objPtr);
10299 break;
10300 case JIM_TT_EXPRSUGAR:
10301 objPtr = JimExpandExprSugar(interp, token->objPtr);
10302 break;
10303 case JIM_TT_CMD:
10304 switch (Jim_EvalObj(interp, token->objPtr)) {
10305 case JIM_OK:
10306 case JIM_RETURN:
10307 objPtr = interp->result;
10308 break;
10309 case JIM_BREAK:
10310 /* Stop substituting */
10311 return JIM_BREAK;
10312 case JIM_CONTINUE:
10313 /* just skip this one */
10314 return JIM_CONTINUE;
10315 default:
10316 return JIM_ERR;
10318 break;
10319 default:
10320 JimPanic((1,
10321 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10322 objPtr = NULL;
10323 break;
10325 if (objPtr) {
10326 *objPtrPtr = objPtr;
10327 return JIM_OK;
10329 return JIM_ERR;
10332 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10333 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10334 * The returned object has refcount = 0.
10336 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10338 int totlen = 0, i;
10339 Jim_Obj **intv;
10340 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10341 Jim_Obj *objPtr;
10342 char *s;
10344 if (tokens <= JIM_EVAL_SINTV_LEN)
10345 intv = sintv;
10346 else
10347 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10349 /* Compute every token forming the argument
10350 * in the intv objects vector. */
10351 for (i = 0; i < tokens; i++) {
10352 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10353 case JIM_OK:
10354 case JIM_RETURN:
10355 break;
10356 case JIM_BREAK:
10357 if (flags & JIM_SUBST_FLAG) {
10358 /* Stop here */
10359 tokens = i;
10360 continue;
10362 /* XXX: Should probably set an error about break outside loop */
10363 /* fall through to error */
10364 case JIM_CONTINUE:
10365 if (flags & JIM_SUBST_FLAG) {
10366 intv[i] = NULL;
10367 continue;
10369 /* XXX: Ditto continue outside loop */
10370 /* fall through to error */
10371 default:
10372 while (i--) {
10373 Jim_DecrRefCount(interp, intv[i]);
10375 if (intv != sintv) {
10376 Jim_Free(intv);
10378 return NULL;
10380 Jim_IncrRefCount(intv[i]);
10381 Jim_String(intv[i]);
10382 totlen += intv[i]->length;
10385 /* Fast path return for a single token */
10386 if (tokens == 1 && intv[0] && intv == sintv) {
10387 Jim_DecrRefCount(interp, intv[0]);
10388 return intv[0];
10391 /* Concatenate every token in an unique
10392 * object. */
10393 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10395 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10396 && token[2].type == JIM_TT_VAR) {
10397 /* May be able to do fast interpolated object -> dictSubst */
10398 objPtr->typePtr = &interpolatedObjType;
10399 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10400 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10401 Jim_IncrRefCount(intv[2]);
10403 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10404 /* The first interpolated token is source, so preserve the source info */
10405 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10409 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10410 objPtr->length = totlen;
10411 for (i = 0; i < tokens; i++) {
10412 if (intv[i]) {
10413 memcpy(s, intv[i]->bytes, intv[i]->length);
10414 s += intv[i]->length;
10415 Jim_DecrRefCount(interp, intv[i]);
10418 objPtr->bytes[totlen] = '\0';
10419 /* Free the intv vector if not static. */
10420 if (intv != sintv) {
10421 Jim_Free(intv);
10424 return objPtr;
10428 /* listPtr *must* be a list.
10429 * The contents of the list is evaluated with the first element as the command and
10430 * the remaining elements as the arguments.
10432 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10434 int retcode = JIM_OK;
10436 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10438 if (listPtr->internalRep.listValue.len) {
10439 Jim_IncrRefCount(listPtr);
10440 retcode = JimInvokeCommand(interp,
10441 listPtr->internalRep.listValue.len,
10442 listPtr->internalRep.listValue.ele);
10443 Jim_DecrRefCount(interp, listPtr);
10445 return retcode;
10448 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10450 SetListFromAny(interp, listPtr);
10451 return JimEvalObjList(interp, listPtr);
10454 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10456 int i;
10457 ScriptObj *script;
10458 ScriptToken *token;
10459 int retcode = JIM_OK;
10460 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10461 Jim_Obj *prevScriptObj;
10463 /* If the object is of type "list", with no string rep we can call
10464 * a specialized version of Jim_EvalObj() */
10465 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10466 return JimEvalObjList(interp, scriptObjPtr);
10469 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10470 script = JimGetScript(interp, scriptObjPtr);
10471 if (!JimScriptValid(interp, script)) {
10472 Jim_DecrRefCount(interp, scriptObjPtr);
10473 return JIM_ERR;
10476 /* Reset the interpreter result. This is useful to
10477 * return the empty result in the case of empty program. */
10478 Jim_SetEmptyResult(interp);
10480 token = script->token;
10482 #ifdef JIM_OPTIMIZATION
10483 /* Check for one of the following common scripts used by for, while
10485 * {}
10486 * incr a
10488 if (script->len == 0) {
10489 Jim_DecrRefCount(interp, scriptObjPtr);
10490 return JIM_OK;
10492 if (script->len == 3
10493 && token[1].objPtr->typePtr == &commandObjType
10494 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10495 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10496 && token[2].objPtr->typePtr == &variableObjType) {
10498 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10500 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10501 JimWideValue(objPtr)++;
10502 Jim_InvalidateStringRep(objPtr);
10503 Jim_DecrRefCount(interp, scriptObjPtr);
10504 Jim_SetResult(interp, objPtr);
10505 return JIM_OK;
10508 #endif
10510 /* Now we have to make sure the internal repr will not be
10511 * freed on shimmering.
10513 * Think for example to this:
10515 * set x {llength $x; ... some more code ...}; eval $x
10517 * In order to preserve the internal rep, we increment the
10518 * inUse field of the script internal rep structure. */
10519 script->inUse++;
10521 /* Stash the current script */
10522 prevScriptObj = interp->currentScriptObj;
10523 interp->currentScriptObj = scriptObjPtr;
10525 interp->errorFlag = 0;
10526 argv = sargv;
10528 /* Execute every command sequentially until the end of the script
10529 * or an error occurs.
10531 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10532 int argc;
10533 int j;
10535 /* First token of the line is always JIM_TT_LINE */
10536 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10537 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10539 /* Allocate the arguments vector if required */
10540 if (argc > JIM_EVAL_SARGV_LEN)
10541 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10543 /* Skip the JIM_TT_LINE token */
10544 i++;
10546 /* Populate the arguments objects.
10547 * If an error occurs, retcode will be set and
10548 * 'j' will be set to the number of args expanded
10550 for (j = 0; j < argc; j++) {
10551 long wordtokens = 1;
10552 int expand = 0;
10553 Jim_Obj *wordObjPtr = NULL;
10555 if (token[i].type == JIM_TT_WORD) {
10556 wordtokens = JimWideValue(token[i++].objPtr);
10557 if (wordtokens < 0) {
10558 expand = 1;
10559 wordtokens = -wordtokens;
10563 if (wordtokens == 1) {
10564 /* Fast path if the token does not
10565 * need interpolation */
10567 switch (token[i].type) {
10568 case JIM_TT_ESC:
10569 case JIM_TT_STR:
10570 wordObjPtr = token[i].objPtr;
10571 break;
10572 case JIM_TT_VAR:
10573 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10574 break;
10575 case JIM_TT_EXPRSUGAR:
10576 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10577 break;
10578 case JIM_TT_DICTSUGAR:
10579 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10580 break;
10581 case JIM_TT_CMD:
10582 retcode = Jim_EvalObj(interp, token[i].objPtr);
10583 if (retcode == JIM_OK) {
10584 wordObjPtr = Jim_GetResult(interp);
10586 break;
10587 default:
10588 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10591 else {
10592 /* For interpolation we call a helper
10593 * function to do the work for us. */
10594 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10597 if (!wordObjPtr) {
10598 if (retcode == JIM_OK) {
10599 retcode = JIM_ERR;
10601 break;
10604 Jim_IncrRefCount(wordObjPtr);
10605 i += wordtokens;
10607 if (!expand) {
10608 argv[j] = wordObjPtr;
10610 else {
10611 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10612 int len = Jim_ListLength(interp, wordObjPtr);
10613 int newargc = argc + len - 1;
10614 int k;
10616 if (len > 1) {
10617 if (argv == sargv) {
10618 if (newargc > JIM_EVAL_SARGV_LEN) {
10619 argv = Jim_Alloc(sizeof(*argv) * newargc);
10620 memcpy(argv, sargv, sizeof(*argv) * j);
10623 else {
10624 /* Need to realloc to make room for (len - 1) more entries */
10625 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10629 /* Now copy in the expanded version */
10630 for (k = 0; k < len; k++) {
10631 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10632 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10635 /* The original object reference is no longer needed,
10636 * after the expansion it is no longer present on
10637 * the argument vector, but the single elements are
10638 * in its place. */
10639 Jim_DecrRefCount(interp, wordObjPtr);
10641 /* And update the indexes */
10642 j--;
10643 argc += len - 1;
10647 if (retcode == JIM_OK && argc) {
10648 /* Invoke the command */
10649 retcode = JimInvokeCommand(interp, argc, argv);
10650 /* Check for a signal after each command */
10651 if (Jim_CheckSignal(interp)) {
10652 retcode = JIM_SIGNAL;
10656 /* Finished with the command, so decrement ref counts of each argument */
10657 while (j-- > 0) {
10658 Jim_DecrRefCount(interp, argv[j]);
10661 if (argv != sargv) {
10662 Jim_Free(argv);
10663 argv = sargv;
10667 /* Possibly add to the error stack trace */
10668 if (retcode == JIM_ERR) {
10669 JimAddErrorToStack(interp, script);
10671 /* Propagate the addStackTrace value through 'return -code error' */
10672 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10673 /* No need to add stack trace */
10674 interp->addStackTrace = 0;
10677 /* Restore the current script */
10678 interp->currentScriptObj = prevScriptObj;
10680 /* Note that we don't have to decrement inUse, because the
10681 * following code transfers our use of the reference again to
10682 * the script object. */
10683 Jim_FreeIntRep(interp, scriptObjPtr);
10684 scriptObjPtr->typePtr = &scriptObjType;
10685 Jim_SetIntRepPtr(scriptObjPtr, script);
10686 Jim_DecrRefCount(interp, scriptObjPtr);
10688 return retcode;
10691 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10693 int retcode;
10694 /* If argObjPtr begins with '&', do an automatic upvar */
10695 const char *varname = Jim_String(argNameObj);
10696 if (*varname == '&') {
10697 /* First check that the target variable exists */
10698 Jim_Obj *objPtr;
10699 Jim_CallFrame *savedCallFrame = interp->framePtr;
10701 interp->framePtr = interp->framePtr->parent;
10702 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10703 interp->framePtr = savedCallFrame;
10704 if (!objPtr) {
10705 return JIM_ERR;
10708 /* It exists, so perform the binding. */
10709 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10710 Jim_IncrRefCount(objPtr);
10711 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10712 Jim_DecrRefCount(interp, objPtr);
10714 else {
10715 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10717 return retcode;
10721 * Sets the interp result to be an error message indicating the required proc args.
10723 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10725 /* Create a nice error message, consistent with Tcl 8.5 */
10726 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10727 int i;
10729 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10730 Jim_AppendString(interp, argmsg, " ", 1);
10732 if (i == cmd->u.proc.argsPos) {
10733 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10734 /* Renamed args */
10735 Jim_AppendString(interp, argmsg, "?", 1);
10736 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10737 Jim_AppendString(interp, argmsg, " ...?", -1);
10739 else {
10740 /* We have plain args */
10741 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10744 else {
10745 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10746 Jim_AppendString(interp, argmsg, "?", 1);
10747 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10748 Jim_AppendString(interp, argmsg, "?", 1);
10750 else {
10751 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10752 if (*arg == '&') {
10753 arg++;
10755 Jim_AppendString(interp, argmsg, arg, -1);
10759 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10760 Jim_FreeNewObj(interp, argmsg);
10763 #ifdef jim_ext_namespace
10765 * [namespace eval]
10767 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10769 Jim_CallFrame *callFramePtr;
10770 int retcode;
10772 /* Create a new callframe */
10773 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10774 callFramePtr->argv = &interp->emptyObj;
10775 callFramePtr->argc = 0;
10776 callFramePtr->procArgsObjPtr = NULL;
10777 callFramePtr->procBodyObjPtr = scriptObj;
10778 callFramePtr->staticVars = NULL;
10779 callFramePtr->fileNameObj = interp->emptyObj;
10780 callFramePtr->line = 0;
10781 Jim_IncrRefCount(scriptObj);
10782 interp->framePtr = callFramePtr;
10784 /* Check if there are too nested calls */
10785 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10786 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10787 retcode = JIM_ERR;
10789 else {
10790 /* Eval the body */
10791 retcode = Jim_EvalObj(interp, scriptObj);
10794 /* Destroy the callframe */
10795 interp->framePtr = interp->framePtr->parent;
10796 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10798 return retcode;
10800 #endif
10802 /* Call a procedure implemented in Tcl.
10803 * It's possible to speed-up a lot this function, currently
10804 * the callframes are not cached, but allocated and
10805 * destroied every time. What is expecially costly is
10806 * to create/destroy the local vars hash table every time.
10808 * This can be fixed just implementing callframes caching
10809 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10810 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10812 Jim_CallFrame *callFramePtr;
10813 int i, d, retcode, optargs;
10814 ScriptObj *script;
10816 /* Check arity */
10817 if (argc - 1 < cmd->u.proc.reqArity ||
10818 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10819 JimSetProcWrongArgs(interp, argv[0], cmd);
10820 return JIM_ERR;
10823 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10824 /* Optimise for procedure with no body - useful for optional debugging */
10825 return JIM_OK;
10828 /* Check if there are too nested calls */
10829 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10830 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10831 return JIM_ERR;
10834 /* Create a new callframe */
10835 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10836 callFramePtr->argv = argv;
10837 callFramePtr->argc = argc;
10838 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10839 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10840 callFramePtr->staticVars = cmd->u.proc.staticVars;
10842 /* Remember where we were called from. */
10843 script = JimGetScript(interp, interp->currentScriptObj);
10844 callFramePtr->fileNameObj = script->fileNameObj;
10845 callFramePtr->line = script->linenr;
10847 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10848 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10849 interp->framePtr = callFramePtr;
10851 /* How many optional args are available */
10852 optargs = (argc - 1 - cmd->u.proc.reqArity);
10854 /* Step 'i' along the actual args, and step 'd' along the formal args */
10855 i = 1;
10856 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10857 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10858 if (d == cmd->u.proc.argsPos) {
10859 /* assign $args */
10860 Jim_Obj *listObjPtr;
10861 int argsLen = 0;
10862 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10863 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10865 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10867 /* It is possible to rename args. */
10868 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10869 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10871 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10872 if (retcode != JIM_OK) {
10873 goto badargset;
10876 i += argsLen;
10877 continue;
10880 /* Optional or required? */
10881 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10882 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10884 else {
10885 /* Ran out, so use the default */
10886 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10888 if (retcode != JIM_OK) {
10889 goto badargset;
10893 /* Eval the body */
10894 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10896 badargset:
10898 /* Free the callframe */
10899 interp->framePtr = interp->framePtr->parent;
10900 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10902 /* Now chain any tailcalls in the parent frame */
10903 if (interp->framePtr->tailcallObj) {
10904 do {
10905 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10907 interp->framePtr->tailcallObj = NULL;
10909 if (retcode == JIM_EVAL) {
10910 retcode = Jim_EvalObjList(interp, tailcallObj);
10911 if (retcode == JIM_RETURN) {
10912 /* If the result of the tailcall is 'return', push
10913 * it up to the caller
10915 interp->returnLevel++;
10918 Jim_DecrRefCount(interp, tailcallObj);
10919 } while (interp->framePtr->tailcallObj);
10921 /* If the tailcall chain finished early, may need to manually discard the command */
10922 if (interp->framePtr->tailcallCmd) {
10923 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10924 interp->framePtr->tailcallCmd = NULL;
10928 /* Handle the JIM_RETURN return code */
10929 if (retcode == JIM_RETURN) {
10930 if (--interp->returnLevel <= 0) {
10931 retcode = interp->returnCode;
10932 interp->returnCode = JIM_OK;
10933 interp->returnLevel = 0;
10936 else if (retcode == JIM_ERR) {
10937 interp->addStackTrace++;
10938 Jim_DecrRefCount(interp, interp->errorProc);
10939 interp->errorProc = argv[0];
10940 Jim_IncrRefCount(interp->errorProc);
10943 return retcode;
10946 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10948 int retval;
10949 Jim_Obj *scriptObjPtr;
10951 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10952 Jim_IncrRefCount(scriptObjPtr);
10954 if (filename) {
10955 Jim_Obj *prevScriptObj;
10957 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10959 prevScriptObj = interp->currentScriptObj;
10960 interp->currentScriptObj = scriptObjPtr;
10962 retval = Jim_EvalObj(interp, scriptObjPtr);
10964 interp->currentScriptObj = prevScriptObj;
10966 else {
10967 retval = Jim_EvalObj(interp, scriptObjPtr);
10969 Jim_DecrRefCount(interp, scriptObjPtr);
10970 return retval;
10973 int Jim_Eval(Jim_Interp *interp, const char *script)
10975 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10978 /* Execute script in the scope of the global level */
10979 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10981 int retval;
10982 Jim_CallFrame *savedFramePtr = interp->framePtr;
10984 interp->framePtr = interp->topFramePtr;
10985 retval = Jim_Eval(interp, script);
10986 interp->framePtr = savedFramePtr;
10988 return retval;
10991 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10993 int retval;
10994 Jim_CallFrame *savedFramePtr = interp->framePtr;
10996 interp->framePtr = interp->topFramePtr;
10997 retval = Jim_EvalFile(interp, filename);
10998 interp->framePtr = savedFramePtr;
11000 return retval;
11003 #include <sys/stat.h>
11005 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11007 FILE *fp;
11008 char *buf;
11009 Jim_Obj *scriptObjPtr;
11010 Jim_Obj *prevScriptObj;
11011 struct stat sb;
11012 int retcode;
11013 int readlen;
11015 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11016 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11017 return JIM_ERR;
11019 if (sb.st_size == 0) {
11020 fclose(fp);
11021 return JIM_OK;
11024 buf = Jim_Alloc(sb.st_size + 1);
11025 readlen = fread(buf, 1, sb.st_size, fp);
11026 if (ferror(fp)) {
11027 fclose(fp);
11028 Jim_Free(buf);
11029 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11030 return JIM_ERR;
11032 fclose(fp);
11033 buf[readlen] = 0;
11035 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11036 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11037 Jim_IncrRefCount(scriptObjPtr);
11039 prevScriptObj = interp->currentScriptObj;
11040 interp->currentScriptObj = scriptObjPtr;
11042 retcode = Jim_EvalObj(interp, scriptObjPtr);
11044 /* Handle the JIM_RETURN return code */
11045 if (retcode == JIM_RETURN) {
11046 if (--interp->returnLevel <= 0) {
11047 retcode = interp->returnCode;
11048 interp->returnCode = JIM_OK;
11049 interp->returnLevel = 0;
11052 if (retcode == JIM_ERR) {
11053 /* EvalFile changes context, so add a stack frame here */
11054 interp->addStackTrace++;
11057 interp->currentScriptObj = prevScriptObj;
11059 Jim_DecrRefCount(interp, scriptObjPtr);
11061 return retcode;
11064 /* -----------------------------------------------------------------------------
11065 * Subst
11066 * ---------------------------------------------------------------------------*/
11067 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11069 pc->tstart = pc->p;
11070 pc->tline = pc->linenr;
11072 if (pc->len == 0) {
11073 pc->tend = pc->p;
11074 pc->tt = JIM_TT_EOL;
11075 pc->eof = 1;
11076 return;
11078 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11079 JimParseCmd(pc);
11080 return;
11082 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11083 if (JimParseVar(pc) == JIM_OK) {
11084 return;
11086 /* Not a var, so treat as a string */
11087 pc->tstart = pc->p;
11088 flags |= JIM_SUBST_NOVAR;
11090 while (pc->len) {
11091 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11092 break;
11094 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11095 break;
11097 if (*pc->p == '\\' && pc->len > 1) {
11098 pc->p++;
11099 pc->len--;
11101 pc->p++;
11102 pc->len--;
11104 pc->tend = pc->p - 1;
11105 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11108 /* The subst object type reuses most of the data structures and functions
11109 * of the script object. Script's data structures are a bit more complex
11110 * for what is needed for [subst]itution tasks, but the reuse helps to
11111 * deal with a single data structure at the cost of some more memory
11112 * usage for substitutions. */
11114 /* This method takes the string representation of an object
11115 * as a Tcl string where to perform [subst]itution, and generates
11116 * the pre-parsed internal representation. */
11117 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11119 int scriptTextLen;
11120 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11121 struct JimParserCtx parser;
11122 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11123 ParseTokenList tokenlist;
11125 /* Initially parse the subst into tokens (in tokenlist) */
11126 ScriptTokenListInit(&tokenlist);
11128 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11129 while (1) {
11130 JimParseSubst(&parser, flags);
11131 if (parser.eof) {
11132 /* Note that subst doesn't need the EOL token */
11133 break;
11135 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11136 parser.tline);
11139 /* Create the "real" subst/script tokens from the initial token list */
11140 script->inUse = 1;
11141 script->substFlags = flags;
11142 script->fileNameObj = interp->emptyObj;
11143 Jim_IncrRefCount(script->fileNameObj);
11144 SubstObjAddTokens(interp, script, &tokenlist);
11146 /* No longer need the token list */
11147 ScriptTokenListFree(&tokenlist);
11149 #ifdef DEBUG_SHOW_SUBST
11151 int i;
11153 printf("==== Subst ====\n");
11154 for (i = 0; i < script->len; i++) {
11155 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11156 Jim_String(script->token[i].objPtr));
11159 #endif
11161 /* Free the old internal rep and set the new one. */
11162 Jim_FreeIntRep(interp, objPtr);
11163 Jim_SetIntRepPtr(objPtr, script);
11164 objPtr->typePtr = &scriptObjType;
11165 return JIM_OK;
11168 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11170 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11171 SetSubstFromAny(interp, objPtr, flags);
11172 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11175 /* Performs commands,variables,blackslashes substitution,
11176 * storing the result object (with refcount 0) into
11177 * resObjPtrPtr. */
11178 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11180 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11182 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11183 /* In order to preserve the internal rep, we increment the
11184 * inUse field of the script internal rep structure. */
11185 script->inUse++;
11187 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11189 script->inUse--;
11190 Jim_DecrRefCount(interp, substObjPtr);
11191 if (*resObjPtrPtr == NULL) {
11192 return JIM_ERR;
11194 return JIM_OK;
11197 /* -----------------------------------------------------------------------------
11198 * Core commands utility functions
11199 * ---------------------------------------------------------------------------*/
11200 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11202 Jim_Obj *objPtr;
11203 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11205 if (*msg) {
11206 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11208 Jim_IncrRefCount(listObjPtr);
11209 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11210 Jim_DecrRefCount(interp, listObjPtr);
11212 Jim_IncrRefCount(objPtr);
11213 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11214 Jim_DecrRefCount(interp, objPtr);
11218 * May add the key and/or value to the list.
11220 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11221 Jim_HashEntry *he, int type);
11223 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11226 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11227 * invoke the callback to add entries to a list.
11228 * Returns the list.
11230 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11231 JimHashtableIteratorCallbackType *callback, int type)
11233 Jim_HashEntry *he;
11234 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11236 /* Check for the non-pattern case. We can do this much more efficiently. */
11237 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11238 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11239 if (he) {
11240 callback(interp, listObjPtr, he, type);
11243 else {
11244 Jim_HashTableIterator htiter;
11245 JimInitHashTableIterator(ht, &htiter);
11246 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11247 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11248 callback(interp, listObjPtr, he, type);
11252 return listObjPtr;
11255 /* Keep these in order */
11256 #define JIM_CMDLIST_COMMANDS 0
11257 #define JIM_CMDLIST_PROCS 1
11258 #define JIM_CMDLIST_CHANNELS 2
11261 * Adds matching command names (procs, channels) to the list.
11263 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11264 Jim_HashEntry *he, int type)
11266 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11267 Jim_Obj *objPtr;
11269 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11270 /* not a proc */
11271 return;
11274 objPtr = Jim_NewStringObj(interp, he->key, -1);
11275 Jim_IncrRefCount(objPtr);
11277 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11278 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11280 Jim_DecrRefCount(interp, objPtr);
11283 /* type is JIM_CMDLIST_xxx */
11284 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11286 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11289 /* Keep these in order */
11290 #define JIM_VARLIST_GLOBALS 0
11291 #define JIM_VARLIST_LOCALS 1
11292 #define JIM_VARLIST_VARS 2
11294 #define JIM_VARLIST_VALUES 0x1000
11297 * Adds matching variable names to the list.
11299 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11300 Jim_HashEntry *he, int type)
11302 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11304 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11305 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11306 if (type & JIM_VARLIST_VALUES) {
11307 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11312 /* mode is JIM_VARLIST_xxx */
11313 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11315 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11316 /* For [info locals], if we are at top level an emtpy list
11317 * is returned. I don't agree, but we aim at compatibility (SS) */
11318 return interp->emptyObj;
11320 else {
11321 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11322 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11326 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11327 Jim_Obj **objPtrPtr, int info_level_cmd)
11329 Jim_CallFrame *targetCallFrame;
11331 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11332 if (targetCallFrame == NULL) {
11333 return JIM_ERR;
11335 /* No proc call at toplevel callframe */
11336 if (targetCallFrame == interp->topFramePtr) {
11337 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11338 return JIM_ERR;
11340 if (info_level_cmd) {
11341 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11343 else {
11344 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11346 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11347 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11348 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11349 *objPtrPtr = listObj;
11351 return JIM_OK;
11354 /* -----------------------------------------------------------------------------
11355 * Core commands
11356 * ---------------------------------------------------------------------------*/
11358 /* fake [puts] -- not the real puts, just for debugging. */
11359 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11361 if (argc != 2 && argc != 3) {
11362 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11363 return JIM_ERR;
11365 if (argc == 3) {
11366 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11367 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11368 return JIM_ERR;
11370 else {
11371 fputs(Jim_String(argv[2]), stdout);
11374 else {
11375 puts(Jim_String(argv[1]));
11377 return JIM_OK;
11380 /* Helper for [+] and [*] */
11381 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11383 jim_wide wideValue, res;
11384 double doubleValue, doubleRes;
11385 int i;
11387 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11389 for (i = 1; i < argc; i++) {
11390 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11391 goto trydouble;
11392 if (op == JIM_EXPROP_ADD)
11393 res += wideValue;
11394 else
11395 res *= wideValue;
11397 Jim_SetResultInt(interp, res);
11398 return JIM_OK;
11399 trydouble:
11400 doubleRes = (double)res;
11401 for (; i < argc; i++) {
11402 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11403 return JIM_ERR;
11404 if (op == JIM_EXPROP_ADD)
11405 doubleRes += doubleValue;
11406 else
11407 doubleRes *= doubleValue;
11409 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11410 return JIM_OK;
11413 /* Helper for [-] and [/] */
11414 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11416 jim_wide wideValue, res = 0;
11417 double doubleValue, doubleRes = 0;
11418 int i = 2;
11420 if (argc < 2) {
11421 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11422 return JIM_ERR;
11424 else if (argc == 2) {
11425 /* The arity = 2 case is different. For [- x] returns -x,
11426 * while [/ x] returns 1/x. */
11427 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11428 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11429 return JIM_ERR;
11431 else {
11432 if (op == JIM_EXPROP_SUB)
11433 doubleRes = -doubleValue;
11434 else
11435 doubleRes = 1.0 / doubleValue;
11436 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11437 return JIM_OK;
11440 if (op == JIM_EXPROP_SUB) {
11441 res = -wideValue;
11442 Jim_SetResultInt(interp, res);
11444 else {
11445 doubleRes = 1.0 / wideValue;
11446 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11448 return JIM_OK;
11450 else {
11451 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11452 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11453 != JIM_OK) {
11454 return JIM_ERR;
11456 else {
11457 goto trydouble;
11461 for (i = 2; i < argc; i++) {
11462 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11463 doubleRes = (double)res;
11464 goto trydouble;
11466 if (op == JIM_EXPROP_SUB)
11467 res -= wideValue;
11468 else
11469 res /= wideValue;
11471 Jim_SetResultInt(interp, res);
11472 return JIM_OK;
11473 trydouble:
11474 for (; i < argc; i++) {
11475 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11476 return JIM_ERR;
11477 if (op == JIM_EXPROP_SUB)
11478 doubleRes -= doubleValue;
11479 else
11480 doubleRes /= doubleValue;
11482 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11483 return JIM_OK;
11487 /* [+] */
11488 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11490 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11493 /* [*] */
11494 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11496 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11499 /* [-] */
11500 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11502 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11505 /* [/] */
11506 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11508 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11511 /* [set] */
11512 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11514 if (argc != 2 && argc != 3) {
11515 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11516 return JIM_ERR;
11518 if (argc == 2) {
11519 Jim_Obj *objPtr;
11521 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11522 if (!objPtr)
11523 return JIM_ERR;
11524 Jim_SetResult(interp, objPtr);
11525 return JIM_OK;
11527 /* argc == 3 case. */
11528 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11529 return JIM_ERR;
11530 Jim_SetResult(interp, argv[2]);
11531 return JIM_OK;
11534 /* [unset]
11536 * unset ?-nocomplain? ?--? ?varName ...?
11538 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11540 int i = 1;
11541 int complain = 1;
11543 while (i < argc) {
11544 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11545 i++;
11546 break;
11548 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11549 complain = 0;
11550 i++;
11551 continue;
11553 break;
11556 while (i < argc) {
11557 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11558 && complain) {
11559 return JIM_ERR;
11561 i++;
11563 return JIM_OK;
11566 /* [while] */
11567 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11569 if (argc != 3) {
11570 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11571 return JIM_ERR;
11574 /* The general purpose implementation of while starts here */
11575 while (1) {
11576 int boolean, retval;
11578 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11579 return retval;
11580 if (!boolean)
11581 break;
11583 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11584 switch (retval) {
11585 case JIM_BREAK:
11586 goto out;
11587 break;
11588 case JIM_CONTINUE:
11589 continue;
11590 break;
11591 default:
11592 return retval;
11596 out:
11597 Jim_SetEmptyResult(interp);
11598 return JIM_OK;
11601 /* [for] */
11602 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11604 int retval;
11605 int boolean = 1;
11606 Jim_Obj *varNamePtr = NULL;
11607 Jim_Obj *stopVarNamePtr = NULL;
11609 if (argc != 5) {
11610 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11611 return JIM_ERR;
11614 /* Do the initialisation */
11615 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11616 return retval;
11619 /* And do the first test now. Better for optimisation
11620 * if we can do next/test at the bottom of the loop
11622 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11624 /* Ready to do the body as follows:
11625 * while (1) {
11626 * body // check retcode
11627 * next // check retcode
11628 * test // check retcode/test bool
11632 #ifdef JIM_OPTIMIZATION
11633 /* Check if the for is on the form:
11634 * for ... {$i < CONST} {incr i}
11635 * for ... {$i < $j} {incr i}
11637 if (retval == JIM_OK && boolean) {
11638 ScriptObj *incrScript;
11639 ExprByteCode *expr;
11640 jim_wide stop, currentVal;
11641 Jim_Obj *objPtr;
11642 int cmpOffset;
11644 /* Do it only if there aren't shared arguments */
11645 expr = JimGetExpression(interp, argv[2]);
11646 incrScript = JimGetScript(interp, argv[3]);
11648 /* Ensure proper lengths to start */
11649 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11650 goto evalstart;
11652 /* Ensure proper token types. */
11653 if (incrScript->token[1].type != JIM_TT_ESC ||
11654 expr->token[0].type != JIM_TT_VAR ||
11655 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11656 goto evalstart;
11659 if (expr->token[2].type == JIM_EXPROP_LT) {
11660 cmpOffset = 0;
11662 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11663 cmpOffset = 1;
11665 else {
11666 goto evalstart;
11669 /* Update command must be incr */
11670 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11671 goto evalstart;
11674 /* incr, expression must be about the same variable */
11675 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11676 goto evalstart;
11679 /* Get the stop condition (must be a variable or integer) */
11680 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11681 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11682 goto evalstart;
11685 else {
11686 stopVarNamePtr = expr->token[1].objPtr;
11687 Jim_IncrRefCount(stopVarNamePtr);
11688 /* Keep the compiler happy */
11689 stop = 0;
11692 /* Initialization */
11693 varNamePtr = expr->token[0].objPtr;
11694 Jim_IncrRefCount(varNamePtr);
11696 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11697 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11698 goto testcond;
11701 /* --- OPTIMIZED FOR --- */
11702 while (retval == JIM_OK) {
11703 /* === Check condition === */
11704 /* Note that currentVal is already set here */
11706 /* Immediate or Variable? get the 'stop' value if the latter. */
11707 if (stopVarNamePtr) {
11708 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11709 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11710 goto testcond;
11714 if (currentVal >= stop + cmpOffset) {
11715 break;
11718 /* Eval body */
11719 retval = Jim_EvalObj(interp, argv[4]);
11720 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11721 retval = JIM_OK;
11723 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11725 /* Increment */
11726 if (objPtr == NULL) {
11727 retval = JIM_ERR;
11728 goto out;
11730 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11731 currentVal = ++JimWideValue(objPtr);
11732 Jim_InvalidateStringRep(objPtr);
11734 else {
11735 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11736 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11737 ++currentVal)) != JIM_OK) {
11738 goto evalnext;
11743 goto out;
11745 evalstart:
11746 #endif
11748 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11749 /* Body */
11750 retval = Jim_EvalObj(interp, argv[4]);
11752 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11753 /* increment */
11754 evalnext:
11755 retval = Jim_EvalObj(interp, argv[3]);
11756 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11757 /* test */
11758 testcond:
11759 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11763 out:
11764 if (stopVarNamePtr) {
11765 Jim_DecrRefCount(interp, stopVarNamePtr);
11767 if (varNamePtr) {
11768 Jim_DecrRefCount(interp, varNamePtr);
11771 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11772 Jim_SetEmptyResult(interp);
11773 return JIM_OK;
11776 return retval;
11779 /* [loop] */
11780 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11782 int retval;
11783 jim_wide i;
11784 jim_wide limit;
11785 jim_wide incr = 1;
11786 Jim_Obj *bodyObjPtr;
11788 if (argc != 5 && argc != 6) {
11789 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11790 return JIM_ERR;
11793 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11794 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11795 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11796 return JIM_ERR;
11798 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11800 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11802 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11803 retval = Jim_EvalObj(interp, bodyObjPtr);
11804 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11805 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11807 retval = JIM_OK;
11809 /* Increment */
11810 i += incr;
11812 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11813 if (argv[1]->typePtr != &variableObjType) {
11814 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11815 return JIM_ERR;
11818 JimWideValue(objPtr) = i;
11819 Jim_InvalidateStringRep(objPtr);
11821 /* The following step is required in order to invalidate the
11822 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11823 if (argv[1]->typePtr != &variableObjType) {
11824 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11825 retval = JIM_ERR;
11826 break;
11830 else {
11831 objPtr = Jim_NewIntObj(interp, i);
11832 retval = Jim_SetVariable(interp, argv[1], objPtr);
11833 if (retval != JIM_OK) {
11834 Jim_FreeNewObj(interp, objPtr);
11840 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11841 Jim_SetEmptyResult(interp);
11842 return JIM_OK;
11844 return retval;
11847 /* List iterators make it easy to iterate over a list.
11848 * At some point iterators will be expanded to support generators.
11850 typedef struct {
11851 Jim_Obj *objPtr;
11852 int idx;
11853 } Jim_ListIter;
11856 * Initialise the iterator at the start of the list.
11858 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11860 iter->objPtr = objPtr;
11861 iter->idx = 0;
11865 * Returns the next object from the list, or NULL on end-of-list.
11867 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11869 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11870 return NULL;
11872 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11876 * Returns 1 if end-of-list has been reached.
11878 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11880 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11883 /* foreach + lmap implementation. */
11884 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11886 int result = JIM_OK;
11887 int i, numargs;
11888 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11889 Jim_ListIter *iters;
11890 Jim_Obj *script;
11891 Jim_Obj *resultObj;
11893 if (argc < 4 || argc % 2 != 0) {
11894 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11895 return JIM_ERR;
11897 script = argv[argc - 1]; /* Last argument is a script */
11898 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11900 if (numargs == 2) {
11901 iters = twoiters;
11903 else {
11904 iters = Jim_Alloc(numargs * sizeof(*iters));
11906 for (i = 0; i < numargs; i++) {
11907 JimListIterInit(&iters[i], argv[i + 1]);
11908 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11909 result = JIM_ERR;
11912 if (result != JIM_OK) {
11913 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11914 return result;
11917 if (doMap) {
11918 resultObj = Jim_NewListObj(interp, NULL, 0);
11920 else {
11921 resultObj = interp->emptyObj;
11923 Jim_IncrRefCount(resultObj);
11925 while (1) {
11926 /* Have we expired all lists? */
11927 for (i = 0; i < numargs; i += 2) {
11928 if (!JimListIterDone(interp, &iters[i + 1])) {
11929 break;
11932 if (i == numargs) {
11933 /* All done */
11934 break;
11937 /* For each list */
11938 for (i = 0; i < numargs; i += 2) {
11939 Jim_Obj *varName;
11941 /* foreach var */
11942 JimListIterInit(&iters[i], argv[i + 1]);
11943 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11944 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11945 if (!valObj) {
11946 /* Ran out, so store the empty string */
11947 valObj = interp->emptyObj;
11949 /* Avoid shimmering */
11950 Jim_IncrRefCount(valObj);
11951 result = Jim_SetVariable(interp, varName, valObj);
11952 Jim_DecrRefCount(interp, valObj);
11953 if (result != JIM_OK) {
11954 goto err;
11958 switch (result = Jim_EvalObj(interp, script)) {
11959 case JIM_OK:
11960 if (doMap) {
11961 Jim_ListAppendElement(interp, resultObj, interp->result);
11963 break;
11964 case JIM_CONTINUE:
11965 break;
11966 case JIM_BREAK:
11967 goto out;
11968 default:
11969 goto err;
11972 out:
11973 result = JIM_OK;
11974 Jim_SetResult(interp, resultObj);
11975 err:
11976 Jim_DecrRefCount(interp, resultObj);
11977 if (numargs > 2) {
11978 Jim_Free(iters);
11980 return result;
11983 /* [foreach] */
11984 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11986 return JimForeachMapHelper(interp, argc, argv, 0);
11989 /* [lmap] */
11990 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11992 return JimForeachMapHelper(interp, argc, argv, 1);
11995 /* [lassign] */
11996 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11998 int result = JIM_ERR;
11999 int i;
12000 Jim_ListIter iter;
12001 Jim_Obj *resultObj;
12003 if (argc < 2) {
12004 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12005 return JIM_ERR;
12008 JimListIterInit(&iter, argv[1]);
12010 for (i = 2; i < argc; i++) {
12011 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12012 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12013 if (result != JIM_OK) {
12014 return result;
12018 resultObj = Jim_NewListObj(interp, NULL, 0);
12019 while (!JimListIterDone(interp, &iter)) {
12020 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12023 Jim_SetResult(interp, resultObj);
12025 return JIM_OK;
12028 /* [if] */
12029 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12031 int boolean, retval, current = 1, falsebody = 0;
12033 if (argc >= 3) {
12034 while (1) {
12035 /* Far not enough arguments given! */
12036 if (current >= argc)
12037 goto err;
12038 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12039 != JIM_OK)
12040 return retval;
12041 /* There lacks something, isn't it? */
12042 if (current >= argc)
12043 goto err;
12044 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12045 current++;
12046 /* Tsk tsk, no then-clause? */
12047 if (current >= argc)
12048 goto err;
12049 if (boolean)
12050 return Jim_EvalObj(interp, argv[current]);
12051 /* Ok: no else-clause follows */
12052 if (++current >= argc) {
12053 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12054 return JIM_OK;
12056 falsebody = current++;
12057 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12058 /* IIICKS - else-clause isn't last cmd? */
12059 if (current != argc - 1)
12060 goto err;
12061 return Jim_EvalObj(interp, argv[current]);
12063 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12064 /* Ok: elseif follows meaning all the stuff
12065 * again (how boring...) */
12066 continue;
12067 /* OOPS - else-clause is not last cmd? */
12068 else if (falsebody != argc - 1)
12069 goto err;
12070 return Jim_EvalObj(interp, argv[falsebody]);
12072 return JIM_OK;
12074 err:
12075 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12076 return JIM_ERR;
12080 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12081 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12082 Jim_Obj *stringObj, int nocase)
12084 Jim_Obj *parms[4];
12085 int argc = 0;
12086 long eq;
12087 int rc;
12089 parms[argc++] = commandObj;
12090 if (nocase) {
12091 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12093 parms[argc++] = patternObj;
12094 parms[argc++] = stringObj;
12096 rc = Jim_EvalObjVector(interp, argc, parms);
12098 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12099 eq = -rc;
12102 return eq;
12105 enum
12106 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12108 /* [switch] */
12109 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12111 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12112 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12113 Jim_Obj *script = 0;
12115 if (argc < 3) {
12116 wrongnumargs:
12117 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12118 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12119 return JIM_ERR;
12121 for (opt = 1; opt < argc; ++opt) {
12122 const char *option = Jim_String(argv[opt]);
12124 if (*option != '-')
12125 break;
12126 else if (strncmp(option, "--", 2) == 0) {
12127 ++opt;
12128 break;
12130 else if (strncmp(option, "-exact", 2) == 0)
12131 matchOpt = SWITCH_EXACT;
12132 else if (strncmp(option, "-glob", 2) == 0)
12133 matchOpt = SWITCH_GLOB;
12134 else if (strncmp(option, "-regexp", 2) == 0)
12135 matchOpt = SWITCH_RE;
12136 else if (strncmp(option, "-command", 2) == 0) {
12137 matchOpt = SWITCH_CMD;
12138 if ((argc - opt) < 2)
12139 goto wrongnumargs;
12140 command = argv[++opt];
12142 else {
12143 Jim_SetResultFormatted(interp,
12144 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12145 argv[opt]);
12146 return JIM_ERR;
12148 if ((argc - opt) < 2)
12149 goto wrongnumargs;
12151 strObj = argv[opt++];
12152 patCount = argc - opt;
12153 if (patCount == 1) {
12154 Jim_Obj **vector;
12156 JimListGetElements(interp, argv[opt], &patCount, &vector);
12157 caseList = vector;
12159 else
12160 caseList = &argv[opt];
12161 if (patCount == 0 || patCount % 2 != 0)
12162 goto wrongnumargs;
12163 for (i = 0; script == 0 && i < patCount; i += 2) {
12164 Jim_Obj *patObj = caseList[i];
12166 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12167 || i < (patCount - 2)) {
12168 switch (matchOpt) {
12169 case SWITCH_EXACT:
12170 if (Jim_StringEqObj(strObj, patObj))
12171 script = caseList[i + 1];
12172 break;
12173 case SWITCH_GLOB:
12174 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12175 script = caseList[i + 1];
12176 break;
12177 case SWITCH_RE:
12178 command = Jim_NewStringObj(interp, "regexp", -1);
12179 /* Fall thru intentionally */
12180 case SWITCH_CMD:{
12181 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12183 /* After the execution of a command we need to
12184 * make sure to reconvert the object into a list
12185 * again. Only for the single-list style [switch]. */
12186 if (argc - opt == 1) {
12187 Jim_Obj **vector;
12189 JimListGetElements(interp, argv[opt], &patCount, &vector);
12190 caseList = vector;
12192 /* command is here already decref'd */
12193 if (rc < 0) {
12194 return -rc;
12196 if (rc)
12197 script = caseList[i + 1];
12198 break;
12202 else {
12203 script = caseList[i + 1];
12206 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12207 script = caseList[i + 1];
12208 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12209 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12210 return JIM_ERR;
12212 Jim_SetEmptyResult(interp);
12213 if (script) {
12214 return Jim_EvalObj(interp, script);
12216 return JIM_OK;
12219 /* [list] */
12220 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12222 Jim_Obj *listObjPtr;
12224 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12225 Jim_SetResult(interp, listObjPtr);
12226 return JIM_OK;
12229 /* [lindex] */
12230 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12232 Jim_Obj *objPtr, *listObjPtr;
12233 int i;
12234 int idx;
12236 if (argc < 2) {
12237 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12238 return JIM_ERR;
12240 objPtr = argv[1];
12241 Jim_IncrRefCount(objPtr);
12242 for (i = 2; i < argc; i++) {
12243 listObjPtr = objPtr;
12244 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12245 Jim_DecrRefCount(interp, listObjPtr);
12246 return JIM_ERR;
12248 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12249 /* Returns an empty object if the index
12250 * is out of range. */
12251 Jim_DecrRefCount(interp, listObjPtr);
12252 Jim_SetEmptyResult(interp);
12253 return JIM_OK;
12255 Jim_IncrRefCount(objPtr);
12256 Jim_DecrRefCount(interp, listObjPtr);
12258 Jim_SetResult(interp, objPtr);
12259 Jim_DecrRefCount(interp, objPtr);
12260 return JIM_OK;
12263 /* [llength] */
12264 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12266 if (argc != 2) {
12267 Jim_WrongNumArgs(interp, 1, argv, "list");
12268 return JIM_ERR;
12270 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12271 return JIM_OK;
12274 /* [lsearch] */
12275 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12277 static const char * const options[] = {
12278 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12279 NULL
12281 enum
12282 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12283 OPT_COMMAND };
12284 int i;
12285 int opt_bool = 0;
12286 int opt_not = 0;
12287 int opt_nocase = 0;
12288 int opt_all = 0;
12289 int opt_inline = 0;
12290 int opt_match = OPT_EXACT;
12291 int listlen;
12292 int rc = JIM_OK;
12293 Jim_Obj *listObjPtr = NULL;
12294 Jim_Obj *commandObj = NULL;
12296 if (argc < 3) {
12297 wrongargs:
12298 Jim_WrongNumArgs(interp, 1, argv,
12299 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12300 return JIM_ERR;
12303 for (i = 1; i < argc - 2; i++) {
12304 int option;
12306 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12307 return JIM_ERR;
12309 switch (option) {
12310 case OPT_BOOL:
12311 opt_bool = 1;
12312 opt_inline = 0;
12313 break;
12314 case OPT_NOT:
12315 opt_not = 1;
12316 break;
12317 case OPT_NOCASE:
12318 opt_nocase = 1;
12319 break;
12320 case OPT_INLINE:
12321 opt_inline = 1;
12322 opt_bool = 0;
12323 break;
12324 case OPT_ALL:
12325 opt_all = 1;
12326 break;
12327 case OPT_COMMAND:
12328 if (i >= argc - 2) {
12329 goto wrongargs;
12331 commandObj = argv[++i];
12332 /* fallthru */
12333 case OPT_EXACT:
12334 case OPT_GLOB:
12335 case OPT_REGEXP:
12336 opt_match = option;
12337 break;
12341 argv += i;
12343 if (opt_all) {
12344 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12346 if (opt_match == OPT_REGEXP) {
12347 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12349 if (commandObj) {
12350 Jim_IncrRefCount(commandObj);
12353 listlen = Jim_ListLength(interp, argv[0]);
12354 for (i = 0; i < listlen; i++) {
12355 int eq = 0;
12356 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12358 switch (opt_match) {
12359 case OPT_EXACT:
12360 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12361 break;
12363 case OPT_GLOB:
12364 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12365 break;
12367 case OPT_REGEXP:
12368 case OPT_COMMAND:
12369 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12370 if (eq < 0) {
12371 if (listObjPtr) {
12372 Jim_FreeNewObj(interp, listObjPtr);
12374 rc = JIM_ERR;
12375 goto done;
12377 break;
12380 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12381 if (!eq && opt_bool && opt_not && !opt_all) {
12382 continue;
12385 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12386 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12387 Jim_Obj *resultObj;
12389 if (opt_bool) {
12390 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12392 else if (!opt_inline) {
12393 resultObj = Jim_NewIntObj(interp, i);
12395 else {
12396 resultObj = objPtr;
12399 if (opt_all) {
12400 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12402 else {
12403 Jim_SetResult(interp, resultObj);
12404 goto done;
12409 if (opt_all) {
12410 Jim_SetResult(interp, listObjPtr);
12412 else {
12413 /* No match */
12414 if (opt_bool) {
12415 Jim_SetResultBool(interp, opt_not);
12417 else if (!opt_inline) {
12418 Jim_SetResultInt(interp, -1);
12422 done:
12423 if (commandObj) {
12424 Jim_DecrRefCount(interp, commandObj);
12426 return rc;
12429 /* [lappend] */
12430 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12432 Jim_Obj *listObjPtr;
12433 int shared, i;
12435 if (argc < 2) {
12436 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12437 return JIM_ERR;
12439 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12440 if (!listObjPtr) {
12441 /* Create the list if it does not exists */
12442 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12443 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12444 Jim_FreeNewObj(interp, listObjPtr);
12445 return JIM_ERR;
12448 shared = Jim_IsShared(listObjPtr);
12449 if (shared)
12450 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12451 for (i = 2; i < argc; i++)
12452 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12453 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12454 if (shared)
12455 Jim_FreeNewObj(interp, listObjPtr);
12456 return JIM_ERR;
12458 Jim_SetResult(interp, listObjPtr);
12459 return JIM_OK;
12462 /* [linsert] */
12463 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12465 int idx, len;
12466 Jim_Obj *listPtr;
12468 if (argc < 3) {
12469 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12470 return JIM_ERR;
12472 listPtr = argv[1];
12473 if (Jim_IsShared(listPtr))
12474 listPtr = Jim_DuplicateObj(interp, listPtr);
12475 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12476 goto err;
12477 len = Jim_ListLength(interp, listPtr);
12478 if (idx >= len)
12479 idx = len;
12480 else if (idx < 0)
12481 idx = len + idx + 1;
12482 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12483 Jim_SetResult(interp, listPtr);
12484 return JIM_OK;
12485 err:
12486 if (listPtr != argv[1]) {
12487 Jim_FreeNewObj(interp, listPtr);
12489 return JIM_ERR;
12492 /* [lreplace] */
12493 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12495 int first, last, len, rangeLen;
12496 Jim_Obj *listObj;
12497 Jim_Obj *newListObj;
12499 if (argc < 4) {
12500 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12501 return JIM_ERR;
12503 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12504 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12505 return JIM_ERR;
12508 listObj = argv[1];
12509 len = Jim_ListLength(interp, listObj);
12511 first = JimRelToAbsIndex(len, first);
12512 last = JimRelToAbsIndex(len, last);
12513 JimRelToAbsRange(len, &first, &last, &rangeLen);
12515 /* Now construct a new list which consists of:
12516 * <elements before first> <supplied elements> <elements after last>
12519 /* Check to see if trying to replace past the end of the list */
12520 if (first < len) {
12521 /* OK. Not past the end */
12523 else if (len == 0) {
12524 /* Special for empty list, adjust first to 0 */
12525 first = 0;
12527 else {
12528 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12529 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12530 return JIM_ERR;
12533 /* Add the first set of elements */
12534 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12536 /* Add supplied elements */
12537 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12539 /* Add the remaining elements */
12540 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12542 Jim_SetResult(interp, newListObj);
12543 return JIM_OK;
12546 /* [lset] */
12547 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12549 if (argc < 3) {
12550 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12551 return JIM_ERR;
12553 else if (argc == 3) {
12554 /* With no indexes, simply implements [set] */
12555 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12556 return JIM_ERR;
12557 Jim_SetResult(interp, argv[2]);
12558 return JIM_OK;
12560 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12563 /* [lsort] */
12564 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12566 static const char * const options[] = {
12567 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12569 enum
12570 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12571 Jim_Obj *resObj;
12572 int i;
12573 int retCode;
12575 struct lsort_info info;
12577 if (argc < 2) {
12578 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12579 return JIM_ERR;
12582 info.type = JIM_LSORT_ASCII;
12583 info.order = 1;
12584 info.indexed = 0;
12585 info.unique = 0;
12586 info.command = NULL;
12587 info.interp = interp;
12589 for (i = 1; i < (argc - 1); i++) {
12590 int option;
12592 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12593 != JIM_OK)
12594 return JIM_ERR;
12595 switch (option) {
12596 case OPT_ASCII:
12597 info.type = JIM_LSORT_ASCII;
12598 break;
12599 case OPT_NOCASE:
12600 info.type = JIM_LSORT_NOCASE;
12601 break;
12602 case OPT_INTEGER:
12603 info.type = JIM_LSORT_INTEGER;
12604 break;
12605 case OPT_REAL:
12606 info.type = JIM_LSORT_REAL;
12607 break;
12608 case OPT_INCREASING:
12609 info.order = 1;
12610 break;
12611 case OPT_DECREASING:
12612 info.order = -1;
12613 break;
12614 case OPT_UNIQUE:
12615 info.unique = 1;
12616 break;
12617 case OPT_COMMAND:
12618 if (i >= (argc - 2)) {
12619 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12620 return JIM_ERR;
12622 info.type = JIM_LSORT_COMMAND;
12623 info.command = argv[i + 1];
12624 i++;
12625 break;
12626 case OPT_INDEX:
12627 if (i >= (argc - 2)) {
12628 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12629 return JIM_ERR;
12631 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12632 return JIM_ERR;
12634 info.indexed = 1;
12635 i++;
12636 break;
12639 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12640 retCode = ListSortElements(interp, resObj, &info);
12641 if (retCode == JIM_OK) {
12642 Jim_SetResult(interp, resObj);
12644 else {
12645 Jim_FreeNewObj(interp, resObj);
12647 return retCode;
12650 /* [append] */
12651 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12653 Jim_Obj *stringObjPtr;
12654 int i;
12656 if (argc < 2) {
12657 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12658 return JIM_ERR;
12660 if (argc == 2) {
12661 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12662 if (!stringObjPtr)
12663 return JIM_ERR;
12665 else {
12666 int freeobj = 0;
12667 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12668 if (!stringObjPtr) {
12669 /* Create the string if it doesn't exist */
12670 stringObjPtr = Jim_NewEmptyStringObj(interp);
12671 freeobj = 1;
12673 else if (Jim_IsShared(stringObjPtr)) {
12674 freeobj = 1;
12675 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12677 for (i = 2; i < argc; i++) {
12678 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12680 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12681 if (freeobj) {
12682 Jim_FreeNewObj(interp, stringObjPtr);
12684 return JIM_ERR;
12687 Jim_SetResult(interp, stringObjPtr);
12688 return JIM_OK;
12691 /* [debug] */
12692 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12694 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12695 static const char * const options[] = {
12696 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12697 "exprbc", "show",
12698 NULL
12700 enum
12702 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12703 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12705 int option;
12707 if (argc < 2) {
12708 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12709 return JIM_ERR;
12711 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12712 return JIM_ERR;
12713 if (option == OPT_REFCOUNT) {
12714 if (argc != 3) {
12715 Jim_WrongNumArgs(interp, 2, argv, "object");
12716 return JIM_ERR;
12718 Jim_SetResultInt(interp, argv[2]->refCount);
12719 return JIM_OK;
12721 else if (option == OPT_OBJCOUNT) {
12722 int freeobj = 0, liveobj = 0;
12723 char buf[256];
12724 Jim_Obj *objPtr;
12726 if (argc != 2) {
12727 Jim_WrongNumArgs(interp, 2, argv, "");
12728 return JIM_ERR;
12730 /* Count the number of free objects. */
12731 objPtr = interp->freeList;
12732 while (objPtr) {
12733 freeobj++;
12734 objPtr = objPtr->nextObjPtr;
12736 /* Count the number of live objects. */
12737 objPtr = interp->liveList;
12738 while (objPtr) {
12739 liveobj++;
12740 objPtr = objPtr->nextObjPtr;
12742 /* Set the result string and return. */
12743 sprintf(buf, "free %d used %d", freeobj, liveobj);
12744 Jim_SetResultString(interp, buf, -1);
12745 return JIM_OK;
12747 else if (option == OPT_OBJECTS) {
12748 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12750 /* Count the number of live objects. */
12751 objPtr = interp->liveList;
12752 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12753 while (objPtr) {
12754 char buf[128];
12755 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12757 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12758 sprintf(buf, "%p", objPtr);
12759 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12760 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12761 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12762 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12763 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12764 objPtr = objPtr->nextObjPtr;
12766 Jim_SetResult(interp, listObjPtr);
12767 return JIM_OK;
12769 else if (option == OPT_INVSTR) {
12770 Jim_Obj *objPtr;
12772 if (argc != 3) {
12773 Jim_WrongNumArgs(interp, 2, argv, "object");
12774 return JIM_ERR;
12776 objPtr = argv[2];
12777 if (objPtr->typePtr != NULL)
12778 Jim_InvalidateStringRep(objPtr);
12779 Jim_SetEmptyResult(interp);
12780 return JIM_OK;
12782 else if (option == OPT_SHOW) {
12783 const char *s;
12784 int len, charlen;
12786 if (argc != 3) {
12787 Jim_WrongNumArgs(interp, 2, argv, "object");
12788 return JIM_ERR;
12790 s = Jim_GetString(argv[2], &len);
12791 #ifdef JIM_UTF8
12792 charlen = utf8_strlen(s, len);
12793 #else
12794 charlen = len;
12795 #endif
12796 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12797 printf("chars (%d): <<%s>>\n", charlen, s);
12798 printf("bytes (%d):", len);
12799 while (len--) {
12800 printf(" %02x", (unsigned char)*s++);
12802 printf("\n");
12803 return JIM_OK;
12805 else if (option == OPT_SCRIPTLEN) {
12806 ScriptObj *script;
12808 if (argc != 3) {
12809 Jim_WrongNumArgs(interp, 2, argv, "script");
12810 return JIM_ERR;
12812 script = JimGetScript(interp, argv[2]);
12813 if (script == NULL)
12814 return JIM_ERR;
12815 Jim_SetResultInt(interp, script->len);
12816 return JIM_OK;
12818 else if (option == OPT_EXPRLEN) {
12819 ExprByteCode *expr;
12821 if (argc != 3) {
12822 Jim_WrongNumArgs(interp, 2, argv, "expression");
12823 return JIM_ERR;
12825 expr = JimGetExpression(interp, argv[2]);
12826 if (expr == NULL)
12827 return JIM_ERR;
12828 Jim_SetResultInt(interp, expr->len);
12829 return JIM_OK;
12831 else if (option == OPT_EXPRBC) {
12832 Jim_Obj *objPtr;
12833 ExprByteCode *expr;
12834 int i;
12836 if (argc != 3) {
12837 Jim_WrongNumArgs(interp, 2, argv, "expression");
12838 return JIM_ERR;
12840 expr = JimGetExpression(interp, argv[2]);
12841 if (expr == NULL)
12842 return JIM_ERR;
12843 objPtr = Jim_NewListObj(interp, NULL, 0);
12844 for (i = 0; i < expr->len; i++) {
12845 const char *type;
12846 const Jim_ExprOperator *op;
12847 Jim_Obj *obj = expr->token[i].objPtr;
12849 switch (expr->token[i].type) {
12850 case JIM_TT_EXPR_INT:
12851 type = "int";
12852 break;
12853 case JIM_TT_EXPR_DOUBLE:
12854 type = "double";
12855 break;
12856 case JIM_TT_CMD:
12857 type = "command";
12858 break;
12859 case JIM_TT_VAR:
12860 type = "variable";
12861 break;
12862 case JIM_TT_DICTSUGAR:
12863 type = "dictsugar";
12864 break;
12865 case JIM_TT_EXPRSUGAR:
12866 type = "exprsugar";
12867 break;
12868 case JIM_TT_ESC:
12869 type = "subst";
12870 break;
12871 case JIM_TT_STR:
12872 type = "string";
12873 break;
12874 default:
12875 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12876 if (op == NULL) {
12877 type = "private";
12879 else {
12880 type = "operator";
12882 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12883 break;
12885 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12886 Jim_ListAppendElement(interp, objPtr, obj);
12888 Jim_SetResult(interp, objPtr);
12889 return JIM_OK;
12891 else {
12892 Jim_SetResultString(interp,
12893 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12894 return JIM_ERR;
12896 /* unreached */
12897 #endif /* JIM_BOOTSTRAP */
12898 #if !defined(JIM_DEBUG_COMMAND)
12899 Jim_SetResultString(interp, "unsupported", -1);
12900 return JIM_ERR;
12901 #endif
12904 /* [eval] */
12905 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12907 int rc;
12909 if (argc < 2) {
12910 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12911 return JIM_ERR;
12914 if (argc == 2) {
12915 rc = Jim_EvalObj(interp, argv[1]);
12917 else {
12918 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12921 if (rc == JIM_ERR) {
12922 /* eval is "interesting", so add a stack frame here */
12923 interp->addStackTrace++;
12925 return rc;
12928 /* [uplevel] */
12929 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12931 if (argc >= 2) {
12932 int retcode;
12933 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12934 const char *str;
12936 /* Save the old callframe pointer */
12937 savedCallFrame = interp->framePtr;
12939 /* Lookup the target frame pointer */
12940 str = Jim_String(argv[1]);
12941 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12942 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12943 argc--;
12944 argv++;
12946 else {
12947 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12949 if (targetCallFrame == NULL) {
12950 return JIM_ERR;
12952 if (argc < 2) {
12953 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12954 return JIM_ERR;
12956 /* Eval the code in the target callframe. */
12957 interp->framePtr = targetCallFrame;
12958 if (argc == 2) {
12959 retcode = Jim_EvalObj(interp, argv[1]);
12961 else {
12962 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12964 interp->framePtr = savedCallFrame;
12965 return retcode;
12967 else {
12968 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12969 return JIM_ERR;
12973 /* [expr] */
12974 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12976 Jim_Obj *exprResultPtr;
12977 int retcode;
12979 if (argc == 2) {
12980 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12982 else if (argc > 2) {
12983 Jim_Obj *objPtr;
12985 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12986 Jim_IncrRefCount(objPtr);
12987 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12988 Jim_DecrRefCount(interp, objPtr);
12990 else {
12991 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12992 return JIM_ERR;
12994 if (retcode != JIM_OK)
12995 return retcode;
12996 Jim_SetResult(interp, exprResultPtr);
12997 Jim_DecrRefCount(interp, exprResultPtr);
12998 return JIM_OK;
13001 /* [break] */
13002 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13004 if (argc != 1) {
13005 Jim_WrongNumArgs(interp, 1, argv, "");
13006 return JIM_ERR;
13008 return JIM_BREAK;
13011 /* [continue] */
13012 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13014 if (argc != 1) {
13015 Jim_WrongNumArgs(interp, 1, argv, "");
13016 return JIM_ERR;
13018 return JIM_CONTINUE;
13021 /* [return] */
13022 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13024 int i;
13025 Jim_Obj *stackTraceObj = NULL;
13026 Jim_Obj *errorCodeObj = NULL;
13027 int returnCode = JIM_OK;
13028 long level = 1;
13030 for (i = 1; i < argc - 1; i += 2) {
13031 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13032 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13033 return JIM_ERR;
13036 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13037 stackTraceObj = argv[i + 1];
13039 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13040 errorCodeObj = argv[i + 1];
13042 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13043 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13044 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13045 return JIM_ERR;
13048 else {
13049 break;
13053 if (i != argc - 1 && i != argc) {
13054 Jim_WrongNumArgs(interp, 1, argv,
13055 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13058 /* If a stack trace is supplied and code is error, set the stack trace */
13059 if (stackTraceObj && returnCode == JIM_ERR) {
13060 JimSetStackTrace(interp, stackTraceObj);
13062 /* If an error code list is supplied, set the global $errorCode */
13063 if (errorCodeObj && returnCode == JIM_ERR) {
13064 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13066 interp->returnCode = returnCode;
13067 interp->returnLevel = level;
13069 if (i == argc - 1) {
13070 Jim_SetResult(interp, argv[i]);
13072 return JIM_RETURN;
13075 /* [tailcall] */
13076 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13078 if (interp->framePtr->level == 0) {
13079 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13080 return JIM_ERR;
13082 else if (argc >= 2) {
13083 /* Need to resolve the tailcall command in the current context */
13084 Jim_CallFrame *cf = interp->framePtr->parent;
13086 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13087 if (cmdPtr == NULL) {
13088 return JIM_ERR;
13091 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13093 /* And stash this pre-resolved command */
13094 JimIncrCmdRefCount(cmdPtr);
13095 cf->tailcallCmd = cmdPtr;
13097 /* And stash the command list */
13098 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13100 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13101 Jim_IncrRefCount(cf->tailcallObj);
13103 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13104 return JIM_EVAL;
13106 return JIM_OK;
13109 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13111 Jim_Obj *cmdList;
13112 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13114 /* prefixListObj is a list to which the args need to be appended */
13115 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13116 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13118 return JimEvalObjList(interp, cmdList);
13121 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13123 Jim_Obj *prefixListObj = privData;
13124 Jim_DecrRefCount(interp, prefixListObj);
13127 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13129 Jim_Obj *prefixListObj;
13130 const char *newname;
13132 if (argc < 3) {
13133 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13134 return JIM_ERR;
13137 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13138 Jim_IncrRefCount(prefixListObj);
13139 newname = Jim_String(argv[1]);
13140 if (newname[0] == ':' && newname[1] == ':') {
13141 while (*++newname == ':') {
13145 Jim_SetResult(interp, argv[1]);
13147 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13150 /* [proc] */
13151 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13153 Jim_Cmd *cmd;
13155 if (argc != 4 && argc != 5) {
13156 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13157 return JIM_ERR;
13160 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13161 return JIM_ERR;
13164 if (argc == 4) {
13165 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13167 else {
13168 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13171 if (cmd) {
13172 /* Add the new command */
13173 Jim_Obj *qualifiedCmdNameObj;
13174 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13176 JimCreateCommand(interp, cmdname, cmd);
13178 /* Calculate and set the namespace for this proc */
13179 JimUpdateProcNamespace(interp, cmd, cmdname);
13181 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13183 /* Unlike Tcl, set the name of the proc as the result */
13184 Jim_SetResult(interp, argv[1]);
13185 return JIM_OK;
13187 return JIM_ERR;
13190 /* [local] */
13191 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13193 int retcode;
13195 if (argc < 2) {
13196 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13197 return JIM_ERR;
13200 /* Evaluate the arguments with 'local' in force */
13201 interp->local++;
13202 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13203 interp->local--;
13206 /* If OK, and the result is a proc, add it to the list of local procs */
13207 if (retcode == 0) {
13208 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13210 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13211 return JIM_ERR;
13213 if (interp->framePtr->localCommands == NULL) {
13214 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13215 Jim_InitStack(interp->framePtr->localCommands);
13217 Jim_IncrRefCount(cmdNameObj);
13218 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13221 return retcode;
13224 /* [upcall] */
13225 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13227 if (argc < 2) {
13228 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13229 return JIM_ERR;
13231 else {
13232 int retcode;
13234 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13235 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13236 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13237 return JIM_ERR;
13239 /* OK. Mark this command as being in an upcall */
13240 cmdPtr->u.proc.upcall++;
13241 JimIncrCmdRefCount(cmdPtr);
13243 /* Invoke the command as normal */
13244 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13246 /* No longer in an upcall */
13247 cmdPtr->u.proc.upcall--;
13248 JimDecrCmdRefCount(interp, cmdPtr);
13250 return retcode;
13254 /* [apply] */
13255 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13257 if (argc < 2) {
13258 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13259 return JIM_ERR;
13261 else {
13262 int ret;
13263 Jim_Cmd *cmd;
13264 Jim_Obj *argListObjPtr;
13265 Jim_Obj *bodyObjPtr;
13266 Jim_Obj *nsObj = NULL;
13267 Jim_Obj **nargv;
13269 int len = Jim_ListLength(interp, argv[1]);
13270 if (len != 2 && len != 3) {
13271 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13272 return JIM_ERR;
13275 if (len == 3) {
13276 #ifdef jim_ext_namespace
13277 /* Need to canonicalise the given namespace. */
13278 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13279 #else
13280 Jim_SetResultString(interp, "namespaces not enabled", -1);
13281 return JIM_ERR;
13282 #endif
13284 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13285 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13287 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13289 if (cmd) {
13290 /* Create a new argv array with a dummy argv[0], for error messages */
13291 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13292 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13293 Jim_IncrRefCount(nargv[0]);
13294 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13295 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13296 Jim_DecrRefCount(interp, nargv[0]);
13297 Jim_Free(nargv);
13299 JimDecrCmdRefCount(interp, cmd);
13300 return ret;
13302 return JIM_ERR;
13307 /* [concat] */
13308 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13310 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13311 return JIM_OK;
13314 /* [upvar] */
13315 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13317 int i;
13318 Jim_CallFrame *targetCallFrame;
13320 /* Lookup the target frame pointer */
13321 if (argc > 3 && (argc % 2 == 0)) {
13322 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13323 argc--;
13324 argv++;
13326 else {
13327 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13329 if (targetCallFrame == NULL) {
13330 return JIM_ERR;
13333 /* Check for arity */
13334 if (argc < 3) {
13335 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13336 return JIM_ERR;
13339 /* Now... for every other/local couple: */
13340 for (i = 1; i < argc; i += 2) {
13341 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13342 return JIM_ERR;
13344 return JIM_OK;
13347 /* [global] */
13348 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13350 int i;
13352 if (argc < 2) {
13353 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13354 return JIM_ERR;
13356 /* Link every var to the toplevel having the same name */
13357 if (interp->framePtr->level == 0)
13358 return JIM_OK; /* global at toplevel... */
13359 for (i = 1; i < argc; i++) {
13360 /* global ::blah does nothing */
13361 const char *name = Jim_String(argv[i]);
13362 if (name[0] != ':' || name[1] != ':') {
13363 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13364 return JIM_ERR;
13367 return JIM_OK;
13370 /* does the [string map] operation. On error NULL is returned,
13371 * otherwise a new string object with the result, having refcount = 0,
13372 * is returned. */
13373 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13374 Jim_Obj *objPtr, int nocase)
13376 int numMaps;
13377 const char *str, *noMatchStart = NULL;
13378 int strLen, i;
13379 Jim_Obj *resultObjPtr;
13381 numMaps = Jim_ListLength(interp, mapListObjPtr);
13382 if (numMaps % 2) {
13383 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13384 return NULL;
13387 str = Jim_String(objPtr);
13388 strLen = Jim_Utf8Length(interp, objPtr);
13390 /* Map it */
13391 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13392 while (strLen) {
13393 for (i = 0; i < numMaps; i += 2) {
13394 Jim_Obj *objPtr;
13395 const char *k;
13396 int kl;
13398 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13399 k = Jim_String(objPtr);
13400 kl = Jim_Utf8Length(interp, objPtr);
13402 if (strLen >= kl && kl) {
13403 int rc;
13404 rc = JimStringCompareLen(str, k, kl, nocase);
13405 if (rc == 0) {
13406 if (noMatchStart) {
13407 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13408 noMatchStart = NULL;
13410 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13411 str += utf8_index(str, kl);
13412 strLen -= kl;
13413 break;
13417 if (i == numMaps) { /* no match */
13418 int c;
13419 if (noMatchStart == NULL)
13420 noMatchStart = str;
13421 str += utf8_tounicode(str, &c);
13422 strLen--;
13425 if (noMatchStart) {
13426 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13428 return resultObjPtr;
13431 /* [string] */
13432 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13434 int len;
13435 int opt_case = 1;
13436 int option;
13437 static const char * const options[] = {
13438 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13439 "map", "repeat", "reverse", "index", "first", "last", "cat",
13440 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13442 enum
13444 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13445 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13446 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13448 static const char * const nocase_options[] = {
13449 "-nocase", NULL
13451 static const char * const nocase_length_options[] = {
13452 "-nocase", "-length", NULL
13455 if (argc < 2) {
13456 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13457 return JIM_ERR;
13459 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13460 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13461 return JIM_ERR;
13463 switch (option) {
13464 case OPT_LENGTH:
13465 case OPT_BYTELENGTH:
13466 if (argc != 3) {
13467 Jim_WrongNumArgs(interp, 2, argv, "string");
13468 return JIM_ERR;
13470 if (option == OPT_LENGTH) {
13471 len = Jim_Utf8Length(interp, argv[2]);
13473 else {
13474 len = Jim_Length(argv[2]);
13476 Jim_SetResultInt(interp, len);
13477 return JIM_OK;
13479 case OPT_CAT:{
13480 Jim_Obj *objPtr;
13481 if (argc == 3) {
13482 /* optimise the one-arg case */
13483 objPtr = argv[2];
13485 else {
13486 int i;
13488 objPtr = Jim_NewStringObj(interp, "", 0);
13490 for (i = 2; i < argc; i++) {
13491 Jim_AppendObj(interp, objPtr, argv[i]);
13494 Jim_SetResult(interp, objPtr);
13495 return JIM_OK;
13498 case OPT_COMPARE:
13499 case OPT_EQUAL:
13501 /* n is the number of remaining option args */
13502 long opt_length = -1;
13503 int n = argc - 4;
13504 int i = 2;
13505 while (n > 0) {
13506 int subopt;
13507 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13508 JIM_ENUM_ABBREV) != JIM_OK) {
13509 badcompareargs:
13510 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13511 return JIM_ERR;
13513 if (subopt == 0) {
13514 /* -nocase */
13515 opt_case = 0;
13516 n--;
13518 else {
13519 /* -length */
13520 if (n < 2) {
13521 goto badcompareargs;
13523 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13524 return JIM_ERR;
13526 n -= 2;
13529 if (n) {
13530 goto badcompareargs;
13532 argv += argc - 2;
13533 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13534 /* Fast version - [string equal], case sensitive, no length */
13535 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13537 else {
13538 if (opt_length >= 0) {
13539 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13541 else {
13542 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13544 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13546 return JIM_OK;
13549 case OPT_MATCH:
13550 if (argc != 4 &&
13551 (argc != 5 ||
13552 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13553 JIM_ENUM_ABBREV) != JIM_OK)) {
13554 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13555 return JIM_ERR;
13557 if (opt_case == 0) {
13558 argv++;
13560 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13561 return JIM_OK;
13563 case OPT_MAP:{
13564 Jim_Obj *objPtr;
13566 if (argc != 4 &&
13567 (argc != 5 ||
13568 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13569 JIM_ENUM_ABBREV) != JIM_OK)) {
13570 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13571 return JIM_ERR;
13574 if (opt_case == 0) {
13575 argv++;
13577 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13578 if (objPtr == NULL) {
13579 return JIM_ERR;
13581 Jim_SetResult(interp, objPtr);
13582 return JIM_OK;
13585 case OPT_RANGE:
13586 case OPT_BYTERANGE:{
13587 Jim_Obj *objPtr;
13589 if (argc != 5) {
13590 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13591 return JIM_ERR;
13593 if (option == OPT_RANGE) {
13594 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13596 else
13598 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13601 if (objPtr == NULL) {
13602 return JIM_ERR;
13604 Jim_SetResult(interp, objPtr);
13605 return JIM_OK;
13608 case OPT_REPLACE:{
13609 Jim_Obj *objPtr;
13611 if (argc != 5 && argc != 6) {
13612 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13613 return JIM_ERR;
13615 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13616 if (objPtr == NULL) {
13617 return JIM_ERR;
13619 Jim_SetResult(interp, objPtr);
13620 return JIM_OK;
13624 case OPT_REPEAT:{
13625 Jim_Obj *objPtr;
13626 jim_wide count;
13628 if (argc != 4) {
13629 Jim_WrongNumArgs(interp, 2, argv, "string count");
13630 return JIM_ERR;
13632 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13633 return JIM_ERR;
13635 objPtr = Jim_NewStringObj(interp, "", 0);
13636 if (count > 0) {
13637 while (count--) {
13638 Jim_AppendObj(interp, objPtr, argv[2]);
13641 Jim_SetResult(interp, objPtr);
13642 return JIM_OK;
13645 case OPT_REVERSE:{
13646 char *buf, *p;
13647 const char *str;
13648 int len;
13649 int i;
13651 if (argc != 3) {
13652 Jim_WrongNumArgs(interp, 2, argv, "string");
13653 return JIM_ERR;
13656 str = Jim_GetString(argv[2], &len);
13657 buf = Jim_Alloc(len + 1);
13658 p = buf + len;
13659 *p = 0;
13660 for (i = 0; i < len; ) {
13661 int c;
13662 int l = utf8_tounicode(str, &c);
13663 memcpy(p - l, str, l);
13664 p -= l;
13665 i += l;
13666 str += l;
13668 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13669 return JIM_OK;
13672 case OPT_INDEX:{
13673 int idx;
13674 const char *str;
13676 if (argc != 4) {
13677 Jim_WrongNumArgs(interp, 2, argv, "string index");
13678 return JIM_ERR;
13680 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13681 return JIM_ERR;
13683 str = Jim_String(argv[2]);
13684 len = Jim_Utf8Length(interp, argv[2]);
13685 if (idx != INT_MIN && idx != INT_MAX) {
13686 idx = JimRelToAbsIndex(len, idx);
13688 if (idx < 0 || idx >= len || str == NULL) {
13689 Jim_SetResultString(interp, "", 0);
13691 else if (len == Jim_Length(argv[2])) {
13692 /* ASCII optimisation */
13693 Jim_SetResultString(interp, str + idx, 1);
13695 else {
13696 int c;
13697 int i = utf8_index(str, idx);
13698 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13700 return JIM_OK;
13703 case OPT_FIRST:
13704 case OPT_LAST:{
13705 int idx = 0, l1, l2;
13706 const char *s1, *s2;
13708 if (argc != 4 && argc != 5) {
13709 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13710 return JIM_ERR;
13712 s1 = Jim_String(argv[2]);
13713 s2 = Jim_String(argv[3]);
13714 l1 = Jim_Utf8Length(interp, argv[2]);
13715 l2 = Jim_Utf8Length(interp, argv[3]);
13716 if (argc == 5) {
13717 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13718 return JIM_ERR;
13720 idx = JimRelToAbsIndex(l2, idx);
13722 else if (option == OPT_LAST) {
13723 idx = l2;
13725 if (option == OPT_FIRST) {
13726 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13728 else {
13729 #ifdef JIM_UTF8
13730 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13731 #else
13732 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13733 #endif
13735 return JIM_OK;
13738 case OPT_TRIM:
13739 case OPT_TRIMLEFT:
13740 case OPT_TRIMRIGHT:{
13741 Jim_Obj *trimchars;
13743 if (argc != 3 && argc != 4) {
13744 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13745 return JIM_ERR;
13747 trimchars = (argc == 4 ? argv[3] : NULL);
13748 if (option == OPT_TRIM) {
13749 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13751 else if (option == OPT_TRIMLEFT) {
13752 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13754 else if (option == OPT_TRIMRIGHT) {
13755 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13757 return JIM_OK;
13760 case OPT_TOLOWER:
13761 case OPT_TOUPPER:
13762 case OPT_TOTITLE:
13763 if (argc != 3) {
13764 Jim_WrongNumArgs(interp, 2, argv, "string");
13765 return JIM_ERR;
13767 if (option == OPT_TOLOWER) {
13768 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13770 else if (option == OPT_TOUPPER) {
13771 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13773 else {
13774 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13776 return JIM_OK;
13778 case OPT_IS:
13779 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13780 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13782 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13783 return JIM_ERR;
13785 return JIM_OK;
13788 /* [time] */
13789 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13791 long i, count = 1;
13792 jim_wide start, elapsed;
13793 char buf[60];
13794 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13796 if (argc < 2) {
13797 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13798 return JIM_ERR;
13800 if (argc == 3) {
13801 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13802 return JIM_ERR;
13804 if (count < 0)
13805 return JIM_OK;
13806 i = count;
13807 start = JimClock();
13808 while (i-- > 0) {
13809 int retval;
13811 retval = Jim_EvalObj(interp, argv[1]);
13812 if (retval != JIM_OK) {
13813 return retval;
13816 elapsed = JimClock() - start;
13817 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13818 Jim_SetResultString(interp, buf, -1);
13819 return JIM_OK;
13822 /* [exit] */
13823 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13825 long exitCode = 0;
13827 if (argc > 2) {
13828 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13829 return JIM_ERR;
13831 if (argc == 2) {
13832 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13833 return JIM_ERR;
13835 interp->exitCode = exitCode;
13836 return JIM_EXIT;
13839 /* [catch] */
13840 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13842 int exitCode = 0;
13843 int i;
13844 int sig = 0;
13846 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13847 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13848 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13850 /* Reset the error code before catch.
13851 * Note that this is not strictly correct.
13853 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13855 for (i = 1; i < argc - 1; i++) {
13856 const char *arg = Jim_String(argv[i]);
13857 jim_wide option;
13858 int ignore;
13860 /* It's a pity we can't use Jim_GetEnum here :-( */
13861 if (strcmp(arg, "--") == 0) {
13862 i++;
13863 break;
13865 if (*arg != '-') {
13866 break;
13869 if (strncmp(arg, "-no", 3) == 0) {
13870 arg += 3;
13871 ignore = 1;
13873 else {
13874 arg++;
13875 ignore = 0;
13878 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13879 option = -1;
13881 if (option < 0) {
13882 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13884 if (option < 0) {
13885 goto wrongargs;
13888 if (ignore) {
13889 ignore_mask |= (1 << option);
13891 else {
13892 ignore_mask &= ~(1 << option);
13896 argc -= i;
13897 if (argc < 1 || argc > 3) {
13898 wrongargs:
13899 Jim_WrongNumArgs(interp, 1, argv,
13900 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13901 return JIM_ERR;
13903 argv += i;
13905 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13906 sig++;
13909 interp->signal_level += sig;
13910 if (Jim_CheckSignal(interp)) {
13911 /* If a signal is set, don't even try to execute the body */
13912 exitCode = JIM_SIGNAL;
13914 else {
13915 exitCode = Jim_EvalObj(interp, argv[0]);
13916 /* Don't want any caught error included in a later stack trace */
13917 interp->errorFlag = 0;
13919 interp->signal_level -= sig;
13921 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13922 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13923 /* Not caught, pass it up */
13924 return exitCode;
13927 if (sig && exitCode == JIM_SIGNAL) {
13928 /* Catch the signal at this level */
13929 if (interp->signal_set_result) {
13930 interp->signal_set_result(interp, interp->sigmask);
13932 else {
13933 Jim_SetResultInt(interp, interp->sigmask);
13935 interp->sigmask = 0;
13938 if (argc >= 2) {
13939 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13940 return JIM_ERR;
13942 if (argc == 3) {
13943 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13945 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13946 Jim_ListAppendElement(interp, optListObj,
13947 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13948 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13949 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13950 if (exitCode == JIM_ERR) {
13951 Jim_Obj *errorCode;
13952 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13953 -1));
13954 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13956 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13957 if (errorCode) {
13958 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13959 Jim_ListAppendElement(interp, optListObj, errorCode);
13962 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13963 return JIM_ERR;
13967 Jim_SetResultInt(interp, exitCode);
13968 return JIM_OK;
13971 #ifdef JIM_REFERENCES
13973 /* [ref] */
13974 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13976 if (argc != 3 && argc != 4) {
13977 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13978 return JIM_ERR;
13980 if (argc == 3) {
13981 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13983 else {
13984 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13986 return JIM_OK;
13989 /* [getref] */
13990 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13992 Jim_Reference *refPtr;
13994 if (argc != 2) {
13995 Jim_WrongNumArgs(interp, 1, argv, "reference");
13996 return JIM_ERR;
13998 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13999 return JIM_ERR;
14000 Jim_SetResult(interp, refPtr->objPtr);
14001 return JIM_OK;
14004 /* [setref] */
14005 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14007 Jim_Reference *refPtr;
14009 if (argc != 3) {
14010 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14011 return JIM_ERR;
14013 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14014 return JIM_ERR;
14015 Jim_IncrRefCount(argv[2]);
14016 Jim_DecrRefCount(interp, refPtr->objPtr);
14017 refPtr->objPtr = argv[2];
14018 Jim_SetResult(interp, argv[2]);
14019 return JIM_OK;
14022 /* [collect] */
14023 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14025 if (argc != 1) {
14026 Jim_WrongNumArgs(interp, 1, argv, "");
14027 return JIM_ERR;
14029 Jim_SetResultInt(interp, Jim_Collect(interp));
14031 /* Free all the freed objects. */
14032 while (interp->freeList) {
14033 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14034 Jim_Free(interp->freeList);
14035 interp->freeList = nextObjPtr;
14038 return JIM_OK;
14041 /* [finalize] reference ?newValue? */
14042 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14044 if (argc != 2 && argc != 3) {
14045 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14046 return JIM_ERR;
14048 if (argc == 2) {
14049 Jim_Obj *cmdNamePtr;
14051 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14052 return JIM_ERR;
14053 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14054 Jim_SetResult(interp, cmdNamePtr);
14056 else {
14057 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14058 return JIM_ERR;
14059 Jim_SetResult(interp, argv[2]);
14061 return JIM_OK;
14064 /* [info references] */
14065 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14067 Jim_Obj *listObjPtr;
14068 Jim_HashTableIterator htiter;
14069 Jim_HashEntry *he;
14071 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14073 JimInitHashTableIterator(&interp->references, &htiter);
14074 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14075 char buf[JIM_REFERENCE_SPACE + 1];
14076 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14077 const unsigned long *refId = he->key;
14079 JimFormatReference(buf, refPtr, *refId);
14080 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14082 Jim_SetResult(interp, listObjPtr);
14083 return JIM_OK;
14085 #endif
14087 /* [rename] */
14088 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14090 if (argc != 3) {
14091 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14092 return JIM_ERR;
14095 if (JimValidName(interp, "new procedure", argv[2])) {
14096 return JIM_ERR;
14099 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14102 #define JIM_DICTMATCH_VALUES 0x0001
14104 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14106 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14108 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14109 if (type & JIM_DICTMATCH_VALUES) {
14110 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14115 * Like JimHashtablePatternMatch, but for dictionaries.
14117 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14118 JimDictMatchCallbackType *callback, int type)
14120 Jim_HashEntry *he;
14121 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14123 /* Check for the non-pattern case. We can do this much more efficiently. */
14124 Jim_HashTableIterator htiter;
14125 JimInitHashTableIterator(ht, &htiter);
14126 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14127 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14128 callback(interp, listObjPtr, he, type);
14132 return listObjPtr;
14136 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14138 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14139 return JIM_ERR;
14141 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14142 return JIM_OK;
14145 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14147 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14148 return JIM_ERR;
14150 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14151 return JIM_OK;
14154 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14156 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14157 return -1;
14159 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14162 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14164 Jim_HashTable *ht;
14165 unsigned int i;
14167 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14168 return JIM_ERR;
14171 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14173 /* Note that this uses internal knowledge of the hash table */
14174 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14176 for (i = 0; i < ht->size; i++) {
14177 Jim_HashEntry *he = ht->table[i];
14179 if (he) {
14180 printf("%d: ", i);
14182 while (he) {
14183 printf(" %s", Jim_String(he->key));
14184 he = he->next;
14186 printf("\n");
14189 return JIM_OK;
14192 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14194 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14196 Jim_AppendString(interp, prefixObj, " ", 1);
14197 Jim_AppendString(interp, prefixObj, subcmd, -1);
14199 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14202 /* [dict] */
14203 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14205 Jim_Obj *objPtr;
14206 int option;
14207 static const char * const options[] = {
14208 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14209 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14210 "replace", "update", NULL
14212 enum
14214 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14215 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14216 OPT_REPLACE, OPT_UPDATE,
14219 if (argc < 2) {
14220 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14221 return JIM_ERR;
14224 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14225 return JIM_ERR;
14228 switch (option) {
14229 case OPT_GET:
14230 if (argc < 3) {
14231 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14232 return JIM_ERR;
14234 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14235 JIM_ERRMSG) != JIM_OK) {
14236 return JIM_ERR;
14238 Jim_SetResult(interp, objPtr);
14239 return JIM_OK;
14241 case OPT_SET:
14242 if (argc < 5) {
14243 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14244 return JIM_ERR;
14246 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14248 case OPT_EXISTS:
14249 if (argc < 4) {
14250 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14251 return JIM_ERR;
14253 else {
14254 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14255 if (rc < 0) {
14256 return JIM_ERR;
14258 Jim_SetResultBool(interp, rc == JIM_OK);
14259 return JIM_OK;
14262 case OPT_UNSET:
14263 if (argc < 4) {
14264 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14265 return JIM_ERR;
14267 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14268 return JIM_ERR;
14270 return JIM_OK;
14272 case OPT_KEYS:
14273 if (argc != 3 && argc != 4) {
14274 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14275 return JIM_ERR;
14277 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14279 case OPT_SIZE:
14280 if (argc != 3) {
14281 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14282 return JIM_ERR;
14284 else if (Jim_DictSize(interp, argv[2]) < 0) {
14285 return JIM_ERR;
14287 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14288 return JIM_OK;
14290 case OPT_MERGE:
14291 if (argc == 2) {
14292 return JIM_OK;
14294 if (Jim_DictSize(interp, argv[2]) < 0) {
14295 return JIM_ERR;
14297 /* Handle as ensemble */
14298 break;
14300 case OPT_UPDATE:
14301 if (argc < 6 || argc % 2) {
14302 /* Better error message */
14303 argc = 2;
14305 break;
14307 case OPT_CREATE:
14308 if (argc % 2) {
14309 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14310 return JIM_ERR;
14312 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14313 Jim_SetResult(interp, objPtr);
14314 return JIM_OK;
14316 case OPT_INFO:
14317 if (argc != 3) {
14318 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14319 return JIM_ERR;
14321 return Jim_DictInfo(interp, argv[2]);
14323 /* Handle command as an ensemble */
14324 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14327 /* [subst] */
14328 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14330 static const char * const options[] = {
14331 "-nobackslashes", "-nocommands", "-novariables", NULL
14333 enum
14334 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14335 int i;
14336 int flags = JIM_SUBST_FLAG;
14337 Jim_Obj *objPtr;
14339 if (argc < 2) {
14340 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14341 return JIM_ERR;
14343 for (i = 1; i < (argc - 1); i++) {
14344 int option;
14346 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14347 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14348 return JIM_ERR;
14350 switch (option) {
14351 case OPT_NOBACKSLASHES:
14352 flags |= JIM_SUBST_NOESC;
14353 break;
14354 case OPT_NOCOMMANDS:
14355 flags |= JIM_SUBST_NOCMD;
14356 break;
14357 case OPT_NOVARIABLES:
14358 flags |= JIM_SUBST_NOVAR;
14359 break;
14362 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14363 return JIM_ERR;
14365 Jim_SetResult(interp, objPtr);
14366 return JIM_OK;
14369 /* [info] */
14370 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14372 int cmd;
14373 Jim_Obj *objPtr;
14374 int mode = 0;
14376 static const char * const commands[] = {
14377 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14378 "vars", "version", "patchlevel", "complete", "args", "hostname",
14379 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14380 "references", "alias", NULL
14382 enum
14383 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14384 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14385 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14386 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14389 #ifdef jim_ext_namespace
14390 int nons = 0;
14392 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14393 /* This is for internal use only */
14394 argc--;
14395 argv++;
14396 nons = 1;
14398 #endif
14400 if (argc < 2) {
14401 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14402 return JIM_ERR;
14404 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14405 != JIM_OK) {
14406 return JIM_ERR;
14409 /* Test for the the most common commands first, just in case it makes a difference */
14410 switch (cmd) {
14411 case INFO_EXISTS:
14412 if (argc != 3) {
14413 Jim_WrongNumArgs(interp, 2, argv, "varName");
14414 return JIM_ERR;
14416 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14417 break;
14419 case INFO_ALIAS:{
14420 Jim_Cmd *cmdPtr;
14422 if (argc != 3) {
14423 Jim_WrongNumArgs(interp, 2, argv, "command");
14424 return JIM_ERR;
14426 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14427 return JIM_ERR;
14429 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14430 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14431 return JIM_ERR;
14433 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14434 return JIM_OK;
14437 case INFO_CHANNELS:
14438 mode++; /* JIM_CMDLIST_CHANNELS */
14439 #ifndef jim_ext_aio
14440 Jim_SetResultString(interp, "aio not enabled", -1);
14441 return JIM_ERR;
14442 #endif
14443 case INFO_PROCS:
14444 mode++; /* JIM_CMDLIST_PROCS */
14445 case INFO_COMMANDS:
14446 /* mode 0 => JIM_CMDLIST_COMMANDS */
14447 if (argc != 2 && argc != 3) {
14448 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14449 return JIM_ERR;
14451 #ifdef jim_ext_namespace
14452 if (!nons) {
14453 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14454 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14457 #endif
14458 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14459 break;
14461 case INFO_VARS:
14462 mode++; /* JIM_VARLIST_VARS */
14463 case INFO_LOCALS:
14464 mode++; /* JIM_VARLIST_LOCALS */
14465 case INFO_GLOBALS:
14466 /* mode 0 => JIM_VARLIST_GLOBALS */
14467 if (argc != 2 && argc != 3) {
14468 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14469 return JIM_ERR;
14471 #ifdef jim_ext_namespace
14472 if (!nons) {
14473 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14474 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14477 #endif
14478 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14479 break;
14481 case INFO_SCRIPT:
14482 if (argc != 2) {
14483 Jim_WrongNumArgs(interp, 2, argv, "");
14484 return JIM_ERR;
14486 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14487 break;
14489 case INFO_SOURCE:{
14490 jim_wide line;
14491 Jim_Obj *resObjPtr;
14492 Jim_Obj *fileNameObj;
14494 if (argc != 3 && argc != 5) {
14495 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14496 return JIM_ERR;
14498 if (argc == 5) {
14499 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14500 return JIM_ERR;
14502 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14503 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14505 else {
14506 if (argv[2]->typePtr == &sourceObjType) {
14507 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14508 line = argv[2]->internalRep.sourceValue.lineNumber;
14510 else if (argv[2]->typePtr == &scriptObjType) {
14511 ScriptObj *script = JimGetScript(interp, argv[2]);
14512 fileNameObj = script->fileNameObj;
14513 line = script->firstline;
14515 else {
14516 fileNameObj = interp->emptyObj;
14517 line = 1;
14519 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14520 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14521 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14523 Jim_SetResult(interp, resObjPtr);
14524 break;
14527 case INFO_STACKTRACE:
14528 Jim_SetResult(interp, interp->stackTrace);
14529 break;
14531 case INFO_LEVEL:
14532 case INFO_FRAME:
14533 switch (argc) {
14534 case 2:
14535 Jim_SetResultInt(interp, interp->framePtr->level);
14536 break;
14538 case 3:
14539 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14540 return JIM_ERR;
14542 Jim_SetResult(interp, objPtr);
14543 break;
14545 default:
14546 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14547 return JIM_ERR;
14549 break;
14551 case INFO_BODY:
14552 case INFO_STATICS:
14553 case INFO_ARGS:{
14554 Jim_Cmd *cmdPtr;
14556 if (argc != 3) {
14557 Jim_WrongNumArgs(interp, 2, argv, "procname");
14558 return JIM_ERR;
14560 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14561 return JIM_ERR;
14563 if (!cmdPtr->isproc) {
14564 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14565 return JIM_ERR;
14567 switch (cmd) {
14568 case INFO_BODY:
14569 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14570 break;
14571 case INFO_ARGS:
14572 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14573 break;
14574 case INFO_STATICS:
14575 if (cmdPtr->u.proc.staticVars) {
14576 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14577 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14578 NULL, JimVariablesMatch, mode));
14580 break;
14582 break;
14585 case INFO_VERSION:
14586 case INFO_PATCHLEVEL:{
14587 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14589 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14590 Jim_SetResultString(interp, buf, -1);
14591 break;
14594 case INFO_COMPLETE:
14595 if (argc != 3 && argc != 4) {
14596 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14597 return JIM_ERR;
14599 else {
14600 int len;
14601 const char *s = Jim_GetString(argv[2], &len);
14602 char missing;
14604 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14605 if (missing != ' ' && argc == 4) {
14606 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14609 break;
14611 case INFO_HOSTNAME:
14612 /* Redirect to os.gethostname if it exists */
14613 return Jim_Eval(interp, "os.gethostname");
14615 case INFO_NAMEOFEXECUTABLE:
14616 /* Redirect to Tcl proc */
14617 return Jim_Eval(interp, "{info nameofexecutable}");
14619 case INFO_RETURNCODES:
14620 if (argc == 2) {
14621 int i;
14622 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14624 for (i = 0; jimReturnCodes[i]; i++) {
14625 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14626 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14627 jimReturnCodes[i], -1));
14630 Jim_SetResult(interp, listObjPtr);
14632 else if (argc == 3) {
14633 long code;
14634 const char *name;
14636 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14637 return JIM_ERR;
14639 name = Jim_ReturnCode(code);
14640 if (*name == '?') {
14641 Jim_SetResultInt(interp, code);
14643 else {
14644 Jim_SetResultString(interp, name, -1);
14647 else {
14648 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14649 return JIM_ERR;
14651 break;
14652 case INFO_REFERENCES:
14653 #ifdef JIM_REFERENCES
14654 return JimInfoReferences(interp, argc, argv);
14655 #else
14656 Jim_SetResultString(interp, "not supported", -1);
14657 return JIM_ERR;
14658 #endif
14660 return JIM_OK;
14663 /* [exists] */
14664 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14666 Jim_Obj *objPtr;
14667 int result = 0;
14669 static const char * const options[] = {
14670 "-command", "-proc", "-alias", "-var", NULL
14672 enum
14674 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14676 int option;
14678 if (argc == 2) {
14679 option = OPT_VAR;
14680 objPtr = argv[1];
14682 else if (argc == 3) {
14683 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14684 return JIM_ERR;
14686 objPtr = argv[2];
14688 else {
14689 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14690 return JIM_ERR;
14693 if (option == OPT_VAR) {
14694 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14696 else {
14697 /* Now different kinds of commands */
14698 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14700 if (cmd) {
14701 switch (option) {
14702 case OPT_COMMAND:
14703 result = 1;
14704 break;
14706 case OPT_ALIAS:
14707 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14708 break;
14710 case OPT_PROC:
14711 result = cmd->isproc;
14712 break;
14716 Jim_SetResultBool(interp, result);
14717 return JIM_OK;
14720 /* [split] */
14721 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14723 const char *str, *splitChars, *noMatchStart;
14724 int splitLen, strLen;
14725 Jim_Obj *resObjPtr;
14726 int c;
14727 int len;
14729 if (argc != 2 && argc != 3) {
14730 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14731 return JIM_ERR;
14734 str = Jim_GetString(argv[1], &len);
14735 if (len == 0) {
14736 return JIM_OK;
14738 strLen = Jim_Utf8Length(interp, argv[1]);
14740 /* Init */
14741 if (argc == 2) {
14742 splitChars = " \n\t\r";
14743 splitLen = 4;
14745 else {
14746 splitChars = Jim_String(argv[2]);
14747 splitLen = Jim_Utf8Length(interp, argv[2]);
14750 noMatchStart = str;
14751 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14753 /* Split */
14754 if (splitLen) {
14755 Jim_Obj *objPtr;
14756 while (strLen--) {
14757 const char *sc = splitChars;
14758 int scLen = splitLen;
14759 int sl = utf8_tounicode(str, &c);
14760 while (scLen--) {
14761 int pc;
14762 sc += utf8_tounicode(sc, &pc);
14763 if (c == pc) {
14764 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14765 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14766 noMatchStart = str + sl;
14767 break;
14770 str += sl;
14772 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14773 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14775 else {
14776 /* This handles the special case of splitchars eq {}
14777 * Optimise by sharing common (ASCII) characters
14779 Jim_Obj **commonObj = NULL;
14780 #define NUM_COMMON (128 - 9)
14781 while (strLen--) {
14782 int n = utf8_tounicode(str, &c);
14783 #ifdef JIM_OPTIMIZATION
14784 if (c >= 9 && c < 128) {
14785 /* Common ASCII char. Note that 9 is the tab character */
14786 c -= 9;
14787 if (!commonObj) {
14788 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14789 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14791 if (!commonObj[c]) {
14792 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14794 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14795 str++;
14796 continue;
14798 #endif
14799 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14800 str += n;
14802 Jim_Free(commonObj);
14805 Jim_SetResult(interp, resObjPtr);
14806 return JIM_OK;
14809 /* [join] */
14810 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14812 const char *joinStr;
14813 int joinStrLen;
14815 if (argc != 2 && argc != 3) {
14816 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14817 return JIM_ERR;
14819 /* Init */
14820 if (argc == 2) {
14821 joinStr = " ";
14822 joinStrLen = 1;
14824 else {
14825 joinStr = Jim_GetString(argv[2], &joinStrLen);
14827 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14828 return JIM_OK;
14831 /* [format] */
14832 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14834 Jim_Obj *objPtr;
14836 if (argc < 2) {
14837 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14838 return JIM_ERR;
14840 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14841 if (objPtr == NULL)
14842 return JIM_ERR;
14843 Jim_SetResult(interp, objPtr);
14844 return JIM_OK;
14847 /* [scan] */
14848 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14850 Jim_Obj *listPtr, **outVec;
14851 int outc, i;
14853 if (argc < 3) {
14854 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14855 return JIM_ERR;
14857 if (argv[2]->typePtr != &scanFmtStringObjType)
14858 SetScanFmtFromAny(interp, argv[2]);
14859 if (FormatGetError(argv[2]) != 0) {
14860 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14861 return JIM_ERR;
14863 if (argc > 3) {
14864 int maxPos = FormatGetMaxPos(argv[2]);
14865 int count = FormatGetCnvCount(argv[2]);
14867 if (maxPos > argc - 3) {
14868 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14869 return JIM_ERR;
14871 else if (count > argc - 3) {
14872 Jim_SetResultString(interp, "different numbers of variable names and "
14873 "field specifiers", -1);
14874 return JIM_ERR;
14876 else if (count < argc - 3) {
14877 Jim_SetResultString(interp, "variable is not assigned by any "
14878 "conversion specifiers", -1);
14879 return JIM_ERR;
14882 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14883 if (listPtr == 0)
14884 return JIM_ERR;
14885 if (argc > 3) {
14886 int rc = JIM_OK;
14887 int count = 0;
14889 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14890 int len = Jim_ListLength(interp, listPtr);
14892 if (len != 0) {
14893 JimListGetElements(interp, listPtr, &outc, &outVec);
14894 for (i = 0; i < outc; ++i) {
14895 if (Jim_Length(outVec[i]) > 0) {
14896 ++count;
14897 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14898 rc = JIM_ERR;
14903 Jim_FreeNewObj(interp, listPtr);
14905 else {
14906 count = -1;
14908 if (rc == JIM_OK) {
14909 Jim_SetResultInt(interp, count);
14911 return rc;
14913 else {
14914 if (listPtr == (Jim_Obj *)EOF) {
14915 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14916 return JIM_OK;
14918 Jim_SetResult(interp, listPtr);
14920 return JIM_OK;
14923 /* [error] */
14924 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14926 if (argc != 2 && argc != 3) {
14927 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14928 return JIM_ERR;
14930 Jim_SetResult(interp, argv[1]);
14931 if (argc == 3) {
14932 JimSetStackTrace(interp, argv[2]);
14933 return JIM_ERR;
14935 interp->addStackTrace++;
14936 return JIM_ERR;
14939 /* [lrange] */
14940 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14942 Jim_Obj *objPtr;
14944 if (argc != 4) {
14945 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14946 return JIM_ERR;
14948 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14949 return JIM_ERR;
14950 Jim_SetResult(interp, objPtr);
14951 return JIM_OK;
14954 /* [lrepeat] */
14955 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14957 Jim_Obj *objPtr;
14958 long count;
14960 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14961 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14962 return JIM_ERR;
14965 if (count == 0 || argc == 2) {
14966 return JIM_OK;
14969 argc -= 2;
14970 argv += 2;
14972 objPtr = Jim_NewListObj(interp, argv, argc);
14973 while (--count) {
14974 ListInsertElements(objPtr, -1, argc, argv);
14977 Jim_SetResult(interp, objPtr);
14978 return JIM_OK;
14981 char **Jim_GetEnviron(void)
14983 #if defined(HAVE__NSGETENVIRON)
14984 return *_NSGetEnviron();
14985 #else
14986 #if !defined(NO_ENVIRON_EXTERN)
14987 extern char **environ;
14988 #endif
14990 return environ;
14991 #endif
14994 void Jim_SetEnviron(char **env)
14996 #if defined(HAVE__NSGETENVIRON)
14997 *_NSGetEnviron() = env;
14998 #else
14999 #if !defined(NO_ENVIRON_EXTERN)
15000 extern char **environ;
15001 #endif
15003 environ = env;
15004 #endif
15007 /* [env] */
15008 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15010 const char *key;
15011 const char *val;
15013 if (argc == 1) {
15014 char **e = Jim_GetEnviron();
15016 int i;
15017 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15019 for (i = 0; e[i]; i++) {
15020 const char *equals = strchr(e[i], '=');
15022 if (equals) {
15023 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15024 equals - e[i]));
15025 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15029 Jim_SetResult(interp, listObjPtr);
15030 return JIM_OK;
15033 if (argc < 2) {
15034 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15035 return JIM_ERR;
15037 key = Jim_String(argv[1]);
15038 val = getenv(key);
15039 if (val == NULL) {
15040 if (argc < 3) {
15041 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15042 return JIM_ERR;
15044 val = Jim_String(argv[2]);
15046 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15047 return JIM_OK;
15050 /* [source] */
15051 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15053 int retval;
15055 if (argc != 2) {
15056 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15057 return JIM_ERR;
15059 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15060 if (retval == JIM_RETURN)
15061 return JIM_OK;
15062 return retval;
15065 /* [lreverse] */
15066 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15068 Jim_Obj *revObjPtr, **ele;
15069 int len;
15071 if (argc != 2) {
15072 Jim_WrongNumArgs(interp, 1, argv, "list");
15073 return JIM_ERR;
15075 JimListGetElements(interp, argv[1], &len, &ele);
15076 len--;
15077 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15078 while (len >= 0)
15079 ListAppendElement(revObjPtr, ele[len--]);
15080 Jim_SetResult(interp, revObjPtr);
15081 return JIM_OK;
15084 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15086 jim_wide len;
15088 if (step == 0)
15089 return -1;
15090 if (start == end)
15091 return 0;
15092 else if (step > 0 && start > end)
15093 return -1;
15094 else if (step < 0 && end > start)
15095 return -1;
15096 len = end - start;
15097 if (len < 0)
15098 len = -len; /* abs(len) */
15099 if (step < 0)
15100 step = -step; /* abs(step) */
15101 len = 1 + ((len - 1) / step);
15102 /* We can truncate safely to INT_MAX, the range command
15103 * will always return an error for a such long range
15104 * because Tcl lists can't be so long. */
15105 if (len > INT_MAX)
15106 len = INT_MAX;
15107 return (int)((len < 0) ? -1 : len);
15110 /* [range] */
15111 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15113 jim_wide start = 0, end, step = 1;
15114 int len, i;
15115 Jim_Obj *objPtr;
15117 if (argc < 2 || argc > 4) {
15118 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15119 return JIM_ERR;
15121 if (argc == 2) {
15122 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15123 return JIM_ERR;
15125 else {
15126 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15127 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15128 return JIM_ERR;
15129 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15130 return JIM_ERR;
15132 if ((len = JimRangeLen(start, end, step)) == -1) {
15133 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15134 return JIM_ERR;
15136 objPtr = Jim_NewListObj(interp, NULL, 0);
15137 for (i = 0; i < len; i++)
15138 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15139 Jim_SetResult(interp, objPtr);
15140 return JIM_OK;
15143 /* [rand] */
15144 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15146 jim_wide min = 0, max = 0, len, maxMul;
15148 if (argc < 1 || argc > 3) {
15149 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15150 return JIM_ERR;
15152 if (argc == 1) {
15153 max = JIM_WIDE_MAX;
15154 } else if (argc == 2) {
15155 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15156 return JIM_ERR;
15157 } else if (argc == 3) {
15158 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15159 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15160 return JIM_ERR;
15162 len = max-min;
15163 if (len < 0) {
15164 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15165 return JIM_ERR;
15167 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15168 while (1) {
15169 jim_wide r;
15171 JimRandomBytes(interp, &r, sizeof(jim_wide));
15172 if (r < 0 || r >= maxMul) continue;
15173 r = (len == 0) ? 0 : r%len;
15174 Jim_SetResultInt(interp, min+r);
15175 return JIM_OK;
15179 static const struct {
15180 const char *name;
15181 Jim_CmdProc *cmdProc;
15182 } Jim_CoreCommandsTable[] = {
15183 {"alias", Jim_AliasCoreCommand},
15184 {"set", Jim_SetCoreCommand},
15185 {"unset", Jim_UnsetCoreCommand},
15186 {"puts", Jim_PutsCoreCommand},
15187 {"+", Jim_AddCoreCommand},
15188 {"*", Jim_MulCoreCommand},
15189 {"-", Jim_SubCoreCommand},
15190 {"/", Jim_DivCoreCommand},
15191 {"incr", Jim_IncrCoreCommand},
15192 {"while", Jim_WhileCoreCommand},
15193 {"loop", Jim_LoopCoreCommand},
15194 {"for", Jim_ForCoreCommand},
15195 {"foreach", Jim_ForeachCoreCommand},
15196 {"lmap", Jim_LmapCoreCommand},
15197 {"lassign", Jim_LassignCoreCommand},
15198 {"if", Jim_IfCoreCommand},
15199 {"switch", Jim_SwitchCoreCommand},
15200 {"list", Jim_ListCoreCommand},
15201 {"lindex", Jim_LindexCoreCommand},
15202 {"lset", Jim_LsetCoreCommand},
15203 {"lsearch", Jim_LsearchCoreCommand},
15204 {"llength", Jim_LlengthCoreCommand},
15205 {"lappend", Jim_LappendCoreCommand},
15206 {"linsert", Jim_LinsertCoreCommand},
15207 {"lreplace", Jim_LreplaceCoreCommand},
15208 {"lsort", Jim_LsortCoreCommand},
15209 {"append", Jim_AppendCoreCommand},
15210 {"debug", Jim_DebugCoreCommand},
15211 {"eval", Jim_EvalCoreCommand},
15212 {"uplevel", Jim_UplevelCoreCommand},
15213 {"expr", Jim_ExprCoreCommand},
15214 {"break", Jim_BreakCoreCommand},
15215 {"continue", Jim_ContinueCoreCommand},
15216 {"proc", Jim_ProcCoreCommand},
15217 {"concat", Jim_ConcatCoreCommand},
15218 {"return", Jim_ReturnCoreCommand},
15219 {"upvar", Jim_UpvarCoreCommand},
15220 {"global", Jim_GlobalCoreCommand},
15221 {"string", Jim_StringCoreCommand},
15222 {"time", Jim_TimeCoreCommand},
15223 {"exit", Jim_ExitCoreCommand},
15224 {"catch", Jim_CatchCoreCommand},
15225 #ifdef JIM_REFERENCES
15226 {"ref", Jim_RefCoreCommand},
15227 {"getref", Jim_GetrefCoreCommand},
15228 {"setref", Jim_SetrefCoreCommand},
15229 {"finalize", Jim_FinalizeCoreCommand},
15230 {"collect", Jim_CollectCoreCommand},
15231 #endif
15232 {"rename", Jim_RenameCoreCommand},
15233 {"dict", Jim_DictCoreCommand},
15234 {"subst", Jim_SubstCoreCommand},
15235 {"info", Jim_InfoCoreCommand},
15236 {"exists", Jim_ExistsCoreCommand},
15237 {"split", Jim_SplitCoreCommand},
15238 {"join", Jim_JoinCoreCommand},
15239 {"format", Jim_FormatCoreCommand},
15240 {"scan", Jim_ScanCoreCommand},
15241 {"error", Jim_ErrorCoreCommand},
15242 {"lrange", Jim_LrangeCoreCommand},
15243 {"lrepeat", Jim_LrepeatCoreCommand},
15244 {"env", Jim_EnvCoreCommand},
15245 {"source", Jim_SourceCoreCommand},
15246 {"lreverse", Jim_LreverseCoreCommand},
15247 {"range", Jim_RangeCoreCommand},
15248 {"rand", Jim_RandCoreCommand},
15249 {"tailcall", Jim_TailcallCoreCommand},
15250 {"local", Jim_LocalCoreCommand},
15251 {"upcall", Jim_UpcallCoreCommand},
15252 {"apply", Jim_ApplyCoreCommand},
15253 {NULL, NULL},
15256 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15258 int i = 0;
15260 while (Jim_CoreCommandsTable[i].name != NULL) {
15261 Jim_CreateCommand(interp,
15262 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15263 i++;
15267 /* -----------------------------------------------------------------------------
15268 * Interactive prompt
15269 * ---------------------------------------------------------------------------*/
15270 void Jim_MakeErrorMessage(Jim_Interp *interp)
15272 Jim_Obj *argv[2];
15274 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15275 argv[1] = interp->result;
15277 Jim_EvalObjVector(interp, 2, argv);
15280 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15281 const char *prefix, const char *const *tablePtr, const char *name)
15283 int count;
15284 char **tablePtrSorted;
15285 int i;
15287 for (count = 0; tablePtr[count]; count++) {
15290 if (name == NULL) {
15291 name = "option";
15294 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15295 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15296 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15297 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15298 for (i = 0; i < count; i++) {
15299 if (i + 1 == count && count > 1) {
15300 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15302 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15303 if (i + 1 != count) {
15304 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15307 Jim_Free(tablePtrSorted);
15310 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15311 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15313 const char *bad = "bad ";
15314 const char *const *entryPtr = NULL;
15315 int i;
15316 int match = -1;
15317 int arglen;
15318 const char *arg = Jim_GetString(objPtr, &arglen);
15320 *indexPtr = -1;
15322 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15323 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15324 /* Found an exact match */
15325 *indexPtr = i;
15326 return JIM_OK;
15328 if (flags & JIM_ENUM_ABBREV) {
15329 /* Accept an unambiguous abbreviation.
15330 * Note that '-' doesnt' consitute a valid abbreviation
15332 if (strncmp(arg, *entryPtr, arglen) == 0) {
15333 if (*arg == '-' && arglen == 1) {
15334 break;
15336 if (match >= 0) {
15337 bad = "ambiguous ";
15338 goto ambiguous;
15340 match = i;
15345 /* If we had an unambiguous partial match */
15346 if (match >= 0) {
15347 *indexPtr = match;
15348 return JIM_OK;
15351 ambiguous:
15352 if (flags & JIM_ERRMSG) {
15353 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15355 return JIM_ERR;
15358 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15360 int i;
15362 for (i = 0; i < (int)len; i++) {
15363 if (array[i] && strcmp(array[i], name) == 0) {
15364 return i;
15367 return -1;
15370 int Jim_IsDict(Jim_Obj *objPtr)
15372 return objPtr->typePtr == &dictObjType;
15375 int Jim_IsList(Jim_Obj *objPtr)
15377 return objPtr->typePtr == &listObjType;
15381 * Very simple printf-like formatting, designed for error messages.
15383 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15384 * The resulting string is created and set as the result.
15386 * Each '%s' should correspond to a regular string parameter.
15387 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15388 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15390 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15392 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15394 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15396 /* Initial space needed */
15397 int len = strlen(format);
15398 int extra = 0;
15399 int n = 0;
15400 const char *params[5];
15401 char *buf;
15402 va_list args;
15403 int i;
15405 va_start(args, format);
15407 for (i = 0; i < len && n < 5; i++) {
15408 int l;
15410 if (strncmp(format + i, "%s", 2) == 0) {
15411 params[n] = va_arg(args, char *);
15413 l = strlen(params[n]);
15415 else if (strncmp(format + i, "%#s", 3) == 0) {
15416 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15418 params[n] = Jim_GetString(objPtr, &l);
15420 else {
15421 if (format[i] == '%') {
15422 i++;
15424 continue;
15426 n++;
15427 extra += l;
15430 len += extra;
15431 buf = Jim_Alloc(len + 1);
15432 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15434 va_end(args);
15436 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15439 /* stubs */
15440 #ifndef jim_ext_package
15441 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15443 return JIM_OK;
15445 #endif
15446 #ifndef jim_ext_aio
15447 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15449 Jim_SetResultString(interp, "aio not enabled", -1);
15450 return NULL;
15452 #endif
15456 * Local Variables: ***
15457 * c-basic-offset: 4 ***
15458 * tab-width: 4 ***
15459 * End: ***