add support for [info source ?filename line?]
[jimtcl.git] / jim.c
blobbe5406a5ea9b816234f6e97e6678ba4189c23eb1
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, '{' if braces incomplete, '"' if quotes 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 the length of the 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 int 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; /* Line number of the current line */
3292 } ScriptObj;
3294 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3296 int i;
3297 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3299 if (--script->inUse != 0)
3300 return;
3301 for (i = 0; i < script->len; i++) {
3302 Jim_DecrRefCount(interp, script->token[i].objPtr);
3304 Jim_Free(script->token);
3305 Jim_DecrRefCount(interp, script->fileNameObj);
3306 Jim_Free(script);
3309 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3311 JIM_NOTUSED(interp);
3312 JIM_NOTUSED(srcPtr);
3314 /* Just return a simple string. We don't try to preserve the source info
3315 * since in practice scripts are never duplicated
3317 dupPtr->typePtr = NULL;
3320 /* A simple parse token.
3321 * As the script is parsed, the created tokens point into the script string rep.
3323 typedef struct
3325 const char *token; /* Pointer to the start of the token */
3326 int len; /* Length of this token */
3327 int type; /* Token type */
3328 int line; /* Line number */
3329 } ParseToken;
3331 /* A list of parsed tokens representing a script.
3332 * Tokens are added to this list as the script is parsed.
3333 * It grows as needed.
3335 typedef struct
3337 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3338 ParseToken *list; /* Array of tokens */
3339 int size; /* Current size of the list */
3340 int count; /* Number of entries used */
3341 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3342 } ParseTokenList;
3344 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3346 tokenlist->list = tokenlist->static_list;
3347 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3348 tokenlist->count = 0;
3351 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3353 if (tokenlist->list != tokenlist->static_list) {
3354 Jim_Free(tokenlist->list);
3359 * Adds the new token to the tokenlist.
3360 * The token has the given length, type and line number.
3361 * The token list is resized as necessary.
3363 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3364 int line)
3366 ParseToken *t;
3368 if (tokenlist->count == tokenlist->size) {
3369 /* Resize the list */
3370 tokenlist->size *= 2;
3371 if (tokenlist->list != tokenlist->static_list) {
3372 tokenlist->list =
3373 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3375 else {
3376 /* The list needs to become allocated */
3377 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3378 memcpy(tokenlist->list, tokenlist->static_list,
3379 tokenlist->count * sizeof(*tokenlist->list));
3382 t = &tokenlist->list[tokenlist->count++];
3383 t->token = token;
3384 t->len = len;
3385 t->type = type;
3386 t->line = line;
3389 /* Counts the number of adjoining non-separator tokens.
3391 * Returns -ve if the first token is the expansion
3392 * operator (in which case the count doesn't include
3393 * that token).
3395 static int JimCountWordTokens(ParseToken *t)
3397 int expand = 1;
3398 int count = 0;
3400 /* Is the first word {*} or {expand}? */
3401 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3402 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3403 /* Create an expand token */
3404 expand = -1;
3405 t++;
3409 /* Now count non-separator words */
3410 while (!TOKEN_IS_SEP(t->type)) {
3411 t++;
3412 count++;
3415 return count * expand;
3419 * Create a script/subst object from the given token.
3421 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3423 Jim_Obj *objPtr;
3425 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3426 /* Convert backlash escapes. The result will never be longer than the original */
3427 int len = t->len;
3428 char *str = Jim_Alloc(len + 1);
3429 len = JimEscape(str, t->token, len);
3430 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3432 else {
3433 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3434 * with a single space.
3436 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3438 return objPtr;
3442 * Takes a tokenlist and creates the allocated list of script tokens
3443 * in script->token, of length script->len.
3445 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3446 * as required.
3448 * Also sets script->line to the line number of the first token
3450 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3451 ParseTokenList *tokenlist)
3453 int i;
3454 struct ScriptToken *token;
3455 /* Number of tokens so far for the current command */
3456 int lineargs = 0;
3457 /* This is the first token for the current command */
3458 ScriptToken *linefirst;
3459 int count;
3460 int linenr;
3462 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3463 printf("==== Tokens ====\n");
3464 for (i = 0; i < tokenlist->count; i++) {
3465 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3466 tokenlist->list[i].len, tokenlist->list[i].token);
3468 #endif
3470 /* May need up to one extra script token for each EOL in the worst case */
3471 count = tokenlist->count;
3472 for (i = 0; i < tokenlist->count; i++) {
3473 if (tokenlist->list[i].type == JIM_TT_EOL) {
3474 count++;
3477 linenr = script->firstline = tokenlist->list[0].line;
3479 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3481 /* This is the first token for the current command */
3482 linefirst = token++;
3484 for (i = 0; i < tokenlist->count; ) {
3485 /* Look ahead to find out how many tokens make up the next word */
3486 int wordtokens;
3488 /* Skip any leading separators */
3489 while (tokenlist->list[i].type == JIM_TT_SEP) {
3490 i++;
3493 wordtokens = JimCountWordTokens(tokenlist->list + i);
3495 if (wordtokens == 0) {
3496 /* None, so at end of line */
3497 if (lineargs) {
3498 linefirst->type = JIM_TT_LINE;
3499 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3500 Jim_IncrRefCount(linefirst->objPtr);
3502 /* Reset for new line */
3503 lineargs = 0;
3504 linefirst = token++;
3506 i++;
3507 continue;
3509 else if (wordtokens != 1) {
3510 /* More than 1, or {*}, so insert a WORD token */
3511 token->type = JIM_TT_WORD;
3512 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3513 Jim_IncrRefCount(token->objPtr);
3514 token++;
3515 if (wordtokens < 0) {
3516 /* Skip the expand token */
3517 i++;
3518 wordtokens = -wordtokens - 1;
3519 lineargs--;
3523 if (lineargs == 0) {
3524 /* First real token on the line, so record the line number */
3525 linenr = tokenlist->list[i].line;
3527 lineargs++;
3529 /* Add each non-separator word token to the line */
3530 while (wordtokens--) {
3531 const ParseToken *t = &tokenlist->list[i++];
3533 token->type = t->type;
3534 token->objPtr = JimMakeScriptObj(interp, t);
3535 Jim_IncrRefCount(token->objPtr);
3537 /* Every object is initially a string of type 'source', but the
3538 * internal type may be specialized during execution of the
3539 * script. */
3540 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3541 token++;
3545 if (lineargs == 0) {
3546 token--;
3549 script->len = token - script->token;
3551 JimPanic((script->len >= count, "allocated script array is too short"));
3553 #ifdef DEBUG_SHOW_SCRIPT
3554 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3555 for (i = 0; i < script->len; i++) {
3556 const ScriptToken *t = &script->token[i];
3557 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3559 #endif
3564 * Sets an appropriate error message for a missing script/expression terminator.
3566 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3568 * Note that a trailing backslash is not considered to be an error.
3570 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3572 const char *msg;
3574 switch (ch) {
3575 case '\\':
3576 case ' ':
3577 return JIM_OK;
3579 case '[':
3580 msg = "unmatched \"[\"";
3581 break;
3582 case '{':
3583 msg = "missing close-brace";
3584 break;
3585 case '"':
3586 default:
3587 msg = "missing quote";
3588 break;
3591 Jim_SetResultString(interp, msg, -1);
3592 return JIM_ERR;
3596 * Similar to ScriptObjAddTokens(), but for subst objects.
3598 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3599 ParseTokenList *tokenlist)
3601 int i;
3602 struct ScriptToken *token;
3604 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3606 for (i = 0; i < tokenlist->count; i++) {
3607 const ParseToken *t = &tokenlist->list[i];
3609 /* Create a token for 't' */
3610 token->type = t->type;
3611 token->objPtr = JimMakeScriptObj(interp, t);
3612 Jim_IncrRefCount(token->objPtr);
3613 token++;
3616 script->len = i;
3619 /* This method takes the string representation of an object
3620 * as a Tcl script, and generates the pre-parsed internal representation
3621 * of the script.
3623 * On parse error, sets an error message and returns JIM_ERR
3624 * (Note: the object is still converted to a script, even if an error occurs)
3626 static int JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3628 int scriptTextLen;
3629 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3630 struct JimParserCtx parser;
3631 struct ScriptObj *script;
3632 ParseTokenList tokenlist;
3633 int line = 1;
3634 int retcode = JIM_OK;
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 retcode = JimParseCheckMissing(interp, parser.missing.ch);
3653 /* Add a final EOF token */
3654 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3656 /* Create the "real" script tokens from the parsed tokens */
3657 script = Jim_Alloc(sizeof(*script));
3658 memset(script, 0, sizeof(*script));
3659 script->inUse = 1;
3660 if (objPtr->typePtr == &sourceObjType) {
3661 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3663 else {
3664 script->fileNameObj = interp->emptyObj;
3666 script->linenr = parser.missing.line;
3667 Jim_IncrRefCount(script->fileNameObj);
3669 ScriptObjAddTokens(interp, script, &tokenlist);
3671 /* No longer need the token list */
3672 ScriptTokenListFree(&tokenlist);
3674 /* Free the old internal rep and set the new one. */
3675 Jim_FreeIntRep(interp, objPtr);
3676 Jim_SetIntRepPtr(objPtr, script);
3677 objPtr->typePtr = &scriptObjType;
3679 return retcode;
3683 * Returns NULL if the script failed to parse and leaves
3684 * an error message in the interp result.
3686 * Otherwise returns a parsed script object.
3687 * (Note: the object is still converted to a script, even if an error occurs)
3689 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3691 if (objPtr == interp->emptyObj) {
3692 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3693 objPtr = interp->nullScriptObj;
3696 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3697 if (JimSetScriptFromAny(interp, objPtr) == JIM_ERR) {
3698 return NULL;
3701 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3704 /* -----------------------------------------------------------------------------
3705 * Commands
3706 * ---------------------------------------------------------------------------*/
3707 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3709 cmdPtr->inUse++;
3712 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3714 if (--cmdPtr->inUse == 0) {
3715 if (cmdPtr->isproc) {
3716 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3717 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3718 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3719 if (cmdPtr->u.proc.staticVars) {
3720 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3721 Jim_Free(cmdPtr->u.proc.staticVars);
3724 else {
3725 /* native (C) */
3726 if (cmdPtr->u.native.delProc) {
3727 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3730 if (cmdPtr->prevCmd) {
3731 /* Delete any pushed command too */
3732 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3734 Jim_Free(cmdPtr);
3738 /* Variables HashTable Type.
3740 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3743 /* Variables HashTable Type.
3745 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3746 static void JimVariablesHTValDestructor(void *interp, void *val)
3748 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3749 Jim_Free(val);
3752 static const Jim_HashTableType JimVariablesHashTableType = {
3753 JimStringCopyHTHashFunction, /* hash function */
3754 JimStringCopyHTDup, /* key dup */
3755 NULL, /* val dup */
3756 JimStringCopyHTKeyCompare, /* key compare */
3757 JimStringCopyHTKeyDestructor, /* key destructor */
3758 JimVariablesHTValDestructor /* val destructor */
3761 /* Commands HashTable Type.
3763 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3765 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3767 JimDecrCmdRefCount(interp, val);
3770 static const Jim_HashTableType JimCommandsHashTableType = {
3771 JimStringCopyHTHashFunction, /* hash function */
3772 JimStringCopyHTDup, /* key dup */
3773 NULL, /* val dup */
3774 JimStringCopyHTKeyCompare, /* key compare */
3775 JimStringCopyHTKeyDestructor, /* key destructor */
3776 JimCommandsHT_ValDestructor /* val destructor */
3779 /* ------------------------- Commands related functions --------------------- */
3781 #ifdef jim_ext_namespace
3783 * Returns the "unscoped" version of the given namespace.
3784 * That is, the fully qualfied name without the leading ::
3785 * The returned value is either nsObj, or an object with a zero ref count.
3787 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3789 const char *name = Jim_String(nsObj);
3790 if (name[0] == ':' && name[1] == ':') {
3791 /* This command is being defined in the global namespace */
3792 while (*++name == ':') {
3794 nsObj = Jim_NewStringObj(interp, name, -1);
3796 else if (Jim_Length(interp->framePtr->nsObj)) {
3797 /* This command is being defined in a non-global namespace */
3798 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3799 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3801 return nsObj;
3804 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3806 Jim_Obj *resultObj;
3808 const char *name = Jim_String(nameObjPtr);
3809 if (name[0] == ':' && name[1] == ':') {
3810 return nameObjPtr;
3812 Jim_IncrRefCount(nameObjPtr);
3813 resultObj = Jim_NewStringObj(interp, "::", -1);
3814 Jim_AppendObj(interp, resultObj, nameObjPtr);
3815 Jim_DecrRefCount(interp, nameObjPtr);
3817 return resultObj;
3821 * An efficient version of JimQualifyNameObj() where the name is
3822 * available (and needed) as a 'const char *'.
3823 * Avoids creating an object if not necessary.
3824 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3826 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3828 Jim_Obj *objPtr = interp->emptyObj;
3830 if (name[0] == ':' && name[1] == ':') {
3831 /* This command is being defined in the global namespace */
3832 while (*++name == ':') {
3835 else if (Jim_Length(interp->framePtr->nsObj)) {
3836 /* This command is being defined in a non-global namespace */
3837 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3838 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3839 name = Jim_String(objPtr);
3841 Jim_IncrRefCount(objPtr);
3842 *objPtrPtr = objPtr;
3843 return name;
3846 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3848 #else
3849 /* We can be more efficient in the no-namespace case */
3850 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3851 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3853 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3855 return nameObjPtr;
3857 #endif
3859 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3861 /* It may already exist, so we try to delete the old one.
3862 * Note that reference count means that it won't be deleted yet if
3863 * it exists in the call stack.
3865 * BUT, if 'local' is in force, instead of deleting the existing
3866 * proc, we stash a reference to the old proc here.
3868 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3869 if (he) {
3870 /* There was an old cmd with the same name,
3871 * so this requires a 'proc epoch' update. */
3873 /* If a procedure with the same name didn't exist there is no need
3874 * to increment the 'proc epoch' because creation of a new procedure
3875 * can never affect existing cached commands. We don't do
3876 * negative caching. */
3877 Jim_InterpIncrProcEpoch(interp);
3880 if (he && interp->local) {
3881 /* Push this command over the top of the previous one */
3882 cmd->prevCmd = Jim_GetHashEntryVal(he);
3883 Jim_SetHashVal(&interp->commands, he, cmd);
3885 else {
3886 if (he) {
3887 /* Replace the existing command */
3888 Jim_DeleteHashEntry(&interp->commands, name);
3891 Jim_AddHashEntry(&interp->commands, name, cmd);
3893 return JIM_OK;
3897 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3898 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3900 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3902 /* Store the new details for this command */
3903 memset(cmdPtr, 0, sizeof(*cmdPtr));
3904 cmdPtr->inUse = 1;
3905 cmdPtr->u.native.delProc = delProc;
3906 cmdPtr->u.native.cmdProc = cmdProc;
3907 cmdPtr->u.native.privData = privData;
3909 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3911 return JIM_OK;
3914 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3916 int len, i;
3918 len = Jim_ListLength(interp, staticsListObjPtr);
3919 if (len == 0) {
3920 return JIM_OK;
3923 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3924 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3925 for (i = 0; i < len; i++) {
3926 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3927 Jim_Var *varPtr;
3928 int subLen;
3930 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3931 /* Check if it's composed of two elements. */
3932 subLen = Jim_ListLength(interp, objPtr);
3933 if (subLen == 1 || subLen == 2) {
3934 /* Try to get the variable value from the current
3935 * environment. */
3936 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3937 if (subLen == 1) {
3938 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3939 if (initObjPtr == NULL) {
3940 Jim_SetResultFormatted(interp,
3941 "variable for initialization of static \"%#s\" not found in the local context",
3942 nameObjPtr);
3943 return JIM_ERR;
3946 else {
3947 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3949 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3950 return JIM_ERR;
3953 varPtr = Jim_Alloc(sizeof(*varPtr));
3954 varPtr->objPtr = initObjPtr;
3955 Jim_IncrRefCount(initObjPtr);
3956 varPtr->linkFramePtr = NULL;
3957 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3958 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3959 Jim_SetResultFormatted(interp,
3960 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3961 Jim_DecrRefCount(interp, initObjPtr);
3962 Jim_Free(varPtr);
3963 return JIM_ERR;
3966 else {
3967 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3968 objPtr);
3969 return JIM_ERR;
3972 return JIM_OK;
3975 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3977 #ifdef jim_ext_namespace
3978 if (cmdPtr->isproc) {
3979 /* XXX: Really need JimNamespaceSplit() */
3980 const char *pt = strrchr(cmdname, ':');
3981 if (pt && pt != cmdname && pt[-1] == ':') {
3982 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3983 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3984 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3986 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3987 /* This commands shadows a global command, so a proc epoch update is required */
3988 Jim_InterpIncrProcEpoch(interp);
3992 #endif
3995 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3996 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3998 Jim_Cmd *cmdPtr;
3999 int argListLen;
4000 int i;
4002 argListLen = Jim_ListLength(interp, argListObjPtr);
4004 /* Allocate space for both the command pointer and the arg list */
4005 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4006 memset(cmdPtr, 0, sizeof(*cmdPtr));
4007 cmdPtr->inUse = 1;
4008 cmdPtr->isproc = 1;
4009 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4010 cmdPtr->u.proc.argListLen = argListLen;
4011 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4012 cmdPtr->u.proc.argsPos = -1;
4013 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4014 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4015 Jim_IncrRefCount(argListObjPtr);
4016 Jim_IncrRefCount(bodyObjPtr);
4017 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4019 /* Create the statics hash table. */
4020 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4021 goto err;
4024 /* Parse the args out into arglist, validating as we go */
4025 /* Examine the argument list for default parameters and 'args' */
4026 for (i = 0; i < argListLen; i++) {
4027 Jim_Obj *argPtr;
4028 Jim_Obj *nameObjPtr;
4029 Jim_Obj *defaultObjPtr;
4030 int len;
4032 /* Examine a parameter */
4033 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4034 len = Jim_ListLength(interp, argPtr);
4035 if (len == 0) {
4036 Jim_SetResultString(interp, "argument with no name", -1);
4037 err:
4038 JimDecrCmdRefCount(interp, cmdPtr);
4039 return NULL;
4041 if (len > 2) {
4042 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4043 goto err;
4046 if (len == 2) {
4047 /* Optional parameter */
4048 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4049 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4051 else {
4052 /* Required parameter */
4053 nameObjPtr = argPtr;
4054 defaultObjPtr = NULL;
4058 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4059 if (cmdPtr->u.proc.argsPos >= 0) {
4060 Jim_SetResultString(interp, "'args' specified more than once", -1);
4061 goto err;
4063 cmdPtr->u.proc.argsPos = i;
4065 else {
4066 if (len == 2) {
4067 cmdPtr->u.proc.optArity++;
4069 else {
4070 cmdPtr->u.proc.reqArity++;
4074 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4075 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4078 return cmdPtr;
4081 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4083 int ret = JIM_OK;
4084 Jim_Obj *qualifiedNameObj;
4085 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4087 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4088 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4089 ret = JIM_ERR;
4091 else {
4092 Jim_InterpIncrProcEpoch(interp);
4095 JimFreeQualifiedName(interp, qualifiedNameObj);
4097 return ret;
4100 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4102 int ret = JIM_ERR;
4103 Jim_HashEntry *he;
4104 Jim_Cmd *cmdPtr;
4105 Jim_Obj *qualifiedOldNameObj;
4106 Jim_Obj *qualifiedNewNameObj;
4107 const char *fqold;
4108 const char *fqnew;
4110 if (newName[0] == 0) {
4111 return Jim_DeleteCommand(interp, oldName);
4114 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4115 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4117 /* Does it exist? */
4118 he = Jim_FindHashEntry(&interp->commands, fqold);
4119 if (he == NULL) {
4120 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4122 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4123 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4125 else {
4126 /* Add the new name first */
4127 cmdPtr = Jim_GetHashEntryVal(he);
4128 JimIncrCmdRefCount(cmdPtr);
4129 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4130 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4132 /* Now remove the old name */
4133 Jim_DeleteHashEntry(&interp->commands, fqold);
4135 /* Increment the epoch */
4136 Jim_InterpIncrProcEpoch(interp);
4138 ret = JIM_OK;
4141 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4142 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4144 return ret;
4147 /* -----------------------------------------------------------------------------
4148 * Command object
4149 * ---------------------------------------------------------------------------*/
4151 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4153 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4156 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4158 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4159 dupPtr->typePtr = srcPtr->typePtr;
4160 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4163 static const Jim_ObjType commandObjType = {
4164 "command",
4165 FreeCommandInternalRep,
4166 DupCommandInternalRep,
4167 NULL,
4168 JIM_TYPE_REFERENCES,
4171 /* This function returns the command structure for the command name
4172 * stored in objPtr. It tries to specialize the objPtr to contain
4173 * a cached info instead to perform the lookup into the hash table
4174 * every time. The information cached may not be uptodate, in such
4175 * a case the lookup is performed and the cache updated.
4177 * Respects the 'upcall' setting
4179 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4181 Jim_Cmd *cmd;
4183 /* In order to be valid, the proc epoch must match and
4184 * the lookup must have occurred in the same namespace
4186 if (objPtr->typePtr != &commandObjType ||
4187 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4188 #ifdef jim_ext_namespace
4189 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4190 #endif
4192 /* Not cached or out of date, so lookup */
4194 /* Do we need to try the local namespace? */
4195 const char *name = Jim_String(objPtr);
4196 Jim_HashEntry *he;
4198 if (name[0] == ':' && name[1] == ':') {
4199 while (*++name == ':') {
4202 #ifdef jim_ext_namespace
4203 else if (Jim_Length(interp->framePtr->nsObj)) {
4204 /* This command is being defined in a non-global namespace */
4205 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4206 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4207 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4208 Jim_FreeNewObj(interp, nameObj);
4209 if (he) {
4210 goto found;
4213 #endif
4215 /* Lookup in the global namespace */
4216 he = Jim_FindHashEntry(&interp->commands, name);
4217 if (he == NULL) {
4218 if (flags & JIM_ERRMSG) {
4219 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4221 return NULL;
4223 #ifdef jim_ext_namespace
4224 found:
4225 #endif
4226 cmd = Jim_GetHashEntryVal(he);
4228 /* Free the old internal repr and set the new one. */
4229 Jim_FreeIntRep(interp, objPtr);
4230 objPtr->typePtr = &commandObjType;
4231 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4232 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4233 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4234 Jim_IncrRefCount(interp->framePtr->nsObj);
4236 else {
4237 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4239 while (cmd->u.proc.upcall) {
4240 cmd = cmd->prevCmd;
4242 return cmd;
4245 /* -----------------------------------------------------------------------------
4246 * Variables
4247 * ---------------------------------------------------------------------------*/
4249 /* -----------------------------------------------------------------------------
4250 * Variable object
4251 * ---------------------------------------------------------------------------*/
4253 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4255 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4257 static const Jim_ObjType variableObjType = {
4258 "variable",
4259 NULL,
4260 NULL,
4261 NULL,
4262 JIM_TYPE_REFERENCES,
4266 * Check that the name does not contain embedded nulls.
4268 * Variable and procedure names are maniplated as null terminated strings, so
4269 * don't allow names with embedded nulls.
4271 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4273 /* Variable names and proc names can't contain embedded nulls */
4274 if (nameObjPtr->typePtr != &variableObjType) {
4275 int len;
4276 const char *str = Jim_GetString(nameObjPtr, &len);
4277 if (memchr(str, '\0', len)) {
4278 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4279 return JIM_ERR;
4282 return JIM_OK;
4285 /* This method should be called only by the variable API.
4286 * It returns JIM_OK on success (variable already exists),
4287 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4288 * a variable name, but syntax glue for [dict] i.e. the last
4289 * character is ')' */
4290 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4292 const char *varName;
4293 Jim_CallFrame *framePtr;
4294 Jim_HashEntry *he;
4295 int global;
4296 int len;
4298 /* Check if the object is already an uptodate variable */
4299 if (objPtr->typePtr == &variableObjType) {
4300 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4301 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4302 /* nothing to do */
4303 return JIM_OK;
4305 /* Need to re-resolve the variable in the updated callframe */
4307 else if (objPtr->typePtr == &dictSubstObjType) {
4308 return JIM_DICT_SUGAR;
4310 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4311 return JIM_ERR;
4315 varName = Jim_GetString(objPtr, &len);
4317 /* Make sure it's not syntax glue to get/set dict. */
4318 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4319 return JIM_DICT_SUGAR;
4322 if (varName[0] == ':' && varName[1] == ':') {
4323 while (*++varName == ':') {
4325 global = 1;
4326 framePtr = interp->topFramePtr;
4328 else {
4329 global = 0;
4330 framePtr = interp->framePtr;
4333 /* Resolve this name in the variables hash table */
4334 he = Jim_FindHashEntry(&framePtr->vars, varName);
4335 if (he == NULL) {
4336 if (!global && framePtr->staticVars) {
4337 /* Try with static vars. */
4338 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4340 if (he == NULL) {
4341 return JIM_ERR;
4345 /* Free the old internal repr and set the new one. */
4346 Jim_FreeIntRep(interp, objPtr);
4347 objPtr->typePtr = &variableObjType;
4348 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4349 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4350 objPtr->internalRep.varValue.global = global;
4351 return JIM_OK;
4354 /* -------------------- Variables related functions ------------------------- */
4355 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4356 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4358 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4360 const char *name;
4361 Jim_CallFrame *framePtr;
4362 int global;
4364 /* New variable to create */
4365 Jim_Var *var = Jim_Alloc(sizeof(*var));
4367 var->objPtr = valObjPtr;
4368 Jim_IncrRefCount(valObjPtr);
4369 var->linkFramePtr = NULL;
4371 name = Jim_String(nameObjPtr);
4372 if (name[0] == ':' && name[1] == ':') {
4373 while (*++name == ':') {
4375 framePtr = interp->topFramePtr;
4376 global = 1;
4378 else {
4379 framePtr = interp->framePtr;
4380 global = 0;
4383 /* Insert the new variable */
4384 Jim_AddHashEntry(&framePtr->vars, name, var);
4386 /* Make the object int rep a variable */
4387 Jim_FreeIntRep(interp, nameObjPtr);
4388 nameObjPtr->typePtr = &variableObjType;
4389 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4390 nameObjPtr->internalRep.varValue.varPtr = var;
4391 nameObjPtr->internalRep.varValue.global = global;
4393 return var;
4396 /* For now that's dummy. Variables lookup should be optimized
4397 * in many ways, with caching of lookups, and possibly with
4398 * a table of pre-allocated vars in every CallFrame for local vars.
4399 * All the caching should also have an 'epoch' mechanism similar
4400 * to the one used by Tcl for procedures lookup caching. */
4402 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4404 int err;
4405 Jim_Var *var;
4407 switch (SetVariableFromAny(interp, nameObjPtr)) {
4408 case JIM_DICT_SUGAR:
4409 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4411 case JIM_ERR:
4412 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4413 return JIM_ERR;
4415 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4416 break;
4418 case JIM_OK:
4419 var = nameObjPtr->internalRep.varValue.varPtr;
4420 if (var->linkFramePtr == NULL) {
4421 Jim_IncrRefCount(valObjPtr);
4422 Jim_DecrRefCount(interp, var->objPtr);
4423 var->objPtr = valObjPtr;
4425 else { /* Else handle the link */
4426 Jim_CallFrame *savedCallFrame;
4428 savedCallFrame = interp->framePtr;
4429 interp->framePtr = var->linkFramePtr;
4430 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4431 interp->framePtr = savedCallFrame;
4432 if (err != JIM_OK)
4433 return err;
4436 return JIM_OK;
4439 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4441 Jim_Obj *nameObjPtr;
4442 int result;
4444 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4445 Jim_IncrRefCount(nameObjPtr);
4446 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4447 Jim_DecrRefCount(interp, nameObjPtr);
4448 return result;
4451 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4453 Jim_CallFrame *savedFramePtr;
4454 int result;
4456 savedFramePtr = interp->framePtr;
4457 interp->framePtr = interp->topFramePtr;
4458 result = Jim_SetVariableStr(interp, name, objPtr);
4459 interp->framePtr = savedFramePtr;
4460 return result;
4463 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4465 Jim_Obj *nameObjPtr, *valObjPtr;
4466 int result;
4468 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4469 valObjPtr = Jim_NewStringObj(interp, val, -1);
4470 Jim_IncrRefCount(nameObjPtr);
4471 Jim_IncrRefCount(valObjPtr);
4472 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4473 Jim_DecrRefCount(interp, nameObjPtr);
4474 Jim_DecrRefCount(interp, valObjPtr);
4475 return result;
4478 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4479 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4481 const char *varName;
4482 const char *targetName;
4483 Jim_CallFrame *framePtr;
4484 Jim_Var *varPtr;
4486 /* Check for an existing variable or link */
4487 switch (SetVariableFromAny(interp, nameObjPtr)) {
4488 case JIM_DICT_SUGAR:
4489 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4490 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4491 return JIM_ERR;
4493 case JIM_OK:
4494 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4496 if (varPtr->linkFramePtr == NULL) {
4497 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4498 return JIM_ERR;
4501 /* It exists, but is a link, so first delete the link */
4502 varPtr->linkFramePtr = NULL;
4503 break;
4506 /* Resolve the call frames for both variables */
4507 /* XXX: SetVariableFromAny() already did this! */
4508 varName = Jim_String(nameObjPtr);
4510 if (varName[0] == ':' && varName[1] == ':') {
4511 while (*++varName == ':') {
4513 /* Linking a global var does nothing */
4514 framePtr = interp->topFramePtr;
4516 else {
4517 framePtr = interp->framePtr;
4520 targetName = Jim_String(targetNameObjPtr);
4521 if (targetName[0] == ':' && targetName[1] == ':') {
4522 while (*++targetName == ':') {
4524 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4525 targetCallFrame = interp->topFramePtr;
4527 Jim_IncrRefCount(targetNameObjPtr);
4529 if (framePtr->level < targetCallFrame->level) {
4530 Jim_SetResultFormatted(interp,
4531 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4532 nameObjPtr);
4533 Jim_DecrRefCount(interp, targetNameObjPtr);
4534 return JIM_ERR;
4537 /* Check for cycles. */
4538 if (framePtr == targetCallFrame) {
4539 Jim_Obj *objPtr = targetNameObjPtr;
4541 /* Cycles are only possible with 'uplevel 0' */
4542 while (1) {
4543 if (strcmp(Jim_String(objPtr), varName) == 0) {
4544 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4545 Jim_DecrRefCount(interp, targetNameObjPtr);
4546 return JIM_ERR;
4548 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4549 break;
4550 varPtr = objPtr->internalRep.varValue.varPtr;
4551 if (varPtr->linkFramePtr != targetCallFrame)
4552 break;
4553 objPtr = varPtr->objPtr;
4557 /* Perform the binding */
4558 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4559 /* We are now sure 'nameObjPtr' type is variableObjType */
4560 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4561 Jim_DecrRefCount(interp, targetNameObjPtr);
4562 return JIM_OK;
4565 /* Return the Jim_Obj pointer associated with a variable name,
4566 * or NULL if the variable was not found in the current context.
4567 * The same optimization discussed in the comment to the
4568 * 'SetVariable' function should apply here.
4570 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4571 * in a dictionary which is shared, the array variable value is duplicated first.
4572 * This allows the array element to be updated (e.g. append, lappend) without
4573 * affecting other references to the dictionary.
4575 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4577 switch (SetVariableFromAny(interp, nameObjPtr)) {
4578 case JIM_OK:{
4579 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4581 if (varPtr->linkFramePtr == NULL) {
4582 return varPtr->objPtr;
4584 else {
4585 Jim_Obj *objPtr;
4587 /* The variable is a link? Resolve it. */
4588 Jim_CallFrame *savedCallFrame = interp->framePtr;
4590 interp->framePtr = varPtr->linkFramePtr;
4591 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4592 interp->framePtr = savedCallFrame;
4593 if (objPtr) {
4594 return objPtr;
4596 /* Error, so fall through to the error message */
4599 break;
4601 case JIM_DICT_SUGAR:
4602 /* [dict] syntax sugar. */
4603 return JimDictSugarGet(interp, nameObjPtr, flags);
4605 if (flags & JIM_ERRMSG) {
4606 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4608 return NULL;
4611 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4613 Jim_CallFrame *savedFramePtr;
4614 Jim_Obj *objPtr;
4616 savedFramePtr = interp->framePtr;
4617 interp->framePtr = interp->topFramePtr;
4618 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4619 interp->framePtr = savedFramePtr;
4621 return objPtr;
4624 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4626 Jim_Obj *nameObjPtr, *varObjPtr;
4628 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4629 Jim_IncrRefCount(nameObjPtr);
4630 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4631 Jim_DecrRefCount(interp, nameObjPtr);
4632 return varObjPtr;
4635 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4637 Jim_CallFrame *savedFramePtr;
4638 Jim_Obj *objPtr;
4640 savedFramePtr = interp->framePtr;
4641 interp->framePtr = interp->topFramePtr;
4642 objPtr = Jim_GetVariableStr(interp, name, flags);
4643 interp->framePtr = savedFramePtr;
4645 return objPtr;
4648 /* Unset a variable.
4649 * Note: On success unset invalidates all the variable objects created
4650 * in the current call frame incrementing. */
4651 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4653 Jim_Var *varPtr;
4654 int retval;
4655 Jim_CallFrame *framePtr;
4657 retval = SetVariableFromAny(interp, nameObjPtr);
4658 if (retval == JIM_DICT_SUGAR) {
4659 /* [dict] syntax sugar. */
4660 return JimDictSugarSet(interp, nameObjPtr, NULL);
4662 else if (retval == JIM_OK) {
4663 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4665 /* If it's a link call UnsetVariable recursively */
4666 if (varPtr->linkFramePtr) {
4667 framePtr = interp->framePtr;
4668 interp->framePtr = varPtr->linkFramePtr;
4669 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4670 interp->framePtr = framePtr;
4672 else {
4673 const char *name = Jim_String(nameObjPtr);
4674 if (nameObjPtr->internalRep.varValue.global) {
4675 name += 2;
4676 framePtr = interp->topFramePtr;
4678 else {
4679 framePtr = interp->framePtr;
4682 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4683 if (retval == JIM_OK) {
4684 /* Change the callframe id, invalidating var lookup caching */
4685 framePtr->id = interp->callFrameEpoch++;
4689 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4690 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4692 return retval;
4695 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4697 /* Given a variable name for [dict] operation syntax sugar,
4698 * this function returns two objects, the first with the name
4699 * of the variable to set, and the second with the rispective key.
4700 * For example "foo(bar)" will return objects with string repr. of
4701 * "foo" and "bar".
4703 * The returned objects have refcount = 1. The function can't fail. */
4704 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4705 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4707 const char *str, *p;
4708 int len, keyLen;
4709 Jim_Obj *varObjPtr, *keyObjPtr;
4711 str = Jim_GetString(objPtr, &len);
4713 p = strchr(str, '(');
4714 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4716 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4718 p++;
4719 keyLen = (str + len) - p;
4720 if (str[len - 1] == ')') {
4721 keyLen--;
4724 /* Create the objects with the variable name and key. */
4725 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4727 Jim_IncrRefCount(varObjPtr);
4728 Jim_IncrRefCount(keyObjPtr);
4729 *varPtrPtr = varObjPtr;
4730 *keyPtrPtr = keyObjPtr;
4733 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4734 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4735 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4737 int err;
4739 SetDictSubstFromAny(interp, objPtr);
4741 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4742 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4744 if (err == JIM_OK) {
4745 /* Don't keep an extra ref to the result */
4746 Jim_SetEmptyResult(interp);
4748 else {
4749 if (!valObjPtr) {
4750 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4751 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4752 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4753 objPtr);
4754 return err;
4757 /* Make the error more informative and Tcl-compatible */
4758 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4759 (valObjPtr ? "set" : "unset"), objPtr);
4761 return err;
4765 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4767 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4768 * and stored back to the variable before expansion.
4770 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4771 Jim_Obj *keyObjPtr, int flags)
4773 Jim_Obj *dictObjPtr;
4774 Jim_Obj *resObjPtr = NULL;
4775 int ret;
4777 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4778 if (!dictObjPtr) {
4779 return NULL;
4782 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4783 if (ret != JIM_OK) {
4784 Jim_SetResultFormatted(interp,
4785 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4786 ret < 0 ? "variable isn't" : "no such element in");
4788 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4789 /* Update the variable to have an unshared copy */
4790 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4793 return resObjPtr;
4796 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4797 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4799 SetDictSubstFromAny(interp, objPtr);
4801 return JimDictExpandArrayVariable(interp,
4802 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4803 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4806 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4808 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4810 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4811 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4814 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4816 JIM_NOTUSED(interp);
4818 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4819 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4820 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4821 dupPtr->typePtr = &dictSubstObjType;
4824 /* Note: The object *must* be in dict-sugar format */
4825 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4827 if (objPtr->typePtr != &dictSubstObjType) {
4828 Jim_Obj *varObjPtr, *keyObjPtr;
4830 if (objPtr->typePtr == &interpolatedObjType) {
4831 /* An interpolated object in dict-sugar form */
4833 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4834 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4836 Jim_IncrRefCount(varObjPtr);
4837 Jim_IncrRefCount(keyObjPtr);
4839 else {
4840 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4843 Jim_FreeIntRep(interp, objPtr);
4844 objPtr->typePtr = &dictSubstObjType;
4845 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4846 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4850 /* This function is used to expand [dict get] sugar in the form
4851 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4852 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4853 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4854 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4855 * the [dict]ionary contained in variable VARNAME. */
4856 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4858 Jim_Obj *resObjPtr = NULL;
4859 Jim_Obj *substKeyObjPtr = NULL;
4861 SetDictSubstFromAny(interp, objPtr);
4863 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4864 &substKeyObjPtr, JIM_NONE)
4865 != JIM_OK) {
4866 return NULL;
4868 Jim_IncrRefCount(substKeyObjPtr);
4869 resObjPtr =
4870 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4871 substKeyObjPtr, 0);
4872 Jim_DecrRefCount(interp, substKeyObjPtr);
4874 return resObjPtr;
4877 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4879 Jim_Obj *resultObjPtr;
4881 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4882 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4883 resultObjPtr->refCount--;
4884 return resultObjPtr;
4886 return NULL;
4889 /* -----------------------------------------------------------------------------
4890 * CallFrame
4891 * ---------------------------------------------------------------------------*/
4893 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4895 Jim_CallFrame *cf;
4897 if (interp->freeFramesList) {
4898 cf = interp->freeFramesList;
4899 interp->freeFramesList = cf->next;
4901 cf->argv = NULL;
4902 cf->argc = 0;
4903 cf->procArgsObjPtr = NULL;
4904 cf->procBodyObjPtr = NULL;
4905 cf->next = NULL;
4906 cf->staticVars = NULL;
4907 cf->localCommands = NULL;
4908 cf->tailcall = 0;
4909 cf->tailcallObj = NULL;
4910 cf->tailcallCmd = NULL;
4912 else {
4913 cf = Jim_Alloc(sizeof(*cf));
4914 memset(cf, 0, sizeof(*cf));
4916 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4919 cf->id = interp->callFrameEpoch++;
4920 cf->parent = parent;
4921 cf->level = parent ? parent->level + 1 : 0;
4922 cf->nsObj = nsObj;
4923 Jim_IncrRefCount(nsObj);
4925 return cf;
4928 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4930 /* Delete any local procs */
4931 if (localCommands) {
4932 Jim_Obj *cmdNameObj;
4934 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4935 Jim_HashEntry *he;
4936 Jim_Obj *fqObjName;
4937 Jim_HashTable *ht = &interp->commands;
4939 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4941 he = Jim_FindHashEntry(ht, fqname);
4943 if (he) {
4944 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4945 if (cmd->prevCmd) {
4946 Jim_Cmd *prevCmd = cmd->prevCmd;
4947 cmd->prevCmd = NULL;
4949 /* Delete the old command */
4950 JimDecrCmdRefCount(interp, cmd);
4952 /* And restore the original */
4953 Jim_SetHashVal(ht, he, prevCmd);
4955 else {
4956 Jim_DeleteHashEntry(ht, fqname);
4957 Jim_InterpIncrProcEpoch(interp);
4960 Jim_DecrRefCount(interp, cmdNameObj);
4961 JimFreeQualifiedName(interp, fqObjName);
4963 Jim_FreeStack(localCommands);
4964 Jim_Free(localCommands);
4966 return JIM_OK;
4970 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4971 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4972 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4974 JimDeleteLocalProcs(interp, cf->localCommands);
4976 if (cf->procArgsObjPtr)
4977 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4978 if (cf->procBodyObjPtr)
4979 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4980 Jim_DecrRefCount(interp, cf->nsObj);
4981 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4982 Jim_FreeHashTable(&cf->vars);
4983 else {
4984 int i;
4985 Jim_HashEntry **table = cf->vars.table, *he;
4987 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4988 he = table[i];
4989 while (he != NULL) {
4990 Jim_HashEntry *nextEntry = he->next;
4991 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
4993 Jim_DecrRefCount(interp, varPtr->objPtr);
4994 Jim_Free(Jim_GetHashEntryKey(he));
4995 Jim_Free(varPtr);
4996 Jim_Free(he);
4997 table[i] = NULL;
4998 he = nextEntry;
5001 cf->vars.used = 0;
5003 cf->next = interp->freeFramesList;
5004 interp->freeFramesList = cf;
5008 /* -----------------------------------------------------------------------------
5009 * References
5010 * ---------------------------------------------------------------------------*/
5011 #ifdef JIM_REFERENCES
5013 /* References HashTable Type.
5015 * Keys are unsigned long integers, dynamically allocated for now but in the
5016 * future it's worth to cache this 4 bytes objects. Values are pointers
5017 * to Jim_References. */
5018 static void JimReferencesHTValDestructor(void *interp, void *val)
5020 Jim_Reference *refPtr = (void *)val;
5022 Jim_DecrRefCount(interp, refPtr->objPtr);
5023 if (refPtr->finalizerCmdNamePtr != NULL) {
5024 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5026 Jim_Free(val);
5029 static unsigned int JimReferencesHTHashFunction(const void *key)
5031 /* Only the least significant bits are used. */
5032 const unsigned long *widePtr = key;
5033 unsigned int intValue = (unsigned int)*widePtr;
5035 return Jim_IntHashFunction(intValue);
5038 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5040 void *copy = Jim_Alloc(sizeof(unsigned long));
5042 JIM_NOTUSED(privdata);
5044 memcpy(copy, key, sizeof(unsigned long));
5045 return copy;
5048 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5050 JIM_NOTUSED(privdata);
5052 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5055 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5057 JIM_NOTUSED(privdata);
5059 Jim_Free(key);
5062 static const Jim_HashTableType JimReferencesHashTableType = {
5063 JimReferencesHTHashFunction, /* hash function */
5064 JimReferencesHTKeyDup, /* key dup */
5065 NULL, /* val dup */
5066 JimReferencesHTKeyCompare, /* key compare */
5067 JimReferencesHTKeyDestructor, /* key destructor */
5068 JimReferencesHTValDestructor /* val destructor */
5071 /* -----------------------------------------------------------------------------
5072 * Reference object type and References API
5073 * ---------------------------------------------------------------------------*/
5075 /* The string representation of references has two features in order
5076 * to make the GC faster. The first is that every reference starts
5077 * with a non common character '<', in order to make the string matching
5078 * faster. The second is that the reference string rep is 42 characters
5079 * in length, this means that it is not necessary to check any object with a string
5080 * repr < 42, and usually there aren't many of these objects. */
5082 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5084 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5086 const char *fmt = "<reference.<%s>.%020lu>";
5088 sprintf(buf, fmt, refPtr->tag, id);
5089 return JIM_REFERENCE_SPACE;
5092 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5094 static const Jim_ObjType referenceObjType = {
5095 "reference",
5096 NULL,
5097 NULL,
5098 UpdateStringOfReference,
5099 JIM_TYPE_REFERENCES,
5102 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5104 char buf[JIM_REFERENCE_SPACE + 1];
5106 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5107 JimSetStringBytes(objPtr, buf);
5110 /* returns true if 'c' is a valid reference tag character.
5111 * i.e. inside the range [_a-zA-Z0-9] */
5112 static int isrefchar(int c)
5114 return (c == '_' || isalnum(c));
5117 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5119 unsigned long value;
5120 int i, len;
5121 const char *str, *start, *end;
5122 char refId[21];
5123 Jim_Reference *refPtr;
5124 Jim_HashEntry *he;
5125 char *endptr;
5127 /* Get the string representation */
5128 str = Jim_GetString(objPtr, &len);
5129 /* Check if it looks like a reference */
5130 if (len < JIM_REFERENCE_SPACE)
5131 goto badformat;
5132 /* Trim spaces */
5133 start = str;
5134 end = str + len - 1;
5135 while (*start == ' ')
5136 start++;
5137 while (*end == ' ' && end > start)
5138 end--;
5139 if (end - start + 1 != JIM_REFERENCE_SPACE)
5140 goto badformat;
5141 /* <reference.<1234567>.%020> */
5142 if (memcmp(start, "<reference.<", 12) != 0)
5143 goto badformat;
5144 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5145 goto badformat;
5146 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5147 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5148 if (!isrefchar(start[12 + i]))
5149 goto badformat;
5151 /* Extract info from the reference. */
5152 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5153 refId[20] = '\0';
5154 /* Try to convert the ID into an unsigned long */
5155 value = strtoul(refId, &endptr, 10);
5156 if (JimCheckConversion(refId, endptr) != JIM_OK)
5157 goto badformat;
5158 /* Check if the reference really exists! */
5159 he = Jim_FindHashEntry(&interp->references, &value);
5160 if (he == NULL) {
5161 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5162 return JIM_ERR;
5164 refPtr = Jim_GetHashEntryVal(he);
5165 /* Free the old internal repr and set the new one. */
5166 Jim_FreeIntRep(interp, objPtr);
5167 objPtr->typePtr = &referenceObjType;
5168 objPtr->internalRep.refValue.id = value;
5169 objPtr->internalRep.refValue.refPtr = refPtr;
5170 return JIM_OK;
5172 badformat:
5173 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5174 return JIM_ERR;
5177 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5178 * as finalizer command (or NULL if there is no finalizer).
5179 * The returned reference object has refcount = 0. */
5180 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5182 struct Jim_Reference *refPtr;
5183 unsigned long id;
5184 Jim_Obj *refObjPtr;
5185 const char *tag;
5186 int tagLen, i;
5188 /* Perform the Garbage Collection if needed. */
5189 Jim_CollectIfNeeded(interp);
5191 refPtr = Jim_Alloc(sizeof(*refPtr));
5192 refPtr->objPtr = objPtr;
5193 Jim_IncrRefCount(objPtr);
5194 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5195 if (cmdNamePtr)
5196 Jim_IncrRefCount(cmdNamePtr);
5197 id = interp->referenceNextId++;
5198 Jim_AddHashEntry(&interp->references, &id, refPtr);
5199 refObjPtr = Jim_NewObj(interp);
5200 refObjPtr->typePtr = &referenceObjType;
5201 refObjPtr->bytes = NULL;
5202 refObjPtr->internalRep.refValue.id = id;
5203 refObjPtr->internalRep.refValue.refPtr = refPtr;
5204 interp->referenceNextId++;
5205 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5206 * that does not pass the 'isrefchar' test is replaced with '_' */
5207 tag = Jim_GetString(tagPtr, &tagLen);
5208 if (tagLen > JIM_REFERENCE_TAGLEN)
5209 tagLen = JIM_REFERENCE_TAGLEN;
5210 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5211 if (i < tagLen && isrefchar(tag[i]))
5212 refPtr->tag[i] = tag[i];
5213 else
5214 refPtr->tag[i] = '_';
5216 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5217 return refObjPtr;
5220 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5222 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5223 return NULL;
5224 return objPtr->internalRep.refValue.refPtr;
5227 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5229 Jim_Reference *refPtr;
5231 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5232 return JIM_ERR;
5233 Jim_IncrRefCount(cmdNamePtr);
5234 if (refPtr->finalizerCmdNamePtr)
5235 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5236 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5237 return JIM_OK;
5240 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5242 Jim_Reference *refPtr;
5244 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5245 return JIM_ERR;
5246 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5247 return JIM_OK;
5250 /* -----------------------------------------------------------------------------
5251 * References Garbage Collection
5252 * ---------------------------------------------------------------------------*/
5254 /* This the hash table type for the "MARK" phase of the GC */
5255 static const Jim_HashTableType JimRefMarkHashTableType = {
5256 JimReferencesHTHashFunction, /* hash function */
5257 JimReferencesHTKeyDup, /* key dup */
5258 NULL, /* val dup */
5259 JimReferencesHTKeyCompare, /* key compare */
5260 JimReferencesHTKeyDestructor, /* key destructor */
5261 NULL /* val destructor */
5264 /* Performs the garbage collection. */
5265 int Jim_Collect(Jim_Interp *interp)
5267 int collected = 0;
5268 #ifndef JIM_BOOTSTRAP
5269 Jim_HashTable marks;
5270 Jim_HashTableIterator htiter;
5271 Jim_HashEntry *he;
5272 Jim_Obj *objPtr;
5274 /* Avoid recursive calls */
5275 if (interp->lastCollectId == -1) {
5276 /* Jim_Collect() already running. Return just now. */
5277 return 0;
5279 interp->lastCollectId = -1;
5281 /* Mark all the references found into the 'mark' hash table.
5282 * The references are searched in every live object that
5283 * is of a type that can contain references. */
5284 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5285 objPtr = interp->liveList;
5286 while (objPtr) {
5287 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5288 const char *str, *p;
5289 int len;
5291 /* If the object is of type reference, to get the
5292 * Id is simple... */
5293 if (objPtr->typePtr == &referenceObjType) {
5294 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5295 #ifdef JIM_DEBUG_GC
5296 printf("MARK (reference): %d refcount: %d\n",
5297 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5298 #endif
5299 objPtr = objPtr->nextObjPtr;
5300 continue;
5302 /* Get the string repr of the object we want
5303 * to scan for references. */
5304 p = str = Jim_GetString(objPtr, &len);
5305 /* Skip objects too little to contain references. */
5306 if (len < JIM_REFERENCE_SPACE) {
5307 objPtr = objPtr->nextObjPtr;
5308 continue;
5310 /* Extract references from the object string repr. */
5311 while (1) {
5312 int i;
5313 unsigned long id;
5315 if ((p = strstr(p, "<reference.<")) == NULL)
5316 break;
5317 /* Check if it's a valid reference. */
5318 if (len - (p - str) < JIM_REFERENCE_SPACE)
5319 break;
5320 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5321 break;
5322 for (i = 21; i <= 40; i++)
5323 if (!isdigit(UCHAR(p[i])))
5324 break;
5325 /* Get the ID */
5326 id = strtoul(p + 21, NULL, 10);
5328 /* Ok, a reference for the given ID
5329 * was found. Mark it. */
5330 Jim_AddHashEntry(&marks, &id, NULL);
5331 #ifdef JIM_DEBUG_GC
5332 printf("MARK: %d\n", (int)id);
5333 #endif
5334 p += JIM_REFERENCE_SPACE;
5337 objPtr = objPtr->nextObjPtr;
5340 /* Run the references hash table to destroy every reference that
5341 * is not referenced outside (not present in the mark HT). */
5342 JimInitHashTableIterator(&interp->references, &htiter);
5343 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5344 const unsigned long *refId;
5345 Jim_Reference *refPtr;
5347 refId = he->key;
5348 /* Check if in the mark phase we encountered
5349 * this reference. */
5350 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5351 #ifdef JIM_DEBUG_GC
5352 printf("COLLECTING %d\n", (int)*refId);
5353 #endif
5354 collected++;
5355 /* Drop the reference, but call the
5356 * finalizer first if registered. */
5357 refPtr = Jim_GetHashEntryVal(he);
5358 if (refPtr->finalizerCmdNamePtr) {
5359 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5360 Jim_Obj *objv[3], *oldResult;
5362 JimFormatReference(refstr, refPtr, *refId);
5364 objv[0] = refPtr->finalizerCmdNamePtr;
5365 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5366 objv[2] = refPtr->objPtr;
5368 /* Drop the reference itself */
5369 /* Avoid the finaliser being freed here */
5370 Jim_IncrRefCount(objv[0]);
5371 /* Don't remove the reference from the hash table just yet
5372 * since that will free refPtr, and hence refPtr->objPtr
5375 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5376 oldResult = interp->result;
5377 Jim_IncrRefCount(oldResult);
5378 Jim_EvalObjVector(interp, 3, objv);
5379 Jim_SetResult(interp, oldResult);
5380 Jim_DecrRefCount(interp, oldResult);
5382 Jim_DecrRefCount(interp, objv[0]);
5384 Jim_DeleteHashEntry(&interp->references, refId);
5387 Jim_FreeHashTable(&marks);
5388 interp->lastCollectId = interp->referenceNextId;
5389 interp->lastCollectTime = time(NULL);
5390 #endif /* JIM_BOOTSTRAP */
5391 return collected;
5394 #define JIM_COLLECT_ID_PERIOD 5000
5395 #define JIM_COLLECT_TIME_PERIOD 300
5397 void Jim_CollectIfNeeded(Jim_Interp *interp)
5399 unsigned long elapsedId;
5400 int elapsedTime;
5402 elapsedId = interp->referenceNextId - interp->lastCollectId;
5403 elapsedTime = time(NULL) - interp->lastCollectTime;
5406 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5407 Jim_Collect(interp);
5410 #endif
5412 int Jim_IsBigEndian(void)
5414 union {
5415 unsigned short s;
5416 unsigned char c[2];
5417 } uval = {0x0102};
5419 return uval.c[0] == 1;
5422 /* -----------------------------------------------------------------------------
5423 * Interpreter related functions
5424 * ---------------------------------------------------------------------------*/
5426 Jim_Interp *Jim_CreateInterp(void)
5428 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5430 memset(i, 0, sizeof(*i));
5432 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5433 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5434 i->lastCollectTime = time(NULL);
5436 /* Note that we can create objects only after the
5437 * interpreter liveList and freeList pointers are
5438 * initialized to NULL. */
5439 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5440 #ifdef JIM_REFERENCES
5441 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5442 #endif
5443 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5444 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5445 i->emptyObj = Jim_NewEmptyStringObj(i);
5446 i->trueObj = Jim_NewIntObj(i, 1);
5447 i->falseObj = Jim_NewIntObj(i, 0);
5448 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5449 i->errorFileNameObj = i->emptyObj;
5450 i->result = i->emptyObj;
5451 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5452 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5453 i->errorProc = i->emptyObj;
5454 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5455 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5456 Jim_IncrRefCount(i->emptyObj);
5457 Jim_IncrRefCount(i->errorFileNameObj);
5458 Jim_IncrRefCount(i->result);
5459 Jim_IncrRefCount(i->stackTrace);
5460 Jim_IncrRefCount(i->unknown);
5461 Jim_IncrRefCount(i->currentScriptObj);
5462 Jim_IncrRefCount(i->nullScriptObj);
5463 Jim_IncrRefCount(i->errorProc);
5464 Jim_IncrRefCount(i->trueObj);
5465 Jim_IncrRefCount(i->falseObj);
5467 /* Initialize key variables every interpreter should contain */
5468 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5469 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5471 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5472 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5473 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5474 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5475 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5476 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5477 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5479 return i;
5482 void Jim_FreeInterp(Jim_Interp *i)
5484 Jim_CallFrame *cf, *cfx;
5486 Jim_Obj *objPtr, *nextObjPtr;
5488 /* Free the active call frames list - must be done before i->commands is destroyed */
5489 for (cf = i->framePtr; cf; cf = cfx) {
5490 cfx = cf->parent;
5491 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5494 Jim_DecrRefCount(i, i->emptyObj);
5495 Jim_DecrRefCount(i, i->trueObj);
5496 Jim_DecrRefCount(i, i->falseObj);
5497 Jim_DecrRefCount(i, i->result);
5498 Jim_DecrRefCount(i, i->stackTrace);
5499 Jim_DecrRefCount(i, i->errorProc);
5500 Jim_DecrRefCount(i, i->unknown);
5501 Jim_DecrRefCount(i, i->errorFileNameObj);
5502 Jim_DecrRefCount(i, i->currentScriptObj);
5503 Jim_DecrRefCount(i, i->nullScriptObj);
5504 Jim_FreeHashTable(&i->commands);
5505 #ifdef JIM_REFERENCES
5506 Jim_FreeHashTable(&i->references);
5507 #endif
5508 Jim_FreeHashTable(&i->packages);
5509 Jim_Free(i->prngState);
5510 Jim_FreeHashTable(&i->assocData);
5512 /* Check that the live object list is empty, otherwise
5513 * there is a memory leak. */
5514 #ifdef JIM_MAINTAINER
5515 if (i->liveList != NULL) {
5516 objPtr = i->liveList;
5518 printf("\n-------------------------------------\n");
5519 printf("Objects still in the free list:\n");
5520 while (objPtr) {
5521 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5523 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5524 printf("%p (%d) %-10s: '%.20s...'\n",
5525 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5527 else {
5528 printf("%p (%d) %-10s: '%s'\n",
5529 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5531 if (objPtr->typePtr == &sourceObjType) {
5532 printf("FILE %s LINE %d\n",
5533 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5534 objPtr->internalRep.sourceValue.lineNumber);
5536 objPtr = objPtr->nextObjPtr;
5538 printf("-------------------------------------\n\n");
5539 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5541 #endif
5543 /* Free all the freed objects. */
5544 objPtr = i->freeList;
5545 while (objPtr) {
5546 nextObjPtr = objPtr->nextObjPtr;
5547 Jim_Free(objPtr);
5548 objPtr = nextObjPtr;
5551 /* Free the free call frames list */
5552 for (cf = i->freeFramesList; cf; cf = cfx) {
5553 cfx = cf->next;
5554 if (cf->vars.table)
5555 Jim_FreeHashTable(&cf->vars);
5556 Jim_Free(cf);
5559 /* Free the interpreter structure. */
5560 Jim_Free(i);
5563 /* Returns the call frame relative to the level represented by
5564 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5566 * This function accepts the 'level' argument in the form
5567 * of the commands [uplevel] and [upvar].
5569 * Returns NULL on error.
5571 * Note: for a function accepting a relative integer as level suitable
5572 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5574 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5576 long level;
5577 const char *str;
5578 Jim_CallFrame *framePtr;
5580 if (levelObjPtr) {
5581 str = Jim_String(levelObjPtr);
5582 if (str[0] == '#') {
5583 char *endptr;
5585 level = jim_strtol(str + 1, &endptr);
5586 if (str[1] == '\0' || endptr[0] != '\0') {
5587 level = -1;
5590 else {
5591 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5592 level = -1;
5594 else {
5595 /* Convert from a relative to an absolute level */
5596 level = interp->framePtr->level - level;
5600 else {
5601 str = "1"; /* Needed to format the error message. */
5602 level = interp->framePtr->level - 1;
5605 if (level == 0) {
5606 return interp->topFramePtr;
5608 if (level > 0) {
5609 /* Lookup */
5610 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5611 if (framePtr->level == level) {
5612 return framePtr;
5617 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5618 return NULL;
5621 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5622 * as a relative integer like in the [info level ?level?] command.
5624 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5626 long level;
5627 Jim_CallFrame *framePtr;
5629 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5630 if (level <= 0) {
5631 /* Convert from a relative to an absolute level */
5632 level = interp->framePtr->level + level;
5635 if (level == 0) {
5636 return interp->topFramePtr;
5639 /* Lookup */
5640 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5641 if (framePtr->level == level) {
5642 return framePtr;
5647 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5648 return NULL;
5651 static void JimResetStackTrace(Jim_Interp *interp)
5653 Jim_DecrRefCount(interp, interp->stackTrace);
5654 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5655 Jim_IncrRefCount(interp->stackTrace);
5658 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5660 int len;
5662 /* Increment reference first in case these are the same object */
5663 Jim_IncrRefCount(stackTraceObj);
5664 Jim_DecrRefCount(interp, interp->stackTrace);
5665 interp->stackTrace = stackTraceObj;
5666 interp->errorFlag = 1;
5668 /* This is a bit ugly.
5669 * If the filename of the last entry of the stack trace is empty,
5670 * the next stack level should be added.
5672 len = Jim_ListLength(interp, interp->stackTrace);
5673 if (len >= 3) {
5674 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5675 interp->addStackTrace = 1;
5680 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5681 Jim_Obj *fileNameObj, int linenr)
5683 if (strcmp(procname, "unknown") == 0) {
5684 procname = "";
5686 if (!*procname && !Jim_Length(fileNameObj)) {
5687 /* No useful info here */
5688 return;
5691 if (Jim_IsShared(interp->stackTrace)) {
5692 Jim_DecrRefCount(interp, interp->stackTrace);
5693 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5694 Jim_IncrRefCount(interp->stackTrace);
5697 /* If we have no procname but the previous element did, merge with that frame */
5698 if (!*procname && Jim_Length(fileNameObj)) {
5699 /* Just a filename. Check the previous entry */
5700 int len = Jim_ListLength(interp, interp->stackTrace);
5702 if (len >= 3) {
5703 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5704 if (Jim_Length(objPtr)) {
5705 /* Yes, the previous level had procname */
5706 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5707 if (Jim_Length(objPtr) == 0) {
5708 /* But no filename, so merge the new info with that frame */
5709 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5710 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5711 return;
5717 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5718 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5719 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5722 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5723 void *data)
5725 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5727 assocEntryPtr->delProc = delProc;
5728 assocEntryPtr->data = data;
5729 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5732 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5734 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5736 if (entryPtr != NULL) {
5737 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5738 return assocEntryPtr->data;
5740 return NULL;
5743 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5745 return Jim_DeleteHashEntry(&interp->assocData, key);
5748 int Jim_GetExitCode(Jim_Interp *interp)
5750 return interp->exitCode;
5753 /* -----------------------------------------------------------------------------
5754 * Integer object
5755 * ---------------------------------------------------------------------------*/
5756 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5757 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5759 static const Jim_ObjType intObjType = {
5760 "int",
5761 NULL,
5762 NULL,
5763 UpdateStringOfInt,
5764 JIM_TYPE_NONE,
5767 /* A coerced double is closer to an int than a double.
5768 * It is an int value temporarily masquerading as a double value.
5769 * i.e. it has the same string value as an int and Jim_GetWide()
5770 * succeeds, but also Jim_GetDouble() returns the value directly.
5772 static const Jim_ObjType coercedDoubleObjType = {
5773 "coerced-double",
5774 NULL,
5775 NULL,
5776 UpdateStringOfInt,
5777 JIM_TYPE_NONE,
5781 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5783 char buf[JIM_INTEGER_SPACE + 1];
5784 jim_wide wideValue = JimWideValue(objPtr);
5785 int pos = 0;
5787 if (wideValue == 0) {
5788 buf[pos++] = '0';
5790 else {
5791 char tmp[JIM_INTEGER_SPACE];
5792 int num = 0;
5793 int i;
5795 if (wideValue < 0) {
5796 buf[pos++] = '-';
5797 i = wideValue % 10;
5798 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5799 * whereas C99 is always -6
5800 * coverity[dead_error_line]
5802 tmp[num++] = (i > 0) ? (10 - i) : -i;
5803 wideValue /= -10;
5806 while (wideValue) {
5807 tmp[num++] = wideValue % 10;
5808 wideValue /= 10;
5811 for (i = 0; i < num; i++) {
5812 buf[pos++] = '0' + tmp[num - i - 1];
5815 buf[pos] = 0;
5817 JimSetStringBytes(objPtr, buf);
5820 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5822 jim_wide wideValue;
5823 const char *str;
5825 if (objPtr->typePtr == &coercedDoubleObjType) {
5826 /* Simple switcheroo */
5827 objPtr->typePtr = &intObjType;
5828 return JIM_OK;
5831 /* Get the string representation */
5832 str = Jim_String(objPtr);
5833 /* Try to convert into a jim_wide */
5834 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5835 if (flags & JIM_ERRMSG) {
5836 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5838 return JIM_ERR;
5840 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5841 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5842 return JIM_ERR;
5844 /* Free the old internal repr and set the new one. */
5845 Jim_FreeIntRep(interp, objPtr);
5846 objPtr->typePtr = &intObjType;
5847 objPtr->internalRep.wideValue = wideValue;
5848 return JIM_OK;
5851 #ifdef JIM_OPTIMIZATION
5852 static int JimIsWide(Jim_Obj *objPtr)
5854 return objPtr->typePtr == &intObjType;
5856 #endif
5858 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5860 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5861 return JIM_ERR;
5862 *widePtr = JimWideValue(objPtr);
5863 return JIM_OK;
5866 /* Get a wide but does not set an error if the format is bad. */
5867 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5869 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5870 return JIM_ERR;
5871 *widePtr = JimWideValue(objPtr);
5872 return JIM_OK;
5875 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5877 jim_wide wideValue;
5878 int retval;
5880 retval = Jim_GetWide(interp, objPtr, &wideValue);
5881 if (retval == JIM_OK) {
5882 *longPtr = (long)wideValue;
5883 return JIM_OK;
5885 return JIM_ERR;
5888 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5890 Jim_Obj *objPtr;
5892 objPtr = Jim_NewObj(interp);
5893 objPtr->typePtr = &intObjType;
5894 objPtr->bytes = NULL;
5895 objPtr->internalRep.wideValue = wideValue;
5896 return objPtr;
5899 /* -----------------------------------------------------------------------------
5900 * Double object
5901 * ---------------------------------------------------------------------------*/
5902 #define JIM_DOUBLE_SPACE 30
5904 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5905 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5907 static const Jim_ObjType doubleObjType = {
5908 "double",
5909 NULL,
5910 NULL,
5911 UpdateStringOfDouble,
5912 JIM_TYPE_NONE,
5915 #ifndef HAVE_ISNAN
5916 #undef isnan
5917 #define isnan(X) ((X) != (X))
5918 #endif
5919 #ifndef HAVE_ISINF
5920 #undef isinf
5921 #define isinf(X) (1.0 / (X) == 0.0)
5922 #endif
5924 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5926 double value = objPtr->internalRep.doubleValue;
5928 if (isnan(value)) {
5929 JimSetStringBytes(objPtr, "NaN");
5930 return;
5932 if (isinf(value)) {
5933 if (value < 0) {
5934 JimSetStringBytes(objPtr, "-Inf");
5936 else {
5937 JimSetStringBytes(objPtr, "Inf");
5939 return;
5942 char buf[JIM_DOUBLE_SPACE + 1];
5943 int i;
5944 int len = sprintf(buf, "%.12g", value);
5946 /* Add a final ".0" if necessary */
5947 for (i = 0; i < len; i++) {
5948 if (buf[i] == '.' || buf[i] == 'e') {
5949 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5950 /* If 'buf' ends in e-0nn or e+0nn, remove
5951 * the 0 after the + or - and reduce the length by 1
5953 char *e = strchr(buf, 'e');
5954 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5955 /* Move it up */
5956 e += 2;
5957 memmove(e, e + 1, len - (e - buf));
5959 #endif
5960 break;
5963 if (buf[i] == '\0') {
5964 buf[i++] = '.';
5965 buf[i++] = '0';
5966 buf[i] = '\0';
5968 JimSetStringBytes(objPtr, buf);
5972 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5974 double doubleValue;
5975 jim_wide wideValue;
5976 const char *str;
5978 /* Preserve the string representation.
5979 * Needed so we can convert back to int without loss
5981 str = Jim_String(objPtr);
5983 #ifdef HAVE_LONG_LONG
5984 /* Assume a 53 bit mantissa */
5985 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5986 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5988 if (objPtr->typePtr == &intObjType
5989 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5990 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5992 /* Direct conversion to coerced double */
5993 objPtr->typePtr = &coercedDoubleObjType;
5994 return JIM_OK;
5996 else
5997 #endif
5998 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5999 /* Managed to convert to an int, so we can use this as a cooerced double */
6000 Jim_FreeIntRep(interp, objPtr);
6001 objPtr->typePtr = &coercedDoubleObjType;
6002 objPtr->internalRep.wideValue = wideValue;
6003 return JIM_OK;
6005 else {
6006 /* Try to convert into a double */
6007 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6008 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6009 return JIM_ERR;
6011 /* Free the old internal repr and set the new one. */
6012 Jim_FreeIntRep(interp, objPtr);
6014 objPtr->typePtr = &doubleObjType;
6015 objPtr->internalRep.doubleValue = doubleValue;
6016 return JIM_OK;
6019 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6021 if (objPtr->typePtr == &coercedDoubleObjType) {
6022 *doublePtr = JimWideValue(objPtr);
6023 return JIM_OK;
6025 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6026 return JIM_ERR;
6028 if (objPtr->typePtr == &coercedDoubleObjType) {
6029 *doublePtr = JimWideValue(objPtr);
6031 else {
6032 *doublePtr = objPtr->internalRep.doubleValue;
6034 return JIM_OK;
6037 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6039 Jim_Obj *objPtr;
6041 objPtr = Jim_NewObj(interp);
6042 objPtr->typePtr = &doubleObjType;
6043 objPtr->bytes = NULL;
6044 objPtr->internalRep.doubleValue = doubleValue;
6045 return objPtr;
6048 /* -----------------------------------------------------------------------------
6049 * List object
6050 * ---------------------------------------------------------------------------*/
6051 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6052 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6053 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6054 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6055 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6056 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6058 /* Note that while the elements of the list may contain references,
6059 * the list object itself can't. This basically means that the
6060 * list object string representation as a whole can't contain references
6061 * that are not presents in the single elements. */
6062 static const Jim_ObjType listObjType = {
6063 "list",
6064 FreeListInternalRep,
6065 DupListInternalRep,
6066 UpdateStringOfList,
6067 JIM_TYPE_NONE,
6070 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6072 int i;
6074 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6075 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6077 Jim_Free(objPtr->internalRep.listValue.ele);
6080 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6082 int i;
6084 JIM_NOTUSED(interp);
6086 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6087 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6088 dupPtr->internalRep.listValue.ele =
6089 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6090 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6091 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6092 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6093 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6095 dupPtr->typePtr = &listObjType;
6098 /* The following function checks if a given string can be encoded
6099 * into a list element without any kind of quoting, surrounded by braces,
6100 * or using escapes to quote. */
6101 #define JIM_ELESTR_SIMPLE 0
6102 #define JIM_ELESTR_BRACE 1
6103 #define JIM_ELESTR_QUOTE 2
6104 static unsigned char ListElementQuotingType(const char *s, int len)
6106 int i, level, blevel, trySimple = 1;
6108 /* Try with the SIMPLE case */
6109 if (len == 0)
6110 return JIM_ELESTR_BRACE;
6111 if (s[0] == '"' || s[0] == '{') {
6112 trySimple = 0;
6113 goto testbrace;
6115 for (i = 0; i < len; i++) {
6116 switch (s[i]) {
6117 case ' ':
6118 case '$':
6119 case '"':
6120 case '[':
6121 case ']':
6122 case ';':
6123 case '\\':
6124 case '\r':
6125 case '\n':
6126 case '\t':
6127 case '\f':
6128 case '\v':
6129 trySimple = 0;
6130 case '{':
6131 case '}':
6132 goto testbrace;
6135 return JIM_ELESTR_SIMPLE;
6137 testbrace:
6138 /* Test if it's possible to do with braces */
6139 if (s[len - 1] == '\\')
6140 return JIM_ELESTR_QUOTE;
6141 level = 0;
6142 blevel = 0;
6143 for (i = 0; i < len; i++) {
6144 switch (s[i]) {
6145 case '{':
6146 level++;
6147 break;
6148 case '}':
6149 level--;
6150 if (level < 0)
6151 return JIM_ELESTR_QUOTE;
6152 break;
6153 case '[':
6154 blevel++;
6155 break;
6156 case ']':
6157 blevel--;
6158 break;
6159 case '\\':
6160 if (s[i + 1] == '\n')
6161 return JIM_ELESTR_QUOTE;
6162 else if (s[i + 1] != '\0')
6163 i++;
6164 break;
6167 if (blevel < 0) {
6168 return JIM_ELESTR_QUOTE;
6171 if (level == 0) {
6172 if (!trySimple)
6173 return JIM_ELESTR_BRACE;
6174 for (i = 0; i < len; i++) {
6175 switch (s[i]) {
6176 case ' ':
6177 case '$':
6178 case '"':
6179 case '[':
6180 case ']':
6181 case ';':
6182 case '\\':
6183 case '\r':
6184 case '\n':
6185 case '\t':
6186 case '\f':
6187 case '\v':
6188 return JIM_ELESTR_BRACE;
6189 break;
6192 return JIM_ELESTR_SIMPLE;
6194 return JIM_ELESTR_QUOTE;
6197 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6198 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6199 * scenario.
6200 * Returns the length of the result.
6202 static int BackslashQuoteString(const char *s, int len, char *q)
6204 char *p = q;
6206 while (len--) {
6207 switch (*s) {
6208 case ' ':
6209 case '$':
6210 case '"':
6211 case '[':
6212 case ']':
6213 case '{':
6214 case '}':
6215 case ';':
6216 case '\\':
6217 *p++ = '\\';
6218 *p++ = *s++;
6219 break;
6220 case '\n':
6221 *p++ = '\\';
6222 *p++ = 'n';
6223 s++;
6224 break;
6225 case '\r':
6226 *p++ = '\\';
6227 *p++ = 'r';
6228 s++;
6229 break;
6230 case '\t':
6231 *p++ = '\\';
6232 *p++ = 't';
6233 s++;
6234 break;
6235 case '\f':
6236 *p++ = '\\';
6237 *p++ = 'f';
6238 s++;
6239 break;
6240 case '\v':
6241 *p++ = '\\';
6242 *p++ = 'v';
6243 s++;
6244 break;
6245 default:
6246 *p++ = *s++;
6247 break;
6250 *p = '\0';
6252 return p - q;
6255 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6257 #define STATIC_QUOTING_LEN 32
6258 int i, bufLen, realLength;
6259 const char *strRep;
6260 char *p;
6261 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6263 /* Estimate the space needed. */
6264 if (objc > STATIC_QUOTING_LEN) {
6265 quotingType = Jim_Alloc(objc);
6267 else {
6268 quotingType = staticQuoting;
6270 bufLen = 0;
6271 for (i = 0; i < objc; i++) {
6272 int len;
6274 strRep = Jim_GetString(objv[i], &len);
6275 quotingType[i] = ListElementQuotingType(strRep, len);
6276 switch (quotingType[i]) {
6277 case JIM_ELESTR_SIMPLE:
6278 if (i != 0 || strRep[0] != '#') {
6279 bufLen += len;
6280 break;
6282 /* Special case '#' on first element needs braces */
6283 quotingType[i] = JIM_ELESTR_BRACE;
6284 /* fall through */
6285 case JIM_ELESTR_BRACE:
6286 bufLen += len + 2;
6287 break;
6288 case JIM_ELESTR_QUOTE:
6289 bufLen += len * 2;
6290 break;
6292 bufLen++; /* elements separator. */
6294 bufLen++;
6296 /* Generate the string rep. */
6297 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6298 realLength = 0;
6299 for (i = 0; i < objc; i++) {
6300 int len, qlen;
6302 strRep = Jim_GetString(objv[i], &len);
6304 switch (quotingType[i]) {
6305 case JIM_ELESTR_SIMPLE:
6306 memcpy(p, strRep, len);
6307 p += len;
6308 realLength += len;
6309 break;
6310 case JIM_ELESTR_BRACE:
6311 *p++ = '{';
6312 memcpy(p, strRep, len);
6313 p += len;
6314 *p++ = '}';
6315 realLength += len + 2;
6316 break;
6317 case JIM_ELESTR_QUOTE:
6318 if (i == 0 && strRep[0] == '#') {
6319 *p++ = '\\';
6320 realLength++;
6322 qlen = BackslashQuoteString(strRep, len, p);
6323 p += qlen;
6324 realLength += qlen;
6325 break;
6327 /* Add a separating space */
6328 if (i + 1 != objc) {
6329 *p++ = ' ';
6330 realLength++;
6333 *p = '\0'; /* nul term. */
6334 objPtr->length = realLength;
6336 if (quotingType != staticQuoting) {
6337 Jim_Free(quotingType);
6341 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6343 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6346 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6348 struct JimParserCtx parser;
6349 const char *str;
6350 int strLen;
6351 Jim_Obj *fileNameObj;
6352 int linenr;
6354 if (objPtr->typePtr == &listObjType) {
6355 return JIM_OK;
6358 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6359 * it also preserves any source location of the dict elements
6360 * which can be very useful
6362 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6363 Jim_Obj **listObjPtrPtr;
6364 int len;
6365 int i;
6367 listObjPtrPtr = JimDictPairs(objPtr, &len);
6368 for (i = 0; i < len; i++) {
6369 Jim_IncrRefCount(listObjPtrPtr[i]);
6372 /* Now just switch the internal rep */
6373 Jim_FreeIntRep(interp, objPtr);
6374 objPtr->typePtr = &listObjType;
6375 objPtr->internalRep.listValue.len = len;
6376 objPtr->internalRep.listValue.maxLen = len;
6377 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6379 return JIM_OK;
6382 /* Try to preserve information about filename / line number */
6383 if (objPtr->typePtr == &sourceObjType) {
6384 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6385 linenr = objPtr->internalRep.sourceValue.lineNumber;
6387 else {
6388 fileNameObj = interp->emptyObj;
6389 linenr = 1;
6391 Jim_IncrRefCount(fileNameObj);
6393 /* Get the string representation */
6394 str = Jim_GetString(objPtr, &strLen);
6396 /* Free the old internal repr just now and initialize the
6397 * new one just now. The string->list conversion can't fail. */
6398 Jim_FreeIntRep(interp, objPtr);
6399 objPtr->typePtr = &listObjType;
6400 objPtr->internalRep.listValue.len = 0;
6401 objPtr->internalRep.listValue.maxLen = 0;
6402 objPtr->internalRep.listValue.ele = NULL;
6404 /* Convert into a list */
6405 if (strLen) {
6406 JimParserInit(&parser, str, strLen, linenr);
6407 while (!parser.eof) {
6408 Jim_Obj *elementPtr;
6410 JimParseList(&parser);
6411 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6412 continue;
6413 elementPtr = JimParserGetTokenObj(interp, &parser);
6414 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6415 ListAppendElement(objPtr, elementPtr);
6418 Jim_DecrRefCount(interp, fileNameObj);
6419 return JIM_OK;
6422 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6424 Jim_Obj *objPtr;
6426 objPtr = Jim_NewObj(interp);
6427 objPtr->typePtr = &listObjType;
6428 objPtr->bytes = NULL;
6429 objPtr->internalRep.listValue.ele = NULL;
6430 objPtr->internalRep.listValue.len = 0;
6431 objPtr->internalRep.listValue.maxLen = 0;
6433 if (len) {
6434 ListInsertElements(objPtr, 0, len, elements);
6437 return objPtr;
6440 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6441 * length of the vector. Note that the user of this function should make
6442 * sure that the list object can't shimmer while the vector returned
6443 * is in use, this vector is the one stored inside the internal representation
6444 * of the list object. This function is not exported, extensions should
6445 * always access to the List object elements using Jim_ListIndex(). */
6446 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6447 Jim_Obj ***listVec)
6449 *listLen = Jim_ListLength(interp, listObj);
6450 *listVec = listObj->internalRep.listValue.ele;
6453 /* Sorting uses ints, but commands may return wide */
6454 static int JimSign(jim_wide w)
6456 if (w == 0) {
6457 return 0;
6459 else if (w < 0) {
6460 return -1;
6462 return 1;
6465 /* ListSortElements type values */
6466 struct lsort_info {
6467 jmp_buf jmpbuf;
6468 Jim_Obj *command;
6469 Jim_Interp *interp;
6470 enum {
6471 JIM_LSORT_ASCII,
6472 JIM_LSORT_NOCASE,
6473 JIM_LSORT_INTEGER,
6474 JIM_LSORT_REAL,
6475 JIM_LSORT_COMMAND
6476 } type;
6477 int order;
6478 int index;
6479 int indexed;
6480 int unique;
6481 int (*subfn)(Jim_Obj **, Jim_Obj **);
6484 static struct lsort_info *sort_info;
6486 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6488 Jim_Obj *lObj, *rObj;
6490 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6491 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6492 longjmp(sort_info->jmpbuf, JIM_ERR);
6494 return sort_info->subfn(&lObj, &rObj);
6497 /* Sort the internal rep of a list. */
6498 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6500 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6503 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6505 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6508 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6510 jim_wide lhs = 0, rhs = 0;
6512 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6513 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6514 longjmp(sort_info->jmpbuf, JIM_ERR);
6517 return JimSign(lhs - rhs) * sort_info->order;
6520 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6522 double lhs = 0, rhs = 0;
6524 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6525 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6526 longjmp(sort_info->jmpbuf, JIM_ERR);
6528 if (lhs == rhs) {
6529 return 0;
6531 if (lhs > rhs) {
6532 return sort_info->order;
6534 return -sort_info->order;
6537 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6539 Jim_Obj *compare_script;
6540 int rc;
6542 jim_wide ret = 0;
6544 /* This must be a valid list */
6545 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6546 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6547 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6549 rc = Jim_EvalObj(sort_info->interp, compare_script);
6551 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6552 longjmp(sort_info->jmpbuf, rc);
6555 return JimSign(ret) * sort_info->order;
6558 /* Remove duplicate elements from the (sorted) list in-place, according to the
6559 * comparison function, comp.
6561 * Note that the last unique value is kept, not the first
6563 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6565 int src;
6566 int dst = 0;
6567 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6569 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6570 if (comp(&ele[dst], &ele[src]) == 0) {
6571 /* Match, so replace the dest with the current source */
6572 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6574 else {
6575 /* No match, so keep the current source and move to the next destination */
6576 dst++;
6578 ele[dst] = ele[src];
6580 /* At end of list, keep the final element */
6581 ele[++dst] = ele[src];
6583 /* Set the new length */
6584 listObjPtr->internalRep.listValue.len = dst;
6587 /* Sort a list *in place*. MUST be called with a non-shared list. */
6588 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6590 struct lsort_info *prev_info;
6592 typedef int (qsort_comparator) (const void *, const void *);
6593 int (*fn) (Jim_Obj **, Jim_Obj **);
6594 Jim_Obj **vector;
6595 int len;
6596 int rc;
6598 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6599 SetListFromAny(interp, listObjPtr);
6601 /* Allow lsort to be called reentrantly */
6602 prev_info = sort_info;
6603 sort_info = info;
6605 vector = listObjPtr->internalRep.listValue.ele;
6606 len = listObjPtr->internalRep.listValue.len;
6607 switch (info->type) {
6608 case JIM_LSORT_ASCII:
6609 fn = ListSortString;
6610 break;
6611 case JIM_LSORT_NOCASE:
6612 fn = ListSortStringNoCase;
6613 break;
6614 case JIM_LSORT_INTEGER:
6615 fn = ListSortInteger;
6616 break;
6617 case JIM_LSORT_REAL:
6618 fn = ListSortReal;
6619 break;
6620 case JIM_LSORT_COMMAND:
6621 fn = ListSortCommand;
6622 break;
6623 default:
6624 fn = NULL; /* avoid warning */
6625 JimPanic((1, "ListSort called with invalid sort type"));
6628 if (info->indexed) {
6629 /* Need to interpose a "list index" function */
6630 info->subfn = fn;
6631 fn = ListSortIndexHelper;
6634 if ((rc = setjmp(info->jmpbuf)) == 0) {
6635 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6637 if (info->unique && len > 1) {
6638 ListRemoveDuplicates(listObjPtr, fn);
6641 Jim_InvalidateStringRep(listObjPtr);
6643 sort_info = prev_info;
6645 return rc;
6648 /* This is the low-level function to insert elements into a list.
6649 * The higher-level Jim_ListInsertElements() performs shared object
6650 * check and invalidates the string repr. This version is used
6651 * in the internals of the List Object and is not exported.
6653 * NOTE: this function can be called only against objects
6654 * with internal type of List.
6656 * An insertion point (idx) of -1 means end-of-list.
6658 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6660 int currentLen = listPtr->internalRep.listValue.len;
6661 int requiredLen = currentLen + elemc;
6662 int i;
6663 Jim_Obj **point;
6665 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6666 if (requiredLen < 2) {
6667 /* Don't do allocations of under 4 pointers. */
6668 requiredLen = 4;
6670 else {
6671 requiredLen *= 2;
6674 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6675 sizeof(Jim_Obj *) * requiredLen);
6677 listPtr->internalRep.listValue.maxLen = requiredLen;
6679 if (idx < 0) {
6680 idx = currentLen;
6682 point = listPtr->internalRep.listValue.ele + idx;
6683 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6684 for (i = 0; i < elemc; ++i) {
6685 point[i] = elemVec[i];
6686 Jim_IncrRefCount(point[i]);
6688 listPtr->internalRep.listValue.len += elemc;
6691 /* Convenience call to ListInsertElements() to append a single element.
6693 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6695 ListInsertElements(listPtr, -1, 1, &objPtr);
6698 /* Appends every element of appendListPtr into listPtr.
6699 * Both have to be of the list type.
6700 * Convenience call to ListInsertElements()
6702 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6704 ListInsertElements(listPtr, -1,
6705 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6708 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6710 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6711 SetListFromAny(interp, listPtr);
6712 Jim_InvalidateStringRep(listPtr);
6713 ListAppendElement(listPtr, objPtr);
6716 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6718 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6719 SetListFromAny(interp, listPtr);
6720 SetListFromAny(interp, appendListPtr);
6721 Jim_InvalidateStringRep(listPtr);
6722 ListAppendList(listPtr, appendListPtr);
6725 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6727 SetListFromAny(interp, objPtr);
6728 return objPtr->internalRep.listValue.len;
6731 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6732 int objc, Jim_Obj *const *objVec)
6734 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6735 SetListFromAny(interp, listPtr);
6736 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6737 idx = listPtr->internalRep.listValue.len;
6738 else if (idx < 0)
6739 idx = 0;
6740 Jim_InvalidateStringRep(listPtr);
6741 ListInsertElements(listPtr, idx, objc, objVec);
6744 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6746 SetListFromAny(interp, listPtr);
6747 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6748 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6749 return NULL;
6751 if (idx < 0)
6752 idx = listPtr->internalRep.listValue.len + idx;
6753 return listPtr->internalRep.listValue.ele[idx];
6756 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6758 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6759 if (*objPtrPtr == NULL) {
6760 if (flags & JIM_ERRMSG) {
6761 Jim_SetResultString(interp, "list index out of range", -1);
6763 return JIM_ERR;
6765 return JIM_OK;
6768 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6769 Jim_Obj *newObjPtr, int flags)
6771 SetListFromAny(interp, listPtr);
6772 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6773 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6774 if (flags & JIM_ERRMSG) {
6775 Jim_SetResultString(interp, "list index out of range", -1);
6777 return JIM_ERR;
6779 if (idx < 0)
6780 idx = listPtr->internalRep.listValue.len + idx;
6781 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6782 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6783 Jim_IncrRefCount(newObjPtr);
6784 return JIM_OK;
6787 /* Modify the list stored in the variable named 'varNamePtr'
6788 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6789 * with the new element 'newObjptr'. (implements the [lset] command) */
6790 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6791 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6793 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6794 int shared, i, idx;
6796 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6797 if (objPtr == NULL)
6798 return JIM_ERR;
6799 if ((shared = Jim_IsShared(objPtr)))
6800 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6801 for (i = 0; i < indexc - 1; i++) {
6802 listObjPtr = objPtr;
6803 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6804 goto err;
6805 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6806 goto err;
6808 if (Jim_IsShared(objPtr)) {
6809 objPtr = Jim_DuplicateObj(interp, objPtr);
6810 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6812 Jim_InvalidateStringRep(listObjPtr);
6814 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6815 goto err;
6816 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6817 goto err;
6818 Jim_InvalidateStringRep(objPtr);
6819 Jim_InvalidateStringRep(varObjPtr);
6820 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6821 goto err;
6822 Jim_SetResult(interp, varObjPtr);
6823 return JIM_OK;
6824 err:
6825 if (shared) {
6826 Jim_FreeNewObj(interp, varObjPtr);
6828 return JIM_ERR;
6831 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6833 int i;
6834 int listLen = Jim_ListLength(interp, listObjPtr);
6835 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6837 for (i = 0; i < listLen; ) {
6838 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6839 if (++i != listLen) {
6840 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6843 return resObjPtr;
6846 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6848 int i;
6850 /* If all the objects in objv are lists,
6851 * it's possible to return a list as result, that's the
6852 * concatenation of all the lists. */
6853 for (i = 0; i < objc; i++) {
6854 if (!Jim_IsList(objv[i]))
6855 break;
6857 if (i == objc) {
6858 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6860 for (i = 0; i < objc; i++)
6861 ListAppendList(objPtr, objv[i]);
6862 return objPtr;
6864 else {
6865 /* Else... we have to glue strings together */
6866 int len = 0, objLen;
6867 char *bytes, *p;
6869 /* Compute the length */
6870 for (i = 0; i < objc; i++) {
6871 len += Jim_Length(objv[i]);
6873 if (objc)
6874 len += objc - 1;
6875 /* Create the string rep, and a string object holding it. */
6876 p = bytes = Jim_Alloc(len + 1);
6877 for (i = 0; i < objc; i++) {
6878 const char *s = Jim_GetString(objv[i], &objLen);
6880 /* Remove leading space */
6881 while (objLen && isspace(UCHAR(*s))) {
6882 s++;
6883 objLen--;
6884 len--;
6886 /* And trailing space */
6887 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6888 /* Handle trailing backslash-space case */
6889 if (objLen > 1 && s[objLen - 2] == '\\') {
6890 break;
6892 objLen--;
6893 len--;
6895 memcpy(p, s, objLen);
6896 p += objLen;
6897 if (i + 1 != objc) {
6898 if (objLen)
6899 *p++ = ' ';
6900 else {
6901 /* Drop the space calcuated for this
6902 * element that is instead null. */
6903 len--;
6907 *p = '\0';
6908 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6912 /* Returns a list composed of the elements in the specified range.
6913 * first and start are directly accepted as Jim_Objects and
6914 * processed for the end?-index? case. */
6915 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6916 Jim_Obj *lastObjPtr)
6918 int first, last;
6919 int len, rangeLen;
6921 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6922 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6923 return NULL;
6924 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6925 first = JimRelToAbsIndex(len, first);
6926 last = JimRelToAbsIndex(len, last);
6927 JimRelToAbsRange(len, &first, &last, &rangeLen);
6928 if (first == 0 && last == len) {
6929 return listObjPtr;
6931 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6934 /* -----------------------------------------------------------------------------
6935 * Dict object
6936 * ---------------------------------------------------------------------------*/
6937 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6938 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6939 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6940 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6942 /* Dict HashTable Type.
6944 * Keys and Values are Jim objects. */
6946 static unsigned int JimObjectHTHashFunction(const void *key)
6948 int len;
6949 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6950 return Jim_GenHashFunction((const unsigned char *)str, len);
6953 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6955 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6958 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6960 Jim_IncrRefCount((Jim_Obj *)val);
6961 return (void *)val;
6964 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6966 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6969 static const Jim_HashTableType JimDictHashTableType = {
6970 JimObjectHTHashFunction, /* hash function */
6971 JimObjectHTKeyValDup, /* key dup */
6972 JimObjectHTKeyValDup, /* val dup */
6973 JimObjectHTKeyCompare, /* key compare */
6974 JimObjectHTKeyValDestructor, /* key destructor */
6975 JimObjectHTKeyValDestructor /* val destructor */
6978 /* Note that while the elements of the dict may contain references,
6979 * the list object itself can't. This basically means that the
6980 * dict object string representation as a whole can't contain references
6981 * that are not presents in the single elements. */
6982 static const Jim_ObjType dictObjType = {
6983 "dict",
6984 FreeDictInternalRep,
6985 DupDictInternalRep,
6986 UpdateStringOfDict,
6987 JIM_TYPE_NONE,
6990 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6992 JIM_NOTUSED(interp);
6994 Jim_FreeHashTable(objPtr->internalRep.ptr);
6995 Jim_Free(objPtr->internalRep.ptr);
6998 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7000 Jim_HashTable *ht, *dupHt;
7001 Jim_HashTableIterator htiter;
7002 Jim_HashEntry *he;
7004 /* Create a new hash table */
7005 ht = srcPtr->internalRep.ptr;
7006 dupHt = Jim_Alloc(sizeof(*dupHt));
7007 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7008 if (ht->size != 0)
7009 Jim_ExpandHashTable(dupHt, ht->size);
7010 /* Copy every element from the source to the dup hash table */
7011 JimInitHashTableIterator(ht, &htiter);
7012 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7013 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7016 dupPtr->internalRep.ptr = dupHt;
7017 dupPtr->typePtr = &dictObjType;
7020 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7022 Jim_HashTable *ht;
7023 Jim_HashTableIterator htiter;
7024 Jim_HashEntry *he;
7025 Jim_Obj **objv;
7026 int i;
7028 ht = dictPtr->internalRep.ptr;
7030 /* Turn the hash table into a flat vector of Jim_Objects. */
7031 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7032 JimInitHashTableIterator(ht, &htiter);
7033 i = 0;
7034 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7035 objv[i++] = Jim_GetHashEntryKey(he);
7036 objv[i++] = Jim_GetHashEntryVal(he);
7038 *len = i;
7039 return objv;
7042 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7044 /* Turn the hash table into a flat vector of Jim_Objects. */
7045 int len;
7046 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7048 /* And now generate the string rep as a list */
7049 JimMakeListStringRep(objPtr, objv, len);
7051 Jim_Free(objv);
7054 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7056 int listlen;
7058 if (objPtr->typePtr == &dictObjType) {
7059 return JIM_OK;
7062 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7063 /* A shared list, so get the string representation now to avoid
7064 * changing the order in case of fast conversion to dict.
7066 Jim_String(objPtr);
7069 /* For simplicity, convert a non-list object to a list and then to a dict */
7070 listlen = Jim_ListLength(interp, objPtr);
7071 if (listlen % 2) {
7072 Jim_SetResultString(interp, "missing value to go with key", -1);
7073 return JIM_ERR;
7075 else {
7076 /* Converting from a list to a dict can't fail */
7077 Jim_HashTable *ht;
7078 int i;
7080 ht = Jim_Alloc(sizeof(*ht));
7081 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7083 for (i = 0; i < listlen; i += 2) {
7084 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7085 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7087 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7090 Jim_FreeIntRep(interp, objPtr);
7091 objPtr->typePtr = &dictObjType;
7092 objPtr->internalRep.ptr = ht;
7094 return JIM_OK;
7098 /* Dict object API */
7100 /* Add an element to a dict. objPtr must be of the "dict" type.
7101 * The higer-level exported function is Jim_DictAddElement().
7102 * If an element with the specified key already exists, the value
7103 * associated is replaced with the new one.
7105 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7106 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7107 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7109 Jim_HashTable *ht = objPtr->internalRep.ptr;
7111 if (valueObjPtr == NULL) { /* unset */
7112 return Jim_DeleteHashEntry(ht, keyObjPtr);
7114 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7115 return JIM_OK;
7118 /* Add an element, higher-level interface for DictAddElement().
7119 * If valueObjPtr == NULL, the key is removed if it exists. */
7120 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7121 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7123 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7124 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7125 return JIM_ERR;
7127 Jim_InvalidateStringRep(objPtr);
7128 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7131 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7133 Jim_Obj *objPtr;
7134 int i;
7136 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7138 objPtr = Jim_NewObj(interp);
7139 objPtr->typePtr = &dictObjType;
7140 objPtr->bytes = NULL;
7141 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7142 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7143 for (i = 0; i < len; i += 2)
7144 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7145 return objPtr;
7148 /* Return the value associated to the specified dict key
7149 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7151 * Sets *objPtrPtr to non-NULL only upon success.
7153 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7154 Jim_Obj **objPtrPtr, int flags)
7156 Jim_HashEntry *he;
7157 Jim_HashTable *ht;
7159 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7160 return -1;
7162 ht = dictPtr->internalRep.ptr;
7163 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7164 if (flags & JIM_ERRMSG) {
7165 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7167 return JIM_ERR;
7169 *objPtrPtr = he->u.val;
7170 return JIM_OK;
7173 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7174 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7176 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7177 return JIM_ERR;
7179 *objPtrPtr = JimDictPairs(dictPtr, len);
7181 return JIM_OK;
7185 /* Return the value associated to the specified dict keys */
7186 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7187 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7189 int i;
7191 if (keyc == 0) {
7192 *objPtrPtr = dictPtr;
7193 return JIM_OK;
7196 for (i = 0; i < keyc; i++) {
7197 Jim_Obj *objPtr;
7199 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7200 if (rc != JIM_OK) {
7201 return rc;
7203 dictPtr = objPtr;
7205 *objPtrPtr = dictPtr;
7206 return JIM_OK;
7209 /* Modify the dict stored into the variable named 'varNamePtr'
7210 * setting the element specified by the 'keyc' keys objects in 'keyv',
7211 * with the new value of the element 'newObjPtr'.
7213 * If newObjPtr == NULL the operation is to remove the given key
7214 * from the dictionary.
7216 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7217 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7219 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7220 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7222 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7223 int shared, i;
7225 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7226 if (objPtr == NULL) {
7227 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7228 /* Cannot remove a key from non existing var */
7229 return JIM_ERR;
7231 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7232 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7233 Jim_FreeNewObj(interp, varObjPtr);
7234 return JIM_ERR;
7237 if ((shared = Jim_IsShared(objPtr)))
7238 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7239 for (i = 0; i < keyc; i++) {
7240 dictObjPtr = objPtr;
7242 /* Check if it's a valid dictionary */
7243 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7244 goto err;
7247 if (i == keyc - 1) {
7248 /* Last key: Note that error on unset with missing last key is OK */
7249 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7250 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7251 goto err;
7254 break;
7257 /* Check if the given key exists. */
7258 Jim_InvalidateStringRep(dictObjPtr);
7259 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7260 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7261 /* This key exists at the current level.
7262 * Make sure it's not shared!. */
7263 if (Jim_IsShared(objPtr)) {
7264 objPtr = Jim_DuplicateObj(interp, objPtr);
7265 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7268 else {
7269 /* Key not found. If it's an [unset] operation
7270 * this is an error. Only the last key may not
7271 * exist. */
7272 if (newObjPtr == NULL) {
7273 goto err;
7275 /* Otherwise set an empty dictionary
7276 * as key's value. */
7277 objPtr = Jim_NewDictObj(interp, NULL, 0);
7278 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7281 /* XXX: Is this necessary? */
7282 Jim_InvalidateStringRep(objPtr);
7283 Jim_InvalidateStringRep(varObjPtr);
7284 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7285 goto err;
7287 Jim_SetResult(interp, varObjPtr);
7288 return JIM_OK;
7289 err:
7290 if (shared) {
7291 Jim_FreeNewObj(interp, varObjPtr);
7293 return JIM_ERR;
7296 /* -----------------------------------------------------------------------------
7297 * Index object
7298 * ---------------------------------------------------------------------------*/
7299 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7300 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7302 static const Jim_ObjType indexObjType = {
7303 "index",
7304 NULL,
7305 NULL,
7306 UpdateStringOfIndex,
7307 JIM_TYPE_NONE,
7310 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7312 if (objPtr->internalRep.intValue == -1) {
7313 JimSetStringBytes(objPtr, "end");
7315 else {
7316 char buf[JIM_INTEGER_SPACE + 1];
7317 if (objPtr->internalRep.intValue >= 0) {
7318 sprintf(buf, "%d", objPtr->internalRep.intValue);
7320 else {
7321 /* Must be <= -2 */
7322 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7324 JimSetStringBytes(objPtr, buf);
7328 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7330 int idx, end = 0;
7331 const char *str;
7332 char *endptr;
7334 /* Get the string representation */
7335 str = Jim_String(objPtr);
7337 /* Try to convert into an index */
7338 if (strncmp(str, "end", 3) == 0) {
7339 end = 1;
7340 str += 3;
7341 idx = 0;
7343 else {
7344 idx = jim_strtol(str, &endptr);
7346 if (endptr == str) {
7347 goto badindex;
7349 str = endptr;
7352 /* Now str may include or +<num> or -<num> */
7353 if (*str == '+' || *str == '-') {
7354 int sign = (*str == '+' ? 1 : -1);
7356 idx += sign * jim_strtol(++str, &endptr);
7357 if (str == endptr || *endptr) {
7358 goto badindex;
7360 str = endptr;
7362 /* The only thing left should be spaces */
7363 while (isspace(UCHAR(*str))) {
7364 str++;
7366 if (*str) {
7367 goto badindex;
7369 if (end) {
7370 if (idx > 0) {
7371 idx = INT_MAX;
7373 else {
7374 /* end-1 is repesented as -2 */
7375 idx--;
7378 else if (idx < 0) {
7379 idx = -INT_MAX;
7382 /* Free the old internal repr and set the new one. */
7383 Jim_FreeIntRep(interp, objPtr);
7384 objPtr->typePtr = &indexObjType;
7385 objPtr->internalRep.intValue = idx;
7386 return JIM_OK;
7388 badindex:
7389 Jim_SetResultFormatted(interp,
7390 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7391 return JIM_ERR;
7394 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7396 /* Avoid shimmering if the object is an integer. */
7397 if (objPtr->typePtr == &intObjType) {
7398 jim_wide val = JimWideValue(objPtr);
7400 if (val < 0)
7401 *indexPtr = -INT_MAX;
7402 else if (val > INT_MAX)
7403 *indexPtr = INT_MAX;
7404 else
7405 *indexPtr = (int)val;
7406 return JIM_OK;
7408 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7409 return JIM_ERR;
7410 *indexPtr = objPtr->internalRep.intValue;
7411 return JIM_OK;
7414 /* -----------------------------------------------------------------------------
7415 * Return Code Object.
7416 * ---------------------------------------------------------------------------*/
7418 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7419 static const char * const jimReturnCodes[] = {
7420 "ok",
7421 "error",
7422 "return",
7423 "break",
7424 "continue",
7425 "signal",
7426 "exit",
7427 "eval",
7428 NULL
7431 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7433 static const Jim_ObjType returnCodeObjType = {
7434 "return-code",
7435 NULL,
7436 NULL,
7437 NULL,
7438 JIM_TYPE_NONE,
7441 /* Converts a (standard) return code to a string. Returns "?" for
7442 * non-standard return codes.
7444 const char *Jim_ReturnCode(int code)
7446 if (code < 0 || code >= (int)jimReturnCodesSize) {
7447 return "?";
7449 else {
7450 return jimReturnCodes[code];
7454 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7456 int returnCode;
7457 jim_wide wideValue;
7459 /* Try to convert into an integer */
7460 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7461 returnCode = (int)wideValue;
7462 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7463 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7464 return JIM_ERR;
7466 /* Free the old internal repr and set the new one. */
7467 Jim_FreeIntRep(interp, objPtr);
7468 objPtr->typePtr = &returnCodeObjType;
7469 objPtr->internalRep.intValue = returnCode;
7470 return JIM_OK;
7473 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7475 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7476 return JIM_ERR;
7477 *intPtr = objPtr->internalRep.intValue;
7478 return JIM_OK;
7481 /* -----------------------------------------------------------------------------
7482 * Expression Parsing
7483 * ---------------------------------------------------------------------------*/
7484 static int JimParseExprOperator(struct JimParserCtx *pc);
7485 static int JimParseExprNumber(struct JimParserCtx *pc);
7486 static int JimParseExprIrrational(struct JimParserCtx *pc);
7488 /* Exrp's Stack machine operators opcodes. */
7490 /* Binary operators (numbers) */
7491 enum
7493 /* Continues on from the JIM_TT_ space */
7494 /* Operations */
7495 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7496 JIM_EXPROP_DIV,
7497 JIM_EXPROP_MOD,
7498 JIM_EXPROP_SUB,
7499 JIM_EXPROP_ADD,
7500 JIM_EXPROP_LSHIFT,
7501 JIM_EXPROP_RSHIFT,
7502 JIM_EXPROP_ROTL,
7503 JIM_EXPROP_ROTR,
7504 JIM_EXPROP_LT,
7505 JIM_EXPROP_GT,
7506 JIM_EXPROP_LTE,
7507 JIM_EXPROP_GTE,
7508 JIM_EXPROP_NUMEQ,
7509 JIM_EXPROP_NUMNE,
7510 JIM_EXPROP_BITAND, /* 35 */
7511 JIM_EXPROP_BITXOR,
7512 JIM_EXPROP_BITOR,
7514 /* Note must keep these together */
7515 JIM_EXPROP_LOGICAND, /* 38 */
7516 JIM_EXPROP_LOGICAND_LEFT,
7517 JIM_EXPROP_LOGICAND_RIGHT,
7519 /* and these */
7520 JIM_EXPROP_LOGICOR, /* 41 */
7521 JIM_EXPROP_LOGICOR_LEFT,
7522 JIM_EXPROP_LOGICOR_RIGHT,
7524 /* and these */
7525 /* Ternary operators */
7526 JIM_EXPROP_TERNARY, /* 44 */
7527 JIM_EXPROP_TERNARY_LEFT,
7528 JIM_EXPROP_TERNARY_RIGHT,
7530 /* and these */
7531 JIM_EXPROP_COLON, /* 47 */
7532 JIM_EXPROP_COLON_LEFT,
7533 JIM_EXPROP_COLON_RIGHT,
7535 JIM_EXPROP_POW, /* 50 */
7537 /* Binary operators (strings) */
7538 JIM_EXPROP_STREQ, /* 51 */
7539 JIM_EXPROP_STRNE,
7540 JIM_EXPROP_STRIN,
7541 JIM_EXPROP_STRNI,
7543 /* Unary operators (numbers) */
7544 JIM_EXPROP_NOT, /* 55 */
7545 JIM_EXPROP_BITNOT,
7546 JIM_EXPROP_UNARYMINUS,
7547 JIM_EXPROP_UNARYPLUS,
7549 /* Functions */
7550 JIM_EXPROP_FUNC_FIRST, /* 59 */
7551 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7552 JIM_EXPROP_FUNC_WIDE,
7553 JIM_EXPROP_FUNC_ABS,
7554 JIM_EXPROP_FUNC_DOUBLE,
7555 JIM_EXPROP_FUNC_ROUND,
7556 JIM_EXPROP_FUNC_RAND,
7557 JIM_EXPROP_FUNC_SRAND,
7559 /* math functions from libm */
7560 JIM_EXPROP_FUNC_SIN, /* 65 */
7561 JIM_EXPROP_FUNC_COS,
7562 JIM_EXPROP_FUNC_TAN,
7563 JIM_EXPROP_FUNC_ASIN,
7564 JIM_EXPROP_FUNC_ACOS,
7565 JIM_EXPROP_FUNC_ATAN,
7566 JIM_EXPROP_FUNC_SINH,
7567 JIM_EXPROP_FUNC_COSH,
7568 JIM_EXPROP_FUNC_TANH,
7569 JIM_EXPROP_FUNC_CEIL,
7570 JIM_EXPROP_FUNC_FLOOR,
7571 JIM_EXPROP_FUNC_EXP,
7572 JIM_EXPROP_FUNC_LOG,
7573 JIM_EXPROP_FUNC_LOG10,
7574 JIM_EXPROP_FUNC_SQRT,
7575 JIM_EXPROP_FUNC_POW,
7578 struct JimExprState
7580 Jim_Obj **stack;
7581 int stacklen;
7582 int opcode;
7583 int skip;
7586 /* Operators table */
7587 typedef struct Jim_ExprOperator
7589 const char *name;
7590 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7591 unsigned char precedence;
7592 unsigned char arity;
7593 unsigned char lazy;
7594 unsigned char namelen;
7595 } Jim_ExprOperator;
7597 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7599 Jim_IncrRefCount(obj);
7600 e->stack[e->stacklen++] = obj;
7603 static Jim_Obj *ExprPop(struct JimExprState *e)
7605 return e->stack[--e->stacklen];
7608 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7610 int intresult = 1;
7611 int rc = JIM_OK;
7612 Jim_Obj *A = ExprPop(e);
7613 double dA, dC = 0;
7614 jim_wide wA, wC = 0;
7616 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7617 switch (e->opcode) {
7618 case JIM_EXPROP_FUNC_INT:
7619 case JIM_EXPROP_FUNC_WIDE:
7620 case JIM_EXPROP_FUNC_ROUND:
7621 case JIM_EXPROP_UNARYPLUS:
7622 wC = wA;
7623 break;
7624 case JIM_EXPROP_FUNC_DOUBLE:
7625 dC = wA;
7626 intresult = 0;
7627 break;
7628 case JIM_EXPROP_FUNC_ABS:
7629 wC = wA >= 0 ? wA : -wA;
7630 break;
7631 case JIM_EXPROP_UNARYMINUS:
7632 wC = -wA;
7633 break;
7634 case JIM_EXPROP_NOT:
7635 wC = !wA;
7636 break;
7637 default:
7638 abort();
7641 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7642 switch (e->opcode) {
7643 case JIM_EXPROP_FUNC_INT:
7644 case JIM_EXPROP_FUNC_WIDE:
7645 wC = dA;
7646 break;
7647 case JIM_EXPROP_FUNC_ROUND:
7648 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7649 break;
7650 case JIM_EXPROP_FUNC_DOUBLE:
7651 case JIM_EXPROP_UNARYPLUS:
7652 dC = dA;
7653 intresult = 0;
7654 break;
7655 case JIM_EXPROP_FUNC_ABS:
7656 dC = dA >= 0 ? dA : -dA;
7657 intresult = 0;
7658 break;
7659 case JIM_EXPROP_UNARYMINUS:
7660 dC = -dA;
7661 intresult = 0;
7662 break;
7663 case JIM_EXPROP_NOT:
7664 wC = !dA;
7665 break;
7666 default:
7667 abort();
7671 if (rc == JIM_OK) {
7672 if (intresult) {
7673 ExprPush(e, Jim_NewIntObj(interp, wC));
7675 else {
7676 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7680 Jim_DecrRefCount(interp, A);
7682 return rc;
7685 static double JimRandDouble(Jim_Interp *interp)
7687 unsigned long x;
7688 JimRandomBytes(interp, &x, sizeof(x));
7690 return (double)x / (unsigned long)~0;
7693 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7695 Jim_Obj *A = ExprPop(e);
7696 jim_wide wA;
7698 int rc = Jim_GetWide(interp, A, &wA);
7699 if (rc == JIM_OK) {
7700 switch (e->opcode) {
7701 case JIM_EXPROP_BITNOT:
7702 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7703 break;
7704 case JIM_EXPROP_FUNC_SRAND:
7705 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7706 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7707 break;
7708 default:
7709 abort();
7713 Jim_DecrRefCount(interp, A);
7715 return rc;
7718 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7720 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7722 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7724 return JIM_OK;
7727 #ifdef JIM_MATH_FUNCTIONS
7728 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7730 int rc;
7731 Jim_Obj *A = ExprPop(e);
7732 double dA, dC;
7734 rc = Jim_GetDouble(interp, A, &dA);
7735 if (rc == JIM_OK) {
7736 switch (e->opcode) {
7737 case JIM_EXPROP_FUNC_SIN:
7738 dC = sin(dA);
7739 break;
7740 case JIM_EXPROP_FUNC_COS:
7741 dC = cos(dA);
7742 break;
7743 case JIM_EXPROP_FUNC_TAN:
7744 dC = tan(dA);
7745 break;
7746 case JIM_EXPROP_FUNC_ASIN:
7747 dC = asin(dA);
7748 break;
7749 case JIM_EXPROP_FUNC_ACOS:
7750 dC = acos(dA);
7751 break;
7752 case JIM_EXPROP_FUNC_ATAN:
7753 dC = atan(dA);
7754 break;
7755 case JIM_EXPROP_FUNC_SINH:
7756 dC = sinh(dA);
7757 break;
7758 case JIM_EXPROP_FUNC_COSH:
7759 dC = cosh(dA);
7760 break;
7761 case JIM_EXPROP_FUNC_TANH:
7762 dC = tanh(dA);
7763 break;
7764 case JIM_EXPROP_FUNC_CEIL:
7765 dC = ceil(dA);
7766 break;
7767 case JIM_EXPROP_FUNC_FLOOR:
7768 dC = floor(dA);
7769 break;
7770 case JIM_EXPROP_FUNC_EXP:
7771 dC = exp(dA);
7772 break;
7773 case JIM_EXPROP_FUNC_LOG:
7774 dC = log(dA);
7775 break;
7776 case JIM_EXPROP_FUNC_LOG10:
7777 dC = log10(dA);
7778 break;
7779 case JIM_EXPROP_FUNC_SQRT:
7780 dC = sqrt(dA);
7781 break;
7782 default:
7783 abort();
7785 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7788 Jim_DecrRefCount(interp, A);
7790 return rc;
7792 #endif
7794 /* A binary operation on two ints */
7795 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7797 Jim_Obj *B = ExprPop(e);
7798 Jim_Obj *A = ExprPop(e);
7799 jim_wide wA, wB;
7800 int rc = JIM_ERR;
7802 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7803 jim_wide wC;
7805 rc = JIM_OK;
7807 switch (e->opcode) {
7808 case JIM_EXPROP_LSHIFT:
7809 wC = wA << wB;
7810 break;
7811 case JIM_EXPROP_RSHIFT:
7812 wC = wA >> wB;
7813 break;
7814 case JIM_EXPROP_BITAND:
7815 wC = wA & wB;
7816 break;
7817 case JIM_EXPROP_BITXOR:
7818 wC = wA ^ wB;
7819 break;
7820 case JIM_EXPROP_BITOR:
7821 wC = wA | wB;
7822 break;
7823 case JIM_EXPROP_MOD:
7824 if (wB == 0) {
7825 wC = 0;
7826 Jim_SetResultString(interp, "Division by zero", -1);
7827 rc = JIM_ERR;
7829 else {
7831 * From Tcl 8.x
7833 * This code is tricky: C doesn't guarantee much
7834 * about the quotient or remainder, but Tcl does.
7835 * The remainder always has the same sign as the
7836 * divisor and a smaller absolute value.
7838 int negative = 0;
7840 if (wB < 0) {
7841 wB = -wB;
7842 wA = -wA;
7843 negative = 1;
7845 wC = wA % wB;
7846 if (wC < 0) {
7847 wC += wB;
7849 if (negative) {
7850 wC = -wC;
7853 break;
7854 case JIM_EXPROP_ROTL:
7855 case JIM_EXPROP_ROTR:{
7856 /* uint32_t would be better. But not everyone has inttypes.h? */
7857 unsigned long uA = (unsigned long)wA;
7858 unsigned long uB = (unsigned long)wB;
7859 const unsigned int S = sizeof(unsigned long) * 8;
7861 /* Shift left by the word size or more is undefined. */
7862 uB %= S;
7864 if (e->opcode == JIM_EXPROP_ROTR) {
7865 uB = S - uB;
7867 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7868 break;
7870 default:
7871 abort();
7873 ExprPush(e, Jim_NewIntObj(interp, wC));
7877 Jim_DecrRefCount(interp, A);
7878 Jim_DecrRefCount(interp, B);
7880 return rc;
7884 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7885 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7887 int intresult = 1;
7888 int rc = JIM_OK;
7889 double dA, dB, dC = 0;
7890 jim_wide wA, wB, wC = 0;
7892 Jim_Obj *B = ExprPop(e);
7893 Jim_Obj *A = ExprPop(e);
7895 if ((A->typePtr != &doubleObjType || A->bytes) &&
7896 (B->typePtr != &doubleObjType || B->bytes) &&
7897 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7899 /* Both are ints */
7901 switch (e->opcode) {
7902 case JIM_EXPROP_POW:
7903 case JIM_EXPROP_FUNC_POW:
7904 wC = JimPowWide(wA, wB);
7905 break;
7906 case JIM_EXPROP_ADD:
7907 wC = wA + wB;
7908 break;
7909 case JIM_EXPROP_SUB:
7910 wC = wA - wB;
7911 break;
7912 case JIM_EXPROP_MUL:
7913 wC = wA * wB;
7914 break;
7915 case JIM_EXPROP_DIV:
7916 if (wB == 0) {
7917 Jim_SetResultString(interp, "Division by zero", -1);
7918 rc = JIM_ERR;
7920 else {
7922 * From Tcl 8.x
7924 * This code is tricky: C doesn't guarantee much
7925 * about the quotient or remainder, but Tcl does.
7926 * The remainder always has the same sign as the
7927 * divisor and a smaller absolute value.
7929 if (wB < 0) {
7930 wB = -wB;
7931 wA = -wA;
7933 wC = wA / wB;
7934 if (wA % wB < 0) {
7935 wC--;
7938 break;
7939 case JIM_EXPROP_LT:
7940 wC = wA < wB;
7941 break;
7942 case JIM_EXPROP_GT:
7943 wC = wA > wB;
7944 break;
7945 case JIM_EXPROP_LTE:
7946 wC = wA <= wB;
7947 break;
7948 case JIM_EXPROP_GTE:
7949 wC = wA >= wB;
7950 break;
7951 case JIM_EXPROP_NUMEQ:
7952 wC = wA == wB;
7953 break;
7954 case JIM_EXPROP_NUMNE:
7955 wC = wA != wB;
7956 break;
7957 default:
7958 abort();
7961 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7962 intresult = 0;
7963 switch (e->opcode) {
7964 case JIM_EXPROP_POW:
7965 case JIM_EXPROP_FUNC_POW:
7966 #ifdef JIM_MATH_FUNCTIONS
7967 dC = pow(dA, dB);
7968 #else
7969 Jim_SetResultString(interp, "unsupported", -1);
7970 rc = JIM_ERR;
7971 #endif
7972 break;
7973 case JIM_EXPROP_ADD:
7974 dC = dA + dB;
7975 break;
7976 case JIM_EXPROP_SUB:
7977 dC = dA - dB;
7978 break;
7979 case JIM_EXPROP_MUL:
7980 dC = dA * dB;
7981 break;
7982 case JIM_EXPROP_DIV:
7983 if (dB == 0) {
7984 #ifdef INFINITY
7985 dC = dA < 0 ? -INFINITY : INFINITY;
7986 #else
7987 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7988 #endif
7990 else {
7991 dC = dA / dB;
7993 break;
7994 case JIM_EXPROP_LT:
7995 wC = dA < dB;
7996 intresult = 1;
7997 break;
7998 case JIM_EXPROP_GT:
7999 wC = dA > dB;
8000 intresult = 1;
8001 break;
8002 case JIM_EXPROP_LTE:
8003 wC = dA <= dB;
8004 intresult = 1;
8005 break;
8006 case JIM_EXPROP_GTE:
8007 wC = dA >= dB;
8008 intresult = 1;
8009 break;
8010 case JIM_EXPROP_NUMEQ:
8011 wC = dA == dB;
8012 intresult = 1;
8013 break;
8014 case JIM_EXPROP_NUMNE:
8015 wC = dA != dB;
8016 intresult = 1;
8017 break;
8018 default:
8019 abort();
8022 else {
8023 /* Handle the string case */
8025 /* XXX: Could optimise the eq/ne case by checking lengths */
8026 int i = Jim_StringCompareObj(interp, A, B, 0);
8028 switch (e->opcode) {
8029 case JIM_EXPROP_LT:
8030 wC = i < 0;
8031 break;
8032 case JIM_EXPROP_GT:
8033 wC = i > 0;
8034 break;
8035 case JIM_EXPROP_LTE:
8036 wC = i <= 0;
8037 break;
8038 case JIM_EXPROP_GTE:
8039 wC = i >= 0;
8040 break;
8041 case JIM_EXPROP_NUMEQ:
8042 wC = i == 0;
8043 break;
8044 case JIM_EXPROP_NUMNE:
8045 wC = i != 0;
8046 break;
8047 default:
8048 rc = JIM_ERR;
8049 break;
8053 if (rc == JIM_OK) {
8054 if (intresult) {
8055 ExprPush(e, Jim_NewIntObj(interp, wC));
8057 else {
8058 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8062 Jim_DecrRefCount(interp, A);
8063 Jim_DecrRefCount(interp, B);
8065 return rc;
8068 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8070 int listlen;
8071 int i;
8073 listlen = Jim_ListLength(interp, listObjPtr);
8074 for (i = 0; i < listlen; i++) {
8075 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8076 return 1;
8079 return 0;
8082 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8084 Jim_Obj *B = ExprPop(e);
8085 Jim_Obj *A = ExprPop(e);
8087 jim_wide wC;
8089 switch (e->opcode) {
8090 case JIM_EXPROP_STREQ:
8091 case JIM_EXPROP_STRNE:
8092 wC = Jim_StringEqObj(A, B);
8093 if (e->opcode == JIM_EXPROP_STRNE) {
8094 wC = !wC;
8096 break;
8097 case JIM_EXPROP_STRIN:
8098 wC = JimSearchList(interp, B, A);
8099 break;
8100 case JIM_EXPROP_STRNI:
8101 wC = !JimSearchList(interp, B, A);
8102 break;
8103 default:
8104 abort();
8106 ExprPush(e, Jim_NewIntObj(interp, wC));
8108 Jim_DecrRefCount(interp, A);
8109 Jim_DecrRefCount(interp, B);
8111 return JIM_OK;
8114 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8116 long l;
8117 double d;
8119 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8120 return l != 0;
8122 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8123 return d != 0;
8125 return -1;
8128 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8130 Jim_Obj *skip = ExprPop(e);
8131 Jim_Obj *A = ExprPop(e);
8132 int rc = JIM_OK;
8134 switch (ExprBool(interp, A)) {
8135 case 0:
8136 /* false, so skip RHS opcodes with a 0 result */
8137 e->skip = JimWideValue(skip);
8138 ExprPush(e, Jim_NewIntObj(interp, 0));
8139 break;
8141 case 1:
8142 /* true so continue */
8143 break;
8145 case -1:
8146 /* Invalid */
8147 rc = JIM_ERR;
8149 Jim_DecrRefCount(interp, A);
8150 Jim_DecrRefCount(interp, skip);
8152 return rc;
8155 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8157 Jim_Obj *skip = ExprPop(e);
8158 Jim_Obj *A = ExprPop(e);
8159 int rc = JIM_OK;
8161 switch (ExprBool(interp, A)) {
8162 case 0:
8163 /* false, so do nothing */
8164 break;
8166 case 1:
8167 /* true so skip RHS opcodes with a 1 result */
8168 e->skip = JimWideValue(skip);
8169 ExprPush(e, Jim_NewIntObj(interp, 1));
8170 break;
8172 case -1:
8173 /* Invalid */
8174 rc = JIM_ERR;
8175 break;
8177 Jim_DecrRefCount(interp, A);
8178 Jim_DecrRefCount(interp, skip);
8180 return rc;
8183 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8185 Jim_Obj *A = ExprPop(e);
8186 int rc = JIM_OK;
8188 switch (ExprBool(interp, A)) {
8189 case 0:
8190 ExprPush(e, Jim_NewIntObj(interp, 0));
8191 break;
8193 case 1:
8194 ExprPush(e, Jim_NewIntObj(interp, 1));
8195 break;
8197 case -1:
8198 /* Invalid */
8199 rc = JIM_ERR;
8200 break;
8202 Jim_DecrRefCount(interp, A);
8204 return rc;
8207 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8209 Jim_Obj *skip = ExprPop(e);
8210 Jim_Obj *A = ExprPop(e);
8211 int rc = JIM_OK;
8213 /* Repush A */
8214 ExprPush(e, A);
8216 switch (ExprBool(interp, A)) {
8217 case 0:
8218 /* false, skip RHS opcodes */
8219 e->skip = JimWideValue(skip);
8220 /* Push a dummy value */
8221 ExprPush(e, Jim_NewIntObj(interp, 0));
8222 break;
8224 case 1:
8225 /* true so do nothing */
8226 break;
8228 case -1:
8229 /* Invalid */
8230 rc = JIM_ERR;
8231 break;
8233 Jim_DecrRefCount(interp, A);
8234 Jim_DecrRefCount(interp, skip);
8236 return rc;
8239 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8241 Jim_Obj *skip = ExprPop(e);
8242 Jim_Obj *B = ExprPop(e);
8243 Jim_Obj *A = ExprPop(e);
8245 /* No need to check for A as non-boolean */
8246 if (ExprBool(interp, A)) {
8247 /* true, so skip RHS opcodes */
8248 e->skip = JimWideValue(skip);
8249 /* Repush B as the answer */
8250 ExprPush(e, B);
8253 Jim_DecrRefCount(interp, skip);
8254 Jim_DecrRefCount(interp, A);
8255 Jim_DecrRefCount(interp, B);
8256 return JIM_OK;
8259 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8261 return JIM_OK;
8264 enum
8266 LAZY_NONE,
8267 LAZY_OP,
8268 LAZY_LEFT,
8269 LAZY_RIGHT
8272 /* name - precedence - arity - opcode
8274 * This array *must* be kept in sync with the JIM_EXPROP enum.
8276 * The following macros pre-compute the string length at compile time.
8278 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8279 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8281 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8282 OPRINIT("*", 110, 2, JimExprOpBin),
8283 OPRINIT("/", 110, 2, JimExprOpBin),
8284 OPRINIT("%", 110, 2, JimExprOpIntBin),
8286 OPRINIT("-", 100, 2, JimExprOpBin),
8287 OPRINIT("+", 100, 2, JimExprOpBin),
8289 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8290 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8292 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8293 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8295 OPRINIT("<", 80, 2, JimExprOpBin),
8296 OPRINIT(">", 80, 2, JimExprOpBin),
8297 OPRINIT("<=", 80, 2, JimExprOpBin),
8298 OPRINIT(">=", 80, 2, JimExprOpBin),
8300 OPRINIT("==", 70, 2, JimExprOpBin),
8301 OPRINIT("!=", 70, 2, JimExprOpBin),
8303 OPRINIT("&", 50, 2, JimExprOpIntBin),
8304 OPRINIT("^", 49, 2, JimExprOpIntBin),
8305 OPRINIT("|", 48, 2, JimExprOpIntBin),
8307 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8308 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8309 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8311 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8312 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8313 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8315 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8316 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8317 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8319 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8320 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8321 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8323 OPRINIT("**", 250, 2, JimExprOpBin),
8325 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8326 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8328 OPRINIT("in", 55, 2, JimExprOpStrBin),
8329 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8331 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8332 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8333 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8334 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8338 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8339 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8340 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8341 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8342 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8343 OPRINIT("rand", 200, 0, JimExprOpNone),
8344 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8346 #ifdef JIM_MATH_FUNCTIONS
8347 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8348 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8349 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8350 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8351 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8352 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8353 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8354 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8355 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8356 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8357 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8358 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8359 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8360 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8361 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8362 OPRINIT("pow", 200, 2, JimExprOpBin),
8363 #endif
8365 #undef OPRINIT
8366 #undef OPRINIT_LAZY
8368 #define JIM_EXPR_OPERATORS_NUM \
8369 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8371 static int JimParseExpression(struct JimParserCtx *pc)
8373 /* Discard spaces and quoted newline */
8374 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8375 if (*pc->p == '\n') {
8376 pc->linenr++;
8378 pc->p++;
8379 pc->len--;
8382 /* Common case */
8383 pc->tline = pc->linenr;
8384 pc->tstart = pc->p;
8386 if (pc->len == 0) {
8387 pc->tend = pc->p;
8388 pc->tt = JIM_TT_EOL;
8389 pc->eof = 1;
8390 return JIM_OK;
8392 switch (*(pc->p)) {
8393 case '(':
8394 pc->tt = JIM_TT_SUBEXPR_START;
8395 goto singlechar;
8396 case ')':
8397 pc->tt = JIM_TT_SUBEXPR_END;
8398 goto singlechar;
8399 case ',':
8400 pc->tt = JIM_TT_SUBEXPR_COMMA;
8401 singlechar:
8402 pc->tend = pc->p;
8403 pc->p++;
8404 pc->len--;
8405 break;
8406 case '[':
8407 return JimParseCmd(pc);
8408 case '$':
8409 if (JimParseVar(pc) == JIM_ERR)
8410 return JimParseExprOperator(pc);
8411 else {
8412 /* Don't allow expr sugar in expressions */
8413 if (pc->tt == JIM_TT_EXPRSUGAR) {
8414 return JIM_ERR;
8416 return JIM_OK;
8418 break;
8419 case '0':
8420 case '1':
8421 case '2':
8422 case '3':
8423 case '4':
8424 case '5':
8425 case '6':
8426 case '7':
8427 case '8':
8428 case '9':
8429 case '.':
8430 return JimParseExprNumber(pc);
8431 case '"':
8432 return JimParseQuote(pc);
8433 case '{':
8434 return JimParseBrace(pc);
8436 case 'N':
8437 case 'I':
8438 case 'n':
8439 case 'i':
8440 if (JimParseExprIrrational(pc) == JIM_ERR)
8441 return JimParseExprOperator(pc);
8442 break;
8443 default:
8444 return JimParseExprOperator(pc);
8445 break;
8447 return JIM_OK;
8450 static int JimParseExprNumber(struct JimParserCtx *pc)
8452 char *end;
8454 /* Assume an integer for now */
8455 pc->tt = JIM_TT_EXPR_INT;
8457 jim_strtoull(pc->p, (char **)&pc->p);
8458 /* Tried as an integer, but perhaps it parses as a double */
8459 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8460 /* Some stupid compilers insist they are cleverer that
8461 * we are. Even a (void) cast doesn't prevent this warning!
8463 if (strtod(pc->tstart, &end)) { /* nothing */ }
8464 if (end == pc->tstart)
8465 return JIM_ERR;
8466 if (end > pc->p) {
8467 /* Yes, double captured more chars */
8468 pc->tt = JIM_TT_EXPR_DOUBLE;
8469 pc->p = end;
8472 pc->tend = pc->p - 1;
8473 pc->len -= (pc->p - pc->tstart);
8474 return JIM_OK;
8477 static int JimParseExprIrrational(struct JimParserCtx *pc)
8479 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8480 int i;
8482 for (i = 0; irrationals[i]; i++) {
8483 const char *irr = irrationals[i];
8485 if (strncmp(irr, pc->p, 3) == 0) {
8486 pc->p += 3;
8487 pc->len -= 3;
8488 pc->tend = pc->p - 1;
8489 pc->tt = JIM_TT_EXPR_DOUBLE;
8490 return JIM_OK;
8493 return JIM_ERR;
8496 static int JimParseExprOperator(struct JimParserCtx *pc)
8498 int i;
8499 int bestIdx = -1, bestLen = 0;
8501 /* Try to get the longest match. */
8502 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8503 const char * const opname = Jim_ExprOperators[i].name;
8504 const int oplen = Jim_ExprOperators[i].namelen;
8506 if (opname == NULL || opname[0] != pc->p[0]) {
8507 continue;
8510 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8511 bestIdx = i + JIM_TT_EXPR_OP;
8512 bestLen = oplen;
8515 if (bestIdx == -1) {
8516 return JIM_ERR;
8519 /* Validate paretheses around function arguments */
8520 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8521 const char *p = pc->p + bestLen;
8522 int len = pc->len - bestLen;
8524 while (len && isspace(UCHAR(*p))) {
8525 len--;
8526 p++;
8528 if (*p != '(') {
8529 return JIM_ERR;
8532 pc->tend = pc->p + bestLen - 1;
8533 pc->p += bestLen;
8534 pc->len -= bestLen;
8536 pc->tt = bestIdx;
8537 return JIM_OK;
8540 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8542 static Jim_ExprOperator dummy_op;
8543 if (opcode < JIM_TT_EXPR_OP) {
8544 return &dummy_op;
8546 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8549 const char *jim_tt_name(int type)
8551 static const char * const tt_names[JIM_TT_EXPR_OP] =
8552 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8553 "DBL", "$()" };
8554 if (type < JIM_TT_EXPR_OP) {
8555 return tt_names[type];
8557 else {
8558 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8559 static char buf[20];
8561 if (op->name) {
8562 return op->name;
8564 sprintf(buf, "(%d)", type);
8565 return buf;
8569 /* -----------------------------------------------------------------------------
8570 * Expression Object
8571 * ---------------------------------------------------------------------------*/
8572 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8573 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8574 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8576 static const Jim_ObjType exprObjType = {
8577 "expression",
8578 FreeExprInternalRep,
8579 DupExprInternalRep,
8580 NULL,
8581 JIM_TYPE_REFERENCES,
8584 /* Expr bytecode structure */
8585 typedef struct ExprByteCode
8587 ScriptToken *token; /* Tokens array. */
8588 int len; /* Length as number of tokens. */
8589 int inUse; /* Used for sharing. */
8590 } ExprByteCode;
8592 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8594 int i;
8596 for (i = 0; i < expr->len; i++) {
8597 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8599 Jim_Free(expr->token);
8600 Jim_Free(expr);
8603 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8605 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8607 if (expr) {
8608 if (--expr->inUse != 0) {
8609 return;
8612 ExprFreeByteCode(interp, expr);
8616 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8618 JIM_NOTUSED(interp);
8619 JIM_NOTUSED(srcPtr);
8621 /* Just returns an simple string. */
8622 dupPtr->typePtr = NULL;
8625 /* Check if an expr program looks correct. */
8626 static int ExprCheckCorrectness(ExprByteCode * expr)
8628 int i;
8629 int stacklen = 0;
8630 int ternary = 0;
8632 /* Try to check if there are stack underflows,
8633 * and make sure at the end of the program there is
8634 * a single result on the stack. */
8635 for (i = 0; i < expr->len; i++) {
8636 ScriptToken *t = &expr->token[i];
8637 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8639 stacklen -= op->arity;
8640 if (stacklen < 0) {
8641 break;
8643 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8644 ternary++;
8646 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8647 ternary--;
8650 /* All operations and operands add one to the stack */
8651 stacklen++;
8653 if (stacklen != 1 || ternary != 0) {
8654 return JIM_ERR;
8656 return JIM_OK;
8659 /* This procedure converts every occurrence of || and && opereators
8660 * in lazy unary versions.
8662 * a b || is converted into:
8664 * a <offset> |L b |R
8666 * a b && is converted into:
8668 * a <offset> &L b &R
8670 * "|L" checks if 'a' is true:
8671 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8672 * the opcode just after |R.
8673 * 2) if it is false does nothing.
8674 * "|R" checks if 'b' is true:
8675 * 1) if it is true pushes 1, otherwise pushes 0.
8677 * "&L" checks if 'a' is true:
8678 * 1) if it is true does nothing.
8679 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8680 * the opcode just after &R
8681 * "&R" checks if 'a' is true:
8682 * if it is true pushes 1, otherwise pushes 0.
8684 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8686 int i;
8688 int leftindex, arity, offset;
8690 /* Search for the end of the first operator */
8691 leftindex = expr->len - 1;
8693 arity = 1;
8694 while (arity) {
8695 ScriptToken *tt = &expr->token[leftindex];
8697 if (tt->type >= JIM_TT_EXPR_OP) {
8698 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8700 arity--;
8701 if (--leftindex < 0) {
8702 return JIM_ERR;
8705 leftindex++;
8707 /* Move them up */
8708 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8709 sizeof(*expr->token) * (expr->len - leftindex));
8710 expr->len += 2;
8711 offset = (expr->len - leftindex) - 1;
8713 /* Now we rely on the fact the the left and right version have opcodes
8714 * 1 and 2 after the main opcode respectively
8716 expr->token[leftindex + 1].type = t->type + 1;
8717 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8719 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8720 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8722 /* Now add the 'R' operator */
8723 expr->token[expr->len].objPtr = interp->emptyObj;
8724 expr->token[expr->len].type = t->type + 2;
8725 expr->len++;
8727 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8728 for (i = leftindex - 1; i > 0; i--) {
8729 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8730 if (op->lazy == LAZY_LEFT) {
8731 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8732 JimWideValue(expr->token[i - 1].objPtr) += 2;
8736 return JIM_OK;
8739 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8741 struct ScriptToken *token = &expr->token[expr->len];
8742 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8744 if (op->lazy == LAZY_OP) {
8745 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8746 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8747 return JIM_ERR;
8750 else {
8751 token->objPtr = interp->emptyObj;
8752 token->type = t->type;
8753 expr->len++;
8755 return JIM_OK;
8759 * Returns the index of the COLON_LEFT to the left of 'right_index'
8760 * taking into account nesting.
8762 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8764 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8766 int ternary_count = 1;
8768 right_index--;
8770 while (right_index > 1) {
8771 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8772 ternary_count--;
8774 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8775 ternary_count++;
8777 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8778 return right_index;
8780 right_index--;
8783 /*notreached*/
8784 return -1;
8788 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8790 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8791 * Otherwise returns 0.
8793 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8795 int i = right_index - 1;
8796 int ternary_count = 1;
8798 while (i > 1) {
8799 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8800 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8801 *prev_right_index = i - 2;
8802 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8803 return 1;
8806 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8807 if (ternary_count == 0) {
8808 return 0;
8810 ternary_count++;
8812 i--;
8814 return 0;
8818 * ExprTernaryReorderExpression description
8819 * ========================================
8821 * ?: is right-to-left associative which doesn't work with the stack-based
8822 * expression engine. The fix is to reorder the bytecode.
8824 * The expression:
8826 * expr 1?2:0?3:4
8828 * Has initial bytecode:
8830 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8831 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8833 * The fix involves simulating this expression instead:
8835 * expr 1?2:(0?3:4)
8837 * With the following bytecode:
8839 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8840 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8842 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8843 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8844 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8845 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8847 * ExprTernaryReorderExpression works thus as follows :
8848 * - start from the end of the stack
8849 * - while walking towards the beginning of the stack
8850 * if token=JIM_EXPROP_COLON_RIGHT then
8851 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8852 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8853 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8854 * if all found then
8855 * perform the rotation
8856 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8857 * end if
8858 * end if
8860 * Note: care has to be taken for nested ternary constructs!!!
8862 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8864 int i;
8866 for (i = expr->len - 1; i > 1; i--) {
8867 int prev_right_index;
8868 int prev_left_index;
8869 int j;
8870 ScriptToken tmp;
8872 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8873 continue;
8876 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8877 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8878 continue;
8882 ** rotate tokens down
8884 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8885 ** | | |
8886 ** | V V
8887 ** | [...] : ...
8888 ** | | |
8889 ** | V V
8890 ** | [...] : ...
8891 ** | | |
8892 ** | V V
8893 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8895 tmp = expr->token[prev_right_index];
8896 for (j = prev_right_index; j < i; j++) {
8897 expr->token[j] = expr->token[j + 1];
8899 expr->token[i] = tmp;
8901 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8903 * This is 'colon left increment' = i - prev_right_index
8905 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8906 * [prev_left_index-1] : skip_count
8909 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8911 /* Adjust for i-- in the loop */
8912 i++;
8916 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8918 Jim_Stack stack;
8919 ExprByteCode *expr;
8920 int ok = 1;
8921 int i;
8922 int prevtt = JIM_TT_NONE;
8923 int have_ternary = 0;
8925 /* -1 for EOL */
8926 int count = tokenlist->count - 1;
8928 expr = Jim_Alloc(sizeof(*expr));
8929 expr->inUse = 1;
8930 expr->len = 0;
8932 Jim_InitStack(&stack);
8934 /* Need extra bytecodes for lazy operators.
8935 * Also check for the ternary operator
8937 for (i = 0; i < tokenlist->count; i++) {
8938 ParseToken *t = &tokenlist->list[i];
8939 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8941 if (op->lazy == LAZY_OP) {
8942 count += 2;
8943 /* Ternary is a lazy op but also needs reordering */
8944 if (t->type == JIM_EXPROP_TERNARY) {
8945 have_ternary = 1;
8950 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8952 for (i = 0; i < tokenlist->count && ok; i++) {
8953 ParseToken *t = &tokenlist->list[i];
8955 /* Next token will be stored here */
8956 struct ScriptToken *token = &expr->token[expr->len];
8958 if (t->type == JIM_TT_EOL) {
8959 break;
8962 switch (t->type) {
8963 case JIM_TT_STR:
8964 case JIM_TT_ESC:
8965 case JIM_TT_VAR:
8966 case JIM_TT_DICTSUGAR:
8967 case JIM_TT_EXPRSUGAR:
8968 case JIM_TT_CMD:
8969 token->type = t->type;
8970 strexpr:
8971 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8972 if (t->type == JIM_TT_CMD) {
8973 /* Only commands need source info */
8974 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8976 expr->len++;
8977 break;
8979 case JIM_TT_EXPR_INT:
8980 case JIM_TT_EXPR_DOUBLE:
8982 char *endptr;
8983 if (t->type == JIM_TT_EXPR_INT) {
8984 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8986 else {
8987 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8989 if (endptr != t->token + t->len) {
8990 /* Conversion failed, so just store it as a string */
8991 Jim_FreeNewObj(interp, token->objPtr);
8992 token->type = JIM_TT_STR;
8993 goto strexpr;
8995 token->type = t->type;
8996 expr->len++;
8998 break;
9000 case JIM_TT_SUBEXPR_START:
9001 Jim_StackPush(&stack, t);
9002 prevtt = JIM_TT_NONE;
9003 continue;
9005 case JIM_TT_SUBEXPR_COMMA:
9006 /* Simple approach. Comma is simply ignored */
9007 continue;
9009 case JIM_TT_SUBEXPR_END:
9010 ok = 0;
9011 while (Jim_StackLen(&stack)) {
9012 ParseToken *tt = Jim_StackPop(&stack);
9014 if (tt->type == JIM_TT_SUBEXPR_START) {
9015 ok = 1;
9016 break;
9019 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9020 goto err;
9023 if (!ok) {
9024 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9025 goto err;
9027 break;
9030 default:{
9031 /* Must be an operator */
9032 const struct Jim_ExprOperator *op;
9033 ParseToken *tt;
9035 /* Convert -/+ to unary minus or unary plus if necessary */
9036 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9037 if (t->type == JIM_EXPROP_SUB) {
9038 t->type = JIM_EXPROP_UNARYMINUS;
9040 else if (t->type == JIM_EXPROP_ADD) {
9041 t->type = JIM_EXPROP_UNARYPLUS;
9045 op = JimExprOperatorInfoByOpcode(t->type);
9047 /* Now handle precedence */
9048 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9049 const struct Jim_ExprOperator *tt_op =
9050 JimExprOperatorInfoByOpcode(tt->type);
9052 /* Note that right-to-left associativity of ?: operator is handled later */
9054 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9055 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9056 ok = 0;
9057 goto err;
9059 Jim_StackPop(&stack);
9061 else {
9062 break;
9065 Jim_StackPush(&stack, t);
9066 break;
9069 prevtt = t->type;
9072 /* Reduce any remaining subexpr */
9073 while (Jim_StackLen(&stack)) {
9074 ParseToken *tt = Jim_StackPop(&stack);
9076 if (tt->type == JIM_TT_SUBEXPR_START) {
9077 ok = 0;
9078 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9079 goto err;
9081 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9082 ok = 0;
9083 goto err;
9087 if (have_ternary) {
9088 ExprTernaryReorderExpression(interp, expr);
9091 err:
9092 /* Free the stack used for the compilation. */
9093 Jim_FreeStack(&stack);
9095 for (i = 0; i < expr->len; i++) {
9096 Jim_IncrRefCount(expr->token[i].objPtr);
9099 if (!ok) {
9100 ExprFreeByteCode(interp, expr);
9101 return NULL;
9104 return expr;
9108 /* This method takes the string representation of an expression
9109 * and generates a program for the Expr's stack-based VM. */
9110 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9112 int exprTextLen;
9113 const char *exprText;
9114 struct JimParserCtx parser;
9115 struct ExprByteCode *expr;
9116 ParseTokenList tokenlist;
9117 int line;
9118 Jim_Obj *fileNameObj;
9119 int rc = JIM_ERR;
9121 /* Try to get information about filename / line number */
9122 if (objPtr->typePtr == &sourceObjType) {
9123 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9124 line = objPtr->internalRep.sourceValue.lineNumber;
9126 else {
9127 fileNameObj = interp->emptyObj;
9128 line = 1;
9130 Jim_IncrRefCount(fileNameObj);
9132 exprText = Jim_GetString(objPtr, &exprTextLen);
9134 /* Initially tokenise the expression into tokenlist */
9135 ScriptTokenListInit(&tokenlist);
9137 JimParserInit(&parser, exprText, exprTextLen, line);
9138 while (!parser.eof) {
9139 if (JimParseExpression(&parser) != JIM_OK) {
9140 ScriptTokenListFree(&tokenlist);
9141 invalidexpr:
9142 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9143 expr = NULL;
9144 goto err;
9147 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9148 parser.tline);
9151 #ifdef DEBUG_SHOW_EXPR_TOKENS
9153 int i;
9154 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9155 for (i = 0; i < tokenlist.count; i++) {
9156 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9157 tokenlist.list[i].len, tokenlist.list[i].token);
9160 #endif
9162 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9163 ScriptTokenListFree(&tokenlist);
9164 Jim_DecrRefCount(interp, fileNameObj);
9165 return JIM_ERR;
9168 /* Now create the expression bytecode from the tokenlist */
9169 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9171 /* No longer need the token list */
9172 ScriptTokenListFree(&tokenlist);
9174 if (!expr) {
9175 goto err;
9178 #ifdef DEBUG_SHOW_EXPR
9180 int i;
9182 printf("==== Expr ====\n");
9183 for (i = 0; i < expr->len; i++) {
9184 ScriptToken *t = &expr->token[i];
9186 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9189 #endif
9191 /* Check program correctness. */
9192 if (ExprCheckCorrectness(expr) != JIM_OK) {
9193 ExprFreeByteCode(interp, expr);
9194 goto invalidexpr;
9197 rc = JIM_OK;
9199 err:
9200 /* Free the old internal rep and set the new one. */
9201 Jim_DecrRefCount(interp, fileNameObj);
9202 Jim_FreeIntRep(interp, objPtr);
9203 Jim_SetIntRepPtr(objPtr, expr);
9204 objPtr->typePtr = &exprObjType;
9205 return rc;
9208 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9210 if (objPtr->typePtr != &exprObjType) {
9211 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9212 return NULL;
9215 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9218 #ifdef JIM_OPTIMIZATION
9219 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9221 if (token->type == JIM_TT_EXPR_INT)
9222 return token->objPtr;
9223 else if (token->type == JIM_TT_VAR)
9224 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9225 else if (token->type == JIM_TT_DICTSUGAR)
9226 return JimExpandDictSugar(interp, token->objPtr);
9227 else
9228 return NULL;
9230 #endif
9232 /* -----------------------------------------------------------------------------
9233 * Expressions evaluation.
9234 * Jim uses a specialized stack-based virtual machine for expressions,
9235 * that takes advantage of the fact that expr's operators
9236 * can't be redefined.
9238 * Jim_EvalExpression() uses the bytecode compiled by
9239 * SetExprFromAny() method of the "expression" object.
9241 * On success a Tcl Object containing the result of the evaluation
9242 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9243 * returned.
9244 * On error the function returns a retcode != to JIM_OK and set a suitable
9245 * error on the interp.
9246 * ---------------------------------------------------------------------------*/
9247 #define JIM_EE_STATICSTACK_LEN 10
9249 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9251 ExprByteCode *expr;
9252 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9253 int i;
9254 int retcode = JIM_OK;
9255 struct JimExprState e;
9257 expr = JimGetExpression(interp, exprObjPtr);
9258 if (!expr) {
9259 return JIM_ERR; /* error in expression. */
9262 #ifdef JIM_OPTIMIZATION
9263 /* Check for one of the following common expressions used by while/for
9265 * CONST
9266 * $a
9267 * !$a
9268 * $a < CONST, $a < $b
9269 * $a <= CONST, $a <= $b
9270 * $a > CONST, $a > $b
9271 * $a >= CONST, $a >= $b
9272 * $a != CONST, $a != $b
9273 * $a == CONST, $a == $b
9276 Jim_Obj *objPtr;
9278 /* STEP 1 -- Check if there are the conditions to run the specialized
9279 * version of while */
9281 switch (expr->len) {
9282 case 1:
9283 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9284 if (objPtr) {
9285 Jim_IncrRefCount(objPtr);
9286 *exprResultPtrPtr = objPtr;
9287 return JIM_OK;
9289 break;
9291 case 2:
9292 if (expr->token[1].type == JIM_EXPROP_NOT) {
9293 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9295 if (objPtr && JimIsWide(objPtr)) {
9296 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9297 Jim_IncrRefCount(*exprResultPtrPtr);
9298 return JIM_OK;
9301 break;
9303 case 3:
9304 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9305 if (objPtr && JimIsWide(objPtr)) {
9306 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9307 if (objPtr2 && JimIsWide(objPtr2)) {
9308 jim_wide wideValueA = JimWideValue(objPtr);
9309 jim_wide wideValueB = JimWideValue(objPtr2);
9310 int cmpRes;
9311 switch (expr->token[2].type) {
9312 case JIM_EXPROP_LT:
9313 cmpRes = wideValueA < wideValueB;
9314 break;
9315 case JIM_EXPROP_LTE:
9316 cmpRes = wideValueA <= wideValueB;
9317 break;
9318 case JIM_EXPROP_GT:
9319 cmpRes = wideValueA > wideValueB;
9320 break;
9321 case JIM_EXPROP_GTE:
9322 cmpRes = wideValueA >= wideValueB;
9323 break;
9324 case JIM_EXPROP_NUMEQ:
9325 cmpRes = wideValueA == wideValueB;
9326 break;
9327 case JIM_EXPROP_NUMNE:
9328 cmpRes = wideValueA != wideValueB;
9329 break;
9330 default:
9331 goto noopt;
9333 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9334 Jim_IncrRefCount(*exprResultPtrPtr);
9335 return JIM_OK;
9338 break;
9341 noopt:
9342 #endif
9344 /* In order to avoid that the internal repr gets freed due to
9345 * shimmering of the exprObjPtr's object, we make the internal rep
9346 * shared. */
9347 expr->inUse++;
9349 /* The stack-based expr VM itself */
9351 /* Stack allocation. Expr programs have the feature that
9352 * a program of length N can't require a stack longer than
9353 * N. */
9354 if (expr->len > JIM_EE_STATICSTACK_LEN)
9355 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9356 else
9357 e.stack = staticStack;
9359 e.stacklen = 0;
9361 /* Execute every instruction */
9362 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9363 Jim_Obj *objPtr;
9365 switch (expr->token[i].type) {
9366 case JIM_TT_EXPR_INT:
9367 case JIM_TT_EXPR_DOUBLE:
9368 case JIM_TT_STR:
9369 ExprPush(&e, expr->token[i].objPtr);
9370 break;
9372 case JIM_TT_VAR:
9373 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9374 if (objPtr) {
9375 ExprPush(&e, objPtr);
9377 else {
9378 retcode = JIM_ERR;
9380 break;
9382 case JIM_TT_DICTSUGAR:
9383 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9384 if (objPtr) {
9385 ExprPush(&e, objPtr);
9387 else {
9388 retcode = JIM_ERR;
9390 break;
9392 case JIM_TT_ESC:
9393 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9394 if (retcode == JIM_OK) {
9395 ExprPush(&e, objPtr);
9397 break;
9399 case JIM_TT_CMD:
9400 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9401 if (retcode == JIM_OK) {
9402 ExprPush(&e, Jim_GetResult(interp));
9404 break;
9406 default:{
9407 /* Find and execute the operation */
9408 e.skip = 0;
9409 e.opcode = expr->token[i].type;
9411 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9412 /* Skip some opcodes if necessary */
9413 i += e.skip;
9414 continue;
9419 expr->inUse--;
9421 if (retcode == JIM_OK) {
9422 *exprResultPtrPtr = ExprPop(&e);
9424 else {
9425 for (i = 0; i < e.stacklen; i++) {
9426 Jim_DecrRefCount(interp, e.stack[i]);
9429 if (e.stack != staticStack) {
9430 Jim_Free(e.stack);
9432 return retcode;
9435 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9437 int retcode;
9438 jim_wide wideValue;
9439 double doubleValue;
9440 Jim_Obj *exprResultPtr;
9442 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9443 if (retcode != JIM_OK)
9444 return retcode;
9446 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9447 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9448 Jim_DecrRefCount(interp, exprResultPtr);
9449 return JIM_ERR;
9451 else {
9452 Jim_DecrRefCount(interp, exprResultPtr);
9453 *boolPtr = doubleValue != 0;
9454 return JIM_OK;
9457 *boolPtr = wideValue != 0;
9459 Jim_DecrRefCount(interp, exprResultPtr);
9460 return JIM_OK;
9463 /* -----------------------------------------------------------------------------
9464 * ScanFormat String Object
9465 * ---------------------------------------------------------------------------*/
9467 /* This Jim_Obj will held a parsed representation of a format string passed to
9468 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9469 * to be parsed in its entirely first and then, if correct, can be used for
9470 * scanning. To avoid endless re-parsing, the parsed representation will be
9471 * stored in an internal representation and re-used for performance reason. */
9473 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9474 * scanformat string. This part will later be used to extract information
9475 * out from the string to be parsed by Jim_ScanString */
9477 typedef struct ScanFmtPartDescr
9479 char *arg; /* Specification of a CHARSET conversion */
9480 char *prefix; /* Prefix to be scanned literally before conversion */
9481 size_t width; /* Maximal width of input to be converted */
9482 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9483 char type; /* Type of conversion (e.g. c, d, f) */
9484 char modifier; /* Modify type (e.g. l - long, h - short */
9485 } ScanFmtPartDescr;
9487 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9488 * string parsed and separated in part descriptions. Furthermore it contains
9489 * the original string representation of the scanformat string to allow for
9490 * fast update of the Jim_Obj's string representation part.
9492 * As an add-on the internal object representation adds some scratch pad area
9493 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9494 * memory for purpose of string scanning.
9496 * The error member points to a static allocated string in case of a mal-
9497 * formed scanformat string or it contains '0' (NULL) in case of a valid
9498 * parse representation.
9500 * The whole memory of the internal representation is allocated as a single
9501 * area of memory that will be internally separated. So freeing and duplicating
9502 * of such an object is cheap */
9504 typedef struct ScanFmtStringObj
9506 jim_wide size; /* Size of internal repr in bytes */
9507 char *stringRep; /* Original string representation */
9508 size_t count; /* Number of ScanFmtPartDescr contained */
9509 size_t convCount; /* Number of conversions that will assign */
9510 size_t maxPos; /* Max position index if XPG3 is used */
9511 const char *error; /* Ptr to error text (NULL if no error */
9512 char *scratch; /* Some scratch pad used by Jim_ScanString */
9513 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9514 } ScanFmtStringObj;
9517 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9518 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9519 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9521 static const Jim_ObjType scanFmtStringObjType = {
9522 "scanformatstring",
9523 FreeScanFmtInternalRep,
9524 DupScanFmtInternalRep,
9525 UpdateStringOfScanFmt,
9526 JIM_TYPE_NONE,
9529 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9531 JIM_NOTUSED(interp);
9532 Jim_Free((char *)objPtr->internalRep.ptr);
9533 objPtr->internalRep.ptr = 0;
9536 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9538 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9539 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9541 JIM_NOTUSED(interp);
9542 memcpy(newVec, srcPtr->internalRep.ptr, size);
9543 dupPtr->internalRep.ptr = newVec;
9544 dupPtr->typePtr = &scanFmtStringObjType;
9547 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9549 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9552 /* SetScanFmtFromAny will parse a given string and create the internal
9553 * representation of the format specification. In case of an error
9554 * the error data member of the internal representation will be set
9555 * to an descriptive error text and the function will be left with
9556 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9557 * specification */
9559 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9561 ScanFmtStringObj *fmtObj;
9562 char *buffer;
9563 int maxCount, i, approxSize, lastPos = -1;
9564 const char *fmt = objPtr->bytes;
9565 int maxFmtLen = objPtr->length;
9566 const char *fmtEnd = fmt + maxFmtLen;
9567 int curr;
9569 Jim_FreeIntRep(interp, objPtr);
9570 /* Count how many conversions could take place maximally */
9571 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9572 if (fmt[i] == '%')
9573 ++maxCount;
9574 /* Calculate an approximation of the memory necessary */
9575 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9576 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9577 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9578 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9579 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9580 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9581 +1; /* safety byte */
9582 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9583 memset(fmtObj, 0, approxSize);
9584 fmtObj->size = approxSize;
9585 fmtObj->maxPos = 0;
9586 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9587 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9588 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9589 buffer = fmtObj->stringRep + maxFmtLen + 1;
9590 objPtr->internalRep.ptr = fmtObj;
9591 objPtr->typePtr = &scanFmtStringObjType;
9592 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9593 int width = 0, skip;
9594 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9596 fmtObj->count++;
9597 descr->width = 0; /* Assume width unspecified */
9598 /* Overread and store any "literal" prefix */
9599 if (*fmt != '%' || fmt[1] == '%') {
9600 descr->type = 0;
9601 descr->prefix = &buffer[i];
9602 for (; fmt < fmtEnd; ++fmt) {
9603 if (*fmt == '%') {
9604 if (fmt[1] != '%')
9605 break;
9606 ++fmt;
9608 buffer[i++] = *fmt;
9610 buffer[i++] = 0;
9612 /* Skip the conversion introducing '%' sign */
9613 ++fmt;
9614 /* End reached due to non-conversion literal only? */
9615 if (fmt >= fmtEnd)
9616 goto done;
9617 descr->pos = 0; /* Assume "natural" positioning */
9618 if (*fmt == '*') {
9619 descr->pos = -1; /* Okay, conversion will not be assigned */
9620 ++fmt;
9622 else
9623 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9624 /* Check if next token is a number (could be width or pos */
9625 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9626 fmt += skip;
9627 /* Was the number a XPG3 position specifier? */
9628 if (descr->pos != -1 && *fmt == '$') {
9629 int prev;
9631 ++fmt;
9632 descr->pos = width;
9633 width = 0;
9634 /* Look if "natural" postioning and XPG3 one was mixed */
9635 if ((lastPos == 0 && descr->pos > 0)
9636 || (lastPos > 0 && descr->pos == 0)) {
9637 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9638 return JIM_ERR;
9640 /* Look if this position was already used */
9641 for (prev = 0; prev < curr; ++prev) {
9642 if (fmtObj->descr[prev].pos == -1)
9643 continue;
9644 if (fmtObj->descr[prev].pos == descr->pos) {
9645 fmtObj->error =
9646 "variable is assigned by multiple \"%n$\" conversion specifiers";
9647 return JIM_ERR;
9650 /* Try to find a width after the XPG3 specifier */
9651 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9652 descr->width = width;
9653 fmt += skip;
9655 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9656 fmtObj->maxPos = descr->pos;
9658 else {
9659 /* Number was not a XPG3, so it has to be a width */
9660 descr->width = width;
9663 /* If positioning mode was undetermined yet, fix this */
9664 if (lastPos == -1)
9665 lastPos = descr->pos;
9666 /* Handle CHARSET conversion type ... */
9667 if (*fmt == '[') {
9668 int swapped = 1, beg = i, end, j;
9670 descr->type = '[';
9671 descr->arg = &buffer[i];
9672 ++fmt;
9673 if (*fmt == '^')
9674 buffer[i++] = *fmt++;
9675 if (*fmt == ']')
9676 buffer[i++] = *fmt++;
9677 while (*fmt && *fmt != ']')
9678 buffer[i++] = *fmt++;
9679 if (*fmt != ']') {
9680 fmtObj->error = "unmatched [ in format string";
9681 return JIM_ERR;
9683 end = i;
9684 buffer[i++] = 0;
9685 /* In case a range fence was given "backwards", swap it */
9686 while (swapped) {
9687 swapped = 0;
9688 for (j = beg + 1; j < end - 1; ++j) {
9689 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9690 char tmp = buffer[j - 1];
9692 buffer[j - 1] = buffer[j + 1];
9693 buffer[j + 1] = tmp;
9694 swapped = 1;
9699 else {
9700 /* Remember any valid modifier if given */
9701 if (strchr("hlL", *fmt) != 0)
9702 descr->modifier = tolower((int)*fmt++);
9704 descr->type = *fmt;
9705 if (strchr("efgcsndoxui", *fmt) == 0) {
9706 fmtObj->error = "bad scan conversion character";
9707 return JIM_ERR;
9709 else if (*fmt == 'c' && descr->width != 0) {
9710 fmtObj->error = "field width may not be specified in %c " "conversion";
9711 return JIM_ERR;
9713 else if (*fmt == 'u' && descr->modifier == 'l') {
9714 fmtObj->error = "unsigned wide not supported";
9715 return JIM_ERR;
9718 curr++;
9720 done:
9721 return JIM_OK;
9724 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9726 #define FormatGetCnvCount(_fo_) \
9727 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9728 #define FormatGetMaxPos(_fo_) \
9729 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9730 #define FormatGetError(_fo_) \
9731 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9733 /* JimScanAString is used to scan an unspecified string that ends with
9734 * next WS, or a string that is specified via a charset.
9737 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9739 char *buffer = Jim_StrDup(str);
9740 char *p = buffer;
9742 while (*str) {
9743 int c;
9744 int n;
9746 if (!sdescr && isspace(UCHAR(*str)))
9747 break; /* EOS via WS if unspecified */
9749 n = utf8_tounicode(str, &c);
9750 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9751 break;
9752 while (n--)
9753 *p++ = *str++;
9755 *p = 0;
9756 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9759 /* ScanOneEntry will scan one entry out of the string passed as argument.
9760 * It use the sscanf() function for this task. After extracting and
9761 * converting of the value, the count of scanned characters will be
9762 * returned of -1 in case of no conversion tool place and string was
9763 * already scanned thru */
9765 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9766 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9768 const char *tok;
9769 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9770 size_t scanned = 0;
9771 size_t anchor = pos;
9772 int i;
9773 Jim_Obj *tmpObj = NULL;
9775 /* First pessimistically assume, we will not scan anything :-) */
9776 *valObjPtr = 0;
9777 if (descr->prefix) {
9778 /* There was a prefix given before the conversion, skip it and adjust
9779 * the string-to-be-parsed accordingly */
9780 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9781 /* If prefix require, skip WS */
9782 if (isspace(UCHAR(descr->prefix[i])))
9783 while (pos < strLen && isspace(UCHAR(str[pos])))
9784 ++pos;
9785 else if (descr->prefix[i] != str[pos])
9786 break; /* Prefix do not match here, leave the loop */
9787 else
9788 ++pos; /* Prefix matched so far, next round */
9790 if (pos >= strLen) {
9791 return -1; /* All of str consumed: EOF condition */
9793 else if (descr->prefix[i] != 0)
9794 return 0; /* Not whole prefix consumed, no conversion possible */
9796 /* For all but following conversion, skip leading WS */
9797 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9798 while (isspace(UCHAR(str[pos])))
9799 ++pos;
9800 /* Determine how much skipped/scanned so far */
9801 scanned = pos - anchor;
9803 /* %c is a special, simple case. no width */
9804 if (descr->type == 'n') {
9805 /* Return pseudo conversion means: how much scanned so far? */
9806 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9808 else if (pos >= strLen) {
9809 /* Cannot scan anything, as str is totally consumed */
9810 return -1;
9812 else if (descr->type == 'c') {
9813 int c;
9814 scanned += utf8_tounicode(&str[pos], &c);
9815 *valObjPtr = Jim_NewIntObj(interp, c);
9816 return scanned;
9818 else {
9819 /* Processing of conversions follows ... */
9820 if (descr->width > 0) {
9821 /* Do not try to scan as fas as possible but only the given width.
9822 * To ensure this, we copy the part that should be scanned. */
9823 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9824 size_t tLen = descr->width > sLen ? sLen : descr->width;
9826 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9827 tok = tmpObj->bytes;
9829 else {
9830 /* As no width was given, simply refer to the original string */
9831 tok = &str[pos];
9833 switch (descr->type) {
9834 case 'd':
9835 case 'o':
9836 case 'x':
9837 case 'u':
9838 case 'i':{
9839 char *endp; /* Position where the number finished */
9840 jim_wide w;
9842 int base = descr->type == 'o' ? 8
9843 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9845 /* Try to scan a number with the given base */
9846 if (base == 0) {
9847 w = jim_strtoull(tok, &endp);
9849 else {
9850 w = strtoull(tok, &endp, base);
9853 if (endp != tok) {
9854 /* There was some number sucessfully scanned! */
9855 *valObjPtr = Jim_NewIntObj(interp, w);
9857 /* Adjust the number-of-chars scanned so far */
9858 scanned += endp - tok;
9860 else {
9861 /* Nothing was scanned. We have to determine if this
9862 * happened due to e.g. prefix mismatch or input str
9863 * exhausted */
9864 scanned = *tok ? 0 : -1;
9866 break;
9868 case 's':
9869 case '[':{
9870 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9871 scanned += Jim_Length(*valObjPtr);
9872 break;
9874 case 'e':
9875 case 'f':
9876 case 'g':{
9877 char *endp;
9878 double value = strtod(tok, &endp);
9880 if (endp != tok) {
9881 /* There was some number sucessfully scanned! */
9882 *valObjPtr = Jim_NewDoubleObj(interp, value);
9883 /* Adjust the number-of-chars scanned so far */
9884 scanned += endp - tok;
9886 else {
9887 /* Nothing was scanned. We have to determine if this
9888 * happened due to e.g. prefix mismatch or input str
9889 * exhausted */
9890 scanned = *tok ? 0 : -1;
9892 break;
9895 /* If a substring was allocated (due to pre-defined width) do not
9896 * forget to free it */
9897 if (tmpObj) {
9898 Jim_FreeNewObj(interp, tmpObj);
9901 return scanned;
9904 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9905 * string and returns all converted (and not ignored) values in a list back
9906 * to the caller. If an error occured, a NULL pointer will be returned */
9908 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9910 size_t i, pos;
9911 int scanned = 1;
9912 const char *str = Jim_String(strObjPtr);
9913 int strLen = Jim_Utf8Length(interp, strObjPtr);
9914 Jim_Obj *resultList = 0;
9915 Jim_Obj **resultVec = 0;
9916 int resultc;
9917 Jim_Obj *emptyStr = 0;
9918 ScanFmtStringObj *fmtObj;
9920 /* This should never happen. The format object should already be of the correct type */
9921 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9923 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9924 /* Check if format specification was valid */
9925 if (fmtObj->error != 0) {
9926 if (flags & JIM_ERRMSG)
9927 Jim_SetResultString(interp, fmtObj->error, -1);
9928 return 0;
9930 /* Allocate a new "shared" empty string for all unassigned conversions */
9931 emptyStr = Jim_NewEmptyStringObj(interp);
9932 Jim_IncrRefCount(emptyStr);
9933 /* Create a list and fill it with empty strings up to max specified XPG3 */
9934 resultList = Jim_NewListObj(interp, NULL, 0);
9935 if (fmtObj->maxPos > 0) {
9936 for (i = 0; i < fmtObj->maxPos; ++i)
9937 Jim_ListAppendElement(interp, resultList, emptyStr);
9938 JimListGetElements(interp, resultList, &resultc, &resultVec);
9940 /* Now handle every partial format description */
9941 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9942 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9943 Jim_Obj *value = 0;
9945 /* Only last type may be "literal" w/o conversion - skip it! */
9946 if (descr->type == 0)
9947 continue;
9948 /* As long as any conversion could be done, we will proceed */
9949 if (scanned > 0)
9950 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9951 /* In case our first try results in EOF, we will leave */
9952 if (scanned == -1 && i == 0)
9953 goto eof;
9954 /* Advance next pos-to-be-scanned for the amount scanned already */
9955 pos += scanned;
9957 /* value == 0 means no conversion took place so take empty string */
9958 if (value == 0)
9959 value = Jim_NewEmptyStringObj(interp);
9960 /* If value is a non-assignable one, skip it */
9961 if (descr->pos == -1) {
9962 Jim_FreeNewObj(interp, value);
9964 else if (descr->pos == 0)
9965 /* Otherwise append it to the result list if no XPG3 was given */
9966 Jim_ListAppendElement(interp, resultList, value);
9967 else if (resultVec[descr->pos - 1] == emptyStr) {
9968 /* But due to given XPG3, put the value into the corr. slot */
9969 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9970 Jim_IncrRefCount(value);
9971 resultVec[descr->pos - 1] = value;
9973 else {
9974 /* Otherwise, the slot was already used - free obj and ERROR */
9975 Jim_FreeNewObj(interp, value);
9976 goto err;
9979 Jim_DecrRefCount(interp, emptyStr);
9980 return resultList;
9981 eof:
9982 Jim_DecrRefCount(interp, emptyStr);
9983 Jim_FreeNewObj(interp, resultList);
9984 return (Jim_Obj *)EOF;
9985 err:
9986 Jim_DecrRefCount(interp, emptyStr);
9987 Jim_FreeNewObj(interp, resultList);
9988 return 0;
9991 /* -----------------------------------------------------------------------------
9992 * Pseudo Random Number Generation
9993 * ---------------------------------------------------------------------------*/
9994 /* Initialize the sbox with the numbers from 0 to 255 */
9995 static void JimPrngInit(Jim_Interp *interp)
9997 #define PRNG_SEED_SIZE 256
9998 int i;
9999 unsigned int *seed;
10000 time_t t = time(NULL);
10002 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10004 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10005 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10006 seed[i] = (rand() ^ t ^ clock());
10008 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10009 Jim_Free(seed);
10012 /* Generates N bytes of random data */
10013 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10015 Jim_PrngState *prng;
10016 unsigned char *destByte = (unsigned char *)dest;
10017 unsigned int si, sj, x;
10019 /* initialization, only needed the first time */
10020 if (interp->prngState == NULL)
10021 JimPrngInit(interp);
10022 prng = interp->prngState;
10023 /* generates 'len' bytes of pseudo-random numbers */
10024 for (x = 0; x < len; x++) {
10025 prng->i = (prng->i + 1) & 0xff;
10026 si = prng->sbox[prng->i];
10027 prng->j = (prng->j + si) & 0xff;
10028 sj = prng->sbox[prng->j];
10029 prng->sbox[prng->i] = sj;
10030 prng->sbox[prng->j] = si;
10031 *destByte++ = prng->sbox[(si + sj) & 0xff];
10035 /* Re-seed the generator with user-provided bytes */
10036 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10038 int i;
10039 Jim_PrngState *prng;
10041 /* initialization, only needed the first time */
10042 if (interp->prngState == NULL)
10043 JimPrngInit(interp);
10044 prng = interp->prngState;
10046 /* Set the sbox[i] with i */
10047 for (i = 0; i < 256; i++)
10048 prng->sbox[i] = i;
10049 /* Now use the seed to perform a random permutation of the sbox */
10050 for (i = 0; i < seedLen; i++) {
10051 unsigned char t;
10053 t = prng->sbox[i & 0xFF];
10054 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10055 prng->sbox[seed[i]] = t;
10057 prng->i = prng->j = 0;
10059 /* discard at least the first 256 bytes of stream.
10060 * borrow the seed buffer for this
10062 for (i = 0; i < 256; i += seedLen) {
10063 JimRandomBytes(interp, seed, seedLen);
10067 /* [incr] */
10068 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10070 jim_wide wideValue, increment = 1;
10071 Jim_Obj *intObjPtr;
10073 if (argc != 2 && argc != 3) {
10074 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10075 return JIM_ERR;
10077 if (argc == 3) {
10078 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10079 return JIM_ERR;
10081 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10082 if (!intObjPtr) {
10083 /* Set missing variable to 0 */
10084 wideValue = 0;
10086 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10087 return JIM_ERR;
10089 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10090 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10091 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10092 Jim_FreeNewObj(interp, intObjPtr);
10093 return JIM_ERR;
10096 else {
10097 /* Can do it the quick way */
10098 Jim_InvalidateStringRep(intObjPtr);
10099 JimWideValue(intObjPtr) = wideValue + increment;
10101 /* The following step is required in order to invalidate the
10102 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10103 if (argv[1]->typePtr != &variableObjType) {
10104 /* Note that this can't fail since GetVariable already succeeded */
10105 Jim_SetVariable(interp, argv[1], intObjPtr);
10108 Jim_SetResult(interp, intObjPtr);
10109 return JIM_OK;
10113 /* -----------------------------------------------------------------------------
10114 * Eval
10115 * ---------------------------------------------------------------------------*/
10116 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10117 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10119 /* Handle calls to the [unknown] command */
10120 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10122 int retcode;
10124 /* If JimUnknown() is recursively called too many times...
10125 * done here
10127 if (interp->unknown_called > 50) {
10128 return JIM_ERR;
10131 /* The object interp->unknown just contains
10132 * the "unknown" string, it is used in order to
10133 * avoid to lookup the unknown command every time
10134 * but instead to cache the result. */
10136 /* If the [unknown] command does not exist ... */
10137 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10138 return JIM_ERR;
10140 interp->unknown_called++;
10141 /* XXX: Are we losing fileNameObj and linenr? */
10142 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10143 interp->unknown_called--;
10145 return retcode;
10148 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10150 int retcode;
10151 Jim_Cmd *cmdPtr;
10153 #if 0
10154 printf("invoke");
10155 int j;
10156 for (j = 0; j < objc; j++) {
10157 printf(" '%s'", Jim_String(objv[j]));
10159 printf("\n");
10160 #endif
10162 if (interp->framePtr->tailcallCmd) {
10163 /* Special tailcall command was pre-resolved */
10164 cmdPtr = interp->framePtr->tailcallCmd;
10165 interp->framePtr->tailcallCmd = NULL;
10167 else {
10168 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10169 if (cmdPtr == NULL) {
10170 return JimUnknown(interp, objc, objv);
10172 JimIncrCmdRefCount(cmdPtr);
10175 if (interp->evalDepth == interp->maxEvalDepth) {
10176 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10177 retcode = JIM_ERR;
10178 goto out;
10180 interp->evalDepth++;
10182 /* Call it -- Make sure result is an empty object. */
10183 Jim_SetEmptyResult(interp);
10184 if (cmdPtr->isproc) {
10185 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10187 else {
10188 interp->cmdPrivData = cmdPtr->u.native.privData;
10189 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10191 interp->evalDepth--;
10193 out:
10194 JimDecrCmdRefCount(interp, cmdPtr);
10196 return retcode;
10199 /* Eval the object vector 'objv' composed of 'objc' elements.
10200 * Every element is used as single argument.
10201 * Jim_EvalObj() will call this function every time its object
10202 * argument is of "list" type, with no string representation.
10204 * This is possible because the string representation of a
10205 * list object generated by the UpdateStringOfList is made
10206 * in a way that ensures that every list element is a different
10207 * command argument. */
10208 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10210 int i, retcode;
10212 /* Incr refcount of arguments. */
10213 for (i = 0; i < objc; i++)
10214 Jim_IncrRefCount(objv[i]);
10216 retcode = JimInvokeCommand(interp, objc, objv);
10218 /* Decr refcount of arguments and return the retcode */
10219 for (i = 0; i < objc; i++)
10220 Jim_DecrRefCount(interp, objv[i]);
10222 return retcode;
10226 * Invokes 'prefix' as a command with the objv array as arguments.
10228 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10230 int ret;
10231 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10233 nargv[0] = prefix;
10234 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10235 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10236 Jim_Free(nargv);
10237 return ret;
10240 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10242 int rc = retcode;
10244 if (rc == JIM_ERR && !interp->errorFlag) {
10245 /* This is the first error, so save the file/line information and reset the stack */
10246 interp->errorFlag = 1;
10247 Jim_IncrRefCount(script->fileNameObj);
10248 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10249 interp->errorFileNameObj = script->fileNameObj;
10250 interp->errorLine = script->linenr;
10252 JimResetStackTrace(interp);
10253 /* Always add a level where the error first occurs */
10254 interp->addStackTrace++;
10257 /* Now if this is an "interesting" level, add it to the stack trace */
10258 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10259 /* Add the stack info for the current level */
10261 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10263 /* Note: if we didn't have a filename for this level,
10264 * don't clear the addStackTrace flag
10265 * so we can pick it up at the next level
10267 if (Jim_Length(script->fileNameObj)) {
10268 interp->addStackTrace = 0;
10271 Jim_DecrRefCount(interp, interp->errorProc);
10272 interp->errorProc = interp->emptyObj;
10273 Jim_IncrRefCount(interp->errorProc);
10275 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10276 /* Propagate the addStackTrace value through 'return -code error' */
10278 else {
10279 interp->addStackTrace = 0;
10283 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10285 Jim_Obj *objPtr;
10287 switch (token->type) {
10288 case JIM_TT_STR:
10289 case JIM_TT_ESC:
10290 objPtr = token->objPtr;
10291 break;
10292 case JIM_TT_VAR:
10293 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10294 break;
10295 case JIM_TT_DICTSUGAR:
10296 objPtr = JimExpandDictSugar(interp, token->objPtr);
10297 break;
10298 case JIM_TT_EXPRSUGAR:
10299 objPtr = JimExpandExprSugar(interp, token->objPtr);
10300 break;
10301 case JIM_TT_CMD:
10302 switch (Jim_EvalObj(interp, token->objPtr)) {
10303 case JIM_OK:
10304 case JIM_RETURN:
10305 objPtr = interp->result;
10306 break;
10307 case JIM_BREAK:
10308 /* Stop substituting */
10309 return JIM_BREAK;
10310 case JIM_CONTINUE:
10311 /* just skip this one */
10312 return JIM_CONTINUE;
10313 default:
10314 return JIM_ERR;
10316 break;
10317 default:
10318 JimPanic((1,
10319 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10320 objPtr = NULL;
10321 break;
10323 if (objPtr) {
10324 *objPtrPtr = objPtr;
10325 return JIM_OK;
10327 return JIM_ERR;
10330 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10331 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10332 * The returned object has refcount = 0.
10334 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10336 int totlen = 0, i;
10337 Jim_Obj **intv;
10338 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10339 Jim_Obj *objPtr;
10340 char *s;
10342 if (tokens <= JIM_EVAL_SINTV_LEN)
10343 intv = sintv;
10344 else
10345 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10347 /* Compute every token forming the argument
10348 * in the intv objects vector. */
10349 for (i = 0; i < tokens; i++) {
10350 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10351 case JIM_OK:
10352 case JIM_RETURN:
10353 break;
10354 case JIM_BREAK:
10355 if (flags & JIM_SUBST_FLAG) {
10356 /* Stop here */
10357 tokens = i;
10358 continue;
10360 /* XXX: Should probably set an error about break outside loop */
10361 /* fall through to error */
10362 case JIM_CONTINUE:
10363 if (flags & JIM_SUBST_FLAG) {
10364 intv[i] = NULL;
10365 continue;
10367 /* XXX: Ditto continue outside loop */
10368 /* fall through to error */
10369 default:
10370 while (i--) {
10371 Jim_DecrRefCount(interp, intv[i]);
10373 if (intv != sintv) {
10374 Jim_Free(intv);
10376 return NULL;
10378 Jim_IncrRefCount(intv[i]);
10379 Jim_String(intv[i]);
10380 totlen += intv[i]->length;
10383 /* Fast path return for a single token */
10384 if (tokens == 1 && intv[0] && intv == sintv) {
10385 Jim_DecrRefCount(interp, intv[0]);
10386 return intv[0];
10389 /* Concatenate every token in an unique
10390 * object. */
10391 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10393 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10394 && token[2].type == JIM_TT_VAR) {
10395 /* May be able to do fast interpolated object -> dictSubst */
10396 objPtr->typePtr = &interpolatedObjType;
10397 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10398 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10399 Jim_IncrRefCount(intv[2]);
10401 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10402 /* The first interpolated token is source, so preserve the source info */
10403 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10407 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10408 objPtr->length = totlen;
10409 for (i = 0; i < tokens; i++) {
10410 if (intv[i]) {
10411 memcpy(s, intv[i]->bytes, intv[i]->length);
10412 s += intv[i]->length;
10413 Jim_DecrRefCount(interp, intv[i]);
10416 objPtr->bytes[totlen] = '\0';
10417 /* Free the intv vector if not static. */
10418 if (intv != sintv) {
10419 Jim_Free(intv);
10422 return objPtr;
10426 /* listPtr *must* be a list.
10427 * The contents of the list is evaluated with the first element as the command and
10428 * the remaining elements as the arguments.
10430 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10432 int retcode = JIM_OK;
10434 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10436 if (listPtr->internalRep.listValue.len) {
10437 Jim_IncrRefCount(listPtr);
10438 retcode = JimInvokeCommand(interp,
10439 listPtr->internalRep.listValue.len,
10440 listPtr->internalRep.listValue.ele);
10441 Jim_DecrRefCount(interp, listPtr);
10443 return retcode;
10446 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10448 SetListFromAny(interp, listPtr);
10449 return JimEvalObjList(interp, listPtr);
10452 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10454 int i;
10455 ScriptObj *script;
10456 ScriptToken *token;
10457 int retcode = JIM_OK;
10458 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10459 Jim_Obj *prevScriptObj;
10461 /* If the object is of type "list", with no string rep we can call
10462 * a specialized version of Jim_EvalObj() */
10463 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10464 return JimEvalObjList(interp, scriptObjPtr);
10467 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10468 script = Jim_GetScript(interp, scriptObjPtr);
10469 if (script == NULL) {
10470 Jim_DecrRefCount(interp, scriptObjPtr);
10471 return JIM_ERR;
10474 /* Reset the interpreter result. This is useful to
10475 * return the empty result in the case of empty program. */
10476 Jim_SetEmptyResult(interp);
10478 token = script->token;
10480 #ifdef JIM_OPTIMIZATION
10481 /* Check for one of the following common scripts used by for, while
10483 * {}
10484 * incr a
10486 if (script->len == 0) {
10487 Jim_DecrRefCount(interp, scriptObjPtr);
10488 return JIM_OK;
10490 if (script->len == 3
10491 && token[1].objPtr->typePtr == &commandObjType
10492 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10493 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10494 && token[2].objPtr->typePtr == &variableObjType) {
10496 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10498 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10499 JimWideValue(objPtr)++;
10500 Jim_InvalidateStringRep(objPtr);
10501 Jim_DecrRefCount(interp, scriptObjPtr);
10502 Jim_SetResult(interp, objPtr);
10503 return JIM_OK;
10506 #endif
10508 /* Now we have to make sure the internal repr will not be
10509 * freed on shimmering.
10511 * Think for example to this:
10513 * set x {llength $x; ... some more code ...}; eval $x
10515 * In order to preserve the internal rep, we increment the
10516 * inUse field of the script internal rep structure. */
10517 script->inUse++;
10519 /* Stash the current script */
10520 prevScriptObj = interp->currentScriptObj;
10521 interp->currentScriptObj = scriptObjPtr;
10523 interp->errorFlag = 0;
10524 argv = sargv;
10526 /* Execute every command sequentially until the end of the script
10527 * or an error occurs.
10529 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10530 int argc;
10531 int j;
10533 /* First token of the line is always JIM_TT_LINE */
10534 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10535 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10537 /* Allocate the arguments vector if required */
10538 if (argc > JIM_EVAL_SARGV_LEN)
10539 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10541 /* Skip the JIM_TT_LINE token */
10542 i++;
10544 /* Populate the arguments objects.
10545 * If an error occurs, retcode will be set and
10546 * 'j' will be set to the number of args expanded
10548 for (j = 0; j < argc; j++) {
10549 long wordtokens = 1;
10550 int expand = 0;
10551 Jim_Obj *wordObjPtr = NULL;
10553 if (token[i].type == JIM_TT_WORD) {
10554 wordtokens = JimWideValue(token[i++].objPtr);
10555 if (wordtokens < 0) {
10556 expand = 1;
10557 wordtokens = -wordtokens;
10561 if (wordtokens == 1) {
10562 /* Fast path if the token does not
10563 * need interpolation */
10565 switch (token[i].type) {
10566 case JIM_TT_ESC:
10567 case JIM_TT_STR:
10568 wordObjPtr = token[i].objPtr;
10569 break;
10570 case JIM_TT_VAR:
10571 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10572 break;
10573 case JIM_TT_EXPRSUGAR:
10574 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10575 break;
10576 case JIM_TT_DICTSUGAR:
10577 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10578 break;
10579 case JIM_TT_CMD:
10580 retcode = Jim_EvalObj(interp, token[i].objPtr);
10581 if (retcode == JIM_OK) {
10582 wordObjPtr = Jim_GetResult(interp);
10584 break;
10585 default:
10586 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10589 else {
10590 /* For interpolation we call a helper
10591 * function to do the work for us. */
10592 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10595 if (!wordObjPtr) {
10596 if (retcode == JIM_OK) {
10597 retcode = JIM_ERR;
10599 break;
10602 Jim_IncrRefCount(wordObjPtr);
10603 i += wordtokens;
10605 if (!expand) {
10606 argv[j] = wordObjPtr;
10608 else {
10609 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10610 int len = Jim_ListLength(interp, wordObjPtr);
10611 int newargc = argc + len - 1;
10612 int k;
10614 if (len > 1) {
10615 if (argv == sargv) {
10616 if (newargc > JIM_EVAL_SARGV_LEN) {
10617 argv = Jim_Alloc(sizeof(*argv) * newargc);
10618 memcpy(argv, sargv, sizeof(*argv) * j);
10621 else {
10622 /* Need to realloc to make room for (len - 1) more entries */
10623 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10627 /* Now copy in the expanded version */
10628 for (k = 0; k < len; k++) {
10629 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10630 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10633 /* The original object reference is no longer needed,
10634 * after the expansion it is no longer present on
10635 * the argument vector, but the single elements are
10636 * in its place. */
10637 Jim_DecrRefCount(interp, wordObjPtr);
10639 /* And update the indexes */
10640 j--;
10641 argc += len - 1;
10645 if (retcode == JIM_OK && argc) {
10646 /* Invoke the command */
10647 retcode = JimInvokeCommand(interp, argc, argv);
10648 /* Check for a signal after each command */
10649 if (Jim_CheckSignal(interp)) {
10650 retcode = JIM_SIGNAL;
10654 /* Finished with the command, so decrement ref counts of each argument */
10655 while (j-- > 0) {
10656 Jim_DecrRefCount(interp, argv[j]);
10659 if (argv != sargv) {
10660 Jim_Free(argv);
10661 argv = sargv;
10665 /* Possibly add to the error stack trace */
10666 JimAddErrorToStack(interp, retcode, script);
10668 /* Restore the current script */
10669 interp->currentScriptObj = prevScriptObj;
10671 /* Note that we don't have to decrement inUse, because the
10672 * following code transfers our use of the reference again to
10673 * the script object. */
10674 Jim_FreeIntRep(interp, scriptObjPtr);
10675 scriptObjPtr->typePtr = &scriptObjType;
10676 Jim_SetIntRepPtr(scriptObjPtr, script);
10677 Jim_DecrRefCount(interp, scriptObjPtr);
10679 return retcode;
10682 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10684 int retcode;
10685 /* If argObjPtr begins with '&', do an automatic upvar */
10686 const char *varname = Jim_String(argNameObj);
10687 if (*varname == '&') {
10688 /* First check that the target variable exists */
10689 Jim_Obj *objPtr;
10690 Jim_CallFrame *savedCallFrame = interp->framePtr;
10692 interp->framePtr = interp->framePtr->parent;
10693 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10694 interp->framePtr = savedCallFrame;
10695 if (!objPtr) {
10696 return JIM_ERR;
10699 /* It exists, so perform the binding. */
10700 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10701 Jim_IncrRefCount(objPtr);
10702 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10703 Jim_DecrRefCount(interp, objPtr);
10705 else {
10706 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10708 return retcode;
10712 * Sets the interp result to be an error message indicating the required proc args.
10714 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10716 /* Create a nice error message, consistent with Tcl 8.5 */
10717 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10718 int i;
10720 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10721 Jim_AppendString(interp, argmsg, " ", 1);
10723 if (i == cmd->u.proc.argsPos) {
10724 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10725 /* Renamed args */
10726 Jim_AppendString(interp, argmsg, "?", 1);
10727 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10728 Jim_AppendString(interp, argmsg, " ...?", -1);
10730 else {
10731 /* We have plain args */
10732 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10735 else {
10736 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10737 Jim_AppendString(interp, argmsg, "?", 1);
10738 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10739 Jim_AppendString(interp, argmsg, "?", 1);
10741 else {
10742 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10743 if (*arg == '&') {
10744 arg++;
10746 Jim_AppendString(interp, argmsg, arg, -1);
10750 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10751 Jim_FreeNewObj(interp, argmsg);
10754 #ifdef jim_ext_namespace
10756 * [namespace eval]
10758 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10760 Jim_CallFrame *callFramePtr;
10761 int retcode;
10763 /* Create a new callframe */
10764 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10765 callFramePtr->argv = &interp->emptyObj;
10766 callFramePtr->argc = 0;
10767 callFramePtr->procArgsObjPtr = NULL;
10768 callFramePtr->procBodyObjPtr = scriptObj;
10769 callFramePtr->staticVars = NULL;
10770 callFramePtr->fileNameObj = interp->emptyObj;
10771 callFramePtr->line = 0;
10772 Jim_IncrRefCount(scriptObj);
10773 interp->framePtr = callFramePtr;
10775 /* Check if there are too nested calls */
10776 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10777 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10778 retcode = JIM_ERR;
10780 else {
10781 /* Eval the body */
10782 retcode = Jim_EvalObj(interp, scriptObj);
10785 /* Destroy the callframe */
10786 interp->framePtr = interp->framePtr->parent;
10787 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10789 return retcode;
10791 #endif
10793 /* Call a procedure implemented in Tcl.
10794 * It's possible to speed-up a lot this function, currently
10795 * the callframes are not cached, but allocated and
10796 * destroied every time. What is expecially costly is
10797 * to create/destroy the local vars hash table every time.
10799 * This can be fixed just implementing callframes caching
10800 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10801 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10803 Jim_CallFrame *callFramePtr;
10804 int i, d, retcode, optargs;
10805 ScriptObj *script;
10807 /* Check arity */
10808 if (argc - 1 < cmd->u.proc.reqArity ||
10809 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10810 JimSetProcWrongArgs(interp, argv[0], cmd);
10811 return JIM_ERR;
10814 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10815 /* Optimise for procedure with no body - useful for optional debugging */
10816 return JIM_OK;
10819 /* Check if there are too nested calls */
10820 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10821 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10822 return JIM_ERR;
10825 /* Create a new callframe */
10826 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10827 callFramePtr->argv = argv;
10828 callFramePtr->argc = argc;
10829 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10830 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10831 callFramePtr->staticVars = cmd->u.proc.staticVars;
10833 /* Remember where we were called from. */
10834 script = Jim_GetScript(interp, interp->currentScriptObj);
10835 callFramePtr->fileNameObj = script->fileNameObj;
10836 callFramePtr->line = script->linenr;
10838 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10839 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10840 interp->framePtr = callFramePtr;
10842 /* How many optional args are available */
10843 optargs = (argc - 1 - cmd->u.proc.reqArity);
10845 /* Step 'i' along the actual args, and step 'd' along the formal args */
10846 i = 1;
10847 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10848 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10849 if (d == cmd->u.proc.argsPos) {
10850 /* assign $args */
10851 Jim_Obj *listObjPtr;
10852 int argsLen = 0;
10853 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10854 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10856 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10858 /* It is possible to rename args. */
10859 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10860 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10862 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10863 if (retcode != JIM_OK) {
10864 goto badargset;
10867 i += argsLen;
10868 continue;
10871 /* Optional or required? */
10872 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10873 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10875 else {
10876 /* Ran out, so use the default */
10877 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10879 if (retcode != JIM_OK) {
10880 goto badargset;
10884 /* Eval the body */
10885 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10887 badargset:
10889 /* Free the callframe */
10890 interp->framePtr = interp->framePtr->parent;
10891 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10893 if (interp->framePtr->tailcallObj) {
10894 /* If a tailcall is already being executed, merge this tailcall with that one */
10895 if (interp->framePtr->tailcall++ == 0) {
10896 /* No current tailcall in this frame, so invoke the tailcall command */
10897 do {
10898 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10900 interp->framePtr->tailcallObj = NULL;
10902 if (retcode == JIM_EVAL) {
10903 retcode = Jim_EvalObjList(interp, tailcallObj);
10904 if (retcode == JIM_RETURN) {
10905 /* If the result of the tailcall is 'return', push
10906 * it up to the caller
10908 interp->returnLevel++;
10911 Jim_DecrRefCount(interp, tailcallObj);
10912 } while (interp->framePtr->tailcallObj);
10914 /* If the tailcall chain finished early, may need to manually discard the command */
10915 if (interp->framePtr->tailcallCmd) {
10916 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10917 interp->framePtr->tailcallCmd = NULL;
10920 interp->framePtr->tailcall--;
10923 /* Handle the JIM_RETURN return code */
10924 if (retcode == JIM_RETURN) {
10925 if (--interp->returnLevel <= 0) {
10926 retcode = interp->returnCode;
10927 interp->returnCode = JIM_OK;
10928 interp->returnLevel = 0;
10931 else if (retcode == JIM_ERR) {
10932 interp->addStackTrace++;
10933 Jim_DecrRefCount(interp, interp->errorProc);
10934 interp->errorProc = argv[0];
10935 Jim_IncrRefCount(interp->errorProc);
10938 return retcode;
10941 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10943 int retval;
10944 Jim_Obj *scriptObjPtr;
10946 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10947 Jim_IncrRefCount(scriptObjPtr);
10949 if (filename) {
10950 Jim_Obj *prevScriptObj;
10952 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10954 prevScriptObj = interp->currentScriptObj;
10955 interp->currentScriptObj = scriptObjPtr;
10957 retval = Jim_EvalObj(interp, scriptObjPtr);
10959 interp->currentScriptObj = prevScriptObj;
10961 else {
10962 retval = Jim_EvalObj(interp, scriptObjPtr);
10964 Jim_DecrRefCount(interp, scriptObjPtr);
10965 return retval;
10968 int Jim_Eval(Jim_Interp *interp, const char *script)
10970 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10973 /* Execute script in the scope of the global level */
10974 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10976 int retval;
10977 Jim_CallFrame *savedFramePtr = interp->framePtr;
10979 interp->framePtr = interp->topFramePtr;
10980 retval = Jim_Eval(interp, script);
10981 interp->framePtr = savedFramePtr;
10983 return retval;
10986 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10988 int retval;
10989 Jim_CallFrame *savedFramePtr = interp->framePtr;
10991 interp->framePtr = interp->topFramePtr;
10992 retval = Jim_EvalFile(interp, filename);
10993 interp->framePtr = savedFramePtr;
10995 return retval;
10998 #include <sys/stat.h>
11000 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11002 FILE *fp;
11003 char *buf;
11004 Jim_Obj *scriptObjPtr;
11005 Jim_Obj *prevScriptObj;
11006 struct stat sb;
11007 int retcode;
11008 int readlen;
11010 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11011 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11012 return JIM_ERR;
11014 if (sb.st_size == 0) {
11015 fclose(fp);
11016 return JIM_OK;
11019 buf = Jim_Alloc(sb.st_size + 1);
11020 readlen = fread(buf, 1, sb.st_size, fp);
11021 if (ferror(fp)) {
11022 fclose(fp);
11023 Jim_Free(buf);
11024 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11025 return JIM_ERR;
11027 fclose(fp);
11028 buf[readlen] = 0;
11030 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11031 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11032 Jim_IncrRefCount(scriptObjPtr);
11034 /* Now check the script for unmatched braces, etc. */
11035 if (Jim_GetScript(interp, scriptObjPtr) == NULL) {
11036 /* EvalFile changes context, so add a stack frame here */
11037 JimAddErrorToStack(interp, JIM_ERR, (ScriptObj *)Jim_GetIntRepPtr(scriptObjPtr));
11038 Jim_DecrRefCount(interp, scriptObjPtr);
11039 return JIM_ERR;
11042 prevScriptObj = interp->currentScriptObj;
11043 interp->currentScriptObj = scriptObjPtr;
11045 retcode = Jim_EvalObj(interp, scriptObjPtr);
11047 /* Handle the JIM_RETURN return code */
11048 if (retcode == JIM_RETURN) {
11049 if (--interp->returnLevel <= 0) {
11050 retcode = interp->returnCode;
11051 interp->returnCode = JIM_OK;
11052 interp->returnLevel = 0;
11055 if (retcode == JIM_ERR) {
11056 /* EvalFile changes context, so add a stack frame here */
11057 interp->addStackTrace++;
11060 interp->currentScriptObj = prevScriptObj;
11062 Jim_DecrRefCount(interp, scriptObjPtr);
11064 return retcode;
11067 /* -----------------------------------------------------------------------------
11068 * Subst
11069 * ---------------------------------------------------------------------------*/
11070 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11072 pc->tstart = pc->p;
11073 pc->tline = pc->linenr;
11075 if (pc->len == 0) {
11076 pc->tend = pc->p;
11077 pc->tt = JIM_TT_EOL;
11078 pc->eof = 1;
11079 return;
11081 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11082 JimParseCmd(pc);
11083 return;
11085 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11086 if (JimParseVar(pc) == JIM_OK) {
11087 return;
11089 /* Not a var, so treat as a string */
11090 pc->tstart = pc->p;
11091 flags |= JIM_SUBST_NOVAR;
11093 while (pc->len) {
11094 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11095 break;
11097 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11098 break;
11100 if (*pc->p == '\\' && pc->len > 1) {
11101 pc->p++;
11102 pc->len--;
11104 pc->p++;
11105 pc->len--;
11107 pc->tend = pc->p - 1;
11108 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11111 /* The subst object type reuses most of the data structures and functions
11112 * of the script object. Script's data structures are a bit more complex
11113 * for what is needed for [subst]itution tasks, but the reuse helps to
11114 * deal with a single data structure at the cost of some more memory
11115 * usage for substitutions. */
11117 /* This method takes the string representation of an object
11118 * as a Tcl string where to perform [subst]itution, and generates
11119 * the pre-parsed internal representation. */
11120 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11122 int scriptTextLen;
11123 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11124 struct JimParserCtx parser;
11125 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11126 ParseTokenList tokenlist;
11128 /* Initially parse the subst into tokens (in tokenlist) */
11129 ScriptTokenListInit(&tokenlist);
11131 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11132 while (1) {
11133 JimParseSubst(&parser, flags);
11134 if (parser.eof) {
11135 /* Note that subst doesn't need the EOL token */
11136 break;
11138 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11139 parser.tline);
11142 /* Create the "real" subst/script tokens from the initial token list */
11143 script->inUse = 1;
11144 script->substFlags = flags;
11145 script->fileNameObj = interp->emptyObj;
11146 Jim_IncrRefCount(script->fileNameObj);
11147 SubstObjAddTokens(interp, script, &tokenlist);
11149 /* No longer need the token list */
11150 ScriptTokenListFree(&tokenlist);
11152 #ifdef DEBUG_SHOW_SUBST
11154 int i;
11156 printf("==== Subst ====\n");
11157 for (i = 0; i < script->len; i++) {
11158 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11159 Jim_String(script->token[i].objPtr));
11162 #endif
11164 /* Free the old internal rep and set the new one. */
11165 Jim_FreeIntRep(interp, objPtr);
11166 Jim_SetIntRepPtr(objPtr, script);
11167 objPtr->typePtr = &scriptObjType;
11168 return JIM_OK;
11171 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11173 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11174 SetSubstFromAny(interp, objPtr, flags);
11175 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11178 /* Performs commands,variables,blackslashes substitution,
11179 * storing the result object (with refcount 0) into
11180 * resObjPtrPtr. */
11181 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11183 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11185 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11186 /* In order to preserve the internal rep, we increment the
11187 * inUse field of the script internal rep structure. */
11188 script->inUse++;
11190 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11192 script->inUse--;
11193 Jim_DecrRefCount(interp, substObjPtr);
11194 if (*resObjPtrPtr == NULL) {
11195 return JIM_ERR;
11197 return JIM_OK;
11200 /* -----------------------------------------------------------------------------
11201 * Core commands utility functions
11202 * ---------------------------------------------------------------------------*/
11203 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11205 Jim_Obj *objPtr;
11206 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11208 if (*msg) {
11209 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11211 Jim_IncrRefCount(listObjPtr);
11212 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11213 Jim_DecrRefCount(interp, listObjPtr);
11215 Jim_IncrRefCount(objPtr);
11216 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11217 Jim_DecrRefCount(interp, objPtr);
11221 * May add the key and/or value to the list.
11223 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11224 Jim_HashEntry *he, int type);
11226 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11229 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11230 * invoke the callback to add entries to a list.
11231 * Returns the list.
11233 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11234 JimHashtableIteratorCallbackType *callback, int type)
11236 Jim_HashEntry *he;
11237 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11239 /* Check for the non-pattern case. We can do this much more efficiently. */
11240 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11241 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11242 if (he) {
11243 callback(interp, listObjPtr, he, type);
11246 else {
11247 Jim_HashTableIterator htiter;
11248 JimInitHashTableIterator(ht, &htiter);
11249 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11250 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11251 callback(interp, listObjPtr, he, type);
11255 return listObjPtr;
11258 /* Keep these in order */
11259 #define JIM_CMDLIST_COMMANDS 0
11260 #define JIM_CMDLIST_PROCS 1
11261 #define JIM_CMDLIST_CHANNELS 2
11264 * Adds matching command names (procs, channels) to the list.
11266 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11267 Jim_HashEntry *he, int type)
11269 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11270 Jim_Obj *objPtr;
11272 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11273 /* not a proc */
11274 return;
11277 objPtr = Jim_NewStringObj(interp, he->key, -1);
11278 Jim_IncrRefCount(objPtr);
11280 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11281 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11283 Jim_DecrRefCount(interp, objPtr);
11286 /* type is JIM_CMDLIST_xxx */
11287 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11289 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11292 /* Keep these in order */
11293 #define JIM_VARLIST_GLOBALS 0
11294 #define JIM_VARLIST_LOCALS 1
11295 #define JIM_VARLIST_VARS 2
11297 #define JIM_VARLIST_VALUES 0x1000
11300 * Adds matching variable names to the list.
11302 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11303 Jim_HashEntry *he, int type)
11305 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11307 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11308 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11309 if (type & JIM_VARLIST_VALUES) {
11310 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11315 /* mode is JIM_VARLIST_xxx */
11316 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11318 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11319 /* For [info locals], if we are at top level an emtpy list
11320 * is returned. I don't agree, but we aim at compatibility (SS) */
11321 return interp->emptyObj;
11323 else {
11324 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11325 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11329 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11330 Jim_Obj **objPtrPtr, int info_level_cmd)
11332 Jim_CallFrame *targetCallFrame;
11334 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11335 if (targetCallFrame == NULL) {
11336 return JIM_ERR;
11338 /* No proc call at toplevel callframe */
11339 if (targetCallFrame == interp->topFramePtr) {
11340 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11341 return JIM_ERR;
11343 if (info_level_cmd) {
11344 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11346 else {
11347 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11349 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11350 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11351 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11352 *objPtrPtr = listObj;
11354 return JIM_OK;
11357 /* -----------------------------------------------------------------------------
11358 * Core commands
11359 * ---------------------------------------------------------------------------*/
11361 /* fake [puts] -- not the real puts, just for debugging. */
11362 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11364 if (argc != 2 && argc != 3) {
11365 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11366 return JIM_ERR;
11368 if (argc == 3) {
11369 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11370 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11371 return JIM_ERR;
11373 else {
11374 fputs(Jim_String(argv[2]), stdout);
11377 else {
11378 puts(Jim_String(argv[1]));
11380 return JIM_OK;
11383 /* Helper for [+] and [*] */
11384 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11386 jim_wide wideValue, res;
11387 double doubleValue, doubleRes;
11388 int i;
11390 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11392 for (i = 1; i < argc; i++) {
11393 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11394 goto trydouble;
11395 if (op == JIM_EXPROP_ADD)
11396 res += wideValue;
11397 else
11398 res *= wideValue;
11400 Jim_SetResultInt(interp, res);
11401 return JIM_OK;
11402 trydouble:
11403 doubleRes = (double)res;
11404 for (; i < argc; i++) {
11405 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11406 return JIM_ERR;
11407 if (op == JIM_EXPROP_ADD)
11408 doubleRes += doubleValue;
11409 else
11410 doubleRes *= doubleValue;
11412 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11413 return JIM_OK;
11416 /* Helper for [-] and [/] */
11417 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11419 jim_wide wideValue, res = 0;
11420 double doubleValue, doubleRes = 0;
11421 int i = 2;
11423 if (argc < 2) {
11424 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11425 return JIM_ERR;
11427 else if (argc == 2) {
11428 /* The arity = 2 case is different. For [- x] returns -x,
11429 * while [/ x] returns 1/x. */
11430 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11431 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11432 return JIM_ERR;
11434 else {
11435 if (op == JIM_EXPROP_SUB)
11436 doubleRes = -doubleValue;
11437 else
11438 doubleRes = 1.0 / doubleValue;
11439 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11440 return JIM_OK;
11443 if (op == JIM_EXPROP_SUB) {
11444 res = -wideValue;
11445 Jim_SetResultInt(interp, res);
11447 else {
11448 doubleRes = 1.0 / wideValue;
11449 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11451 return JIM_OK;
11453 else {
11454 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11455 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11456 != JIM_OK) {
11457 return JIM_ERR;
11459 else {
11460 goto trydouble;
11464 for (i = 2; i < argc; i++) {
11465 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11466 doubleRes = (double)res;
11467 goto trydouble;
11469 if (op == JIM_EXPROP_SUB)
11470 res -= wideValue;
11471 else
11472 res /= wideValue;
11474 Jim_SetResultInt(interp, res);
11475 return JIM_OK;
11476 trydouble:
11477 for (; i < argc; i++) {
11478 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11479 return JIM_ERR;
11480 if (op == JIM_EXPROP_SUB)
11481 doubleRes -= doubleValue;
11482 else
11483 doubleRes /= doubleValue;
11485 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11486 return JIM_OK;
11490 /* [+] */
11491 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11493 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11496 /* [*] */
11497 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11499 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11502 /* [-] */
11503 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11505 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11508 /* [/] */
11509 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11511 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11514 /* [set] */
11515 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11517 if (argc != 2 && argc != 3) {
11518 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11519 return JIM_ERR;
11521 if (argc == 2) {
11522 Jim_Obj *objPtr;
11524 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11525 if (!objPtr)
11526 return JIM_ERR;
11527 Jim_SetResult(interp, objPtr);
11528 return JIM_OK;
11530 /* argc == 3 case. */
11531 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11532 return JIM_ERR;
11533 Jim_SetResult(interp, argv[2]);
11534 return JIM_OK;
11537 /* [unset]
11539 * unset ?-nocomplain? ?--? ?varName ...?
11541 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11543 int i = 1;
11544 int complain = 1;
11546 while (i < argc) {
11547 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11548 i++;
11549 break;
11551 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11552 complain = 0;
11553 i++;
11554 continue;
11556 break;
11559 while (i < argc) {
11560 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11561 && complain) {
11562 return JIM_ERR;
11564 i++;
11566 return JIM_OK;
11569 /* [while] */
11570 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11572 if (argc != 3) {
11573 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11574 return JIM_ERR;
11577 /* The general purpose implementation of while starts here */
11578 while (1) {
11579 int boolean, retval;
11581 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11582 return retval;
11583 if (!boolean)
11584 break;
11586 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11587 switch (retval) {
11588 case JIM_BREAK:
11589 goto out;
11590 break;
11591 case JIM_CONTINUE:
11592 continue;
11593 break;
11594 default:
11595 return retval;
11599 out:
11600 Jim_SetEmptyResult(interp);
11601 return JIM_OK;
11604 /* [for] */
11605 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11607 int retval;
11608 int boolean = 1;
11609 Jim_Obj *varNamePtr = NULL;
11610 Jim_Obj *stopVarNamePtr = NULL;
11612 if (argc != 5) {
11613 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11614 return JIM_ERR;
11617 /* Do the initialisation */
11618 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11619 return retval;
11622 /* And do the first test now. Better for optimisation
11623 * if we can do next/test at the bottom of the loop
11625 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11627 /* Ready to do the body as follows:
11628 * while (1) {
11629 * body // check retcode
11630 * next // check retcode
11631 * test // check retcode/test bool
11635 #ifdef JIM_OPTIMIZATION
11636 /* Check if the for is on the form:
11637 * for ... {$i < CONST} {incr i}
11638 * for ... {$i < $j} {incr i}
11640 if (retval == JIM_OK && boolean) {
11641 ScriptObj *incrScript;
11642 ExprByteCode *expr;
11643 jim_wide stop, currentVal;
11644 Jim_Obj *objPtr;
11645 int cmpOffset;
11647 /* Do it only if there aren't shared arguments */
11648 expr = JimGetExpression(interp, argv[2]);
11649 incrScript = Jim_GetScript(interp, argv[3]);
11651 /* Ensure proper lengths to start */
11652 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11653 goto evalstart;
11655 /* Ensure proper token types. */
11656 if (incrScript->token[1].type != JIM_TT_ESC ||
11657 expr->token[0].type != JIM_TT_VAR ||
11658 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11659 goto evalstart;
11662 if (expr->token[2].type == JIM_EXPROP_LT) {
11663 cmpOffset = 0;
11665 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11666 cmpOffset = 1;
11668 else {
11669 goto evalstart;
11672 /* Update command must be incr */
11673 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11674 goto evalstart;
11677 /* incr, expression must be about the same variable */
11678 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11679 goto evalstart;
11682 /* Get the stop condition (must be a variable or integer) */
11683 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11684 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11685 goto evalstart;
11688 else {
11689 stopVarNamePtr = expr->token[1].objPtr;
11690 Jim_IncrRefCount(stopVarNamePtr);
11691 /* Keep the compiler happy */
11692 stop = 0;
11695 /* Initialization */
11696 varNamePtr = expr->token[0].objPtr;
11697 Jim_IncrRefCount(varNamePtr);
11699 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11700 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11701 goto testcond;
11704 /* --- OPTIMIZED FOR --- */
11705 while (retval == JIM_OK) {
11706 /* === Check condition === */
11707 /* Note that currentVal is already set here */
11709 /* Immediate or Variable? get the 'stop' value if the latter. */
11710 if (stopVarNamePtr) {
11711 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11712 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11713 goto testcond;
11717 if (currentVal >= stop + cmpOffset) {
11718 break;
11721 /* Eval body */
11722 retval = Jim_EvalObj(interp, argv[4]);
11723 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11724 retval = JIM_OK;
11726 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11728 /* Increment */
11729 if (objPtr == NULL) {
11730 retval = JIM_ERR;
11731 goto out;
11733 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11734 currentVal = ++JimWideValue(objPtr);
11735 Jim_InvalidateStringRep(objPtr);
11737 else {
11738 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11739 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11740 ++currentVal)) != JIM_OK) {
11741 goto evalnext;
11746 goto out;
11748 evalstart:
11749 #endif
11751 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11752 /* Body */
11753 retval = Jim_EvalObj(interp, argv[4]);
11755 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11756 /* increment */
11757 evalnext:
11758 retval = Jim_EvalObj(interp, argv[3]);
11759 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11760 /* test */
11761 testcond:
11762 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11766 out:
11767 if (stopVarNamePtr) {
11768 Jim_DecrRefCount(interp, stopVarNamePtr);
11770 if (varNamePtr) {
11771 Jim_DecrRefCount(interp, varNamePtr);
11774 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11775 Jim_SetEmptyResult(interp);
11776 return JIM_OK;
11779 return retval;
11782 /* [loop] */
11783 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11785 int retval;
11786 jim_wide i;
11787 jim_wide limit;
11788 jim_wide incr = 1;
11789 Jim_Obj *bodyObjPtr;
11791 if (argc != 5 && argc != 6) {
11792 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11793 return JIM_ERR;
11796 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11797 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11798 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11799 return JIM_ERR;
11801 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11803 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11805 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11806 retval = Jim_EvalObj(interp, bodyObjPtr);
11807 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11808 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11810 retval = JIM_OK;
11812 /* Increment */
11813 i += incr;
11815 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11816 if (argv[1]->typePtr != &variableObjType) {
11817 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11818 return JIM_ERR;
11821 JimWideValue(objPtr) = i;
11822 Jim_InvalidateStringRep(objPtr);
11824 /* The following step is required in order to invalidate the
11825 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11826 if (argv[1]->typePtr != &variableObjType) {
11827 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11828 retval = JIM_ERR;
11829 break;
11833 else {
11834 objPtr = Jim_NewIntObj(interp, i);
11835 retval = Jim_SetVariable(interp, argv[1], objPtr);
11836 if (retval != JIM_OK) {
11837 Jim_FreeNewObj(interp, objPtr);
11843 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11844 Jim_SetEmptyResult(interp);
11845 return JIM_OK;
11847 return retval;
11850 /* List iterators make it easy to iterate over a list.
11851 * At some point iterators will be expanded to support generators.
11853 typedef struct {
11854 Jim_Obj *objPtr;
11855 int idx;
11856 } Jim_ListIter;
11859 * Initialise the iterator at the start of the list.
11861 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11863 iter->objPtr = objPtr;
11864 iter->idx = 0;
11868 * Returns the next object from the list, or NULL on end-of-list.
11870 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11872 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11873 return NULL;
11875 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11879 * Returns 1 if end-of-list has been reached.
11881 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11883 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11886 /* foreach + lmap implementation. */
11887 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11889 int result = JIM_OK;
11890 int i, numargs;
11891 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11892 Jim_ListIter *iters;
11893 Jim_Obj *script;
11894 Jim_Obj *resultObj;
11896 if (argc < 4 || argc % 2 != 0) {
11897 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11898 return JIM_ERR;
11900 script = argv[argc - 1]; /* Last argument is a script */
11901 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11903 if (numargs == 2) {
11904 iters = twoiters;
11906 else {
11907 iters = Jim_Alloc(numargs * sizeof(*iters));
11909 for (i = 0; i < numargs; i++) {
11910 JimListIterInit(&iters[i], argv[i + 1]);
11911 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11912 result = JIM_ERR;
11915 if (result != JIM_OK) {
11916 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11917 return result;
11920 if (doMap) {
11921 resultObj = Jim_NewListObj(interp, NULL, 0);
11923 else {
11924 resultObj = interp->emptyObj;
11926 Jim_IncrRefCount(resultObj);
11928 while (1) {
11929 /* Have we expired all lists? */
11930 for (i = 0; i < numargs; i += 2) {
11931 if (!JimListIterDone(interp, &iters[i + 1])) {
11932 break;
11935 if (i == numargs) {
11936 /* All done */
11937 break;
11940 /* For each list */
11941 for (i = 0; i < numargs; i += 2) {
11942 Jim_Obj *varName;
11944 /* foreach var */
11945 JimListIterInit(&iters[i], argv[i + 1]);
11946 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11947 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11948 if (!valObj) {
11949 /* Ran out, so store the empty string */
11950 valObj = interp->emptyObj;
11952 /* Avoid shimmering */
11953 Jim_IncrRefCount(valObj);
11954 result = Jim_SetVariable(interp, varName, valObj);
11955 Jim_DecrRefCount(interp, valObj);
11956 if (result != JIM_OK) {
11957 goto err;
11961 switch (result = Jim_EvalObj(interp, script)) {
11962 case JIM_OK:
11963 if (doMap) {
11964 Jim_ListAppendElement(interp, resultObj, interp->result);
11966 break;
11967 case JIM_CONTINUE:
11968 break;
11969 case JIM_BREAK:
11970 goto out;
11971 default:
11972 goto err;
11975 out:
11976 result = JIM_OK;
11977 Jim_SetResult(interp, resultObj);
11978 err:
11979 Jim_DecrRefCount(interp, resultObj);
11980 if (numargs > 2) {
11981 Jim_Free(iters);
11983 return result;
11986 /* [foreach] */
11987 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11989 return JimForeachMapHelper(interp, argc, argv, 0);
11992 /* [lmap] */
11993 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11995 return JimForeachMapHelper(interp, argc, argv, 1);
11998 /* [lassign] */
11999 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12001 int result = JIM_ERR;
12002 int i;
12003 Jim_ListIter iter;
12004 Jim_Obj *resultObj;
12006 if (argc < 2) {
12007 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12008 return JIM_ERR;
12011 JimListIterInit(&iter, argv[1]);
12013 for (i = 2; i < argc; i++) {
12014 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12015 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12016 if (result != JIM_OK) {
12017 return result;
12021 resultObj = Jim_NewListObj(interp, NULL, 0);
12022 while (!JimListIterDone(interp, &iter)) {
12023 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12026 Jim_SetResult(interp, resultObj);
12028 return JIM_OK;
12031 /* [if] */
12032 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12034 int boolean, retval, current = 1, falsebody = 0;
12036 if (argc >= 3) {
12037 while (1) {
12038 /* Far not enough arguments given! */
12039 if (current >= argc)
12040 goto err;
12041 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12042 != JIM_OK)
12043 return retval;
12044 /* There lacks something, isn't it? */
12045 if (current >= argc)
12046 goto err;
12047 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12048 current++;
12049 /* Tsk tsk, no then-clause? */
12050 if (current >= argc)
12051 goto err;
12052 if (boolean)
12053 return Jim_EvalObj(interp, argv[current]);
12054 /* Ok: no else-clause follows */
12055 if (++current >= argc) {
12056 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12057 return JIM_OK;
12059 falsebody = current++;
12060 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12061 /* IIICKS - else-clause isn't last cmd? */
12062 if (current != argc - 1)
12063 goto err;
12064 return Jim_EvalObj(interp, argv[current]);
12066 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12067 /* Ok: elseif follows meaning all the stuff
12068 * again (how boring...) */
12069 continue;
12070 /* OOPS - else-clause is not last cmd? */
12071 else if (falsebody != argc - 1)
12072 goto err;
12073 return Jim_EvalObj(interp, argv[falsebody]);
12075 return JIM_OK;
12077 err:
12078 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12079 return JIM_ERR;
12083 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12084 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12085 Jim_Obj *stringObj, int nocase)
12087 Jim_Obj *parms[4];
12088 int argc = 0;
12089 long eq;
12090 int rc;
12092 parms[argc++] = commandObj;
12093 if (nocase) {
12094 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12096 parms[argc++] = patternObj;
12097 parms[argc++] = stringObj;
12099 rc = Jim_EvalObjVector(interp, argc, parms);
12101 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12102 eq = -rc;
12105 return eq;
12108 enum
12109 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12111 /* [switch] */
12112 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12114 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12115 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12116 Jim_Obj *script = 0;
12118 if (argc < 3) {
12119 wrongnumargs:
12120 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12121 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12122 return JIM_ERR;
12124 for (opt = 1; opt < argc; ++opt) {
12125 const char *option = Jim_String(argv[opt]);
12127 if (*option != '-')
12128 break;
12129 else if (strncmp(option, "--", 2) == 0) {
12130 ++opt;
12131 break;
12133 else if (strncmp(option, "-exact", 2) == 0)
12134 matchOpt = SWITCH_EXACT;
12135 else if (strncmp(option, "-glob", 2) == 0)
12136 matchOpt = SWITCH_GLOB;
12137 else if (strncmp(option, "-regexp", 2) == 0)
12138 matchOpt = SWITCH_RE;
12139 else if (strncmp(option, "-command", 2) == 0) {
12140 matchOpt = SWITCH_CMD;
12141 if ((argc - opt) < 2)
12142 goto wrongnumargs;
12143 command = argv[++opt];
12145 else {
12146 Jim_SetResultFormatted(interp,
12147 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12148 argv[opt]);
12149 return JIM_ERR;
12151 if ((argc - opt) < 2)
12152 goto wrongnumargs;
12154 strObj = argv[opt++];
12155 patCount = argc - opt;
12156 if (patCount == 1) {
12157 Jim_Obj **vector;
12159 JimListGetElements(interp, argv[opt], &patCount, &vector);
12160 caseList = vector;
12162 else
12163 caseList = &argv[opt];
12164 if (patCount == 0 || patCount % 2 != 0)
12165 goto wrongnumargs;
12166 for (i = 0; script == 0 && i < patCount; i += 2) {
12167 Jim_Obj *patObj = caseList[i];
12169 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12170 || i < (patCount - 2)) {
12171 switch (matchOpt) {
12172 case SWITCH_EXACT:
12173 if (Jim_StringEqObj(strObj, patObj))
12174 script = caseList[i + 1];
12175 break;
12176 case SWITCH_GLOB:
12177 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12178 script = caseList[i + 1];
12179 break;
12180 case SWITCH_RE:
12181 command = Jim_NewStringObj(interp, "regexp", -1);
12182 /* Fall thru intentionally */
12183 case SWITCH_CMD:{
12184 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12186 /* After the execution of a command we need to
12187 * make sure to reconvert the object into a list
12188 * again. Only for the single-list style [switch]. */
12189 if (argc - opt == 1) {
12190 Jim_Obj **vector;
12192 JimListGetElements(interp, argv[opt], &patCount, &vector);
12193 caseList = vector;
12195 /* command is here already decref'd */
12196 if (rc < 0) {
12197 return -rc;
12199 if (rc)
12200 script = caseList[i + 1];
12201 break;
12205 else {
12206 script = caseList[i + 1];
12209 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12210 script = caseList[i + 1];
12211 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12212 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12213 return JIM_ERR;
12215 Jim_SetEmptyResult(interp);
12216 if (script) {
12217 return Jim_EvalObj(interp, script);
12219 return JIM_OK;
12222 /* [list] */
12223 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12225 Jim_Obj *listObjPtr;
12227 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12228 Jim_SetResult(interp, listObjPtr);
12229 return JIM_OK;
12232 /* [lindex] */
12233 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12235 Jim_Obj *objPtr, *listObjPtr;
12236 int i;
12237 int idx;
12239 if (argc < 2) {
12240 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12241 return JIM_ERR;
12243 objPtr = argv[1];
12244 Jim_IncrRefCount(objPtr);
12245 for (i = 2; i < argc; i++) {
12246 listObjPtr = objPtr;
12247 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12248 Jim_DecrRefCount(interp, listObjPtr);
12249 return JIM_ERR;
12251 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12252 /* Returns an empty object if the index
12253 * is out of range. */
12254 Jim_DecrRefCount(interp, listObjPtr);
12255 Jim_SetEmptyResult(interp);
12256 return JIM_OK;
12258 Jim_IncrRefCount(objPtr);
12259 Jim_DecrRefCount(interp, listObjPtr);
12261 Jim_SetResult(interp, objPtr);
12262 Jim_DecrRefCount(interp, objPtr);
12263 return JIM_OK;
12266 /* [llength] */
12267 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12269 if (argc != 2) {
12270 Jim_WrongNumArgs(interp, 1, argv, "list");
12271 return JIM_ERR;
12273 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12274 return JIM_OK;
12277 /* [lsearch] */
12278 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12280 static const char * const options[] = {
12281 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12282 NULL
12284 enum
12285 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12286 OPT_COMMAND };
12287 int i;
12288 int opt_bool = 0;
12289 int opt_not = 0;
12290 int opt_nocase = 0;
12291 int opt_all = 0;
12292 int opt_inline = 0;
12293 int opt_match = OPT_EXACT;
12294 int listlen;
12295 int rc = JIM_OK;
12296 Jim_Obj *listObjPtr = NULL;
12297 Jim_Obj *commandObj = NULL;
12299 if (argc < 3) {
12300 wrongargs:
12301 Jim_WrongNumArgs(interp, 1, argv,
12302 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12303 return JIM_ERR;
12306 for (i = 1; i < argc - 2; i++) {
12307 int option;
12309 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12310 return JIM_ERR;
12312 switch (option) {
12313 case OPT_BOOL:
12314 opt_bool = 1;
12315 opt_inline = 0;
12316 break;
12317 case OPT_NOT:
12318 opt_not = 1;
12319 break;
12320 case OPT_NOCASE:
12321 opt_nocase = 1;
12322 break;
12323 case OPT_INLINE:
12324 opt_inline = 1;
12325 opt_bool = 0;
12326 break;
12327 case OPT_ALL:
12328 opt_all = 1;
12329 break;
12330 case OPT_COMMAND:
12331 if (i >= argc - 2) {
12332 goto wrongargs;
12334 commandObj = argv[++i];
12335 /* fallthru */
12336 case OPT_EXACT:
12337 case OPT_GLOB:
12338 case OPT_REGEXP:
12339 opt_match = option;
12340 break;
12344 argv += i;
12346 if (opt_all) {
12347 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12349 if (opt_match == OPT_REGEXP) {
12350 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12352 if (commandObj) {
12353 Jim_IncrRefCount(commandObj);
12356 listlen = Jim_ListLength(interp, argv[0]);
12357 for (i = 0; i < listlen; i++) {
12358 int eq = 0;
12359 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12361 switch (opt_match) {
12362 case OPT_EXACT:
12363 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12364 break;
12366 case OPT_GLOB:
12367 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12368 break;
12370 case OPT_REGEXP:
12371 case OPT_COMMAND:
12372 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12373 if (eq < 0) {
12374 if (listObjPtr) {
12375 Jim_FreeNewObj(interp, listObjPtr);
12377 rc = JIM_ERR;
12378 goto done;
12380 break;
12383 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12384 if (!eq && opt_bool && opt_not && !opt_all) {
12385 continue;
12388 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12389 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12390 Jim_Obj *resultObj;
12392 if (opt_bool) {
12393 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12395 else if (!opt_inline) {
12396 resultObj = Jim_NewIntObj(interp, i);
12398 else {
12399 resultObj = objPtr;
12402 if (opt_all) {
12403 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12405 else {
12406 Jim_SetResult(interp, resultObj);
12407 goto done;
12412 if (opt_all) {
12413 Jim_SetResult(interp, listObjPtr);
12415 else {
12416 /* No match */
12417 if (opt_bool) {
12418 Jim_SetResultBool(interp, opt_not);
12420 else if (!opt_inline) {
12421 Jim_SetResultInt(interp, -1);
12425 done:
12426 if (commandObj) {
12427 Jim_DecrRefCount(interp, commandObj);
12429 return rc;
12432 /* [lappend] */
12433 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12435 Jim_Obj *listObjPtr;
12436 int shared, i;
12438 if (argc < 2) {
12439 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12440 return JIM_ERR;
12442 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12443 if (!listObjPtr) {
12444 /* Create the list if it does not exists */
12445 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12446 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12447 Jim_FreeNewObj(interp, listObjPtr);
12448 return JIM_ERR;
12451 shared = Jim_IsShared(listObjPtr);
12452 if (shared)
12453 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12454 for (i = 2; i < argc; i++)
12455 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12456 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12457 if (shared)
12458 Jim_FreeNewObj(interp, listObjPtr);
12459 return JIM_ERR;
12461 Jim_SetResult(interp, listObjPtr);
12462 return JIM_OK;
12465 /* [linsert] */
12466 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12468 int idx, len;
12469 Jim_Obj *listPtr;
12471 if (argc < 3) {
12472 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12473 return JIM_ERR;
12475 listPtr = argv[1];
12476 if (Jim_IsShared(listPtr))
12477 listPtr = Jim_DuplicateObj(interp, listPtr);
12478 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12479 goto err;
12480 len = Jim_ListLength(interp, listPtr);
12481 if (idx >= len)
12482 idx = len;
12483 else if (idx < 0)
12484 idx = len + idx + 1;
12485 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12486 Jim_SetResult(interp, listPtr);
12487 return JIM_OK;
12488 err:
12489 if (listPtr != argv[1]) {
12490 Jim_FreeNewObj(interp, listPtr);
12492 return JIM_ERR;
12495 /* [lreplace] */
12496 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12498 int first, last, len, rangeLen;
12499 Jim_Obj *listObj;
12500 Jim_Obj *newListObj;
12502 if (argc < 4) {
12503 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12504 return JIM_ERR;
12506 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12507 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12508 return JIM_ERR;
12511 listObj = argv[1];
12512 len = Jim_ListLength(interp, listObj);
12514 first = JimRelToAbsIndex(len, first);
12515 last = JimRelToAbsIndex(len, last);
12516 JimRelToAbsRange(len, &first, &last, &rangeLen);
12518 /* Now construct a new list which consists of:
12519 * <elements before first> <supplied elements> <elements after last>
12522 /* Check to see if trying to replace past the end of the list */
12523 if (first < len) {
12524 /* OK. Not past the end */
12526 else if (len == 0) {
12527 /* Special for empty list, adjust first to 0 */
12528 first = 0;
12530 else {
12531 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12532 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12533 return JIM_ERR;
12536 /* Add the first set of elements */
12537 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12539 /* Add supplied elements */
12540 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12542 /* Add the remaining elements */
12543 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12545 Jim_SetResult(interp, newListObj);
12546 return JIM_OK;
12549 /* [lset] */
12550 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12552 if (argc < 3) {
12553 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12554 return JIM_ERR;
12556 else if (argc == 3) {
12557 /* With no indexes, simply implements [set] */
12558 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12559 return JIM_ERR;
12560 Jim_SetResult(interp, argv[2]);
12561 return JIM_OK;
12563 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12566 /* [lsort] */
12567 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12569 static const char * const options[] = {
12570 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12572 enum
12573 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12574 Jim_Obj *resObj;
12575 int i;
12576 int retCode;
12578 struct lsort_info info;
12580 if (argc < 2) {
12581 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12582 return JIM_ERR;
12585 info.type = JIM_LSORT_ASCII;
12586 info.order = 1;
12587 info.indexed = 0;
12588 info.unique = 0;
12589 info.command = NULL;
12590 info.interp = interp;
12592 for (i = 1; i < (argc - 1); i++) {
12593 int option;
12595 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12596 != JIM_OK)
12597 return JIM_ERR;
12598 switch (option) {
12599 case OPT_ASCII:
12600 info.type = JIM_LSORT_ASCII;
12601 break;
12602 case OPT_NOCASE:
12603 info.type = JIM_LSORT_NOCASE;
12604 break;
12605 case OPT_INTEGER:
12606 info.type = JIM_LSORT_INTEGER;
12607 break;
12608 case OPT_REAL:
12609 info.type = JIM_LSORT_REAL;
12610 break;
12611 case OPT_INCREASING:
12612 info.order = 1;
12613 break;
12614 case OPT_DECREASING:
12615 info.order = -1;
12616 break;
12617 case OPT_UNIQUE:
12618 info.unique = 1;
12619 break;
12620 case OPT_COMMAND:
12621 if (i >= (argc - 2)) {
12622 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12623 return JIM_ERR;
12625 info.type = JIM_LSORT_COMMAND;
12626 info.command = argv[i + 1];
12627 i++;
12628 break;
12629 case OPT_INDEX:
12630 if (i >= (argc - 2)) {
12631 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12632 return JIM_ERR;
12634 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12635 return JIM_ERR;
12637 info.indexed = 1;
12638 i++;
12639 break;
12642 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12643 retCode = ListSortElements(interp, resObj, &info);
12644 if (retCode == JIM_OK) {
12645 Jim_SetResult(interp, resObj);
12647 else {
12648 Jim_FreeNewObj(interp, resObj);
12650 return retCode;
12653 /* [append] */
12654 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12656 Jim_Obj *stringObjPtr;
12657 int i;
12659 if (argc < 2) {
12660 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12661 return JIM_ERR;
12663 if (argc == 2) {
12664 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12665 if (!stringObjPtr)
12666 return JIM_ERR;
12668 else {
12669 int freeobj = 0;
12670 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12671 if (!stringObjPtr) {
12672 /* Create the string if it doesn't exist */
12673 stringObjPtr = Jim_NewEmptyStringObj(interp);
12674 freeobj = 1;
12676 else if (Jim_IsShared(stringObjPtr)) {
12677 freeobj = 1;
12678 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12680 for (i = 2; i < argc; i++) {
12681 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12683 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12684 if (freeobj) {
12685 Jim_FreeNewObj(interp, stringObjPtr);
12687 return JIM_ERR;
12690 Jim_SetResult(interp, stringObjPtr);
12691 return JIM_OK;
12694 /* [debug] */
12695 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12697 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12698 static const char * const options[] = {
12699 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12700 "exprbc", "show",
12701 NULL
12703 enum
12705 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12706 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12708 int option;
12710 if (argc < 2) {
12711 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12712 return JIM_ERR;
12714 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12715 return JIM_ERR;
12716 if (option == OPT_REFCOUNT) {
12717 if (argc != 3) {
12718 Jim_WrongNumArgs(interp, 2, argv, "object");
12719 return JIM_ERR;
12721 Jim_SetResultInt(interp, argv[2]->refCount);
12722 return JIM_OK;
12724 else if (option == OPT_OBJCOUNT) {
12725 int freeobj = 0, liveobj = 0;
12726 char buf[256];
12727 Jim_Obj *objPtr;
12729 if (argc != 2) {
12730 Jim_WrongNumArgs(interp, 2, argv, "");
12731 return JIM_ERR;
12733 /* Count the number of free objects. */
12734 objPtr = interp->freeList;
12735 while (objPtr) {
12736 freeobj++;
12737 objPtr = objPtr->nextObjPtr;
12739 /* Count the number of live objects. */
12740 objPtr = interp->liveList;
12741 while (objPtr) {
12742 liveobj++;
12743 objPtr = objPtr->nextObjPtr;
12745 /* Set the result string and return. */
12746 sprintf(buf, "free %d used %d", freeobj, liveobj);
12747 Jim_SetResultString(interp, buf, -1);
12748 return JIM_OK;
12750 else if (option == OPT_OBJECTS) {
12751 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12753 /* Count the number of live objects. */
12754 objPtr = interp->liveList;
12755 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12756 while (objPtr) {
12757 char buf[128];
12758 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12760 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12761 sprintf(buf, "%p", objPtr);
12762 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12763 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12764 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12765 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12766 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12767 objPtr = objPtr->nextObjPtr;
12769 Jim_SetResult(interp, listObjPtr);
12770 return JIM_OK;
12772 else if (option == OPT_INVSTR) {
12773 Jim_Obj *objPtr;
12775 if (argc != 3) {
12776 Jim_WrongNumArgs(interp, 2, argv, "object");
12777 return JIM_ERR;
12779 objPtr = argv[2];
12780 if (objPtr->typePtr != NULL)
12781 Jim_InvalidateStringRep(objPtr);
12782 Jim_SetEmptyResult(interp);
12783 return JIM_OK;
12785 else if (option == OPT_SHOW) {
12786 const char *s;
12787 int len, charlen;
12789 if (argc != 3) {
12790 Jim_WrongNumArgs(interp, 2, argv, "object");
12791 return JIM_ERR;
12793 s = Jim_GetString(argv[2], &len);
12794 #ifdef JIM_UTF8
12795 charlen = utf8_strlen(s, len);
12796 #else
12797 charlen = len;
12798 #endif
12799 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12800 printf("chars (%d): <<%s>>\n", charlen, s);
12801 printf("bytes (%d):", len);
12802 while (len--) {
12803 printf(" %02x", (unsigned char)*s++);
12805 printf("\n");
12806 return JIM_OK;
12808 else if (option == OPT_SCRIPTLEN) {
12809 ScriptObj *script;
12811 if (argc != 3) {
12812 Jim_WrongNumArgs(interp, 2, argv, "script");
12813 return JIM_ERR;
12815 script = Jim_GetScript(interp, argv[2]);
12816 if (script == NULL)
12817 return JIM_ERR;
12818 Jim_SetResultInt(interp, script->len);
12819 return JIM_OK;
12821 else if (option == OPT_EXPRLEN) {
12822 ExprByteCode *expr;
12824 if (argc != 3) {
12825 Jim_WrongNumArgs(interp, 2, argv, "expression");
12826 return JIM_ERR;
12828 expr = JimGetExpression(interp, argv[2]);
12829 if (expr == NULL)
12830 return JIM_ERR;
12831 Jim_SetResultInt(interp, expr->len);
12832 return JIM_OK;
12834 else if (option == OPT_EXPRBC) {
12835 Jim_Obj *objPtr;
12836 ExprByteCode *expr;
12837 int i;
12839 if (argc != 3) {
12840 Jim_WrongNumArgs(interp, 2, argv, "expression");
12841 return JIM_ERR;
12843 expr = JimGetExpression(interp, argv[2]);
12844 if (expr == NULL)
12845 return JIM_ERR;
12846 objPtr = Jim_NewListObj(interp, NULL, 0);
12847 for (i = 0; i < expr->len; i++) {
12848 const char *type;
12849 const Jim_ExprOperator *op;
12850 Jim_Obj *obj = expr->token[i].objPtr;
12852 switch (expr->token[i].type) {
12853 case JIM_TT_EXPR_INT:
12854 type = "int";
12855 break;
12856 case JIM_TT_EXPR_DOUBLE:
12857 type = "double";
12858 break;
12859 case JIM_TT_CMD:
12860 type = "command";
12861 break;
12862 case JIM_TT_VAR:
12863 type = "variable";
12864 break;
12865 case JIM_TT_DICTSUGAR:
12866 type = "dictsugar";
12867 break;
12868 case JIM_TT_EXPRSUGAR:
12869 type = "exprsugar";
12870 break;
12871 case JIM_TT_ESC:
12872 type = "subst";
12873 break;
12874 case JIM_TT_STR:
12875 type = "string";
12876 break;
12877 default:
12878 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12879 if (op == NULL) {
12880 type = "private";
12882 else {
12883 type = "operator";
12885 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12886 break;
12888 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12889 Jim_ListAppendElement(interp, objPtr, obj);
12891 Jim_SetResult(interp, objPtr);
12892 return JIM_OK;
12894 else {
12895 Jim_SetResultString(interp,
12896 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12897 return JIM_ERR;
12899 /* unreached */
12900 #endif /* JIM_BOOTSTRAP */
12901 #if !defined(JIM_DEBUG_COMMAND)
12902 Jim_SetResultString(interp, "unsupported", -1);
12903 return JIM_ERR;
12904 #endif
12907 /* [eval] */
12908 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12910 int rc;
12912 if (argc < 2) {
12913 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12914 return JIM_ERR;
12917 if (argc == 2) {
12918 rc = Jim_EvalObj(interp, argv[1]);
12920 else {
12921 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12924 if (rc == JIM_ERR) {
12925 /* eval is "interesting", so add a stack frame here */
12926 interp->addStackTrace++;
12928 return rc;
12931 /* [uplevel] */
12932 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12934 if (argc >= 2) {
12935 int retcode;
12936 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12937 int savedTailcall;
12938 const char *str;
12940 /* Save the old callframe pointer */
12941 savedCallFrame = interp->framePtr;
12943 /* Lookup the target frame pointer */
12944 str = Jim_String(argv[1]);
12945 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12946 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12947 argc--;
12948 argv++;
12950 else {
12951 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12953 if (targetCallFrame == NULL) {
12954 return JIM_ERR;
12956 if (argc < 2) {
12957 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12958 return JIM_ERR;
12960 /* Eval the code in the target callframe. */
12961 interp->framePtr = targetCallFrame;
12962 /* Can't merge tailcalls across upcall */
12963 savedTailcall = interp->framePtr->tailcall;
12964 interp->framePtr->tailcall = 0;
12965 if (argc == 2) {
12966 retcode = Jim_EvalObj(interp, argv[1]);
12968 else {
12969 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12971 interp->framePtr->tailcall = savedTailcall;
12972 interp->framePtr = savedCallFrame;
12973 return retcode;
12975 else {
12976 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12977 return JIM_ERR;
12981 /* [expr] */
12982 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12984 Jim_Obj *exprResultPtr;
12985 int retcode;
12987 if (argc == 2) {
12988 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12990 else if (argc > 2) {
12991 Jim_Obj *objPtr;
12993 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12994 Jim_IncrRefCount(objPtr);
12995 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12996 Jim_DecrRefCount(interp, objPtr);
12998 else {
12999 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13000 return JIM_ERR;
13002 if (retcode != JIM_OK)
13003 return retcode;
13004 Jim_SetResult(interp, exprResultPtr);
13005 Jim_DecrRefCount(interp, exprResultPtr);
13006 return JIM_OK;
13009 /* [break] */
13010 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13012 if (argc != 1) {
13013 Jim_WrongNumArgs(interp, 1, argv, "");
13014 return JIM_ERR;
13016 return JIM_BREAK;
13019 /* [continue] */
13020 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13022 if (argc != 1) {
13023 Jim_WrongNumArgs(interp, 1, argv, "");
13024 return JIM_ERR;
13026 return JIM_CONTINUE;
13029 /* [return] */
13030 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13032 int i;
13033 Jim_Obj *stackTraceObj = NULL;
13034 Jim_Obj *errorCodeObj = NULL;
13035 int returnCode = JIM_OK;
13036 long level = 1;
13038 for (i = 1; i < argc - 1; i += 2) {
13039 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13040 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13041 return JIM_ERR;
13044 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13045 stackTraceObj = argv[i + 1];
13047 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13048 errorCodeObj = argv[i + 1];
13050 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13051 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13052 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13053 return JIM_ERR;
13056 else {
13057 break;
13061 if (i != argc - 1 && i != argc) {
13062 Jim_WrongNumArgs(interp, 1, argv,
13063 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13066 /* If a stack trace is supplied and code is error, set the stack trace */
13067 if (stackTraceObj && returnCode == JIM_ERR) {
13068 JimSetStackTrace(interp, stackTraceObj);
13070 /* If an error code list is supplied, set the global $errorCode */
13071 if (errorCodeObj && returnCode == JIM_ERR) {
13072 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13074 interp->returnCode = returnCode;
13075 interp->returnLevel = level;
13077 if (i == argc - 1) {
13078 Jim_SetResult(interp, argv[i]);
13080 return JIM_RETURN;
13083 /* [tailcall] */
13084 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13086 if (interp->framePtr->level == 0) {
13087 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13088 return JIM_ERR;
13090 else if (argc >= 2) {
13091 /* Need to resolve the tailcall command in the current context */
13092 Jim_CallFrame *cf = interp->framePtr->parent;
13094 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13095 if (cmdPtr == NULL) {
13096 return JIM_ERR;
13099 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13101 /* And stash this pre-resolved command */
13102 JimIncrCmdRefCount(cmdPtr);
13103 cf->tailcallCmd = cmdPtr;
13105 /* And stash the command list */
13106 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13108 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13109 Jim_IncrRefCount(cf->tailcallObj);
13111 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13112 return JIM_EVAL;
13114 return JIM_OK;
13117 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13119 Jim_Obj *cmdList;
13120 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13122 /* prefixListObj is a list to which the args need to be appended */
13123 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13124 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13126 return JimEvalObjList(interp, cmdList);
13129 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13131 Jim_Obj *prefixListObj = privData;
13132 Jim_DecrRefCount(interp, prefixListObj);
13135 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13137 Jim_Obj *prefixListObj;
13138 const char *newname;
13140 if (argc < 3) {
13141 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13142 return JIM_ERR;
13145 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13146 Jim_IncrRefCount(prefixListObj);
13147 newname = Jim_String(argv[1]);
13148 if (newname[0] == ':' && newname[1] == ':') {
13149 while (*++newname == ':') {
13153 Jim_SetResult(interp, argv[1]);
13155 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13158 /* [proc] */
13159 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13161 Jim_Cmd *cmd;
13163 if (argc != 4 && argc != 5) {
13164 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13165 return JIM_ERR;
13168 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13169 return JIM_ERR;
13172 if (argc == 4) {
13173 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13175 else {
13176 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13179 if (cmd) {
13180 /* Add the new command */
13181 Jim_Obj *qualifiedCmdNameObj;
13182 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13184 JimCreateCommand(interp, cmdname, cmd);
13186 /* Calculate and set the namespace for this proc */
13187 JimUpdateProcNamespace(interp, cmd, cmdname);
13189 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13191 /* Unlike Tcl, set the name of the proc as the result */
13192 Jim_SetResult(interp, argv[1]);
13193 return JIM_OK;
13195 return JIM_ERR;
13198 /* [local] */
13199 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13201 int retcode;
13203 if (argc < 2) {
13204 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13205 return JIM_ERR;
13208 /* Evaluate the arguments with 'local' in force */
13209 interp->local++;
13210 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13211 interp->local--;
13214 /* If OK, and the result is a proc, add it to the list of local procs */
13215 if (retcode == 0) {
13216 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13218 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13219 return JIM_ERR;
13221 if (interp->framePtr->localCommands == NULL) {
13222 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13223 Jim_InitStack(interp->framePtr->localCommands);
13225 Jim_IncrRefCount(cmdNameObj);
13226 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13229 return retcode;
13232 /* [upcall] */
13233 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13235 if (argc < 2) {
13236 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13237 return JIM_ERR;
13239 else {
13240 int retcode;
13242 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13243 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13244 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13245 return JIM_ERR;
13247 /* OK. Mark this command as being in an upcall */
13248 cmdPtr->u.proc.upcall++;
13249 JimIncrCmdRefCount(cmdPtr);
13251 /* Invoke the command as normal */
13252 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13254 /* No longer in an upcall */
13255 cmdPtr->u.proc.upcall--;
13256 JimDecrCmdRefCount(interp, cmdPtr);
13258 return retcode;
13262 /* [apply] */
13263 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13265 if (argc < 2) {
13266 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13267 return JIM_ERR;
13269 else {
13270 int ret;
13271 Jim_Cmd *cmd;
13272 Jim_Obj *argListObjPtr;
13273 Jim_Obj *bodyObjPtr;
13274 Jim_Obj *nsObj = NULL;
13275 Jim_Obj **nargv;
13277 int len = Jim_ListLength(interp, argv[1]);
13278 if (len != 2 && len != 3) {
13279 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13280 return JIM_ERR;
13283 if (len == 3) {
13284 #ifdef jim_ext_namespace
13285 /* Need to canonicalise the given namespace. */
13286 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13287 #else
13288 Jim_SetResultString(interp, "namespaces not enabled", -1);
13289 return JIM_ERR;
13290 #endif
13292 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13293 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13295 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13297 if (cmd) {
13298 /* Create a new argv array with a dummy argv[0], for error messages */
13299 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13300 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13301 Jim_IncrRefCount(nargv[0]);
13302 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13303 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13304 Jim_DecrRefCount(interp, nargv[0]);
13305 Jim_Free(nargv);
13307 JimDecrCmdRefCount(interp, cmd);
13308 return ret;
13310 return JIM_ERR;
13315 /* [concat] */
13316 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13318 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13319 return JIM_OK;
13322 /* [upvar] */
13323 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13325 int i;
13326 Jim_CallFrame *targetCallFrame;
13328 /* Lookup the target frame pointer */
13329 if (argc > 3 && (argc % 2 == 0)) {
13330 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13331 argc--;
13332 argv++;
13334 else {
13335 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13337 if (targetCallFrame == NULL) {
13338 return JIM_ERR;
13341 /* Check for arity */
13342 if (argc < 3) {
13343 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13344 return JIM_ERR;
13347 /* Now... for every other/local couple: */
13348 for (i = 1; i < argc; i += 2) {
13349 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13350 return JIM_ERR;
13352 return JIM_OK;
13355 /* [global] */
13356 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13358 int i;
13360 if (argc < 2) {
13361 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13362 return JIM_ERR;
13364 /* Link every var to the toplevel having the same name */
13365 if (interp->framePtr->level == 0)
13366 return JIM_OK; /* global at toplevel... */
13367 for (i = 1; i < argc; i++) {
13368 /* global ::blah does nothing */
13369 const char *name = Jim_String(argv[i]);
13370 if (name[0] != ':' || name[1] != ':') {
13371 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13372 return JIM_ERR;
13375 return JIM_OK;
13378 /* does the [string map] operation. On error NULL is returned,
13379 * otherwise a new string object with the result, having refcount = 0,
13380 * is returned. */
13381 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13382 Jim_Obj *objPtr, int nocase)
13384 int numMaps;
13385 const char *str, *noMatchStart = NULL;
13386 int strLen, i;
13387 Jim_Obj *resultObjPtr;
13389 numMaps = Jim_ListLength(interp, mapListObjPtr);
13390 if (numMaps % 2) {
13391 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13392 return NULL;
13395 str = Jim_String(objPtr);
13396 strLen = Jim_Utf8Length(interp, objPtr);
13398 /* Map it */
13399 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13400 while (strLen) {
13401 for (i = 0; i < numMaps; i += 2) {
13402 Jim_Obj *objPtr;
13403 const char *k;
13404 int kl;
13406 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13407 k = Jim_String(objPtr);
13408 kl = Jim_Utf8Length(interp, objPtr);
13410 if (strLen >= kl && kl) {
13411 int rc;
13412 rc = JimStringCompareLen(str, k, kl, nocase);
13413 if (rc == 0) {
13414 if (noMatchStart) {
13415 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13416 noMatchStart = NULL;
13418 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13419 str += utf8_index(str, kl);
13420 strLen -= kl;
13421 break;
13425 if (i == numMaps) { /* no match */
13426 int c;
13427 if (noMatchStart == NULL)
13428 noMatchStart = str;
13429 str += utf8_tounicode(str, &c);
13430 strLen--;
13433 if (noMatchStart) {
13434 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13436 return resultObjPtr;
13439 /* [string] */
13440 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13442 int len;
13443 int opt_case = 1;
13444 int option;
13445 static const char * const options[] = {
13446 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13447 "map", "repeat", "reverse", "index", "first", "last", "cat",
13448 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13450 enum
13452 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13453 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13454 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13456 static const char * const nocase_options[] = {
13457 "-nocase", NULL
13459 static const char * const nocase_length_options[] = {
13460 "-nocase", "-length", NULL
13463 if (argc < 2) {
13464 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13465 return JIM_ERR;
13467 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13468 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13469 return JIM_ERR;
13471 switch (option) {
13472 case OPT_LENGTH:
13473 case OPT_BYTELENGTH:
13474 if (argc != 3) {
13475 Jim_WrongNumArgs(interp, 2, argv, "string");
13476 return JIM_ERR;
13478 if (option == OPT_LENGTH) {
13479 len = Jim_Utf8Length(interp, argv[2]);
13481 else {
13482 len = Jim_Length(argv[2]);
13484 Jim_SetResultInt(interp, len);
13485 return JIM_OK;
13487 case OPT_CAT:{
13488 Jim_Obj *objPtr;
13489 if (argc == 3) {
13490 /* optimise the one-arg case */
13491 objPtr = argv[2];
13493 else {
13494 int i;
13496 objPtr = Jim_NewStringObj(interp, "", 0);
13498 for (i = 2; i < argc; i++) {
13499 Jim_AppendObj(interp, objPtr, argv[i]);
13502 Jim_SetResult(interp, objPtr);
13503 return JIM_OK;
13506 case OPT_COMPARE:
13507 case OPT_EQUAL:
13509 /* n is the number of remaining option args */
13510 long opt_length = -1;
13511 int n = argc - 4;
13512 int i = 2;
13513 while (n > 0) {
13514 int subopt;
13515 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13516 JIM_ENUM_ABBREV) != JIM_OK) {
13517 badcompareargs:
13518 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13519 return JIM_ERR;
13521 if (subopt == 0) {
13522 /* -nocase */
13523 opt_case = 0;
13524 n--;
13526 else {
13527 /* -length */
13528 if (n < 2) {
13529 goto badcompareargs;
13531 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13532 return JIM_ERR;
13534 n -= 2;
13537 if (n) {
13538 goto badcompareargs;
13540 argv += argc - 2;
13541 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13542 /* Fast version - [string equal], case sensitive, no length */
13543 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13545 else {
13546 if (opt_length >= 0) {
13547 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13549 else {
13550 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13552 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13554 return JIM_OK;
13557 case OPT_MATCH:
13558 if (argc != 4 &&
13559 (argc != 5 ||
13560 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13561 JIM_ENUM_ABBREV) != JIM_OK)) {
13562 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13563 return JIM_ERR;
13565 if (opt_case == 0) {
13566 argv++;
13568 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13569 return JIM_OK;
13571 case OPT_MAP:{
13572 Jim_Obj *objPtr;
13574 if (argc != 4 &&
13575 (argc != 5 ||
13576 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13577 JIM_ENUM_ABBREV) != JIM_OK)) {
13578 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13579 return JIM_ERR;
13582 if (opt_case == 0) {
13583 argv++;
13585 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13586 if (objPtr == NULL) {
13587 return JIM_ERR;
13589 Jim_SetResult(interp, objPtr);
13590 return JIM_OK;
13593 case OPT_RANGE:
13594 case OPT_BYTERANGE:{
13595 Jim_Obj *objPtr;
13597 if (argc != 5) {
13598 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13599 return JIM_ERR;
13601 if (option == OPT_RANGE) {
13602 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13604 else
13606 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13609 if (objPtr == NULL) {
13610 return JIM_ERR;
13612 Jim_SetResult(interp, objPtr);
13613 return JIM_OK;
13616 case OPT_REPLACE:{
13617 Jim_Obj *objPtr;
13619 if (argc != 5 && argc != 6) {
13620 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13621 return JIM_ERR;
13623 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13624 if (objPtr == NULL) {
13625 return JIM_ERR;
13627 Jim_SetResult(interp, objPtr);
13628 return JIM_OK;
13632 case OPT_REPEAT:{
13633 Jim_Obj *objPtr;
13634 jim_wide count;
13636 if (argc != 4) {
13637 Jim_WrongNumArgs(interp, 2, argv, "string count");
13638 return JIM_ERR;
13640 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13641 return JIM_ERR;
13643 objPtr = Jim_NewStringObj(interp, "", 0);
13644 if (count > 0) {
13645 while (count--) {
13646 Jim_AppendObj(interp, objPtr, argv[2]);
13649 Jim_SetResult(interp, objPtr);
13650 return JIM_OK;
13653 case OPT_REVERSE:{
13654 char *buf, *p;
13655 const char *str;
13656 int len;
13657 int i;
13659 if (argc != 3) {
13660 Jim_WrongNumArgs(interp, 2, argv, "string");
13661 return JIM_ERR;
13664 str = Jim_GetString(argv[2], &len);
13665 buf = Jim_Alloc(len + 1);
13666 p = buf + len;
13667 *p = 0;
13668 for (i = 0; i < len; ) {
13669 int c;
13670 int l = utf8_tounicode(str, &c);
13671 memcpy(p - l, str, l);
13672 p -= l;
13673 i += l;
13674 str += l;
13676 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13677 return JIM_OK;
13680 case OPT_INDEX:{
13681 int idx;
13682 const char *str;
13684 if (argc != 4) {
13685 Jim_WrongNumArgs(interp, 2, argv, "string index");
13686 return JIM_ERR;
13688 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13689 return JIM_ERR;
13691 str = Jim_String(argv[2]);
13692 len = Jim_Utf8Length(interp, argv[2]);
13693 if (idx != INT_MIN && idx != INT_MAX) {
13694 idx = JimRelToAbsIndex(len, idx);
13696 if (idx < 0 || idx >= len || str == NULL) {
13697 Jim_SetResultString(interp, "", 0);
13699 else if (len == Jim_Length(argv[2])) {
13700 /* ASCII optimisation */
13701 Jim_SetResultString(interp, str + idx, 1);
13703 else {
13704 int c;
13705 int i = utf8_index(str, idx);
13706 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13708 return JIM_OK;
13711 case OPT_FIRST:
13712 case OPT_LAST:{
13713 int idx = 0, l1, l2;
13714 const char *s1, *s2;
13716 if (argc != 4 && argc != 5) {
13717 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13718 return JIM_ERR;
13720 s1 = Jim_String(argv[2]);
13721 s2 = Jim_String(argv[3]);
13722 l1 = Jim_Utf8Length(interp, argv[2]);
13723 l2 = Jim_Utf8Length(interp, argv[3]);
13724 if (argc == 5) {
13725 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13726 return JIM_ERR;
13728 idx = JimRelToAbsIndex(l2, idx);
13730 else if (option == OPT_LAST) {
13731 idx = l2;
13733 if (option == OPT_FIRST) {
13734 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13736 else {
13737 #ifdef JIM_UTF8
13738 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13739 #else
13740 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13741 #endif
13743 return JIM_OK;
13746 case OPT_TRIM:
13747 case OPT_TRIMLEFT:
13748 case OPT_TRIMRIGHT:{
13749 Jim_Obj *trimchars;
13751 if (argc != 3 && argc != 4) {
13752 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13753 return JIM_ERR;
13755 trimchars = (argc == 4 ? argv[3] : NULL);
13756 if (option == OPT_TRIM) {
13757 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13759 else if (option == OPT_TRIMLEFT) {
13760 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13762 else if (option == OPT_TRIMRIGHT) {
13763 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13765 return JIM_OK;
13768 case OPT_TOLOWER:
13769 case OPT_TOUPPER:
13770 case OPT_TOTITLE:
13771 if (argc != 3) {
13772 Jim_WrongNumArgs(interp, 2, argv, "string");
13773 return JIM_ERR;
13775 if (option == OPT_TOLOWER) {
13776 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13778 else if (option == OPT_TOUPPER) {
13779 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13781 else {
13782 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13784 return JIM_OK;
13786 case OPT_IS:
13787 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13788 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13790 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13791 return JIM_ERR;
13793 return JIM_OK;
13796 /* [time] */
13797 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13799 long i, count = 1;
13800 jim_wide start, elapsed;
13801 char buf[60];
13802 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13804 if (argc < 2) {
13805 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13806 return JIM_ERR;
13808 if (argc == 3) {
13809 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13810 return JIM_ERR;
13812 if (count < 0)
13813 return JIM_OK;
13814 i = count;
13815 start = JimClock();
13816 while (i-- > 0) {
13817 int retval;
13819 retval = Jim_EvalObj(interp, argv[1]);
13820 if (retval != JIM_OK) {
13821 return retval;
13824 elapsed = JimClock() - start;
13825 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13826 Jim_SetResultString(interp, buf, -1);
13827 return JIM_OK;
13830 /* [exit] */
13831 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13833 long exitCode = 0;
13835 if (argc > 2) {
13836 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13837 return JIM_ERR;
13839 if (argc == 2) {
13840 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13841 return JIM_ERR;
13843 interp->exitCode = exitCode;
13844 return JIM_EXIT;
13847 /* [catch] */
13848 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13850 int exitCode = 0;
13851 int i;
13852 int sig = 0;
13854 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13855 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13856 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13858 /* Reset the error code before catch.
13859 * Note that this is not strictly correct.
13861 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13863 for (i = 1; i < argc - 1; i++) {
13864 const char *arg = Jim_String(argv[i]);
13865 jim_wide option;
13866 int ignore;
13868 /* It's a pity we can't use Jim_GetEnum here :-( */
13869 if (strcmp(arg, "--") == 0) {
13870 i++;
13871 break;
13873 if (*arg != '-') {
13874 break;
13877 if (strncmp(arg, "-no", 3) == 0) {
13878 arg += 3;
13879 ignore = 1;
13881 else {
13882 arg++;
13883 ignore = 0;
13886 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13887 option = -1;
13889 if (option < 0) {
13890 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13892 if (option < 0) {
13893 goto wrongargs;
13896 if (ignore) {
13897 ignore_mask |= (1 << option);
13899 else {
13900 ignore_mask &= ~(1 << option);
13904 argc -= i;
13905 if (argc < 1 || argc > 3) {
13906 wrongargs:
13907 Jim_WrongNumArgs(interp, 1, argv,
13908 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13909 return JIM_ERR;
13911 argv += i;
13913 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13914 sig++;
13917 interp->signal_level += sig;
13918 if (Jim_CheckSignal(interp)) {
13919 /* If a signal is set, don't even try to execute the body */
13920 exitCode = JIM_SIGNAL;
13922 else {
13923 exitCode = Jim_EvalObj(interp, argv[0]);
13924 /* Don't want any caught error included in a later stack trace */
13925 interp->errorFlag = 0;
13927 interp->signal_level -= sig;
13929 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13930 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13931 /* Not caught, pass it up */
13932 return exitCode;
13935 if (sig && exitCode == JIM_SIGNAL) {
13936 /* Catch the signal at this level */
13937 if (interp->signal_set_result) {
13938 interp->signal_set_result(interp, interp->sigmask);
13940 else {
13941 Jim_SetResultInt(interp, interp->sigmask);
13943 interp->sigmask = 0;
13946 if (argc >= 2) {
13947 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13948 return JIM_ERR;
13950 if (argc == 3) {
13951 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13953 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13954 Jim_ListAppendElement(interp, optListObj,
13955 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13956 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13957 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13958 if (exitCode == JIM_ERR) {
13959 Jim_Obj *errorCode;
13960 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13961 -1));
13962 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13964 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13965 if (errorCode) {
13966 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13967 Jim_ListAppendElement(interp, optListObj, errorCode);
13970 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13971 return JIM_ERR;
13975 Jim_SetResultInt(interp, exitCode);
13976 return JIM_OK;
13979 #ifdef JIM_REFERENCES
13981 /* [ref] */
13982 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13984 if (argc != 3 && argc != 4) {
13985 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13986 return JIM_ERR;
13988 if (argc == 3) {
13989 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13991 else {
13992 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13994 return JIM_OK;
13997 /* [getref] */
13998 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14000 Jim_Reference *refPtr;
14002 if (argc != 2) {
14003 Jim_WrongNumArgs(interp, 1, argv, "reference");
14004 return JIM_ERR;
14006 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14007 return JIM_ERR;
14008 Jim_SetResult(interp, refPtr->objPtr);
14009 return JIM_OK;
14012 /* [setref] */
14013 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14015 Jim_Reference *refPtr;
14017 if (argc != 3) {
14018 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14019 return JIM_ERR;
14021 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14022 return JIM_ERR;
14023 Jim_IncrRefCount(argv[2]);
14024 Jim_DecrRefCount(interp, refPtr->objPtr);
14025 refPtr->objPtr = argv[2];
14026 Jim_SetResult(interp, argv[2]);
14027 return JIM_OK;
14030 /* [collect] */
14031 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14033 if (argc != 1) {
14034 Jim_WrongNumArgs(interp, 1, argv, "");
14035 return JIM_ERR;
14037 Jim_SetResultInt(interp, Jim_Collect(interp));
14039 /* Free all the freed objects. */
14040 while (interp->freeList) {
14041 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14042 Jim_Free(interp->freeList);
14043 interp->freeList = nextObjPtr;
14046 return JIM_OK;
14049 /* [finalize] reference ?newValue? */
14050 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14052 if (argc != 2 && argc != 3) {
14053 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14054 return JIM_ERR;
14056 if (argc == 2) {
14057 Jim_Obj *cmdNamePtr;
14059 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14060 return JIM_ERR;
14061 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14062 Jim_SetResult(interp, cmdNamePtr);
14064 else {
14065 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14066 return JIM_ERR;
14067 Jim_SetResult(interp, argv[2]);
14069 return JIM_OK;
14072 /* [info references] */
14073 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14075 Jim_Obj *listObjPtr;
14076 Jim_HashTableIterator htiter;
14077 Jim_HashEntry *he;
14079 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14081 JimInitHashTableIterator(&interp->references, &htiter);
14082 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14083 char buf[JIM_REFERENCE_SPACE + 1];
14084 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14085 const unsigned long *refId = he->key;
14087 JimFormatReference(buf, refPtr, *refId);
14088 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14090 Jim_SetResult(interp, listObjPtr);
14091 return JIM_OK;
14093 #endif
14095 /* [rename] */
14096 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14098 if (argc != 3) {
14099 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14100 return JIM_ERR;
14103 if (JimValidName(interp, "new procedure", argv[2])) {
14104 return JIM_ERR;
14107 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14110 #define JIM_DICTMATCH_VALUES 0x0001
14112 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14114 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14116 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14117 if (type & JIM_DICTMATCH_VALUES) {
14118 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14123 * Like JimHashtablePatternMatch, but for dictionaries.
14125 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14126 JimDictMatchCallbackType *callback, int type)
14128 Jim_HashEntry *he;
14129 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14131 /* Check for the non-pattern case. We can do this much more efficiently. */
14132 Jim_HashTableIterator htiter;
14133 JimInitHashTableIterator(ht, &htiter);
14134 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14135 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14136 callback(interp, listObjPtr, he, type);
14140 return listObjPtr;
14144 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14146 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14147 return JIM_ERR;
14149 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14150 return JIM_OK;
14153 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14155 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14156 return JIM_ERR;
14158 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14159 return JIM_OK;
14162 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14164 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14165 return -1;
14167 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14170 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14172 Jim_HashTable *ht;
14173 unsigned int i;
14175 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14176 return JIM_ERR;
14179 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14181 /* Note that this uses internal knowledge of the hash table */
14182 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14184 for (i = 0; i < ht->size; i++) {
14185 Jim_HashEntry *he = ht->table[i];
14187 if (he) {
14188 printf("%d: ", i);
14190 while (he) {
14191 printf(" %s", Jim_String(he->key));
14192 he = he->next;
14194 printf("\n");
14197 return JIM_OK;
14200 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14202 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14204 Jim_AppendString(interp, prefixObj, " ", 1);
14205 Jim_AppendString(interp, prefixObj, subcmd, -1);
14207 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14210 /* [dict] */
14211 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14213 Jim_Obj *objPtr;
14214 int option;
14215 static const char * const options[] = {
14216 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14217 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14218 "replace", "update", NULL
14220 enum
14222 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14223 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14224 OPT_REPLACE, OPT_UPDATE,
14227 if (argc < 2) {
14228 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14229 return JIM_ERR;
14232 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14233 return JIM_ERR;
14236 switch (option) {
14237 case OPT_GET:
14238 if (argc < 3) {
14239 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14240 return JIM_ERR;
14242 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14243 JIM_ERRMSG) != JIM_OK) {
14244 return JIM_ERR;
14246 Jim_SetResult(interp, objPtr);
14247 return JIM_OK;
14249 case OPT_SET:
14250 if (argc < 5) {
14251 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14252 return JIM_ERR;
14254 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14256 case OPT_EXISTS:
14257 if (argc < 4) {
14258 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14259 return JIM_ERR;
14261 else {
14262 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14263 if (rc < 0) {
14264 return JIM_ERR;
14266 Jim_SetResultBool(interp, rc == JIM_OK);
14267 return JIM_OK;
14270 case OPT_UNSET:
14271 if (argc < 4) {
14272 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14273 return JIM_ERR;
14275 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14276 return JIM_ERR;
14278 return JIM_OK;
14280 case OPT_KEYS:
14281 if (argc != 3 && argc != 4) {
14282 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14283 return JIM_ERR;
14285 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14287 case OPT_SIZE:
14288 if (argc != 3) {
14289 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14290 return JIM_ERR;
14292 else if (Jim_DictSize(interp, argv[2]) < 0) {
14293 return JIM_ERR;
14295 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14296 return JIM_OK;
14298 case OPT_MERGE:
14299 if (argc == 2) {
14300 return JIM_OK;
14302 if (Jim_DictSize(interp, argv[2]) < 0) {
14303 return JIM_ERR;
14305 /* Handle as ensemble */
14306 break;
14308 case OPT_UPDATE:
14309 if (argc < 6 || argc % 2) {
14310 /* Better error message */
14311 argc = 2;
14313 break;
14315 case OPT_CREATE:
14316 if (argc % 2) {
14317 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14318 return JIM_ERR;
14320 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14321 Jim_SetResult(interp, objPtr);
14322 return JIM_OK;
14324 case OPT_INFO:
14325 if (argc != 3) {
14326 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14327 return JIM_ERR;
14329 return Jim_DictInfo(interp, argv[2]);
14331 /* Handle command as an ensemble */
14332 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14335 /* [subst] */
14336 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14338 static const char * const options[] = {
14339 "-nobackslashes", "-nocommands", "-novariables", NULL
14341 enum
14342 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14343 int i;
14344 int flags = JIM_SUBST_FLAG;
14345 Jim_Obj *objPtr;
14347 if (argc < 2) {
14348 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14349 return JIM_ERR;
14351 for (i = 1; i < (argc - 1); i++) {
14352 int option;
14354 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14355 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14356 return JIM_ERR;
14358 switch (option) {
14359 case OPT_NOBACKSLASHES:
14360 flags |= JIM_SUBST_NOESC;
14361 break;
14362 case OPT_NOCOMMANDS:
14363 flags |= JIM_SUBST_NOCMD;
14364 break;
14365 case OPT_NOVARIABLES:
14366 flags |= JIM_SUBST_NOVAR;
14367 break;
14370 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14371 return JIM_ERR;
14373 Jim_SetResult(interp, objPtr);
14374 return JIM_OK;
14377 /* [info] */
14378 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14380 int cmd;
14381 Jim_Obj *objPtr;
14382 int mode = 0;
14384 static const char * const commands[] = {
14385 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14386 "vars", "version", "patchlevel", "complete", "args", "hostname",
14387 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14388 "references", "alias", NULL
14390 enum
14391 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14392 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14393 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14394 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14397 #ifdef jim_ext_namespace
14398 int nons = 0;
14400 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14401 /* This is for internal use only */
14402 argc--;
14403 argv++;
14404 nons = 1;
14406 #endif
14408 if (argc < 2) {
14409 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14410 return JIM_ERR;
14412 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14413 != JIM_OK) {
14414 return JIM_ERR;
14417 /* Test for the the most common commands first, just in case it makes a difference */
14418 switch (cmd) {
14419 case INFO_EXISTS:
14420 if (argc != 3) {
14421 Jim_WrongNumArgs(interp, 2, argv, "varName");
14422 return JIM_ERR;
14424 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14425 break;
14427 case INFO_ALIAS:{
14428 Jim_Cmd *cmdPtr;
14430 if (argc != 3) {
14431 Jim_WrongNumArgs(interp, 2, argv, "command");
14432 return JIM_ERR;
14434 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14435 return JIM_ERR;
14437 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14438 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14439 return JIM_ERR;
14441 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14442 return JIM_OK;
14445 case INFO_CHANNELS:
14446 mode++; /* JIM_CMDLIST_CHANNELS */
14447 #ifndef jim_ext_aio
14448 Jim_SetResultString(interp, "aio not enabled", -1);
14449 return JIM_ERR;
14450 #endif
14451 case INFO_PROCS:
14452 mode++; /* JIM_CMDLIST_PROCS */
14453 case INFO_COMMANDS:
14454 /* mode 0 => JIM_CMDLIST_COMMANDS */
14455 if (argc != 2 && argc != 3) {
14456 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14457 return JIM_ERR;
14459 #ifdef jim_ext_namespace
14460 if (!nons) {
14461 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14462 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14465 #endif
14466 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14467 break;
14469 case INFO_VARS:
14470 mode++; /* JIM_VARLIST_VARS */
14471 case INFO_LOCALS:
14472 mode++; /* JIM_VARLIST_LOCALS */
14473 case INFO_GLOBALS:
14474 /* mode 0 => JIM_VARLIST_GLOBALS */
14475 if (argc != 2 && argc != 3) {
14476 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14477 return JIM_ERR;
14479 #ifdef jim_ext_namespace
14480 if (!nons) {
14481 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14482 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14485 #endif
14486 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14487 break;
14489 case INFO_SCRIPT:
14490 if (argc != 2) {
14491 Jim_WrongNumArgs(interp, 2, argv, "");
14492 return JIM_ERR;
14494 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14495 break;
14497 case INFO_SOURCE:{
14498 jim_wide line;
14499 Jim_Obj *resObjPtr;
14500 Jim_Obj *fileNameObj;
14502 if (argc != 3 && argc != 5) {
14503 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14504 return JIM_ERR;
14506 if (argc == 5) {
14507 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14508 return JIM_ERR;
14510 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14511 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14513 else {
14514 if (argv[2]->typePtr == &sourceObjType) {
14515 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14516 line = argv[2]->internalRep.sourceValue.lineNumber;
14518 else if (argv[2]->typePtr == &scriptObjType) {
14519 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14520 fileNameObj = script->fileNameObj;
14521 line = script->firstline;
14523 else {
14524 fileNameObj = interp->emptyObj;
14525 line = 1;
14527 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14528 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14529 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14531 Jim_SetResult(interp, resObjPtr);
14532 break;
14535 case INFO_STACKTRACE:
14536 Jim_SetResult(interp, interp->stackTrace);
14537 break;
14539 case INFO_LEVEL:
14540 case INFO_FRAME:
14541 switch (argc) {
14542 case 2:
14543 Jim_SetResultInt(interp, interp->framePtr->level);
14544 break;
14546 case 3:
14547 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14548 return JIM_ERR;
14550 Jim_SetResult(interp, objPtr);
14551 break;
14553 default:
14554 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14555 return JIM_ERR;
14557 break;
14559 case INFO_BODY:
14560 case INFO_STATICS:
14561 case INFO_ARGS:{
14562 Jim_Cmd *cmdPtr;
14564 if (argc != 3) {
14565 Jim_WrongNumArgs(interp, 2, argv, "procname");
14566 return JIM_ERR;
14568 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14569 return JIM_ERR;
14571 if (!cmdPtr->isproc) {
14572 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14573 return JIM_ERR;
14575 switch (cmd) {
14576 case INFO_BODY:
14577 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14578 break;
14579 case INFO_ARGS:
14580 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14581 break;
14582 case INFO_STATICS:
14583 if (cmdPtr->u.proc.staticVars) {
14584 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14585 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14586 NULL, JimVariablesMatch, mode));
14588 break;
14590 break;
14593 case INFO_VERSION:
14594 case INFO_PATCHLEVEL:{
14595 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14597 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14598 Jim_SetResultString(interp, buf, -1);
14599 break;
14602 case INFO_COMPLETE:
14603 if (argc != 3 && argc != 4) {
14604 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14605 return JIM_ERR;
14607 else {
14608 int len;
14609 const char *s = Jim_GetString(argv[2], &len);
14610 char missing;
14612 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14613 if (missing != ' ' && argc == 4) {
14614 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14617 break;
14619 case INFO_HOSTNAME:
14620 /* Redirect to os.gethostname if it exists */
14621 return Jim_Eval(interp, "os.gethostname");
14623 case INFO_NAMEOFEXECUTABLE:
14624 /* Redirect to Tcl proc */
14625 return Jim_Eval(interp, "{info nameofexecutable}");
14627 case INFO_RETURNCODES:
14628 if (argc == 2) {
14629 int i;
14630 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14632 for (i = 0; jimReturnCodes[i]; i++) {
14633 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14634 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14635 jimReturnCodes[i], -1));
14638 Jim_SetResult(interp, listObjPtr);
14640 else if (argc == 3) {
14641 long code;
14642 const char *name;
14644 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14645 return JIM_ERR;
14647 name = Jim_ReturnCode(code);
14648 if (*name == '?') {
14649 Jim_SetResultInt(interp, code);
14651 else {
14652 Jim_SetResultString(interp, name, -1);
14655 else {
14656 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14657 return JIM_ERR;
14659 break;
14660 case INFO_REFERENCES:
14661 #ifdef JIM_REFERENCES
14662 return JimInfoReferences(interp, argc, argv);
14663 #else
14664 Jim_SetResultString(interp, "not supported", -1);
14665 return JIM_ERR;
14666 #endif
14668 return JIM_OK;
14671 /* [exists] */
14672 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14674 Jim_Obj *objPtr;
14675 int result = 0;
14677 static const char * const options[] = {
14678 "-command", "-proc", "-alias", "-var", NULL
14680 enum
14682 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14684 int option;
14686 if (argc == 2) {
14687 option = OPT_VAR;
14688 objPtr = argv[1];
14690 else if (argc == 3) {
14691 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14692 return JIM_ERR;
14694 objPtr = argv[2];
14696 else {
14697 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14698 return JIM_ERR;
14701 if (option == OPT_VAR) {
14702 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14704 else {
14705 /* Now different kinds of commands */
14706 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14708 if (cmd) {
14709 switch (option) {
14710 case OPT_COMMAND:
14711 result = 1;
14712 break;
14714 case OPT_ALIAS:
14715 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14716 break;
14718 case OPT_PROC:
14719 result = cmd->isproc;
14720 break;
14724 Jim_SetResultBool(interp, result);
14725 return JIM_OK;
14728 /* [split] */
14729 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14731 const char *str, *splitChars, *noMatchStart;
14732 int splitLen, strLen;
14733 Jim_Obj *resObjPtr;
14734 int c;
14735 int len;
14737 if (argc != 2 && argc != 3) {
14738 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14739 return JIM_ERR;
14742 str = Jim_GetString(argv[1], &len);
14743 if (len == 0) {
14744 return JIM_OK;
14746 strLen = Jim_Utf8Length(interp, argv[1]);
14748 /* Init */
14749 if (argc == 2) {
14750 splitChars = " \n\t\r";
14751 splitLen = 4;
14753 else {
14754 splitChars = Jim_String(argv[2]);
14755 splitLen = Jim_Utf8Length(interp, argv[2]);
14758 noMatchStart = str;
14759 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14761 /* Split */
14762 if (splitLen) {
14763 Jim_Obj *objPtr;
14764 while (strLen--) {
14765 const char *sc = splitChars;
14766 int scLen = splitLen;
14767 int sl = utf8_tounicode(str, &c);
14768 while (scLen--) {
14769 int pc;
14770 sc += utf8_tounicode(sc, &pc);
14771 if (c == pc) {
14772 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14773 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14774 noMatchStart = str + sl;
14775 break;
14778 str += sl;
14780 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14781 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14783 else {
14784 /* This handles the special case of splitchars eq {}
14785 * Optimise by sharing common (ASCII) characters
14787 Jim_Obj **commonObj = NULL;
14788 #define NUM_COMMON (128 - 9)
14789 while (strLen--) {
14790 int n = utf8_tounicode(str, &c);
14791 #ifdef JIM_OPTIMIZATION
14792 if (c >= 9 && c < 128) {
14793 /* Common ASCII char. Note that 9 is the tab character */
14794 c -= 9;
14795 if (!commonObj) {
14796 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14797 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14799 if (!commonObj[c]) {
14800 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14802 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14803 str++;
14804 continue;
14806 #endif
14807 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14808 str += n;
14810 Jim_Free(commonObj);
14813 Jim_SetResult(interp, resObjPtr);
14814 return JIM_OK;
14817 /* [join] */
14818 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14820 const char *joinStr;
14821 int joinStrLen;
14823 if (argc != 2 && argc != 3) {
14824 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14825 return JIM_ERR;
14827 /* Init */
14828 if (argc == 2) {
14829 joinStr = " ";
14830 joinStrLen = 1;
14832 else {
14833 joinStr = Jim_GetString(argv[2], &joinStrLen);
14835 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14836 return JIM_OK;
14839 /* [format] */
14840 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14842 Jim_Obj *objPtr;
14844 if (argc < 2) {
14845 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14846 return JIM_ERR;
14848 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14849 if (objPtr == NULL)
14850 return JIM_ERR;
14851 Jim_SetResult(interp, objPtr);
14852 return JIM_OK;
14855 /* [scan] */
14856 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14858 Jim_Obj *listPtr, **outVec;
14859 int outc, i;
14861 if (argc < 3) {
14862 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14863 return JIM_ERR;
14865 if (argv[2]->typePtr != &scanFmtStringObjType)
14866 SetScanFmtFromAny(interp, argv[2]);
14867 if (FormatGetError(argv[2]) != 0) {
14868 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14869 return JIM_ERR;
14871 if (argc > 3) {
14872 int maxPos = FormatGetMaxPos(argv[2]);
14873 int count = FormatGetCnvCount(argv[2]);
14875 if (maxPos > argc - 3) {
14876 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14877 return JIM_ERR;
14879 else if (count > argc - 3) {
14880 Jim_SetResultString(interp, "different numbers of variable names and "
14881 "field specifiers", -1);
14882 return JIM_ERR;
14884 else if (count < argc - 3) {
14885 Jim_SetResultString(interp, "variable is not assigned by any "
14886 "conversion specifiers", -1);
14887 return JIM_ERR;
14890 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14891 if (listPtr == 0)
14892 return JIM_ERR;
14893 if (argc > 3) {
14894 int rc = JIM_OK;
14895 int count = 0;
14897 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14898 int len = Jim_ListLength(interp, listPtr);
14900 if (len != 0) {
14901 JimListGetElements(interp, listPtr, &outc, &outVec);
14902 for (i = 0; i < outc; ++i) {
14903 if (Jim_Length(outVec[i]) > 0) {
14904 ++count;
14905 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14906 rc = JIM_ERR;
14911 Jim_FreeNewObj(interp, listPtr);
14913 else {
14914 count = -1;
14916 if (rc == JIM_OK) {
14917 Jim_SetResultInt(interp, count);
14919 return rc;
14921 else {
14922 if (listPtr == (Jim_Obj *)EOF) {
14923 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14924 return JIM_OK;
14926 Jim_SetResult(interp, listPtr);
14928 return JIM_OK;
14931 /* [error] */
14932 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14934 if (argc != 2 && argc != 3) {
14935 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14936 return JIM_ERR;
14938 Jim_SetResult(interp, argv[1]);
14939 if (argc == 3) {
14940 JimSetStackTrace(interp, argv[2]);
14941 return JIM_ERR;
14943 interp->addStackTrace++;
14944 return JIM_ERR;
14947 /* [lrange] */
14948 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14950 Jim_Obj *objPtr;
14952 if (argc != 4) {
14953 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14954 return JIM_ERR;
14956 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14957 return JIM_ERR;
14958 Jim_SetResult(interp, objPtr);
14959 return JIM_OK;
14962 /* [lrepeat] */
14963 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14965 Jim_Obj *objPtr;
14966 long count;
14968 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14969 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14970 return JIM_ERR;
14973 if (count == 0 || argc == 2) {
14974 return JIM_OK;
14977 argc -= 2;
14978 argv += 2;
14980 objPtr = Jim_NewListObj(interp, argv, argc);
14981 while (--count) {
14982 ListInsertElements(objPtr, -1, argc, argv);
14985 Jim_SetResult(interp, objPtr);
14986 return JIM_OK;
14989 char **Jim_GetEnviron(void)
14991 #if defined(HAVE__NSGETENVIRON)
14992 return *_NSGetEnviron();
14993 #else
14994 #if !defined(NO_ENVIRON_EXTERN)
14995 extern char **environ;
14996 #endif
14998 return environ;
14999 #endif
15002 void Jim_SetEnviron(char **env)
15004 #if defined(HAVE__NSGETENVIRON)
15005 *_NSGetEnviron() = env;
15006 #else
15007 #if !defined(NO_ENVIRON_EXTERN)
15008 extern char **environ;
15009 #endif
15011 environ = env;
15012 #endif
15015 /* [env] */
15016 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15018 const char *key;
15019 const char *val;
15021 if (argc == 1) {
15022 char **e = Jim_GetEnviron();
15024 int i;
15025 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15027 for (i = 0; e[i]; i++) {
15028 const char *equals = strchr(e[i], '=');
15030 if (equals) {
15031 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15032 equals - e[i]));
15033 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15037 Jim_SetResult(interp, listObjPtr);
15038 return JIM_OK;
15041 if (argc < 2) {
15042 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15043 return JIM_ERR;
15045 key = Jim_String(argv[1]);
15046 val = getenv(key);
15047 if (val == NULL) {
15048 if (argc < 3) {
15049 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15050 return JIM_ERR;
15052 val = Jim_String(argv[2]);
15054 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15055 return JIM_OK;
15058 /* [source] */
15059 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15061 int retval;
15063 if (argc != 2) {
15064 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15065 return JIM_ERR;
15067 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15068 if (retval == JIM_RETURN)
15069 return JIM_OK;
15070 return retval;
15073 /* [lreverse] */
15074 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15076 Jim_Obj *revObjPtr, **ele;
15077 int len;
15079 if (argc != 2) {
15080 Jim_WrongNumArgs(interp, 1, argv, "list");
15081 return JIM_ERR;
15083 JimListGetElements(interp, argv[1], &len, &ele);
15084 len--;
15085 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15086 while (len >= 0)
15087 ListAppendElement(revObjPtr, ele[len--]);
15088 Jim_SetResult(interp, revObjPtr);
15089 return JIM_OK;
15092 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15094 jim_wide len;
15096 if (step == 0)
15097 return -1;
15098 if (start == end)
15099 return 0;
15100 else if (step > 0 && start > end)
15101 return -1;
15102 else if (step < 0 && end > start)
15103 return -1;
15104 len = end - start;
15105 if (len < 0)
15106 len = -len; /* abs(len) */
15107 if (step < 0)
15108 step = -step; /* abs(step) */
15109 len = 1 + ((len - 1) / step);
15110 /* We can truncate safely to INT_MAX, the range command
15111 * will always return an error for a such long range
15112 * because Tcl lists can't be so long. */
15113 if (len > INT_MAX)
15114 len = INT_MAX;
15115 return (int)((len < 0) ? -1 : len);
15118 /* [range] */
15119 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15121 jim_wide start = 0, end, step = 1;
15122 int len, i;
15123 Jim_Obj *objPtr;
15125 if (argc < 2 || argc > 4) {
15126 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15127 return JIM_ERR;
15129 if (argc == 2) {
15130 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15131 return JIM_ERR;
15133 else {
15134 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15135 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15136 return JIM_ERR;
15137 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15138 return JIM_ERR;
15140 if ((len = JimRangeLen(start, end, step)) == -1) {
15141 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15142 return JIM_ERR;
15144 objPtr = Jim_NewListObj(interp, NULL, 0);
15145 for (i = 0; i < len; i++)
15146 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15147 Jim_SetResult(interp, objPtr);
15148 return JIM_OK;
15151 /* [rand] */
15152 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15154 jim_wide min = 0, max = 0, len, maxMul;
15156 if (argc < 1 || argc > 3) {
15157 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15158 return JIM_ERR;
15160 if (argc == 1) {
15161 max = JIM_WIDE_MAX;
15162 } else if (argc == 2) {
15163 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15164 return JIM_ERR;
15165 } else if (argc == 3) {
15166 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15167 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15168 return JIM_ERR;
15170 len = max-min;
15171 if (len < 0) {
15172 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15173 return JIM_ERR;
15175 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15176 while (1) {
15177 jim_wide r;
15179 JimRandomBytes(interp, &r, sizeof(jim_wide));
15180 if (r < 0 || r >= maxMul) continue;
15181 r = (len == 0) ? 0 : r%len;
15182 Jim_SetResultInt(interp, min+r);
15183 return JIM_OK;
15187 static const struct {
15188 const char *name;
15189 Jim_CmdProc *cmdProc;
15190 } Jim_CoreCommandsTable[] = {
15191 {"alias", Jim_AliasCoreCommand},
15192 {"set", Jim_SetCoreCommand},
15193 {"unset", Jim_UnsetCoreCommand},
15194 {"puts", Jim_PutsCoreCommand},
15195 {"+", Jim_AddCoreCommand},
15196 {"*", Jim_MulCoreCommand},
15197 {"-", Jim_SubCoreCommand},
15198 {"/", Jim_DivCoreCommand},
15199 {"incr", Jim_IncrCoreCommand},
15200 {"while", Jim_WhileCoreCommand},
15201 {"loop", Jim_LoopCoreCommand},
15202 {"for", Jim_ForCoreCommand},
15203 {"foreach", Jim_ForeachCoreCommand},
15204 {"lmap", Jim_LmapCoreCommand},
15205 {"lassign", Jim_LassignCoreCommand},
15206 {"if", Jim_IfCoreCommand},
15207 {"switch", Jim_SwitchCoreCommand},
15208 {"list", Jim_ListCoreCommand},
15209 {"lindex", Jim_LindexCoreCommand},
15210 {"lset", Jim_LsetCoreCommand},
15211 {"lsearch", Jim_LsearchCoreCommand},
15212 {"llength", Jim_LlengthCoreCommand},
15213 {"lappend", Jim_LappendCoreCommand},
15214 {"linsert", Jim_LinsertCoreCommand},
15215 {"lreplace", Jim_LreplaceCoreCommand},
15216 {"lsort", Jim_LsortCoreCommand},
15217 {"append", Jim_AppendCoreCommand},
15218 {"debug", Jim_DebugCoreCommand},
15219 {"eval", Jim_EvalCoreCommand},
15220 {"uplevel", Jim_UplevelCoreCommand},
15221 {"expr", Jim_ExprCoreCommand},
15222 {"break", Jim_BreakCoreCommand},
15223 {"continue", Jim_ContinueCoreCommand},
15224 {"proc", Jim_ProcCoreCommand},
15225 {"concat", Jim_ConcatCoreCommand},
15226 {"return", Jim_ReturnCoreCommand},
15227 {"upvar", Jim_UpvarCoreCommand},
15228 {"global", Jim_GlobalCoreCommand},
15229 {"string", Jim_StringCoreCommand},
15230 {"time", Jim_TimeCoreCommand},
15231 {"exit", Jim_ExitCoreCommand},
15232 {"catch", Jim_CatchCoreCommand},
15233 #ifdef JIM_REFERENCES
15234 {"ref", Jim_RefCoreCommand},
15235 {"getref", Jim_GetrefCoreCommand},
15236 {"setref", Jim_SetrefCoreCommand},
15237 {"finalize", Jim_FinalizeCoreCommand},
15238 {"collect", Jim_CollectCoreCommand},
15239 #endif
15240 {"rename", Jim_RenameCoreCommand},
15241 {"dict", Jim_DictCoreCommand},
15242 {"subst", Jim_SubstCoreCommand},
15243 {"info", Jim_InfoCoreCommand},
15244 {"exists", Jim_ExistsCoreCommand},
15245 {"split", Jim_SplitCoreCommand},
15246 {"join", Jim_JoinCoreCommand},
15247 {"format", Jim_FormatCoreCommand},
15248 {"scan", Jim_ScanCoreCommand},
15249 {"error", Jim_ErrorCoreCommand},
15250 {"lrange", Jim_LrangeCoreCommand},
15251 {"lrepeat", Jim_LrepeatCoreCommand},
15252 {"env", Jim_EnvCoreCommand},
15253 {"source", Jim_SourceCoreCommand},
15254 {"lreverse", Jim_LreverseCoreCommand},
15255 {"range", Jim_RangeCoreCommand},
15256 {"rand", Jim_RandCoreCommand},
15257 {"tailcall", Jim_TailcallCoreCommand},
15258 {"local", Jim_LocalCoreCommand},
15259 {"upcall", Jim_UpcallCoreCommand},
15260 {"apply", Jim_ApplyCoreCommand},
15261 {NULL, NULL},
15264 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15266 int i = 0;
15268 while (Jim_CoreCommandsTable[i].name != NULL) {
15269 Jim_CreateCommand(interp,
15270 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15271 i++;
15275 /* -----------------------------------------------------------------------------
15276 * Interactive prompt
15277 * ---------------------------------------------------------------------------*/
15278 void Jim_MakeErrorMessage(Jim_Interp *interp)
15280 Jim_Obj *argv[2];
15282 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15283 argv[1] = interp->result;
15285 Jim_EvalObjVector(interp, 2, argv);
15288 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15289 const char *prefix, const char *const *tablePtr, const char *name)
15291 int count;
15292 char **tablePtrSorted;
15293 int i;
15295 for (count = 0; tablePtr[count]; count++) {
15298 if (name == NULL) {
15299 name = "option";
15302 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15303 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15304 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15305 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15306 for (i = 0; i < count; i++) {
15307 if (i + 1 == count && count > 1) {
15308 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15310 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15311 if (i + 1 != count) {
15312 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15315 Jim_Free(tablePtrSorted);
15318 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15319 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15321 const char *bad = "bad ";
15322 const char *const *entryPtr = NULL;
15323 int i;
15324 int match = -1;
15325 int arglen;
15326 const char *arg = Jim_GetString(objPtr, &arglen);
15328 *indexPtr = -1;
15330 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15331 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15332 /* Found an exact match */
15333 *indexPtr = i;
15334 return JIM_OK;
15336 if (flags & JIM_ENUM_ABBREV) {
15337 /* Accept an unambiguous abbreviation.
15338 * Note that '-' doesnt' consitute a valid abbreviation
15340 if (strncmp(arg, *entryPtr, arglen) == 0) {
15341 if (*arg == '-' && arglen == 1) {
15342 break;
15344 if (match >= 0) {
15345 bad = "ambiguous ";
15346 goto ambiguous;
15348 match = i;
15353 /* If we had an unambiguous partial match */
15354 if (match >= 0) {
15355 *indexPtr = match;
15356 return JIM_OK;
15359 ambiguous:
15360 if (flags & JIM_ERRMSG) {
15361 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15363 return JIM_ERR;
15366 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15368 int i;
15370 for (i = 0; i < (int)len; i++) {
15371 if (array[i] && strcmp(array[i], name) == 0) {
15372 return i;
15375 return -1;
15378 int Jim_IsDict(Jim_Obj *objPtr)
15380 return objPtr->typePtr == &dictObjType;
15383 int Jim_IsList(Jim_Obj *objPtr)
15385 return objPtr->typePtr == &listObjType;
15389 * Very simple printf-like formatting, designed for error messages.
15391 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15392 * The resulting string is created and set as the result.
15394 * Each '%s' should correspond to a regular string parameter.
15395 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15396 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15398 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15400 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15402 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15404 /* Initial space needed */
15405 int len = strlen(format);
15406 int extra = 0;
15407 int n = 0;
15408 const char *params[5];
15409 char *buf;
15410 va_list args;
15411 int i;
15413 va_start(args, format);
15415 for (i = 0; i < len && n < 5; i++) {
15416 int l;
15418 if (strncmp(format + i, "%s", 2) == 0) {
15419 params[n] = va_arg(args, char *);
15421 l = strlen(params[n]);
15423 else if (strncmp(format + i, "%#s", 3) == 0) {
15424 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15426 params[n] = Jim_GetString(objPtr, &l);
15428 else {
15429 if (format[i] == '%') {
15430 i++;
15432 continue;
15434 n++;
15435 extra += l;
15438 len += extra;
15439 buf = Jim_Alloc(len + 1);
15440 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15442 va_end(args);
15444 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15447 /* stubs */
15448 #ifndef jim_ext_package
15449 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15451 return JIM_OK;
15453 #endif
15454 #ifndef jim_ext_aio
15455 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15457 Jim_SetResultString(interp, "aio not enabled", -1);
15458 return NULL;
15460 #endif
15464 * Local Variables: ***
15465 * c-basic-offset: 4 ***
15466 * tab-width: 4 ***
15467 * End: ***