ensure that tests can find tcltest.tcl
[jimtcl.git] / jim.c
blobdc92c4767feae958598e834a81005e8328d78323
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
130 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
131 int flags);
132 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
133 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
134 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
135 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
136 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
137 const char *prefix, const char *const *tablePtr, const char *name);
138 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
139 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
140 static int JimSign(jim_wide w);
141 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
142 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
143 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s, int *uc, int upper)
153 int l = utf8_tounicode(s, uc);
154 if (upper) {
155 *uc = utf8_upper(*uc);
157 return l;
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
182 int not = 0;
183 int pchar;
184 int match = 0;
185 int nocase = 0;
187 if (flags & JIM_NOCASE) {
188 nocase++;
189 c = utf8_upper(c);
192 if (flags & JIM_CHARSET_SCAN) {
193 if (*pattern == '^') {
194 not++;
195 pattern++;
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern == ']') {
200 goto first;
204 while (*pattern && *pattern != ']') {
205 /* Exact match */
206 if (pattern[0] == '\\') {
207 first:
208 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
210 else {
211 /* Is this a range? a-z */
212 int start;
213 int end;
215 pattern += utf8_tounicode_case(pattern, &start, nocase);
216 if (pattern[0] == '-' && pattern[1]) {
217 /* skip '-' */
218 pattern += utf8_tounicode(pattern, &pchar);
219 pattern += utf8_tounicode_case(pattern, &end, nocase);
221 /* Handle reversed range too */
222 if ((c >= start && c <= end) || (c >= end && c <= start)) {
223 match = 1;
225 continue;
227 pchar = start;
230 if (pchar == c) {
231 match = 1;
234 if (not) {
235 match = !match;
238 return match ? pattern : NULL;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
311 * string comparison. Works on binary data.
313 * Returns -1, 0 or 1
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
319 if (l1 < l2) {
320 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
322 else if (l2 < l1) {
323 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
325 else {
326 return JimSign(memcmp(s1, s2, l1));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
340 while (*s1 && *s2 && maxchars) {
341 int c1, c2;
342 s1 += utf8_tounicode_case(s1, &c1, nocase);
343 s2 += utf8_tounicode_case(s2, &c2, nocase);
344 if (c1 != c2) {
345 return JimSign(c1 - c2);
347 maxchars--;
349 if (!maxchars) {
350 return 0;
352 /* One string or both terminated */
353 if (*s1) {
354 return 1;
356 if (*s2) {
357 return -1;
359 return 0;
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
367 int i;
368 int l1bytelen;
370 if (!l1 || !l2 || l1 > l2) {
371 return -1;
373 if (idx < 0)
374 idx = 0;
375 s2 += utf8_index(s2, idx);
377 l1bytelen = utf8_index(s1, l1);
379 for (i = idx; i <= l2 - l1; i++) {
380 int c;
381 if (memcmp(s2, s1, l1bytelen) == 0) {
382 return i;
384 s2 += utf8_tounicode(s2, &c);
386 return -1;
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
394 const char *p;
396 if (!l1 || !l2 || l1 > l2)
397 return -1;
399 /* Now search for the needle */
400 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
401 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
402 return p - s2;
405 return -1;
408 #ifdef JIM_UTF8
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
414 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
415 if (n > 0) {
416 n = utf8_strlen(s2, n);
418 return n;
420 #endif
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str, const char *endptr)
431 if (str[0] == '\0' || str == endptr) {
432 return JIM_ERR;
435 if (endptr[0] != '\0') {
436 while (*endptr) {
437 if (!isspace(UCHAR(*endptr))) {
438 return JIM_ERR;
440 endptr++;
443 return JIM_OK;
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str, int *base, int *sign)
451 int i = 0;
453 *base = 10;
455 while (isspace(UCHAR(str[i]))) {
456 i++;
459 if (str[i] == '-') {
460 *sign = -1;
461 i++;
463 else {
464 if (str[i] == '+') {
465 i++;
467 *sign = 1;
470 if (str[i] != '0') {
471 /* base 10 */
472 return 0;
475 /* We have 0<x>, so see if we can convert it */
476 switch (str[i + 1]) {
477 case 'x': case 'X': *base = 16; break;
478 case 'o': case 'O': *base = 8; break;
479 case 'b': case 'B': *base = 2; break;
480 default: return 0;
482 i += 2;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
485 /* Parse according to this base */
486 return i;
488 /* Parse as base 10 */
489 *base = 10;
490 return 0;
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str, char **endptr)
498 int sign;
499 int base;
500 int i = JimNumberBase(str, &base, &sign);
502 if (base != 10) {
503 long value = strtol(str + i, endptr, base);
504 if (endptr == NULL || *endptr != str + i) {
505 return value * sign;
509 /* Can just do a regular base-10 conversion */
510 return strtol(str, endptr, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide jim_strtoull(const char *str, char **endptr)
519 #ifdef HAVE_LONG_LONG
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 jim_wide value = strtoull(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str, endptr, 10);
533 #else
534 return (unsigned long)jim_strtol(str, endptr);
535 #endif
538 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
540 char *endptr;
542 if (base) {
543 *widePtr = strtoull(str, &endptr, base);
545 else {
546 *widePtr = jim_strtoull(str, &endptr);
549 return JimCheckConversion(str, endptr);
552 int Jim_StringToDouble(const char *str, double *doublePtr)
554 char *endptr;
556 /* Callers can check for underflow via ERANGE */
557 errno = 0;
559 *doublePtr = strtod(str, &endptr);
561 return JimCheckConversion(str, endptr);
564 static jim_wide JimPowWide(jim_wide b, jim_wide e)
566 jim_wide i, res = 1;
568 if ((b == 0 && e != 0) || (e < 0))
569 return 0;
570 for (i = 0; i < e; i++) {
571 res *= b;
573 return res;
576 /* -----------------------------------------------------------------------------
577 * Special functions
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition, const char *fmt, ...)
582 va_list ap;
584 if (!condition) {
585 return;
588 va_start(ap, fmt);
590 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr, fmt, ap);
592 fprintf(stderr, "\n\n");
593 va_end(ap);
595 #ifdef HAVE_BACKTRACE
597 void *array[40];
598 int size, i;
599 char **strings;
601 size = backtrace(array, 40);
602 strings = backtrace_symbols(array, size);
603 for (i = 0; i < size; i++)
604 fprintf(stderr, "[backtrace] %s\n", strings[i]);
605 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
608 #endif
610 exit(1);
612 #endif
614 /* -----------------------------------------------------------------------------
615 * Memory allocation
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size)
620 return size ? malloc(size) : NULL;
623 void Jim_Free(void *ptr)
625 free(ptr);
628 void *Jim_Realloc(void *ptr, int size)
630 return realloc(ptr, size);
633 char *Jim_StrDup(const char *s)
635 return strdup(s);
638 char *Jim_StrDupLen(const char *s, int l)
640 char *copy = Jim_Alloc(l + 1);
642 memcpy(copy, s, l + 1);
643 copy[l] = 0; /* Just to be sure, original could be substring */
644 return copy;
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide JimClock(void)
654 struct timeval tv;
656 gettimeofday(&tv, NULL);
657 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
660 /* -----------------------------------------------------------------------------
661 * Hash Tables
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
666 static unsigned int JimHashTableNextPower(unsigned int size);
667 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key)
674 key += ~(key << 15);
675 key ^= (key >> 10);
676 key += (key << 3);
677 key ^= (key >> 6);
678 key += ~(key << 11);
679 key ^= (key >> 16);
680 return key;
683 /* Generic hash function (we are using to multiply by 9 and add the byte
684 * as Tcl) */
685 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
687 unsigned int h = 0;
689 while (len--)
690 h += (h << 3) + *buf++;
691 return h;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable *ht)
699 ht->table = NULL;
700 ht->size = 0;
701 ht->sizemask = 0;
702 ht->used = 0;
703 ht->collisions = 0;
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht->uniq = (rand() ^ time(NULL) ^ clock());
709 #else
710 ht->uniq = 0;
711 #endif
714 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
716 iter->ht = ht;
717 iter->index = -1;
718 iter->entry = NULL;
719 iter->nextEntry = NULL;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
725 JimResetHashTable(ht);
726 ht->type = type;
727 ht->privdata = privDataPtr;
728 return JIM_OK;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable *ht)
735 int minimal = ht->used;
737 if (minimal < JIM_HT_INITIAL_SIZE)
738 minimal = JIM_HT_INITIAL_SIZE;
739 Jim_ExpandHashTable(ht, minimal);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
745 Jim_HashTable n; /* the new hashtable */
746 unsigned int realsize = JimHashTableNextPower(size), i;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size <= ht->used)
751 return;
753 Jim_InitHashTable(&n, ht->type, ht->privdata);
754 n.size = realsize;
755 n.sizemask = realsize - 1;
756 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
757 /* Keep the same 'uniq' as the original */
758 n.uniq = ht->uniq;
760 /* Initialize all the pointers to NULL */
761 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
766 n.used = ht->used;
767 for (i = 0; ht->used > 0; i++) {
768 Jim_HashEntry *he, *nextHe;
770 if (ht->table[i] == NULL)
771 continue;
773 /* For each hash entry on this slot... */
774 he = ht->table[i];
775 while (he) {
776 unsigned int h;
778 nextHe = he->next;
779 /* Get the new element index */
780 h = Jim_HashKey(ht, he->key) & n.sizemask;
781 he->next = n.table[h];
782 n.table[h] = he;
783 ht->used--;
784 /* Pass to the next element */
785 he = nextHe;
788 assert(ht->used == 0);
789 Jim_Free(ht->table);
791 /* Remap the new hashtable in the old */
792 *ht = n;
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
798 Jim_HashEntry *entry;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry = JimInsertHashEntry(ht, key, 0);
803 if (entry == NULL)
804 return JIM_ERR;
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht, entry, key);
808 Jim_SetHashVal(ht, entry, val);
809 return JIM_OK;
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
815 int existed;
816 Jim_HashEntry *entry;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry = JimInsertHashEntry(ht, key, 1);
821 if (entry->key) {
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht->type->valDestructor && ht->type->valDup) {
828 void *newval = ht->type->valDup(ht->privdata, val);
829 ht->type->valDestructor(ht->privdata, entry->u.val);
830 entry->u.val = newval;
832 else {
833 Jim_FreeEntryVal(ht, entry);
834 Jim_SetHashVal(ht, entry, val);
836 existed = 1;
838 else {
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht, entry, key);
841 Jim_SetHashVal(ht, entry, val);
842 existed = 0;
845 return existed;
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
851 unsigned int h;
852 Jim_HashEntry *he, *prevHe;
854 if (ht->used == 0)
855 return JIM_ERR;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
859 prevHe = NULL;
860 while (he) {
861 if (Jim_CompareHashKeys(ht, key, he->key)) {
862 /* Unlink the element from the list */
863 if (prevHe)
864 prevHe->next = he->next;
865 else
866 ht->table[h] = he->next;
867 Jim_FreeEntryKey(ht, he);
868 Jim_FreeEntryVal(ht, he);
869 Jim_Free(he);
870 ht->used--;
871 return JIM_OK;
873 prevHe = he;
874 he = he->next;
876 return JIM_ERR; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable *ht)
882 unsigned int i;
884 /* Free all the elements */
885 for (i = 0; ht->used > 0; i++) {
886 Jim_HashEntry *he, *nextHe;
888 if ((he = ht->table[i]) == NULL)
889 continue;
890 while (he) {
891 nextHe = he->next;
892 Jim_FreeEntryKey(ht, he);
893 Jim_FreeEntryVal(ht, he);
894 Jim_Free(he);
895 ht->used--;
896 he = nextHe;
899 /* Free the table and the allocated cache structure */
900 Jim_Free(ht->table);
901 /* Re-initialize the table */
902 JimResetHashTable(ht);
903 return JIM_OK; /* never fails */
906 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
908 Jim_HashEntry *he;
909 unsigned int h;
911 if (ht->used == 0)
912 return NULL;
913 h = Jim_HashKey(ht, key) & ht->sizemask;
914 he = ht->table[h];
915 while (he) {
916 if (Jim_CompareHashKeys(ht, key, he->key))
917 return he;
918 he = he->next;
920 return NULL;
923 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
925 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
926 JimInitHashTableIterator(ht, iter);
927 return iter;
930 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
932 while (1) {
933 if (iter->entry == NULL) {
934 iter->index++;
935 if (iter->index >= (signed)iter->ht->size)
936 break;
937 iter->entry = iter->ht->table[iter->index];
939 else {
940 iter->entry = iter->nextEntry;
942 if (iter->entry) {
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter->nextEntry = iter->entry->next;
946 return iter->entry;
949 return NULL;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
959 if (ht->size == 0)
960 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
961 if (ht->size == ht->used)
962 Jim_ExpandHashTable(ht, ht->size * 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size)
968 unsigned int i = JIM_HT_INITIAL_SIZE;
970 if (size >= 2147483648U)
971 return 2147483648U;
972 while (1) {
973 if (i >= size)
974 return i;
975 i *= 2;
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
984 unsigned int h;
985 Jim_HashEntry *he;
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht);
990 /* Compute the key hash value */
991 h = Jim_HashKey(ht, key) & ht->sizemask;
992 /* Search if this slot does not already contain the given key */
993 he = ht->table[h];
994 while (he) {
995 if (Jim_CompareHashKeys(ht, key, he->key))
996 return replace ? he : NULL;
997 he = he->next;
1000 /* Allocates the memory and stores key */
1001 he = Jim_Alloc(sizeof(*he));
1002 he->next = ht->table[h];
1003 ht->table[h] = he;
1004 ht->used++;
1005 he->key = NULL;
1007 return he;
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key)
1014 return Jim_GenHashFunction(key, strlen(key));
1017 static void *JimStringCopyHTDup(void *privdata, const void *key)
1019 return Jim_StrDup(key);
1022 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1024 return strcmp(key1, key2) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1029 Jim_Free(key);
1032 static const Jim_HashTableType JimPackageHashTableType = {
1033 JimStringCopyHTHashFunction, /* hash function */
1034 JimStringCopyHTDup, /* key dup */
1035 NULL, /* val dup */
1036 JimStringCopyHTKeyCompare, /* key compare */
1037 JimStringCopyHTKeyDestructor, /* key destructor */
1038 NULL /* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc *delProc;
1044 void *data;
1045 } AssocDataValue;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1049 AssocDataValue *assocPtr = (AssocDataValue *) data;
1051 if (assocPtr->delProc != NULL)
1052 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1053 Jim_Free(data);
1056 static const Jim_HashTableType JimAssocDataHashTableType = {
1057 JimStringCopyHTHashFunction, /* hash function */
1058 JimStringCopyHTDup, /* key dup */
1059 NULL, /* val dup */
1060 JimStringCopyHTKeyCompare, /* key compare */
1061 JimStringCopyHTKeyDestructor, /* key destructor */
1062 JimAssocDataHashTableValueDestructor /* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack *stack)
1071 stack->len = 0;
1072 stack->maxlen = 0;
1073 stack->vector = NULL;
1076 void Jim_FreeStack(Jim_Stack *stack)
1078 Jim_Free(stack->vector);
1081 int Jim_StackLen(Jim_Stack *stack)
1083 return stack->len;
1086 void Jim_StackPush(Jim_Stack *stack, void *element)
1088 int neededLen = stack->len + 1;
1090 if (neededLen > stack->maxlen) {
1091 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1092 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1094 stack->vector[stack->len] = element;
1095 stack->len++;
1098 void *Jim_StackPop(Jim_Stack *stack)
1100 if (stack->len == 0)
1101 return NULL;
1102 stack->len--;
1103 return stack->vector[stack->len];
1106 void *Jim_StackPeek(Jim_Stack *stack)
1108 if (stack->len == 0)
1109 return NULL;
1110 return stack->vector[stack->len - 1];
1113 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1115 int i;
1117 for (i = 0; i < stack->len; i++)
1118 freeFunc(stack->vector[i]);
1121 /* -----------------------------------------------------------------------------
1122 * Tcl Parser
1123 * ---------------------------------------------------------------------------*/
1125 /* Token types */
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1154 /* Parser states */
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing {
1163 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1164 int line; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1169 struct JimParserCtx
1171 const char *p; /* Pointer to the point of the program we are parsing */
1172 int len; /* Remaining length */
1173 int linenr; /* Current line number */
1174 const char *tstart;
1175 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline; /* Line number of the returned token */
1177 int tt; /* Token type */
1178 int eof; /* Non zero if EOF condition is true. */
1179 int state; /* Parser state */
1180 int comment; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx *pc);
1185 static int JimParseSep(struct JimParserCtx *pc);
1186 static int JimParseEol(struct JimParserCtx *pc);
1187 static int JimParseCmd(struct JimParserCtx *pc);
1188 static int JimParseQuote(struct JimParserCtx *pc);
1189 static int JimParseVar(struct JimParserCtx *pc);
1190 static int JimParseBrace(struct JimParserCtx *pc);
1191 static int JimParseStr(struct JimParserCtx *pc);
1192 static int JimParseComment(struct JimParserCtx *pc);
1193 static void JimParseSubCmd(struct JimParserCtx *pc);
1194 static int JimParseSubQuote(struct JimParserCtx *pc);
1195 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1202 pc->p = prg;
1203 pc->len = len;
1204 pc->tstart = NULL;
1205 pc->tend = NULL;
1206 pc->tline = 0;
1207 pc->tt = JIM_TT_NONE;
1208 pc->eof = 0;
1209 pc->state = JIM_PS_DEF;
1210 pc->linenr = linenr;
1211 pc->comment = 1;
1212 pc->missing.ch = ' ';
1213 pc->missing.line = linenr;
1216 static int JimParseScript(struct JimParserCtx *pc)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1219 if (!pc->len) {
1220 pc->tstart = pc->p;
1221 pc->tend = pc->p - 1;
1222 pc->tline = pc->linenr;
1223 pc->tt = JIM_TT_EOL;
1224 pc->eof = 1;
1225 return JIM_OK;
1227 switch (*(pc->p)) {
1228 case '\\':
1229 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1230 return JimParseSep(pc);
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 case ' ':
1235 case '\t':
1236 case '\r':
1237 case '\f':
1238 if (pc->state == JIM_PS_DEF)
1239 return JimParseSep(pc);
1240 pc->comment = 0;
1241 return JimParseStr(pc);
1242 case '\n':
1243 case ';':
1244 pc->comment = 1;
1245 if (pc->state == JIM_PS_DEF)
1246 return JimParseEol(pc);
1247 return JimParseStr(pc);
1248 case '[':
1249 pc->comment = 0;
1250 return JimParseCmd(pc);
1251 case '$':
1252 pc->comment = 0;
1253 if (JimParseVar(pc) == JIM_ERR) {
1254 /* An orphan $. Create as a separate token */
1255 pc->tstart = pc->tend = pc->p++;
1256 pc->len--;
1257 pc->tt = JIM_TT_ESC;
1259 return JIM_OK;
1260 case '#':
1261 if (pc->comment) {
1262 JimParseComment(pc);
1263 continue;
1265 return JimParseStr(pc);
1266 default:
1267 pc->comment = 0;
1268 return JimParseStr(pc);
1270 return JIM_OK;
1274 static int JimParseSep(struct JimParserCtx *pc)
1276 pc->tstart = pc->p;
1277 pc->tline = pc->linenr;
1278 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1279 if (*pc->p == '\n') {
1280 break;
1282 if (*pc->p == '\\') {
1283 pc->p++;
1284 pc->len--;
1285 pc->linenr++;
1287 pc->p++;
1288 pc->len--;
1290 pc->tend = pc->p - 1;
1291 pc->tt = JIM_TT_SEP;
1292 return JIM_OK;
1295 static int JimParseEol(struct JimParserCtx *pc)
1297 pc->tstart = pc->p;
1298 pc->tline = pc->linenr;
1299 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1300 if (*pc->p == '\n')
1301 pc->linenr++;
1302 pc->p++;
1303 pc->len--;
1305 pc->tend = pc->p - 1;
1306 pc->tt = JIM_TT_EOL;
1307 return JIM_OK;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx *pc)
1340 int level = 1;
1342 /* Skip the brace */
1343 pc->p++;
1344 pc->len--;
1345 while (pc->len) {
1346 switch (*pc->p) {
1347 case '\\':
1348 if (pc->len > 1) {
1349 if (*++pc->p == '\n') {
1350 pc->linenr++;
1352 pc->len--;
1354 break;
1356 case '{':
1357 level++;
1358 break;
1360 case '}':
1361 if (--level == 0) {
1362 pc->tend = pc->p - 1;
1363 pc->p++;
1364 pc->len--;
1365 return;
1367 break;
1369 case '\n':
1370 pc->linenr++;
1371 break;
1373 pc->p++;
1374 pc->len--;
1376 pc->missing.ch = '{';
1377 pc->missing.line = pc->tline;
1378 pc->tend = pc->p - 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1389 * or JIM_TT_STR.
1391 static int JimParseSubQuote(struct JimParserCtx *pc)
1393 int tt = JIM_TT_STR;
1394 int line = pc->tline;
1396 /* Skip the quote */
1397 pc->p++;
1398 pc->len--;
1399 while (pc->len) {
1400 switch (*pc->p) {
1401 case '\\':
1402 if (pc->len > 1) {
1403 if (*++pc->p == '\n') {
1404 pc->linenr++;
1406 pc->len--;
1407 tt = JIM_TT_ESC;
1409 break;
1411 case '"':
1412 pc->tend = pc->p - 1;
1413 pc->p++;
1414 pc->len--;
1415 return tt;
1417 case '[':
1418 JimParseSubCmd(pc);
1419 tt = JIM_TT_ESC;
1420 continue;
1422 case '\n':
1423 pc->linenr++;
1424 break;
1426 case '$':
1427 tt = JIM_TT_ESC;
1428 break;
1430 pc->p++;
1431 pc->len--;
1433 pc->missing.ch = '"';
1434 pc->missing.line = line;
1435 pc->tend = pc->p - 1;
1436 return tt;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx *pc)
1447 int level = 1;
1448 int startofword = 1;
1449 int line = pc->tline;
1451 /* Skip the bracket */
1452 pc->p++;
1453 pc->len--;
1454 while (pc->len) {
1455 switch (*pc->p) {
1456 case '\\':
1457 if (pc->len > 1) {
1458 if (*++pc->p == '\n') {
1459 pc->linenr++;
1461 pc->len--;
1463 break;
1465 case '[':
1466 level++;
1467 break;
1469 case ']':
1470 if (--level == 0) {
1471 pc->tend = pc->p - 1;
1472 pc->p++;
1473 pc->len--;
1474 return;
1476 break;
1478 case '"':
1479 if (startofword) {
1480 JimParseSubQuote(pc);
1481 continue;
1483 break;
1485 case '{':
1486 JimParseSubBrace(pc);
1487 startofword = 0;
1488 continue;
1490 case '\n':
1491 pc->linenr++;
1492 break;
1494 startofword = isspace(UCHAR(*pc->p));
1495 pc->p++;
1496 pc->len--;
1498 pc->missing.ch = '[';
1499 pc->missing.line = line;
1500 pc->tend = pc->p - 1;
1503 static int JimParseBrace(struct JimParserCtx *pc)
1505 pc->tstart = pc->p + 1;
1506 pc->tline = pc->linenr;
1507 pc->tt = JIM_TT_STR;
1508 JimParseSubBrace(pc);
1509 return JIM_OK;
1512 static int JimParseCmd(struct JimParserCtx *pc)
1514 pc->tstart = pc->p + 1;
1515 pc->tline = pc->linenr;
1516 pc->tt = JIM_TT_CMD;
1517 JimParseSubCmd(pc);
1518 return JIM_OK;
1521 static int JimParseQuote(struct JimParserCtx *pc)
1523 pc->tstart = pc->p + 1;
1524 pc->tline = pc->linenr;
1525 pc->tt = JimParseSubQuote(pc);
1526 return JIM_OK;
1529 static int JimParseVar(struct JimParserCtx *pc)
1531 /* skip the $ */
1532 pc->p++;
1533 pc->len--;
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc->p == '[') {
1537 /* Parse $[...] expr shorthand syntax */
1538 JimParseCmd(pc);
1539 pc->tt = JIM_TT_EXPRSUGAR;
1540 return JIM_OK;
1542 #endif
1544 pc->tstart = pc->p;
1545 pc->tt = JIM_TT_VAR;
1546 pc->tline = pc->linenr;
1548 if (*pc->p == '{') {
1549 pc->tstart = ++pc->p;
1550 pc->len--;
1552 while (pc->len && *pc->p != '}') {
1553 if (*pc->p == '\n') {
1554 pc->linenr++;
1556 pc->p++;
1557 pc->len--;
1559 pc->tend = pc->p - 1;
1560 if (pc->len) {
1561 pc->p++;
1562 pc->len--;
1565 else {
1566 while (1) {
1567 /* Skip double colon, but not single colon! */
1568 if (pc->p[0] == ':' && pc->p[1] == ':') {
1569 while (*pc->p == ':') {
1570 pc->p++;
1571 pc->len--;
1573 continue;
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1579 pc->p++;
1580 pc->len--;
1581 continue;
1583 break;
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc->p == '(') {
1587 int count = 1;
1588 const char *paren = NULL;
1590 pc->tt = JIM_TT_DICTSUGAR;
1592 while (count && pc->len) {
1593 pc->p++;
1594 pc->len--;
1595 if (*pc->p == '\\' && pc->len >= 1) {
1596 pc->p++;
1597 pc->len--;
1599 else if (*pc->p == '(') {
1600 count++;
1602 else if (*pc->p == ')') {
1603 paren = pc->p;
1604 count--;
1607 if (count == 0) {
1608 pc->p++;
1609 pc->len--;
1611 else if (paren) {
1612 /* Did not find a matching paren. Back up */
1613 paren++;
1614 pc->len += (pc->p - paren);
1615 pc->p = paren;
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc->tstart == '(') {
1619 pc->tt = JIM_TT_EXPRSUGAR;
1621 #endif
1623 pc->tend = pc->p - 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1628 * a string. */
1629 if (pc->tstart == pc->p) {
1630 pc->p--;
1631 pc->len++;
1632 return JIM_ERR;
1634 return JIM_OK;
1637 static int JimParseStr(struct JimParserCtx *pc)
1639 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1640 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1641 /* Starting a new word */
1642 if (*pc->p == '{') {
1643 return JimParseBrace(pc);
1645 if (*pc->p == '"') {
1646 pc->state = JIM_PS_QUOTE;
1647 pc->p++;
1648 pc->len--;
1649 /* In case the end quote is missing */
1650 pc->missing.line = pc->tline;
1653 pc->tstart = pc->p;
1654 pc->tline = pc->linenr;
1655 while (1) {
1656 if (pc->len == 0) {
1657 if (pc->state == JIM_PS_QUOTE) {
1658 pc->missing.ch = '"';
1660 pc->tend = pc->p - 1;
1661 pc->tt = JIM_TT_ESC;
1662 return JIM_OK;
1664 switch (*pc->p) {
1665 case '\\':
1666 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1667 pc->tend = pc->p - 1;
1668 pc->tt = JIM_TT_ESC;
1669 return JIM_OK;
1671 if (pc->len >= 2) {
1672 if (*(pc->p + 1) == '\n') {
1673 pc->linenr++;
1675 pc->p++;
1676 pc->len--;
1678 else if (pc->len == 1) {
1679 /* End of script with trailing backslash */
1680 pc->missing.ch = '\\';
1682 break;
1683 case '(':
1684 /* If the following token is not '$' just keep going */
1685 if (pc->len > 1 && pc->p[1] != '$') {
1686 break;
1688 case ')':
1689 /* Only need a separate ')' token if the previous was a var */
1690 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1691 if (pc->p == pc->tstart) {
1692 /* At the start of the token, so just return this char */
1693 pc->p++;
1694 pc->len--;
1696 pc->tend = pc->p - 1;
1697 pc->tt = JIM_TT_ESC;
1698 return JIM_OK;
1700 break;
1702 case '$':
1703 case '[':
1704 pc->tend = pc->p - 1;
1705 pc->tt = JIM_TT_ESC;
1706 return JIM_OK;
1707 case ' ':
1708 case '\t':
1709 case '\n':
1710 case '\r':
1711 case '\f':
1712 case ';':
1713 if (pc->state == JIM_PS_DEF) {
1714 pc->tend = pc->p - 1;
1715 pc->tt = JIM_TT_ESC;
1716 return JIM_OK;
1718 else if (*pc->p == '\n') {
1719 pc->linenr++;
1721 break;
1722 case '"':
1723 if (pc->state == JIM_PS_QUOTE) {
1724 pc->tend = pc->p - 1;
1725 pc->tt = JIM_TT_ESC;
1726 pc->p++;
1727 pc->len--;
1728 pc->state = JIM_PS_DEF;
1729 return JIM_OK;
1731 break;
1733 pc->p++;
1734 pc->len--;
1736 return JIM_OK; /* unreached */
1739 static int JimParseComment(struct JimParserCtx *pc)
1741 while (*pc->p) {
1742 if (*pc->p == '\\') {
1743 pc->p++;
1744 pc->len--;
1745 if (pc->len == 0) {
1746 pc->missing.ch = '\\';
1747 return JIM_OK;
1749 if (*pc->p == '\n') {
1750 pc->linenr++;
1753 else if (*pc->p == '\n') {
1754 pc->p++;
1755 pc->len--;
1756 pc->linenr++;
1757 break;
1759 pc->p++;
1760 pc->len--;
1762 return JIM_OK;
1765 /* xdigitval and odigitval are helper functions for JimEscape() */
1766 static int xdigitval(int c)
1768 if (c >= '0' && c <= '9')
1769 return c - '0';
1770 if (c >= 'a' && c <= 'f')
1771 return c - 'a' + 10;
1772 if (c >= 'A' && c <= 'F')
1773 return c - 'A' + 10;
1774 return -1;
1777 static int odigitval(int c)
1779 if (c >= '0' && c <= '7')
1780 return c - '0';
1781 return -1;
1784 /* Perform Tcl escape substitution of 's', storing the result
1785 * string into 'dest'. The escaped string is guaranteed to
1786 * be the same length or shorted than the source string.
1787 * Slen is the length of the string at 's', if it's -1 the string
1788 * length will be calculated by the function.
1790 * The function returns the length of the resulting string. */
1791 static int JimEscape(char *dest, const char *s, int slen)
1793 char *p = dest;
1794 int i, len;
1796 if (slen == -1)
1797 slen = strlen(s);
1799 for (i = 0; i < slen; i++) {
1800 switch (s[i]) {
1801 case '\\':
1802 switch (s[i + 1]) {
1803 case 'a':
1804 *p++ = 0x7;
1805 i++;
1806 break;
1807 case 'b':
1808 *p++ = 0x8;
1809 i++;
1810 break;
1811 case 'f':
1812 *p++ = 0xc;
1813 i++;
1814 break;
1815 case 'n':
1816 *p++ = 0xa;
1817 i++;
1818 break;
1819 case 'r':
1820 *p++ = 0xd;
1821 i++;
1822 break;
1823 case 't':
1824 *p++ = 0x9;
1825 i++;
1826 break;
1827 case 'u':
1828 case 'U':
1829 case 'x':
1830 /* A unicode or hex sequence.
1831 * \x Expect 1-2 hex chars and convert to hex.
1832 * \u Expect 1-4 hex chars and convert to utf-8.
1833 * \U Expect 1-8 hex chars and convert to utf-8.
1834 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1835 * An invalid sequence means simply the escaped char.
1838 unsigned val = 0;
1839 int k;
1840 int maxchars = 2;
1842 i++;
1844 if (s[i] == 'U') {
1845 maxchars = 8;
1847 else if (s[i] == 'u') {
1848 if (s[i + 1] == '{') {
1849 maxchars = 6;
1850 i++;
1852 else {
1853 maxchars = 4;
1857 for (k = 0; k < maxchars; k++) {
1858 int c = xdigitval(s[i + k + 1]);
1859 if (c == -1) {
1860 break;
1862 val = (val << 4) | c;
1864 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1865 if (s[i] == '{') {
1866 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1867 /* Back up */
1868 i--;
1869 k = 0;
1871 else {
1872 /* Skip the closing brace */
1873 k++;
1876 if (k) {
1877 /* Got a valid sequence, so convert */
1878 if (s[i] == 'x') {
1879 *p++ = val;
1881 else {
1882 p += utf8_fromunicode(p, val);
1884 i += k;
1885 break;
1887 /* Not a valid codepoint, just an escaped char */
1888 *p++ = s[i];
1890 break;
1891 case 'v':
1892 *p++ = 0xb;
1893 i++;
1894 break;
1895 case '\0':
1896 *p++ = '\\';
1897 i++;
1898 break;
1899 case '\n':
1900 /* Replace all spaces and tabs after backslash newline with a single space*/
1901 *p++ = ' ';
1902 do {
1903 i++;
1904 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1905 break;
1906 case '0':
1907 case '1':
1908 case '2':
1909 case '3':
1910 case '4':
1911 case '5':
1912 case '6':
1913 case '7':
1914 /* octal escape */
1916 int val = 0;
1917 int c = odigitval(s[i + 1]);
1919 val = c;
1920 c = odigitval(s[i + 2]);
1921 if (c == -1) {
1922 *p++ = val;
1923 i++;
1924 break;
1926 val = (val * 8) + c;
1927 c = odigitval(s[i + 3]);
1928 if (c == -1) {
1929 *p++ = val;
1930 i += 2;
1931 break;
1933 val = (val * 8) + c;
1934 *p++ = val;
1935 i += 3;
1937 break;
1938 default:
1939 *p++ = s[i + 1];
1940 i++;
1941 break;
1943 break;
1944 default:
1945 *p++ = s[i];
1946 break;
1949 len = p - dest;
1950 *p = '\0';
1951 return len;
1954 /* Returns a dynamically allocated copy of the current token in the
1955 * parser context. The function performs conversion of escapes if
1956 * the token is of type JIM_TT_ESC.
1958 * Note that after the conversion, tokens that are grouped with
1959 * braces in the source code, are always recognizable from the
1960 * identical string obtained in a different way from the type.
1962 * For example the string:
1964 * {*}$a
1966 * will return as first token "*", of type JIM_TT_STR
1968 * While the string:
1970 * *$a
1972 * will return as first token "*", of type JIM_TT_ESC
1974 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1976 const char *start, *end;
1977 char *token;
1978 int len;
1980 start = pc->tstart;
1981 end = pc->tend;
1982 if (start > end) {
1983 len = 0;
1984 token = Jim_Alloc(1);
1985 token[0] = '\0';
1987 else {
1988 len = (end - start) + 1;
1989 token = Jim_Alloc(len + 1);
1990 if (pc->tt != JIM_TT_ESC) {
1991 /* No escape conversion needed? Just copy it. */
1992 memcpy(token, start, len);
1993 token[len] = '\0';
1995 else {
1996 /* Else convert the escape chars. */
1997 len = JimEscape(token, start, len);
2001 return Jim_NewStringObjNoAlloc(interp, token, len);
2004 /* Parses the given string to determine if it represents a complete script.
2006 * This is useful for interactive shells implementation, for [info complete].
2008 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2009 * '{' on scripts incomplete missing one or more '}' to be balanced.
2010 * '[' on scripts incomplete missing one or more ']' to be balanced.
2011 * '"' on scripts incomplete missing a '"' char.
2012 * '\\' on scripts with a trailing backslash.
2014 * If the script is complete, 1 is returned, otherwise 0.
2016 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2018 struct JimParserCtx parser;
2020 JimParserInit(&parser, s, len, 1);
2021 while (!parser.eof) {
2022 JimParseScript(&parser);
2024 if (stateCharPtr) {
2025 *stateCharPtr = parser.missing.ch;
2027 return parser.missing.ch == ' ';
2030 /* -----------------------------------------------------------------------------
2031 * Tcl Lists parsing
2032 * ---------------------------------------------------------------------------*/
2033 static int JimParseListSep(struct JimParserCtx *pc);
2034 static int JimParseListStr(struct JimParserCtx *pc);
2035 static int JimParseListQuote(struct JimParserCtx *pc);
2037 static int JimParseList(struct JimParserCtx *pc)
2039 if (isspace(UCHAR(*pc->p))) {
2040 return JimParseListSep(pc);
2042 switch (*pc->p) {
2043 case '"':
2044 return JimParseListQuote(pc);
2046 case '{':
2047 return JimParseBrace(pc);
2049 default:
2050 if (pc->len) {
2051 return JimParseListStr(pc);
2053 break;
2056 pc->tstart = pc->tend = pc->p;
2057 pc->tline = pc->linenr;
2058 pc->tt = JIM_TT_EOL;
2059 pc->eof = 1;
2060 return JIM_OK;
2063 static int JimParseListSep(struct JimParserCtx *pc)
2065 pc->tstart = pc->p;
2066 pc->tline = pc->linenr;
2067 while (isspace(UCHAR(*pc->p))) {
2068 if (*pc->p == '\n') {
2069 pc->linenr++;
2071 pc->p++;
2072 pc->len--;
2074 pc->tend = pc->p - 1;
2075 pc->tt = JIM_TT_SEP;
2076 return JIM_OK;
2079 static int JimParseListQuote(struct JimParserCtx *pc)
2081 pc->p++;
2082 pc->len--;
2084 pc->tstart = pc->p;
2085 pc->tline = pc->linenr;
2086 pc->tt = JIM_TT_STR;
2088 while (pc->len) {
2089 switch (*pc->p) {
2090 case '\\':
2091 pc->tt = JIM_TT_ESC;
2092 if (--pc->len == 0) {
2093 /* Trailing backslash */
2094 pc->tend = pc->p;
2095 return JIM_OK;
2097 pc->p++;
2098 break;
2099 case '\n':
2100 pc->linenr++;
2101 break;
2102 case '"':
2103 pc->tend = pc->p - 1;
2104 pc->p++;
2105 pc->len--;
2106 return JIM_OK;
2108 pc->p++;
2109 pc->len--;
2112 pc->tend = pc->p - 1;
2113 return JIM_OK;
2116 static int JimParseListStr(struct JimParserCtx *pc)
2118 pc->tstart = pc->p;
2119 pc->tline = pc->linenr;
2120 pc->tt = JIM_TT_STR;
2122 while (pc->len) {
2123 if (isspace(UCHAR(*pc->p))) {
2124 pc->tend = pc->p - 1;
2125 return JIM_OK;
2127 if (*pc->p == '\\') {
2128 if (--pc->len == 0) {
2129 /* Trailing backslash */
2130 pc->tend = pc->p;
2131 return JIM_OK;
2133 pc->tt = JIM_TT_ESC;
2134 pc->p++;
2136 pc->p++;
2137 pc->len--;
2139 pc->tend = pc->p - 1;
2140 return JIM_OK;
2143 /* -----------------------------------------------------------------------------
2144 * Jim_Obj related functions
2145 * ---------------------------------------------------------------------------*/
2147 /* Return a new initialized object. */
2148 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2150 Jim_Obj *objPtr;
2152 /* -- Check if there are objects in the free list -- */
2153 if (interp->freeList != NULL) {
2154 /* -- Unlink the object from the free list -- */
2155 objPtr = interp->freeList;
2156 interp->freeList = objPtr->nextObjPtr;
2158 else {
2159 /* -- No ready to use objects: allocate a new one -- */
2160 objPtr = Jim_Alloc(sizeof(*objPtr));
2163 /* Object is returned with refCount of 0. Every
2164 * kind of GC implemented should take care to don't try
2165 * to scan objects with refCount == 0. */
2166 objPtr->refCount = 0;
2167 /* All the other fields are left not initialized to save time.
2168 * The caller will probably want to set them to the right
2169 * value anyway. */
2171 /* -- Put the object into the live list -- */
2172 objPtr->prevObjPtr = NULL;
2173 objPtr->nextObjPtr = interp->liveList;
2174 if (interp->liveList)
2175 interp->liveList->prevObjPtr = objPtr;
2176 interp->liveList = objPtr;
2178 return objPtr;
2181 /* Free an object. Actually objects are never freed, but
2182 * just moved to the free objects list, where they will be
2183 * reused by Jim_NewObj(). */
2184 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2186 /* Check if the object was already freed, panic. */
2187 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2188 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2190 /* Free the internal representation */
2191 Jim_FreeIntRep(interp, objPtr);
2192 /* Free the string representation */
2193 if (objPtr->bytes != NULL) {
2194 if (objPtr->bytes != JimEmptyStringRep)
2195 Jim_Free(objPtr->bytes);
2197 /* Unlink the object from the live objects list */
2198 if (objPtr->prevObjPtr)
2199 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2200 if (objPtr->nextObjPtr)
2201 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2202 if (interp->liveList == objPtr)
2203 interp->liveList = objPtr->nextObjPtr;
2204 #ifdef JIM_DISABLE_OBJECT_POOL
2205 Jim_Free(objPtr);
2206 #else
2207 /* Link the object into the free objects list */
2208 objPtr->prevObjPtr = NULL;
2209 objPtr->nextObjPtr = interp->freeList;
2210 if (interp->freeList)
2211 interp->freeList->prevObjPtr = objPtr;
2212 interp->freeList = objPtr;
2213 objPtr->refCount = -1;
2214 #endif
2217 /* Invalidate the string representation of an object. */
2218 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2220 if (objPtr->bytes != NULL) {
2221 if (objPtr->bytes != JimEmptyStringRep)
2222 Jim_Free(objPtr->bytes);
2224 objPtr->bytes = NULL;
2227 /* Duplicate an object. The returned object has refcount = 0. */
2228 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2230 Jim_Obj *dupPtr;
2232 dupPtr = Jim_NewObj(interp);
2233 if (objPtr->bytes == NULL) {
2234 /* Object does not have a valid string representation. */
2235 dupPtr->bytes = NULL;
2237 else if (objPtr->length == 0) {
2238 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2239 dupPtr->bytes = JimEmptyStringRep;
2240 dupPtr->length = 0;
2241 dupPtr->typePtr = NULL;
2242 return dupPtr;
2244 else {
2245 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2246 dupPtr->length = objPtr->length;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr->typePtr = objPtr->typePtr;
2253 if (objPtr->typePtr != NULL) {
2254 if (objPtr->typePtr->dupIntRepProc == NULL) {
2255 dupPtr->internalRep = objPtr->internalRep;
2257 else {
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2262 return dupPtr;
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2271 if (objPtr->bytes == NULL) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2274 objPtr->typePtr->updateStringProc(objPtr);
2276 if (lenPtr)
2277 *lenPtr = objPtr->length;
2278 return objPtr->bytes;
2281 /* Just returns the length of the object's string rep */
2282 int Jim_Length(Jim_Obj *objPtr)
2284 if (objPtr->bytes == NULL) {
2285 /* Invalid string repr. Generate it. */
2286 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2287 objPtr->typePtr->updateStringProc(objPtr);
2289 return objPtr->length;
2292 /* Just returns 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 void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3192 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3194 static const Jim_ObjType scriptObjType = {
3195 "script",
3196 FreeScriptInternalRep,
3197 DupScriptInternalRep,
3198 NULL,
3199 JIM_TYPE_REFERENCES,
3202 /* Each token of a script is represented by a ScriptToken.
3203 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3204 * can be specialized by commands operating on it.
3206 typedef struct ScriptToken
3208 Jim_Obj *objPtr;
3209 int type;
3210 } ScriptToken;
3212 /* This is the script object internal representation. An array of
3213 * ScriptToken structures, including a pre-computed representation of the
3214 * command length and arguments.
3216 * For example the script:
3218 * puts hello
3219 * set $i $x$y [foo]BAR
3221 * will produce a ScriptObj with the following ScriptToken's:
3223 * LIN 2
3224 * ESC puts
3225 * ESC hello
3226 * LIN 4
3227 * ESC set
3228 * VAR i
3229 * WRD 2
3230 * VAR x
3231 * VAR y
3232 * WRD 2
3233 * CMD foo
3234 * ESC BAR
3236 * "puts hello" has two args (LIN 2), composed of single tokens.
3237 * (Note that the WRD token is omitted for the common case of a single token.)
3239 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3240 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3242 * The precomputation of the command structure makes Jim_Eval() faster,
3243 * and simpler because there aren't dynamic lengths / allocations.
3245 * -- {expand}/{*} handling --
3247 * Expand is handled in a special way.
3249 * If a "word" begins with {*}, the word token count is -ve.
3251 * For example the command:
3253 * list {*}{a b}
3255 * Will produce the following cmdstruct array:
3257 * LIN 2
3258 * ESC list
3259 * WRD -1
3260 * STR a b
3262 * Note that the 'LIN' token also contains the source information for the
3263 * first word of the line for error reporting purposes
3265 * -- the substFlags field of the structure --
3267 * The scriptObj structure is used to represent both "script" objects
3268 * and "subst" objects. In the second case, the there are no LIN and WRD
3269 * tokens. Instead SEP and EOL tokens are added as-is.
3270 * In addition, the field 'substFlags' is used to represent the flags used to turn
3271 * the string into the internal representation.
3272 * If these flags do not match what the application requires,
3273 * the scriptObj is created again. For example the script:
3275 * subst -nocommands $string
3276 * subst -novariables $string
3278 * Will (re)create the internal representation of the $string object
3279 * two times.
3281 typedef struct ScriptObj
3283 ScriptToken *token; /* Tokens array. */
3284 Jim_Obj *fileNameObj; /* Filename */
3285 int len; /* Length of token[] */
3286 int substFlags; /* flags used for the compilation of "subst" objects */
3287 int inUse; /* Used to share a ScriptObj. Currently
3288 only used by Jim_EvalObj() as protection against
3289 shimmering of the currently evaluated object. */
3290 int firstline; /* Line number of the first line */
3291 int linenr; /* Error line number, if any */
3292 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3293 } ScriptObj;
3295 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3297 int i;
3298 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3300 if (--script->inUse != 0)
3301 return;
3302 for (i = 0; i < script->len; i++) {
3303 Jim_DecrRefCount(interp, script->token[i].objPtr);
3305 Jim_Free(script->token);
3306 Jim_DecrRefCount(interp, script->fileNameObj);
3307 Jim_Free(script);
3310 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3312 JIM_NOTUSED(interp);
3313 JIM_NOTUSED(srcPtr);
3315 /* Just return a simple string. We don't try to preserve the source info
3316 * since in practice scripts are never duplicated
3318 dupPtr->typePtr = NULL;
3321 /* A simple parse token.
3322 * As the script is parsed, the created tokens point into the script string rep.
3324 typedef struct
3326 const char *token; /* Pointer to the start of the token */
3327 int len; /* Length of this token */
3328 int type; /* Token type */
3329 int line; /* Line number */
3330 } ParseToken;
3332 /* A list of parsed tokens representing a script.
3333 * Tokens are added to this list as the script is parsed.
3334 * It grows as needed.
3336 typedef struct
3338 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3339 ParseToken *list; /* Array of tokens */
3340 int size; /* Current size of the list */
3341 int count; /* Number of entries used */
3342 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3343 } ParseTokenList;
3345 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3347 tokenlist->list = tokenlist->static_list;
3348 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3349 tokenlist->count = 0;
3352 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3354 if (tokenlist->list != tokenlist->static_list) {
3355 Jim_Free(tokenlist->list);
3360 * Adds the new token to the tokenlist.
3361 * The token has the given length, type and line number.
3362 * The token list is resized as necessary.
3364 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3365 int line)
3367 ParseToken *t;
3369 if (tokenlist->count == tokenlist->size) {
3370 /* Resize the list */
3371 tokenlist->size *= 2;
3372 if (tokenlist->list != tokenlist->static_list) {
3373 tokenlist->list =
3374 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3376 else {
3377 /* The list needs to become allocated */
3378 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3379 memcpy(tokenlist->list, tokenlist->static_list,
3380 tokenlist->count * sizeof(*tokenlist->list));
3383 t = &tokenlist->list[tokenlist->count++];
3384 t->token = token;
3385 t->len = len;
3386 t->type = type;
3387 t->line = line;
3390 /* Counts the number of adjoining non-separator tokens.
3392 * Returns -ve if the first token is the expansion
3393 * operator (in which case the count doesn't include
3394 * that token).
3396 static int JimCountWordTokens(ParseToken *t)
3398 int expand = 1;
3399 int count = 0;
3401 /* Is the first word {*} or {expand}? */
3402 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3403 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3404 /* Create an expand token */
3405 expand = -1;
3406 t++;
3410 /* Now count non-separator words */
3411 while (!TOKEN_IS_SEP(t->type)) {
3412 t++;
3413 count++;
3416 return count * expand;
3420 * Create a script/subst object from the given token.
3422 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3424 Jim_Obj *objPtr;
3426 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3427 /* Convert backlash escapes. The result will never be longer than the original */
3428 int len = t->len;
3429 char *str = Jim_Alloc(len + 1);
3430 len = JimEscape(str, t->token, len);
3431 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3433 else {
3434 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3435 * with a single space.
3437 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3439 return objPtr;
3443 * Takes a tokenlist and creates the allocated list of script tokens
3444 * in script->token, of length script->len.
3446 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3447 * as required.
3449 * Also sets script->line to the line number of the first token
3451 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3452 ParseTokenList *tokenlist)
3454 int i;
3455 struct ScriptToken *token;
3456 /* Number of tokens so far for the current command */
3457 int lineargs = 0;
3458 /* This is the first token for the current command */
3459 ScriptToken *linefirst;
3460 int count;
3461 int linenr;
3463 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3464 printf("==== Tokens ====\n");
3465 for (i = 0; i < tokenlist->count; i++) {
3466 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3467 tokenlist->list[i].len, tokenlist->list[i].token);
3469 #endif
3471 /* May need up to one extra script token for each EOL in the worst case */
3472 count = tokenlist->count;
3473 for (i = 0; i < tokenlist->count; i++) {
3474 if (tokenlist->list[i].type == JIM_TT_EOL) {
3475 count++;
3478 linenr = script->firstline = tokenlist->list[0].line;
3480 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3482 /* This is the first token for the current command */
3483 linefirst = token++;
3485 for (i = 0; i < tokenlist->count; ) {
3486 /* Look ahead to find out how many tokens make up the next word */
3487 int wordtokens;
3489 /* Skip any leading separators */
3490 while (tokenlist->list[i].type == JIM_TT_SEP) {
3491 i++;
3494 wordtokens = JimCountWordTokens(tokenlist->list + i);
3496 if (wordtokens == 0) {
3497 /* None, so at end of line */
3498 if (lineargs) {
3499 linefirst->type = JIM_TT_LINE;
3500 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3501 Jim_IncrRefCount(linefirst->objPtr);
3503 /* Reset for new line */
3504 lineargs = 0;
3505 linefirst = token++;
3507 i++;
3508 continue;
3510 else if (wordtokens != 1) {
3511 /* More than 1, or {*}, so insert a WORD token */
3512 token->type = JIM_TT_WORD;
3513 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3514 Jim_IncrRefCount(token->objPtr);
3515 token++;
3516 if (wordtokens < 0) {
3517 /* Skip the expand token */
3518 i++;
3519 wordtokens = -wordtokens - 1;
3520 lineargs--;
3524 if (lineargs == 0) {
3525 /* First real token on the line, so record the line number */
3526 linenr = tokenlist->list[i].line;
3528 lineargs++;
3530 /* Add each non-separator word token to the line */
3531 while (wordtokens--) {
3532 const ParseToken *t = &tokenlist->list[i++];
3534 token->type = t->type;
3535 token->objPtr = JimMakeScriptObj(interp, t);
3536 Jim_IncrRefCount(token->objPtr);
3538 /* Every object is initially a string of type 'source', but the
3539 * internal type may be specialized during execution of the
3540 * script. */
3541 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3542 token++;
3546 if (lineargs == 0) {
3547 token--;
3550 script->len = token - script->token;
3552 JimPanic((script->len >= count, "allocated script array is too short"));
3554 #ifdef DEBUG_SHOW_SCRIPT
3555 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3556 for (i = 0; i < script->len; i++) {
3557 const ScriptToken *t = &script->token[i];
3558 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3560 #endif
3565 * Sets an appropriate error message for a missing script/expression terminator.
3567 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3569 * Note that a trailing backslash is not considered to be an error.
3571 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3573 const char *msg;
3575 switch (ch) {
3576 case '\\':
3577 case ' ':
3578 return JIM_OK;
3580 case '[':
3581 msg = "unmatched \"[\"";
3582 break;
3583 case '{':
3584 msg = "missing close-brace";
3585 break;
3586 case '"':
3587 default:
3588 msg = "missing quote";
3589 break;
3592 Jim_SetResultString(interp, msg, -1);
3593 return JIM_ERR;
3597 * Similar to ScriptObjAddTokens(), but for subst objects.
3599 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3600 ParseTokenList *tokenlist)
3602 int i;
3603 struct ScriptToken *token;
3605 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3607 for (i = 0; i < tokenlist->count; i++) {
3608 const ParseToken *t = &tokenlist->list[i];
3610 /* Create a token for 't' */
3611 token->type = t->type;
3612 token->objPtr = JimMakeScriptObj(interp, t);
3613 Jim_IncrRefCount(token->objPtr);
3614 token++;
3617 script->len = i;
3620 /* This method takes the string representation of an object
3621 * as a Tcl script, and generates the pre-parsed internal representation
3622 * of the script.
3624 * On parse error, sets an error message and returns JIM_ERR
3625 * (Note: the object is still converted to a script, even if an error occurs)
3627 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3629 int scriptTextLen;
3630 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3631 struct JimParserCtx parser;
3632 struct ScriptObj *script;
3633 ParseTokenList tokenlist;
3634 int line = 1;
3636 /* Try to get information about filename / line number */
3637 if (objPtr->typePtr == &sourceObjType) {
3638 line = objPtr->internalRep.sourceValue.lineNumber;
3641 /* Initially parse the script into tokens (in tokenlist) */
3642 ScriptTokenListInit(&tokenlist);
3644 JimParserInit(&parser, scriptText, scriptTextLen, line);
3645 while (!parser.eof) {
3646 JimParseScript(&parser);
3647 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3648 parser.tline);
3651 /* Add a final EOF token */
3652 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3654 /* Create the "real" script tokens from the parsed tokens */
3655 script = Jim_Alloc(sizeof(*script));
3656 memset(script, 0, sizeof(*script));
3657 script->inUse = 1;
3658 if (objPtr->typePtr == &sourceObjType) {
3659 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3661 else {
3662 script->fileNameObj = interp->emptyObj;
3664 Jim_IncrRefCount(script->fileNameObj);
3665 script->missing = parser.missing.ch;
3666 script->linenr = parser.missing.line;
3668 ScriptObjAddTokens(interp, script, &tokenlist);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp, objPtr);
3675 Jim_SetIntRepPtr(objPtr, script);
3676 objPtr->typePtr = &scriptObjType;
3679 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3682 * Returns the parsed script.
3683 * Note that if there is any possibility that the script is not valid,
3684 * call JimScriptValid() to check
3686 ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3688 if (objPtr == interp->emptyObj) {
3689 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3690 objPtr = interp->nullScriptObj;
3693 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3694 JimSetScriptFromAny(interp, objPtr);
3697 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3701 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3702 * and leaves an error message in the interp result.
3705 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3707 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3708 JimAddErrorToStack(interp, script);
3709 return 0;
3711 return 1;
3715 /* -----------------------------------------------------------------------------
3716 * Commands
3717 * ---------------------------------------------------------------------------*/
3718 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3720 cmdPtr->inUse++;
3723 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3725 if (--cmdPtr->inUse == 0) {
3726 if (cmdPtr->isproc) {
3727 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3728 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3729 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3730 if (cmdPtr->u.proc.staticVars) {
3731 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3732 Jim_Free(cmdPtr->u.proc.staticVars);
3735 else {
3736 /* native (C) */
3737 if (cmdPtr->u.native.delProc) {
3738 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3741 if (cmdPtr->prevCmd) {
3742 /* Delete any pushed command too */
3743 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3745 Jim_Free(cmdPtr);
3749 /* Variables HashTable Type.
3751 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3754 /* Variables HashTable Type.
3756 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3757 static void JimVariablesHTValDestructor(void *interp, void *val)
3759 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3760 Jim_Free(val);
3763 static const Jim_HashTableType JimVariablesHashTableType = {
3764 JimStringCopyHTHashFunction, /* hash function */
3765 JimStringCopyHTDup, /* key dup */
3766 NULL, /* val dup */
3767 JimStringCopyHTKeyCompare, /* key compare */
3768 JimStringCopyHTKeyDestructor, /* key destructor */
3769 JimVariablesHTValDestructor /* val destructor */
3772 /* Commands HashTable Type.
3774 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3776 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3778 JimDecrCmdRefCount(interp, val);
3781 static const Jim_HashTableType JimCommandsHashTableType = {
3782 JimStringCopyHTHashFunction, /* hash function */
3783 JimStringCopyHTDup, /* key dup */
3784 NULL, /* val dup */
3785 JimStringCopyHTKeyCompare, /* key compare */
3786 JimStringCopyHTKeyDestructor, /* key destructor */
3787 JimCommandsHT_ValDestructor /* val destructor */
3790 /* ------------------------- Commands related functions --------------------- */
3792 #ifdef jim_ext_namespace
3794 * Returns the "unscoped" version of the given namespace.
3795 * That is, the fully qualfied name without the leading ::
3796 * The returned value is either nsObj, or an object with a zero ref count.
3798 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3800 const char *name = Jim_String(nsObj);
3801 if (name[0] == ':' && name[1] == ':') {
3802 /* This command is being defined in the global namespace */
3803 while (*++name == ':') {
3805 nsObj = Jim_NewStringObj(interp, name, -1);
3807 else if (Jim_Length(interp->framePtr->nsObj)) {
3808 /* This command is being defined in a non-global namespace */
3809 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3810 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3812 return nsObj;
3815 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3817 Jim_Obj *resultObj;
3819 const char *name = Jim_String(nameObjPtr);
3820 if (name[0] == ':' && name[1] == ':') {
3821 return nameObjPtr;
3823 Jim_IncrRefCount(nameObjPtr);
3824 resultObj = Jim_NewStringObj(interp, "::", -1);
3825 Jim_AppendObj(interp, resultObj, nameObjPtr);
3826 Jim_DecrRefCount(interp, nameObjPtr);
3828 return resultObj;
3832 * An efficient version of JimQualifyNameObj() where the name is
3833 * available (and needed) as a 'const char *'.
3834 * Avoids creating an object if not necessary.
3835 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3837 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3839 Jim_Obj *objPtr = interp->emptyObj;
3841 if (name[0] == ':' && name[1] == ':') {
3842 /* This command is being defined in the global namespace */
3843 while (*++name == ':') {
3846 else if (Jim_Length(interp->framePtr->nsObj)) {
3847 /* This command is being defined in a non-global namespace */
3848 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3849 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3850 name = Jim_String(objPtr);
3852 Jim_IncrRefCount(objPtr);
3853 *objPtrPtr = objPtr;
3854 return name;
3857 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3859 #else
3860 /* We can be more efficient in the no-namespace case */
3861 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3862 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3864 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3866 return nameObjPtr;
3868 #endif
3870 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3872 /* It may already exist, so we try to delete the old one.
3873 * Note that reference count means that it won't be deleted yet if
3874 * it exists in the call stack.
3876 * BUT, if 'local' is in force, instead of deleting the existing
3877 * proc, we stash a reference to the old proc here.
3879 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3880 if (he) {
3881 /* There was an old cmd with the same name,
3882 * so this requires a 'proc epoch' update. */
3884 /* If a procedure with the same name didn't exist there is no need
3885 * to increment the 'proc epoch' because creation of a new procedure
3886 * can never affect existing cached commands. We don't do
3887 * negative caching. */
3888 Jim_InterpIncrProcEpoch(interp);
3891 if (he && interp->local) {
3892 /* Push this command over the top of the previous one */
3893 cmd->prevCmd = Jim_GetHashEntryVal(he);
3894 Jim_SetHashVal(&interp->commands, he, cmd);
3896 else {
3897 if (he) {
3898 /* Replace the existing command */
3899 Jim_DeleteHashEntry(&interp->commands, name);
3902 Jim_AddHashEntry(&interp->commands, name, cmd);
3904 return JIM_OK;
3908 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3909 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3911 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3913 /* Store the new details for this command */
3914 memset(cmdPtr, 0, sizeof(*cmdPtr));
3915 cmdPtr->inUse = 1;
3916 cmdPtr->u.native.delProc = delProc;
3917 cmdPtr->u.native.cmdProc = cmdProc;
3918 cmdPtr->u.native.privData = privData;
3920 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3922 return JIM_OK;
3925 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3927 int len, i;
3929 len = Jim_ListLength(interp, staticsListObjPtr);
3930 if (len == 0) {
3931 return JIM_OK;
3934 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3935 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3936 for (i = 0; i < len; i++) {
3937 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3938 Jim_Var *varPtr;
3939 int subLen;
3941 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3942 /* Check if it's composed of two elements. */
3943 subLen = Jim_ListLength(interp, objPtr);
3944 if (subLen == 1 || subLen == 2) {
3945 /* Try to get the variable value from the current
3946 * environment. */
3947 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3948 if (subLen == 1) {
3949 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3950 if (initObjPtr == NULL) {
3951 Jim_SetResultFormatted(interp,
3952 "variable for initialization of static \"%#s\" not found in the local context",
3953 nameObjPtr);
3954 return JIM_ERR;
3957 else {
3958 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3960 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3961 return JIM_ERR;
3964 varPtr = Jim_Alloc(sizeof(*varPtr));
3965 varPtr->objPtr = initObjPtr;
3966 Jim_IncrRefCount(initObjPtr);
3967 varPtr->linkFramePtr = NULL;
3968 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3969 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3970 Jim_SetResultFormatted(interp,
3971 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3972 Jim_DecrRefCount(interp, initObjPtr);
3973 Jim_Free(varPtr);
3974 return JIM_ERR;
3977 else {
3978 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3979 objPtr);
3980 return JIM_ERR;
3983 return JIM_OK;
3986 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3988 #ifdef jim_ext_namespace
3989 if (cmdPtr->isproc) {
3990 /* XXX: Really need JimNamespaceSplit() */
3991 const char *pt = strrchr(cmdname, ':');
3992 if (pt && pt != cmdname && pt[-1] == ':') {
3993 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3994 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3995 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3997 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3998 /* This commands shadows a global command, so a proc epoch update is required */
3999 Jim_InterpIncrProcEpoch(interp);
4003 #endif
4006 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4007 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4009 Jim_Cmd *cmdPtr;
4010 int argListLen;
4011 int i;
4013 argListLen = Jim_ListLength(interp, argListObjPtr);
4015 /* Allocate space for both the command pointer and the arg list */
4016 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4017 memset(cmdPtr, 0, sizeof(*cmdPtr));
4018 cmdPtr->inUse = 1;
4019 cmdPtr->isproc = 1;
4020 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4021 cmdPtr->u.proc.argListLen = argListLen;
4022 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4023 cmdPtr->u.proc.argsPos = -1;
4024 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4025 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4026 Jim_IncrRefCount(argListObjPtr);
4027 Jim_IncrRefCount(bodyObjPtr);
4028 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4030 /* Create the statics hash table. */
4031 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4032 goto err;
4035 /* Parse the args out into arglist, validating as we go */
4036 /* Examine the argument list for default parameters and 'args' */
4037 for (i = 0; i < argListLen; i++) {
4038 Jim_Obj *argPtr;
4039 Jim_Obj *nameObjPtr;
4040 Jim_Obj *defaultObjPtr;
4041 int len;
4043 /* Examine a parameter */
4044 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4045 len = Jim_ListLength(interp, argPtr);
4046 if (len == 0) {
4047 Jim_SetResultString(interp, "argument with no name", -1);
4048 err:
4049 JimDecrCmdRefCount(interp, cmdPtr);
4050 return NULL;
4052 if (len > 2) {
4053 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4054 goto err;
4057 if (len == 2) {
4058 /* Optional parameter */
4059 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4060 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4062 else {
4063 /* Required parameter */
4064 nameObjPtr = argPtr;
4065 defaultObjPtr = NULL;
4069 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4070 if (cmdPtr->u.proc.argsPos >= 0) {
4071 Jim_SetResultString(interp, "'args' specified more than once", -1);
4072 goto err;
4074 cmdPtr->u.proc.argsPos = i;
4076 else {
4077 if (len == 2) {
4078 cmdPtr->u.proc.optArity++;
4080 else {
4081 cmdPtr->u.proc.reqArity++;
4085 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4086 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4089 return cmdPtr;
4092 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4094 int ret = JIM_OK;
4095 Jim_Obj *qualifiedNameObj;
4096 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4098 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4099 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4100 ret = JIM_ERR;
4102 else {
4103 Jim_InterpIncrProcEpoch(interp);
4106 JimFreeQualifiedName(interp, qualifiedNameObj);
4108 return ret;
4111 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4113 int ret = JIM_ERR;
4114 Jim_HashEntry *he;
4115 Jim_Cmd *cmdPtr;
4116 Jim_Obj *qualifiedOldNameObj;
4117 Jim_Obj *qualifiedNewNameObj;
4118 const char *fqold;
4119 const char *fqnew;
4121 if (newName[0] == 0) {
4122 return Jim_DeleteCommand(interp, oldName);
4125 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4126 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4128 /* Does it exist? */
4129 he = Jim_FindHashEntry(&interp->commands, fqold);
4130 if (he == NULL) {
4131 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4133 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4134 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4136 else {
4137 /* Add the new name first */
4138 cmdPtr = Jim_GetHashEntryVal(he);
4139 JimIncrCmdRefCount(cmdPtr);
4140 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4141 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4143 /* Now remove the old name */
4144 Jim_DeleteHashEntry(&interp->commands, fqold);
4146 /* Increment the epoch */
4147 Jim_InterpIncrProcEpoch(interp);
4149 ret = JIM_OK;
4152 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4153 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4155 return ret;
4158 /* -----------------------------------------------------------------------------
4159 * Command object
4160 * ---------------------------------------------------------------------------*/
4162 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4164 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4167 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4169 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4170 dupPtr->typePtr = srcPtr->typePtr;
4171 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4174 static const Jim_ObjType commandObjType = {
4175 "command",
4176 FreeCommandInternalRep,
4177 DupCommandInternalRep,
4178 NULL,
4179 JIM_TYPE_REFERENCES,
4182 /* This function returns the command structure for the command name
4183 * stored in objPtr. It tries to specialize the objPtr to contain
4184 * a cached info instead to perform the lookup into the hash table
4185 * every time. The information cached may not be uptodate, in such
4186 * a case the lookup is performed and the cache updated.
4188 * Respects the 'upcall' setting
4190 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4192 Jim_Cmd *cmd;
4194 /* In order to be valid, the proc epoch must match and
4195 * the lookup must have occurred in the same namespace
4197 if (objPtr->typePtr != &commandObjType ||
4198 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4199 #ifdef jim_ext_namespace
4200 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4201 #endif
4203 /* Not cached or out of date, so lookup */
4205 /* Do we need to try the local namespace? */
4206 const char *name = Jim_String(objPtr);
4207 Jim_HashEntry *he;
4209 if (name[0] == ':' && name[1] == ':') {
4210 while (*++name == ':') {
4213 #ifdef jim_ext_namespace
4214 else if (Jim_Length(interp->framePtr->nsObj)) {
4215 /* This command is being defined in a non-global namespace */
4216 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4217 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4218 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4219 Jim_FreeNewObj(interp, nameObj);
4220 if (he) {
4221 goto found;
4224 #endif
4226 /* Lookup in the global namespace */
4227 he = Jim_FindHashEntry(&interp->commands, name);
4228 if (he == NULL) {
4229 if (flags & JIM_ERRMSG) {
4230 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4232 return NULL;
4234 #ifdef jim_ext_namespace
4235 found:
4236 #endif
4237 cmd = Jim_GetHashEntryVal(he);
4239 /* Free the old internal repr and set the new one. */
4240 Jim_FreeIntRep(interp, objPtr);
4241 objPtr->typePtr = &commandObjType;
4242 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4243 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4244 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4245 Jim_IncrRefCount(interp->framePtr->nsObj);
4247 else {
4248 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4250 while (cmd->u.proc.upcall) {
4251 cmd = cmd->prevCmd;
4253 return cmd;
4256 /* -----------------------------------------------------------------------------
4257 * Variables
4258 * ---------------------------------------------------------------------------*/
4260 /* -----------------------------------------------------------------------------
4261 * Variable object
4262 * ---------------------------------------------------------------------------*/
4264 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4266 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4268 static const Jim_ObjType variableObjType = {
4269 "variable",
4270 NULL,
4271 NULL,
4272 NULL,
4273 JIM_TYPE_REFERENCES,
4277 * Check that the name does not contain embedded nulls.
4279 * Variable and procedure names are maniplated as null terminated strings, so
4280 * don't allow names with embedded nulls.
4282 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4284 /* Variable names and proc names can't contain embedded nulls */
4285 if (nameObjPtr->typePtr != &variableObjType) {
4286 int len;
4287 const char *str = Jim_GetString(nameObjPtr, &len);
4288 if (memchr(str, '\0', len)) {
4289 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4290 return JIM_ERR;
4293 return JIM_OK;
4296 /* This method should be called only by the variable API.
4297 * It returns JIM_OK on success (variable already exists),
4298 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4299 * a variable name, but syntax glue for [dict] i.e. the last
4300 * character is ')' */
4301 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4303 const char *varName;
4304 Jim_CallFrame *framePtr;
4305 Jim_HashEntry *he;
4306 int global;
4307 int len;
4309 /* Check if the object is already an uptodate variable */
4310 if (objPtr->typePtr == &variableObjType) {
4311 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4312 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4313 /* nothing to do */
4314 return JIM_OK;
4316 /* Need to re-resolve the variable in the updated callframe */
4318 else if (objPtr->typePtr == &dictSubstObjType) {
4319 return JIM_DICT_SUGAR;
4321 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4322 return JIM_ERR;
4326 varName = Jim_GetString(objPtr, &len);
4328 /* Make sure it's not syntax glue to get/set dict. */
4329 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4330 return JIM_DICT_SUGAR;
4333 if (varName[0] == ':' && varName[1] == ':') {
4334 while (*++varName == ':') {
4336 global = 1;
4337 framePtr = interp->topFramePtr;
4339 else {
4340 global = 0;
4341 framePtr = interp->framePtr;
4344 /* Resolve this name in the variables hash table */
4345 he = Jim_FindHashEntry(&framePtr->vars, varName);
4346 if (he == NULL) {
4347 if (!global && framePtr->staticVars) {
4348 /* Try with static vars. */
4349 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4351 if (he == NULL) {
4352 return JIM_ERR;
4356 /* Free the old internal repr and set the new one. */
4357 Jim_FreeIntRep(interp, objPtr);
4358 objPtr->typePtr = &variableObjType;
4359 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4360 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4361 objPtr->internalRep.varValue.global = global;
4362 return JIM_OK;
4365 /* -------------------- Variables related functions ------------------------- */
4366 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4367 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4369 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4371 const char *name;
4372 Jim_CallFrame *framePtr;
4373 int global;
4375 /* New variable to create */
4376 Jim_Var *var = Jim_Alloc(sizeof(*var));
4378 var->objPtr = valObjPtr;
4379 Jim_IncrRefCount(valObjPtr);
4380 var->linkFramePtr = NULL;
4382 name = Jim_String(nameObjPtr);
4383 if (name[0] == ':' && name[1] == ':') {
4384 while (*++name == ':') {
4386 framePtr = interp->topFramePtr;
4387 global = 1;
4389 else {
4390 framePtr = interp->framePtr;
4391 global = 0;
4394 /* Insert the new variable */
4395 Jim_AddHashEntry(&framePtr->vars, name, var);
4397 /* Make the object int rep a variable */
4398 Jim_FreeIntRep(interp, nameObjPtr);
4399 nameObjPtr->typePtr = &variableObjType;
4400 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4401 nameObjPtr->internalRep.varValue.varPtr = var;
4402 nameObjPtr->internalRep.varValue.global = global;
4404 return var;
4407 /* For now that's dummy. Variables lookup should be optimized
4408 * in many ways, with caching of lookups, and possibly with
4409 * a table of pre-allocated vars in every CallFrame for local vars.
4410 * All the caching should also have an 'epoch' mechanism similar
4411 * to the one used by Tcl for procedures lookup caching. */
4413 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4415 int err;
4416 Jim_Var *var;
4418 switch (SetVariableFromAny(interp, nameObjPtr)) {
4419 case JIM_DICT_SUGAR:
4420 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4422 case JIM_ERR:
4423 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4424 return JIM_ERR;
4426 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4427 break;
4429 case JIM_OK:
4430 var = nameObjPtr->internalRep.varValue.varPtr;
4431 if (var->linkFramePtr == NULL) {
4432 Jim_IncrRefCount(valObjPtr);
4433 Jim_DecrRefCount(interp, var->objPtr);
4434 var->objPtr = valObjPtr;
4436 else { /* Else handle the link */
4437 Jim_CallFrame *savedCallFrame;
4439 savedCallFrame = interp->framePtr;
4440 interp->framePtr = var->linkFramePtr;
4441 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4442 interp->framePtr = savedCallFrame;
4443 if (err != JIM_OK)
4444 return err;
4447 return JIM_OK;
4450 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4452 Jim_Obj *nameObjPtr;
4453 int result;
4455 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4456 Jim_IncrRefCount(nameObjPtr);
4457 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4458 Jim_DecrRefCount(interp, nameObjPtr);
4459 return result;
4462 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4464 Jim_CallFrame *savedFramePtr;
4465 int result;
4467 savedFramePtr = interp->framePtr;
4468 interp->framePtr = interp->topFramePtr;
4469 result = Jim_SetVariableStr(interp, name, objPtr);
4470 interp->framePtr = savedFramePtr;
4471 return result;
4474 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4476 Jim_Obj *nameObjPtr, *valObjPtr;
4477 int result;
4479 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4480 valObjPtr = Jim_NewStringObj(interp, val, -1);
4481 Jim_IncrRefCount(nameObjPtr);
4482 Jim_IncrRefCount(valObjPtr);
4483 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4484 Jim_DecrRefCount(interp, nameObjPtr);
4485 Jim_DecrRefCount(interp, valObjPtr);
4486 return result;
4489 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4490 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4492 const char *varName;
4493 const char *targetName;
4494 Jim_CallFrame *framePtr;
4495 Jim_Var *varPtr;
4497 /* Check for an existing variable or link */
4498 switch (SetVariableFromAny(interp, nameObjPtr)) {
4499 case JIM_DICT_SUGAR:
4500 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4501 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4502 return JIM_ERR;
4504 case JIM_OK:
4505 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4507 if (varPtr->linkFramePtr == NULL) {
4508 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4509 return JIM_ERR;
4512 /* It exists, but is a link, so first delete the link */
4513 varPtr->linkFramePtr = NULL;
4514 break;
4517 /* Resolve the call frames for both variables */
4518 /* XXX: SetVariableFromAny() already did this! */
4519 varName = Jim_String(nameObjPtr);
4521 if (varName[0] == ':' && varName[1] == ':') {
4522 while (*++varName == ':') {
4524 /* Linking a global var does nothing */
4525 framePtr = interp->topFramePtr;
4527 else {
4528 framePtr = interp->framePtr;
4531 targetName = Jim_String(targetNameObjPtr);
4532 if (targetName[0] == ':' && targetName[1] == ':') {
4533 while (*++targetName == ':') {
4535 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4536 targetCallFrame = interp->topFramePtr;
4538 Jim_IncrRefCount(targetNameObjPtr);
4540 if (framePtr->level < targetCallFrame->level) {
4541 Jim_SetResultFormatted(interp,
4542 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4543 nameObjPtr);
4544 Jim_DecrRefCount(interp, targetNameObjPtr);
4545 return JIM_ERR;
4548 /* Check for cycles. */
4549 if (framePtr == targetCallFrame) {
4550 Jim_Obj *objPtr = targetNameObjPtr;
4552 /* Cycles are only possible with 'uplevel 0' */
4553 while (1) {
4554 if (strcmp(Jim_String(objPtr), varName) == 0) {
4555 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4556 Jim_DecrRefCount(interp, targetNameObjPtr);
4557 return JIM_ERR;
4559 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4560 break;
4561 varPtr = objPtr->internalRep.varValue.varPtr;
4562 if (varPtr->linkFramePtr != targetCallFrame)
4563 break;
4564 objPtr = varPtr->objPtr;
4568 /* Perform the binding */
4569 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4570 /* We are now sure 'nameObjPtr' type is variableObjType */
4571 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4572 Jim_DecrRefCount(interp, targetNameObjPtr);
4573 return JIM_OK;
4576 /* Return the Jim_Obj pointer associated with a variable name,
4577 * or NULL if the variable was not found in the current context.
4578 * The same optimization discussed in the comment to the
4579 * 'SetVariable' function should apply here.
4581 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4582 * in a dictionary which is shared, the array variable value is duplicated first.
4583 * This allows the array element to be updated (e.g. append, lappend) without
4584 * affecting other references to the dictionary.
4586 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4588 switch (SetVariableFromAny(interp, nameObjPtr)) {
4589 case JIM_OK:{
4590 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4592 if (varPtr->linkFramePtr == NULL) {
4593 return varPtr->objPtr;
4595 else {
4596 Jim_Obj *objPtr;
4598 /* The variable is a link? Resolve it. */
4599 Jim_CallFrame *savedCallFrame = interp->framePtr;
4601 interp->framePtr = varPtr->linkFramePtr;
4602 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4603 interp->framePtr = savedCallFrame;
4604 if (objPtr) {
4605 return objPtr;
4607 /* Error, so fall through to the error message */
4610 break;
4612 case JIM_DICT_SUGAR:
4613 /* [dict] syntax sugar. */
4614 return JimDictSugarGet(interp, nameObjPtr, flags);
4616 if (flags & JIM_ERRMSG) {
4617 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4619 return NULL;
4622 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4624 Jim_CallFrame *savedFramePtr;
4625 Jim_Obj *objPtr;
4627 savedFramePtr = interp->framePtr;
4628 interp->framePtr = interp->topFramePtr;
4629 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4630 interp->framePtr = savedFramePtr;
4632 return objPtr;
4635 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4637 Jim_Obj *nameObjPtr, *varObjPtr;
4639 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4640 Jim_IncrRefCount(nameObjPtr);
4641 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4642 Jim_DecrRefCount(interp, nameObjPtr);
4643 return varObjPtr;
4646 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4648 Jim_CallFrame *savedFramePtr;
4649 Jim_Obj *objPtr;
4651 savedFramePtr = interp->framePtr;
4652 interp->framePtr = interp->topFramePtr;
4653 objPtr = Jim_GetVariableStr(interp, name, flags);
4654 interp->framePtr = savedFramePtr;
4656 return objPtr;
4659 /* Unset a variable.
4660 * Note: On success unset invalidates all the variable objects created
4661 * in the current call frame incrementing. */
4662 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4664 Jim_Var *varPtr;
4665 int retval;
4666 Jim_CallFrame *framePtr;
4668 retval = SetVariableFromAny(interp, nameObjPtr);
4669 if (retval == JIM_DICT_SUGAR) {
4670 /* [dict] syntax sugar. */
4671 return JimDictSugarSet(interp, nameObjPtr, NULL);
4673 else if (retval == JIM_OK) {
4674 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4676 /* If it's a link call UnsetVariable recursively */
4677 if (varPtr->linkFramePtr) {
4678 framePtr = interp->framePtr;
4679 interp->framePtr = varPtr->linkFramePtr;
4680 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4681 interp->framePtr = framePtr;
4683 else {
4684 const char *name = Jim_String(nameObjPtr);
4685 if (nameObjPtr->internalRep.varValue.global) {
4686 name += 2;
4687 framePtr = interp->topFramePtr;
4689 else {
4690 framePtr = interp->framePtr;
4693 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4694 if (retval == JIM_OK) {
4695 /* Change the callframe id, invalidating var lookup caching */
4696 framePtr->id = interp->callFrameEpoch++;
4700 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4701 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4703 return retval;
4706 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4708 /* Given a variable name for [dict] operation syntax sugar,
4709 * this function returns two objects, the first with the name
4710 * of the variable to set, and the second with the rispective key.
4711 * For example "foo(bar)" will return objects with string repr. of
4712 * "foo" and "bar".
4714 * The returned objects have refcount = 1. The function can't fail. */
4715 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4716 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4718 const char *str, *p;
4719 int len, keyLen;
4720 Jim_Obj *varObjPtr, *keyObjPtr;
4722 str = Jim_GetString(objPtr, &len);
4724 p = strchr(str, '(');
4725 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4727 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4729 p++;
4730 keyLen = (str + len) - p;
4731 if (str[len - 1] == ')') {
4732 keyLen--;
4735 /* Create the objects with the variable name and key. */
4736 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4738 Jim_IncrRefCount(varObjPtr);
4739 Jim_IncrRefCount(keyObjPtr);
4740 *varPtrPtr = varObjPtr;
4741 *keyPtrPtr = keyObjPtr;
4744 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4745 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4746 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4748 int err;
4750 SetDictSubstFromAny(interp, objPtr);
4752 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4753 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4755 if (err == JIM_OK) {
4756 /* Don't keep an extra ref to the result */
4757 Jim_SetEmptyResult(interp);
4759 else {
4760 if (!valObjPtr) {
4761 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4762 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4763 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4764 objPtr);
4765 return err;
4768 /* Make the error more informative and Tcl-compatible */
4769 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4770 (valObjPtr ? "set" : "unset"), objPtr);
4772 return err;
4776 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4778 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4779 * and stored back to the variable before expansion.
4781 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4782 Jim_Obj *keyObjPtr, int flags)
4784 Jim_Obj *dictObjPtr;
4785 Jim_Obj *resObjPtr = NULL;
4786 int ret;
4788 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4789 if (!dictObjPtr) {
4790 return NULL;
4793 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4794 if (ret != JIM_OK) {
4795 Jim_SetResultFormatted(interp,
4796 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4797 ret < 0 ? "variable isn't" : "no such element in");
4799 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4800 /* Update the variable to have an unshared copy */
4801 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4804 return resObjPtr;
4807 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4808 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4810 SetDictSubstFromAny(interp, objPtr);
4812 return JimDictExpandArrayVariable(interp,
4813 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4814 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4817 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4819 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4821 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4822 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4825 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4827 JIM_NOTUSED(interp);
4829 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4830 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4831 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4832 dupPtr->typePtr = &dictSubstObjType;
4835 /* Note: The object *must* be in dict-sugar format */
4836 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4838 if (objPtr->typePtr != &dictSubstObjType) {
4839 Jim_Obj *varObjPtr, *keyObjPtr;
4841 if (objPtr->typePtr == &interpolatedObjType) {
4842 /* An interpolated object in dict-sugar form */
4844 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4845 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4847 Jim_IncrRefCount(varObjPtr);
4848 Jim_IncrRefCount(keyObjPtr);
4850 else {
4851 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4854 Jim_FreeIntRep(interp, objPtr);
4855 objPtr->typePtr = &dictSubstObjType;
4856 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4857 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4861 /* This function is used to expand [dict get] sugar in the form
4862 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4863 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4864 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4865 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4866 * the [dict]ionary contained in variable VARNAME. */
4867 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4869 Jim_Obj *resObjPtr = NULL;
4870 Jim_Obj *substKeyObjPtr = NULL;
4872 SetDictSubstFromAny(interp, objPtr);
4874 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4875 &substKeyObjPtr, JIM_NONE)
4876 != JIM_OK) {
4877 return NULL;
4879 Jim_IncrRefCount(substKeyObjPtr);
4880 resObjPtr =
4881 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4882 substKeyObjPtr, 0);
4883 Jim_DecrRefCount(interp, substKeyObjPtr);
4885 return resObjPtr;
4888 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4890 Jim_Obj *resultObjPtr;
4892 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4893 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4894 resultObjPtr->refCount--;
4895 return resultObjPtr;
4897 return NULL;
4900 /* -----------------------------------------------------------------------------
4901 * CallFrame
4902 * ---------------------------------------------------------------------------*/
4904 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4906 Jim_CallFrame *cf;
4908 if (interp->freeFramesList) {
4909 cf = interp->freeFramesList;
4910 interp->freeFramesList = cf->next;
4912 cf->argv = NULL;
4913 cf->argc = 0;
4914 cf->procArgsObjPtr = NULL;
4915 cf->procBodyObjPtr = NULL;
4916 cf->next = NULL;
4917 cf->staticVars = NULL;
4918 cf->localCommands = NULL;
4919 cf->tailcall = 0;
4920 cf->tailcallObj = NULL;
4921 cf->tailcallCmd = NULL;
4923 else {
4924 cf = Jim_Alloc(sizeof(*cf));
4925 memset(cf, 0, sizeof(*cf));
4927 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4930 cf->id = interp->callFrameEpoch++;
4931 cf->parent = parent;
4932 cf->level = parent ? parent->level + 1 : 0;
4933 cf->nsObj = nsObj;
4934 Jim_IncrRefCount(nsObj);
4936 return cf;
4939 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4941 /* Delete any local procs */
4942 if (localCommands) {
4943 Jim_Obj *cmdNameObj;
4945 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4946 Jim_HashEntry *he;
4947 Jim_Obj *fqObjName;
4948 Jim_HashTable *ht = &interp->commands;
4950 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4952 he = Jim_FindHashEntry(ht, fqname);
4954 if (he) {
4955 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4956 if (cmd->prevCmd) {
4957 Jim_Cmd *prevCmd = cmd->prevCmd;
4958 cmd->prevCmd = NULL;
4960 /* Delete the old command */
4961 JimDecrCmdRefCount(interp, cmd);
4963 /* And restore the original */
4964 Jim_SetHashVal(ht, he, prevCmd);
4966 else {
4967 Jim_DeleteHashEntry(ht, fqname);
4968 Jim_InterpIncrProcEpoch(interp);
4971 Jim_DecrRefCount(interp, cmdNameObj);
4972 JimFreeQualifiedName(interp, fqObjName);
4974 Jim_FreeStack(localCommands);
4975 Jim_Free(localCommands);
4977 return JIM_OK;
4981 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4982 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4983 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4985 JimDeleteLocalProcs(interp, cf->localCommands);
4987 if (cf->procArgsObjPtr)
4988 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4989 if (cf->procBodyObjPtr)
4990 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4991 Jim_DecrRefCount(interp, cf->nsObj);
4992 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4993 Jim_FreeHashTable(&cf->vars);
4994 else {
4995 int i;
4996 Jim_HashEntry **table = cf->vars.table, *he;
4998 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4999 he = table[i];
5000 while (he != NULL) {
5001 Jim_HashEntry *nextEntry = he->next;
5002 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5004 Jim_DecrRefCount(interp, varPtr->objPtr);
5005 Jim_Free(Jim_GetHashEntryKey(he));
5006 Jim_Free(varPtr);
5007 Jim_Free(he);
5008 table[i] = NULL;
5009 he = nextEntry;
5012 cf->vars.used = 0;
5014 cf->next = interp->freeFramesList;
5015 interp->freeFramesList = cf;
5019 /* -----------------------------------------------------------------------------
5020 * References
5021 * ---------------------------------------------------------------------------*/
5022 #ifdef JIM_REFERENCES
5024 /* References HashTable Type.
5026 * Keys are unsigned long integers, dynamically allocated for now but in the
5027 * future it's worth to cache this 4 bytes objects. Values are pointers
5028 * to Jim_References. */
5029 static void JimReferencesHTValDestructor(void *interp, void *val)
5031 Jim_Reference *refPtr = (void *)val;
5033 Jim_DecrRefCount(interp, refPtr->objPtr);
5034 if (refPtr->finalizerCmdNamePtr != NULL) {
5035 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5037 Jim_Free(val);
5040 static unsigned int JimReferencesHTHashFunction(const void *key)
5042 /* Only the least significant bits are used. */
5043 const unsigned long *widePtr = key;
5044 unsigned int intValue = (unsigned int)*widePtr;
5046 return Jim_IntHashFunction(intValue);
5049 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5051 void *copy = Jim_Alloc(sizeof(unsigned long));
5053 JIM_NOTUSED(privdata);
5055 memcpy(copy, key, sizeof(unsigned long));
5056 return copy;
5059 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5061 JIM_NOTUSED(privdata);
5063 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5066 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5068 JIM_NOTUSED(privdata);
5070 Jim_Free(key);
5073 static const Jim_HashTableType JimReferencesHashTableType = {
5074 JimReferencesHTHashFunction, /* hash function */
5075 JimReferencesHTKeyDup, /* key dup */
5076 NULL, /* val dup */
5077 JimReferencesHTKeyCompare, /* key compare */
5078 JimReferencesHTKeyDestructor, /* key destructor */
5079 JimReferencesHTValDestructor /* val destructor */
5082 /* -----------------------------------------------------------------------------
5083 * Reference object type and References API
5084 * ---------------------------------------------------------------------------*/
5086 /* The string representation of references has two features in order
5087 * to make the GC faster. The first is that every reference starts
5088 * with a non common character '<', in order to make the string matching
5089 * faster. The second is that the reference string rep is 42 characters
5090 * in length, this means that it is not necessary to check any object with a string
5091 * repr < 42, and usually there aren't many of these objects. */
5093 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5095 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5097 const char *fmt = "<reference.<%s>.%020lu>";
5099 sprintf(buf, fmt, refPtr->tag, id);
5100 return JIM_REFERENCE_SPACE;
5103 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5105 static const Jim_ObjType referenceObjType = {
5106 "reference",
5107 NULL,
5108 NULL,
5109 UpdateStringOfReference,
5110 JIM_TYPE_REFERENCES,
5113 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5115 char buf[JIM_REFERENCE_SPACE + 1];
5117 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5118 JimSetStringBytes(objPtr, buf);
5121 /* returns true if 'c' is a valid reference tag character.
5122 * i.e. inside the range [_a-zA-Z0-9] */
5123 static int isrefchar(int c)
5125 return (c == '_' || isalnum(c));
5128 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5130 unsigned long value;
5131 int i, len;
5132 const char *str, *start, *end;
5133 char refId[21];
5134 Jim_Reference *refPtr;
5135 Jim_HashEntry *he;
5136 char *endptr;
5138 /* Get the string representation */
5139 str = Jim_GetString(objPtr, &len);
5140 /* Check if it looks like a reference */
5141 if (len < JIM_REFERENCE_SPACE)
5142 goto badformat;
5143 /* Trim spaces */
5144 start = str;
5145 end = str + len - 1;
5146 while (*start == ' ')
5147 start++;
5148 while (*end == ' ' && end > start)
5149 end--;
5150 if (end - start + 1 != JIM_REFERENCE_SPACE)
5151 goto badformat;
5152 /* <reference.<1234567>.%020> */
5153 if (memcmp(start, "<reference.<", 12) != 0)
5154 goto badformat;
5155 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5156 goto badformat;
5157 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5158 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5159 if (!isrefchar(start[12 + i]))
5160 goto badformat;
5162 /* Extract info from the reference. */
5163 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5164 refId[20] = '\0';
5165 /* Try to convert the ID into an unsigned long */
5166 value = strtoul(refId, &endptr, 10);
5167 if (JimCheckConversion(refId, endptr) != JIM_OK)
5168 goto badformat;
5169 /* Check if the reference really exists! */
5170 he = Jim_FindHashEntry(&interp->references, &value);
5171 if (he == NULL) {
5172 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5173 return JIM_ERR;
5175 refPtr = Jim_GetHashEntryVal(he);
5176 /* Free the old internal repr and set the new one. */
5177 Jim_FreeIntRep(interp, objPtr);
5178 objPtr->typePtr = &referenceObjType;
5179 objPtr->internalRep.refValue.id = value;
5180 objPtr->internalRep.refValue.refPtr = refPtr;
5181 return JIM_OK;
5183 badformat:
5184 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5185 return JIM_ERR;
5188 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5189 * as finalizer command (or NULL if there is no finalizer).
5190 * The returned reference object has refcount = 0. */
5191 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5193 struct Jim_Reference *refPtr;
5194 unsigned long id;
5195 Jim_Obj *refObjPtr;
5196 const char *tag;
5197 int tagLen, i;
5199 /* Perform the Garbage Collection if needed. */
5200 Jim_CollectIfNeeded(interp);
5202 refPtr = Jim_Alloc(sizeof(*refPtr));
5203 refPtr->objPtr = objPtr;
5204 Jim_IncrRefCount(objPtr);
5205 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5206 if (cmdNamePtr)
5207 Jim_IncrRefCount(cmdNamePtr);
5208 id = interp->referenceNextId++;
5209 Jim_AddHashEntry(&interp->references, &id, refPtr);
5210 refObjPtr = Jim_NewObj(interp);
5211 refObjPtr->typePtr = &referenceObjType;
5212 refObjPtr->bytes = NULL;
5213 refObjPtr->internalRep.refValue.id = id;
5214 refObjPtr->internalRep.refValue.refPtr = refPtr;
5215 interp->referenceNextId++;
5216 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5217 * that does not pass the 'isrefchar' test is replaced with '_' */
5218 tag = Jim_GetString(tagPtr, &tagLen);
5219 if (tagLen > JIM_REFERENCE_TAGLEN)
5220 tagLen = JIM_REFERENCE_TAGLEN;
5221 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5222 if (i < tagLen && isrefchar(tag[i]))
5223 refPtr->tag[i] = tag[i];
5224 else
5225 refPtr->tag[i] = '_';
5227 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5228 return refObjPtr;
5231 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5233 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5234 return NULL;
5235 return objPtr->internalRep.refValue.refPtr;
5238 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5240 Jim_Reference *refPtr;
5242 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5243 return JIM_ERR;
5244 Jim_IncrRefCount(cmdNamePtr);
5245 if (refPtr->finalizerCmdNamePtr)
5246 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5247 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5248 return JIM_OK;
5251 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5253 Jim_Reference *refPtr;
5255 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5256 return JIM_ERR;
5257 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5258 return JIM_OK;
5261 /* -----------------------------------------------------------------------------
5262 * References Garbage Collection
5263 * ---------------------------------------------------------------------------*/
5265 /* This the hash table type for the "MARK" phase of the GC */
5266 static const Jim_HashTableType JimRefMarkHashTableType = {
5267 JimReferencesHTHashFunction, /* hash function */
5268 JimReferencesHTKeyDup, /* key dup */
5269 NULL, /* val dup */
5270 JimReferencesHTKeyCompare, /* key compare */
5271 JimReferencesHTKeyDestructor, /* key destructor */
5272 NULL /* val destructor */
5275 /* Performs the garbage collection. */
5276 int Jim_Collect(Jim_Interp *interp)
5278 int collected = 0;
5279 #ifndef JIM_BOOTSTRAP
5280 Jim_HashTable marks;
5281 Jim_HashTableIterator htiter;
5282 Jim_HashEntry *he;
5283 Jim_Obj *objPtr;
5285 /* Avoid recursive calls */
5286 if (interp->lastCollectId == -1) {
5287 /* Jim_Collect() already running. Return just now. */
5288 return 0;
5290 interp->lastCollectId = -1;
5292 /* Mark all the references found into the 'mark' hash table.
5293 * The references are searched in every live object that
5294 * is of a type that can contain references. */
5295 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5296 objPtr = interp->liveList;
5297 while (objPtr) {
5298 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5299 const char *str, *p;
5300 int len;
5302 /* If the object is of type reference, to get the
5303 * Id is simple... */
5304 if (objPtr->typePtr == &referenceObjType) {
5305 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5306 #ifdef JIM_DEBUG_GC
5307 printf("MARK (reference): %d refcount: %d\n",
5308 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5309 #endif
5310 objPtr = objPtr->nextObjPtr;
5311 continue;
5313 /* Get the string repr of the object we want
5314 * to scan for references. */
5315 p = str = Jim_GetString(objPtr, &len);
5316 /* Skip objects too little to contain references. */
5317 if (len < JIM_REFERENCE_SPACE) {
5318 objPtr = objPtr->nextObjPtr;
5319 continue;
5321 /* Extract references from the object string repr. */
5322 while (1) {
5323 int i;
5324 unsigned long id;
5326 if ((p = strstr(p, "<reference.<")) == NULL)
5327 break;
5328 /* Check if it's a valid reference. */
5329 if (len - (p - str) < JIM_REFERENCE_SPACE)
5330 break;
5331 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5332 break;
5333 for (i = 21; i <= 40; i++)
5334 if (!isdigit(UCHAR(p[i])))
5335 break;
5336 /* Get the ID */
5337 id = strtoul(p + 21, NULL, 10);
5339 /* Ok, a reference for the given ID
5340 * was found. Mark it. */
5341 Jim_AddHashEntry(&marks, &id, NULL);
5342 #ifdef JIM_DEBUG_GC
5343 printf("MARK: %d\n", (int)id);
5344 #endif
5345 p += JIM_REFERENCE_SPACE;
5348 objPtr = objPtr->nextObjPtr;
5351 /* Run the references hash table to destroy every reference that
5352 * is not referenced outside (not present in the mark HT). */
5353 JimInitHashTableIterator(&interp->references, &htiter);
5354 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5355 const unsigned long *refId;
5356 Jim_Reference *refPtr;
5358 refId = he->key;
5359 /* Check if in the mark phase we encountered
5360 * this reference. */
5361 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5362 #ifdef JIM_DEBUG_GC
5363 printf("COLLECTING %d\n", (int)*refId);
5364 #endif
5365 collected++;
5366 /* Drop the reference, but call the
5367 * finalizer first if registered. */
5368 refPtr = Jim_GetHashEntryVal(he);
5369 if (refPtr->finalizerCmdNamePtr) {
5370 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5371 Jim_Obj *objv[3], *oldResult;
5373 JimFormatReference(refstr, refPtr, *refId);
5375 objv[0] = refPtr->finalizerCmdNamePtr;
5376 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5377 objv[2] = refPtr->objPtr;
5379 /* Drop the reference itself */
5380 /* Avoid the finaliser being freed here */
5381 Jim_IncrRefCount(objv[0]);
5382 /* Don't remove the reference from the hash table just yet
5383 * since that will free refPtr, and hence refPtr->objPtr
5386 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5387 oldResult = interp->result;
5388 Jim_IncrRefCount(oldResult);
5389 Jim_EvalObjVector(interp, 3, objv);
5390 Jim_SetResult(interp, oldResult);
5391 Jim_DecrRefCount(interp, oldResult);
5393 Jim_DecrRefCount(interp, objv[0]);
5395 Jim_DeleteHashEntry(&interp->references, refId);
5398 Jim_FreeHashTable(&marks);
5399 interp->lastCollectId = interp->referenceNextId;
5400 interp->lastCollectTime = time(NULL);
5401 #endif /* JIM_BOOTSTRAP */
5402 return collected;
5405 #define JIM_COLLECT_ID_PERIOD 5000
5406 #define JIM_COLLECT_TIME_PERIOD 300
5408 void Jim_CollectIfNeeded(Jim_Interp *interp)
5410 unsigned long elapsedId;
5411 int elapsedTime;
5413 elapsedId = interp->referenceNextId - interp->lastCollectId;
5414 elapsedTime = time(NULL) - interp->lastCollectTime;
5417 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5418 Jim_Collect(interp);
5421 #endif
5423 int Jim_IsBigEndian(void)
5425 union {
5426 unsigned short s;
5427 unsigned char c[2];
5428 } uval = {0x0102};
5430 return uval.c[0] == 1;
5433 /* -----------------------------------------------------------------------------
5434 * Interpreter related functions
5435 * ---------------------------------------------------------------------------*/
5437 Jim_Interp *Jim_CreateInterp(void)
5439 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5441 memset(i, 0, sizeof(*i));
5443 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5444 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5445 i->lastCollectTime = time(NULL);
5447 /* Note that we can create objects only after the
5448 * interpreter liveList and freeList pointers are
5449 * initialized to NULL. */
5450 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5451 #ifdef JIM_REFERENCES
5452 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5453 #endif
5454 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5455 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5456 i->emptyObj = Jim_NewEmptyStringObj(i);
5457 i->trueObj = Jim_NewIntObj(i, 1);
5458 i->falseObj = Jim_NewIntObj(i, 0);
5459 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5460 i->errorFileNameObj = i->emptyObj;
5461 i->result = i->emptyObj;
5462 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5463 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5464 i->errorProc = i->emptyObj;
5465 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5466 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5467 Jim_IncrRefCount(i->emptyObj);
5468 Jim_IncrRefCount(i->errorFileNameObj);
5469 Jim_IncrRefCount(i->result);
5470 Jim_IncrRefCount(i->stackTrace);
5471 Jim_IncrRefCount(i->unknown);
5472 Jim_IncrRefCount(i->currentScriptObj);
5473 Jim_IncrRefCount(i->nullScriptObj);
5474 Jim_IncrRefCount(i->errorProc);
5475 Jim_IncrRefCount(i->trueObj);
5476 Jim_IncrRefCount(i->falseObj);
5478 /* Initialize key variables every interpreter should contain */
5479 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5480 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5482 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5483 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5484 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5485 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5486 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5487 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5488 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5490 return i;
5493 void Jim_FreeInterp(Jim_Interp *i)
5495 Jim_CallFrame *cf, *cfx;
5497 Jim_Obj *objPtr, *nextObjPtr;
5499 /* Free the active call frames list - must be done before i->commands is destroyed */
5500 for (cf = i->framePtr; cf; cf = cfx) {
5501 cfx = cf->parent;
5502 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5505 Jim_DecrRefCount(i, i->emptyObj);
5506 Jim_DecrRefCount(i, i->trueObj);
5507 Jim_DecrRefCount(i, i->falseObj);
5508 Jim_DecrRefCount(i, i->result);
5509 Jim_DecrRefCount(i, i->stackTrace);
5510 Jim_DecrRefCount(i, i->errorProc);
5511 Jim_DecrRefCount(i, i->unknown);
5512 Jim_DecrRefCount(i, i->errorFileNameObj);
5513 Jim_DecrRefCount(i, i->currentScriptObj);
5514 Jim_DecrRefCount(i, i->nullScriptObj);
5515 Jim_FreeHashTable(&i->commands);
5516 #ifdef JIM_REFERENCES
5517 Jim_FreeHashTable(&i->references);
5518 #endif
5519 Jim_FreeHashTable(&i->packages);
5520 Jim_Free(i->prngState);
5521 Jim_FreeHashTable(&i->assocData);
5523 /* Check that the live object list is empty, otherwise
5524 * there is a memory leak. */
5525 #ifdef JIM_MAINTAINER
5526 if (i->liveList != NULL) {
5527 objPtr = i->liveList;
5529 printf("\n-------------------------------------\n");
5530 printf("Objects still in the free list:\n");
5531 while (objPtr) {
5532 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5534 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5535 printf("%p (%d) %-10s: '%.20s...'\n",
5536 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5538 else {
5539 printf("%p (%d) %-10s: '%s'\n",
5540 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5542 if (objPtr->typePtr == &sourceObjType) {
5543 printf("FILE %s LINE %d\n",
5544 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5545 objPtr->internalRep.sourceValue.lineNumber);
5547 objPtr = objPtr->nextObjPtr;
5549 printf("-------------------------------------\n\n");
5550 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5552 #endif
5554 /* Free all the freed objects. */
5555 objPtr = i->freeList;
5556 while (objPtr) {
5557 nextObjPtr = objPtr->nextObjPtr;
5558 Jim_Free(objPtr);
5559 objPtr = nextObjPtr;
5562 /* Free the free call frames list */
5563 for (cf = i->freeFramesList; cf; cf = cfx) {
5564 cfx = cf->next;
5565 if (cf->vars.table)
5566 Jim_FreeHashTable(&cf->vars);
5567 Jim_Free(cf);
5570 /* Free the interpreter structure. */
5571 Jim_Free(i);
5574 /* Returns the call frame relative to the level represented by
5575 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5577 * This function accepts the 'level' argument in the form
5578 * of the commands [uplevel] and [upvar].
5580 * Returns NULL on error.
5582 * Note: for a function accepting a relative integer as level suitable
5583 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5585 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5587 long level;
5588 const char *str;
5589 Jim_CallFrame *framePtr;
5591 if (levelObjPtr) {
5592 str = Jim_String(levelObjPtr);
5593 if (str[0] == '#') {
5594 char *endptr;
5596 level = jim_strtol(str + 1, &endptr);
5597 if (str[1] == '\0' || endptr[0] != '\0') {
5598 level = -1;
5601 else {
5602 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5603 level = -1;
5605 else {
5606 /* Convert from a relative to an absolute level */
5607 level = interp->framePtr->level - level;
5611 else {
5612 str = "1"; /* Needed to format the error message. */
5613 level = interp->framePtr->level - 1;
5616 if (level == 0) {
5617 return interp->topFramePtr;
5619 if (level > 0) {
5620 /* Lookup */
5621 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5622 if (framePtr->level == level) {
5623 return framePtr;
5628 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5629 return NULL;
5632 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5633 * as a relative integer like in the [info level ?level?] command.
5635 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5637 long level;
5638 Jim_CallFrame *framePtr;
5640 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5641 if (level <= 0) {
5642 /* Convert from a relative to an absolute level */
5643 level = interp->framePtr->level + level;
5646 if (level == 0) {
5647 return interp->topFramePtr;
5650 /* Lookup */
5651 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5652 if (framePtr->level == level) {
5653 return framePtr;
5658 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5659 return NULL;
5662 static void JimResetStackTrace(Jim_Interp *interp)
5664 Jim_DecrRefCount(interp, interp->stackTrace);
5665 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5666 Jim_IncrRefCount(interp->stackTrace);
5669 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5671 int len;
5673 /* Increment reference first in case these are the same object */
5674 Jim_IncrRefCount(stackTraceObj);
5675 Jim_DecrRefCount(interp, interp->stackTrace);
5676 interp->stackTrace = stackTraceObj;
5677 interp->errorFlag = 1;
5679 /* This is a bit ugly.
5680 * If the filename of the last entry of the stack trace is empty,
5681 * the next stack level should be added.
5683 len = Jim_ListLength(interp, interp->stackTrace);
5684 if (len >= 3) {
5685 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5686 interp->addStackTrace = 1;
5691 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5692 Jim_Obj *fileNameObj, int linenr)
5694 if (strcmp(procname, "unknown") == 0) {
5695 procname = "";
5697 if (!*procname && !Jim_Length(fileNameObj)) {
5698 /* No useful info here */
5699 return;
5702 if (Jim_IsShared(interp->stackTrace)) {
5703 Jim_DecrRefCount(interp, interp->stackTrace);
5704 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5705 Jim_IncrRefCount(interp->stackTrace);
5708 /* If we have no procname but the previous element did, merge with that frame */
5709 if (!*procname && Jim_Length(fileNameObj)) {
5710 /* Just a filename. Check the previous entry */
5711 int len = Jim_ListLength(interp, interp->stackTrace);
5713 if (len >= 3) {
5714 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5715 if (Jim_Length(objPtr)) {
5716 /* Yes, the previous level had procname */
5717 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5718 if (Jim_Length(objPtr) == 0) {
5719 /* But no filename, so merge the new info with that frame */
5720 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5721 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5722 return;
5728 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5729 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5730 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5733 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5734 void *data)
5736 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5738 assocEntryPtr->delProc = delProc;
5739 assocEntryPtr->data = data;
5740 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5743 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5745 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5747 if (entryPtr != NULL) {
5748 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5749 return assocEntryPtr->data;
5751 return NULL;
5754 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5756 return Jim_DeleteHashEntry(&interp->assocData, key);
5759 int Jim_GetExitCode(Jim_Interp *interp)
5761 return interp->exitCode;
5764 /* -----------------------------------------------------------------------------
5765 * Integer object
5766 * ---------------------------------------------------------------------------*/
5767 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5768 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5770 static const Jim_ObjType intObjType = {
5771 "int",
5772 NULL,
5773 NULL,
5774 UpdateStringOfInt,
5775 JIM_TYPE_NONE,
5778 /* A coerced double is closer to an int than a double.
5779 * It is an int value temporarily masquerading as a double value.
5780 * i.e. it has the same string value as an int and Jim_GetWide()
5781 * succeeds, but also Jim_GetDouble() returns the value directly.
5783 static const Jim_ObjType coercedDoubleObjType = {
5784 "coerced-double",
5785 NULL,
5786 NULL,
5787 UpdateStringOfInt,
5788 JIM_TYPE_NONE,
5792 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5794 char buf[JIM_INTEGER_SPACE + 1];
5795 jim_wide wideValue = JimWideValue(objPtr);
5796 int pos = 0;
5798 if (wideValue == 0) {
5799 buf[pos++] = '0';
5801 else {
5802 char tmp[JIM_INTEGER_SPACE];
5803 int num = 0;
5804 int i;
5806 if (wideValue < 0) {
5807 buf[pos++] = '-';
5808 i = wideValue % 10;
5809 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5810 * whereas C99 is always -6
5811 * coverity[dead_error_line]
5813 tmp[num++] = (i > 0) ? (10 - i) : -i;
5814 wideValue /= -10;
5817 while (wideValue) {
5818 tmp[num++] = wideValue % 10;
5819 wideValue /= 10;
5822 for (i = 0; i < num; i++) {
5823 buf[pos++] = '0' + tmp[num - i - 1];
5826 buf[pos] = 0;
5828 JimSetStringBytes(objPtr, buf);
5831 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5833 jim_wide wideValue;
5834 const char *str;
5836 if (objPtr->typePtr == &coercedDoubleObjType) {
5837 /* Simple switcheroo */
5838 objPtr->typePtr = &intObjType;
5839 return JIM_OK;
5842 /* Get the string representation */
5843 str = Jim_String(objPtr);
5844 /* Try to convert into a jim_wide */
5845 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5846 if (flags & JIM_ERRMSG) {
5847 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5849 return JIM_ERR;
5851 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5852 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5853 return JIM_ERR;
5855 /* Free the old internal repr and set the new one. */
5856 Jim_FreeIntRep(interp, objPtr);
5857 objPtr->typePtr = &intObjType;
5858 objPtr->internalRep.wideValue = wideValue;
5859 return JIM_OK;
5862 #ifdef JIM_OPTIMIZATION
5863 static int JimIsWide(Jim_Obj *objPtr)
5865 return objPtr->typePtr == &intObjType;
5867 #endif
5869 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5871 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5872 return JIM_ERR;
5873 *widePtr = JimWideValue(objPtr);
5874 return JIM_OK;
5877 /* Get a wide but does not set an error if the format is bad. */
5878 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5880 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5881 return JIM_ERR;
5882 *widePtr = JimWideValue(objPtr);
5883 return JIM_OK;
5886 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5888 jim_wide wideValue;
5889 int retval;
5891 retval = Jim_GetWide(interp, objPtr, &wideValue);
5892 if (retval == JIM_OK) {
5893 *longPtr = (long)wideValue;
5894 return JIM_OK;
5896 return JIM_ERR;
5899 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5901 Jim_Obj *objPtr;
5903 objPtr = Jim_NewObj(interp);
5904 objPtr->typePtr = &intObjType;
5905 objPtr->bytes = NULL;
5906 objPtr->internalRep.wideValue = wideValue;
5907 return objPtr;
5910 /* -----------------------------------------------------------------------------
5911 * Double object
5912 * ---------------------------------------------------------------------------*/
5913 #define JIM_DOUBLE_SPACE 30
5915 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5916 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5918 static const Jim_ObjType doubleObjType = {
5919 "double",
5920 NULL,
5921 NULL,
5922 UpdateStringOfDouble,
5923 JIM_TYPE_NONE,
5926 #ifndef HAVE_ISNAN
5927 #undef isnan
5928 #define isnan(X) ((X) != (X))
5929 #endif
5930 #ifndef HAVE_ISINF
5931 #undef isinf
5932 #define isinf(X) (1.0 / (X) == 0.0)
5933 #endif
5935 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5937 double value = objPtr->internalRep.doubleValue;
5939 if (isnan(value)) {
5940 JimSetStringBytes(objPtr, "NaN");
5941 return;
5943 if (isinf(value)) {
5944 if (value < 0) {
5945 JimSetStringBytes(objPtr, "-Inf");
5947 else {
5948 JimSetStringBytes(objPtr, "Inf");
5950 return;
5953 char buf[JIM_DOUBLE_SPACE + 1];
5954 int i;
5955 int len = sprintf(buf, "%.12g", value);
5957 /* Add a final ".0" if necessary */
5958 for (i = 0; i < len; i++) {
5959 if (buf[i] == '.' || buf[i] == 'e') {
5960 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5961 /* If 'buf' ends in e-0nn or e+0nn, remove
5962 * the 0 after the + or - and reduce the length by 1
5964 char *e = strchr(buf, 'e');
5965 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5966 /* Move it up */
5967 e += 2;
5968 memmove(e, e + 1, len - (e - buf));
5970 #endif
5971 break;
5974 if (buf[i] == '\0') {
5975 buf[i++] = '.';
5976 buf[i++] = '0';
5977 buf[i] = '\0';
5979 JimSetStringBytes(objPtr, buf);
5983 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5985 double doubleValue;
5986 jim_wide wideValue;
5987 const char *str;
5989 /* Preserve the string representation.
5990 * Needed so we can convert back to int without loss
5992 str = Jim_String(objPtr);
5994 #ifdef HAVE_LONG_LONG
5995 /* Assume a 53 bit mantissa */
5996 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5997 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5999 if (objPtr->typePtr == &intObjType
6000 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6001 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6003 /* Direct conversion to coerced double */
6004 objPtr->typePtr = &coercedDoubleObjType;
6005 return JIM_OK;
6007 else
6008 #endif
6009 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6010 /* Managed to convert to an int, so we can use this as a cooerced double */
6011 Jim_FreeIntRep(interp, objPtr);
6012 objPtr->typePtr = &coercedDoubleObjType;
6013 objPtr->internalRep.wideValue = wideValue;
6014 return JIM_OK;
6016 else {
6017 /* Try to convert into a double */
6018 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6019 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6020 return JIM_ERR;
6022 /* Free the old internal repr and set the new one. */
6023 Jim_FreeIntRep(interp, objPtr);
6025 objPtr->typePtr = &doubleObjType;
6026 objPtr->internalRep.doubleValue = doubleValue;
6027 return JIM_OK;
6030 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6032 if (objPtr->typePtr == &coercedDoubleObjType) {
6033 *doublePtr = JimWideValue(objPtr);
6034 return JIM_OK;
6036 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6037 return JIM_ERR;
6039 if (objPtr->typePtr == &coercedDoubleObjType) {
6040 *doublePtr = JimWideValue(objPtr);
6042 else {
6043 *doublePtr = objPtr->internalRep.doubleValue;
6045 return JIM_OK;
6048 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6050 Jim_Obj *objPtr;
6052 objPtr = Jim_NewObj(interp);
6053 objPtr->typePtr = &doubleObjType;
6054 objPtr->bytes = NULL;
6055 objPtr->internalRep.doubleValue = doubleValue;
6056 return objPtr;
6059 /* -----------------------------------------------------------------------------
6060 * List object
6061 * ---------------------------------------------------------------------------*/
6062 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6063 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6064 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6065 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6066 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6067 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6069 /* Note that while the elements of the list may contain references,
6070 * the list object itself can't. This basically means that the
6071 * list object string representation as a whole can't contain references
6072 * that are not presents in the single elements. */
6073 static const Jim_ObjType listObjType = {
6074 "list",
6075 FreeListInternalRep,
6076 DupListInternalRep,
6077 UpdateStringOfList,
6078 JIM_TYPE_NONE,
6081 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6083 int i;
6085 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6086 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6088 Jim_Free(objPtr->internalRep.listValue.ele);
6091 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6093 int i;
6095 JIM_NOTUSED(interp);
6097 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6098 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6099 dupPtr->internalRep.listValue.ele =
6100 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6101 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6102 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6103 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6104 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6106 dupPtr->typePtr = &listObjType;
6109 /* The following function checks if a given string can be encoded
6110 * into a list element without any kind of quoting, surrounded by braces,
6111 * or using escapes to quote. */
6112 #define JIM_ELESTR_SIMPLE 0
6113 #define JIM_ELESTR_BRACE 1
6114 #define JIM_ELESTR_QUOTE 2
6115 static unsigned char ListElementQuotingType(const char *s, int len)
6117 int i, level, blevel, trySimple = 1;
6119 /* Try with the SIMPLE case */
6120 if (len == 0)
6121 return JIM_ELESTR_BRACE;
6122 if (s[0] == '"' || s[0] == '{') {
6123 trySimple = 0;
6124 goto testbrace;
6126 for (i = 0; i < len; i++) {
6127 switch (s[i]) {
6128 case ' ':
6129 case '$':
6130 case '"':
6131 case '[':
6132 case ']':
6133 case ';':
6134 case '\\':
6135 case '\r':
6136 case '\n':
6137 case '\t':
6138 case '\f':
6139 case '\v':
6140 trySimple = 0;
6141 case '{':
6142 case '}':
6143 goto testbrace;
6146 return JIM_ELESTR_SIMPLE;
6148 testbrace:
6149 /* Test if it's possible to do with braces */
6150 if (s[len - 1] == '\\')
6151 return JIM_ELESTR_QUOTE;
6152 level = 0;
6153 blevel = 0;
6154 for (i = 0; i < len; i++) {
6155 switch (s[i]) {
6156 case '{':
6157 level++;
6158 break;
6159 case '}':
6160 level--;
6161 if (level < 0)
6162 return JIM_ELESTR_QUOTE;
6163 break;
6164 case '[':
6165 blevel++;
6166 break;
6167 case ']':
6168 blevel--;
6169 break;
6170 case '\\':
6171 if (s[i + 1] == '\n')
6172 return JIM_ELESTR_QUOTE;
6173 else if (s[i + 1] != '\0')
6174 i++;
6175 break;
6178 if (blevel < 0) {
6179 return JIM_ELESTR_QUOTE;
6182 if (level == 0) {
6183 if (!trySimple)
6184 return JIM_ELESTR_BRACE;
6185 for (i = 0; i < len; i++) {
6186 switch (s[i]) {
6187 case ' ':
6188 case '$':
6189 case '"':
6190 case '[':
6191 case ']':
6192 case ';':
6193 case '\\':
6194 case '\r':
6195 case '\n':
6196 case '\t':
6197 case '\f':
6198 case '\v':
6199 return JIM_ELESTR_BRACE;
6200 break;
6203 return JIM_ELESTR_SIMPLE;
6205 return JIM_ELESTR_QUOTE;
6208 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6209 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6210 * scenario.
6211 * Returns the length of the result.
6213 static int BackslashQuoteString(const char *s, int len, char *q)
6215 char *p = q;
6217 while (len--) {
6218 switch (*s) {
6219 case ' ':
6220 case '$':
6221 case '"':
6222 case '[':
6223 case ']':
6224 case '{':
6225 case '}':
6226 case ';':
6227 case '\\':
6228 *p++ = '\\';
6229 *p++ = *s++;
6230 break;
6231 case '\n':
6232 *p++ = '\\';
6233 *p++ = 'n';
6234 s++;
6235 break;
6236 case '\r':
6237 *p++ = '\\';
6238 *p++ = 'r';
6239 s++;
6240 break;
6241 case '\t':
6242 *p++ = '\\';
6243 *p++ = 't';
6244 s++;
6245 break;
6246 case '\f':
6247 *p++ = '\\';
6248 *p++ = 'f';
6249 s++;
6250 break;
6251 case '\v':
6252 *p++ = '\\';
6253 *p++ = 'v';
6254 s++;
6255 break;
6256 default:
6257 *p++ = *s++;
6258 break;
6261 *p = '\0';
6263 return p - q;
6266 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6268 #define STATIC_QUOTING_LEN 32
6269 int i, bufLen, realLength;
6270 const char *strRep;
6271 char *p;
6272 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6274 /* Estimate the space needed. */
6275 if (objc > STATIC_QUOTING_LEN) {
6276 quotingType = Jim_Alloc(objc);
6278 else {
6279 quotingType = staticQuoting;
6281 bufLen = 0;
6282 for (i = 0; i < objc; i++) {
6283 int len;
6285 strRep = Jim_GetString(objv[i], &len);
6286 quotingType[i] = ListElementQuotingType(strRep, len);
6287 switch (quotingType[i]) {
6288 case JIM_ELESTR_SIMPLE:
6289 if (i != 0 || strRep[0] != '#') {
6290 bufLen += len;
6291 break;
6293 /* Special case '#' on first element needs braces */
6294 quotingType[i] = JIM_ELESTR_BRACE;
6295 /* fall through */
6296 case JIM_ELESTR_BRACE:
6297 bufLen += len + 2;
6298 break;
6299 case JIM_ELESTR_QUOTE:
6300 bufLen += len * 2;
6301 break;
6303 bufLen++; /* elements separator. */
6305 bufLen++;
6307 /* Generate the string rep. */
6308 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6309 realLength = 0;
6310 for (i = 0; i < objc; i++) {
6311 int len, qlen;
6313 strRep = Jim_GetString(objv[i], &len);
6315 switch (quotingType[i]) {
6316 case JIM_ELESTR_SIMPLE:
6317 memcpy(p, strRep, len);
6318 p += len;
6319 realLength += len;
6320 break;
6321 case JIM_ELESTR_BRACE:
6322 *p++ = '{';
6323 memcpy(p, strRep, len);
6324 p += len;
6325 *p++ = '}';
6326 realLength += len + 2;
6327 break;
6328 case JIM_ELESTR_QUOTE:
6329 if (i == 0 && strRep[0] == '#') {
6330 *p++ = '\\';
6331 realLength++;
6333 qlen = BackslashQuoteString(strRep, len, p);
6334 p += qlen;
6335 realLength += qlen;
6336 break;
6338 /* Add a separating space */
6339 if (i + 1 != objc) {
6340 *p++ = ' ';
6341 realLength++;
6344 *p = '\0'; /* nul term. */
6345 objPtr->length = realLength;
6347 if (quotingType != staticQuoting) {
6348 Jim_Free(quotingType);
6352 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6354 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6357 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6359 struct JimParserCtx parser;
6360 const char *str;
6361 int strLen;
6362 Jim_Obj *fileNameObj;
6363 int linenr;
6365 if (objPtr->typePtr == &listObjType) {
6366 return JIM_OK;
6369 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6370 * it also preserves any source location of the dict elements
6371 * which can be very useful
6373 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6374 Jim_Obj **listObjPtrPtr;
6375 int len;
6376 int i;
6378 listObjPtrPtr = JimDictPairs(objPtr, &len);
6379 for (i = 0; i < len; i++) {
6380 Jim_IncrRefCount(listObjPtrPtr[i]);
6383 /* Now just switch the internal rep */
6384 Jim_FreeIntRep(interp, objPtr);
6385 objPtr->typePtr = &listObjType;
6386 objPtr->internalRep.listValue.len = len;
6387 objPtr->internalRep.listValue.maxLen = len;
6388 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6390 return JIM_OK;
6393 /* Try to preserve information about filename / line number */
6394 if (objPtr->typePtr == &sourceObjType) {
6395 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6396 linenr = objPtr->internalRep.sourceValue.lineNumber;
6398 else {
6399 fileNameObj = interp->emptyObj;
6400 linenr = 1;
6402 Jim_IncrRefCount(fileNameObj);
6404 /* Get the string representation */
6405 str = Jim_GetString(objPtr, &strLen);
6407 /* Free the old internal repr just now and initialize the
6408 * new one just now. The string->list conversion can't fail. */
6409 Jim_FreeIntRep(interp, objPtr);
6410 objPtr->typePtr = &listObjType;
6411 objPtr->internalRep.listValue.len = 0;
6412 objPtr->internalRep.listValue.maxLen = 0;
6413 objPtr->internalRep.listValue.ele = NULL;
6415 /* Convert into a list */
6416 if (strLen) {
6417 JimParserInit(&parser, str, strLen, linenr);
6418 while (!parser.eof) {
6419 Jim_Obj *elementPtr;
6421 JimParseList(&parser);
6422 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6423 continue;
6424 elementPtr = JimParserGetTokenObj(interp, &parser);
6425 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6426 ListAppendElement(objPtr, elementPtr);
6429 Jim_DecrRefCount(interp, fileNameObj);
6430 return JIM_OK;
6433 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6435 Jim_Obj *objPtr;
6437 objPtr = Jim_NewObj(interp);
6438 objPtr->typePtr = &listObjType;
6439 objPtr->bytes = NULL;
6440 objPtr->internalRep.listValue.ele = NULL;
6441 objPtr->internalRep.listValue.len = 0;
6442 objPtr->internalRep.listValue.maxLen = 0;
6444 if (len) {
6445 ListInsertElements(objPtr, 0, len, elements);
6448 return objPtr;
6451 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6452 * length of the vector. Note that the user of this function should make
6453 * sure that the list object can't shimmer while the vector returned
6454 * is in use, this vector is the one stored inside the internal representation
6455 * of the list object. This function is not exported, extensions should
6456 * always access to the List object elements using Jim_ListIndex(). */
6457 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6458 Jim_Obj ***listVec)
6460 *listLen = Jim_ListLength(interp, listObj);
6461 *listVec = listObj->internalRep.listValue.ele;
6464 /* Sorting uses ints, but commands may return wide */
6465 static int JimSign(jim_wide w)
6467 if (w == 0) {
6468 return 0;
6470 else if (w < 0) {
6471 return -1;
6473 return 1;
6476 /* ListSortElements type values */
6477 struct lsort_info {
6478 jmp_buf jmpbuf;
6479 Jim_Obj *command;
6480 Jim_Interp *interp;
6481 enum {
6482 JIM_LSORT_ASCII,
6483 JIM_LSORT_NOCASE,
6484 JIM_LSORT_INTEGER,
6485 JIM_LSORT_REAL,
6486 JIM_LSORT_COMMAND
6487 } type;
6488 int order;
6489 int index;
6490 int indexed;
6491 int unique;
6492 int (*subfn)(Jim_Obj **, Jim_Obj **);
6495 static struct lsort_info *sort_info;
6497 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6499 Jim_Obj *lObj, *rObj;
6501 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6502 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6503 longjmp(sort_info->jmpbuf, JIM_ERR);
6505 return sort_info->subfn(&lObj, &rObj);
6508 /* Sort the internal rep of a list. */
6509 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6511 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6514 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6516 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6519 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6521 jim_wide lhs = 0, rhs = 0;
6523 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6524 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6525 longjmp(sort_info->jmpbuf, JIM_ERR);
6528 return JimSign(lhs - rhs) * sort_info->order;
6531 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6533 double lhs = 0, rhs = 0;
6535 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6536 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6537 longjmp(sort_info->jmpbuf, JIM_ERR);
6539 if (lhs == rhs) {
6540 return 0;
6542 if (lhs > rhs) {
6543 return sort_info->order;
6545 return -sort_info->order;
6548 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6550 Jim_Obj *compare_script;
6551 int rc;
6553 jim_wide ret = 0;
6555 /* This must be a valid list */
6556 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6557 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6558 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6560 rc = Jim_EvalObj(sort_info->interp, compare_script);
6562 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6563 longjmp(sort_info->jmpbuf, rc);
6566 return JimSign(ret) * sort_info->order;
6569 /* Remove duplicate elements from the (sorted) list in-place, according to the
6570 * comparison function, comp.
6572 * Note that the last unique value is kept, not the first
6574 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6576 int src;
6577 int dst = 0;
6578 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6580 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6581 if (comp(&ele[dst], &ele[src]) == 0) {
6582 /* Match, so replace the dest with the current source */
6583 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6585 else {
6586 /* No match, so keep the current source and move to the next destination */
6587 dst++;
6589 ele[dst] = ele[src];
6591 /* At end of list, keep the final element */
6592 ele[++dst] = ele[src];
6594 /* Set the new length */
6595 listObjPtr->internalRep.listValue.len = dst;
6598 /* Sort a list *in place*. MUST be called with a non-shared list. */
6599 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6601 struct lsort_info *prev_info;
6603 typedef int (qsort_comparator) (const void *, const void *);
6604 int (*fn) (Jim_Obj **, Jim_Obj **);
6605 Jim_Obj **vector;
6606 int len;
6607 int rc;
6609 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6610 SetListFromAny(interp, listObjPtr);
6612 /* Allow lsort to be called reentrantly */
6613 prev_info = sort_info;
6614 sort_info = info;
6616 vector = listObjPtr->internalRep.listValue.ele;
6617 len = listObjPtr->internalRep.listValue.len;
6618 switch (info->type) {
6619 case JIM_LSORT_ASCII:
6620 fn = ListSortString;
6621 break;
6622 case JIM_LSORT_NOCASE:
6623 fn = ListSortStringNoCase;
6624 break;
6625 case JIM_LSORT_INTEGER:
6626 fn = ListSortInteger;
6627 break;
6628 case JIM_LSORT_REAL:
6629 fn = ListSortReal;
6630 break;
6631 case JIM_LSORT_COMMAND:
6632 fn = ListSortCommand;
6633 break;
6634 default:
6635 fn = NULL; /* avoid warning */
6636 JimPanic((1, "ListSort called with invalid sort type"));
6639 if (info->indexed) {
6640 /* Need to interpose a "list index" function */
6641 info->subfn = fn;
6642 fn = ListSortIndexHelper;
6645 if ((rc = setjmp(info->jmpbuf)) == 0) {
6646 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6648 if (info->unique && len > 1) {
6649 ListRemoveDuplicates(listObjPtr, fn);
6652 Jim_InvalidateStringRep(listObjPtr);
6654 sort_info = prev_info;
6656 return rc;
6659 /* This is the low-level function to insert elements into a list.
6660 * The higher-level Jim_ListInsertElements() performs shared object
6661 * check and invalidates the string repr. This version is used
6662 * in the internals of the List Object and is not exported.
6664 * NOTE: this function can be called only against objects
6665 * with internal type of List.
6667 * An insertion point (idx) of -1 means end-of-list.
6669 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6671 int currentLen = listPtr->internalRep.listValue.len;
6672 int requiredLen = currentLen + elemc;
6673 int i;
6674 Jim_Obj **point;
6676 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6677 if (requiredLen < 2) {
6678 /* Don't do allocations of under 4 pointers. */
6679 requiredLen = 4;
6681 else {
6682 requiredLen *= 2;
6685 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6686 sizeof(Jim_Obj *) * requiredLen);
6688 listPtr->internalRep.listValue.maxLen = requiredLen;
6690 if (idx < 0) {
6691 idx = currentLen;
6693 point = listPtr->internalRep.listValue.ele + idx;
6694 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6695 for (i = 0; i < elemc; ++i) {
6696 point[i] = elemVec[i];
6697 Jim_IncrRefCount(point[i]);
6699 listPtr->internalRep.listValue.len += elemc;
6702 /* Convenience call to ListInsertElements() to append a single element.
6704 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6706 ListInsertElements(listPtr, -1, 1, &objPtr);
6709 /* Appends every element of appendListPtr into listPtr.
6710 * Both have to be of the list type.
6711 * Convenience call to ListInsertElements()
6713 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6715 ListInsertElements(listPtr, -1,
6716 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6719 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6721 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6722 SetListFromAny(interp, listPtr);
6723 Jim_InvalidateStringRep(listPtr);
6724 ListAppendElement(listPtr, objPtr);
6727 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6729 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6730 SetListFromAny(interp, listPtr);
6731 SetListFromAny(interp, appendListPtr);
6732 Jim_InvalidateStringRep(listPtr);
6733 ListAppendList(listPtr, appendListPtr);
6736 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6738 SetListFromAny(interp, objPtr);
6739 return objPtr->internalRep.listValue.len;
6742 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6743 int objc, Jim_Obj *const *objVec)
6745 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6746 SetListFromAny(interp, listPtr);
6747 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6748 idx = listPtr->internalRep.listValue.len;
6749 else if (idx < 0)
6750 idx = 0;
6751 Jim_InvalidateStringRep(listPtr);
6752 ListInsertElements(listPtr, idx, objc, objVec);
6755 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6757 SetListFromAny(interp, listPtr);
6758 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6759 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6760 return NULL;
6762 if (idx < 0)
6763 idx = listPtr->internalRep.listValue.len + idx;
6764 return listPtr->internalRep.listValue.ele[idx];
6767 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6769 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6770 if (*objPtrPtr == NULL) {
6771 if (flags & JIM_ERRMSG) {
6772 Jim_SetResultString(interp, "list index out of range", -1);
6774 return JIM_ERR;
6776 return JIM_OK;
6779 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6780 Jim_Obj *newObjPtr, int flags)
6782 SetListFromAny(interp, listPtr);
6783 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6784 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6785 if (flags & JIM_ERRMSG) {
6786 Jim_SetResultString(interp, "list index out of range", -1);
6788 return JIM_ERR;
6790 if (idx < 0)
6791 idx = listPtr->internalRep.listValue.len + idx;
6792 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6793 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6794 Jim_IncrRefCount(newObjPtr);
6795 return JIM_OK;
6798 /* Modify the list stored in the variable named 'varNamePtr'
6799 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6800 * with the new element 'newObjptr'. (implements the [lset] command) */
6801 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6802 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6804 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6805 int shared, i, idx;
6807 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6808 if (objPtr == NULL)
6809 return JIM_ERR;
6810 if ((shared = Jim_IsShared(objPtr)))
6811 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6812 for (i = 0; i < indexc - 1; i++) {
6813 listObjPtr = objPtr;
6814 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6815 goto err;
6816 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6817 goto err;
6819 if (Jim_IsShared(objPtr)) {
6820 objPtr = Jim_DuplicateObj(interp, objPtr);
6821 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6823 Jim_InvalidateStringRep(listObjPtr);
6825 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6826 goto err;
6827 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6828 goto err;
6829 Jim_InvalidateStringRep(objPtr);
6830 Jim_InvalidateStringRep(varObjPtr);
6831 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6832 goto err;
6833 Jim_SetResult(interp, varObjPtr);
6834 return JIM_OK;
6835 err:
6836 if (shared) {
6837 Jim_FreeNewObj(interp, varObjPtr);
6839 return JIM_ERR;
6842 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6844 int i;
6845 int listLen = Jim_ListLength(interp, listObjPtr);
6846 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6848 for (i = 0; i < listLen; ) {
6849 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6850 if (++i != listLen) {
6851 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6854 return resObjPtr;
6857 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6859 int i;
6861 /* If all the objects in objv are lists,
6862 * it's possible to return a list as result, that's the
6863 * concatenation of all the lists. */
6864 for (i = 0; i < objc; i++) {
6865 if (!Jim_IsList(objv[i]))
6866 break;
6868 if (i == objc) {
6869 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6871 for (i = 0; i < objc; i++)
6872 ListAppendList(objPtr, objv[i]);
6873 return objPtr;
6875 else {
6876 /* Else... we have to glue strings together */
6877 int len = 0, objLen;
6878 char *bytes, *p;
6880 /* Compute the length */
6881 for (i = 0; i < objc; i++) {
6882 len += Jim_Length(objv[i]);
6884 if (objc)
6885 len += objc - 1;
6886 /* Create the string rep, and a string object holding it. */
6887 p = bytes = Jim_Alloc(len + 1);
6888 for (i = 0; i < objc; i++) {
6889 const char *s = Jim_GetString(objv[i], &objLen);
6891 /* Remove leading space */
6892 while (objLen && isspace(UCHAR(*s))) {
6893 s++;
6894 objLen--;
6895 len--;
6897 /* And trailing space */
6898 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6899 /* Handle trailing backslash-space case */
6900 if (objLen > 1 && s[objLen - 2] == '\\') {
6901 break;
6903 objLen--;
6904 len--;
6906 memcpy(p, s, objLen);
6907 p += objLen;
6908 if (i + 1 != objc) {
6909 if (objLen)
6910 *p++ = ' ';
6911 else {
6912 /* Drop the space calcuated for this
6913 * element that is instead null. */
6914 len--;
6918 *p = '\0';
6919 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6923 /* Returns a list composed of the elements in the specified range.
6924 * first and start are directly accepted as Jim_Objects and
6925 * processed for the end?-index? case. */
6926 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6927 Jim_Obj *lastObjPtr)
6929 int first, last;
6930 int len, rangeLen;
6932 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6933 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6934 return NULL;
6935 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6936 first = JimRelToAbsIndex(len, first);
6937 last = JimRelToAbsIndex(len, last);
6938 JimRelToAbsRange(len, &first, &last, &rangeLen);
6939 if (first == 0 && last == len) {
6940 return listObjPtr;
6942 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6945 /* -----------------------------------------------------------------------------
6946 * Dict object
6947 * ---------------------------------------------------------------------------*/
6948 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6949 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6950 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6951 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6953 /* Dict HashTable Type.
6955 * Keys and Values are Jim objects. */
6957 static unsigned int JimObjectHTHashFunction(const void *key)
6959 int len;
6960 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6961 return Jim_GenHashFunction((const unsigned char *)str, len);
6964 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6966 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6969 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6971 Jim_IncrRefCount((Jim_Obj *)val);
6972 return (void *)val;
6975 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6977 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6980 static const Jim_HashTableType JimDictHashTableType = {
6981 JimObjectHTHashFunction, /* hash function */
6982 JimObjectHTKeyValDup, /* key dup */
6983 JimObjectHTKeyValDup, /* val dup */
6984 JimObjectHTKeyCompare, /* key compare */
6985 JimObjectHTKeyValDestructor, /* key destructor */
6986 JimObjectHTKeyValDestructor /* val destructor */
6989 /* Note that while the elements of the dict may contain references,
6990 * the list object itself can't. This basically means that the
6991 * dict object string representation as a whole can't contain references
6992 * that are not presents in the single elements. */
6993 static const Jim_ObjType dictObjType = {
6994 "dict",
6995 FreeDictInternalRep,
6996 DupDictInternalRep,
6997 UpdateStringOfDict,
6998 JIM_TYPE_NONE,
7001 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7003 JIM_NOTUSED(interp);
7005 Jim_FreeHashTable(objPtr->internalRep.ptr);
7006 Jim_Free(objPtr->internalRep.ptr);
7009 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7011 Jim_HashTable *ht, *dupHt;
7012 Jim_HashTableIterator htiter;
7013 Jim_HashEntry *he;
7015 /* Create a new hash table */
7016 ht = srcPtr->internalRep.ptr;
7017 dupHt = Jim_Alloc(sizeof(*dupHt));
7018 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7019 if (ht->size != 0)
7020 Jim_ExpandHashTable(dupHt, ht->size);
7021 /* Copy every element from the source to the dup hash table */
7022 JimInitHashTableIterator(ht, &htiter);
7023 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7024 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7027 dupPtr->internalRep.ptr = dupHt;
7028 dupPtr->typePtr = &dictObjType;
7031 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7033 Jim_HashTable *ht;
7034 Jim_HashTableIterator htiter;
7035 Jim_HashEntry *he;
7036 Jim_Obj **objv;
7037 int i;
7039 ht = dictPtr->internalRep.ptr;
7041 /* Turn the hash table into a flat vector of Jim_Objects. */
7042 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7043 JimInitHashTableIterator(ht, &htiter);
7044 i = 0;
7045 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7046 objv[i++] = Jim_GetHashEntryKey(he);
7047 objv[i++] = Jim_GetHashEntryVal(he);
7049 *len = i;
7050 return objv;
7053 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7055 /* Turn the hash table into a flat vector of Jim_Objects. */
7056 int len;
7057 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7059 /* And now generate the string rep as a list */
7060 JimMakeListStringRep(objPtr, objv, len);
7062 Jim_Free(objv);
7065 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7067 int listlen;
7069 if (objPtr->typePtr == &dictObjType) {
7070 return JIM_OK;
7073 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7074 /* A shared list, so get the string representation now to avoid
7075 * changing the order in case of fast conversion to dict.
7077 Jim_String(objPtr);
7080 /* For simplicity, convert a non-list object to a list and then to a dict */
7081 listlen = Jim_ListLength(interp, objPtr);
7082 if (listlen % 2) {
7083 Jim_SetResultString(interp, "missing value to go with key", -1);
7084 return JIM_ERR;
7086 else {
7087 /* Converting from a list to a dict can't fail */
7088 Jim_HashTable *ht;
7089 int i;
7091 ht = Jim_Alloc(sizeof(*ht));
7092 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7094 for (i = 0; i < listlen; i += 2) {
7095 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7096 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7098 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7101 Jim_FreeIntRep(interp, objPtr);
7102 objPtr->typePtr = &dictObjType;
7103 objPtr->internalRep.ptr = ht;
7105 return JIM_OK;
7109 /* Dict object API */
7111 /* Add an element to a dict. objPtr must be of the "dict" type.
7112 * The higer-level exported function is Jim_DictAddElement().
7113 * If an element with the specified key already exists, the value
7114 * associated is replaced with the new one.
7116 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7117 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7118 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7120 Jim_HashTable *ht = objPtr->internalRep.ptr;
7122 if (valueObjPtr == NULL) { /* unset */
7123 return Jim_DeleteHashEntry(ht, keyObjPtr);
7125 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7126 return JIM_OK;
7129 /* Add an element, higher-level interface for DictAddElement().
7130 * If valueObjPtr == NULL, the key is removed if it exists. */
7131 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7132 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7134 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7135 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7136 return JIM_ERR;
7138 Jim_InvalidateStringRep(objPtr);
7139 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7142 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7144 Jim_Obj *objPtr;
7145 int i;
7147 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7149 objPtr = Jim_NewObj(interp);
7150 objPtr->typePtr = &dictObjType;
7151 objPtr->bytes = NULL;
7152 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7153 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7154 for (i = 0; i < len; i += 2)
7155 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7156 return objPtr;
7159 /* Return the value associated to the specified dict key
7160 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7162 * Sets *objPtrPtr to non-NULL only upon success.
7164 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7165 Jim_Obj **objPtrPtr, int flags)
7167 Jim_HashEntry *he;
7168 Jim_HashTable *ht;
7170 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7171 return -1;
7173 ht = dictPtr->internalRep.ptr;
7174 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7175 if (flags & JIM_ERRMSG) {
7176 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7178 return JIM_ERR;
7180 *objPtrPtr = he->u.val;
7181 return JIM_OK;
7184 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7185 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7187 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7188 return JIM_ERR;
7190 *objPtrPtr = JimDictPairs(dictPtr, len);
7192 return JIM_OK;
7196 /* Return the value associated to the specified dict keys */
7197 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7198 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7200 int i;
7202 if (keyc == 0) {
7203 *objPtrPtr = dictPtr;
7204 return JIM_OK;
7207 for (i = 0; i < keyc; i++) {
7208 Jim_Obj *objPtr;
7210 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7211 if (rc != JIM_OK) {
7212 return rc;
7214 dictPtr = objPtr;
7216 *objPtrPtr = dictPtr;
7217 return JIM_OK;
7220 /* Modify the dict stored into the variable named 'varNamePtr'
7221 * setting the element specified by the 'keyc' keys objects in 'keyv',
7222 * with the new value of the element 'newObjPtr'.
7224 * If newObjPtr == NULL the operation is to remove the given key
7225 * from the dictionary.
7227 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7228 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7230 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7231 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7233 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7234 int shared, i;
7236 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7237 if (objPtr == NULL) {
7238 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7239 /* Cannot remove a key from non existing var */
7240 return JIM_ERR;
7242 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7243 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7244 Jim_FreeNewObj(interp, varObjPtr);
7245 return JIM_ERR;
7248 if ((shared = Jim_IsShared(objPtr)))
7249 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7250 for (i = 0; i < keyc; i++) {
7251 dictObjPtr = objPtr;
7253 /* Check if it's a valid dictionary */
7254 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7255 goto err;
7258 if (i == keyc - 1) {
7259 /* Last key: Note that error on unset with missing last key is OK */
7260 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7261 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7262 goto err;
7265 break;
7268 /* Check if the given key exists. */
7269 Jim_InvalidateStringRep(dictObjPtr);
7270 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7271 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7272 /* This key exists at the current level.
7273 * Make sure it's not shared!. */
7274 if (Jim_IsShared(objPtr)) {
7275 objPtr = Jim_DuplicateObj(interp, objPtr);
7276 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7279 else {
7280 /* Key not found. If it's an [unset] operation
7281 * this is an error. Only the last key may not
7282 * exist. */
7283 if (newObjPtr == NULL) {
7284 goto err;
7286 /* Otherwise set an empty dictionary
7287 * as key's value. */
7288 objPtr = Jim_NewDictObj(interp, NULL, 0);
7289 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7292 /* XXX: Is this necessary? */
7293 Jim_InvalidateStringRep(objPtr);
7294 Jim_InvalidateStringRep(varObjPtr);
7295 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7296 goto err;
7298 Jim_SetResult(interp, varObjPtr);
7299 return JIM_OK;
7300 err:
7301 if (shared) {
7302 Jim_FreeNewObj(interp, varObjPtr);
7304 return JIM_ERR;
7307 /* -----------------------------------------------------------------------------
7308 * Index object
7309 * ---------------------------------------------------------------------------*/
7310 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7311 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7313 static const Jim_ObjType indexObjType = {
7314 "index",
7315 NULL,
7316 NULL,
7317 UpdateStringOfIndex,
7318 JIM_TYPE_NONE,
7321 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7323 if (objPtr->internalRep.intValue == -1) {
7324 JimSetStringBytes(objPtr, "end");
7326 else {
7327 char buf[JIM_INTEGER_SPACE + 1];
7328 if (objPtr->internalRep.intValue >= 0) {
7329 sprintf(buf, "%d", objPtr->internalRep.intValue);
7331 else {
7332 /* Must be <= -2 */
7333 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7335 JimSetStringBytes(objPtr, buf);
7339 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7341 int idx, end = 0;
7342 const char *str;
7343 char *endptr;
7345 /* Get the string representation */
7346 str = Jim_String(objPtr);
7348 /* Try to convert into an index */
7349 if (strncmp(str, "end", 3) == 0) {
7350 end = 1;
7351 str += 3;
7352 idx = 0;
7354 else {
7355 idx = jim_strtol(str, &endptr);
7357 if (endptr == str) {
7358 goto badindex;
7360 str = endptr;
7363 /* Now str may include or +<num> or -<num> */
7364 if (*str == '+' || *str == '-') {
7365 int sign = (*str == '+' ? 1 : -1);
7367 idx += sign * jim_strtol(++str, &endptr);
7368 if (str == endptr || *endptr) {
7369 goto badindex;
7371 str = endptr;
7373 /* The only thing left should be spaces */
7374 while (isspace(UCHAR(*str))) {
7375 str++;
7377 if (*str) {
7378 goto badindex;
7380 if (end) {
7381 if (idx > 0) {
7382 idx = INT_MAX;
7384 else {
7385 /* end-1 is repesented as -2 */
7386 idx--;
7389 else if (idx < 0) {
7390 idx = -INT_MAX;
7393 /* Free the old internal repr and set the new one. */
7394 Jim_FreeIntRep(interp, objPtr);
7395 objPtr->typePtr = &indexObjType;
7396 objPtr->internalRep.intValue = idx;
7397 return JIM_OK;
7399 badindex:
7400 Jim_SetResultFormatted(interp,
7401 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7402 return JIM_ERR;
7405 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7407 /* Avoid shimmering if the object is an integer. */
7408 if (objPtr->typePtr == &intObjType) {
7409 jim_wide val = JimWideValue(objPtr);
7411 if (val < 0)
7412 *indexPtr = -INT_MAX;
7413 else if (val > INT_MAX)
7414 *indexPtr = INT_MAX;
7415 else
7416 *indexPtr = (int)val;
7417 return JIM_OK;
7419 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7420 return JIM_ERR;
7421 *indexPtr = objPtr->internalRep.intValue;
7422 return JIM_OK;
7425 /* -----------------------------------------------------------------------------
7426 * Return Code Object.
7427 * ---------------------------------------------------------------------------*/
7429 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7430 static const char * const jimReturnCodes[] = {
7431 "ok",
7432 "error",
7433 "return",
7434 "break",
7435 "continue",
7436 "signal",
7437 "exit",
7438 "eval",
7439 NULL
7442 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7444 static const Jim_ObjType returnCodeObjType = {
7445 "return-code",
7446 NULL,
7447 NULL,
7448 NULL,
7449 JIM_TYPE_NONE,
7452 /* Converts a (standard) return code to a string. Returns "?" for
7453 * non-standard return codes.
7455 const char *Jim_ReturnCode(int code)
7457 if (code < 0 || code >= (int)jimReturnCodesSize) {
7458 return "?";
7460 else {
7461 return jimReturnCodes[code];
7465 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7467 int returnCode;
7468 jim_wide wideValue;
7470 /* Try to convert into an integer */
7471 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7472 returnCode = (int)wideValue;
7473 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7474 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7475 return JIM_ERR;
7477 /* Free the old internal repr and set the new one. */
7478 Jim_FreeIntRep(interp, objPtr);
7479 objPtr->typePtr = &returnCodeObjType;
7480 objPtr->internalRep.intValue = returnCode;
7481 return JIM_OK;
7484 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7486 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7487 return JIM_ERR;
7488 *intPtr = objPtr->internalRep.intValue;
7489 return JIM_OK;
7492 /* -----------------------------------------------------------------------------
7493 * Expression Parsing
7494 * ---------------------------------------------------------------------------*/
7495 static int JimParseExprOperator(struct JimParserCtx *pc);
7496 static int JimParseExprNumber(struct JimParserCtx *pc);
7497 static int JimParseExprIrrational(struct JimParserCtx *pc);
7499 /* Exrp's Stack machine operators opcodes. */
7501 /* Binary operators (numbers) */
7502 enum
7504 /* Continues on from the JIM_TT_ space */
7505 /* Operations */
7506 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7507 JIM_EXPROP_DIV,
7508 JIM_EXPROP_MOD,
7509 JIM_EXPROP_SUB,
7510 JIM_EXPROP_ADD,
7511 JIM_EXPROP_LSHIFT,
7512 JIM_EXPROP_RSHIFT,
7513 JIM_EXPROP_ROTL,
7514 JIM_EXPROP_ROTR,
7515 JIM_EXPROP_LT,
7516 JIM_EXPROP_GT,
7517 JIM_EXPROP_LTE,
7518 JIM_EXPROP_GTE,
7519 JIM_EXPROP_NUMEQ,
7520 JIM_EXPROP_NUMNE,
7521 JIM_EXPROP_BITAND, /* 35 */
7522 JIM_EXPROP_BITXOR,
7523 JIM_EXPROP_BITOR,
7525 /* Note must keep these together */
7526 JIM_EXPROP_LOGICAND, /* 38 */
7527 JIM_EXPROP_LOGICAND_LEFT,
7528 JIM_EXPROP_LOGICAND_RIGHT,
7530 /* and these */
7531 JIM_EXPROP_LOGICOR, /* 41 */
7532 JIM_EXPROP_LOGICOR_LEFT,
7533 JIM_EXPROP_LOGICOR_RIGHT,
7535 /* and these */
7536 /* Ternary operators */
7537 JIM_EXPROP_TERNARY, /* 44 */
7538 JIM_EXPROP_TERNARY_LEFT,
7539 JIM_EXPROP_TERNARY_RIGHT,
7541 /* and these */
7542 JIM_EXPROP_COLON, /* 47 */
7543 JIM_EXPROP_COLON_LEFT,
7544 JIM_EXPROP_COLON_RIGHT,
7546 JIM_EXPROP_POW, /* 50 */
7548 /* Binary operators (strings) */
7549 JIM_EXPROP_STREQ, /* 51 */
7550 JIM_EXPROP_STRNE,
7551 JIM_EXPROP_STRIN,
7552 JIM_EXPROP_STRNI,
7554 /* Unary operators (numbers) */
7555 JIM_EXPROP_NOT, /* 55 */
7556 JIM_EXPROP_BITNOT,
7557 JIM_EXPROP_UNARYMINUS,
7558 JIM_EXPROP_UNARYPLUS,
7560 /* Functions */
7561 JIM_EXPROP_FUNC_FIRST, /* 59 */
7562 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7563 JIM_EXPROP_FUNC_WIDE,
7564 JIM_EXPROP_FUNC_ABS,
7565 JIM_EXPROP_FUNC_DOUBLE,
7566 JIM_EXPROP_FUNC_ROUND,
7567 JIM_EXPROP_FUNC_RAND,
7568 JIM_EXPROP_FUNC_SRAND,
7570 /* math functions from libm */
7571 JIM_EXPROP_FUNC_SIN, /* 65 */
7572 JIM_EXPROP_FUNC_COS,
7573 JIM_EXPROP_FUNC_TAN,
7574 JIM_EXPROP_FUNC_ASIN,
7575 JIM_EXPROP_FUNC_ACOS,
7576 JIM_EXPROP_FUNC_ATAN,
7577 JIM_EXPROP_FUNC_SINH,
7578 JIM_EXPROP_FUNC_COSH,
7579 JIM_EXPROP_FUNC_TANH,
7580 JIM_EXPROP_FUNC_CEIL,
7581 JIM_EXPROP_FUNC_FLOOR,
7582 JIM_EXPROP_FUNC_EXP,
7583 JIM_EXPROP_FUNC_LOG,
7584 JIM_EXPROP_FUNC_LOG10,
7585 JIM_EXPROP_FUNC_SQRT,
7586 JIM_EXPROP_FUNC_POW,
7589 struct JimExprState
7591 Jim_Obj **stack;
7592 int stacklen;
7593 int opcode;
7594 int skip;
7597 /* Operators table */
7598 typedef struct Jim_ExprOperator
7600 const char *name;
7601 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7602 unsigned char precedence;
7603 unsigned char arity;
7604 unsigned char lazy;
7605 unsigned char namelen;
7606 } Jim_ExprOperator;
7608 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7610 Jim_IncrRefCount(obj);
7611 e->stack[e->stacklen++] = obj;
7614 static Jim_Obj *ExprPop(struct JimExprState *e)
7616 return e->stack[--e->stacklen];
7619 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7621 int intresult = 1;
7622 int rc = JIM_OK;
7623 Jim_Obj *A = ExprPop(e);
7624 double dA, dC = 0;
7625 jim_wide wA, wC = 0;
7627 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7628 switch (e->opcode) {
7629 case JIM_EXPROP_FUNC_INT:
7630 case JIM_EXPROP_FUNC_WIDE:
7631 case JIM_EXPROP_FUNC_ROUND:
7632 case JIM_EXPROP_UNARYPLUS:
7633 wC = wA;
7634 break;
7635 case JIM_EXPROP_FUNC_DOUBLE:
7636 dC = wA;
7637 intresult = 0;
7638 break;
7639 case JIM_EXPROP_FUNC_ABS:
7640 wC = wA >= 0 ? wA : -wA;
7641 break;
7642 case JIM_EXPROP_UNARYMINUS:
7643 wC = -wA;
7644 break;
7645 case JIM_EXPROP_NOT:
7646 wC = !wA;
7647 break;
7648 default:
7649 abort();
7652 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7653 switch (e->opcode) {
7654 case JIM_EXPROP_FUNC_INT:
7655 case JIM_EXPROP_FUNC_WIDE:
7656 wC = dA;
7657 break;
7658 case JIM_EXPROP_FUNC_ROUND:
7659 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7660 break;
7661 case JIM_EXPROP_FUNC_DOUBLE:
7662 case JIM_EXPROP_UNARYPLUS:
7663 dC = dA;
7664 intresult = 0;
7665 break;
7666 case JIM_EXPROP_FUNC_ABS:
7667 dC = dA >= 0 ? dA : -dA;
7668 intresult = 0;
7669 break;
7670 case JIM_EXPROP_UNARYMINUS:
7671 dC = -dA;
7672 intresult = 0;
7673 break;
7674 case JIM_EXPROP_NOT:
7675 wC = !dA;
7676 break;
7677 default:
7678 abort();
7682 if (rc == JIM_OK) {
7683 if (intresult) {
7684 ExprPush(e, Jim_NewIntObj(interp, wC));
7686 else {
7687 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7691 Jim_DecrRefCount(interp, A);
7693 return rc;
7696 static double JimRandDouble(Jim_Interp *interp)
7698 unsigned long x;
7699 JimRandomBytes(interp, &x, sizeof(x));
7701 return (double)x / (unsigned long)~0;
7704 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7706 Jim_Obj *A = ExprPop(e);
7707 jim_wide wA;
7709 int rc = Jim_GetWide(interp, A, &wA);
7710 if (rc == JIM_OK) {
7711 switch (e->opcode) {
7712 case JIM_EXPROP_BITNOT:
7713 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7714 break;
7715 case JIM_EXPROP_FUNC_SRAND:
7716 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7717 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7718 break;
7719 default:
7720 abort();
7724 Jim_DecrRefCount(interp, A);
7726 return rc;
7729 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7731 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7733 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7735 return JIM_OK;
7738 #ifdef JIM_MATH_FUNCTIONS
7739 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7741 int rc;
7742 Jim_Obj *A = ExprPop(e);
7743 double dA, dC;
7745 rc = Jim_GetDouble(interp, A, &dA);
7746 if (rc == JIM_OK) {
7747 switch (e->opcode) {
7748 case JIM_EXPROP_FUNC_SIN:
7749 dC = sin(dA);
7750 break;
7751 case JIM_EXPROP_FUNC_COS:
7752 dC = cos(dA);
7753 break;
7754 case JIM_EXPROP_FUNC_TAN:
7755 dC = tan(dA);
7756 break;
7757 case JIM_EXPROP_FUNC_ASIN:
7758 dC = asin(dA);
7759 break;
7760 case JIM_EXPROP_FUNC_ACOS:
7761 dC = acos(dA);
7762 break;
7763 case JIM_EXPROP_FUNC_ATAN:
7764 dC = atan(dA);
7765 break;
7766 case JIM_EXPROP_FUNC_SINH:
7767 dC = sinh(dA);
7768 break;
7769 case JIM_EXPROP_FUNC_COSH:
7770 dC = cosh(dA);
7771 break;
7772 case JIM_EXPROP_FUNC_TANH:
7773 dC = tanh(dA);
7774 break;
7775 case JIM_EXPROP_FUNC_CEIL:
7776 dC = ceil(dA);
7777 break;
7778 case JIM_EXPROP_FUNC_FLOOR:
7779 dC = floor(dA);
7780 break;
7781 case JIM_EXPROP_FUNC_EXP:
7782 dC = exp(dA);
7783 break;
7784 case JIM_EXPROP_FUNC_LOG:
7785 dC = log(dA);
7786 break;
7787 case JIM_EXPROP_FUNC_LOG10:
7788 dC = log10(dA);
7789 break;
7790 case JIM_EXPROP_FUNC_SQRT:
7791 dC = sqrt(dA);
7792 break;
7793 default:
7794 abort();
7796 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7799 Jim_DecrRefCount(interp, A);
7801 return rc;
7803 #endif
7805 /* A binary operation on two ints */
7806 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7808 Jim_Obj *B = ExprPop(e);
7809 Jim_Obj *A = ExprPop(e);
7810 jim_wide wA, wB;
7811 int rc = JIM_ERR;
7813 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7814 jim_wide wC;
7816 rc = JIM_OK;
7818 switch (e->opcode) {
7819 case JIM_EXPROP_LSHIFT:
7820 wC = wA << wB;
7821 break;
7822 case JIM_EXPROP_RSHIFT:
7823 wC = wA >> wB;
7824 break;
7825 case JIM_EXPROP_BITAND:
7826 wC = wA & wB;
7827 break;
7828 case JIM_EXPROP_BITXOR:
7829 wC = wA ^ wB;
7830 break;
7831 case JIM_EXPROP_BITOR:
7832 wC = wA | wB;
7833 break;
7834 case JIM_EXPROP_MOD:
7835 if (wB == 0) {
7836 wC = 0;
7837 Jim_SetResultString(interp, "Division by zero", -1);
7838 rc = JIM_ERR;
7840 else {
7842 * From Tcl 8.x
7844 * This code is tricky: C doesn't guarantee much
7845 * about the quotient or remainder, but Tcl does.
7846 * The remainder always has the same sign as the
7847 * divisor and a smaller absolute value.
7849 int negative = 0;
7851 if (wB < 0) {
7852 wB = -wB;
7853 wA = -wA;
7854 negative = 1;
7856 wC = wA % wB;
7857 if (wC < 0) {
7858 wC += wB;
7860 if (negative) {
7861 wC = -wC;
7864 break;
7865 case JIM_EXPROP_ROTL:
7866 case JIM_EXPROP_ROTR:{
7867 /* uint32_t would be better. But not everyone has inttypes.h? */
7868 unsigned long uA = (unsigned long)wA;
7869 unsigned long uB = (unsigned long)wB;
7870 const unsigned int S = sizeof(unsigned long) * 8;
7872 /* Shift left by the word size or more is undefined. */
7873 uB %= S;
7875 if (e->opcode == JIM_EXPROP_ROTR) {
7876 uB = S - uB;
7878 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7879 break;
7881 default:
7882 abort();
7884 ExprPush(e, Jim_NewIntObj(interp, wC));
7888 Jim_DecrRefCount(interp, A);
7889 Jim_DecrRefCount(interp, B);
7891 return rc;
7895 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7896 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7898 int intresult = 1;
7899 int rc = JIM_OK;
7900 double dA, dB, dC = 0;
7901 jim_wide wA, wB, wC = 0;
7903 Jim_Obj *B = ExprPop(e);
7904 Jim_Obj *A = ExprPop(e);
7906 if ((A->typePtr != &doubleObjType || A->bytes) &&
7907 (B->typePtr != &doubleObjType || B->bytes) &&
7908 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7910 /* Both are ints */
7912 switch (e->opcode) {
7913 case JIM_EXPROP_POW:
7914 case JIM_EXPROP_FUNC_POW:
7915 wC = JimPowWide(wA, wB);
7916 break;
7917 case JIM_EXPROP_ADD:
7918 wC = wA + wB;
7919 break;
7920 case JIM_EXPROP_SUB:
7921 wC = wA - wB;
7922 break;
7923 case JIM_EXPROP_MUL:
7924 wC = wA * wB;
7925 break;
7926 case JIM_EXPROP_DIV:
7927 if (wB == 0) {
7928 Jim_SetResultString(interp, "Division by zero", -1);
7929 rc = JIM_ERR;
7931 else {
7933 * From Tcl 8.x
7935 * This code is tricky: C doesn't guarantee much
7936 * about the quotient or remainder, but Tcl does.
7937 * The remainder always has the same sign as the
7938 * divisor and a smaller absolute value.
7940 if (wB < 0) {
7941 wB = -wB;
7942 wA = -wA;
7944 wC = wA / wB;
7945 if (wA % wB < 0) {
7946 wC--;
7949 break;
7950 case JIM_EXPROP_LT:
7951 wC = wA < wB;
7952 break;
7953 case JIM_EXPROP_GT:
7954 wC = wA > wB;
7955 break;
7956 case JIM_EXPROP_LTE:
7957 wC = wA <= wB;
7958 break;
7959 case JIM_EXPROP_GTE:
7960 wC = wA >= wB;
7961 break;
7962 case JIM_EXPROP_NUMEQ:
7963 wC = wA == wB;
7964 break;
7965 case JIM_EXPROP_NUMNE:
7966 wC = wA != wB;
7967 break;
7968 default:
7969 abort();
7972 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7973 intresult = 0;
7974 switch (e->opcode) {
7975 case JIM_EXPROP_POW:
7976 case JIM_EXPROP_FUNC_POW:
7977 #ifdef JIM_MATH_FUNCTIONS
7978 dC = pow(dA, dB);
7979 #else
7980 Jim_SetResultString(interp, "unsupported", -1);
7981 rc = JIM_ERR;
7982 #endif
7983 break;
7984 case JIM_EXPROP_ADD:
7985 dC = dA + dB;
7986 break;
7987 case JIM_EXPROP_SUB:
7988 dC = dA - dB;
7989 break;
7990 case JIM_EXPROP_MUL:
7991 dC = dA * dB;
7992 break;
7993 case JIM_EXPROP_DIV:
7994 if (dB == 0) {
7995 #ifdef INFINITY
7996 dC = dA < 0 ? -INFINITY : INFINITY;
7997 #else
7998 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7999 #endif
8001 else {
8002 dC = dA / dB;
8004 break;
8005 case JIM_EXPROP_LT:
8006 wC = dA < dB;
8007 intresult = 1;
8008 break;
8009 case JIM_EXPROP_GT:
8010 wC = dA > dB;
8011 intresult = 1;
8012 break;
8013 case JIM_EXPROP_LTE:
8014 wC = dA <= dB;
8015 intresult = 1;
8016 break;
8017 case JIM_EXPROP_GTE:
8018 wC = dA >= dB;
8019 intresult = 1;
8020 break;
8021 case JIM_EXPROP_NUMEQ:
8022 wC = dA == dB;
8023 intresult = 1;
8024 break;
8025 case JIM_EXPROP_NUMNE:
8026 wC = dA != dB;
8027 intresult = 1;
8028 break;
8029 default:
8030 abort();
8033 else {
8034 /* Handle the string case */
8036 /* XXX: Could optimise the eq/ne case by checking lengths */
8037 int i = Jim_StringCompareObj(interp, A, B, 0);
8039 switch (e->opcode) {
8040 case JIM_EXPROP_LT:
8041 wC = i < 0;
8042 break;
8043 case JIM_EXPROP_GT:
8044 wC = i > 0;
8045 break;
8046 case JIM_EXPROP_LTE:
8047 wC = i <= 0;
8048 break;
8049 case JIM_EXPROP_GTE:
8050 wC = i >= 0;
8051 break;
8052 case JIM_EXPROP_NUMEQ:
8053 wC = i == 0;
8054 break;
8055 case JIM_EXPROP_NUMNE:
8056 wC = i != 0;
8057 break;
8058 default:
8059 rc = JIM_ERR;
8060 break;
8064 if (rc == JIM_OK) {
8065 if (intresult) {
8066 ExprPush(e, Jim_NewIntObj(interp, wC));
8068 else {
8069 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8073 Jim_DecrRefCount(interp, A);
8074 Jim_DecrRefCount(interp, B);
8076 return rc;
8079 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8081 int listlen;
8082 int i;
8084 listlen = Jim_ListLength(interp, listObjPtr);
8085 for (i = 0; i < listlen; i++) {
8086 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8087 return 1;
8090 return 0;
8093 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8095 Jim_Obj *B = ExprPop(e);
8096 Jim_Obj *A = ExprPop(e);
8098 jim_wide wC;
8100 switch (e->opcode) {
8101 case JIM_EXPROP_STREQ:
8102 case JIM_EXPROP_STRNE:
8103 wC = Jim_StringEqObj(A, B);
8104 if (e->opcode == JIM_EXPROP_STRNE) {
8105 wC = !wC;
8107 break;
8108 case JIM_EXPROP_STRIN:
8109 wC = JimSearchList(interp, B, A);
8110 break;
8111 case JIM_EXPROP_STRNI:
8112 wC = !JimSearchList(interp, B, A);
8113 break;
8114 default:
8115 abort();
8117 ExprPush(e, Jim_NewIntObj(interp, wC));
8119 Jim_DecrRefCount(interp, A);
8120 Jim_DecrRefCount(interp, B);
8122 return JIM_OK;
8125 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8127 long l;
8128 double d;
8130 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8131 return l != 0;
8133 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8134 return d != 0;
8136 return -1;
8139 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8141 Jim_Obj *skip = ExprPop(e);
8142 Jim_Obj *A = ExprPop(e);
8143 int rc = JIM_OK;
8145 switch (ExprBool(interp, A)) {
8146 case 0:
8147 /* false, so skip RHS opcodes with a 0 result */
8148 e->skip = JimWideValue(skip);
8149 ExprPush(e, Jim_NewIntObj(interp, 0));
8150 break;
8152 case 1:
8153 /* true so continue */
8154 break;
8156 case -1:
8157 /* Invalid */
8158 rc = JIM_ERR;
8160 Jim_DecrRefCount(interp, A);
8161 Jim_DecrRefCount(interp, skip);
8163 return rc;
8166 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8168 Jim_Obj *skip = ExprPop(e);
8169 Jim_Obj *A = ExprPop(e);
8170 int rc = JIM_OK;
8172 switch (ExprBool(interp, A)) {
8173 case 0:
8174 /* false, so do nothing */
8175 break;
8177 case 1:
8178 /* true so skip RHS opcodes with a 1 result */
8179 e->skip = JimWideValue(skip);
8180 ExprPush(e, Jim_NewIntObj(interp, 1));
8181 break;
8183 case -1:
8184 /* Invalid */
8185 rc = JIM_ERR;
8186 break;
8188 Jim_DecrRefCount(interp, A);
8189 Jim_DecrRefCount(interp, skip);
8191 return rc;
8194 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8196 Jim_Obj *A = ExprPop(e);
8197 int rc = JIM_OK;
8199 switch (ExprBool(interp, A)) {
8200 case 0:
8201 ExprPush(e, Jim_NewIntObj(interp, 0));
8202 break;
8204 case 1:
8205 ExprPush(e, Jim_NewIntObj(interp, 1));
8206 break;
8208 case -1:
8209 /* Invalid */
8210 rc = JIM_ERR;
8211 break;
8213 Jim_DecrRefCount(interp, A);
8215 return rc;
8218 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8220 Jim_Obj *skip = ExprPop(e);
8221 Jim_Obj *A = ExprPop(e);
8222 int rc = JIM_OK;
8224 /* Repush A */
8225 ExprPush(e, A);
8227 switch (ExprBool(interp, A)) {
8228 case 0:
8229 /* false, skip RHS opcodes */
8230 e->skip = JimWideValue(skip);
8231 /* Push a dummy value */
8232 ExprPush(e, Jim_NewIntObj(interp, 0));
8233 break;
8235 case 1:
8236 /* true so do nothing */
8237 break;
8239 case -1:
8240 /* Invalid */
8241 rc = JIM_ERR;
8242 break;
8244 Jim_DecrRefCount(interp, A);
8245 Jim_DecrRefCount(interp, skip);
8247 return rc;
8250 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8252 Jim_Obj *skip = ExprPop(e);
8253 Jim_Obj *B = ExprPop(e);
8254 Jim_Obj *A = ExprPop(e);
8256 /* No need to check for A as non-boolean */
8257 if (ExprBool(interp, A)) {
8258 /* true, so skip RHS opcodes */
8259 e->skip = JimWideValue(skip);
8260 /* Repush B as the answer */
8261 ExprPush(e, B);
8264 Jim_DecrRefCount(interp, skip);
8265 Jim_DecrRefCount(interp, A);
8266 Jim_DecrRefCount(interp, B);
8267 return JIM_OK;
8270 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8272 return JIM_OK;
8275 enum
8277 LAZY_NONE,
8278 LAZY_OP,
8279 LAZY_LEFT,
8280 LAZY_RIGHT
8283 /* name - precedence - arity - opcode
8285 * This array *must* be kept in sync with the JIM_EXPROP enum.
8287 * The following macros pre-compute the string length at compile time.
8289 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8290 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8292 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8293 OPRINIT("*", 110, 2, JimExprOpBin),
8294 OPRINIT("/", 110, 2, JimExprOpBin),
8295 OPRINIT("%", 110, 2, JimExprOpIntBin),
8297 OPRINIT("-", 100, 2, JimExprOpBin),
8298 OPRINIT("+", 100, 2, JimExprOpBin),
8300 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8301 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8303 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8304 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8306 OPRINIT("<", 80, 2, JimExprOpBin),
8307 OPRINIT(">", 80, 2, JimExprOpBin),
8308 OPRINIT("<=", 80, 2, JimExprOpBin),
8309 OPRINIT(">=", 80, 2, JimExprOpBin),
8311 OPRINIT("==", 70, 2, JimExprOpBin),
8312 OPRINIT("!=", 70, 2, JimExprOpBin),
8314 OPRINIT("&", 50, 2, JimExprOpIntBin),
8315 OPRINIT("^", 49, 2, JimExprOpIntBin),
8316 OPRINIT("|", 48, 2, JimExprOpIntBin),
8318 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8319 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8320 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8322 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8323 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8324 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8326 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8327 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8328 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8330 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8331 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8332 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8334 OPRINIT("**", 250, 2, JimExprOpBin),
8336 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8337 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8339 OPRINIT("in", 55, 2, JimExprOpStrBin),
8340 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8342 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8343 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8344 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8345 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8349 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8350 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8351 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8352 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8353 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8354 OPRINIT("rand", 200, 0, JimExprOpNone),
8355 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8357 #ifdef JIM_MATH_FUNCTIONS
8358 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8359 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8360 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8361 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8362 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8363 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8364 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8365 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8366 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8367 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8368 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8369 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8370 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8371 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8372 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8373 OPRINIT("pow", 200, 2, JimExprOpBin),
8374 #endif
8376 #undef OPRINIT
8377 #undef OPRINIT_LAZY
8379 #define JIM_EXPR_OPERATORS_NUM \
8380 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8382 static int JimParseExpression(struct JimParserCtx *pc)
8384 /* Discard spaces and quoted newline */
8385 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8386 if (*pc->p == '\n') {
8387 pc->linenr++;
8389 pc->p++;
8390 pc->len--;
8393 /* Common case */
8394 pc->tline = pc->linenr;
8395 pc->tstart = pc->p;
8397 if (pc->len == 0) {
8398 pc->tend = pc->p;
8399 pc->tt = JIM_TT_EOL;
8400 pc->eof = 1;
8401 return JIM_OK;
8403 switch (*(pc->p)) {
8404 case '(':
8405 pc->tt = JIM_TT_SUBEXPR_START;
8406 goto singlechar;
8407 case ')':
8408 pc->tt = JIM_TT_SUBEXPR_END;
8409 goto singlechar;
8410 case ',':
8411 pc->tt = JIM_TT_SUBEXPR_COMMA;
8412 singlechar:
8413 pc->tend = pc->p;
8414 pc->p++;
8415 pc->len--;
8416 break;
8417 case '[':
8418 return JimParseCmd(pc);
8419 case '$':
8420 if (JimParseVar(pc) == JIM_ERR)
8421 return JimParseExprOperator(pc);
8422 else {
8423 /* Don't allow expr sugar in expressions */
8424 if (pc->tt == JIM_TT_EXPRSUGAR) {
8425 return JIM_ERR;
8427 return JIM_OK;
8429 break;
8430 case '0':
8431 case '1':
8432 case '2':
8433 case '3':
8434 case '4':
8435 case '5':
8436 case '6':
8437 case '7':
8438 case '8':
8439 case '9':
8440 case '.':
8441 return JimParseExprNumber(pc);
8442 case '"':
8443 return JimParseQuote(pc);
8444 case '{':
8445 return JimParseBrace(pc);
8447 case 'N':
8448 case 'I':
8449 case 'n':
8450 case 'i':
8451 if (JimParseExprIrrational(pc) == JIM_ERR)
8452 return JimParseExprOperator(pc);
8453 break;
8454 default:
8455 return JimParseExprOperator(pc);
8456 break;
8458 return JIM_OK;
8461 static int JimParseExprNumber(struct JimParserCtx *pc)
8463 char *end;
8465 /* Assume an integer for now */
8466 pc->tt = JIM_TT_EXPR_INT;
8468 jim_strtoull(pc->p, (char **)&pc->p);
8469 /* Tried as an integer, but perhaps it parses as a double */
8470 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8471 /* Some stupid compilers insist they are cleverer that
8472 * we are. Even a (void) cast doesn't prevent this warning!
8474 if (strtod(pc->tstart, &end)) { /* nothing */ }
8475 if (end == pc->tstart)
8476 return JIM_ERR;
8477 if (end > pc->p) {
8478 /* Yes, double captured more chars */
8479 pc->tt = JIM_TT_EXPR_DOUBLE;
8480 pc->p = end;
8483 pc->tend = pc->p - 1;
8484 pc->len -= (pc->p - pc->tstart);
8485 return JIM_OK;
8488 static int JimParseExprIrrational(struct JimParserCtx *pc)
8490 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8491 int i;
8493 for (i = 0; irrationals[i]; i++) {
8494 const char *irr = irrationals[i];
8496 if (strncmp(irr, pc->p, 3) == 0) {
8497 pc->p += 3;
8498 pc->len -= 3;
8499 pc->tend = pc->p - 1;
8500 pc->tt = JIM_TT_EXPR_DOUBLE;
8501 return JIM_OK;
8504 return JIM_ERR;
8507 static int JimParseExprOperator(struct JimParserCtx *pc)
8509 int i;
8510 int bestIdx = -1, bestLen = 0;
8512 /* Try to get the longest match. */
8513 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8514 const char * const opname = Jim_ExprOperators[i].name;
8515 const int oplen = Jim_ExprOperators[i].namelen;
8517 if (opname == NULL || opname[0] != pc->p[0]) {
8518 continue;
8521 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8522 bestIdx = i + JIM_TT_EXPR_OP;
8523 bestLen = oplen;
8526 if (bestIdx == -1) {
8527 return JIM_ERR;
8530 /* Validate paretheses around function arguments */
8531 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8532 const char *p = pc->p + bestLen;
8533 int len = pc->len - bestLen;
8535 while (len && isspace(UCHAR(*p))) {
8536 len--;
8537 p++;
8539 if (*p != '(') {
8540 return JIM_ERR;
8543 pc->tend = pc->p + bestLen - 1;
8544 pc->p += bestLen;
8545 pc->len -= bestLen;
8547 pc->tt = bestIdx;
8548 return JIM_OK;
8551 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8553 static Jim_ExprOperator dummy_op;
8554 if (opcode < JIM_TT_EXPR_OP) {
8555 return &dummy_op;
8557 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8560 const char *jim_tt_name(int type)
8562 static const char * const tt_names[JIM_TT_EXPR_OP] =
8563 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8564 "DBL", "$()" };
8565 if (type < JIM_TT_EXPR_OP) {
8566 return tt_names[type];
8568 else {
8569 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8570 static char buf[20];
8572 if (op->name) {
8573 return op->name;
8575 sprintf(buf, "(%d)", type);
8576 return buf;
8580 /* -----------------------------------------------------------------------------
8581 * Expression Object
8582 * ---------------------------------------------------------------------------*/
8583 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8584 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8585 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8587 static const Jim_ObjType exprObjType = {
8588 "expression",
8589 FreeExprInternalRep,
8590 DupExprInternalRep,
8591 NULL,
8592 JIM_TYPE_REFERENCES,
8595 /* Expr bytecode structure */
8596 typedef struct ExprByteCode
8598 ScriptToken *token; /* Tokens array. */
8599 int len; /* Length as number of tokens. */
8600 int inUse; /* Used for sharing. */
8601 } ExprByteCode;
8603 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8605 int i;
8607 for (i = 0; i < expr->len; i++) {
8608 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8610 Jim_Free(expr->token);
8611 Jim_Free(expr);
8614 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8616 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8618 if (expr) {
8619 if (--expr->inUse != 0) {
8620 return;
8623 ExprFreeByteCode(interp, expr);
8627 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8629 JIM_NOTUSED(interp);
8630 JIM_NOTUSED(srcPtr);
8632 /* Just returns an simple string. */
8633 dupPtr->typePtr = NULL;
8636 /* Check if an expr program looks correct. */
8637 static int ExprCheckCorrectness(ExprByteCode * expr)
8639 int i;
8640 int stacklen = 0;
8641 int ternary = 0;
8643 /* Try to check if there are stack underflows,
8644 * and make sure at the end of the program there is
8645 * a single result on the stack. */
8646 for (i = 0; i < expr->len; i++) {
8647 ScriptToken *t = &expr->token[i];
8648 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8650 stacklen -= op->arity;
8651 if (stacklen < 0) {
8652 break;
8654 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8655 ternary++;
8657 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8658 ternary--;
8661 /* All operations and operands add one to the stack */
8662 stacklen++;
8664 if (stacklen != 1 || ternary != 0) {
8665 return JIM_ERR;
8667 return JIM_OK;
8670 /* This procedure converts every occurrence of || and && opereators
8671 * in lazy unary versions.
8673 * a b || is converted into:
8675 * a <offset> |L b |R
8677 * a b && is converted into:
8679 * a <offset> &L b &R
8681 * "|L" checks if 'a' is true:
8682 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8683 * the opcode just after |R.
8684 * 2) if it is false does nothing.
8685 * "|R" checks if 'b' is true:
8686 * 1) if it is true pushes 1, otherwise pushes 0.
8688 * "&L" checks if 'a' is true:
8689 * 1) if it is true does nothing.
8690 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8691 * the opcode just after &R
8692 * "&R" checks if 'a' is true:
8693 * if it is true pushes 1, otherwise pushes 0.
8695 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8697 int i;
8699 int leftindex, arity, offset;
8701 /* Search for the end of the first operator */
8702 leftindex = expr->len - 1;
8704 arity = 1;
8705 while (arity) {
8706 ScriptToken *tt = &expr->token[leftindex];
8708 if (tt->type >= JIM_TT_EXPR_OP) {
8709 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8711 arity--;
8712 if (--leftindex < 0) {
8713 return JIM_ERR;
8716 leftindex++;
8718 /* Move them up */
8719 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8720 sizeof(*expr->token) * (expr->len - leftindex));
8721 expr->len += 2;
8722 offset = (expr->len - leftindex) - 1;
8724 /* Now we rely on the fact the the left and right version have opcodes
8725 * 1 and 2 after the main opcode respectively
8727 expr->token[leftindex + 1].type = t->type + 1;
8728 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8730 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8731 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8733 /* Now add the 'R' operator */
8734 expr->token[expr->len].objPtr = interp->emptyObj;
8735 expr->token[expr->len].type = t->type + 2;
8736 expr->len++;
8738 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8739 for (i = leftindex - 1; i > 0; i--) {
8740 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8741 if (op->lazy == LAZY_LEFT) {
8742 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8743 JimWideValue(expr->token[i - 1].objPtr) += 2;
8747 return JIM_OK;
8750 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8752 struct ScriptToken *token = &expr->token[expr->len];
8753 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8755 if (op->lazy == LAZY_OP) {
8756 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8757 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8758 return JIM_ERR;
8761 else {
8762 token->objPtr = interp->emptyObj;
8763 token->type = t->type;
8764 expr->len++;
8766 return JIM_OK;
8770 * Returns the index of the COLON_LEFT to the left of 'right_index'
8771 * taking into account nesting.
8773 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8775 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8777 int ternary_count = 1;
8779 right_index--;
8781 while (right_index > 1) {
8782 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8783 ternary_count--;
8785 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8786 ternary_count++;
8788 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8789 return right_index;
8791 right_index--;
8794 /*notreached*/
8795 return -1;
8799 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8801 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8802 * Otherwise returns 0.
8804 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8806 int i = right_index - 1;
8807 int ternary_count = 1;
8809 while (i > 1) {
8810 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8811 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8812 *prev_right_index = i - 2;
8813 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8814 return 1;
8817 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8818 if (ternary_count == 0) {
8819 return 0;
8821 ternary_count++;
8823 i--;
8825 return 0;
8829 * ExprTernaryReorderExpression description
8830 * ========================================
8832 * ?: is right-to-left associative which doesn't work with the stack-based
8833 * expression engine. The fix is to reorder the bytecode.
8835 * The expression:
8837 * expr 1?2:0?3:4
8839 * Has initial bytecode:
8841 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8842 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8844 * The fix involves simulating this expression instead:
8846 * expr 1?2:(0?3:4)
8848 * With the following bytecode:
8850 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8851 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8853 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8854 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8855 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8856 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8858 * ExprTernaryReorderExpression works thus as follows :
8859 * - start from the end of the stack
8860 * - while walking towards the beginning of the stack
8861 * if token=JIM_EXPROP_COLON_RIGHT then
8862 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8863 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8864 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8865 * if all found then
8866 * perform the rotation
8867 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8868 * end if
8869 * end if
8871 * Note: care has to be taken for nested ternary constructs!!!
8873 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8875 int i;
8877 for (i = expr->len - 1; i > 1; i--) {
8878 int prev_right_index;
8879 int prev_left_index;
8880 int j;
8881 ScriptToken tmp;
8883 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8884 continue;
8887 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8888 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8889 continue;
8893 ** rotate tokens down
8895 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8896 ** | | |
8897 ** | V V
8898 ** | [...] : ...
8899 ** | | |
8900 ** | V V
8901 ** | [...] : ...
8902 ** | | |
8903 ** | V V
8904 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8906 tmp = expr->token[prev_right_index];
8907 for (j = prev_right_index; j < i; j++) {
8908 expr->token[j] = expr->token[j + 1];
8910 expr->token[i] = tmp;
8912 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8914 * This is 'colon left increment' = i - prev_right_index
8916 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8917 * [prev_left_index-1] : skip_count
8920 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8922 /* Adjust for i-- in the loop */
8923 i++;
8927 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8929 Jim_Stack stack;
8930 ExprByteCode *expr;
8931 int ok = 1;
8932 int i;
8933 int prevtt = JIM_TT_NONE;
8934 int have_ternary = 0;
8936 /* -1 for EOL */
8937 int count = tokenlist->count - 1;
8939 expr = Jim_Alloc(sizeof(*expr));
8940 expr->inUse = 1;
8941 expr->len = 0;
8943 Jim_InitStack(&stack);
8945 /* Need extra bytecodes for lazy operators.
8946 * Also check for the ternary operator
8948 for (i = 0; i < tokenlist->count; i++) {
8949 ParseToken *t = &tokenlist->list[i];
8950 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8952 if (op->lazy == LAZY_OP) {
8953 count += 2;
8954 /* Ternary is a lazy op but also needs reordering */
8955 if (t->type == JIM_EXPROP_TERNARY) {
8956 have_ternary = 1;
8961 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8963 for (i = 0; i < tokenlist->count && ok; i++) {
8964 ParseToken *t = &tokenlist->list[i];
8966 /* Next token will be stored here */
8967 struct ScriptToken *token = &expr->token[expr->len];
8969 if (t->type == JIM_TT_EOL) {
8970 break;
8973 switch (t->type) {
8974 case JIM_TT_STR:
8975 case JIM_TT_ESC:
8976 case JIM_TT_VAR:
8977 case JIM_TT_DICTSUGAR:
8978 case JIM_TT_EXPRSUGAR:
8979 case JIM_TT_CMD:
8980 token->type = t->type;
8981 strexpr:
8982 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8983 if (t->type == JIM_TT_CMD) {
8984 /* Only commands need source info */
8985 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8987 expr->len++;
8988 break;
8990 case JIM_TT_EXPR_INT:
8991 case JIM_TT_EXPR_DOUBLE:
8993 char *endptr;
8994 if (t->type == JIM_TT_EXPR_INT) {
8995 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8997 else {
8998 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9000 if (endptr != t->token + t->len) {
9001 /* Conversion failed, so just store it as a string */
9002 Jim_FreeNewObj(interp, token->objPtr);
9003 token->type = JIM_TT_STR;
9004 goto strexpr;
9006 token->type = t->type;
9007 expr->len++;
9009 break;
9011 case JIM_TT_SUBEXPR_START:
9012 Jim_StackPush(&stack, t);
9013 prevtt = JIM_TT_NONE;
9014 continue;
9016 case JIM_TT_SUBEXPR_COMMA:
9017 /* Simple approach. Comma is simply ignored */
9018 continue;
9020 case JIM_TT_SUBEXPR_END:
9021 ok = 0;
9022 while (Jim_StackLen(&stack)) {
9023 ParseToken *tt = Jim_StackPop(&stack);
9025 if (tt->type == JIM_TT_SUBEXPR_START) {
9026 ok = 1;
9027 break;
9030 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9031 goto err;
9034 if (!ok) {
9035 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9036 goto err;
9038 break;
9041 default:{
9042 /* Must be an operator */
9043 const struct Jim_ExprOperator *op;
9044 ParseToken *tt;
9046 /* Convert -/+ to unary minus or unary plus if necessary */
9047 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9048 if (t->type == JIM_EXPROP_SUB) {
9049 t->type = JIM_EXPROP_UNARYMINUS;
9051 else if (t->type == JIM_EXPROP_ADD) {
9052 t->type = JIM_EXPROP_UNARYPLUS;
9056 op = JimExprOperatorInfoByOpcode(t->type);
9058 /* Now handle precedence */
9059 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9060 const struct Jim_ExprOperator *tt_op =
9061 JimExprOperatorInfoByOpcode(tt->type);
9063 /* Note that right-to-left associativity of ?: operator is handled later */
9065 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9066 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9067 ok = 0;
9068 goto err;
9070 Jim_StackPop(&stack);
9072 else {
9073 break;
9076 Jim_StackPush(&stack, t);
9077 break;
9080 prevtt = t->type;
9083 /* Reduce any remaining subexpr */
9084 while (Jim_StackLen(&stack)) {
9085 ParseToken *tt = Jim_StackPop(&stack);
9087 if (tt->type == JIM_TT_SUBEXPR_START) {
9088 ok = 0;
9089 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9090 goto err;
9092 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9093 ok = 0;
9094 goto err;
9098 if (have_ternary) {
9099 ExprTernaryReorderExpression(interp, expr);
9102 err:
9103 /* Free the stack used for the compilation. */
9104 Jim_FreeStack(&stack);
9106 for (i = 0; i < expr->len; i++) {
9107 Jim_IncrRefCount(expr->token[i].objPtr);
9110 if (!ok) {
9111 ExprFreeByteCode(interp, expr);
9112 return NULL;
9115 return expr;
9119 /* This method takes the string representation of an expression
9120 * and generates a program for the Expr's stack-based VM. */
9121 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9123 int exprTextLen;
9124 const char *exprText;
9125 struct JimParserCtx parser;
9126 struct ExprByteCode *expr;
9127 ParseTokenList tokenlist;
9128 int line;
9129 Jim_Obj *fileNameObj;
9130 int rc = JIM_ERR;
9132 /* Try to get information about filename / line number */
9133 if (objPtr->typePtr == &sourceObjType) {
9134 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9135 line = objPtr->internalRep.sourceValue.lineNumber;
9137 else {
9138 fileNameObj = interp->emptyObj;
9139 line = 1;
9141 Jim_IncrRefCount(fileNameObj);
9143 exprText = Jim_GetString(objPtr, &exprTextLen);
9145 /* Initially tokenise the expression into tokenlist */
9146 ScriptTokenListInit(&tokenlist);
9148 JimParserInit(&parser, exprText, exprTextLen, line);
9149 while (!parser.eof) {
9150 if (JimParseExpression(&parser) != JIM_OK) {
9151 ScriptTokenListFree(&tokenlist);
9152 invalidexpr:
9153 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9154 expr = NULL;
9155 goto err;
9158 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9159 parser.tline);
9162 #ifdef DEBUG_SHOW_EXPR_TOKENS
9164 int i;
9165 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9166 for (i = 0; i < tokenlist.count; i++) {
9167 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9168 tokenlist.list[i].len, tokenlist.list[i].token);
9171 #endif
9173 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9174 ScriptTokenListFree(&tokenlist);
9175 Jim_DecrRefCount(interp, fileNameObj);
9176 return JIM_ERR;
9179 /* Now create the expression bytecode from the tokenlist */
9180 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9182 /* No longer need the token list */
9183 ScriptTokenListFree(&tokenlist);
9185 if (!expr) {
9186 goto err;
9189 #ifdef DEBUG_SHOW_EXPR
9191 int i;
9193 printf("==== Expr ====\n");
9194 for (i = 0; i < expr->len; i++) {
9195 ScriptToken *t = &expr->token[i];
9197 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9200 #endif
9202 /* Check program correctness. */
9203 if (ExprCheckCorrectness(expr) != JIM_OK) {
9204 ExprFreeByteCode(interp, expr);
9205 goto invalidexpr;
9208 rc = JIM_OK;
9210 err:
9211 /* Free the old internal rep and set the new one. */
9212 Jim_DecrRefCount(interp, fileNameObj);
9213 Jim_FreeIntRep(interp, objPtr);
9214 Jim_SetIntRepPtr(objPtr, expr);
9215 objPtr->typePtr = &exprObjType;
9216 return rc;
9219 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9221 if (objPtr->typePtr != &exprObjType) {
9222 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9223 return NULL;
9226 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9229 #ifdef JIM_OPTIMIZATION
9230 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9232 if (token->type == JIM_TT_EXPR_INT)
9233 return token->objPtr;
9234 else if (token->type == JIM_TT_VAR)
9235 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9236 else if (token->type == JIM_TT_DICTSUGAR)
9237 return JimExpandDictSugar(interp, token->objPtr);
9238 else
9239 return NULL;
9241 #endif
9243 /* -----------------------------------------------------------------------------
9244 * Expressions evaluation.
9245 * Jim uses a specialized stack-based virtual machine for expressions,
9246 * that takes advantage of the fact that expr's operators
9247 * can't be redefined.
9249 * Jim_EvalExpression() uses the bytecode compiled by
9250 * SetExprFromAny() method of the "expression" object.
9252 * On success a Tcl Object containing the result of the evaluation
9253 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9254 * returned.
9255 * On error the function returns a retcode != to JIM_OK and set a suitable
9256 * error on the interp.
9257 * ---------------------------------------------------------------------------*/
9258 #define JIM_EE_STATICSTACK_LEN 10
9260 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9262 ExprByteCode *expr;
9263 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9264 int i;
9265 int retcode = JIM_OK;
9266 struct JimExprState e;
9268 expr = JimGetExpression(interp, exprObjPtr);
9269 if (!expr) {
9270 return JIM_ERR; /* error in expression. */
9273 #ifdef JIM_OPTIMIZATION
9274 /* Check for one of the following common expressions used by while/for
9276 * CONST
9277 * $a
9278 * !$a
9279 * $a < CONST, $a < $b
9280 * $a <= CONST, $a <= $b
9281 * $a > CONST, $a > $b
9282 * $a >= CONST, $a >= $b
9283 * $a != CONST, $a != $b
9284 * $a == CONST, $a == $b
9287 Jim_Obj *objPtr;
9289 /* STEP 1 -- Check if there are the conditions to run the specialized
9290 * version of while */
9292 switch (expr->len) {
9293 case 1:
9294 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9295 if (objPtr) {
9296 Jim_IncrRefCount(objPtr);
9297 *exprResultPtrPtr = objPtr;
9298 return JIM_OK;
9300 break;
9302 case 2:
9303 if (expr->token[1].type == JIM_EXPROP_NOT) {
9304 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9306 if (objPtr && JimIsWide(objPtr)) {
9307 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9308 Jim_IncrRefCount(*exprResultPtrPtr);
9309 return JIM_OK;
9312 break;
9314 case 3:
9315 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9316 if (objPtr && JimIsWide(objPtr)) {
9317 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9318 if (objPtr2 && JimIsWide(objPtr2)) {
9319 jim_wide wideValueA = JimWideValue(objPtr);
9320 jim_wide wideValueB = JimWideValue(objPtr2);
9321 int cmpRes;
9322 switch (expr->token[2].type) {
9323 case JIM_EXPROP_LT:
9324 cmpRes = wideValueA < wideValueB;
9325 break;
9326 case JIM_EXPROP_LTE:
9327 cmpRes = wideValueA <= wideValueB;
9328 break;
9329 case JIM_EXPROP_GT:
9330 cmpRes = wideValueA > wideValueB;
9331 break;
9332 case JIM_EXPROP_GTE:
9333 cmpRes = wideValueA >= wideValueB;
9334 break;
9335 case JIM_EXPROP_NUMEQ:
9336 cmpRes = wideValueA == wideValueB;
9337 break;
9338 case JIM_EXPROP_NUMNE:
9339 cmpRes = wideValueA != wideValueB;
9340 break;
9341 default:
9342 goto noopt;
9344 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9345 Jim_IncrRefCount(*exprResultPtrPtr);
9346 return JIM_OK;
9349 break;
9352 noopt:
9353 #endif
9355 /* In order to avoid that the internal repr gets freed due to
9356 * shimmering of the exprObjPtr's object, we make the internal rep
9357 * shared. */
9358 expr->inUse++;
9360 /* The stack-based expr VM itself */
9362 /* Stack allocation. Expr programs have the feature that
9363 * a program of length N can't require a stack longer than
9364 * N. */
9365 if (expr->len > JIM_EE_STATICSTACK_LEN)
9366 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9367 else
9368 e.stack = staticStack;
9370 e.stacklen = 0;
9372 /* Execute every instruction */
9373 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9374 Jim_Obj *objPtr;
9376 switch (expr->token[i].type) {
9377 case JIM_TT_EXPR_INT:
9378 case JIM_TT_EXPR_DOUBLE:
9379 case JIM_TT_STR:
9380 ExprPush(&e, expr->token[i].objPtr);
9381 break;
9383 case JIM_TT_VAR:
9384 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9385 if (objPtr) {
9386 ExprPush(&e, objPtr);
9388 else {
9389 retcode = JIM_ERR;
9391 break;
9393 case JIM_TT_DICTSUGAR:
9394 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9395 if (objPtr) {
9396 ExprPush(&e, objPtr);
9398 else {
9399 retcode = JIM_ERR;
9401 break;
9403 case JIM_TT_ESC:
9404 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9405 if (retcode == JIM_OK) {
9406 ExprPush(&e, objPtr);
9408 break;
9410 case JIM_TT_CMD:
9411 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9412 if (retcode == JIM_OK) {
9413 ExprPush(&e, Jim_GetResult(interp));
9415 break;
9417 default:{
9418 /* Find and execute the operation */
9419 e.skip = 0;
9420 e.opcode = expr->token[i].type;
9422 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9423 /* Skip some opcodes if necessary */
9424 i += e.skip;
9425 continue;
9430 expr->inUse--;
9432 if (retcode == JIM_OK) {
9433 *exprResultPtrPtr = ExprPop(&e);
9435 else {
9436 for (i = 0; i < e.stacklen; i++) {
9437 Jim_DecrRefCount(interp, e.stack[i]);
9440 if (e.stack != staticStack) {
9441 Jim_Free(e.stack);
9443 return retcode;
9446 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9448 int retcode;
9449 jim_wide wideValue;
9450 double doubleValue;
9451 Jim_Obj *exprResultPtr;
9453 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9454 if (retcode != JIM_OK)
9455 return retcode;
9457 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9458 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9459 Jim_DecrRefCount(interp, exprResultPtr);
9460 return JIM_ERR;
9462 else {
9463 Jim_DecrRefCount(interp, exprResultPtr);
9464 *boolPtr = doubleValue != 0;
9465 return JIM_OK;
9468 *boolPtr = wideValue != 0;
9470 Jim_DecrRefCount(interp, exprResultPtr);
9471 return JIM_OK;
9474 /* -----------------------------------------------------------------------------
9475 * ScanFormat String Object
9476 * ---------------------------------------------------------------------------*/
9478 /* This Jim_Obj will held a parsed representation of a format string passed to
9479 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9480 * to be parsed in its entirely first and then, if correct, can be used for
9481 * scanning. To avoid endless re-parsing, the parsed representation will be
9482 * stored in an internal representation and re-used for performance reason. */
9484 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9485 * scanformat string. This part will later be used to extract information
9486 * out from the string to be parsed by Jim_ScanString */
9488 typedef struct ScanFmtPartDescr
9490 char *arg; /* Specification of a CHARSET conversion */
9491 char *prefix; /* Prefix to be scanned literally before conversion */
9492 size_t width; /* Maximal width of input to be converted */
9493 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9494 char type; /* Type of conversion (e.g. c, d, f) */
9495 char modifier; /* Modify type (e.g. l - long, h - short */
9496 } ScanFmtPartDescr;
9498 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9499 * string parsed and separated in part descriptions. Furthermore it contains
9500 * the original string representation of the scanformat string to allow for
9501 * fast update of the Jim_Obj's string representation part.
9503 * As an add-on the internal object representation adds some scratch pad area
9504 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9505 * memory for purpose of string scanning.
9507 * The error member points to a static allocated string in case of a mal-
9508 * formed scanformat string or it contains '0' (NULL) in case of a valid
9509 * parse representation.
9511 * The whole memory of the internal representation is allocated as a single
9512 * area of memory that will be internally separated. So freeing and duplicating
9513 * of such an object is cheap */
9515 typedef struct ScanFmtStringObj
9517 jim_wide size; /* Size of internal repr in bytes */
9518 char *stringRep; /* Original string representation */
9519 size_t count; /* Number of ScanFmtPartDescr contained */
9520 size_t convCount; /* Number of conversions that will assign */
9521 size_t maxPos; /* Max position index if XPG3 is used */
9522 const char *error; /* Ptr to error text (NULL if no error */
9523 char *scratch; /* Some scratch pad used by Jim_ScanString */
9524 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9525 } ScanFmtStringObj;
9528 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9529 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9530 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9532 static const Jim_ObjType scanFmtStringObjType = {
9533 "scanformatstring",
9534 FreeScanFmtInternalRep,
9535 DupScanFmtInternalRep,
9536 UpdateStringOfScanFmt,
9537 JIM_TYPE_NONE,
9540 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9542 JIM_NOTUSED(interp);
9543 Jim_Free((char *)objPtr->internalRep.ptr);
9544 objPtr->internalRep.ptr = 0;
9547 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9549 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9550 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9552 JIM_NOTUSED(interp);
9553 memcpy(newVec, srcPtr->internalRep.ptr, size);
9554 dupPtr->internalRep.ptr = newVec;
9555 dupPtr->typePtr = &scanFmtStringObjType;
9558 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9560 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9563 /* SetScanFmtFromAny will parse a given string and create the internal
9564 * representation of the format specification. In case of an error
9565 * the error data member of the internal representation will be set
9566 * to an descriptive error text and the function will be left with
9567 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9568 * specification */
9570 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9572 ScanFmtStringObj *fmtObj;
9573 char *buffer;
9574 int maxCount, i, approxSize, lastPos = -1;
9575 const char *fmt = objPtr->bytes;
9576 int maxFmtLen = objPtr->length;
9577 const char *fmtEnd = fmt + maxFmtLen;
9578 int curr;
9580 Jim_FreeIntRep(interp, objPtr);
9581 /* Count how many conversions could take place maximally */
9582 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9583 if (fmt[i] == '%')
9584 ++maxCount;
9585 /* Calculate an approximation of the memory necessary */
9586 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9587 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9588 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9589 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9590 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9591 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9592 +1; /* safety byte */
9593 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9594 memset(fmtObj, 0, approxSize);
9595 fmtObj->size = approxSize;
9596 fmtObj->maxPos = 0;
9597 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9598 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9599 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9600 buffer = fmtObj->stringRep + maxFmtLen + 1;
9601 objPtr->internalRep.ptr = fmtObj;
9602 objPtr->typePtr = &scanFmtStringObjType;
9603 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9604 int width = 0, skip;
9605 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9607 fmtObj->count++;
9608 descr->width = 0; /* Assume width unspecified */
9609 /* Overread and store any "literal" prefix */
9610 if (*fmt != '%' || fmt[1] == '%') {
9611 descr->type = 0;
9612 descr->prefix = &buffer[i];
9613 for (; fmt < fmtEnd; ++fmt) {
9614 if (*fmt == '%') {
9615 if (fmt[1] != '%')
9616 break;
9617 ++fmt;
9619 buffer[i++] = *fmt;
9621 buffer[i++] = 0;
9623 /* Skip the conversion introducing '%' sign */
9624 ++fmt;
9625 /* End reached due to non-conversion literal only? */
9626 if (fmt >= fmtEnd)
9627 goto done;
9628 descr->pos = 0; /* Assume "natural" positioning */
9629 if (*fmt == '*') {
9630 descr->pos = -1; /* Okay, conversion will not be assigned */
9631 ++fmt;
9633 else
9634 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9635 /* Check if next token is a number (could be width or pos */
9636 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9637 fmt += skip;
9638 /* Was the number a XPG3 position specifier? */
9639 if (descr->pos != -1 && *fmt == '$') {
9640 int prev;
9642 ++fmt;
9643 descr->pos = width;
9644 width = 0;
9645 /* Look if "natural" postioning and XPG3 one was mixed */
9646 if ((lastPos == 0 && descr->pos > 0)
9647 || (lastPos > 0 && descr->pos == 0)) {
9648 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9649 return JIM_ERR;
9651 /* Look if this position was already used */
9652 for (prev = 0; prev < curr; ++prev) {
9653 if (fmtObj->descr[prev].pos == -1)
9654 continue;
9655 if (fmtObj->descr[prev].pos == descr->pos) {
9656 fmtObj->error =
9657 "variable is assigned by multiple \"%n$\" conversion specifiers";
9658 return JIM_ERR;
9661 /* Try to find a width after the XPG3 specifier */
9662 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9663 descr->width = width;
9664 fmt += skip;
9666 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9667 fmtObj->maxPos = descr->pos;
9669 else {
9670 /* Number was not a XPG3, so it has to be a width */
9671 descr->width = width;
9674 /* If positioning mode was undetermined yet, fix this */
9675 if (lastPos == -1)
9676 lastPos = descr->pos;
9677 /* Handle CHARSET conversion type ... */
9678 if (*fmt == '[') {
9679 int swapped = 1, beg = i, end, j;
9681 descr->type = '[';
9682 descr->arg = &buffer[i];
9683 ++fmt;
9684 if (*fmt == '^')
9685 buffer[i++] = *fmt++;
9686 if (*fmt == ']')
9687 buffer[i++] = *fmt++;
9688 while (*fmt && *fmt != ']')
9689 buffer[i++] = *fmt++;
9690 if (*fmt != ']') {
9691 fmtObj->error = "unmatched [ in format string";
9692 return JIM_ERR;
9694 end = i;
9695 buffer[i++] = 0;
9696 /* In case a range fence was given "backwards", swap it */
9697 while (swapped) {
9698 swapped = 0;
9699 for (j = beg + 1; j < end - 1; ++j) {
9700 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9701 char tmp = buffer[j - 1];
9703 buffer[j - 1] = buffer[j + 1];
9704 buffer[j + 1] = tmp;
9705 swapped = 1;
9710 else {
9711 /* Remember any valid modifier if given */
9712 if (strchr("hlL", *fmt) != 0)
9713 descr->modifier = tolower((int)*fmt++);
9715 descr->type = *fmt;
9716 if (strchr("efgcsndoxui", *fmt) == 0) {
9717 fmtObj->error = "bad scan conversion character";
9718 return JIM_ERR;
9720 else if (*fmt == 'c' && descr->width != 0) {
9721 fmtObj->error = "field width may not be specified in %c " "conversion";
9722 return JIM_ERR;
9724 else if (*fmt == 'u' && descr->modifier == 'l') {
9725 fmtObj->error = "unsigned wide not supported";
9726 return JIM_ERR;
9729 curr++;
9731 done:
9732 return JIM_OK;
9735 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9737 #define FormatGetCnvCount(_fo_) \
9738 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9739 #define FormatGetMaxPos(_fo_) \
9740 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9741 #define FormatGetError(_fo_) \
9742 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9744 /* JimScanAString is used to scan an unspecified string that ends with
9745 * next WS, or a string that is specified via a charset.
9748 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9750 char *buffer = Jim_StrDup(str);
9751 char *p = buffer;
9753 while (*str) {
9754 int c;
9755 int n;
9757 if (!sdescr && isspace(UCHAR(*str)))
9758 break; /* EOS via WS if unspecified */
9760 n = utf8_tounicode(str, &c);
9761 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9762 break;
9763 while (n--)
9764 *p++ = *str++;
9766 *p = 0;
9767 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9770 /* ScanOneEntry will scan one entry out of the string passed as argument.
9771 * It use the sscanf() function for this task. After extracting and
9772 * converting of the value, the count of scanned characters will be
9773 * returned of -1 in case of no conversion tool place and string was
9774 * already scanned thru */
9776 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9777 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9779 const char *tok;
9780 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9781 size_t scanned = 0;
9782 size_t anchor = pos;
9783 int i;
9784 Jim_Obj *tmpObj = NULL;
9786 /* First pessimistically assume, we will not scan anything :-) */
9787 *valObjPtr = 0;
9788 if (descr->prefix) {
9789 /* There was a prefix given before the conversion, skip it and adjust
9790 * the string-to-be-parsed accordingly */
9791 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9792 /* If prefix require, skip WS */
9793 if (isspace(UCHAR(descr->prefix[i])))
9794 while (pos < strLen && isspace(UCHAR(str[pos])))
9795 ++pos;
9796 else if (descr->prefix[i] != str[pos])
9797 break; /* Prefix do not match here, leave the loop */
9798 else
9799 ++pos; /* Prefix matched so far, next round */
9801 if (pos >= strLen) {
9802 return -1; /* All of str consumed: EOF condition */
9804 else if (descr->prefix[i] != 0)
9805 return 0; /* Not whole prefix consumed, no conversion possible */
9807 /* For all but following conversion, skip leading WS */
9808 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9809 while (isspace(UCHAR(str[pos])))
9810 ++pos;
9811 /* Determine how much skipped/scanned so far */
9812 scanned = pos - anchor;
9814 /* %c is a special, simple case. no width */
9815 if (descr->type == 'n') {
9816 /* Return pseudo conversion means: how much scanned so far? */
9817 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9819 else if (pos >= strLen) {
9820 /* Cannot scan anything, as str is totally consumed */
9821 return -1;
9823 else if (descr->type == 'c') {
9824 int c;
9825 scanned += utf8_tounicode(&str[pos], &c);
9826 *valObjPtr = Jim_NewIntObj(interp, c);
9827 return scanned;
9829 else {
9830 /* Processing of conversions follows ... */
9831 if (descr->width > 0) {
9832 /* Do not try to scan as fas as possible but only the given width.
9833 * To ensure this, we copy the part that should be scanned. */
9834 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9835 size_t tLen = descr->width > sLen ? sLen : descr->width;
9837 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9838 tok = tmpObj->bytes;
9840 else {
9841 /* As no width was given, simply refer to the original string */
9842 tok = &str[pos];
9844 switch (descr->type) {
9845 case 'd':
9846 case 'o':
9847 case 'x':
9848 case 'u':
9849 case 'i':{
9850 char *endp; /* Position where the number finished */
9851 jim_wide w;
9853 int base = descr->type == 'o' ? 8
9854 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9856 /* Try to scan a number with the given base */
9857 if (base == 0) {
9858 w = jim_strtoull(tok, &endp);
9860 else {
9861 w = strtoull(tok, &endp, base);
9864 if (endp != tok) {
9865 /* There was some number sucessfully scanned! */
9866 *valObjPtr = Jim_NewIntObj(interp, w);
9868 /* Adjust the number-of-chars scanned so far */
9869 scanned += endp - tok;
9871 else {
9872 /* Nothing was scanned. We have to determine if this
9873 * happened due to e.g. prefix mismatch or input str
9874 * exhausted */
9875 scanned = *tok ? 0 : -1;
9877 break;
9879 case 's':
9880 case '[':{
9881 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9882 scanned += Jim_Length(*valObjPtr);
9883 break;
9885 case 'e':
9886 case 'f':
9887 case 'g':{
9888 char *endp;
9889 double value = strtod(tok, &endp);
9891 if (endp != tok) {
9892 /* There was some number sucessfully scanned! */
9893 *valObjPtr = Jim_NewDoubleObj(interp, value);
9894 /* Adjust the number-of-chars scanned so far */
9895 scanned += endp - tok;
9897 else {
9898 /* Nothing was scanned. We have to determine if this
9899 * happened due to e.g. prefix mismatch or input str
9900 * exhausted */
9901 scanned = *tok ? 0 : -1;
9903 break;
9906 /* If a substring was allocated (due to pre-defined width) do not
9907 * forget to free it */
9908 if (tmpObj) {
9909 Jim_FreeNewObj(interp, tmpObj);
9912 return scanned;
9915 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9916 * string and returns all converted (and not ignored) values in a list back
9917 * to the caller. If an error occured, a NULL pointer will be returned */
9919 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9921 size_t i, pos;
9922 int scanned = 1;
9923 const char *str = Jim_String(strObjPtr);
9924 int strLen = Jim_Utf8Length(interp, strObjPtr);
9925 Jim_Obj *resultList = 0;
9926 Jim_Obj **resultVec = 0;
9927 int resultc;
9928 Jim_Obj *emptyStr = 0;
9929 ScanFmtStringObj *fmtObj;
9931 /* This should never happen. The format object should already be of the correct type */
9932 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9934 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9935 /* Check if format specification was valid */
9936 if (fmtObj->error != 0) {
9937 if (flags & JIM_ERRMSG)
9938 Jim_SetResultString(interp, fmtObj->error, -1);
9939 return 0;
9941 /* Allocate a new "shared" empty string for all unassigned conversions */
9942 emptyStr = Jim_NewEmptyStringObj(interp);
9943 Jim_IncrRefCount(emptyStr);
9944 /* Create a list and fill it with empty strings up to max specified XPG3 */
9945 resultList = Jim_NewListObj(interp, NULL, 0);
9946 if (fmtObj->maxPos > 0) {
9947 for (i = 0; i < fmtObj->maxPos; ++i)
9948 Jim_ListAppendElement(interp, resultList, emptyStr);
9949 JimListGetElements(interp, resultList, &resultc, &resultVec);
9951 /* Now handle every partial format description */
9952 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9953 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9954 Jim_Obj *value = 0;
9956 /* Only last type may be "literal" w/o conversion - skip it! */
9957 if (descr->type == 0)
9958 continue;
9959 /* As long as any conversion could be done, we will proceed */
9960 if (scanned > 0)
9961 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9962 /* In case our first try results in EOF, we will leave */
9963 if (scanned == -1 && i == 0)
9964 goto eof;
9965 /* Advance next pos-to-be-scanned for the amount scanned already */
9966 pos += scanned;
9968 /* value == 0 means no conversion took place so take empty string */
9969 if (value == 0)
9970 value = Jim_NewEmptyStringObj(interp);
9971 /* If value is a non-assignable one, skip it */
9972 if (descr->pos == -1) {
9973 Jim_FreeNewObj(interp, value);
9975 else if (descr->pos == 0)
9976 /* Otherwise append it to the result list if no XPG3 was given */
9977 Jim_ListAppendElement(interp, resultList, value);
9978 else if (resultVec[descr->pos - 1] == emptyStr) {
9979 /* But due to given XPG3, put the value into the corr. slot */
9980 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9981 Jim_IncrRefCount(value);
9982 resultVec[descr->pos - 1] = value;
9984 else {
9985 /* Otherwise, the slot was already used - free obj and ERROR */
9986 Jim_FreeNewObj(interp, value);
9987 goto err;
9990 Jim_DecrRefCount(interp, emptyStr);
9991 return resultList;
9992 eof:
9993 Jim_DecrRefCount(interp, emptyStr);
9994 Jim_FreeNewObj(interp, resultList);
9995 return (Jim_Obj *)EOF;
9996 err:
9997 Jim_DecrRefCount(interp, emptyStr);
9998 Jim_FreeNewObj(interp, resultList);
9999 return 0;
10002 /* -----------------------------------------------------------------------------
10003 * Pseudo Random Number Generation
10004 * ---------------------------------------------------------------------------*/
10005 /* Initialize the sbox with the numbers from 0 to 255 */
10006 static void JimPrngInit(Jim_Interp *interp)
10008 #define PRNG_SEED_SIZE 256
10009 int i;
10010 unsigned int *seed;
10011 time_t t = time(NULL);
10013 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10015 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10016 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10017 seed[i] = (rand() ^ t ^ clock());
10019 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10020 Jim_Free(seed);
10023 /* Generates N bytes of random data */
10024 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10026 Jim_PrngState *prng;
10027 unsigned char *destByte = (unsigned char *)dest;
10028 unsigned int si, sj, x;
10030 /* initialization, only needed the first time */
10031 if (interp->prngState == NULL)
10032 JimPrngInit(interp);
10033 prng = interp->prngState;
10034 /* generates 'len' bytes of pseudo-random numbers */
10035 for (x = 0; x < len; x++) {
10036 prng->i = (prng->i + 1) & 0xff;
10037 si = prng->sbox[prng->i];
10038 prng->j = (prng->j + si) & 0xff;
10039 sj = prng->sbox[prng->j];
10040 prng->sbox[prng->i] = sj;
10041 prng->sbox[prng->j] = si;
10042 *destByte++ = prng->sbox[(si + sj) & 0xff];
10046 /* Re-seed the generator with user-provided bytes */
10047 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10049 int i;
10050 Jim_PrngState *prng;
10052 /* initialization, only needed the first time */
10053 if (interp->prngState == NULL)
10054 JimPrngInit(interp);
10055 prng = interp->prngState;
10057 /* Set the sbox[i] with i */
10058 for (i = 0; i < 256; i++)
10059 prng->sbox[i] = i;
10060 /* Now use the seed to perform a random permutation of the sbox */
10061 for (i = 0; i < seedLen; i++) {
10062 unsigned char t;
10064 t = prng->sbox[i & 0xFF];
10065 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10066 prng->sbox[seed[i]] = t;
10068 prng->i = prng->j = 0;
10070 /* discard at least the first 256 bytes of stream.
10071 * borrow the seed buffer for this
10073 for (i = 0; i < 256; i += seedLen) {
10074 JimRandomBytes(interp, seed, seedLen);
10078 /* [incr] */
10079 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10081 jim_wide wideValue, increment = 1;
10082 Jim_Obj *intObjPtr;
10084 if (argc != 2 && argc != 3) {
10085 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10086 return JIM_ERR;
10088 if (argc == 3) {
10089 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10090 return JIM_ERR;
10092 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10093 if (!intObjPtr) {
10094 /* Set missing variable to 0 */
10095 wideValue = 0;
10097 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10098 return JIM_ERR;
10100 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10101 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10102 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10103 Jim_FreeNewObj(interp, intObjPtr);
10104 return JIM_ERR;
10107 else {
10108 /* Can do it the quick way */
10109 Jim_InvalidateStringRep(intObjPtr);
10110 JimWideValue(intObjPtr) = wideValue + increment;
10112 /* The following step is required in order to invalidate the
10113 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10114 if (argv[1]->typePtr != &variableObjType) {
10115 /* Note that this can't fail since GetVariable already succeeded */
10116 Jim_SetVariable(interp, argv[1], intObjPtr);
10119 Jim_SetResult(interp, intObjPtr);
10120 return JIM_OK;
10124 /* -----------------------------------------------------------------------------
10125 * Eval
10126 * ---------------------------------------------------------------------------*/
10127 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10128 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10130 /* Handle calls to the [unknown] command */
10131 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10133 int retcode;
10135 /* If JimUnknown() is recursively called too many times...
10136 * done here
10138 if (interp->unknown_called > 50) {
10139 return JIM_ERR;
10142 /* The object interp->unknown just contains
10143 * the "unknown" string, it is used in order to
10144 * avoid to lookup the unknown command every time
10145 * but instead to cache the result. */
10147 /* If the [unknown] command does not exist ... */
10148 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10149 return JIM_ERR;
10151 interp->unknown_called++;
10152 /* XXX: Are we losing fileNameObj and linenr? */
10153 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10154 interp->unknown_called--;
10156 return retcode;
10159 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10161 int retcode;
10162 Jim_Cmd *cmdPtr;
10164 #if 0
10165 printf("invoke");
10166 int j;
10167 for (j = 0; j < objc; j++) {
10168 printf(" '%s'", Jim_String(objv[j]));
10170 printf("\n");
10171 #endif
10173 if (interp->framePtr->tailcallCmd) {
10174 /* Special tailcall command was pre-resolved */
10175 cmdPtr = interp->framePtr->tailcallCmd;
10176 interp->framePtr->tailcallCmd = NULL;
10178 else {
10179 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10180 if (cmdPtr == NULL) {
10181 return JimUnknown(interp, objc, objv);
10183 JimIncrCmdRefCount(cmdPtr);
10186 if (interp->evalDepth == interp->maxEvalDepth) {
10187 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10188 retcode = JIM_ERR;
10189 goto out;
10191 interp->evalDepth++;
10193 /* Call it -- Make sure result is an empty object. */
10194 Jim_SetEmptyResult(interp);
10195 if (cmdPtr->isproc) {
10196 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10198 else {
10199 interp->cmdPrivData = cmdPtr->u.native.privData;
10200 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10202 interp->evalDepth--;
10204 out:
10205 JimDecrCmdRefCount(interp, cmdPtr);
10207 return retcode;
10210 /* Eval the object vector 'objv' composed of 'objc' elements.
10211 * Every element is used as single argument.
10212 * Jim_EvalObj() will call this function every time its object
10213 * argument is of "list" type, with no string representation.
10215 * This is possible because the string representation of a
10216 * list object generated by the UpdateStringOfList is made
10217 * in a way that ensures that every list element is a different
10218 * command argument. */
10219 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10221 int i, retcode;
10223 /* Incr refcount of arguments. */
10224 for (i = 0; i < objc; i++)
10225 Jim_IncrRefCount(objv[i]);
10227 retcode = JimInvokeCommand(interp, objc, objv);
10229 /* Decr refcount of arguments and return the retcode */
10230 for (i = 0; i < objc; i++)
10231 Jim_DecrRefCount(interp, objv[i]);
10233 return retcode;
10237 * Invokes 'prefix' as a command with the objv array as arguments.
10239 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10241 int ret;
10242 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10244 nargv[0] = prefix;
10245 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10246 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10247 Jim_Free(nargv);
10248 return ret;
10251 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10253 if (!interp->errorFlag) {
10254 /* This is the first error, so save the file/line information and reset the stack */
10255 interp->errorFlag = 1;
10256 Jim_IncrRefCount(script->fileNameObj);
10257 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10258 interp->errorFileNameObj = script->fileNameObj;
10259 interp->errorLine = script->linenr;
10261 JimResetStackTrace(interp);
10262 /* Always add a level where the error first occurs */
10263 interp->addStackTrace++;
10266 /* Now if this is an "interesting" level, add it to the stack trace */
10267 if (interp->addStackTrace > 0) {
10268 /* Add the stack info for the current level */
10270 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10272 /* Note: if we didn't have a filename for this level,
10273 * don't clear the addStackTrace flag
10274 * so we can pick it up at the next level
10276 if (Jim_Length(script->fileNameObj)) {
10277 interp->addStackTrace = 0;
10280 Jim_DecrRefCount(interp, interp->errorProc);
10281 interp->errorProc = interp->emptyObj;
10282 Jim_IncrRefCount(interp->errorProc);
10286 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10288 Jim_Obj *objPtr;
10290 switch (token->type) {
10291 case JIM_TT_STR:
10292 case JIM_TT_ESC:
10293 objPtr = token->objPtr;
10294 break;
10295 case JIM_TT_VAR:
10296 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10297 break;
10298 case JIM_TT_DICTSUGAR:
10299 objPtr = JimExpandDictSugar(interp, token->objPtr);
10300 break;
10301 case JIM_TT_EXPRSUGAR:
10302 objPtr = JimExpandExprSugar(interp, token->objPtr);
10303 break;
10304 case JIM_TT_CMD:
10305 switch (Jim_EvalObj(interp, token->objPtr)) {
10306 case JIM_OK:
10307 case JIM_RETURN:
10308 objPtr = interp->result;
10309 break;
10310 case JIM_BREAK:
10311 /* Stop substituting */
10312 return JIM_BREAK;
10313 case JIM_CONTINUE:
10314 /* just skip this one */
10315 return JIM_CONTINUE;
10316 default:
10317 return JIM_ERR;
10319 break;
10320 default:
10321 JimPanic((1,
10322 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10323 objPtr = NULL;
10324 break;
10326 if (objPtr) {
10327 *objPtrPtr = objPtr;
10328 return JIM_OK;
10330 return JIM_ERR;
10333 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10334 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10335 * The returned object has refcount = 0.
10337 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10339 int totlen = 0, i;
10340 Jim_Obj **intv;
10341 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10342 Jim_Obj *objPtr;
10343 char *s;
10345 if (tokens <= JIM_EVAL_SINTV_LEN)
10346 intv = sintv;
10347 else
10348 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10350 /* Compute every token forming the argument
10351 * in the intv objects vector. */
10352 for (i = 0; i < tokens; i++) {
10353 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10354 case JIM_OK:
10355 case JIM_RETURN:
10356 break;
10357 case JIM_BREAK:
10358 if (flags & JIM_SUBST_FLAG) {
10359 /* Stop here */
10360 tokens = i;
10361 continue;
10363 /* XXX: Should probably set an error about break outside loop */
10364 /* fall through to error */
10365 case JIM_CONTINUE:
10366 if (flags & JIM_SUBST_FLAG) {
10367 intv[i] = NULL;
10368 continue;
10370 /* XXX: Ditto continue outside loop */
10371 /* fall through to error */
10372 default:
10373 while (i--) {
10374 Jim_DecrRefCount(interp, intv[i]);
10376 if (intv != sintv) {
10377 Jim_Free(intv);
10379 return NULL;
10381 Jim_IncrRefCount(intv[i]);
10382 Jim_String(intv[i]);
10383 totlen += intv[i]->length;
10386 /* Fast path return for a single token */
10387 if (tokens == 1 && intv[0] && intv == sintv) {
10388 Jim_DecrRefCount(interp, intv[0]);
10389 return intv[0];
10392 /* Concatenate every token in an unique
10393 * object. */
10394 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10396 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10397 && token[2].type == JIM_TT_VAR) {
10398 /* May be able to do fast interpolated object -> dictSubst */
10399 objPtr->typePtr = &interpolatedObjType;
10400 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10401 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10402 Jim_IncrRefCount(intv[2]);
10404 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10405 /* The first interpolated token is source, so preserve the source info */
10406 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10410 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10411 objPtr->length = totlen;
10412 for (i = 0; i < tokens; i++) {
10413 if (intv[i]) {
10414 memcpy(s, intv[i]->bytes, intv[i]->length);
10415 s += intv[i]->length;
10416 Jim_DecrRefCount(interp, intv[i]);
10419 objPtr->bytes[totlen] = '\0';
10420 /* Free the intv vector if not static. */
10421 if (intv != sintv) {
10422 Jim_Free(intv);
10425 return objPtr;
10429 /* listPtr *must* be a list.
10430 * The contents of the list is evaluated with the first element as the command and
10431 * the remaining elements as the arguments.
10433 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10435 int retcode = JIM_OK;
10437 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10439 if (listPtr->internalRep.listValue.len) {
10440 Jim_IncrRefCount(listPtr);
10441 retcode = JimInvokeCommand(interp,
10442 listPtr->internalRep.listValue.len,
10443 listPtr->internalRep.listValue.ele);
10444 Jim_DecrRefCount(interp, listPtr);
10446 return retcode;
10449 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10451 SetListFromAny(interp, listPtr);
10452 return JimEvalObjList(interp, listPtr);
10455 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10457 int i;
10458 ScriptObj *script;
10459 ScriptToken *token;
10460 int retcode = JIM_OK;
10461 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10462 Jim_Obj *prevScriptObj;
10464 /* If the object is of type "list", with no string rep we can call
10465 * a specialized version of Jim_EvalObj() */
10466 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10467 return JimEvalObjList(interp, scriptObjPtr);
10470 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10471 script = JimGetScript(interp, scriptObjPtr);
10472 if (!JimScriptValid(interp, script)) {
10473 Jim_DecrRefCount(interp, scriptObjPtr);
10474 return JIM_ERR;
10477 /* Reset the interpreter result. This is useful to
10478 * return the empty result in the case of empty program. */
10479 Jim_SetEmptyResult(interp);
10481 token = script->token;
10483 #ifdef JIM_OPTIMIZATION
10484 /* Check for one of the following common scripts used by for, while
10486 * {}
10487 * incr a
10489 if (script->len == 0) {
10490 Jim_DecrRefCount(interp, scriptObjPtr);
10491 return JIM_OK;
10493 if (script->len == 3
10494 && token[1].objPtr->typePtr == &commandObjType
10495 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10496 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10497 && token[2].objPtr->typePtr == &variableObjType) {
10499 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10501 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10502 JimWideValue(objPtr)++;
10503 Jim_InvalidateStringRep(objPtr);
10504 Jim_DecrRefCount(interp, scriptObjPtr);
10505 Jim_SetResult(interp, objPtr);
10506 return JIM_OK;
10509 #endif
10511 /* Now we have to make sure the internal repr will not be
10512 * freed on shimmering.
10514 * Think for example to this:
10516 * set x {llength $x; ... some more code ...}; eval $x
10518 * In order to preserve the internal rep, we increment the
10519 * inUse field of the script internal rep structure. */
10520 script->inUse++;
10522 /* Stash the current script */
10523 prevScriptObj = interp->currentScriptObj;
10524 interp->currentScriptObj = scriptObjPtr;
10526 interp->errorFlag = 0;
10527 argv = sargv;
10529 /* Execute every command sequentially until the end of the script
10530 * or an error occurs.
10532 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10533 int argc;
10534 int j;
10536 /* First token of the line is always JIM_TT_LINE */
10537 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10538 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10540 /* Allocate the arguments vector if required */
10541 if (argc > JIM_EVAL_SARGV_LEN)
10542 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10544 /* Skip the JIM_TT_LINE token */
10545 i++;
10547 /* Populate the arguments objects.
10548 * If an error occurs, retcode will be set and
10549 * 'j' will be set to the number of args expanded
10551 for (j = 0; j < argc; j++) {
10552 long wordtokens = 1;
10553 int expand = 0;
10554 Jim_Obj *wordObjPtr = NULL;
10556 if (token[i].type == JIM_TT_WORD) {
10557 wordtokens = JimWideValue(token[i++].objPtr);
10558 if (wordtokens < 0) {
10559 expand = 1;
10560 wordtokens = -wordtokens;
10564 if (wordtokens == 1) {
10565 /* Fast path if the token does not
10566 * need interpolation */
10568 switch (token[i].type) {
10569 case JIM_TT_ESC:
10570 case JIM_TT_STR:
10571 wordObjPtr = token[i].objPtr;
10572 break;
10573 case JIM_TT_VAR:
10574 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10575 break;
10576 case JIM_TT_EXPRSUGAR:
10577 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10578 break;
10579 case JIM_TT_DICTSUGAR:
10580 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10581 break;
10582 case JIM_TT_CMD:
10583 retcode = Jim_EvalObj(interp, token[i].objPtr);
10584 if (retcode == JIM_OK) {
10585 wordObjPtr = Jim_GetResult(interp);
10587 break;
10588 default:
10589 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10592 else {
10593 /* For interpolation we call a helper
10594 * function to do the work for us. */
10595 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10598 if (!wordObjPtr) {
10599 if (retcode == JIM_OK) {
10600 retcode = JIM_ERR;
10602 break;
10605 Jim_IncrRefCount(wordObjPtr);
10606 i += wordtokens;
10608 if (!expand) {
10609 argv[j] = wordObjPtr;
10611 else {
10612 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10613 int len = Jim_ListLength(interp, wordObjPtr);
10614 int newargc = argc + len - 1;
10615 int k;
10617 if (len > 1) {
10618 if (argv == sargv) {
10619 if (newargc > JIM_EVAL_SARGV_LEN) {
10620 argv = Jim_Alloc(sizeof(*argv) * newargc);
10621 memcpy(argv, sargv, sizeof(*argv) * j);
10624 else {
10625 /* Need to realloc to make room for (len - 1) more entries */
10626 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10630 /* Now copy in the expanded version */
10631 for (k = 0; k < len; k++) {
10632 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10633 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10636 /* The original object reference is no longer needed,
10637 * after the expansion it is no longer present on
10638 * the argument vector, but the single elements are
10639 * in its place. */
10640 Jim_DecrRefCount(interp, wordObjPtr);
10642 /* And update the indexes */
10643 j--;
10644 argc += len - 1;
10648 if (retcode == JIM_OK && argc) {
10649 /* Invoke the command */
10650 retcode = JimInvokeCommand(interp, argc, argv);
10651 /* Check for a signal after each command */
10652 if (Jim_CheckSignal(interp)) {
10653 retcode = JIM_SIGNAL;
10657 /* Finished with the command, so decrement ref counts of each argument */
10658 while (j-- > 0) {
10659 Jim_DecrRefCount(interp, argv[j]);
10662 if (argv != sargv) {
10663 Jim_Free(argv);
10664 argv = sargv;
10668 /* Possibly add to the error stack trace */
10669 if (retcode == JIM_ERR) {
10670 JimAddErrorToStack(interp, script);
10672 /* Propagate the addStackTrace value through 'return -code error' */
10673 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10674 /* No need to add stack trace */
10675 interp->addStackTrace = 0;
10678 /* Restore the current script */
10679 interp->currentScriptObj = prevScriptObj;
10681 /* Note that we don't have to decrement inUse, because the
10682 * following code transfers our use of the reference again to
10683 * the script object. */
10684 Jim_FreeIntRep(interp, scriptObjPtr);
10685 scriptObjPtr->typePtr = &scriptObjType;
10686 Jim_SetIntRepPtr(scriptObjPtr, script);
10687 Jim_DecrRefCount(interp, scriptObjPtr);
10689 return retcode;
10692 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10694 int retcode;
10695 /* If argObjPtr begins with '&', do an automatic upvar */
10696 const char *varname = Jim_String(argNameObj);
10697 if (*varname == '&') {
10698 /* First check that the target variable exists */
10699 Jim_Obj *objPtr;
10700 Jim_CallFrame *savedCallFrame = interp->framePtr;
10702 interp->framePtr = interp->framePtr->parent;
10703 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10704 interp->framePtr = savedCallFrame;
10705 if (!objPtr) {
10706 return JIM_ERR;
10709 /* It exists, so perform the binding. */
10710 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10711 Jim_IncrRefCount(objPtr);
10712 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10713 Jim_DecrRefCount(interp, objPtr);
10715 else {
10716 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10718 return retcode;
10722 * Sets the interp result to be an error message indicating the required proc args.
10724 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10726 /* Create a nice error message, consistent with Tcl 8.5 */
10727 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10728 int i;
10730 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10731 Jim_AppendString(interp, argmsg, " ", 1);
10733 if (i == cmd->u.proc.argsPos) {
10734 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10735 /* Renamed args */
10736 Jim_AppendString(interp, argmsg, "?", 1);
10737 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10738 Jim_AppendString(interp, argmsg, " ...?", -1);
10740 else {
10741 /* We have plain args */
10742 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10745 else {
10746 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10747 Jim_AppendString(interp, argmsg, "?", 1);
10748 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10749 Jim_AppendString(interp, argmsg, "?", 1);
10751 else {
10752 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10753 if (*arg == '&') {
10754 arg++;
10756 Jim_AppendString(interp, argmsg, arg, -1);
10760 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10761 Jim_FreeNewObj(interp, argmsg);
10764 #ifdef jim_ext_namespace
10766 * [namespace eval]
10768 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10770 Jim_CallFrame *callFramePtr;
10771 int retcode;
10773 /* Create a new callframe */
10774 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10775 callFramePtr->argv = &interp->emptyObj;
10776 callFramePtr->argc = 0;
10777 callFramePtr->procArgsObjPtr = NULL;
10778 callFramePtr->procBodyObjPtr = scriptObj;
10779 callFramePtr->staticVars = NULL;
10780 callFramePtr->fileNameObj = interp->emptyObj;
10781 callFramePtr->line = 0;
10782 Jim_IncrRefCount(scriptObj);
10783 interp->framePtr = callFramePtr;
10785 /* Check if there are too nested calls */
10786 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10787 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10788 retcode = JIM_ERR;
10790 else {
10791 /* Eval the body */
10792 retcode = Jim_EvalObj(interp, scriptObj);
10795 /* Destroy the callframe */
10796 interp->framePtr = interp->framePtr->parent;
10797 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10799 return retcode;
10801 #endif
10803 /* Call a procedure implemented in Tcl.
10804 * It's possible to speed-up a lot this function, currently
10805 * the callframes are not cached, but allocated and
10806 * destroied every time. What is expecially costly is
10807 * to create/destroy the local vars hash table every time.
10809 * This can be fixed just implementing callframes caching
10810 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10811 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10813 Jim_CallFrame *callFramePtr;
10814 int i, d, retcode, optargs;
10815 ScriptObj *script;
10817 /* Check arity */
10818 if (argc - 1 < cmd->u.proc.reqArity ||
10819 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10820 JimSetProcWrongArgs(interp, argv[0], cmd);
10821 return JIM_ERR;
10824 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10825 /* Optimise for procedure with no body - useful for optional debugging */
10826 return JIM_OK;
10829 /* Check if there are too nested calls */
10830 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10831 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10832 return JIM_ERR;
10835 /* Create a new callframe */
10836 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10837 callFramePtr->argv = argv;
10838 callFramePtr->argc = argc;
10839 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10840 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10841 callFramePtr->staticVars = cmd->u.proc.staticVars;
10843 /* Remember where we were called from. */
10844 script = JimGetScript(interp, interp->currentScriptObj);
10845 callFramePtr->fileNameObj = script->fileNameObj;
10846 callFramePtr->line = script->linenr;
10848 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10849 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10850 interp->framePtr = callFramePtr;
10852 /* How many optional args are available */
10853 optargs = (argc - 1 - cmd->u.proc.reqArity);
10855 /* Step 'i' along the actual args, and step 'd' along the formal args */
10856 i = 1;
10857 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10858 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10859 if (d == cmd->u.proc.argsPos) {
10860 /* assign $args */
10861 Jim_Obj *listObjPtr;
10862 int argsLen = 0;
10863 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10864 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10866 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10868 /* It is possible to rename args. */
10869 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10870 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10872 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10873 if (retcode != JIM_OK) {
10874 goto badargset;
10877 i += argsLen;
10878 continue;
10881 /* Optional or required? */
10882 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10883 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10885 else {
10886 /* Ran out, so use the default */
10887 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10889 if (retcode != JIM_OK) {
10890 goto badargset;
10894 /* Eval the body */
10895 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10897 badargset:
10899 /* Free the callframe */
10900 interp->framePtr = interp->framePtr->parent;
10901 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10903 if (interp->framePtr->tailcallObj) {
10904 /* If a tailcall is already being executed, merge this tailcall with that one */
10905 if (interp->framePtr->tailcall++ == 0) {
10906 /* No current tailcall in this frame, so invoke the tailcall command */
10907 do {
10908 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10910 interp->framePtr->tailcallObj = NULL;
10912 if (retcode == JIM_EVAL) {
10913 retcode = Jim_EvalObjList(interp, tailcallObj);
10914 if (retcode == JIM_RETURN) {
10915 /* If the result of the tailcall is 'return', push
10916 * it up to the caller
10918 interp->returnLevel++;
10921 Jim_DecrRefCount(interp, tailcallObj);
10922 } while (interp->framePtr->tailcallObj);
10924 /* If the tailcall chain finished early, may need to manually discard the command */
10925 if (interp->framePtr->tailcallCmd) {
10926 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10927 interp->framePtr->tailcallCmd = NULL;
10930 interp->framePtr->tailcall--;
10933 /* Handle the JIM_RETURN return code */
10934 if (retcode == JIM_RETURN) {
10935 if (--interp->returnLevel <= 0) {
10936 retcode = interp->returnCode;
10937 interp->returnCode = JIM_OK;
10938 interp->returnLevel = 0;
10941 else if (retcode == JIM_ERR) {
10942 interp->addStackTrace++;
10943 Jim_DecrRefCount(interp, interp->errorProc);
10944 interp->errorProc = argv[0];
10945 Jim_IncrRefCount(interp->errorProc);
10948 return retcode;
10951 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10953 int retval;
10954 Jim_Obj *scriptObjPtr;
10956 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10957 Jim_IncrRefCount(scriptObjPtr);
10959 if (filename) {
10960 Jim_Obj *prevScriptObj;
10962 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10964 prevScriptObj = interp->currentScriptObj;
10965 interp->currentScriptObj = scriptObjPtr;
10967 retval = Jim_EvalObj(interp, scriptObjPtr);
10969 interp->currentScriptObj = prevScriptObj;
10971 else {
10972 retval = Jim_EvalObj(interp, scriptObjPtr);
10974 Jim_DecrRefCount(interp, scriptObjPtr);
10975 return retval;
10978 int Jim_Eval(Jim_Interp *interp, const char *script)
10980 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10983 /* Execute script in the scope of the global level */
10984 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10986 int retval;
10987 Jim_CallFrame *savedFramePtr = interp->framePtr;
10989 interp->framePtr = interp->topFramePtr;
10990 retval = Jim_Eval(interp, script);
10991 interp->framePtr = savedFramePtr;
10993 return retval;
10996 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10998 int retval;
10999 Jim_CallFrame *savedFramePtr = interp->framePtr;
11001 interp->framePtr = interp->topFramePtr;
11002 retval = Jim_EvalFile(interp, filename);
11003 interp->framePtr = savedFramePtr;
11005 return retval;
11008 #include <sys/stat.h>
11010 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11012 FILE *fp;
11013 char *buf;
11014 Jim_Obj *scriptObjPtr;
11015 Jim_Obj *prevScriptObj;
11016 struct stat sb;
11017 int retcode;
11018 int readlen;
11020 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11021 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11022 return JIM_ERR;
11024 if (sb.st_size == 0) {
11025 fclose(fp);
11026 return JIM_OK;
11029 buf = Jim_Alloc(sb.st_size + 1);
11030 readlen = fread(buf, 1, sb.st_size, fp);
11031 if (ferror(fp)) {
11032 fclose(fp);
11033 Jim_Free(buf);
11034 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11035 return JIM_ERR;
11037 fclose(fp);
11038 buf[readlen] = 0;
11040 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11041 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11042 Jim_IncrRefCount(scriptObjPtr);
11044 prevScriptObj = interp->currentScriptObj;
11045 interp->currentScriptObj = scriptObjPtr;
11047 retcode = Jim_EvalObj(interp, scriptObjPtr);
11049 /* Handle the JIM_RETURN return code */
11050 if (retcode == JIM_RETURN) {
11051 if (--interp->returnLevel <= 0) {
11052 retcode = interp->returnCode;
11053 interp->returnCode = JIM_OK;
11054 interp->returnLevel = 0;
11057 if (retcode == JIM_ERR) {
11058 /* EvalFile changes context, so add a stack frame here */
11059 interp->addStackTrace++;
11062 interp->currentScriptObj = prevScriptObj;
11064 Jim_DecrRefCount(interp, scriptObjPtr);
11066 return retcode;
11069 /* -----------------------------------------------------------------------------
11070 * Subst
11071 * ---------------------------------------------------------------------------*/
11072 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11074 pc->tstart = pc->p;
11075 pc->tline = pc->linenr;
11077 if (pc->len == 0) {
11078 pc->tend = pc->p;
11079 pc->tt = JIM_TT_EOL;
11080 pc->eof = 1;
11081 return;
11083 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11084 JimParseCmd(pc);
11085 return;
11087 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11088 if (JimParseVar(pc) == JIM_OK) {
11089 return;
11091 /* Not a var, so treat as a string */
11092 pc->tstart = pc->p;
11093 flags |= JIM_SUBST_NOVAR;
11095 while (pc->len) {
11096 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11097 break;
11099 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11100 break;
11102 if (*pc->p == '\\' && pc->len > 1) {
11103 pc->p++;
11104 pc->len--;
11106 pc->p++;
11107 pc->len--;
11109 pc->tend = pc->p - 1;
11110 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11113 /* The subst object type reuses most of the data structures and functions
11114 * of the script object. Script's data structures are a bit more complex
11115 * for what is needed for [subst]itution tasks, but the reuse helps to
11116 * deal with a single data structure at the cost of some more memory
11117 * usage for substitutions. */
11119 /* This method takes the string representation of an object
11120 * as a Tcl string where to perform [subst]itution, and generates
11121 * the pre-parsed internal representation. */
11122 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11124 int scriptTextLen;
11125 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11126 struct JimParserCtx parser;
11127 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11128 ParseTokenList tokenlist;
11130 /* Initially parse the subst into tokens (in tokenlist) */
11131 ScriptTokenListInit(&tokenlist);
11133 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11134 while (1) {
11135 JimParseSubst(&parser, flags);
11136 if (parser.eof) {
11137 /* Note that subst doesn't need the EOL token */
11138 break;
11140 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11141 parser.tline);
11144 /* Create the "real" subst/script tokens from the initial token list */
11145 script->inUse = 1;
11146 script->substFlags = flags;
11147 script->fileNameObj = interp->emptyObj;
11148 Jim_IncrRefCount(script->fileNameObj);
11149 SubstObjAddTokens(interp, script, &tokenlist);
11151 /* No longer need the token list */
11152 ScriptTokenListFree(&tokenlist);
11154 #ifdef DEBUG_SHOW_SUBST
11156 int i;
11158 printf("==== Subst ====\n");
11159 for (i = 0; i < script->len; i++) {
11160 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11161 Jim_String(script->token[i].objPtr));
11164 #endif
11166 /* Free the old internal rep and set the new one. */
11167 Jim_FreeIntRep(interp, objPtr);
11168 Jim_SetIntRepPtr(objPtr, script);
11169 objPtr->typePtr = &scriptObjType;
11170 return JIM_OK;
11173 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11175 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11176 SetSubstFromAny(interp, objPtr, flags);
11177 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11180 /* Performs commands,variables,blackslashes substitution,
11181 * storing the result object (with refcount 0) into
11182 * resObjPtrPtr. */
11183 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11185 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11187 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11188 /* In order to preserve the internal rep, we increment the
11189 * inUse field of the script internal rep structure. */
11190 script->inUse++;
11192 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11194 script->inUse--;
11195 Jim_DecrRefCount(interp, substObjPtr);
11196 if (*resObjPtrPtr == NULL) {
11197 return JIM_ERR;
11199 return JIM_OK;
11202 /* -----------------------------------------------------------------------------
11203 * Core commands utility functions
11204 * ---------------------------------------------------------------------------*/
11205 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11207 Jim_Obj *objPtr;
11208 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11210 if (*msg) {
11211 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11213 Jim_IncrRefCount(listObjPtr);
11214 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11215 Jim_DecrRefCount(interp, listObjPtr);
11217 Jim_IncrRefCount(objPtr);
11218 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11219 Jim_DecrRefCount(interp, objPtr);
11223 * May add the key and/or value to the list.
11225 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11226 Jim_HashEntry *he, int type);
11228 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11231 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11232 * invoke the callback to add entries to a list.
11233 * Returns the list.
11235 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11236 JimHashtableIteratorCallbackType *callback, int type)
11238 Jim_HashEntry *he;
11239 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11241 /* Check for the non-pattern case. We can do this much more efficiently. */
11242 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11243 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11244 if (he) {
11245 callback(interp, listObjPtr, he, type);
11248 else {
11249 Jim_HashTableIterator htiter;
11250 JimInitHashTableIterator(ht, &htiter);
11251 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11252 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11253 callback(interp, listObjPtr, he, type);
11257 return listObjPtr;
11260 /* Keep these in order */
11261 #define JIM_CMDLIST_COMMANDS 0
11262 #define JIM_CMDLIST_PROCS 1
11263 #define JIM_CMDLIST_CHANNELS 2
11266 * Adds matching command names (procs, channels) to the list.
11268 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11269 Jim_HashEntry *he, int type)
11271 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11272 Jim_Obj *objPtr;
11274 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11275 /* not a proc */
11276 return;
11279 objPtr = Jim_NewStringObj(interp, he->key, -1);
11280 Jim_IncrRefCount(objPtr);
11282 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11283 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11285 Jim_DecrRefCount(interp, objPtr);
11288 /* type is JIM_CMDLIST_xxx */
11289 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11291 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11294 /* Keep these in order */
11295 #define JIM_VARLIST_GLOBALS 0
11296 #define JIM_VARLIST_LOCALS 1
11297 #define JIM_VARLIST_VARS 2
11299 #define JIM_VARLIST_VALUES 0x1000
11302 * Adds matching variable names to the list.
11304 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11305 Jim_HashEntry *he, int type)
11307 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11309 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11310 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11311 if (type & JIM_VARLIST_VALUES) {
11312 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11317 /* mode is JIM_VARLIST_xxx */
11318 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11320 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11321 /* For [info locals], if we are at top level an emtpy list
11322 * is returned. I don't agree, but we aim at compatibility (SS) */
11323 return interp->emptyObj;
11325 else {
11326 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11327 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11331 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11332 Jim_Obj **objPtrPtr, int info_level_cmd)
11334 Jim_CallFrame *targetCallFrame;
11336 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11337 if (targetCallFrame == NULL) {
11338 return JIM_ERR;
11340 /* No proc call at toplevel callframe */
11341 if (targetCallFrame == interp->topFramePtr) {
11342 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11343 return JIM_ERR;
11345 if (info_level_cmd) {
11346 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11348 else {
11349 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11351 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11352 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11353 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11354 *objPtrPtr = listObj;
11356 return JIM_OK;
11359 /* -----------------------------------------------------------------------------
11360 * Core commands
11361 * ---------------------------------------------------------------------------*/
11363 /* fake [puts] -- not the real puts, just for debugging. */
11364 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11366 if (argc != 2 && argc != 3) {
11367 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11368 return JIM_ERR;
11370 if (argc == 3) {
11371 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11372 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11373 return JIM_ERR;
11375 else {
11376 fputs(Jim_String(argv[2]), stdout);
11379 else {
11380 puts(Jim_String(argv[1]));
11382 return JIM_OK;
11385 /* Helper for [+] and [*] */
11386 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11388 jim_wide wideValue, res;
11389 double doubleValue, doubleRes;
11390 int i;
11392 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11394 for (i = 1; i < argc; i++) {
11395 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11396 goto trydouble;
11397 if (op == JIM_EXPROP_ADD)
11398 res += wideValue;
11399 else
11400 res *= wideValue;
11402 Jim_SetResultInt(interp, res);
11403 return JIM_OK;
11404 trydouble:
11405 doubleRes = (double)res;
11406 for (; i < argc; i++) {
11407 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11408 return JIM_ERR;
11409 if (op == JIM_EXPROP_ADD)
11410 doubleRes += doubleValue;
11411 else
11412 doubleRes *= doubleValue;
11414 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11415 return JIM_OK;
11418 /* Helper for [-] and [/] */
11419 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11421 jim_wide wideValue, res = 0;
11422 double doubleValue, doubleRes = 0;
11423 int i = 2;
11425 if (argc < 2) {
11426 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11427 return JIM_ERR;
11429 else if (argc == 2) {
11430 /* The arity = 2 case is different. For [- x] returns -x,
11431 * while [/ x] returns 1/x. */
11432 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11433 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11434 return JIM_ERR;
11436 else {
11437 if (op == JIM_EXPROP_SUB)
11438 doubleRes = -doubleValue;
11439 else
11440 doubleRes = 1.0 / doubleValue;
11441 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11442 return JIM_OK;
11445 if (op == JIM_EXPROP_SUB) {
11446 res = -wideValue;
11447 Jim_SetResultInt(interp, res);
11449 else {
11450 doubleRes = 1.0 / wideValue;
11451 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11453 return JIM_OK;
11455 else {
11456 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11457 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11458 != JIM_OK) {
11459 return JIM_ERR;
11461 else {
11462 goto trydouble;
11466 for (i = 2; i < argc; i++) {
11467 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11468 doubleRes = (double)res;
11469 goto trydouble;
11471 if (op == JIM_EXPROP_SUB)
11472 res -= wideValue;
11473 else
11474 res /= wideValue;
11476 Jim_SetResultInt(interp, res);
11477 return JIM_OK;
11478 trydouble:
11479 for (; i < argc; i++) {
11480 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11481 return JIM_ERR;
11482 if (op == JIM_EXPROP_SUB)
11483 doubleRes -= doubleValue;
11484 else
11485 doubleRes /= doubleValue;
11487 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11488 return JIM_OK;
11492 /* [+] */
11493 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11495 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11498 /* [*] */
11499 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11501 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11504 /* [-] */
11505 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11507 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11510 /* [/] */
11511 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11513 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11516 /* [set] */
11517 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11519 if (argc != 2 && argc != 3) {
11520 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11521 return JIM_ERR;
11523 if (argc == 2) {
11524 Jim_Obj *objPtr;
11526 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11527 if (!objPtr)
11528 return JIM_ERR;
11529 Jim_SetResult(interp, objPtr);
11530 return JIM_OK;
11532 /* argc == 3 case. */
11533 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11534 return JIM_ERR;
11535 Jim_SetResult(interp, argv[2]);
11536 return JIM_OK;
11539 /* [unset]
11541 * unset ?-nocomplain? ?--? ?varName ...?
11543 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11545 int i = 1;
11546 int complain = 1;
11548 while (i < argc) {
11549 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11550 i++;
11551 break;
11553 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11554 complain = 0;
11555 i++;
11556 continue;
11558 break;
11561 while (i < argc) {
11562 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11563 && complain) {
11564 return JIM_ERR;
11566 i++;
11568 return JIM_OK;
11571 /* [while] */
11572 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11574 if (argc != 3) {
11575 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11576 return JIM_ERR;
11579 /* The general purpose implementation of while starts here */
11580 while (1) {
11581 int boolean, retval;
11583 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11584 return retval;
11585 if (!boolean)
11586 break;
11588 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11589 switch (retval) {
11590 case JIM_BREAK:
11591 goto out;
11592 break;
11593 case JIM_CONTINUE:
11594 continue;
11595 break;
11596 default:
11597 return retval;
11601 out:
11602 Jim_SetEmptyResult(interp);
11603 return JIM_OK;
11606 /* [for] */
11607 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11609 int retval;
11610 int boolean = 1;
11611 Jim_Obj *varNamePtr = NULL;
11612 Jim_Obj *stopVarNamePtr = NULL;
11614 if (argc != 5) {
11615 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11616 return JIM_ERR;
11619 /* Do the initialisation */
11620 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11621 return retval;
11624 /* And do the first test now. Better for optimisation
11625 * if we can do next/test at the bottom of the loop
11627 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11629 /* Ready to do the body as follows:
11630 * while (1) {
11631 * body // check retcode
11632 * next // check retcode
11633 * test // check retcode/test bool
11637 #ifdef JIM_OPTIMIZATION
11638 /* Check if the for is on the form:
11639 * for ... {$i < CONST} {incr i}
11640 * for ... {$i < $j} {incr i}
11642 if (retval == JIM_OK && boolean) {
11643 ScriptObj *incrScript;
11644 ExprByteCode *expr;
11645 jim_wide stop, currentVal;
11646 Jim_Obj *objPtr;
11647 int cmpOffset;
11649 /* Do it only if there aren't shared arguments */
11650 expr = JimGetExpression(interp, argv[2]);
11651 incrScript = JimGetScript(interp, argv[3]);
11653 /* Ensure proper lengths to start */
11654 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11655 goto evalstart;
11657 /* Ensure proper token types. */
11658 if (incrScript->token[1].type != JIM_TT_ESC ||
11659 expr->token[0].type != JIM_TT_VAR ||
11660 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11661 goto evalstart;
11664 if (expr->token[2].type == JIM_EXPROP_LT) {
11665 cmpOffset = 0;
11667 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11668 cmpOffset = 1;
11670 else {
11671 goto evalstart;
11674 /* Update command must be incr */
11675 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11676 goto evalstart;
11679 /* incr, expression must be about the same variable */
11680 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11681 goto evalstart;
11684 /* Get the stop condition (must be a variable or integer) */
11685 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11686 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11687 goto evalstart;
11690 else {
11691 stopVarNamePtr = expr->token[1].objPtr;
11692 Jim_IncrRefCount(stopVarNamePtr);
11693 /* Keep the compiler happy */
11694 stop = 0;
11697 /* Initialization */
11698 varNamePtr = expr->token[0].objPtr;
11699 Jim_IncrRefCount(varNamePtr);
11701 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11702 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11703 goto testcond;
11706 /* --- OPTIMIZED FOR --- */
11707 while (retval == JIM_OK) {
11708 /* === Check condition === */
11709 /* Note that currentVal is already set here */
11711 /* Immediate or Variable? get the 'stop' value if the latter. */
11712 if (stopVarNamePtr) {
11713 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11714 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11715 goto testcond;
11719 if (currentVal >= stop + cmpOffset) {
11720 break;
11723 /* Eval body */
11724 retval = Jim_EvalObj(interp, argv[4]);
11725 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11726 retval = JIM_OK;
11728 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11730 /* Increment */
11731 if (objPtr == NULL) {
11732 retval = JIM_ERR;
11733 goto out;
11735 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11736 currentVal = ++JimWideValue(objPtr);
11737 Jim_InvalidateStringRep(objPtr);
11739 else {
11740 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11741 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11742 ++currentVal)) != JIM_OK) {
11743 goto evalnext;
11748 goto out;
11750 evalstart:
11751 #endif
11753 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11754 /* Body */
11755 retval = Jim_EvalObj(interp, argv[4]);
11757 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11758 /* increment */
11759 evalnext:
11760 retval = Jim_EvalObj(interp, argv[3]);
11761 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11762 /* test */
11763 testcond:
11764 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11768 out:
11769 if (stopVarNamePtr) {
11770 Jim_DecrRefCount(interp, stopVarNamePtr);
11772 if (varNamePtr) {
11773 Jim_DecrRefCount(interp, varNamePtr);
11776 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11777 Jim_SetEmptyResult(interp);
11778 return JIM_OK;
11781 return retval;
11784 /* [loop] */
11785 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11787 int retval;
11788 jim_wide i;
11789 jim_wide limit;
11790 jim_wide incr = 1;
11791 Jim_Obj *bodyObjPtr;
11793 if (argc != 5 && argc != 6) {
11794 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11795 return JIM_ERR;
11798 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11799 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11800 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11801 return JIM_ERR;
11803 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11805 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11807 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11808 retval = Jim_EvalObj(interp, bodyObjPtr);
11809 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11810 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11812 retval = JIM_OK;
11814 /* Increment */
11815 i += incr;
11817 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11818 if (argv[1]->typePtr != &variableObjType) {
11819 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11820 return JIM_ERR;
11823 JimWideValue(objPtr) = i;
11824 Jim_InvalidateStringRep(objPtr);
11826 /* The following step is required in order to invalidate the
11827 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11828 if (argv[1]->typePtr != &variableObjType) {
11829 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11830 retval = JIM_ERR;
11831 break;
11835 else {
11836 objPtr = Jim_NewIntObj(interp, i);
11837 retval = Jim_SetVariable(interp, argv[1], objPtr);
11838 if (retval != JIM_OK) {
11839 Jim_FreeNewObj(interp, objPtr);
11845 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11846 Jim_SetEmptyResult(interp);
11847 return JIM_OK;
11849 return retval;
11852 /* List iterators make it easy to iterate over a list.
11853 * At some point iterators will be expanded to support generators.
11855 typedef struct {
11856 Jim_Obj *objPtr;
11857 int idx;
11858 } Jim_ListIter;
11861 * Initialise the iterator at the start of the list.
11863 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11865 iter->objPtr = objPtr;
11866 iter->idx = 0;
11870 * Returns the next object from the list, or NULL on end-of-list.
11872 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11874 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11875 return NULL;
11877 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11881 * Returns 1 if end-of-list has been reached.
11883 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11885 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11888 /* foreach + lmap implementation. */
11889 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11891 int result = JIM_OK;
11892 int i, numargs;
11893 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11894 Jim_ListIter *iters;
11895 Jim_Obj *script;
11896 Jim_Obj *resultObj;
11898 if (argc < 4 || argc % 2 != 0) {
11899 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11900 return JIM_ERR;
11902 script = argv[argc - 1]; /* Last argument is a script */
11903 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11905 if (numargs == 2) {
11906 iters = twoiters;
11908 else {
11909 iters = Jim_Alloc(numargs * sizeof(*iters));
11911 for (i = 0; i < numargs; i++) {
11912 JimListIterInit(&iters[i], argv[i + 1]);
11913 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11914 result = JIM_ERR;
11917 if (result != JIM_OK) {
11918 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11919 return result;
11922 if (doMap) {
11923 resultObj = Jim_NewListObj(interp, NULL, 0);
11925 else {
11926 resultObj = interp->emptyObj;
11928 Jim_IncrRefCount(resultObj);
11930 while (1) {
11931 /* Have we expired all lists? */
11932 for (i = 0; i < numargs; i += 2) {
11933 if (!JimListIterDone(interp, &iters[i + 1])) {
11934 break;
11937 if (i == numargs) {
11938 /* All done */
11939 break;
11942 /* For each list */
11943 for (i = 0; i < numargs; i += 2) {
11944 Jim_Obj *varName;
11946 /* foreach var */
11947 JimListIterInit(&iters[i], argv[i + 1]);
11948 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11949 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11950 if (!valObj) {
11951 /* Ran out, so store the empty string */
11952 valObj = interp->emptyObj;
11954 /* Avoid shimmering */
11955 Jim_IncrRefCount(valObj);
11956 result = Jim_SetVariable(interp, varName, valObj);
11957 Jim_DecrRefCount(interp, valObj);
11958 if (result != JIM_OK) {
11959 goto err;
11963 switch (result = Jim_EvalObj(interp, script)) {
11964 case JIM_OK:
11965 if (doMap) {
11966 Jim_ListAppendElement(interp, resultObj, interp->result);
11968 break;
11969 case JIM_CONTINUE:
11970 break;
11971 case JIM_BREAK:
11972 goto out;
11973 default:
11974 goto err;
11977 out:
11978 result = JIM_OK;
11979 Jim_SetResult(interp, resultObj);
11980 err:
11981 Jim_DecrRefCount(interp, resultObj);
11982 if (numargs > 2) {
11983 Jim_Free(iters);
11985 return result;
11988 /* [foreach] */
11989 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11991 return JimForeachMapHelper(interp, argc, argv, 0);
11994 /* [lmap] */
11995 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11997 return JimForeachMapHelper(interp, argc, argv, 1);
12000 /* [lassign] */
12001 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12003 int result = JIM_ERR;
12004 int i;
12005 Jim_ListIter iter;
12006 Jim_Obj *resultObj;
12008 if (argc < 2) {
12009 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12010 return JIM_ERR;
12013 JimListIterInit(&iter, argv[1]);
12015 for (i = 2; i < argc; i++) {
12016 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12017 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12018 if (result != JIM_OK) {
12019 return result;
12023 resultObj = Jim_NewListObj(interp, NULL, 0);
12024 while (!JimListIterDone(interp, &iter)) {
12025 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12028 Jim_SetResult(interp, resultObj);
12030 return JIM_OK;
12033 /* [if] */
12034 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12036 int boolean, retval, current = 1, falsebody = 0;
12038 if (argc >= 3) {
12039 while (1) {
12040 /* Far not enough arguments given! */
12041 if (current >= argc)
12042 goto err;
12043 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12044 != JIM_OK)
12045 return retval;
12046 /* There lacks something, isn't it? */
12047 if (current >= argc)
12048 goto err;
12049 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12050 current++;
12051 /* Tsk tsk, no then-clause? */
12052 if (current >= argc)
12053 goto err;
12054 if (boolean)
12055 return Jim_EvalObj(interp, argv[current]);
12056 /* Ok: no else-clause follows */
12057 if (++current >= argc) {
12058 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12059 return JIM_OK;
12061 falsebody = current++;
12062 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12063 /* IIICKS - else-clause isn't last cmd? */
12064 if (current != argc - 1)
12065 goto err;
12066 return Jim_EvalObj(interp, argv[current]);
12068 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12069 /* Ok: elseif follows meaning all the stuff
12070 * again (how boring...) */
12071 continue;
12072 /* OOPS - else-clause is not last cmd? */
12073 else if (falsebody != argc - 1)
12074 goto err;
12075 return Jim_EvalObj(interp, argv[falsebody]);
12077 return JIM_OK;
12079 err:
12080 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12081 return JIM_ERR;
12085 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12086 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12087 Jim_Obj *stringObj, int nocase)
12089 Jim_Obj *parms[4];
12090 int argc = 0;
12091 long eq;
12092 int rc;
12094 parms[argc++] = commandObj;
12095 if (nocase) {
12096 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12098 parms[argc++] = patternObj;
12099 parms[argc++] = stringObj;
12101 rc = Jim_EvalObjVector(interp, argc, parms);
12103 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12104 eq = -rc;
12107 return eq;
12110 enum
12111 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12113 /* [switch] */
12114 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12116 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12117 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12118 Jim_Obj *script = 0;
12120 if (argc < 3) {
12121 wrongnumargs:
12122 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12123 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12124 return JIM_ERR;
12126 for (opt = 1; opt < argc; ++opt) {
12127 const char *option = Jim_String(argv[opt]);
12129 if (*option != '-')
12130 break;
12131 else if (strncmp(option, "--", 2) == 0) {
12132 ++opt;
12133 break;
12135 else if (strncmp(option, "-exact", 2) == 0)
12136 matchOpt = SWITCH_EXACT;
12137 else if (strncmp(option, "-glob", 2) == 0)
12138 matchOpt = SWITCH_GLOB;
12139 else if (strncmp(option, "-regexp", 2) == 0)
12140 matchOpt = SWITCH_RE;
12141 else if (strncmp(option, "-command", 2) == 0) {
12142 matchOpt = SWITCH_CMD;
12143 if ((argc - opt) < 2)
12144 goto wrongnumargs;
12145 command = argv[++opt];
12147 else {
12148 Jim_SetResultFormatted(interp,
12149 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12150 argv[opt]);
12151 return JIM_ERR;
12153 if ((argc - opt) < 2)
12154 goto wrongnumargs;
12156 strObj = argv[opt++];
12157 patCount = argc - opt;
12158 if (patCount == 1) {
12159 Jim_Obj **vector;
12161 JimListGetElements(interp, argv[opt], &patCount, &vector);
12162 caseList = vector;
12164 else
12165 caseList = &argv[opt];
12166 if (patCount == 0 || patCount % 2 != 0)
12167 goto wrongnumargs;
12168 for (i = 0; script == 0 && i < patCount; i += 2) {
12169 Jim_Obj *patObj = caseList[i];
12171 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12172 || i < (patCount - 2)) {
12173 switch (matchOpt) {
12174 case SWITCH_EXACT:
12175 if (Jim_StringEqObj(strObj, patObj))
12176 script = caseList[i + 1];
12177 break;
12178 case SWITCH_GLOB:
12179 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12180 script = caseList[i + 1];
12181 break;
12182 case SWITCH_RE:
12183 command = Jim_NewStringObj(interp, "regexp", -1);
12184 /* Fall thru intentionally */
12185 case SWITCH_CMD:{
12186 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12188 /* After the execution of a command we need to
12189 * make sure to reconvert the object into a list
12190 * again. Only for the single-list style [switch]. */
12191 if (argc - opt == 1) {
12192 Jim_Obj **vector;
12194 JimListGetElements(interp, argv[opt], &patCount, &vector);
12195 caseList = vector;
12197 /* command is here already decref'd */
12198 if (rc < 0) {
12199 return -rc;
12201 if (rc)
12202 script = caseList[i + 1];
12203 break;
12207 else {
12208 script = caseList[i + 1];
12211 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12212 script = caseList[i + 1];
12213 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12214 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12215 return JIM_ERR;
12217 Jim_SetEmptyResult(interp);
12218 if (script) {
12219 return Jim_EvalObj(interp, script);
12221 return JIM_OK;
12224 /* [list] */
12225 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12227 Jim_Obj *listObjPtr;
12229 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12230 Jim_SetResult(interp, listObjPtr);
12231 return JIM_OK;
12234 /* [lindex] */
12235 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12237 Jim_Obj *objPtr, *listObjPtr;
12238 int i;
12239 int idx;
12241 if (argc < 2) {
12242 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12243 return JIM_ERR;
12245 objPtr = argv[1];
12246 Jim_IncrRefCount(objPtr);
12247 for (i = 2; i < argc; i++) {
12248 listObjPtr = objPtr;
12249 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12250 Jim_DecrRefCount(interp, listObjPtr);
12251 return JIM_ERR;
12253 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12254 /* Returns an empty object if the index
12255 * is out of range. */
12256 Jim_DecrRefCount(interp, listObjPtr);
12257 Jim_SetEmptyResult(interp);
12258 return JIM_OK;
12260 Jim_IncrRefCount(objPtr);
12261 Jim_DecrRefCount(interp, listObjPtr);
12263 Jim_SetResult(interp, objPtr);
12264 Jim_DecrRefCount(interp, objPtr);
12265 return JIM_OK;
12268 /* [llength] */
12269 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12271 if (argc != 2) {
12272 Jim_WrongNumArgs(interp, 1, argv, "list");
12273 return JIM_ERR;
12275 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12276 return JIM_OK;
12279 /* [lsearch] */
12280 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12282 static const char * const options[] = {
12283 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12284 NULL
12286 enum
12287 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12288 OPT_COMMAND };
12289 int i;
12290 int opt_bool = 0;
12291 int opt_not = 0;
12292 int opt_nocase = 0;
12293 int opt_all = 0;
12294 int opt_inline = 0;
12295 int opt_match = OPT_EXACT;
12296 int listlen;
12297 int rc = JIM_OK;
12298 Jim_Obj *listObjPtr = NULL;
12299 Jim_Obj *commandObj = NULL;
12301 if (argc < 3) {
12302 wrongargs:
12303 Jim_WrongNumArgs(interp, 1, argv,
12304 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12305 return JIM_ERR;
12308 for (i = 1; i < argc - 2; i++) {
12309 int option;
12311 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12312 return JIM_ERR;
12314 switch (option) {
12315 case OPT_BOOL:
12316 opt_bool = 1;
12317 opt_inline = 0;
12318 break;
12319 case OPT_NOT:
12320 opt_not = 1;
12321 break;
12322 case OPT_NOCASE:
12323 opt_nocase = 1;
12324 break;
12325 case OPT_INLINE:
12326 opt_inline = 1;
12327 opt_bool = 0;
12328 break;
12329 case OPT_ALL:
12330 opt_all = 1;
12331 break;
12332 case OPT_COMMAND:
12333 if (i >= argc - 2) {
12334 goto wrongargs;
12336 commandObj = argv[++i];
12337 /* fallthru */
12338 case OPT_EXACT:
12339 case OPT_GLOB:
12340 case OPT_REGEXP:
12341 opt_match = option;
12342 break;
12346 argv += i;
12348 if (opt_all) {
12349 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12351 if (opt_match == OPT_REGEXP) {
12352 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12354 if (commandObj) {
12355 Jim_IncrRefCount(commandObj);
12358 listlen = Jim_ListLength(interp, argv[0]);
12359 for (i = 0; i < listlen; i++) {
12360 int eq = 0;
12361 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12363 switch (opt_match) {
12364 case OPT_EXACT:
12365 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12366 break;
12368 case OPT_GLOB:
12369 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12370 break;
12372 case OPT_REGEXP:
12373 case OPT_COMMAND:
12374 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12375 if (eq < 0) {
12376 if (listObjPtr) {
12377 Jim_FreeNewObj(interp, listObjPtr);
12379 rc = JIM_ERR;
12380 goto done;
12382 break;
12385 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12386 if (!eq && opt_bool && opt_not && !opt_all) {
12387 continue;
12390 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12391 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12392 Jim_Obj *resultObj;
12394 if (opt_bool) {
12395 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12397 else if (!opt_inline) {
12398 resultObj = Jim_NewIntObj(interp, i);
12400 else {
12401 resultObj = objPtr;
12404 if (opt_all) {
12405 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12407 else {
12408 Jim_SetResult(interp, resultObj);
12409 goto done;
12414 if (opt_all) {
12415 Jim_SetResult(interp, listObjPtr);
12417 else {
12418 /* No match */
12419 if (opt_bool) {
12420 Jim_SetResultBool(interp, opt_not);
12422 else if (!opt_inline) {
12423 Jim_SetResultInt(interp, -1);
12427 done:
12428 if (commandObj) {
12429 Jim_DecrRefCount(interp, commandObj);
12431 return rc;
12434 /* [lappend] */
12435 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12437 Jim_Obj *listObjPtr;
12438 int shared, i;
12440 if (argc < 2) {
12441 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12442 return JIM_ERR;
12444 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12445 if (!listObjPtr) {
12446 /* Create the list if it does not exists */
12447 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12448 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12449 Jim_FreeNewObj(interp, listObjPtr);
12450 return JIM_ERR;
12453 shared = Jim_IsShared(listObjPtr);
12454 if (shared)
12455 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12456 for (i = 2; i < argc; i++)
12457 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12458 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12459 if (shared)
12460 Jim_FreeNewObj(interp, listObjPtr);
12461 return JIM_ERR;
12463 Jim_SetResult(interp, listObjPtr);
12464 return JIM_OK;
12467 /* [linsert] */
12468 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12470 int idx, len;
12471 Jim_Obj *listPtr;
12473 if (argc < 3) {
12474 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12475 return JIM_ERR;
12477 listPtr = argv[1];
12478 if (Jim_IsShared(listPtr))
12479 listPtr = Jim_DuplicateObj(interp, listPtr);
12480 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12481 goto err;
12482 len = Jim_ListLength(interp, listPtr);
12483 if (idx >= len)
12484 idx = len;
12485 else if (idx < 0)
12486 idx = len + idx + 1;
12487 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12488 Jim_SetResult(interp, listPtr);
12489 return JIM_OK;
12490 err:
12491 if (listPtr != argv[1]) {
12492 Jim_FreeNewObj(interp, listPtr);
12494 return JIM_ERR;
12497 /* [lreplace] */
12498 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12500 int first, last, len, rangeLen;
12501 Jim_Obj *listObj;
12502 Jim_Obj *newListObj;
12504 if (argc < 4) {
12505 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12506 return JIM_ERR;
12508 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12509 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12510 return JIM_ERR;
12513 listObj = argv[1];
12514 len = Jim_ListLength(interp, listObj);
12516 first = JimRelToAbsIndex(len, first);
12517 last = JimRelToAbsIndex(len, last);
12518 JimRelToAbsRange(len, &first, &last, &rangeLen);
12520 /* Now construct a new list which consists of:
12521 * <elements before first> <supplied elements> <elements after last>
12524 /* Check to see if trying to replace past the end of the list */
12525 if (first < len) {
12526 /* OK. Not past the end */
12528 else if (len == 0) {
12529 /* Special for empty list, adjust first to 0 */
12530 first = 0;
12532 else {
12533 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12534 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12535 return JIM_ERR;
12538 /* Add the first set of elements */
12539 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12541 /* Add supplied elements */
12542 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12544 /* Add the remaining elements */
12545 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12547 Jim_SetResult(interp, newListObj);
12548 return JIM_OK;
12551 /* [lset] */
12552 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12554 if (argc < 3) {
12555 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12556 return JIM_ERR;
12558 else if (argc == 3) {
12559 /* With no indexes, simply implements [set] */
12560 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12561 return JIM_ERR;
12562 Jim_SetResult(interp, argv[2]);
12563 return JIM_OK;
12565 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12568 /* [lsort] */
12569 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12571 static const char * const options[] = {
12572 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12574 enum
12575 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12576 Jim_Obj *resObj;
12577 int i;
12578 int retCode;
12580 struct lsort_info info;
12582 if (argc < 2) {
12583 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12584 return JIM_ERR;
12587 info.type = JIM_LSORT_ASCII;
12588 info.order = 1;
12589 info.indexed = 0;
12590 info.unique = 0;
12591 info.command = NULL;
12592 info.interp = interp;
12594 for (i = 1; i < (argc - 1); i++) {
12595 int option;
12597 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12598 != JIM_OK)
12599 return JIM_ERR;
12600 switch (option) {
12601 case OPT_ASCII:
12602 info.type = JIM_LSORT_ASCII;
12603 break;
12604 case OPT_NOCASE:
12605 info.type = JIM_LSORT_NOCASE;
12606 break;
12607 case OPT_INTEGER:
12608 info.type = JIM_LSORT_INTEGER;
12609 break;
12610 case OPT_REAL:
12611 info.type = JIM_LSORT_REAL;
12612 break;
12613 case OPT_INCREASING:
12614 info.order = 1;
12615 break;
12616 case OPT_DECREASING:
12617 info.order = -1;
12618 break;
12619 case OPT_UNIQUE:
12620 info.unique = 1;
12621 break;
12622 case OPT_COMMAND:
12623 if (i >= (argc - 2)) {
12624 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12625 return JIM_ERR;
12627 info.type = JIM_LSORT_COMMAND;
12628 info.command = argv[i + 1];
12629 i++;
12630 break;
12631 case OPT_INDEX:
12632 if (i >= (argc - 2)) {
12633 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12634 return JIM_ERR;
12636 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12637 return JIM_ERR;
12639 info.indexed = 1;
12640 i++;
12641 break;
12644 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12645 retCode = ListSortElements(interp, resObj, &info);
12646 if (retCode == JIM_OK) {
12647 Jim_SetResult(interp, resObj);
12649 else {
12650 Jim_FreeNewObj(interp, resObj);
12652 return retCode;
12655 /* [append] */
12656 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12658 Jim_Obj *stringObjPtr;
12659 int i;
12661 if (argc < 2) {
12662 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12663 return JIM_ERR;
12665 if (argc == 2) {
12666 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12667 if (!stringObjPtr)
12668 return JIM_ERR;
12670 else {
12671 int freeobj = 0;
12672 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12673 if (!stringObjPtr) {
12674 /* Create the string if it doesn't exist */
12675 stringObjPtr = Jim_NewEmptyStringObj(interp);
12676 freeobj = 1;
12678 else if (Jim_IsShared(stringObjPtr)) {
12679 freeobj = 1;
12680 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12682 for (i = 2; i < argc; i++) {
12683 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12685 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12686 if (freeobj) {
12687 Jim_FreeNewObj(interp, stringObjPtr);
12689 return JIM_ERR;
12692 Jim_SetResult(interp, stringObjPtr);
12693 return JIM_OK;
12696 /* [debug] */
12697 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12699 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12700 static const char * const options[] = {
12701 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12702 "exprbc", "show",
12703 NULL
12705 enum
12707 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12708 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12710 int option;
12712 if (argc < 2) {
12713 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12714 return JIM_ERR;
12716 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12717 return JIM_ERR;
12718 if (option == OPT_REFCOUNT) {
12719 if (argc != 3) {
12720 Jim_WrongNumArgs(interp, 2, argv, "object");
12721 return JIM_ERR;
12723 Jim_SetResultInt(interp, argv[2]->refCount);
12724 return JIM_OK;
12726 else if (option == OPT_OBJCOUNT) {
12727 int freeobj = 0, liveobj = 0;
12728 char buf[256];
12729 Jim_Obj *objPtr;
12731 if (argc != 2) {
12732 Jim_WrongNumArgs(interp, 2, argv, "");
12733 return JIM_ERR;
12735 /* Count the number of free objects. */
12736 objPtr = interp->freeList;
12737 while (objPtr) {
12738 freeobj++;
12739 objPtr = objPtr->nextObjPtr;
12741 /* Count the number of live objects. */
12742 objPtr = interp->liveList;
12743 while (objPtr) {
12744 liveobj++;
12745 objPtr = objPtr->nextObjPtr;
12747 /* Set the result string and return. */
12748 sprintf(buf, "free %d used %d", freeobj, liveobj);
12749 Jim_SetResultString(interp, buf, -1);
12750 return JIM_OK;
12752 else if (option == OPT_OBJECTS) {
12753 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12755 /* Count the number of live objects. */
12756 objPtr = interp->liveList;
12757 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12758 while (objPtr) {
12759 char buf[128];
12760 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12762 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12763 sprintf(buf, "%p", objPtr);
12764 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12765 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12766 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12767 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12768 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12769 objPtr = objPtr->nextObjPtr;
12771 Jim_SetResult(interp, listObjPtr);
12772 return JIM_OK;
12774 else if (option == OPT_INVSTR) {
12775 Jim_Obj *objPtr;
12777 if (argc != 3) {
12778 Jim_WrongNumArgs(interp, 2, argv, "object");
12779 return JIM_ERR;
12781 objPtr = argv[2];
12782 if (objPtr->typePtr != NULL)
12783 Jim_InvalidateStringRep(objPtr);
12784 Jim_SetEmptyResult(interp);
12785 return JIM_OK;
12787 else if (option == OPT_SHOW) {
12788 const char *s;
12789 int len, charlen;
12791 if (argc != 3) {
12792 Jim_WrongNumArgs(interp, 2, argv, "object");
12793 return JIM_ERR;
12795 s = Jim_GetString(argv[2], &len);
12796 #ifdef JIM_UTF8
12797 charlen = utf8_strlen(s, len);
12798 #else
12799 charlen = len;
12800 #endif
12801 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12802 printf("chars (%d): <<%s>>\n", charlen, s);
12803 printf("bytes (%d):", len);
12804 while (len--) {
12805 printf(" %02x", (unsigned char)*s++);
12807 printf("\n");
12808 return JIM_OK;
12810 else if (option == OPT_SCRIPTLEN) {
12811 ScriptObj *script;
12813 if (argc != 3) {
12814 Jim_WrongNumArgs(interp, 2, argv, "script");
12815 return JIM_ERR;
12817 script = JimGetScript(interp, argv[2]);
12818 if (script == NULL)
12819 return JIM_ERR;
12820 Jim_SetResultInt(interp, script->len);
12821 return JIM_OK;
12823 else if (option == OPT_EXPRLEN) {
12824 ExprByteCode *expr;
12826 if (argc != 3) {
12827 Jim_WrongNumArgs(interp, 2, argv, "expression");
12828 return JIM_ERR;
12830 expr = JimGetExpression(interp, argv[2]);
12831 if (expr == NULL)
12832 return JIM_ERR;
12833 Jim_SetResultInt(interp, expr->len);
12834 return JIM_OK;
12836 else if (option == OPT_EXPRBC) {
12837 Jim_Obj *objPtr;
12838 ExprByteCode *expr;
12839 int i;
12841 if (argc != 3) {
12842 Jim_WrongNumArgs(interp, 2, argv, "expression");
12843 return JIM_ERR;
12845 expr = JimGetExpression(interp, argv[2]);
12846 if (expr == NULL)
12847 return JIM_ERR;
12848 objPtr = Jim_NewListObj(interp, NULL, 0);
12849 for (i = 0; i < expr->len; i++) {
12850 const char *type;
12851 const Jim_ExprOperator *op;
12852 Jim_Obj *obj = expr->token[i].objPtr;
12854 switch (expr->token[i].type) {
12855 case JIM_TT_EXPR_INT:
12856 type = "int";
12857 break;
12858 case JIM_TT_EXPR_DOUBLE:
12859 type = "double";
12860 break;
12861 case JIM_TT_CMD:
12862 type = "command";
12863 break;
12864 case JIM_TT_VAR:
12865 type = "variable";
12866 break;
12867 case JIM_TT_DICTSUGAR:
12868 type = "dictsugar";
12869 break;
12870 case JIM_TT_EXPRSUGAR:
12871 type = "exprsugar";
12872 break;
12873 case JIM_TT_ESC:
12874 type = "subst";
12875 break;
12876 case JIM_TT_STR:
12877 type = "string";
12878 break;
12879 default:
12880 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12881 if (op == NULL) {
12882 type = "private";
12884 else {
12885 type = "operator";
12887 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12888 break;
12890 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12891 Jim_ListAppendElement(interp, objPtr, obj);
12893 Jim_SetResult(interp, objPtr);
12894 return JIM_OK;
12896 else {
12897 Jim_SetResultString(interp,
12898 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12899 return JIM_ERR;
12901 /* unreached */
12902 #endif /* JIM_BOOTSTRAP */
12903 #if !defined(JIM_DEBUG_COMMAND)
12904 Jim_SetResultString(interp, "unsupported", -1);
12905 return JIM_ERR;
12906 #endif
12909 /* [eval] */
12910 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12912 int rc;
12914 if (argc < 2) {
12915 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12916 return JIM_ERR;
12919 if (argc == 2) {
12920 rc = Jim_EvalObj(interp, argv[1]);
12922 else {
12923 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12926 if (rc == JIM_ERR) {
12927 /* eval is "interesting", so add a stack frame here */
12928 interp->addStackTrace++;
12930 return rc;
12933 /* [uplevel] */
12934 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12936 if (argc >= 2) {
12937 int retcode;
12938 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12939 int savedTailcall;
12940 const char *str;
12942 /* Save the old callframe pointer */
12943 savedCallFrame = interp->framePtr;
12945 /* Lookup the target frame pointer */
12946 str = Jim_String(argv[1]);
12947 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12948 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12949 argc--;
12950 argv++;
12952 else {
12953 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12955 if (targetCallFrame == NULL) {
12956 return JIM_ERR;
12958 if (argc < 2) {
12959 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12960 return JIM_ERR;
12962 /* Eval the code in the target callframe. */
12963 interp->framePtr = targetCallFrame;
12964 /* Can't merge tailcalls across upcall */
12965 savedTailcall = interp->framePtr->tailcall;
12966 interp->framePtr->tailcall = 0;
12967 if (argc == 2) {
12968 retcode = Jim_EvalObj(interp, argv[1]);
12970 else {
12971 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12973 interp->framePtr->tailcall = savedTailcall;
12974 interp->framePtr = savedCallFrame;
12975 return retcode;
12977 else {
12978 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12979 return JIM_ERR;
12983 /* [expr] */
12984 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12986 Jim_Obj *exprResultPtr;
12987 int retcode;
12989 if (argc == 2) {
12990 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12992 else if (argc > 2) {
12993 Jim_Obj *objPtr;
12995 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12996 Jim_IncrRefCount(objPtr);
12997 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12998 Jim_DecrRefCount(interp, objPtr);
13000 else {
13001 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13002 return JIM_ERR;
13004 if (retcode != JIM_OK)
13005 return retcode;
13006 Jim_SetResult(interp, exprResultPtr);
13007 Jim_DecrRefCount(interp, exprResultPtr);
13008 return JIM_OK;
13011 /* [break] */
13012 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13014 if (argc != 1) {
13015 Jim_WrongNumArgs(interp, 1, argv, "");
13016 return JIM_ERR;
13018 return JIM_BREAK;
13021 /* [continue] */
13022 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13024 if (argc != 1) {
13025 Jim_WrongNumArgs(interp, 1, argv, "");
13026 return JIM_ERR;
13028 return JIM_CONTINUE;
13031 /* [return] */
13032 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13034 int i;
13035 Jim_Obj *stackTraceObj = NULL;
13036 Jim_Obj *errorCodeObj = NULL;
13037 int returnCode = JIM_OK;
13038 long level = 1;
13040 for (i = 1; i < argc - 1; i += 2) {
13041 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13042 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13043 return JIM_ERR;
13046 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13047 stackTraceObj = argv[i + 1];
13049 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13050 errorCodeObj = argv[i + 1];
13052 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13053 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13054 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13055 return JIM_ERR;
13058 else {
13059 break;
13063 if (i != argc - 1 && i != argc) {
13064 Jim_WrongNumArgs(interp, 1, argv,
13065 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13068 /* If a stack trace is supplied and code is error, set the stack trace */
13069 if (stackTraceObj && returnCode == JIM_ERR) {
13070 JimSetStackTrace(interp, stackTraceObj);
13072 /* If an error code list is supplied, set the global $errorCode */
13073 if (errorCodeObj && returnCode == JIM_ERR) {
13074 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13076 interp->returnCode = returnCode;
13077 interp->returnLevel = level;
13079 if (i == argc - 1) {
13080 Jim_SetResult(interp, argv[i]);
13082 return JIM_RETURN;
13085 /* [tailcall] */
13086 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13088 if (interp->framePtr->level == 0) {
13089 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13090 return JIM_ERR;
13092 else if (argc >= 2) {
13093 /* Need to resolve the tailcall command in the current context */
13094 Jim_CallFrame *cf = interp->framePtr->parent;
13096 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13097 if (cmdPtr == NULL) {
13098 return JIM_ERR;
13101 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13103 /* And stash this pre-resolved command */
13104 JimIncrCmdRefCount(cmdPtr);
13105 cf->tailcallCmd = cmdPtr;
13107 /* And stash the command list */
13108 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13110 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13111 Jim_IncrRefCount(cf->tailcallObj);
13113 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13114 return JIM_EVAL;
13116 return JIM_OK;
13119 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13121 Jim_Obj *cmdList;
13122 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13124 /* prefixListObj is a list to which the args need to be appended */
13125 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13126 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13128 return JimEvalObjList(interp, cmdList);
13131 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13133 Jim_Obj *prefixListObj = privData;
13134 Jim_DecrRefCount(interp, prefixListObj);
13137 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13139 Jim_Obj *prefixListObj;
13140 const char *newname;
13142 if (argc < 3) {
13143 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13144 return JIM_ERR;
13147 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13148 Jim_IncrRefCount(prefixListObj);
13149 newname = Jim_String(argv[1]);
13150 if (newname[0] == ':' && newname[1] == ':') {
13151 while (*++newname == ':') {
13155 Jim_SetResult(interp, argv[1]);
13157 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13160 /* [proc] */
13161 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13163 Jim_Cmd *cmd;
13165 if (argc != 4 && argc != 5) {
13166 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13167 return JIM_ERR;
13170 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13171 return JIM_ERR;
13174 if (argc == 4) {
13175 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13177 else {
13178 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13181 if (cmd) {
13182 /* Add the new command */
13183 Jim_Obj *qualifiedCmdNameObj;
13184 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13186 JimCreateCommand(interp, cmdname, cmd);
13188 /* Calculate and set the namespace for this proc */
13189 JimUpdateProcNamespace(interp, cmd, cmdname);
13191 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13193 /* Unlike Tcl, set the name of the proc as the result */
13194 Jim_SetResult(interp, argv[1]);
13195 return JIM_OK;
13197 return JIM_ERR;
13200 /* [local] */
13201 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13203 int retcode;
13205 if (argc < 2) {
13206 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13207 return JIM_ERR;
13210 /* Evaluate the arguments with 'local' in force */
13211 interp->local++;
13212 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13213 interp->local--;
13216 /* If OK, and the result is a proc, add it to the list of local procs */
13217 if (retcode == 0) {
13218 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13220 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13221 return JIM_ERR;
13223 if (interp->framePtr->localCommands == NULL) {
13224 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13225 Jim_InitStack(interp->framePtr->localCommands);
13227 Jim_IncrRefCount(cmdNameObj);
13228 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13231 return retcode;
13234 /* [upcall] */
13235 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13237 if (argc < 2) {
13238 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13239 return JIM_ERR;
13241 else {
13242 int retcode;
13244 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13245 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13246 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13247 return JIM_ERR;
13249 /* OK. Mark this command as being in an upcall */
13250 cmdPtr->u.proc.upcall++;
13251 JimIncrCmdRefCount(cmdPtr);
13253 /* Invoke the command as normal */
13254 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13256 /* No longer in an upcall */
13257 cmdPtr->u.proc.upcall--;
13258 JimDecrCmdRefCount(interp, cmdPtr);
13260 return retcode;
13264 /* [apply] */
13265 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13267 if (argc < 2) {
13268 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13269 return JIM_ERR;
13271 else {
13272 int ret;
13273 Jim_Cmd *cmd;
13274 Jim_Obj *argListObjPtr;
13275 Jim_Obj *bodyObjPtr;
13276 Jim_Obj *nsObj = NULL;
13277 Jim_Obj **nargv;
13279 int len = Jim_ListLength(interp, argv[1]);
13280 if (len != 2 && len != 3) {
13281 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13282 return JIM_ERR;
13285 if (len == 3) {
13286 #ifdef jim_ext_namespace
13287 /* Need to canonicalise the given namespace. */
13288 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13289 #else
13290 Jim_SetResultString(interp, "namespaces not enabled", -1);
13291 return JIM_ERR;
13292 #endif
13294 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13295 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13297 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13299 if (cmd) {
13300 /* Create a new argv array with a dummy argv[0], for error messages */
13301 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13302 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13303 Jim_IncrRefCount(nargv[0]);
13304 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13305 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13306 Jim_DecrRefCount(interp, nargv[0]);
13307 Jim_Free(nargv);
13309 JimDecrCmdRefCount(interp, cmd);
13310 return ret;
13312 return JIM_ERR;
13317 /* [concat] */
13318 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13320 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13321 return JIM_OK;
13324 /* [upvar] */
13325 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13327 int i;
13328 Jim_CallFrame *targetCallFrame;
13330 /* Lookup the target frame pointer */
13331 if (argc > 3 && (argc % 2 == 0)) {
13332 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13333 argc--;
13334 argv++;
13336 else {
13337 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13339 if (targetCallFrame == NULL) {
13340 return JIM_ERR;
13343 /* Check for arity */
13344 if (argc < 3) {
13345 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13346 return JIM_ERR;
13349 /* Now... for every other/local couple: */
13350 for (i = 1; i < argc; i += 2) {
13351 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13352 return JIM_ERR;
13354 return JIM_OK;
13357 /* [global] */
13358 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13360 int i;
13362 if (argc < 2) {
13363 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13364 return JIM_ERR;
13366 /* Link every var to the toplevel having the same name */
13367 if (interp->framePtr->level == 0)
13368 return JIM_OK; /* global at toplevel... */
13369 for (i = 1; i < argc; i++) {
13370 /* global ::blah does nothing */
13371 const char *name = Jim_String(argv[i]);
13372 if (name[0] != ':' || name[1] != ':') {
13373 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13374 return JIM_ERR;
13377 return JIM_OK;
13380 /* does the [string map] operation. On error NULL is returned,
13381 * otherwise a new string object with the result, having refcount = 0,
13382 * is returned. */
13383 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13384 Jim_Obj *objPtr, int nocase)
13386 int numMaps;
13387 const char *str, *noMatchStart = NULL;
13388 int strLen, i;
13389 Jim_Obj *resultObjPtr;
13391 numMaps = Jim_ListLength(interp, mapListObjPtr);
13392 if (numMaps % 2) {
13393 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13394 return NULL;
13397 str = Jim_String(objPtr);
13398 strLen = Jim_Utf8Length(interp, objPtr);
13400 /* Map it */
13401 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13402 while (strLen) {
13403 for (i = 0; i < numMaps; i += 2) {
13404 Jim_Obj *objPtr;
13405 const char *k;
13406 int kl;
13408 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13409 k = Jim_String(objPtr);
13410 kl = Jim_Utf8Length(interp, objPtr);
13412 if (strLen >= kl && kl) {
13413 int rc;
13414 rc = JimStringCompareLen(str, k, kl, nocase);
13415 if (rc == 0) {
13416 if (noMatchStart) {
13417 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13418 noMatchStart = NULL;
13420 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13421 str += utf8_index(str, kl);
13422 strLen -= kl;
13423 break;
13427 if (i == numMaps) { /* no match */
13428 int c;
13429 if (noMatchStart == NULL)
13430 noMatchStart = str;
13431 str += utf8_tounicode(str, &c);
13432 strLen--;
13435 if (noMatchStart) {
13436 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13438 return resultObjPtr;
13441 /* [string] */
13442 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13444 int len;
13445 int opt_case = 1;
13446 int option;
13447 static const char * const options[] = {
13448 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13449 "map", "repeat", "reverse", "index", "first", "last", "cat",
13450 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13452 enum
13454 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13455 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13456 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13458 static const char * const nocase_options[] = {
13459 "-nocase", NULL
13461 static const char * const nocase_length_options[] = {
13462 "-nocase", "-length", NULL
13465 if (argc < 2) {
13466 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13467 return JIM_ERR;
13469 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13470 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13471 return JIM_ERR;
13473 switch (option) {
13474 case OPT_LENGTH:
13475 case OPT_BYTELENGTH:
13476 if (argc != 3) {
13477 Jim_WrongNumArgs(interp, 2, argv, "string");
13478 return JIM_ERR;
13480 if (option == OPT_LENGTH) {
13481 len = Jim_Utf8Length(interp, argv[2]);
13483 else {
13484 len = Jim_Length(argv[2]);
13486 Jim_SetResultInt(interp, len);
13487 return JIM_OK;
13489 case OPT_CAT:{
13490 Jim_Obj *objPtr;
13491 if (argc == 3) {
13492 /* optimise the one-arg case */
13493 objPtr = argv[2];
13495 else {
13496 int i;
13498 objPtr = Jim_NewStringObj(interp, "", 0);
13500 for (i = 2; i < argc; i++) {
13501 Jim_AppendObj(interp, objPtr, argv[i]);
13504 Jim_SetResult(interp, objPtr);
13505 return JIM_OK;
13508 case OPT_COMPARE:
13509 case OPT_EQUAL:
13511 /* n is the number of remaining option args */
13512 long opt_length = -1;
13513 int n = argc - 4;
13514 int i = 2;
13515 while (n > 0) {
13516 int subopt;
13517 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13518 JIM_ENUM_ABBREV) != JIM_OK) {
13519 badcompareargs:
13520 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13521 return JIM_ERR;
13523 if (subopt == 0) {
13524 /* -nocase */
13525 opt_case = 0;
13526 n--;
13528 else {
13529 /* -length */
13530 if (n < 2) {
13531 goto badcompareargs;
13533 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13534 return JIM_ERR;
13536 n -= 2;
13539 if (n) {
13540 goto badcompareargs;
13542 argv += argc - 2;
13543 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13544 /* Fast version - [string equal], case sensitive, no length */
13545 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13547 else {
13548 if (opt_length >= 0) {
13549 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13551 else {
13552 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13554 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13556 return JIM_OK;
13559 case OPT_MATCH:
13560 if (argc != 4 &&
13561 (argc != 5 ||
13562 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13563 JIM_ENUM_ABBREV) != JIM_OK)) {
13564 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13565 return JIM_ERR;
13567 if (opt_case == 0) {
13568 argv++;
13570 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13571 return JIM_OK;
13573 case OPT_MAP:{
13574 Jim_Obj *objPtr;
13576 if (argc != 4 &&
13577 (argc != 5 ||
13578 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13579 JIM_ENUM_ABBREV) != JIM_OK)) {
13580 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13581 return JIM_ERR;
13584 if (opt_case == 0) {
13585 argv++;
13587 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13588 if (objPtr == NULL) {
13589 return JIM_ERR;
13591 Jim_SetResult(interp, objPtr);
13592 return JIM_OK;
13595 case OPT_RANGE:
13596 case OPT_BYTERANGE:{
13597 Jim_Obj *objPtr;
13599 if (argc != 5) {
13600 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13601 return JIM_ERR;
13603 if (option == OPT_RANGE) {
13604 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13606 else
13608 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13611 if (objPtr == NULL) {
13612 return JIM_ERR;
13614 Jim_SetResult(interp, objPtr);
13615 return JIM_OK;
13618 case OPT_REPLACE:{
13619 Jim_Obj *objPtr;
13621 if (argc != 5 && argc != 6) {
13622 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13623 return JIM_ERR;
13625 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13626 if (objPtr == NULL) {
13627 return JIM_ERR;
13629 Jim_SetResult(interp, objPtr);
13630 return JIM_OK;
13634 case OPT_REPEAT:{
13635 Jim_Obj *objPtr;
13636 jim_wide count;
13638 if (argc != 4) {
13639 Jim_WrongNumArgs(interp, 2, argv, "string count");
13640 return JIM_ERR;
13642 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13643 return JIM_ERR;
13645 objPtr = Jim_NewStringObj(interp, "", 0);
13646 if (count > 0) {
13647 while (count--) {
13648 Jim_AppendObj(interp, objPtr, argv[2]);
13651 Jim_SetResult(interp, objPtr);
13652 return JIM_OK;
13655 case OPT_REVERSE:{
13656 char *buf, *p;
13657 const char *str;
13658 int len;
13659 int i;
13661 if (argc != 3) {
13662 Jim_WrongNumArgs(interp, 2, argv, "string");
13663 return JIM_ERR;
13666 str = Jim_GetString(argv[2], &len);
13667 buf = Jim_Alloc(len + 1);
13668 p = buf + len;
13669 *p = 0;
13670 for (i = 0; i < len; ) {
13671 int c;
13672 int l = utf8_tounicode(str, &c);
13673 memcpy(p - l, str, l);
13674 p -= l;
13675 i += l;
13676 str += l;
13678 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13679 return JIM_OK;
13682 case OPT_INDEX:{
13683 int idx;
13684 const char *str;
13686 if (argc != 4) {
13687 Jim_WrongNumArgs(interp, 2, argv, "string index");
13688 return JIM_ERR;
13690 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13691 return JIM_ERR;
13693 str = Jim_String(argv[2]);
13694 len = Jim_Utf8Length(interp, argv[2]);
13695 if (idx != INT_MIN && idx != INT_MAX) {
13696 idx = JimRelToAbsIndex(len, idx);
13698 if (idx < 0 || idx >= len || str == NULL) {
13699 Jim_SetResultString(interp, "", 0);
13701 else if (len == Jim_Length(argv[2])) {
13702 /* ASCII optimisation */
13703 Jim_SetResultString(interp, str + idx, 1);
13705 else {
13706 int c;
13707 int i = utf8_index(str, idx);
13708 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13710 return JIM_OK;
13713 case OPT_FIRST:
13714 case OPT_LAST:{
13715 int idx = 0, l1, l2;
13716 const char *s1, *s2;
13718 if (argc != 4 && argc != 5) {
13719 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13720 return JIM_ERR;
13722 s1 = Jim_String(argv[2]);
13723 s2 = Jim_String(argv[3]);
13724 l1 = Jim_Utf8Length(interp, argv[2]);
13725 l2 = Jim_Utf8Length(interp, argv[3]);
13726 if (argc == 5) {
13727 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13728 return JIM_ERR;
13730 idx = JimRelToAbsIndex(l2, idx);
13732 else if (option == OPT_LAST) {
13733 idx = l2;
13735 if (option == OPT_FIRST) {
13736 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13738 else {
13739 #ifdef JIM_UTF8
13740 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13741 #else
13742 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13743 #endif
13745 return JIM_OK;
13748 case OPT_TRIM:
13749 case OPT_TRIMLEFT:
13750 case OPT_TRIMRIGHT:{
13751 Jim_Obj *trimchars;
13753 if (argc != 3 && argc != 4) {
13754 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13755 return JIM_ERR;
13757 trimchars = (argc == 4 ? argv[3] : NULL);
13758 if (option == OPT_TRIM) {
13759 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13761 else if (option == OPT_TRIMLEFT) {
13762 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13764 else if (option == OPT_TRIMRIGHT) {
13765 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13767 return JIM_OK;
13770 case OPT_TOLOWER:
13771 case OPT_TOUPPER:
13772 case OPT_TOTITLE:
13773 if (argc != 3) {
13774 Jim_WrongNumArgs(interp, 2, argv, "string");
13775 return JIM_ERR;
13777 if (option == OPT_TOLOWER) {
13778 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13780 else if (option == OPT_TOUPPER) {
13781 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13783 else {
13784 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13786 return JIM_OK;
13788 case OPT_IS:
13789 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13790 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13792 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13793 return JIM_ERR;
13795 return JIM_OK;
13798 /* [time] */
13799 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13801 long i, count = 1;
13802 jim_wide start, elapsed;
13803 char buf[60];
13804 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13806 if (argc < 2) {
13807 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13808 return JIM_ERR;
13810 if (argc == 3) {
13811 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13812 return JIM_ERR;
13814 if (count < 0)
13815 return JIM_OK;
13816 i = count;
13817 start = JimClock();
13818 while (i-- > 0) {
13819 int retval;
13821 retval = Jim_EvalObj(interp, argv[1]);
13822 if (retval != JIM_OK) {
13823 return retval;
13826 elapsed = JimClock() - start;
13827 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13828 Jim_SetResultString(interp, buf, -1);
13829 return JIM_OK;
13832 /* [exit] */
13833 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13835 long exitCode = 0;
13837 if (argc > 2) {
13838 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13839 return JIM_ERR;
13841 if (argc == 2) {
13842 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13843 return JIM_ERR;
13845 interp->exitCode = exitCode;
13846 return JIM_EXIT;
13849 /* [catch] */
13850 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13852 int exitCode = 0;
13853 int i;
13854 int sig = 0;
13856 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13857 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13858 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13860 /* Reset the error code before catch.
13861 * Note that this is not strictly correct.
13863 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13865 for (i = 1; i < argc - 1; i++) {
13866 const char *arg = Jim_String(argv[i]);
13867 jim_wide option;
13868 int ignore;
13870 /* It's a pity we can't use Jim_GetEnum here :-( */
13871 if (strcmp(arg, "--") == 0) {
13872 i++;
13873 break;
13875 if (*arg != '-') {
13876 break;
13879 if (strncmp(arg, "-no", 3) == 0) {
13880 arg += 3;
13881 ignore = 1;
13883 else {
13884 arg++;
13885 ignore = 0;
13888 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13889 option = -1;
13891 if (option < 0) {
13892 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13894 if (option < 0) {
13895 goto wrongargs;
13898 if (ignore) {
13899 ignore_mask |= (1 << option);
13901 else {
13902 ignore_mask &= ~(1 << option);
13906 argc -= i;
13907 if (argc < 1 || argc > 3) {
13908 wrongargs:
13909 Jim_WrongNumArgs(interp, 1, argv,
13910 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13911 return JIM_ERR;
13913 argv += i;
13915 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13916 sig++;
13919 interp->signal_level += sig;
13920 if (Jim_CheckSignal(interp)) {
13921 /* If a signal is set, don't even try to execute the body */
13922 exitCode = JIM_SIGNAL;
13924 else {
13925 exitCode = Jim_EvalObj(interp, argv[0]);
13926 /* Don't want any caught error included in a later stack trace */
13927 interp->errorFlag = 0;
13929 interp->signal_level -= sig;
13931 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13932 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13933 /* Not caught, pass it up */
13934 return exitCode;
13937 if (sig && exitCode == JIM_SIGNAL) {
13938 /* Catch the signal at this level */
13939 if (interp->signal_set_result) {
13940 interp->signal_set_result(interp, interp->sigmask);
13942 else {
13943 Jim_SetResultInt(interp, interp->sigmask);
13945 interp->sigmask = 0;
13948 if (argc >= 2) {
13949 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13950 return JIM_ERR;
13952 if (argc == 3) {
13953 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13955 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13956 Jim_ListAppendElement(interp, optListObj,
13957 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13958 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13959 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13960 if (exitCode == JIM_ERR) {
13961 Jim_Obj *errorCode;
13962 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13963 -1));
13964 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13966 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13967 if (errorCode) {
13968 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13969 Jim_ListAppendElement(interp, optListObj, errorCode);
13972 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13973 return JIM_ERR;
13977 Jim_SetResultInt(interp, exitCode);
13978 return JIM_OK;
13981 #ifdef JIM_REFERENCES
13983 /* [ref] */
13984 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13986 if (argc != 3 && argc != 4) {
13987 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13988 return JIM_ERR;
13990 if (argc == 3) {
13991 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13993 else {
13994 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13996 return JIM_OK;
13999 /* [getref] */
14000 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14002 Jim_Reference *refPtr;
14004 if (argc != 2) {
14005 Jim_WrongNumArgs(interp, 1, argv, "reference");
14006 return JIM_ERR;
14008 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14009 return JIM_ERR;
14010 Jim_SetResult(interp, refPtr->objPtr);
14011 return JIM_OK;
14014 /* [setref] */
14015 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14017 Jim_Reference *refPtr;
14019 if (argc != 3) {
14020 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14021 return JIM_ERR;
14023 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14024 return JIM_ERR;
14025 Jim_IncrRefCount(argv[2]);
14026 Jim_DecrRefCount(interp, refPtr->objPtr);
14027 refPtr->objPtr = argv[2];
14028 Jim_SetResult(interp, argv[2]);
14029 return JIM_OK;
14032 /* [collect] */
14033 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14035 if (argc != 1) {
14036 Jim_WrongNumArgs(interp, 1, argv, "");
14037 return JIM_ERR;
14039 Jim_SetResultInt(interp, Jim_Collect(interp));
14041 /* Free all the freed objects. */
14042 while (interp->freeList) {
14043 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14044 Jim_Free(interp->freeList);
14045 interp->freeList = nextObjPtr;
14048 return JIM_OK;
14051 /* [finalize] reference ?newValue? */
14052 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14054 if (argc != 2 && argc != 3) {
14055 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14056 return JIM_ERR;
14058 if (argc == 2) {
14059 Jim_Obj *cmdNamePtr;
14061 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14062 return JIM_ERR;
14063 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14064 Jim_SetResult(interp, cmdNamePtr);
14066 else {
14067 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14068 return JIM_ERR;
14069 Jim_SetResult(interp, argv[2]);
14071 return JIM_OK;
14074 /* [info references] */
14075 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14077 Jim_Obj *listObjPtr;
14078 Jim_HashTableIterator htiter;
14079 Jim_HashEntry *he;
14081 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14083 JimInitHashTableIterator(&interp->references, &htiter);
14084 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14085 char buf[JIM_REFERENCE_SPACE + 1];
14086 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14087 const unsigned long *refId = he->key;
14089 JimFormatReference(buf, refPtr, *refId);
14090 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14092 Jim_SetResult(interp, listObjPtr);
14093 return JIM_OK;
14095 #endif
14097 /* [rename] */
14098 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14100 if (argc != 3) {
14101 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14102 return JIM_ERR;
14105 if (JimValidName(interp, "new procedure", argv[2])) {
14106 return JIM_ERR;
14109 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14112 #define JIM_DICTMATCH_VALUES 0x0001
14114 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14116 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14118 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14119 if (type & JIM_DICTMATCH_VALUES) {
14120 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14125 * Like JimHashtablePatternMatch, but for dictionaries.
14127 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14128 JimDictMatchCallbackType *callback, int type)
14130 Jim_HashEntry *he;
14131 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14133 /* Check for the non-pattern case. We can do this much more efficiently. */
14134 Jim_HashTableIterator htiter;
14135 JimInitHashTableIterator(ht, &htiter);
14136 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14137 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14138 callback(interp, listObjPtr, he, type);
14142 return listObjPtr;
14146 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14148 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14149 return JIM_ERR;
14151 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14152 return JIM_OK;
14155 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14157 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14158 return JIM_ERR;
14160 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14161 return JIM_OK;
14164 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14166 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14167 return -1;
14169 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14172 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14174 Jim_HashTable *ht;
14175 unsigned int i;
14177 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14178 return JIM_ERR;
14181 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14183 /* Note that this uses internal knowledge of the hash table */
14184 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14186 for (i = 0; i < ht->size; i++) {
14187 Jim_HashEntry *he = ht->table[i];
14189 if (he) {
14190 printf("%d: ", i);
14192 while (he) {
14193 printf(" %s", Jim_String(he->key));
14194 he = he->next;
14196 printf("\n");
14199 return JIM_OK;
14202 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14204 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14206 Jim_AppendString(interp, prefixObj, " ", 1);
14207 Jim_AppendString(interp, prefixObj, subcmd, -1);
14209 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14212 /* [dict] */
14213 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14215 Jim_Obj *objPtr;
14216 int option;
14217 static const char * const options[] = {
14218 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14219 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14220 "replace", "update", NULL
14222 enum
14224 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14225 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14226 OPT_REPLACE, OPT_UPDATE,
14229 if (argc < 2) {
14230 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14231 return JIM_ERR;
14234 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14235 return JIM_ERR;
14238 switch (option) {
14239 case OPT_GET:
14240 if (argc < 3) {
14241 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14242 return JIM_ERR;
14244 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14245 JIM_ERRMSG) != JIM_OK) {
14246 return JIM_ERR;
14248 Jim_SetResult(interp, objPtr);
14249 return JIM_OK;
14251 case OPT_SET:
14252 if (argc < 5) {
14253 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14254 return JIM_ERR;
14256 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14258 case OPT_EXISTS:
14259 if (argc < 4) {
14260 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14261 return JIM_ERR;
14263 else {
14264 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14265 if (rc < 0) {
14266 return JIM_ERR;
14268 Jim_SetResultBool(interp, rc == JIM_OK);
14269 return JIM_OK;
14272 case OPT_UNSET:
14273 if (argc < 4) {
14274 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14275 return JIM_ERR;
14277 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14278 return JIM_ERR;
14280 return JIM_OK;
14282 case OPT_KEYS:
14283 if (argc != 3 && argc != 4) {
14284 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14285 return JIM_ERR;
14287 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14289 case OPT_SIZE:
14290 if (argc != 3) {
14291 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14292 return JIM_ERR;
14294 else if (Jim_DictSize(interp, argv[2]) < 0) {
14295 return JIM_ERR;
14297 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14298 return JIM_OK;
14300 case OPT_MERGE:
14301 if (argc == 2) {
14302 return JIM_OK;
14304 if (Jim_DictSize(interp, argv[2]) < 0) {
14305 return JIM_ERR;
14307 /* Handle as ensemble */
14308 break;
14310 case OPT_UPDATE:
14311 if (argc < 6 || argc % 2) {
14312 /* Better error message */
14313 argc = 2;
14315 break;
14317 case OPT_CREATE:
14318 if (argc % 2) {
14319 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14320 return JIM_ERR;
14322 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14323 Jim_SetResult(interp, objPtr);
14324 return JIM_OK;
14326 case OPT_INFO:
14327 if (argc != 3) {
14328 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14329 return JIM_ERR;
14331 return Jim_DictInfo(interp, argv[2]);
14333 /* Handle command as an ensemble */
14334 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14337 /* [subst] */
14338 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14340 static const char * const options[] = {
14341 "-nobackslashes", "-nocommands", "-novariables", NULL
14343 enum
14344 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14345 int i;
14346 int flags = JIM_SUBST_FLAG;
14347 Jim_Obj *objPtr;
14349 if (argc < 2) {
14350 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14351 return JIM_ERR;
14353 for (i = 1; i < (argc - 1); i++) {
14354 int option;
14356 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14357 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14358 return JIM_ERR;
14360 switch (option) {
14361 case OPT_NOBACKSLASHES:
14362 flags |= JIM_SUBST_NOESC;
14363 break;
14364 case OPT_NOCOMMANDS:
14365 flags |= JIM_SUBST_NOCMD;
14366 break;
14367 case OPT_NOVARIABLES:
14368 flags |= JIM_SUBST_NOVAR;
14369 break;
14372 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14373 return JIM_ERR;
14375 Jim_SetResult(interp, objPtr);
14376 return JIM_OK;
14379 /* [info] */
14380 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14382 int cmd;
14383 Jim_Obj *objPtr;
14384 int mode = 0;
14386 static const char * const commands[] = {
14387 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14388 "vars", "version", "patchlevel", "complete", "args", "hostname",
14389 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14390 "references", "alias", NULL
14392 enum
14393 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14394 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14395 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14396 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14399 #ifdef jim_ext_namespace
14400 int nons = 0;
14402 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14403 /* This is for internal use only */
14404 argc--;
14405 argv++;
14406 nons = 1;
14408 #endif
14410 if (argc < 2) {
14411 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14412 return JIM_ERR;
14414 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14415 != JIM_OK) {
14416 return JIM_ERR;
14419 /* Test for the the most common commands first, just in case it makes a difference */
14420 switch (cmd) {
14421 case INFO_EXISTS:
14422 if (argc != 3) {
14423 Jim_WrongNumArgs(interp, 2, argv, "varName");
14424 return JIM_ERR;
14426 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14427 break;
14429 case INFO_ALIAS:{
14430 Jim_Cmd *cmdPtr;
14432 if (argc != 3) {
14433 Jim_WrongNumArgs(interp, 2, argv, "command");
14434 return JIM_ERR;
14436 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14437 return JIM_ERR;
14439 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14440 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14441 return JIM_ERR;
14443 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14444 return JIM_OK;
14447 case INFO_CHANNELS:
14448 mode++; /* JIM_CMDLIST_CHANNELS */
14449 #ifndef jim_ext_aio
14450 Jim_SetResultString(interp, "aio not enabled", -1);
14451 return JIM_ERR;
14452 #endif
14453 case INFO_PROCS:
14454 mode++; /* JIM_CMDLIST_PROCS */
14455 case INFO_COMMANDS:
14456 /* mode 0 => JIM_CMDLIST_COMMANDS */
14457 if (argc != 2 && argc != 3) {
14458 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14459 return JIM_ERR;
14461 #ifdef jim_ext_namespace
14462 if (!nons) {
14463 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14464 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14467 #endif
14468 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14469 break;
14471 case INFO_VARS:
14472 mode++; /* JIM_VARLIST_VARS */
14473 case INFO_LOCALS:
14474 mode++; /* JIM_VARLIST_LOCALS */
14475 case INFO_GLOBALS:
14476 /* mode 0 => JIM_VARLIST_GLOBALS */
14477 if (argc != 2 && argc != 3) {
14478 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14479 return JIM_ERR;
14481 #ifdef jim_ext_namespace
14482 if (!nons) {
14483 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14484 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14487 #endif
14488 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14489 break;
14491 case INFO_SCRIPT:
14492 if (argc != 2) {
14493 Jim_WrongNumArgs(interp, 2, argv, "");
14494 return JIM_ERR;
14496 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14497 break;
14499 case INFO_SOURCE:{
14500 jim_wide line;
14501 Jim_Obj *resObjPtr;
14502 Jim_Obj *fileNameObj;
14504 if (argc != 3 && argc != 5) {
14505 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14506 return JIM_ERR;
14508 if (argc == 5) {
14509 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14510 return JIM_ERR;
14512 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14513 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14515 else {
14516 if (argv[2]->typePtr == &sourceObjType) {
14517 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14518 line = argv[2]->internalRep.sourceValue.lineNumber;
14520 else if (argv[2]->typePtr == &scriptObjType) {
14521 ScriptObj *script = JimGetScript(interp, argv[2]);
14522 fileNameObj = script->fileNameObj;
14523 line = script->firstline;
14525 else {
14526 fileNameObj = interp->emptyObj;
14527 line = 1;
14529 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14530 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14531 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14533 Jim_SetResult(interp, resObjPtr);
14534 break;
14537 case INFO_STACKTRACE:
14538 Jim_SetResult(interp, interp->stackTrace);
14539 break;
14541 case INFO_LEVEL:
14542 case INFO_FRAME:
14543 switch (argc) {
14544 case 2:
14545 Jim_SetResultInt(interp, interp->framePtr->level);
14546 break;
14548 case 3:
14549 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14550 return JIM_ERR;
14552 Jim_SetResult(interp, objPtr);
14553 break;
14555 default:
14556 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14557 return JIM_ERR;
14559 break;
14561 case INFO_BODY:
14562 case INFO_STATICS:
14563 case INFO_ARGS:{
14564 Jim_Cmd *cmdPtr;
14566 if (argc != 3) {
14567 Jim_WrongNumArgs(interp, 2, argv, "procname");
14568 return JIM_ERR;
14570 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14571 return JIM_ERR;
14573 if (!cmdPtr->isproc) {
14574 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14575 return JIM_ERR;
14577 switch (cmd) {
14578 case INFO_BODY:
14579 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14580 break;
14581 case INFO_ARGS:
14582 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14583 break;
14584 case INFO_STATICS:
14585 if (cmdPtr->u.proc.staticVars) {
14586 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14587 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14588 NULL, JimVariablesMatch, mode));
14590 break;
14592 break;
14595 case INFO_VERSION:
14596 case INFO_PATCHLEVEL:{
14597 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14599 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14600 Jim_SetResultString(interp, buf, -1);
14601 break;
14604 case INFO_COMPLETE:
14605 if (argc != 3 && argc != 4) {
14606 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14607 return JIM_ERR;
14609 else {
14610 int len;
14611 const char *s = Jim_GetString(argv[2], &len);
14612 char missing;
14614 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14615 if (missing != ' ' && argc == 4) {
14616 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14619 break;
14621 case INFO_HOSTNAME:
14622 /* Redirect to os.gethostname if it exists */
14623 return Jim_Eval(interp, "os.gethostname");
14625 case INFO_NAMEOFEXECUTABLE:
14626 /* Redirect to Tcl proc */
14627 return Jim_Eval(interp, "{info nameofexecutable}");
14629 case INFO_RETURNCODES:
14630 if (argc == 2) {
14631 int i;
14632 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14634 for (i = 0; jimReturnCodes[i]; i++) {
14635 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14636 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14637 jimReturnCodes[i], -1));
14640 Jim_SetResult(interp, listObjPtr);
14642 else if (argc == 3) {
14643 long code;
14644 const char *name;
14646 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14647 return JIM_ERR;
14649 name = Jim_ReturnCode(code);
14650 if (*name == '?') {
14651 Jim_SetResultInt(interp, code);
14653 else {
14654 Jim_SetResultString(interp, name, -1);
14657 else {
14658 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14659 return JIM_ERR;
14661 break;
14662 case INFO_REFERENCES:
14663 #ifdef JIM_REFERENCES
14664 return JimInfoReferences(interp, argc, argv);
14665 #else
14666 Jim_SetResultString(interp, "not supported", -1);
14667 return JIM_ERR;
14668 #endif
14670 return JIM_OK;
14673 /* [exists] */
14674 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14676 Jim_Obj *objPtr;
14677 int result = 0;
14679 static const char * const options[] = {
14680 "-command", "-proc", "-alias", "-var", NULL
14682 enum
14684 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14686 int option;
14688 if (argc == 2) {
14689 option = OPT_VAR;
14690 objPtr = argv[1];
14692 else if (argc == 3) {
14693 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14694 return JIM_ERR;
14696 objPtr = argv[2];
14698 else {
14699 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14700 return JIM_ERR;
14703 if (option == OPT_VAR) {
14704 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14706 else {
14707 /* Now different kinds of commands */
14708 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14710 if (cmd) {
14711 switch (option) {
14712 case OPT_COMMAND:
14713 result = 1;
14714 break;
14716 case OPT_ALIAS:
14717 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14718 break;
14720 case OPT_PROC:
14721 result = cmd->isproc;
14722 break;
14726 Jim_SetResultBool(interp, result);
14727 return JIM_OK;
14730 /* [split] */
14731 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14733 const char *str, *splitChars, *noMatchStart;
14734 int splitLen, strLen;
14735 Jim_Obj *resObjPtr;
14736 int c;
14737 int len;
14739 if (argc != 2 && argc != 3) {
14740 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14741 return JIM_ERR;
14744 str = Jim_GetString(argv[1], &len);
14745 if (len == 0) {
14746 return JIM_OK;
14748 strLen = Jim_Utf8Length(interp, argv[1]);
14750 /* Init */
14751 if (argc == 2) {
14752 splitChars = " \n\t\r";
14753 splitLen = 4;
14755 else {
14756 splitChars = Jim_String(argv[2]);
14757 splitLen = Jim_Utf8Length(interp, argv[2]);
14760 noMatchStart = str;
14761 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14763 /* Split */
14764 if (splitLen) {
14765 Jim_Obj *objPtr;
14766 while (strLen--) {
14767 const char *sc = splitChars;
14768 int scLen = splitLen;
14769 int sl = utf8_tounicode(str, &c);
14770 while (scLen--) {
14771 int pc;
14772 sc += utf8_tounicode(sc, &pc);
14773 if (c == pc) {
14774 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14775 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14776 noMatchStart = str + sl;
14777 break;
14780 str += sl;
14782 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14783 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14785 else {
14786 /* This handles the special case of splitchars eq {}
14787 * Optimise by sharing common (ASCII) characters
14789 Jim_Obj **commonObj = NULL;
14790 #define NUM_COMMON (128 - 9)
14791 while (strLen--) {
14792 int n = utf8_tounicode(str, &c);
14793 #ifdef JIM_OPTIMIZATION
14794 if (c >= 9 && c < 128) {
14795 /* Common ASCII char. Note that 9 is the tab character */
14796 c -= 9;
14797 if (!commonObj) {
14798 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14799 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14801 if (!commonObj[c]) {
14802 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14804 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14805 str++;
14806 continue;
14808 #endif
14809 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14810 str += n;
14812 Jim_Free(commonObj);
14815 Jim_SetResult(interp, resObjPtr);
14816 return JIM_OK;
14819 /* [join] */
14820 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14822 const char *joinStr;
14823 int joinStrLen;
14825 if (argc != 2 && argc != 3) {
14826 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14827 return JIM_ERR;
14829 /* Init */
14830 if (argc == 2) {
14831 joinStr = " ";
14832 joinStrLen = 1;
14834 else {
14835 joinStr = Jim_GetString(argv[2], &joinStrLen);
14837 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14838 return JIM_OK;
14841 /* [format] */
14842 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14844 Jim_Obj *objPtr;
14846 if (argc < 2) {
14847 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14848 return JIM_ERR;
14850 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14851 if (objPtr == NULL)
14852 return JIM_ERR;
14853 Jim_SetResult(interp, objPtr);
14854 return JIM_OK;
14857 /* [scan] */
14858 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14860 Jim_Obj *listPtr, **outVec;
14861 int outc, i;
14863 if (argc < 3) {
14864 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14865 return JIM_ERR;
14867 if (argv[2]->typePtr != &scanFmtStringObjType)
14868 SetScanFmtFromAny(interp, argv[2]);
14869 if (FormatGetError(argv[2]) != 0) {
14870 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14871 return JIM_ERR;
14873 if (argc > 3) {
14874 int maxPos = FormatGetMaxPos(argv[2]);
14875 int count = FormatGetCnvCount(argv[2]);
14877 if (maxPos > argc - 3) {
14878 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14879 return JIM_ERR;
14881 else if (count > argc - 3) {
14882 Jim_SetResultString(interp, "different numbers of variable names and "
14883 "field specifiers", -1);
14884 return JIM_ERR;
14886 else if (count < argc - 3) {
14887 Jim_SetResultString(interp, "variable is not assigned by any "
14888 "conversion specifiers", -1);
14889 return JIM_ERR;
14892 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14893 if (listPtr == 0)
14894 return JIM_ERR;
14895 if (argc > 3) {
14896 int rc = JIM_OK;
14897 int count = 0;
14899 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14900 int len = Jim_ListLength(interp, listPtr);
14902 if (len != 0) {
14903 JimListGetElements(interp, listPtr, &outc, &outVec);
14904 for (i = 0; i < outc; ++i) {
14905 if (Jim_Length(outVec[i]) > 0) {
14906 ++count;
14907 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14908 rc = JIM_ERR;
14913 Jim_FreeNewObj(interp, listPtr);
14915 else {
14916 count = -1;
14918 if (rc == JIM_OK) {
14919 Jim_SetResultInt(interp, count);
14921 return rc;
14923 else {
14924 if (listPtr == (Jim_Obj *)EOF) {
14925 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14926 return JIM_OK;
14928 Jim_SetResult(interp, listPtr);
14930 return JIM_OK;
14933 /* [error] */
14934 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14936 if (argc != 2 && argc != 3) {
14937 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14938 return JIM_ERR;
14940 Jim_SetResult(interp, argv[1]);
14941 if (argc == 3) {
14942 JimSetStackTrace(interp, argv[2]);
14943 return JIM_ERR;
14945 interp->addStackTrace++;
14946 return JIM_ERR;
14949 /* [lrange] */
14950 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14952 Jim_Obj *objPtr;
14954 if (argc != 4) {
14955 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14956 return JIM_ERR;
14958 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14959 return JIM_ERR;
14960 Jim_SetResult(interp, objPtr);
14961 return JIM_OK;
14964 /* [lrepeat] */
14965 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14967 Jim_Obj *objPtr;
14968 long count;
14970 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14971 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14972 return JIM_ERR;
14975 if (count == 0 || argc == 2) {
14976 return JIM_OK;
14979 argc -= 2;
14980 argv += 2;
14982 objPtr = Jim_NewListObj(interp, argv, argc);
14983 while (--count) {
14984 ListInsertElements(objPtr, -1, argc, argv);
14987 Jim_SetResult(interp, objPtr);
14988 return JIM_OK;
14991 char **Jim_GetEnviron(void)
14993 #if defined(HAVE__NSGETENVIRON)
14994 return *_NSGetEnviron();
14995 #else
14996 #if !defined(NO_ENVIRON_EXTERN)
14997 extern char **environ;
14998 #endif
15000 return environ;
15001 #endif
15004 void Jim_SetEnviron(char **env)
15006 #if defined(HAVE__NSGETENVIRON)
15007 *_NSGetEnviron() = env;
15008 #else
15009 #if !defined(NO_ENVIRON_EXTERN)
15010 extern char **environ;
15011 #endif
15013 environ = env;
15014 #endif
15017 /* [env] */
15018 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15020 const char *key;
15021 const char *val;
15023 if (argc == 1) {
15024 char **e = Jim_GetEnviron();
15026 int i;
15027 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15029 for (i = 0; e[i]; i++) {
15030 const char *equals = strchr(e[i], '=');
15032 if (equals) {
15033 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15034 equals - e[i]));
15035 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15039 Jim_SetResult(interp, listObjPtr);
15040 return JIM_OK;
15043 if (argc < 2) {
15044 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15045 return JIM_ERR;
15047 key = Jim_String(argv[1]);
15048 val = getenv(key);
15049 if (val == NULL) {
15050 if (argc < 3) {
15051 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15052 return JIM_ERR;
15054 val = Jim_String(argv[2]);
15056 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15057 return JIM_OK;
15060 /* [source] */
15061 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15063 int retval;
15065 if (argc != 2) {
15066 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15067 return JIM_ERR;
15069 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15070 if (retval == JIM_RETURN)
15071 return JIM_OK;
15072 return retval;
15075 /* [lreverse] */
15076 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15078 Jim_Obj *revObjPtr, **ele;
15079 int len;
15081 if (argc != 2) {
15082 Jim_WrongNumArgs(interp, 1, argv, "list");
15083 return JIM_ERR;
15085 JimListGetElements(interp, argv[1], &len, &ele);
15086 len--;
15087 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15088 while (len >= 0)
15089 ListAppendElement(revObjPtr, ele[len--]);
15090 Jim_SetResult(interp, revObjPtr);
15091 return JIM_OK;
15094 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15096 jim_wide len;
15098 if (step == 0)
15099 return -1;
15100 if (start == end)
15101 return 0;
15102 else if (step > 0 && start > end)
15103 return -1;
15104 else if (step < 0 && end > start)
15105 return -1;
15106 len = end - start;
15107 if (len < 0)
15108 len = -len; /* abs(len) */
15109 if (step < 0)
15110 step = -step; /* abs(step) */
15111 len = 1 + ((len - 1) / step);
15112 /* We can truncate safely to INT_MAX, the range command
15113 * will always return an error for a such long range
15114 * because Tcl lists can't be so long. */
15115 if (len > INT_MAX)
15116 len = INT_MAX;
15117 return (int)((len < 0) ? -1 : len);
15120 /* [range] */
15121 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15123 jim_wide start = 0, end, step = 1;
15124 int len, i;
15125 Jim_Obj *objPtr;
15127 if (argc < 2 || argc > 4) {
15128 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15129 return JIM_ERR;
15131 if (argc == 2) {
15132 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15133 return JIM_ERR;
15135 else {
15136 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15137 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15138 return JIM_ERR;
15139 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15140 return JIM_ERR;
15142 if ((len = JimRangeLen(start, end, step)) == -1) {
15143 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15144 return JIM_ERR;
15146 objPtr = Jim_NewListObj(interp, NULL, 0);
15147 for (i = 0; i < len; i++)
15148 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15149 Jim_SetResult(interp, objPtr);
15150 return JIM_OK;
15153 /* [rand] */
15154 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15156 jim_wide min = 0, max = 0, len, maxMul;
15158 if (argc < 1 || argc > 3) {
15159 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15160 return JIM_ERR;
15162 if (argc == 1) {
15163 max = JIM_WIDE_MAX;
15164 } else if (argc == 2) {
15165 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15166 return JIM_ERR;
15167 } else if (argc == 3) {
15168 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15169 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15170 return JIM_ERR;
15172 len = max-min;
15173 if (len < 0) {
15174 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15175 return JIM_ERR;
15177 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15178 while (1) {
15179 jim_wide r;
15181 JimRandomBytes(interp, &r, sizeof(jim_wide));
15182 if (r < 0 || r >= maxMul) continue;
15183 r = (len == 0) ? 0 : r%len;
15184 Jim_SetResultInt(interp, min+r);
15185 return JIM_OK;
15189 static const struct {
15190 const char *name;
15191 Jim_CmdProc *cmdProc;
15192 } Jim_CoreCommandsTable[] = {
15193 {"alias", Jim_AliasCoreCommand},
15194 {"set", Jim_SetCoreCommand},
15195 {"unset", Jim_UnsetCoreCommand},
15196 {"puts", Jim_PutsCoreCommand},
15197 {"+", Jim_AddCoreCommand},
15198 {"*", Jim_MulCoreCommand},
15199 {"-", Jim_SubCoreCommand},
15200 {"/", Jim_DivCoreCommand},
15201 {"incr", Jim_IncrCoreCommand},
15202 {"while", Jim_WhileCoreCommand},
15203 {"loop", Jim_LoopCoreCommand},
15204 {"for", Jim_ForCoreCommand},
15205 {"foreach", Jim_ForeachCoreCommand},
15206 {"lmap", Jim_LmapCoreCommand},
15207 {"lassign", Jim_LassignCoreCommand},
15208 {"if", Jim_IfCoreCommand},
15209 {"switch", Jim_SwitchCoreCommand},
15210 {"list", Jim_ListCoreCommand},
15211 {"lindex", Jim_LindexCoreCommand},
15212 {"lset", Jim_LsetCoreCommand},
15213 {"lsearch", Jim_LsearchCoreCommand},
15214 {"llength", Jim_LlengthCoreCommand},
15215 {"lappend", Jim_LappendCoreCommand},
15216 {"linsert", Jim_LinsertCoreCommand},
15217 {"lreplace", Jim_LreplaceCoreCommand},
15218 {"lsort", Jim_LsortCoreCommand},
15219 {"append", Jim_AppendCoreCommand},
15220 {"debug", Jim_DebugCoreCommand},
15221 {"eval", Jim_EvalCoreCommand},
15222 {"uplevel", Jim_UplevelCoreCommand},
15223 {"expr", Jim_ExprCoreCommand},
15224 {"break", Jim_BreakCoreCommand},
15225 {"continue", Jim_ContinueCoreCommand},
15226 {"proc", Jim_ProcCoreCommand},
15227 {"concat", Jim_ConcatCoreCommand},
15228 {"return", Jim_ReturnCoreCommand},
15229 {"upvar", Jim_UpvarCoreCommand},
15230 {"global", Jim_GlobalCoreCommand},
15231 {"string", Jim_StringCoreCommand},
15232 {"time", Jim_TimeCoreCommand},
15233 {"exit", Jim_ExitCoreCommand},
15234 {"catch", Jim_CatchCoreCommand},
15235 #ifdef JIM_REFERENCES
15236 {"ref", Jim_RefCoreCommand},
15237 {"getref", Jim_GetrefCoreCommand},
15238 {"setref", Jim_SetrefCoreCommand},
15239 {"finalize", Jim_FinalizeCoreCommand},
15240 {"collect", Jim_CollectCoreCommand},
15241 #endif
15242 {"rename", Jim_RenameCoreCommand},
15243 {"dict", Jim_DictCoreCommand},
15244 {"subst", Jim_SubstCoreCommand},
15245 {"info", Jim_InfoCoreCommand},
15246 {"exists", Jim_ExistsCoreCommand},
15247 {"split", Jim_SplitCoreCommand},
15248 {"join", Jim_JoinCoreCommand},
15249 {"format", Jim_FormatCoreCommand},
15250 {"scan", Jim_ScanCoreCommand},
15251 {"error", Jim_ErrorCoreCommand},
15252 {"lrange", Jim_LrangeCoreCommand},
15253 {"lrepeat", Jim_LrepeatCoreCommand},
15254 {"env", Jim_EnvCoreCommand},
15255 {"source", Jim_SourceCoreCommand},
15256 {"lreverse", Jim_LreverseCoreCommand},
15257 {"range", Jim_RangeCoreCommand},
15258 {"rand", Jim_RandCoreCommand},
15259 {"tailcall", Jim_TailcallCoreCommand},
15260 {"local", Jim_LocalCoreCommand},
15261 {"upcall", Jim_UpcallCoreCommand},
15262 {"apply", Jim_ApplyCoreCommand},
15263 {NULL, NULL},
15266 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15268 int i = 0;
15270 while (Jim_CoreCommandsTable[i].name != NULL) {
15271 Jim_CreateCommand(interp,
15272 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15273 i++;
15277 /* -----------------------------------------------------------------------------
15278 * Interactive prompt
15279 * ---------------------------------------------------------------------------*/
15280 void Jim_MakeErrorMessage(Jim_Interp *interp)
15282 Jim_Obj *argv[2];
15284 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15285 argv[1] = interp->result;
15287 Jim_EvalObjVector(interp, 2, argv);
15290 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15291 const char *prefix, const char *const *tablePtr, const char *name)
15293 int count;
15294 char **tablePtrSorted;
15295 int i;
15297 for (count = 0; tablePtr[count]; count++) {
15300 if (name == NULL) {
15301 name = "option";
15304 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15305 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15306 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15307 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15308 for (i = 0; i < count; i++) {
15309 if (i + 1 == count && count > 1) {
15310 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15312 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15313 if (i + 1 != count) {
15314 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15317 Jim_Free(tablePtrSorted);
15320 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15321 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15323 const char *bad = "bad ";
15324 const char *const *entryPtr = NULL;
15325 int i;
15326 int match = -1;
15327 int arglen;
15328 const char *arg = Jim_GetString(objPtr, &arglen);
15330 *indexPtr = -1;
15332 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15333 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15334 /* Found an exact match */
15335 *indexPtr = i;
15336 return JIM_OK;
15338 if (flags & JIM_ENUM_ABBREV) {
15339 /* Accept an unambiguous abbreviation.
15340 * Note that '-' doesnt' consitute a valid abbreviation
15342 if (strncmp(arg, *entryPtr, arglen) == 0) {
15343 if (*arg == '-' && arglen == 1) {
15344 break;
15346 if (match >= 0) {
15347 bad = "ambiguous ";
15348 goto ambiguous;
15350 match = i;
15355 /* If we had an unambiguous partial match */
15356 if (match >= 0) {
15357 *indexPtr = match;
15358 return JIM_OK;
15361 ambiguous:
15362 if (flags & JIM_ERRMSG) {
15363 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15365 return JIM_ERR;
15368 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15370 int i;
15372 for (i = 0; i < (int)len; i++) {
15373 if (array[i] && strcmp(array[i], name) == 0) {
15374 return i;
15377 return -1;
15380 int Jim_IsDict(Jim_Obj *objPtr)
15382 return objPtr->typePtr == &dictObjType;
15385 int Jim_IsList(Jim_Obj *objPtr)
15387 return objPtr->typePtr == &listObjType;
15391 * Very simple printf-like formatting, designed for error messages.
15393 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15394 * The resulting string is created and set as the result.
15396 * Each '%s' should correspond to a regular string parameter.
15397 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15398 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15400 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15402 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15404 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15406 /* Initial space needed */
15407 int len = strlen(format);
15408 int extra = 0;
15409 int n = 0;
15410 const char *params[5];
15411 char *buf;
15412 va_list args;
15413 int i;
15415 va_start(args, format);
15417 for (i = 0; i < len && n < 5; i++) {
15418 int l;
15420 if (strncmp(format + i, "%s", 2) == 0) {
15421 params[n] = va_arg(args, char *);
15423 l = strlen(params[n]);
15425 else if (strncmp(format + i, "%#s", 3) == 0) {
15426 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15428 params[n] = Jim_GetString(objPtr, &l);
15430 else {
15431 if (format[i] == '%') {
15432 i++;
15434 continue;
15436 n++;
15437 extra += l;
15440 len += extra;
15441 buf = Jim_Alloc(len + 1);
15442 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15444 va_end(args);
15446 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15449 /* stubs */
15450 #ifndef jim_ext_package
15451 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15453 return JIM_OK;
15455 #endif
15456 #ifndef jim_ext_aio
15457 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15459 Jim_SetResultString(interp, "aio not enabled", -1);
15460 return NULL;
15462 #endif
15466 * Local Variables: ***
15467 * c-basic-offset: 4 ***
15468 * tab-width: 4 ***
15469 * End: ***