Fixed a documentation typo
[jimtcl.git] / jim.c
blobad3814066365147a3e7a63c2f2974db5c2a31909
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)
1155 * Results of missing quotes, braces, etc. from parsing.
1157 struct JimParseMissing {
1158 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1159 int line; /* Line number starting the missing token */
1162 /* Parser context structure. The same context is used both to parse
1163 * Tcl scripts and lists. */
1164 struct JimParserCtx
1166 const char *p; /* Pointer to the point of the program we are parsing */
1167 int len; /* Remaining length */
1168 int linenr; /* Current line number */
1169 const char *tstart;
1170 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1171 int tline; /* Line number of the returned token */
1172 int tt; /* Token type */
1173 int eof; /* Non zero if EOF condition is true. */
1174 int inquote; /* Parsing a quoted string */
1175 int comment; /* Non zero if the next chars may be a comment. */
1176 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1179 static int JimParseScript(struct JimParserCtx *pc);
1180 static int JimParseSep(struct JimParserCtx *pc);
1181 static int JimParseEol(struct JimParserCtx *pc);
1182 static int JimParseCmd(struct JimParserCtx *pc);
1183 static int JimParseQuote(struct JimParserCtx *pc);
1184 static int JimParseVar(struct JimParserCtx *pc);
1185 static int JimParseBrace(struct JimParserCtx *pc);
1186 static int JimParseStr(struct JimParserCtx *pc);
1187 static int JimParseComment(struct JimParserCtx *pc);
1188 static void JimParseSubCmd(struct JimParserCtx *pc);
1189 static int JimParseSubQuote(struct JimParserCtx *pc);
1190 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1192 /* Initialize a parser context.
1193 * 'prg' is a pointer to the program text, linenr is the line
1194 * number of the first line contained in the program. */
1195 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1197 pc->p = prg;
1198 pc->len = len;
1199 pc->tstart = NULL;
1200 pc->tend = NULL;
1201 pc->tline = 0;
1202 pc->tt = JIM_TT_NONE;
1203 pc->eof = 0;
1204 pc->inquote = 0;
1205 pc->linenr = linenr;
1206 pc->comment = 1;
1207 pc->missing.ch = ' ';
1208 pc->missing.line = linenr;
1211 static int JimParseScript(struct JimParserCtx *pc)
1213 while (1) { /* the while is used to reiterate with continue if needed */
1214 if (!pc->len) {
1215 pc->tstart = pc->p;
1216 pc->tend = pc->p - 1;
1217 pc->tline = pc->linenr;
1218 pc->tt = JIM_TT_EOL;
1219 pc->eof = 1;
1220 return JIM_OK;
1222 switch (*(pc->p)) {
1223 case '\\':
1224 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1225 return JimParseSep(pc);
1227 pc->comment = 0;
1228 return JimParseStr(pc);
1229 case ' ':
1230 case '\t':
1231 case '\r':
1232 case '\f':
1233 if (!pc->inquote)
1234 return JimParseSep(pc);
1235 pc->comment = 0;
1236 return JimParseStr(pc);
1237 case '\n':
1238 case ';':
1239 pc->comment = 1;
1240 if (!pc->inquote)
1241 return JimParseEol(pc);
1242 return JimParseStr(pc);
1243 case '[':
1244 pc->comment = 0;
1245 return JimParseCmd(pc);
1246 case '$':
1247 pc->comment = 0;
1248 if (JimParseVar(pc) == JIM_ERR) {
1249 /* An orphan $. Create as a separate token */
1250 pc->tstart = pc->tend = pc->p++;
1251 pc->len--;
1252 pc->tt = JIM_TT_ESC;
1254 return JIM_OK;
1255 case '#':
1256 if (pc->comment) {
1257 JimParseComment(pc);
1258 continue;
1260 return JimParseStr(pc);
1261 default:
1262 pc->comment = 0;
1263 return JimParseStr(pc);
1265 return JIM_OK;
1269 static int JimParseSep(struct JimParserCtx *pc)
1271 pc->tstart = pc->p;
1272 pc->tline = pc->linenr;
1273 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1274 if (*pc->p == '\n') {
1275 break;
1277 if (*pc->p == '\\') {
1278 pc->p++;
1279 pc->len--;
1280 pc->linenr++;
1282 pc->p++;
1283 pc->len--;
1285 pc->tend = pc->p - 1;
1286 pc->tt = JIM_TT_SEP;
1287 return JIM_OK;
1290 static int JimParseEol(struct JimParserCtx *pc)
1292 pc->tstart = pc->p;
1293 pc->tline = pc->linenr;
1294 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1295 if (*pc->p == '\n')
1296 pc->linenr++;
1297 pc->p++;
1298 pc->len--;
1300 pc->tend = pc->p - 1;
1301 pc->tt = JIM_TT_EOL;
1302 return JIM_OK;
1306 ** Here are the rules for parsing:
1307 ** {braced expression}
1308 ** - Count open and closing braces
1309 ** - Backslash escapes meaning of braces
1311 ** "quoted expression"
1312 ** - First double quote at start of word terminates the expression
1313 ** - Backslash escapes quote and bracket
1314 ** - [commands brackets] are counted/nested
1315 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1317 ** [command expression]
1318 ** - Count open and closing brackets
1319 ** - Backslash escapes quote, bracket and brace
1320 ** - [commands brackets] are counted/nested
1321 ** - "quoted expressions" are parsed according to quoting rules
1322 ** - {braced expressions} are parsed according to brace rules
1324 ** For everything, backslash escapes the next char, newline increments current line
1328 * Parses a braced expression starting at pc->p.
1330 * Positions the parser at the end of the braced expression,
1331 * sets pc->tend and possibly pc->missing.
1333 static void JimParseSubBrace(struct JimParserCtx *pc)
1335 int level = 1;
1337 /* Skip the brace */
1338 pc->p++;
1339 pc->len--;
1340 while (pc->len) {
1341 switch (*pc->p) {
1342 case '\\':
1343 if (pc->len > 1) {
1344 if (*++pc->p == '\n') {
1345 pc->linenr++;
1347 pc->len--;
1349 break;
1351 case '{':
1352 level++;
1353 break;
1355 case '}':
1356 if (--level == 0) {
1357 pc->tend = pc->p - 1;
1358 pc->p++;
1359 pc->len--;
1360 return;
1362 break;
1364 case '\n':
1365 pc->linenr++;
1366 break;
1368 pc->p++;
1369 pc->len--;
1371 pc->missing.ch = '{';
1372 pc->missing.line = pc->tline;
1373 pc->tend = pc->p - 1;
1377 * Parses a quoted expression starting at pc->p.
1379 * Positions the parser at the end of the quoted expression,
1380 * sets pc->tend and possibly pc->missing.
1382 * Returns the type of the token of the string,
1383 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1384 * or JIM_TT_STR.
1386 static int JimParseSubQuote(struct JimParserCtx *pc)
1388 int tt = JIM_TT_STR;
1389 int line = pc->tline;
1391 /* Skip the quote */
1392 pc->p++;
1393 pc->len--;
1394 while (pc->len) {
1395 switch (*pc->p) {
1396 case '\\':
1397 if (pc->len > 1) {
1398 if (*++pc->p == '\n') {
1399 pc->linenr++;
1401 pc->len--;
1402 tt = JIM_TT_ESC;
1404 break;
1406 case '"':
1407 pc->tend = pc->p - 1;
1408 pc->p++;
1409 pc->len--;
1410 return tt;
1412 case '[':
1413 JimParseSubCmd(pc);
1414 tt = JIM_TT_ESC;
1415 continue;
1417 case '\n':
1418 pc->linenr++;
1419 break;
1421 case '$':
1422 tt = JIM_TT_ESC;
1423 break;
1425 pc->p++;
1426 pc->len--;
1428 pc->missing.ch = '"';
1429 pc->missing.line = line;
1430 pc->tend = pc->p - 1;
1431 return tt;
1435 * Parses a [command] expression starting at pc->p.
1437 * Positions the parser at the end of the command expression,
1438 * sets pc->tend and possibly pc->missing.
1440 static void JimParseSubCmd(struct JimParserCtx *pc)
1442 int level = 1;
1443 int startofword = 1;
1444 int line = pc->tline;
1446 /* Skip the bracket */
1447 pc->p++;
1448 pc->len--;
1449 while (pc->len) {
1450 switch (*pc->p) {
1451 case '\\':
1452 if (pc->len > 1) {
1453 if (*++pc->p == '\n') {
1454 pc->linenr++;
1456 pc->len--;
1458 break;
1460 case '[':
1461 level++;
1462 break;
1464 case ']':
1465 if (--level == 0) {
1466 pc->tend = pc->p - 1;
1467 pc->p++;
1468 pc->len--;
1469 return;
1471 break;
1473 case '"':
1474 if (startofword) {
1475 JimParseSubQuote(pc);
1476 continue;
1478 break;
1480 case '{':
1481 JimParseSubBrace(pc);
1482 startofword = 0;
1483 continue;
1485 case '\n':
1486 pc->linenr++;
1487 break;
1489 startofword = isspace(UCHAR(*pc->p));
1490 pc->p++;
1491 pc->len--;
1493 pc->missing.ch = '[';
1494 pc->missing.line = line;
1495 pc->tend = pc->p - 1;
1498 static int JimParseBrace(struct JimParserCtx *pc)
1500 pc->tstart = pc->p + 1;
1501 pc->tline = pc->linenr;
1502 pc->tt = JIM_TT_STR;
1503 JimParseSubBrace(pc);
1504 return JIM_OK;
1507 static int JimParseCmd(struct JimParserCtx *pc)
1509 pc->tstart = pc->p + 1;
1510 pc->tline = pc->linenr;
1511 pc->tt = JIM_TT_CMD;
1512 JimParseSubCmd(pc);
1513 return JIM_OK;
1516 static int JimParseQuote(struct JimParserCtx *pc)
1518 pc->tstart = pc->p + 1;
1519 pc->tline = pc->linenr;
1520 pc->tt = JimParseSubQuote(pc);
1521 return JIM_OK;
1524 static int JimParseVar(struct JimParserCtx *pc)
1526 /* skip the $ */
1527 pc->p++;
1528 pc->len--;
1530 #ifdef EXPRSUGAR_BRACKET
1531 if (*pc->p == '[') {
1532 /* Parse $[...] expr shorthand syntax */
1533 JimParseCmd(pc);
1534 pc->tt = JIM_TT_EXPRSUGAR;
1535 return JIM_OK;
1537 #endif
1539 pc->tstart = pc->p;
1540 pc->tt = JIM_TT_VAR;
1541 pc->tline = pc->linenr;
1543 if (*pc->p == '{') {
1544 pc->tstart = ++pc->p;
1545 pc->len--;
1547 while (pc->len && *pc->p != '}') {
1548 if (*pc->p == '\n') {
1549 pc->linenr++;
1551 pc->p++;
1552 pc->len--;
1554 pc->tend = pc->p - 1;
1555 if (pc->len) {
1556 pc->p++;
1557 pc->len--;
1560 else {
1561 while (1) {
1562 /* Skip double colon, but not single colon! */
1563 if (pc->p[0] == ':' && pc->p[1] == ':') {
1564 while (*pc->p == ':') {
1565 pc->p++;
1566 pc->len--;
1568 continue;
1570 /* Note that any char >= 0x80 must be part of a utf-8 char.
1571 * We consider all unicode points outside of ASCII as letters
1573 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1574 pc->p++;
1575 pc->len--;
1576 continue;
1578 break;
1580 /* Parse [dict get] syntax sugar. */
1581 if (*pc->p == '(') {
1582 int count = 1;
1583 const char *paren = NULL;
1585 pc->tt = JIM_TT_DICTSUGAR;
1587 while (count && pc->len) {
1588 pc->p++;
1589 pc->len--;
1590 if (*pc->p == '\\' && pc->len >= 1) {
1591 pc->p++;
1592 pc->len--;
1594 else if (*pc->p == '(') {
1595 count++;
1597 else if (*pc->p == ')') {
1598 paren = pc->p;
1599 count--;
1602 if (count == 0) {
1603 pc->p++;
1604 pc->len--;
1606 else if (paren) {
1607 /* Did not find a matching paren. Back up */
1608 paren++;
1609 pc->len += (pc->p - paren);
1610 pc->p = paren;
1612 #ifndef EXPRSUGAR_BRACKET
1613 if (*pc->tstart == '(') {
1614 pc->tt = JIM_TT_EXPRSUGAR;
1616 #endif
1618 pc->tend = pc->p - 1;
1620 /* Check if we parsed just the '$' character.
1621 * That's not a variable so an error is returned
1622 * to tell the state machine to consider this '$' just
1623 * a string. */
1624 if (pc->tstart == pc->p) {
1625 pc->p--;
1626 pc->len++;
1627 return JIM_ERR;
1629 return JIM_OK;
1632 static int JimParseStr(struct JimParserCtx *pc)
1634 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1635 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1636 /* Starting a new word */
1637 if (*pc->p == '{') {
1638 return JimParseBrace(pc);
1640 if (*pc->p == '"') {
1641 pc->inquote = 1;
1642 pc->p++;
1643 pc->len--;
1644 /* In case the end quote is missing */
1645 pc->missing.line = pc->tline;
1648 pc->tstart = pc->p;
1649 pc->tline = pc->linenr;
1650 while (1) {
1651 if (pc->len == 0) {
1652 if (pc->inquote) {
1653 pc->missing.ch = '"';
1655 pc->tend = pc->p - 1;
1656 pc->tt = JIM_TT_ESC;
1657 return JIM_OK;
1659 switch (*pc->p) {
1660 case '\\':
1661 if (!pc->inquote && *(pc->p + 1) == '\n') {
1662 pc->tend = pc->p - 1;
1663 pc->tt = JIM_TT_ESC;
1664 return JIM_OK;
1666 if (pc->len >= 2) {
1667 if (*(pc->p + 1) == '\n') {
1668 pc->linenr++;
1670 pc->p++;
1671 pc->len--;
1673 else if (pc->len == 1) {
1674 /* End of script with trailing backslash */
1675 pc->missing.ch = '\\';
1677 break;
1678 case '(':
1679 /* If the following token is not '$' just keep going */
1680 if (pc->len > 1 && pc->p[1] != '$') {
1681 break;
1683 /* fall through */
1684 case ')':
1685 /* Only need a separate ')' token if the previous was a var */
1686 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1687 if (pc->p == pc->tstart) {
1688 /* At the start of the token, so just return this char */
1689 pc->p++;
1690 pc->len--;
1692 pc->tend = pc->p - 1;
1693 pc->tt = JIM_TT_ESC;
1694 return JIM_OK;
1696 break;
1698 case '$':
1699 case '[':
1700 pc->tend = pc->p - 1;
1701 pc->tt = JIM_TT_ESC;
1702 return JIM_OK;
1703 case ' ':
1704 case '\t':
1705 case '\n':
1706 case '\r':
1707 case '\f':
1708 case ';':
1709 if (!pc->inquote) {
1710 pc->tend = pc->p - 1;
1711 pc->tt = JIM_TT_ESC;
1712 return JIM_OK;
1714 else if (*pc->p == '\n') {
1715 pc->linenr++;
1717 break;
1718 case '"':
1719 if (pc->inquote) {
1720 pc->tend = pc->p - 1;
1721 pc->tt = JIM_TT_ESC;
1722 pc->p++;
1723 pc->len--;
1724 pc->inquote = 0;
1725 return JIM_OK;
1727 break;
1729 pc->p++;
1730 pc->len--;
1732 return JIM_OK; /* unreached */
1735 static int JimParseComment(struct JimParserCtx *pc)
1737 while (*pc->p) {
1738 if (*pc->p == '\\') {
1739 pc->p++;
1740 pc->len--;
1741 if (pc->len == 0) {
1742 pc->missing.ch = '\\';
1743 return JIM_OK;
1745 if (*pc->p == '\n') {
1746 pc->linenr++;
1749 else if (*pc->p == '\n') {
1750 pc->p++;
1751 pc->len--;
1752 pc->linenr++;
1753 break;
1755 pc->p++;
1756 pc->len--;
1758 return JIM_OK;
1761 /* xdigitval and odigitval are helper functions for JimEscape() */
1762 static int xdigitval(int c)
1764 if (c >= '0' && c <= '9')
1765 return c - '0';
1766 if (c >= 'a' && c <= 'f')
1767 return c - 'a' + 10;
1768 if (c >= 'A' && c <= 'F')
1769 return c - 'A' + 10;
1770 return -1;
1773 static int odigitval(int c)
1775 if (c >= '0' && c <= '7')
1776 return c - '0';
1777 return -1;
1780 /* Perform Tcl escape substitution of 's', storing the result
1781 * string into 'dest'. The escaped string is guaranteed to
1782 * be the same length or shorted than the source string.
1783 * Slen is the length of the string at 's'.
1785 * The function returns the length of the resulting string. */
1786 static int JimEscape(char *dest, const char *s, int slen)
1788 char *p = dest;
1789 int i, len;
1791 for (i = 0; i < slen; i++) {
1792 switch (s[i]) {
1793 case '\\':
1794 switch (s[i + 1]) {
1795 case 'a':
1796 *p++ = 0x7;
1797 i++;
1798 break;
1799 case 'b':
1800 *p++ = 0x8;
1801 i++;
1802 break;
1803 case 'f':
1804 *p++ = 0xc;
1805 i++;
1806 break;
1807 case 'n':
1808 *p++ = 0xa;
1809 i++;
1810 break;
1811 case 'r':
1812 *p++ = 0xd;
1813 i++;
1814 break;
1815 case 't':
1816 *p++ = 0x9;
1817 i++;
1818 break;
1819 case 'u':
1820 case 'U':
1821 case 'x':
1822 /* A unicode or hex sequence.
1823 * \x Expect 1-2 hex chars and convert to hex.
1824 * \u Expect 1-4 hex chars and convert to utf-8.
1825 * \U Expect 1-8 hex chars and convert to utf-8.
1826 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1827 * An invalid sequence means simply the escaped char.
1830 unsigned val = 0;
1831 int k;
1832 int maxchars = 2;
1834 i++;
1836 if (s[i] == 'U') {
1837 maxchars = 8;
1839 else if (s[i] == 'u') {
1840 if (s[i + 1] == '{') {
1841 maxchars = 6;
1842 i++;
1844 else {
1845 maxchars = 4;
1849 for (k = 0; k < maxchars; k++) {
1850 int c = xdigitval(s[i + k + 1]);
1851 if (c == -1) {
1852 break;
1854 val = (val << 4) | c;
1856 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1857 if (s[i] == '{') {
1858 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1859 /* Back up */
1860 i--;
1861 k = 0;
1863 else {
1864 /* Skip the closing brace */
1865 k++;
1868 if (k) {
1869 /* Got a valid sequence, so convert */
1870 if (s[i] == 'x') {
1871 *p++ = val;
1873 else {
1874 p += utf8_fromunicode(p, val);
1876 i += k;
1877 break;
1879 /* Not a valid codepoint, just an escaped char */
1880 *p++ = s[i];
1882 break;
1883 case 'v':
1884 *p++ = 0xb;
1885 i++;
1886 break;
1887 case '\0':
1888 *p++ = '\\';
1889 i++;
1890 break;
1891 case '\n':
1892 /* Replace all spaces and tabs after backslash newline with a single space*/
1893 *p++ = ' ';
1894 do {
1895 i++;
1896 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1897 break;
1898 case '0':
1899 case '1':
1900 case '2':
1901 case '3':
1902 case '4':
1903 case '5':
1904 case '6':
1905 case '7':
1906 /* octal escape */
1908 int val = 0;
1909 int c = odigitval(s[i + 1]);
1911 val = c;
1912 c = odigitval(s[i + 2]);
1913 if (c == -1) {
1914 *p++ = val;
1915 i++;
1916 break;
1918 val = (val * 8) + c;
1919 c = odigitval(s[i + 3]);
1920 if (c == -1) {
1921 *p++ = val;
1922 i += 2;
1923 break;
1925 val = (val * 8) + c;
1926 *p++ = val;
1927 i += 3;
1929 break;
1930 default:
1931 *p++ = s[i + 1];
1932 i++;
1933 break;
1935 break;
1936 default:
1937 *p++ = s[i];
1938 break;
1941 len = p - dest;
1942 *p = '\0';
1943 return len;
1946 /* Returns a dynamically allocated copy of the current token in the
1947 * parser context. The function performs conversion of escapes if
1948 * the token is of type JIM_TT_ESC.
1950 * Note that after the conversion, tokens that are grouped with
1951 * braces in the source code, are always recognizable from the
1952 * identical string obtained in a different way from the type.
1954 * For example the string:
1956 * {*}$a
1958 * will return as first token "*", of type JIM_TT_STR
1960 * While the string:
1962 * *$a
1964 * will return as first token "*", of type JIM_TT_ESC
1966 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1968 const char *start, *end;
1969 char *token;
1970 int len;
1972 start = pc->tstart;
1973 end = pc->tend;
1974 if (start > end) {
1975 len = 0;
1976 token = Jim_Alloc(1);
1977 token[0] = '\0';
1979 else {
1980 len = (end - start) + 1;
1981 token = Jim_Alloc(len + 1);
1982 if (pc->tt != JIM_TT_ESC) {
1983 /* No escape conversion needed? Just copy it. */
1984 memcpy(token, start, len);
1985 token[len] = '\0';
1987 else {
1988 /* Else convert the escape chars. */
1989 len = JimEscape(token, start, len);
1993 return Jim_NewStringObjNoAlloc(interp, token, len);
1996 /* -----------------------------------------------------------------------------
1997 * Tcl Lists parsing
1998 * ---------------------------------------------------------------------------*/
1999 static int JimParseListSep(struct JimParserCtx *pc);
2000 static int JimParseListStr(struct JimParserCtx *pc);
2001 static int JimParseListQuote(struct JimParserCtx *pc);
2003 static int JimParseList(struct JimParserCtx *pc)
2005 if (isspace(UCHAR(*pc->p))) {
2006 return JimParseListSep(pc);
2008 switch (*pc->p) {
2009 case '"':
2010 return JimParseListQuote(pc);
2012 case '{':
2013 return JimParseBrace(pc);
2015 default:
2016 if (pc->len) {
2017 return JimParseListStr(pc);
2019 break;
2022 pc->tstart = pc->tend = pc->p;
2023 pc->tline = pc->linenr;
2024 pc->tt = JIM_TT_EOL;
2025 pc->eof = 1;
2026 return JIM_OK;
2029 static int JimParseListSep(struct JimParserCtx *pc)
2031 pc->tstart = pc->p;
2032 pc->tline = pc->linenr;
2033 while (isspace(UCHAR(*pc->p))) {
2034 if (*pc->p == '\n') {
2035 pc->linenr++;
2037 pc->p++;
2038 pc->len--;
2040 pc->tend = pc->p - 1;
2041 pc->tt = JIM_TT_SEP;
2042 return JIM_OK;
2045 static int JimParseListQuote(struct JimParserCtx *pc)
2047 pc->p++;
2048 pc->len--;
2050 pc->tstart = pc->p;
2051 pc->tline = pc->linenr;
2052 pc->tt = JIM_TT_STR;
2054 while (pc->len) {
2055 switch (*pc->p) {
2056 case '\\':
2057 pc->tt = JIM_TT_ESC;
2058 if (--pc->len == 0) {
2059 /* Trailing backslash */
2060 pc->tend = pc->p;
2061 return JIM_OK;
2063 pc->p++;
2064 break;
2065 case '\n':
2066 pc->linenr++;
2067 break;
2068 case '"':
2069 pc->tend = pc->p - 1;
2070 pc->p++;
2071 pc->len--;
2072 return JIM_OK;
2074 pc->p++;
2075 pc->len--;
2078 pc->tend = pc->p - 1;
2079 return JIM_OK;
2082 static int JimParseListStr(struct JimParserCtx *pc)
2084 pc->tstart = pc->p;
2085 pc->tline = pc->linenr;
2086 pc->tt = JIM_TT_STR;
2088 while (pc->len) {
2089 if (isspace(UCHAR(*pc->p))) {
2090 pc->tend = pc->p - 1;
2091 return JIM_OK;
2093 if (*pc->p == '\\') {
2094 if (--pc->len == 0) {
2095 /* Trailing backslash */
2096 pc->tend = pc->p;
2097 return JIM_OK;
2099 pc->tt = JIM_TT_ESC;
2100 pc->p++;
2102 pc->p++;
2103 pc->len--;
2105 pc->tend = pc->p - 1;
2106 return JIM_OK;
2109 /* -----------------------------------------------------------------------------
2110 * Jim_Obj related functions
2111 * ---------------------------------------------------------------------------*/
2113 /* Return a new initialized object. */
2114 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2116 Jim_Obj *objPtr;
2118 /* -- Check if there are objects in the free list -- */
2119 if (interp->freeList != NULL) {
2120 /* -- Unlink the object from the free list -- */
2121 objPtr = interp->freeList;
2122 interp->freeList = objPtr->nextObjPtr;
2124 else {
2125 /* -- No ready to use objects: allocate a new one -- */
2126 objPtr = Jim_Alloc(sizeof(*objPtr));
2129 /* Object is returned with refCount of 0. Every
2130 * kind of GC implemented should take care to don't try
2131 * to scan objects with refCount == 0. */
2132 objPtr->refCount = 0;
2133 /* All the other fields are left not initialized to save time.
2134 * The caller will probably want to set them to the right
2135 * value anyway. */
2137 /* -- Put the object into the live list -- */
2138 objPtr->prevObjPtr = NULL;
2139 objPtr->nextObjPtr = interp->liveList;
2140 if (interp->liveList)
2141 interp->liveList->prevObjPtr = objPtr;
2142 interp->liveList = objPtr;
2144 return objPtr;
2147 /* Free an object. Actually objects are never freed, but
2148 * just moved to the free objects list, where they will be
2149 * reused by Jim_NewObj(). */
2150 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2152 /* Check if the object was already freed, panic. */
2153 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2154 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2156 /* Free the internal representation */
2157 Jim_FreeIntRep(interp, objPtr);
2158 /* Free the string representation */
2159 if (objPtr->bytes != NULL) {
2160 if (objPtr->bytes != JimEmptyStringRep)
2161 Jim_Free(objPtr->bytes);
2163 /* Unlink the object from the live objects list */
2164 if (objPtr->prevObjPtr)
2165 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2166 if (objPtr->nextObjPtr)
2167 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2168 if (interp->liveList == objPtr)
2169 interp->liveList = objPtr->nextObjPtr;
2170 #ifdef JIM_DISABLE_OBJECT_POOL
2171 Jim_Free(objPtr);
2172 #else
2173 /* Link the object into the free objects list */
2174 objPtr->prevObjPtr = NULL;
2175 objPtr->nextObjPtr = interp->freeList;
2176 if (interp->freeList)
2177 interp->freeList->prevObjPtr = objPtr;
2178 interp->freeList = objPtr;
2179 objPtr->refCount = -1;
2180 #endif
2183 /* Invalidate the string representation of an object. */
2184 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2186 if (objPtr->bytes != NULL) {
2187 if (objPtr->bytes != JimEmptyStringRep)
2188 Jim_Free(objPtr->bytes);
2190 objPtr->bytes = NULL;
2193 /* Duplicate an object. The returned object has refcount = 0. */
2194 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2196 Jim_Obj *dupPtr;
2198 dupPtr = Jim_NewObj(interp);
2199 if (objPtr->bytes == NULL) {
2200 /* Object does not have a valid string representation. */
2201 dupPtr->bytes = NULL;
2203 else if (objPtr->length == 0) {
2204 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2205 dupPtr->bytes = JimEmptyStringRep;
2206 dupPtr->length = 0;
2207 dupPtr->typePtr = NULL;
2208 return dupPtr;
2210 else {
2211 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2212 dupPtr->length = objPtr->length;
2213 /* Copy the null byte too */
2214 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2217 /* By default, the new object has the same type as the old object */
2218 dupPtr->typePtr = objPtr->typePtr;
2219 if (objPtr->typePtr != NULL) {
2220 if (objPtr->typePtr->dupIntRepProc == NULL) {
2221 dupPtr->internalRep = objPtr->internalRep;
2223 else {
2224 /* The dup proc may set a different type, e.g. NULL */
2225 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2228 return dupPtr;
2231 /* Return the string representation for objPtr. If the object's
2232 * string representation is invalid, calls the updateStringProc method to create
2233 * a new one from the internal representation of the object.
2235 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2237 if (objPtr->bytes == NULL) {
2238 /* Invalid string repr. Generate it. */
2239 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2240 objPtr->typePtr->updateStringProc(objPtr);
2242 if (lenPtr)
2243 *lenPtr = objPtr->length;
2244 return objPtr->bytes;
2247 /* Just returns the length of the object's string rep */
2248 int Jim_Length(Jim_Obj *objPtr)
2250 if (objPtr->bytes == NULL) {
2251 /* Invalid string repr. Generate it. */
2252 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2253 objPtr->typePtr->updateStringProc(objPtr);
2255 return objPtr->length;
2258 /* Just returns object's string rep */
2259 const char *Jim_String(Jim_Obj *objPtr)
2261 if (objPtr->bytes == NULL) {
2262 /* Invalid string repr. Generate it. */
2263 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2264 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2265 objPtr->typePtr->updateStringProc(objPtr);
2267 return objPtr->bytes;
2270 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2272 objPtr->bytes = Jim_StrDup(str);
2273 objPtr->length = strlen(str);
2276 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2277 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2279 static const Jim_ObjType dictSubstObjType = {
2280 "dict-substitution",
2281 FreeDictSubstInternalRep,
2282 DupDictSubstInternalRep,
2283 NULL,
2284 JIM_TYPE_NONE,
2287 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2289 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2292 static const Jim_ObjType interpolatedObjType = {
2293 "interpolated",
2294 FreeInterpolatedInternalRep,
2295 NULL,
2296 NULL,
2297 JIM_TYPE_NONE,
2300 /* -----------------------------------------------------------------------------
2301 * String Object
2302 * ---------------------------------------------------------------------------*/
2303 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2304 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2306 static const Jim_ObjType stringObjType = {
2307 "string",
2308 NULL,
2309 DupStringInternalRep,
2310 NULL,
2311 JIM_TYPE_REFERENCES,
2314 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2316 JIM_NOTUSED(interp);
2318 /* This is a bit subtle: the only caller of this function
2319 * should be Jim_DuplicateObj(), that will copy the
2320 * string representaion. After the copy, the duplicated
2321 * object will not have more room in the buffer than
2322 * srcPtr->length bytes. So we just set it to length. */
2323 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2324 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2327 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2329 if (objPtr->typePtr != &stringObjType) {
2330 /* Get a fresh string representation. */
2331 if (objPtr->bytes == NULL) {
2332 /* Invalid string repr. Generate it. */
2333 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2334 objPtr->typePtr->updateStringProc(objPtr);
2336 /* Free any other internal representation. */
2337 Jim_FreeIntRep(interp, objPtr);
2338 /* Set it as string, i.e. just set the maxLength field. */
2339 objPtr->typePtr = &stringObjType;
2340 objPtr->internalRep.strValue.maxLength = objPtr->length;
2341 /* Don't know the utf-8 length yet */
2342 objPtr->internalRep.strValue.charLength = -1;
2344 return JIM_OK;
2348 * Returns the length of the object string in chars, not bytes.
2350 * These may be different for a utf-8 string.
2352 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2354 #ifdef JIM_UTF8
2355 SetStringFromAny(interp, objPtr);
2357 if (objPtr->internalRep.strValue.charLength < 0) {
2358 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2360 return objPtr->internalRep.strValue.charLength;
2361 #else
2362 return Jim_Length(objPtr);
2363 #endif
2366 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2367 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2369 Jim_Obj *objPtr = Jim_NewObj(interp);
2371 /* Need to find out how many bytes the string requires */
2372 if (len == -1)
2373 len = strlen(s);
2374 /* Alloc/Set the string rep. */
2375 if (len == 0) {
2376 objPtr->bytes = JimEmptyStringRep;
2378 else {
2379 objPtr->bytes = Jim_Alloc(len + 1);
2380 memcpy(objPtr->bytes, s, len);
2381 objPtr->bytes[len] = '\0';
2383 objPtr->length = len;
2385 /* No typePtr field for the vanilla string object. */
2386 objPtr->typePtr = NULL;
2387 return objPtr;
2390 /* charlen is in characters -- see also Jim_NewStringObj() */
2391 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2393 #ifdef JIM_UTF8
2394 /* Need to find out how many bytes the string requires */
2395 int bytelen = utf8_index(s, charlen);
2397 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2399 /* Remember the utf8 length, so set the type */
2400 objPtr->typePtr = &stringObjType;
2401 objPtr->internalRep.strValue.maxLength = bytelen;
2402 objPtr->internalRep.strValue.charLength = charlen;
2404 return objPtr;
2405 #else
2406 return Jim_NewStringObj(interp, s, charlen);
2407 #endif
2410 /* This version does not try to duplicate the 's' pointer, but
2411 * use it directly. */
2412 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2414 Jim_Obj *objPtr = Jim_NewObj(interp);
2416 objPtr->bytes = s;
2417 objPtr->length = (len == -1) ? strlen(s) : len;
2418 objPtr->typePtr = NULL;
2419 return objPtr;
2422 /* Low-level string append. Use it only against unshared objects
2423 * of type "string". */
2424 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2426 int needlen;
2428 if (len == -1)
2429 len = strlen(str);
2430 needlen = objPtr->length + len;
2431 if (objPtr->internalRep.strValue.maxLength < needlen ||
2432 objPtr->internalRep.strValue.maxLength == 0) {
2433 needlen *= 2;
2434 /* Inefficient to malloc() for less than 8 bytes */
2435 if (needlen < 7) {
2436 needlen = 7;
2438 if (objPtr->bytes == JimEmptyStringRep) {
2439 objPtr->bytes = Jim_Alloc(needlen + 1);
2441 else {
2442 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2444 objPtr->internalRep.strValue.maxLength = needlen;
2446 memcpy(objPtr->bytes + objPtr->length, str, len);
2447 objPtr->bytes[objPtr->length + len] = '\0';
2449 if (objPtr->internalRep.strValue.charLength >= 0) {
2450 /* Update the utf-8 char length */
2451 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2453 objPtr->length += len;
2456 /* Higher level API to append strings to objects.
2457 * Object must not be unshared for each of these.
2459 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2461 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2462 SetStringFromAny(interp, objPtr);
2463 StringAppendString(objPtr, str, len);
2466 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2468 int len;
2469 const char *str = Jim_GetString(appendObjPtr, &len);
2470 Jim_AppendString(interp, objPtr, str, len);
2473 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2475 va_list ap;
2477 SetStringFromAny(interp, objPtr);
2478 va_start(ap, objPtr);
2479 while (1) {
2480 const char *s = va_arg(ap, const char *);
2482 if (s == NULL)
2483 break;
2484 Jim_AppendString(interp, objPtr, s, -1);
2486 va_end(ap);
2489 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2491 if (aObjPtr == bObjPtr) {
2492 return 1;
2494 else {
2495 int Alen, Blen;
2496 const char *sA = Jim_GetString(aObjPtr, &Alen);
2497 const char *sB = Jim_GetString(bObjPtr, &Blen);
2499 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2504 * Note. Does not support embedded nulls in either the pattern or the object.
2506 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2508 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2512 * Note: does not support embedded nulls for the nocase option.
2514 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2516 int l1, l2;
2517 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2518 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2520 if (nocase) {
2521 /* Do a character compare for nocase */
2522 return JimStringCompareLen(s1, s2, -1, nocase);
2524 return JimStringCompare(s1, l1, s2, l2);
2528 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2530 * Note: does not support embedded nulls
2532 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2534 const char *s1 = Jim_String(firstObjPtr);
2535 const char *s2 = Jim_String(secondObjPtr);
2537 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2540 /* Convert a range, as returned by Jim_GetRange(), into
2541 * an absolute index into an object of the specified length.
2542 * This function may return negative values, or values
2543 * greater than or equal to the length of the list if the index
2544 * is out of range. */
2545 static int JimRelToAbsIndex(int len, int idx)
2547 if (idx < 0)
2548 return len + idx;
2549 return idx;
2552 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2553 * into a form suitable for implementation of commands like [string range] and [lrange].
2555 * The resulting range is guaranteed to address valid elements of
2556 * the structure.
2558 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2560 int rangeLen;
2562 if (*firstPtr > *lastPtr) {
2563 rangeLen = 0;
2565 else {
2566 rangeLen = *lastPtr - *firstPtr + 1;
2567 if (rangeLen) {
2568 if (*firstPtr < 0) {
2569 rangeLen += *firstPtr;
2570 *firstPtr = 0;
2572 if (*lastPtr >= len) {
2573 rangeLen -= (*lastPtr - (len - 1));
2574 *lastPtr = len - 1;
2578 if (rangeLen < 0)
2579 rangeLen = 0;
2581 *rangeLenPtr = rangeLen;
2584 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2585 int len, int *first, int *last, int *range)
2587 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2588 return JIM_ERR;
2590 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2591 return JIM_ERR;
2593 *first = JimRelToAbsIndex(len, *first);
2594 *last = JimRelToAbsIndex(len, *last);
2595 JimRelToAbsRange(len, first, last, range);
2596 return JIM_OK;
2599 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2600 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2602 int first, last;
2603 const char *str;
2604 int rangeLen;
2605 int bytelen;
2607 str = Jim_GetString(strObjPtr, &bytelen);
2609 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2610 return NULL;
2613 if (first == 0 && rangeLen == bytelen) {
2614 return strObjPtr;
2616 return Jim_NewStringObj(interp, str + first, rangeLen);
2619 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2620 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2622 #ifdef JIM_UTF8
2623 int first, last;
2624 const char *str;
2625 int len, rangeLen;
2626 int bytelen;
2628 str = Jim_GetString(strObjPtr, &bytelen);
2629 len = Jim_Utf8Length(interp, strObjPtr);
2631 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2632 return NULL;
2635 if (first == 0 && rangeLen == len) {
2636 return strObjPtr;
2638 if (len == bytelen) {
2639 /* ASCII optimisation */
2640 return Jim_NewStringObj(interp, str + first, rangeLen);
2642 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2643 #else
2644 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2645 #endif
2648 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2649 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2651 int first, last;
2652 const char *str;
2653 int len, rangeLen;
2654 Jim_Obj *objPtr;
2656 len = Jim_Utf8Length(interp, strObjPtr);
2658 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2659 return NULL;
2662 if (last < first) {
2663 return strObjPtr;
2666 str = Jim_String(strObjPtr);
2668 /* Before part */
2669 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2671 /* Replacement */
2672 if (newStrObj) {
2673 Jim_AppendObj(interp, objPtr, newStrObj);
2676 /* After part */
2677 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2679 return objPtr;
2683 * Note: does not support embedded nulls.
2685 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2687 while (*str) {
2688 int c;
2689 str += utf8_tounicode(str, &c);
2690 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2692 *dest = 0;
2696 * Note: does not support embedded nulls.
2698 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2700 char *buf;
2701 int len;
2702 const char *str;
2704 SetStringFromAny(interp, strObjPtr);
2706 str = Jim_GetString(strObjPtr, &len);
2708 #ifdef JIM_UTF8
2709 /* Case mapping can change the utf-8 length of the string.
2710 * But at worst it will be by one extra byte per char
2712 len *= 2;
2713 #endif
2714 buf = Jim_Alloc(len + 1);
2715 JimStrCopyUpperLower(buf, str, 0);
2716 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2720 * Note: does not support embedded nulls.
2722 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2724 char *buf;
2725 const char *str;
2726 int len;
2728 if (strObjPtr->typePtr != &stringObjType) {
2729 SetStringFromAny(interp, strObjPtr);
2732 str = Jim_GetString(strObjPtr, &len);
2734 #ifdef JIM_UTF8
2735 /* Case mapping can change the utf-8 length of the string.
2736 * But at worst it will be by one extra byte per char
2738 len *= 2;
2739 #endif
2740 buf = Jim_Alloc(len + 1);
2741 JimStrCopyUpperLower(buf, str, 1);
2742 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2746 * Note: does not support embedded nulls.
2748 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2750 char *buf, *p;
2751 int len;
2752 int c;
2753 const char *str;
2755 str = Jim_GetString(strObjPtr, &len);
2756 if (len == 0) {
2757 return strObjPtr;
2759 #ifdef JIM_UTF8
2760 /* Case mapping can change the utf-8 length of the string.
2761 * But at worst it will be by one extra byte per char
2763 len *= 2;
2764 #endif
2765 buf = p = Jim_Alloc(len + 1);
2767 str += utf8_tounicode(str, &c);
2768 p += utf8_getchars(p, utf8_title(c));
2770 JimStrCopyUpperLower(p, str, 0);
2772 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2775 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2776 * for unicode character 'c'.
2777 * Returns the position if found or NULL if not
2779 static const char *utf8_memchr(const char *str, int len, int c)
2781 #ifdef JIM_UTF8
2782 while (len) {
2783 int sc;
2784 int n = utf8_tounicode(str, &sc);
2785 if (sc == c) {
2786 return str;
2788 str += n;
2789 len -= n;
2791 return NULL;
2792 #else
2793 return memchr(str, c, len);
2794 #endif
2798 * Searches for the first non-trim char in string (str, len)
2800 * If none is found, returns just past the last char.
2802 * Lengths are in bytes.
2804 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2806 while (len) {
2807 int c;
2808 int n = utf8_tounicode(str, &c);
2810 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2811 /* Not a trim char, so stop */
2812 break;
2814 str += n;
2815 len -= n;
2817 return str;
2821 * Searches backwards for a non-trim char in string (str, len).
2823 * Returns a pointer to just after the non-trim char, or NULL if not found.
2825 * Lengths are in bytes.
2827 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2829 str += len;
2831 while (len) {
2832 int c;
2833 int n = utf8_prev_len(str, len);
2835 len -= n;
2836 str -= n;
2838 n = utf8_tounicode(str, &c);
2840 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2841 return str + n;
2845 return NULL;
2848 static const char default_trim_chars[] = " \t\n\r";
2849 /* sizeof() here includes the null byte */
2850 static int default_trim_chars_len = sizeof(default_trim_chars);
2852 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2854 int len;
2855 const char *str = Jim_GetString(strObjPtr, &len);
2856 const char *trimchars = default_trim_chars;
2857 int trimcharslen = default_trim_chars_len;
2858 const char *newstr;
2860 if (trimcharsObjPtr) {
2861 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2864 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2865 if (newstr == str) {
2866 return strObjPtr;
2869 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2872 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2874 int len;
2875 const char *trimchars = default_trim_chars;
2876 int trimcharslen = default_trim_chars_len;
2877 const char *nontrim;
2879 if (trimcharsObjPtr) {
2880 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2883 SetStringFromAny(interp, strObjPtr);
2885 len = Jim_Length(strObjPtr);
2886 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2888 if (nontrim == NULL) {
2889 /* All trim, so return a zero-length string */
2890 return Jim_NewEmptyStringObj(interp);
2892 if (nontrim == strObjPtr->bytes + len) {
2893 /* All non-trim, so return the original object */
2894 return strObjPtr;
2897 if (Jim_IsShared(strObjPtr)) {
2898 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2900 else {
2901 /* Can modify this string in place */
2902 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2903 strObjPtr->length = (nontrim - strObjPtr->bytes);
2906 return strObjPtr;
2909 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2911 /* First trim left. */
2912 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2914 /* Now trim right */
2915 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2917 /* Note: refCount check is needed since objPtr may be emptyObj */
2918 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2919 /* We don't want this object to be leaked */
2920 Jim_FreeNewObj(interp, objPtr);
2923 return strObjPtr;
2926 /* Some platforms don't have isascii - need a non-macro version */
2927 #ifdef HAVE_ISASCII
2928 #define jim_isascii isascii
2929 #else
2930 static int jim_isascii(int c)
2932 return !(c & ~0x7f);
2934 #endif
2936 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2938 static const char * const strclassnames[] = {
2939 "integer", "alpha", "alnum", "ascii", "digit",
2940 "double", "lower", "upper", "space", "xdigit",
2941 "control", "print", "graph", "punct",
2942 NULL
2944 enum {
2945 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2946 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2947 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2949 int strclass;
2950 int len;
2951 int i;
2952 const char *str;
2953 int (*isclassfunc)(int c) = NULL;
2955 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2956 return JIM_ERR;
2959 str = Jim_GetString(strObjPtr, &len);
2960 if (len == 0) {
2961 Jim_SetResultBool(interp, !strict);
2962 return JIM_OK;
2965 switch (strclass) {
2966 case STR_IS_INTEGER:
2968 jim_wide w;
2969 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2970 return JIM_OK;
2973 case STR_IS_DOUBLE:
2975 double d;
2976 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2977 return JIM_OK;
2980 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2981 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2982 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
2983 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2984 case STR_IS_LOWER: isclassfunc = islower; break;
2985 case STR_IS_UPPER: isclassfunc = isupper; break;
2986 case STR_IS_SPACE: isclassfunc = isspace; break;
2987 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2988 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2989 case STR_IS_PRINT: isclassfunc = isprint; break;
2990 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2991 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2992 default:
2993 return JIM_ERR;
2996 for (i = 0; i < len; i++) {
2997 if (!isclassfunc(str[i])) {
2998 Jim_SetResultBool(interp, 0);
2999 return JIM_OK;
3002 Jim_SetResultBool(interp, 1);
3003 return JIM_OK;
3006 /* -----------------------------------------------------------------------------
3007 * Compared String Object
3008 * ---------------------------------------------------------------------------*/
3010 /* This is strange object that allows comparison of a C literal string
3011 * with a Jim object in a very short time if the same comparison is done
3012 * multiple times. For example every time the [if] command is executed,
3013 * Jim has to check if a given argument is "else".
3014 * If the code has no errors, this comparison is true most of the time,
3015 * so we can cache the pointer of the string of the last matching
3016 * comparison inside the object. Because most C compilers perform literal sharing,
3017 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3018 * this works pretty well even if comparisons are at different places
3019 * inside the C code. */
3021 static const Jim_ObjType comparedStringObjType = {
3022 "compared-string",
3023 NULL,
3024 NULL,
3025 NULL,
3026 JIM_TYPE_REFERENCES,
3029 /* The only way this object is exposed to the API is via the following
3030 * function. Returns true if the string and the object string repr.
3031 * are the same, otherwise zero is returned.
3033 * Note: this isn't binary safe, but it hardly needs to be.*/
3034 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3036 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3037 return 1;
3039 else {
3040 const char *objStr = Jim_String(objPtr);
3042 if (strcmp(str, objStr) != 0)
3043 return 0;
3045 if (objPtr->typePtr != &comparedStringObjType) {
3046 Jim_FreeIntRep(interp, objPtr);
3047 objPtr->typePtr = &comparedStringObjType;
3049 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3050 return 1;
3054 static int qsortCompareStringPointers(const void *a, const void *b)
3056 char *const *sa = (char *const *)a;
3057 char *const *sb = (char *const *)b;
3059 return strcmp(*sa, *sb);
3063 /* -----------------------------------------------------------------------------
3064 * Source Object
3066 * This object is just a string from the language point of view, but
3067 * the internal representation contains the filename and line number
3068 * where this token was read. This information is used by
3069 * Jim_EvalObj() if the object passed happens to be of type "source".
3071 * This allows propagation of the information about line numbers and file
3072 * names and gives error messages with absolute line numbers.
3074 * Note that this object uses the internal representation of the Jim_Object,
3075 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3077 * Also the object will be converted to something else if the given
3078 * token it represents in the source file is not something to be
3079 * evaluated (not a script), and will be specialized in some other way,
3080 * so the time overhead is also almost zero.
3081 * ---------------------------------------------------------------------------*/
3083 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3084 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3086 static const Jim_ObjType sourceObjType = {
3087 "source",
3088 FreeSourceInternalRep,
3089 DupSourceInternalRep,
3090 NULL,
3091 JIM_TYPE_REFERENCES,
3094 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3096 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3099 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3101 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3102 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3105 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3106 Jim_Obj *fileNameObj, int lineNumber)
3108 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3109 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3110 Jim_IncrRefCount(fileNameObj);
3111 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3112 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3113 objPtr->typePtr = &sourceObjType;
3116 /* -----------------------------------------------------------------------------
3117 * ScriptLine Object
3119 * This object is used only in the Script internal represenation.
3120 * For each line of the script, it holds the number of tokens on the line
3121 * and the source line number.
3123 static const Jim_ObjType scriptLineObjType = {
3124 "scriptline",
3125 NULL,
3126 NULL,
3127 NULL,
3128 JIM_NONE,
3131 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3133 Jim_Obj *objPtr;
3135 #ifdef DEBUG_SHOW_SCRIPT
3136 char buf[100];
3137 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3138 objPtr = Jim_NewStringObj(interp, buf, -1);
3139 #else
3140 objPtr = Jim_NewEmptyStringObj(interp);
3141 #endif
3142 objPtr->typePtr = &scriptLineObjType;
3143 objPtr->internalRep.scriptLineValue.argc = argc;
3144 objPtr->internalRep.scriptLineValue.line = line;
3146 return objPtr;
3149 /* -----------------------------------------------------------------------------
3150 * Script Object
3152 * This object holds the parsed internal representation of a script.
3153 * This representation is help within an allocated ScriptObj (see below)
3155 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3156 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3158 static const Jim_ObjType scriptObjType = {
3159 "script",
3160 FreeScriptInternalRep,
3161 DupScriptInternalRep,
3162 NULL,
3163 JIM_TYPE_REFERENCES,
3166 /* Each token of a script is represented by a ScriptToken.
3167 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3168 * can be specialized by commands operating on it.
3170 typedef struct ScriptToken
3172 Jim_Obj *objPtr;
3173 int type;
3174 } ScriptToken;
3176 /* This is the script object internal representation. An array of
3177 * ScriptToken structures, including a pre-computed representation of the
3178 * command length and arguments.
3180 * For example the script:
3182 * puts hello
3183 * set $i $x$y [foo]BAR
3185 * will produce a ScriptObj with the following ScriptToken's:
3187 * LIN 2
3188 * ESC puts
3189 * ESC hello
3190 * LIN 4
3191 * ESC set
3192 * VAR i
3193 * WRD 2
3194 * VAR x
3195 * VAR y
3196 * WRD 2
3197 * CMD foo
3198 * ESC BAR
3200 * "puts hello" has two args (LIN 2), composed of single tokens.
3201 * (Note that the WRD token is omitted for the common case of a single token.)
3203 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3204 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3206 * The precomputation of the command structure makes Jim_Eval() faster,
3207 * and simpler because there aren't dynamic lengths / allocations.
3209 * -- {expand}/{*} handling --
3211 * Expand is handled in a special way.
3213 * If a "word" begins with {*}, the word token count is -ve.
3215 * For example the command:
3217 * list {*}{a b}
3219 * Will produce the following cmdstruct array:
3221 * LIN 2
3222 * ESC list
3223 * WRD -1
3224 * STR a b
3226 * Note that the 'LIN' token also contains the source information for the
3227 * first word of the line for error reporting purposes
3229 * -- the substFlags field of the structure --
3231 * The scriptObj structure is used to represent both "script" objects
3232 * and "subst" objects. In the second case, there are no LIN and WRD
3233 * tokens. Instead SEP and EOL tokens are added as-is.
3234 * In addition, the field 'substFlags' is used to represent the flags used to turn
3235 * the string into the internal representation.
3236 * If these flags do not match what the application requires,
3237 * the scriptObj is created again. For example the script:
3239 * subst -nocommands $string
3240 * subst -novariables $string
3242 * Will (re)create the internal representation of the $string object
3243 * two times.
3245 typedef struct ScriptObj
3247 ScriptToken *token; /* Tokens array. */
3248 Jim_Obj *fileNameObj; /* Filename */
3249 int len; /* Length of token[] */
3250 int substFlags; /* flags used for the compilation of "subst" objects */
3251 int inUse; /* Used to share a ScriptObj. Currently
3252 only used by Jim_EvalObj() as protection against
3253 shimmering of the currently evaluated object. */
3254 int firstline; /* Line number of the first line */
3255 int linenr; /* Error line number, if any */
3256 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3257 } ScriptObj;
3259 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3260 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3261 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3263 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3265 int i;
3266 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3268 if (--script->inUse != 0)
3269 return;
3270 for (i = 0; i < script->len; i++) {
3271 Jim_DecrRefCount(interp, script->token[i].objPtr);
3273 Jim_Free(script->token);
3274 Jim_DecrRefCount(interp, script->fileNameObj);
3275 Jim_Free(script);
3278 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3280 JIM_NOTUSED(interp);
3281 JIM_NOTUSED(srcPtr);
3283 /* Just return a simple string. We don't try to preserve the source info
3284 * since in practice scripts are never duplicated
3286 dupPtr->typePtr = NULL;
3289 /* A simple parse token.
3290 * As the script is parsed, the created tokens point into the script string rep.
3292 typedef struct
3294 const char *token; /* Pointer to the start of the token */
3295 int len; /* Length of this token */
3296 int type; /* Token type */
3297 int line; /* Line number */
3298 } ParseToken;
3300 /* A list of parsed tokens representing a script.
3301 * Tokens are added to this list as the script is parsed.
3302 * It grows as needed.
3304 typedef struct
3306 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3307 ParseToken *list; /* Array of tokens */
3308 int size; /* Current size of the list */
3309 int count; /* Number of entries used */
3310 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3311 } ParseTokenList;
3313 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3315 tokenlist->list = tokenlist->static_list;
3316 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3317 tokenlist->count = 0;
3320 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3322 if (tokenlist->list != tokenlist->static_list) {
3323 Jim_Free(tokenlist->list);
3328 * Adds the new token to the tokenlist.
3329 * The token has the given length, type and line number.
3330 * The token list is resized as necessary.
3332 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3333 int line)
3335 ParseToken *t;
3337 if (tokenlist->count == tokenlist->size) {
3338 /* Resize the list */
3339 tokenlist->size *= 2;
3340 if (tokenlist->list != tokenlist->static_list) {
3341 tokenlist->list =
3342 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3344 else {
3345 /* The list needs to become allocated */
3346 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3347 memcpy(tokenlist->list, tokenlist->static_list,
3348 tokenlist->count * sizeof(*tokenlist->list));
3351 t = &tokenlist->list[tokenlist->count++];
3352 t->token = token;
3353 t->len = len;
3354 t->type = type;
3355 t->line = line;
3358 /* Counts the number of adjoining non-separator tokens.
3360 * Returns -ve if the first token is the expansion
3361 * operator (in which case the count doesn't include
3362 * that token).
3364 static int JimCountWordTokens(ParseToken *t)
3366 int expand = 1;
3367 int count = 0;
3369 /* Is the first word {*} or {expand}? */
3370 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3371 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3372 /* Create an expand token */
3373 expand = -1;
3374 t++;
3378 /* Now count non-separator words */
3379 while (!TOKEN_IS_SEP(t->type)) {
3380 t++;
3381 count++;
3384 return count * expand;
3388 * Create a script/subst object from the given token.
3390 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3392 Jim_Obj *objPtr;
3394 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3395 /* Convert backlash escapes. The result will never be longer than the original */
3396 int len = t->len;
3397 char *str = Jim_Alloc(len + 1);
3398 len = JimEscape(str, t->token, len);
3399 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3401 else {
3402 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3403 * with a single space.
3405 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3407 return objPtr;
3411 * Takes a tokenlist and creates the allocated list of script tokens
3412 * in script->token, of length script->len.
3414 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3415 * as required.
3417 * Also sets script->line to the line number of the first token
3419 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3420 ParseTokenList *tokenlist)
3422 int i;
3423 struct ScriptToken *token;
3424 /* Number of tokens so far for the current command */
3425 int lineargs = 0;
3426 /* This is the first token for the current command */
3427 ScriptToken *linefirst;
3428 int count;
3429 int linenr;
3431 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3432 printf("==== Tokens ====\n");
3433 for (i = 0; i < tokenlist->count; i++) {
3434 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3435 tokenlist->list[i].len, tokenlist->list[i].token);
3437 #endif
3439 /* May need up to one extra script token for each EOL in the worst case */
3440 count = tokenlist->count;
3441 for (i = 0; i < tokenlist->count; i++) {
3442 if (tokenlist->list[i].type == JIM_TT_EOL) {
3443 count++;
3446 linenr = script->firstline = tokenlist->list[0].line;
3448 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3450 /* This is the first token for the current command */
3451 linefirst = token++;
3453 for (i = 0; i < tokenlist->count; ) {
3454 /* Look ahead to find out how many tokens make up the next word */
3455 int wordtokens;
3457 /* Skip any leading separators */
3458 while (tokenlist->list[i].type == JIM_TT_SEP) {
3459 i++;
3462 wordtokens = JimCountWordTokens(tokenlist->list + i);
3464 if (wordtokens == 0) {
3465 /* None, so at end of line */
3466 if (lineargs) {
3467 linefirst->type = JIM_TT_LINE;
3468 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3469 Jim_IncrRefCount(linefirst->objPtr);
3471 /* Reset for new line */
3472 lineargs = 0;
3473 linefirst = token++;
3475 i++;
3476 continue;
3478 else if (wordtokens != 1) {
3479 /* More than 1, or {*}, so insert a WORD token */
3480 token->type = JIM_TT_WORD;
3481 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3482 Jim_IncrRefCount(token->objPtr);
3483 token++;
3484 if (wordtokens < 0) {
3485 /* Skip the expand token */
3486 i++;
3487 wordtokens = -wordtokens - 1;
3488 lineargs--;
3492 if (lineargs == 0) {
3493 /* First real token on the line, so record the line number */
3494 linenr = tokenlist->list[i].line;
3496 lineargs++;
3498 /* Add each non-separator word token to the line */
3499 while (wordtokens--) {
3500 const ParseToken *t = &tokenlist->list[i++];
3502 token->type = t->type;
3503 token->objPtr = JimMakeScriptObj(interp, t);
3504 Jim_IncrRefCount(token->objPtr);
3506 /* Every object is initially a string of type 'source', but the
3507 * internal type may be specialized during execution of the
3508 * script. */
3509 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3510 token++;
3514 if (lineargs == 0) {
3515 token--;
3518 script->len = token - script->token;
3520 JimPanic((script->len >= count, "allocated script array is too short"));
3522 #ifdef DEBUG_SHOW_SCRIPT
3523 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3524 for (i = 0; i < script->len; i++) {
3525 const ScriptToken *t = &script->token[i];
3526 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3528 #endif
3532 /* Parses the given string object to determine if it represents a complete script.
3534 * This is useful for interactive shells implementation, for [info complete].
3536 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3537 * '{' on scripts incomplete missing one or more '}' to be balanced.
3538 * '[' on scripts incomplete missing one or more ']' to be balanced.
3539 * '"' on scripts incomplete missing a '"' char.
3540 * '\\' on scripts with a trailing backslash.
3542 * If the script is complete, 1 is returned, otherwise 0.
3544 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3546 ScriptObj *script = JimGetScript(interp, scriptObj);
3547 if (stateCharPtr) {
3548 *stateCharPtr = script->missing;
3550 return (script->missing == ' ');
3554 * Sets an appropriate error message for a missing script/expression terminator.
3556 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3558 * Note that a trailing backslash is not considered to be an error.
3560 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3562 const char *msg;
3564 switch (ch) {
3565 case '\\':
3566 case ' ':
3567 return JIM_OK;
3569 case '[':
3570 msg = "unmatched \"[\"";
3571 break;
3572 case '{':
3573 msg = "missing close-brace";
3574 break;
3575 case '"':
3576 default:
3577 msg = "missing quote";
3578 break;
3581 Jim_SetResultString(interp, msg, -1);
3582 return JIM_ERR;
3586 * Similar to ScriptObjAddTokens(), but for subst objects.
3588 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3589 ParseTokenList *tokenlist)
3591 int i;
3592 struct ScriptToken *token;
3594 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3596 for (i = 0; i < tokenlist->count; i++) {
3597 const ParseToken *t = &tokenlist->list[i];
3599 /* Create a token for 't' */
3600 token->type = t->type;
3601 token->objPtr = JimMakeScriptObj(interp, t);
3602 Jim_IncrRefCount(token->objPtr);
3603 token++;
3606 script->len = i;
3609 /* This method takes the string representation of an object
3610 * as a Tcl script, and generates the pre-parsed internal representation
3611 * of the script.
3613 * On parse error, sets an error message and returns JIM_ERR
3614 * (Note: the object is still converted to a script, even if an error occurs)
3616 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3618 int scriptTextLen;
3619 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3620 struct JimParserCtx parser;
3621 struct ScriptObj *script;
3622 ParseTokenList tokenlist;
3623 int line = 1;
3625 /* Try to get information about filename / line number */
3626 if (objPtr->typePtr == &sourceObjType) {
3627 line = objPtr->internalRep.sourceValue.lineNumber;
3630 /* Initially parse the script into tokens (in tokenlist) */
3631 ScriptTokenListInit(&tokenlist);
3633 JimParserInit(&parser, scriptText, scriptTextLen, line);
3634 while (!parser.eof) {
3635 JimParseScript(&parser);
3636 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3637 parser.tline);
3640 /* Add a final EOF token */
3641 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3643 /* Create the "real" script tokens from the parsed tokens */
3644 script = Jim_Alloc(sizeof(*script));
3645 memset(script, 0, sizeof(*script));
3646 script->inUse = 1;
3647 if (objPtr->typePtr == &sourceObjType) {
3648 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3650 else {
3651 script->fileNameObj = interp->emptyObj;
3653 Jim_IncrRefCount(script->fileNameObj);
3654 script->missing = parser.missing.ch;
3655 script->linenr = parser.missing.line;
3657 ScriptObjAddTokens(interp, script, &tokenlist);
3659 /* No longer need the token list */
3660 ScriptTokenListFree(&tokenlist);
3662 /* Free the old internal rep and set the new one. */
3663 Jim_FreeIntRep(interp, objPtr);
3664 Jim_SetIntRepPtr(objPtr, script);
3665 objPtr->typePtr = &scriptObjType;
3668 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3671 * Returns the parsed script.
3672 * Note that if there is any possibility that the script is not valid,
3673 * call JimScriptValid() to check
3675 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3677 if (objPtr == interp->emptyObj) {
3678 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3679 objPtr = interp->nullScriptObj;
3682 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3683 JimSetScriptFromAny(interp, objPtr);
3686 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3690 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3691 * and leaves an error message in the interp result.
3694 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3696 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3697 JimAddErrorToStack(interp, script);
3698 return 0;
3700 return 1;
3704 /* -----------------------------------------------------------------------------
3705 * Commands
3706 * ---------------------------------------------------------------------------*/
3707 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3709 cmdPtr->inUse++;
3712 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3714 if (--cmdPtr->inUse == 0) {
3715 if (cmdPtr->isproc) {
3716 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3717 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3718 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3719 if (cmdPtr->u.proc.staticVars) {
3720 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3721 Jim_Free(cmdPtr->u.proc.staticVars);
3724 else {
3725 /* native (C) */
3726 if (cmdPtr->u.native.delProc) {
3727 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3730 if (cmdPtr->prevCmd) {
3731 /* Delete any pushed command too */
3732 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3734 Jim_Free(cmdPtr);
3738 /* Variables HashTable Type.
3740 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3743 /* Variables HashTable Type.
3745 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3746 static void JimVariablesHTValDestructor(void *interp, void *val)
3748 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3749 Jim_Free(val);
3752 static const Jim_HashTableType JimVariablesHashTableType = {
3753 JimStringCopyHTHashFunction, /* hash function */
3754 JimStringCopyHTDup, /* key dup */
3755 NULL, /* val dup */
3756 JimStringCopyHTKeyCompare, /* key compare */
3757 JimStringCopyHTKeyDestructor, /* key destructor */
3758 JimVariablesHTValDestructor /* val destructor */
3761 /* Commands HashTable Type.
3763 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3765 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3767 JimDecrCmdRefCount(interp, val);
3770 static const Jim_HashTableType JimCommandsHashTableType = {
3771 JimStringCopyHTHashFunction, /* hash function */
3772 JimStringCopyHTDup, /* key dup */
3773 NULL, /* val dup */
3774 JimStringCopyHTKeyCompare, /* key compare */
3775 JimStringCopyHTKeyDestructor, /* key destructor */
3776 JimCommandsHT_ValDestructor /* val destructor */
3779 /* ------------------------- Commands related functions --------------------- */
3781 #ifdef jim_ext_namespace
3783 * Returns the "unscoped" version of the given namespace.
3784 * That is, the fully qualified name without the leading ::
3785 * The returned value is either nsObj, or an object with a zero ref count.
3787 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3789 const char *name = Jim_String(nsObj);
3790 if (name[0] == ':' && name[1] == ':') {
3791 /* This command is being defined in the global namespace */
3792 while (*++name == ':') {
3794 nsObj = Jim_NewStringObj(interp, name, -1);
3796 else if (Jim_Length(interp->framePtr->nsObj)) {
3797 /* This command is being defined in a non-global namespace */
3798 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3799 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3801 return nsObj;
3804 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3806 Jim_Obj *resultObj;
3808 const char *name = Jim_String(nameObjPtr);
3809 if (name[0] == ':' && name[1] == ':') {
3810 return nameObjPtr;
3812 Jim_IncrRefCount(nameObjPtr);
3813 resultObj = Jim_NewStringObj(interp, "::", -1);
3814 Jim_AppendObj(interp, resultObj, nameObjPtr);
3815 Jim_DecrRefCount(interp, nameObjPtr);
3817 return resultObj;
3821 * An efficient version of JimQualifyNameObj() where the name is
3822 * available (and needed) as a 'const char *'.
3823 * Avoids creating an object if not necessary.
3824 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3826 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3828 Jim_Obj *objPtr = interp->emptyObj;
3830 if (name[0] == ':' && name[1] == ':') {
3831 /* This command is being defined in the global namespace */
3832 while (*++name == ':') {
3835 else if (Jim_Length(interp->framePtr->nsObj)) {
3836 /* This command is being defined in a non-global namespace */
3837 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3838 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3839 name = Jim_String(objPtr);
3841 Jim_IncrRefCount(objPtr);
3842 *objPtrPtr = objPtr;
3843 return name;
3846 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3848 #else
3849 /* We can be more efficient in the no-namespace case */
3850 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3851 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3853 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3855 return nameObjPtr;
3857 #endif
3859 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3861 /* It may already exist, so we try to delete the old one.
3862 * Note that reference count means that it won't be deleted yet if
3863 * it exists in the call stack.
3865 * BUT, if 'local' is in force, instead of deleting the existing
3866 * proc, we stash a reference to the old proc here.
3868 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3869 if (he) {
3870 /* There was an old cmd with the same name,
3871 * so this requires a 'proc epoch' update. */
3873 /* If a procedure with the same name didn't exist there is no need
3874 * to increment the 'proc epoch' because creation of a new procedure
3875 * can never affect existing cached commands. We don't do
3876 * negative caching. */
3877 Jim_InterpIncrProcEpoch(interp);
3880 if (he && interp->local) {
3881 /* Push this command over the top of the previous one */
3882 cmd->prevCmd = Jim_GetHashEntryVal(he);
3883 Jim_SetHashVal(&interp->commands, he, cmd);
3885 else {
3886 if (he) {
3887 /* Replace the existing command */
3888 Jim_DeleteHashEntry(&interp->commands, name);
3891 Jim_AddHashEntry(&interp->commands, name, cmd);
3893 return JIM_OK;
3897 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3898 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3900 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3902 /* Store the new details for this command */
3903 memset(cmdPtr, 0, sizeof(*cmdPtr));
3904 cmdPtr->inUse = 1;
3905 cmdPtr->u.native.delProc = delProc;
3906 cmdPtr->u.native.cmdProc = cmdProc;
3907 cmdPtr->u.native.privData = privData;
3909 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3911 return JIM_OK;
3914 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3916 int len, i;
3918 len = Jim_ListLength(interp, staticsListObjPtr);
3919 if (len == 0) {
3920 return JIM_OK;
3923 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3924 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3925 for (i = 0; i < len; i++) {
3926 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3927 Jim_Var *varPtr;
3928 int subLen;
3930 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3931 /* Check if it's composed of two elements. */
3932 subLen = Jim_ListLength(interp, objPtr);
3933 if (subLen == 1 || subLen == 2) {
3934 /* Try to get the variable value from the current
3935 * environment. */
3936 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3937 if (subLen == 1) {
3938 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3939 if (initObjPtr == NULL) {
3940 Jim_SetResultFormatted(interp,
3941 "variable for initialization of static \"%#s\" not found in the local context",
3942 nameObjPtr);
3943 return JIM_ERR;
3946 else {
3947 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3949 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3950 return JIM_ERR;
3953 varPtr = Jim_Alloc(sizeof(*varPtr));
3954 varPtr->objPtr = initObjPtr;
3955 Jim_IncrRefCount(initObjPtr);
3956 varPtr->linkFramePtr = NULL;
3957 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3958 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3959 Jim_SetResultFormatted(interp,
3960 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3961 Jim_DecrRefCount(interp, initObjPtr);
3962 Jim_Free(varPtr);
3963 return JIM_ERR;
3966 else {
3967 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3968 objPtr);
3969 return JIM_ERR;
3972 return JIM_OK;
3975 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3977 #ifdef jim_ext_namespace
3978 if (cmdPtr->isproc) {
3979 /* XXX: Really need JimNamespaceSplit() */
3980 const char *pt = strrchr(cmdname, ':');
3981 if (pt && pt != cmdname && pt[-1] == ':') {
3982 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3983 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3984 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3986 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3987 /* This commands shadows a global command, so a proc epoch update is required */
3988 Jim_InterpIncrProcEpoch(interp);
3992 #endif
3995 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3996 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3998 Jim_Cmd *cmdPtr;
3999 int argListLen;
4000 int i;
4002 argListLen = Jim_ListLength(interp, argListObjPtr);
4004 /* Allocate space for both the command pointer and the arg list */
4005 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4006 memset(cmdPtr, 0, sizeof(*cmdPtr));
4007 cmdPtr->inUse = 1;
4008 cmdPtr->isproc = 1;
4009 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4010 cmdPtr->u.proc.argListLen = argListLen;
4011 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4012 cmdPtr->u.proc.argsPos = -1;
4013 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4014 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4015 Jim_IncrRefCount(argListObjPtr);
4016 Jim_IncrRefCount(bodyObjPtr);
4017 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4019 /* Create the statics hash table. */
4020 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4021 goto err;
4024 /* Parse the args out into arglist, validating as we go */
4025 /* Examine the argument list for default parameters and 'args' */
4026 for (i = 0; i < argListLen; i++) {
4027 Jim_Obj *argPtr;
4028 Jim_Obj *nameObjPtr;
4029 Jim_Obj *defaultObjPtr;
4030 int len;
4032 /* Examine a parameter */
4033 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4034 len = Jim_ListLength(interp, argPtr);
4035 if (len == 0) {
4036 Jim_SetResultString(interp, "argument with no name", -1);
4037 err:
4038 JimDecrCmdRefCount(interp, cmdPtr);
4039 return NULL;
4041 if (len > 2) {
4042 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4043 goto err;
4046 if (len == 2) {
4047 /* Optional parameter */
4048 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4049 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4051 else {
4052 /* Required parameter */
4053 nameObjPtr = argPtr;
4054 defaultObjPtr = NULL;
4058 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4059 if (cmdPtr->u.proc.argsPos >= 0) {
4060 Jim_SetResultString(interp, "'args' specified more than once", -1);
4061 goto err;
4063 cmdPtr->u.proc.argsPos = i;
4065 else {
4066 if (len == 2) {
4067 cmdPtr->u.proc.optArity++;
4069 else {
4070 cmdPtr->u.proc.reqArity++;
4074 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4075 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4078 return cmdPtr;
4081 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4083 int ret = JIM_OK;
4084 Jim_Obj *qualifiedNameObj;
4085 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4087 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4088 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4089 ret = JIM_ERR;
4091 else {
4092 Jim_InterpIncrProcEpoch(interp);
4095 JimFreeQualifiedName(interp, qualifiedNameObj);
4097 return ret;
4100 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4102 int ret = JIM_ERR;
4103 Jim_HashEntry *he;
4104 Jim_Cmd *cmdPtr;
4105 Jim_Obj *qualifiedOldNameObj;
4106 Jim_Obj *qualifiedNewNameObj;
4107 const char *fqold;
4108 const char *fqnew;
4110 if (newName[0] == 0) {
4111 return Jim_DeleteCommand(interp, oldName);
4114 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4115 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4117 /* Does it exist? */
4118 he = Jim_FindHashEntry(&interp->commands, fqold);
4119 if (he == NULL) {
4120 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4122 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4123 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4125 else {
4126 /* Add the new name first */
4127 cmdPtr = Jim_GetHashEntryVal(he);
4128 JimIncrCmdRefCount(cmdPtr);
4129 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4130 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4132 /* Now remove the old name */
4133 Jim_DeleteHashEntry(&interp->commands, fqold);
4135 /* Increment the epoch */
4136 Jim_InterpIncrProcEpoch(interp);
4138 ret = JIM_OK;
4141 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4142 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4144 return ret;
4147 /* -----------------------------------------------------------------------------
4148 * Command object
4149 * ---------------------------------------------------------------------------*/
4151 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4153 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4156 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4158 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4159 dupPtr->typePtr = srcPtr->typePtr;
4160 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4163 static const Jim_ObjType commandObjType = {
4164 "command",
4165 FreeCommandInternalRep,
4166 DupCommandInternalRep,
4167 NULL,
4168 JIM_TYPE_REFERENCES,
4171 /* This function returns the command structure for the command name
4172 * stored in objPtr. It tries to specialize the objPtr to contain
4173 * a cached info instead to perform the lookup into the hash table
4174 * every time. The information cached may not be uptodate, in such
4175 * a case the lookup is performed and the cache updated.
4177 * Respects the 'upcall' setting
4179 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4181 Jim_Cmd *cmd;
4183 /* In order to be valid, the proc epoch must match and
4184 * the lookup must have occurred in the same namespace
4186 if (objPtr->typePtr != &commandObjType ||
4187 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4188 #ifdef jim_ext_namespace
4189 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4190 #endif
4192 /* Not cached or out of date, so lookup */
4194 /* Do we need to try the local namespace? */
4195 const char *name = Jim_String(objPtr);
4196 Jim_HashEntry *he;
4198 if (name[0] == ':' && name[1] == ':') {
4199 while (*++name == ':') {
4202 #ifdef jim_ext_namespace
4203 else if (Jim_Length(interp->framePtr->nsObj)) {
4204 /* This command is being defined in a non-global namespace */
4205 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4206 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4207 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4208 Jim_FreeNewObj(interp, nameObj);
4209 if (he) {
4210 goto found;
4213 #endif
4215 /* Lookup in the global namespace */
4216 he = Jim_FindHashEntry(&interp->commands, name);
4217 if (he == NULL) {
4218 if (flags & JIM_ERRMSG) {
4219 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4221 return NULL;
4223 #ifdef jim_ext_namespace
4224 found:
4225 #endif
4226 cmd = Jim_GetHashEntryVal(he);
4228 /* Free the old internal repr and set the new one. */
4229 Jim_FreeIntRep(interp, objPtr);
4230 objPtr->typePtr = &commandObjType;
4231 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4232 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4233 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4234 Jim_IncrRefCount(interp->framePtr->nsObj);
4236 else {
4237 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4239 while (cmd->u.proc.upcall) {
4240 cmd = cmd->prevCmd;
4242 return cmd;
4245 /* -----------------------------------------------------------------------------
4246 * Variables
4247 * ---------------------------------------------------------------------------*/
4249 /* -----------------------------------------------------------------------------
4250 * Variable object
4251 * ---------------------------------------------------------------------------*/
4253 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4255 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4257 static const Jim_ObjType variableObjType = {
4258 "variable",
4259 NULL,
4260 NULL,
4261 NULL,
4262 JIM_TYPE_REFERENCES,
4266 * Check that the name does not contain embedded nulls.
4268 * Variable and procedure names are manipulated as null terminated strings, so
4269 * don't allow names with embedded nulls.
4271 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4273 /* Variable names and proc names can't contain embedded nulls */
4274 if (nameObjPtr->typePtr != &variableObjType) {
4275 int len;
4276 const char *str = Jim_GetString(nameObjPtr, &len);
4277 if (memchr(str, '\0', len)) {
4278 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4279 return JIM_ERR;
4282 return JIM_OK;
4285 /* This method should be called only by the variable API.
4286 * It returns JIM_OK on success (variable already exists),
4287 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4288 * a variable name, but syntax glue for [dict] i.e. the last
4289 * character is ')' */
4290 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4292 const char *varName;
4293 Jim_CallFrame *framePtr;
4294 Jim_HashEntry *he;
4295 int global;
4296 int len;
4298 /* Check if the object is already an uptodate variable */
4299 if (objPtr->typePtr == &variableObjType) {
4300 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4301 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4302 /* nothing to do */
4303 return JIM_OK;
4305 /* Need to re-resolve the variable in the updated callframe */
4307 else if (objPtr->typePtr == &dictSubstObjType) {
4308 return JIM_DICT_SUGAR;
4310 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4311 return JIM_ERR;
4315 varName = Jim_GetString(objPtr, &len);
4317 /* Make sure it's not syntax glue to get/set dict. */
4318 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4319 return JIM_DICT_SUGAR;
4322 if (varName[0] == ':' && varName[1] == ':') {
4323 while (*++varName == ':') {
4325 global = 1;
4326 framePtr = interp->topFramePtr;
4328 else {
4329 global = 0;
4330 framePtr = interp->framePtr;
4333 /* Resolve this name in the variables hash table */
4334 he = Jim_FindHashEntry(&framePtr->vars, varName);
4335 if (he == NULL) {
4336 if (!global && framePtr->staticVars) {
4337 /* Try with static vars. */
4338 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4340 if (he == NULL) {
4341 return JIM_ERR;
4345 /* Free the old internal repr and set the new one. */
4346 Jim_FreeIntRep(interp, objPtr);
4347 objPtr->typePtr = &variableObjType;
4348 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4349 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4350 objPtr->internalRep.varValue.global = global;
4351 return JIM_OK;
4354 /* -------------------- Variables related functions ------------------------- */
4355 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4356 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4358 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4360 const char *name;
4361 Jim_CallFrame *framePtr;
4362 int global;
4364 /* New variable to create */
4365 Jim_Var *var = Jim_Alloc(sizeof(*var));
4367 var->objPtr = valObjPtr;
4368 Jim_IncrRefCount(valObjPtr);
4369 var->linkFramePtr = NULL;
4371 name = Jim_String(nameObjPtr);
4372 if (name[0] == ':' && name[1] == ':') {
4373 while (*++name == ':') {
4375 framePtr = interp->topFramePtr;
4376 global = 1;
4378 else {
4379 framePtr = interp->framePtr;
4380 global = 0;
4383 /* Insert the new variable */
4384 Jim_AddHashEntry(&framePtr->vars, name, var);
4386 /* Make the object int rep a variable */
4387 Jim_FreeIntRep(interp, nameObjPtr);
4388 nameObjPtr->typePtr = &variableObjType;
4389 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4390 nameObjPtr->internalRep.varValue.varPtr = var;
4391 nameObjPtr->internalRep.varValue.global = global;
4393 return var;
4396 /* For now that's dummy. Variables lookup should be optimized
4397 * in many ways, with caching of lookups, and possibly with
4398 * a table of pre-allocated vars in every CallFrame for local vars.
4399 * All the caching should also have an 'epoch' mechanism similar
4400 * to the one used by Tcl for procedures lookup caching. */
4402 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4404 int err;
4405 Jim_Var *var;
4407 switch (SetVariableFromAny(interp, nameObjPtr)) {
4408 case JIM_DICT_SUGAR:
4409 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4411 case JIM_ERR:
4412 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4413 return JIM_ERR;
4415 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4416 break;
4418 case JIM_OK:
4419 var = nameObjPtr->internalRep.varValue.varPtr;
4420 if (var->linkFramePtr == NULL) {
4421 Jim_IncrRefCount(valObjPtr);
4422 Jim_DecrRefCount(interp, var->objPtr);
4423 var->objPtr = valObjPtr;
4425 else { /* Else handle the link */
4426 Jim_CallFrame *savedCallFrame;
4428 savedCallFrame = interp->framePtr;
4429 interp->framePtr = var->linkFramePtr;
4430 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4431 interp->framePtr = savedCallFrame;
4432 if (err != JIM_OK)
4433 return err;
4436 return JIM_OK;
4439 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4441 Jim_Obj *nameObjPtr;
4442 int result;
4444 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4445 Jim_IncrRefCount(nameObjPtr);
4446 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4447 Jim_DecrRefCount(interp, nameObjPtr);
4448 return result;
4451 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4453 Jim_CallFrame *savedFramePtr;
4454 int result;
4456 savedFramePtr = interp->framePtr;
4457 interp->framePtr = interp->topFramePtr;
4458 result = Jim_SetVariableStr(interp, name, objPtr);
4459 interp->framePtr = savedFramePtr;
4460 return result;
4463 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4465 Jim_Obj *nameObjPtr, *valObjPtr;
4466 int result;
4468 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4469 valObjPtr = Jim_NewStringObj(interp, val, -1);
4470 Jim_IncrRefCount(nameObjPtr);
4471 Jim_IncrRefCount(valObjPtr);
4472 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4473 Jim_DecrRefCount(interp, nameObjPtr);
4474 Jim_DecrRefCount(interp, valObjPtr);
4475 return result;
4478 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4479 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4481 const char *varName;
4482 const char *targetName;
4483 Jim_CallFrame *framePtr;
4484 Jim_Var *varPtr;
4486 /* Check for an existing variable or link */
4487 switch (SetVariableFromAny(interp, nameObjPtr)) {
4488 case JIM_DICT_SUGAR:
4489 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4490 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4491 return JIM_ERR;
4493 case JIM_OK:
4494 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4496 if (varPtr->linkFramePtr == NULL) {
4497 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4498 return JIM_ERR;
4501 /* It exists, but is a link, so first delete the link */
4502 varPtr->linkFramePtr = NULL;
4503 break;
4506 /* Resolve the call frames for both variables */
4507 /* XXX: SetVariableFromAny() already did this! */
4508 varName = Jim_String(nameObjPtr);
4510 if (varName[0] == ':' && varName[1] == ':') {
4511 while (*++varName == ':') {
4513 /* Linking a global var does nothing */
4514 framePtr = interp->topFramePtr;
4516 else {
4517 framePtr = interp->framePtr;
4520 targetName = Jim_String(targetNameObjPtr);
4521 if (targetName[0] == ':' && targetName[1] == ':') {
4522 while (*++targetName == ':') {
4524 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4525 targetCallFrame = interp->topFramePtr;
4527 Jim_IncrRefCount(targetNameObjPtr);
4529 if (framePtr->level < targetCallFrame->level) {
4530 Jim_SetResultFormatted(interp,
4531 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4532 nameObjPtr);
4533 Jim_DecrRefCount(interp, targetNameObjPtr);
4534 return JIM_ERR;
4537 /* Check for cycles. */
4538 if (framePtr == targetCallFrame) {
4539 Jim_Obj *objPtr = targetNameObjPtr;
4541 /* Cycles are only possible with 'uplevel 0' */
4542 while (1) {
4543 if (strcmp(Jim_String(objPtr), varName) == 0) {
4544 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4545 Jim_DecrRefCount(interp, targetNameObjPtr);
4546 return JIM_ERR;
4548 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4549 break;
4550 varPtr = objPtr->internalRep.varValue.varPtr;
4551 if (varPtr->linkFramePtr != targetCallFrame)
4552 break;
4553 objPtr = varPtr->objPtr;
4557 /* Perform the binding */
4558 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4559 /* We are now sure 'nameObjPtr' type is variableObjType */
4560 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4561 Jim_DecrRefCount(interp, targetNameObjPtr);
4562 return JIM_OK;
4565 /* Return the Jim_Obj pointer associated with a variable name,
4566 * or NULL if the variable was not found in the current context.
4567 * The same optimization discussed in the comment to the
4568 * 'SetVariable' function should apply here.
4570 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4571 * in a dictionary which is shared, the array variable value is duplicated first.
4572 * This allows the array element to be updated (e.g. append, lappend) without
4573 * affecting other references to the dictionary.
4575 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4577 switch (SetVariableFromAny(interp, nameObjPtr)) {
4578 case JIM_OK:{
4579 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4581 if (varPtr->linkFramePtr == NULL) {
4582 return varPtr->objPtr;
4584 else {
4585 Jim_Obj *objPtr;
4587 /* The variable is a link? Resolve it. */
4588 Jim_CallFrame *savedCallFrame = interp->framePtr;
4590 interp->framePtr = varPtr->linkFramePtr;
4591 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4592 interp->framePtr = savedCallFrame;
4593 if (objPtr) {
4594 return objPtr;
4596 /* Error, so fall through to the error message */
4599 break;
4601 case JIM_DICT_SUGAR:
4602 /* [dict] syntax sugar. */
4603 return JimDictSugarGet(interp, nameObjPtr, flags);
4605 if (flags & JIM_ERRMSG) {
4606 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4608 return NULL;
4611 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4613 Jim_CallFrame *savedFramePtr;
4614 Jim_Obj *objPtr;
4616 savedFramePtr = interp->framePtr;
4617 interp->framePtr = interp->topFramePtr;
4618 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4619 interp->framePtr = savedFramePtr;
4621 return objPtr;
4624 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4626 Jim_Obj *nameObjPtr, *varObjPtr;
4628 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4629 Jim_IncrRefCount(nameObjPtr);
4630 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4631 Jim_DecrRefCount(interp, nameObjPtr);
4632 return varObjPtr;
4635 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4637 Jim_CallFrame *savedFramePtr;
4638 Jim_Obj *objPtr;
4640 savedFramePtr = interp->framePtr;
4641 interp->framePtr = interp->topFramePtr;
4642 objPtr = Jim_GetVariableStr(interp, name, flags);
4643 interp->framePtr = savedFramePtr;
4645 return objPtr;
4648 /* Unset a variable.
4649 * Note: On success unset invalidates all the variable objects created
4650 * in the current call frame incrementing. */
4651 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4653 Jim_Var *varPtr;
4654 int retval;
4655 Jim_CallFrame *framePtr;
4657 retval = SetVariableFromAny(interp, nameObjPtr);
4658 if (retval == JIM_DICT_SUGAR) {
4659 /* [dict] syntax sugar. */
4660 return JimDictSugarSet(interp, nameObjPtr, NULL);
4662 else if (retval == JIM_OK) {
4663 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4665 /* If it's a link call UnsetVariable recursively */
4666 if (varPtr->linkFramePtr) {
4667 framePtr = interp->framePtr;
4668 interp->framePtr = varPtr->linkFramePtr;
4669 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4670 interp->framePtr = framePtr;
4672 else {
4673 const char *name = Jim_String(nameObjPtr);
4674 if (nameObjPtr->internalRep.varValue.global) {
4675 name += 2;
4676 framePtr = interp->topFramePtr;
4678 else {
4679 framePtr = interp->framePtr;
4682 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4683 if (retval == JIM_OK) {
4684 /* Change the callframe id, invalidating var lookup caching */
4685 framePtr->id = interp->callFrameEpoch++;
4689 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4690 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4692 return retval;
4695 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4697 /* Given a variable name for [dict] operation syntax sugar,
4698 * this function returns two objects, the first with the name
4699 * of the variable to set, and the second with the respective key.
4700 * For example "foo(bar)" will return objects with string repr. of
4701 * "foo" and "bar".
4703 * The returned objects have refcount = 1. The function can't fail. */
4704 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4705 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4707 const char *str, *p;
4708 int len, keyLen;
4709 Jim_Obj *varObjPtr, *keyObjPtr;
4711 str = Jim_GetString(objPtr, &len);
4713 p = strchr(str, '(');
4714 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4716 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4718 p++;
4719 keyLen = (str + len) - p;
4720 if (str[len - 1] == ')') {
4721 keyLen--;
4724 /* Create the objects with the variable name and key. */
4725 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4727 Jim_IncrRefCount(varObjPtr);
4728 Jim_IncrRefCount(keyObjPtr);
4729 *varPtrPtr = varObjPtr;
4730 *keyPtrPtr = keyObjPtr;
4733 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4734 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4735 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4737 int err;
4739 SetDictSubstFromAny(interp, objPtr);
4741 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4742 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4744 if (err == JIM_OK) {
4745 /* Don't keep an extra ref to the result */
4746 Jim_SetEmptyResult(interp);
4748 else {
4749 if (!valObjPtr) {
4750 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4751 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4752 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4753 objPtr);
4754 return err;
4757 /* Make the error more informative and Tcl-compatible */
4758 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4759 (valObjPtr ? "set" : "unset"), objPtr);
4761 return err;
4765 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4767 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4768 * and stored back to the variable before expansion.
4770 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4771 Jim_Obj *keyObjPtr, int flags)
4773 Jim_Obj *dictObjPtr;
4774 Jim_Obj *resObjPtr = NULL;
4775 int ret;
4777 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4778 if (!dictObjPtr) {
4779 return NULL;
4782 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4783 if (ret != JIM_OK) {
4784 Jim_SetResultFormatted(interp,
4785 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4786 ret < 0 ? "variable isn't" : "no such element in");
4788 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4789 /* Update the variable to have an unshared copy */
4790 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4793 return resObjPtr;
4796 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4797 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4799 SetDictSubstFromAny(interp, objPtr);
4801 return JimDictExpandArrayVariable(interp,
4802 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4803 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4806 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4808 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4810 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4811 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4814 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4816 JIM_NOTUSED(interp);
4818 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4819 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4820 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4821 dupPtr->typePtr = &dictSubstObjType;
4824 /* Note: The object *must* be in dict-sugar format */
4825 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4827 if (objPtr->typePtr != &dictSubstObjType) {
4828 Jim_Obj *varObjPtr, *keyObjPtr;
4830 if (objPtr->typePtr == &interpolatedObjType) {
4831 /* An interpolated object in dict-sugar form */
4833 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4834 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4836 Jim_IncrRefCount(varObjPtr);
4837 Jim_IncrRefCount(keyObjPtr);
4839 else {
4840 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4843 Jim_FreeIntRep(interp, objPtr);
4844 objPtr->typePtr = &dictSubstObjType;
4845 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4846 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4850 /* This function is used to expand [dict get] sugar in the form
4851 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4852 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4853 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4854 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4855 * the [dict]ionary contained in variable VARNAME. */
4856 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4858 Jim_Obj *resObjPtr = NULL;
4859 Jim_Obj *substKeyObjPtr = NULL;
4861 SetDictSubstFromAny(interp, objPtr);
4863 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4864 &substKeyObjPtr, JIM_NONE)
4865 != JIM_OK) {
4866 return NULL;
4868 Jim_IncrRefCount(substKeyObjPtr);
4869 resObjPtr =
4870 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4871 substKeyObjPtr, 0);
4872 Jim_DecrRefCount(interp, substKeyObjPtr);
4874 return resObjPtr;
4877 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4879 Jim_Obj *resultObjPtr;
4881 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4882 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4883 resultObjPtr->refCount--;
4884 return resultObjPtr;
4886 return NULL;
4889 /* -----------------------------------------------------------------------------
4890 * CallFrame
4891 * ---------------------------------------------------------------------------*/
4893 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4895 Jim_CallFrame *cf;
4897 if (interp->freeFramesList) {
4898 cf = interp->freeFramesList;
4899 interp->freeFramesList = cf->next;
4901 cf->argv = NULL;
4902 cf->argc = 0;
4903 cf->procArgsObjPtr = NULL;
4904 cf->procBodyObjPtr = NULL;
4905 cf->next = NULL;
4906 cf->staticVars = NULL;
4907 cf->localCommands = NULL;
4908 cf->tailcallObj = NULL;
4909 cf->tailcallCmd = NULL;
4911 else {
4912 cf = Jim_Alloc(sizeof(*cf));
4913 memset(cf, 0, sizeof(*cf));
4915 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4918 cf->id = interp->callFrameEpoch++;
4919 cf->parent = parent;
4920 cf->level = parent ? parent->level + 1 : 0;
4921 cf->nsObj = nsObj;
4922 Jim_IncrRefCount(nsObj);
4924 return cf;
4927 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4929 /* Delete any local procs */
4930 if (localCommands) {
4931 Jim_Obj *cmdNameObj;
4933 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4934 Jim_HashEntry *he;
4935 Jim_Obj *fqObjName;
4936 Jim_HashTable *ht = &interp->commands;
4938 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4940 he = Jim_FindHashEntry(ht, fqname);
4942 if (he) {
4943 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4944 if (cmd->prevCmd) {
4945 Jim_Cmd *prevCmd = cmd->prevCmd;
4946 cmd->prevCmd = NULL;
4948 /* Delete the old command */
4949 JimDecrCmdRefCount(interp, cmd);
4951 /* And restore the original */
4952 Jim_SetHashVal(ht, he, prevCmd);
4954 else {
4955 Jim_DeleteHashEntry(ht, fqname);
4956 Jim_InterpIncrProcEpoch(interp);
4959 Jim_DecrRefCount(interp, cmdNameObj);
4960 JimFreeQualifiedName(interp, fqObjName);
4962 Jim_FreeStack(localCommands);
4963 Jim_Free(localCommands);
4965 return JIM_OK;
4969 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4970 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4971 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4973 JimDeleteLocalProcs(interp, cf->localCommands);
4975 if (cf->procArgsObjPtr)
4976 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4977 if (cf->procBodyObjPtr)
4978 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4979 Jim_DecrRefCount(interp, cf->nsObj);
4980 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4981 Jim_FreeHashTable(&cf->vars);
4982 else {
4983 int i;
4984 Jim_HashEntry **table = cf->vars.table, *he;
4986 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4987 he = table[i];
4988 while (he != NULL) {
4989 Jim_HashEntry *nextEntry = he->next;
4990 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
4992 Jim_DecrRefCount(interp, varPtr->objPtr);
4993 Jim_Free(Jim_GetHashEntryKey(he));
4994 Jim_Free(varPtr);
4995 Jim_Free(he);
4996 table[i] = NULL;
4997 he = nextEntry;
5000 cf->vars.used = 0;
5002 cf->next = interp->freeFramesList;
5003 interp->freeFramesList = cf;
5007 /* -----------------------------------------------------------------------------
5008 * References
5009 * ---------------------------------------------------------------------------*/
5010 #ifdef JIM_REFERENCES
5012 /* References HashTable Type.
5014 * Keys are unsigned long integers, dynamically allocated for now but in the
5015 * future it's worth to cache this 4 bytes objects. Values are pointers
5016 * to Jim_References. */
5017 static void JimReferencesHTValDestructor(void *interp, void *val)
5019 Jim_Reference *refPtr = (void *)val;
5021 Jim_DecrRefCount(interp, refPtr->objPtr);
5022 if (refPtr->finalizerCmdNamePtr != NULL) {
5023 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5025 Jim_Free(val);
5028 static unsigned int JimReferencesHTHashFunction(const void *key)
5030 /* Only the least significant bits are used. */
5031 const unsigned long *widePtr = key;
5032 unsigned int intValue = (unsigned int)*widePtr;
5034 return Jim_IntHashFunction(intValue);
5037 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5039 void *copy = Jim_Alloc(sizeof(unsigned long));
5041 JIM_NOTUSED(privdata);
5043 memcpy(copy, key, sizeof(unsigned long));
5044 return copy;
5047 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5049 JIM_NOTUSED(privdata);
5051 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5054 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5056 JIM_NOTUSED(privdata);
5058 Jim_Free(key);
5061 static const Jim_HashTableType JimReferencesHashTableType = {
5062 JimReferencesHTHashFunction, /* hash function */
5063 JimReferencesHTKeyDup, /* key dup */
5064 NULL, /* val dup */
5065 JimReferencesHTKeyCompare, /* key compare */
5066 JimReferencesHTKeyDestructor, /* key destructor */
5067 JimReferencesHTValDestructor /* val destructor */
5070 /* -----------------------------------------------------------------------------
5071 * Reference object type and References API
5072 * ---------------------------------------------------------------------------*/
5074 /* The string representation of references has two features in order
5075 * to make the GC faster. The first is that every reference starts
5076 * with a non common character '<', in order to make the string matching
5077 * faster. The second is that the reference string rep is 42 characters
5078 * in length, this means that it is not necessary to check any object with a string
5079 * repr < 42, and usually there aren't many of these objects. */
5081 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5083 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5085 const char *fmt = "<reference.<%s>.%020lu>";
5087 sprintf(buf, fmt, refPtr->tag, id);
5088 return JIM_REFERENCE_SPACE;
5091 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5093 static const Jim_ObjType referenceObjType = {
5094 "reference",
5095 NULL,
5096 NULL,
5097 UpdateStringOfReference,
5098 JIM_TYPE_REFERENCES,
5101 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5103 char buf[JIM_REFERENCE_SPACE + 1];
5105 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5106 JimSetStringBytes(objPtr, buf);
5109 /* returns true if 'c' is a valid reference tag character.
5110 * i.e. inside the range [_a-zA-Z0-9] */
5111 static int isrefchar(int c)
5113 return (c == '_' || isalnum(c));
5116 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5118 unsigned long value;
5119 int i, len;
5120 const char *str, *start, *end;
5121 char refId[21];
5122 Jim_Reference *refPtr;
5123 Jim_HashEntry *he;
5124 char *endptr;
5126 /* Get the string representation */
5127 str = Jim_GetString(objPtr, &len);
5128 /* Check if it looks like a reference */
5129 if (len < JIM_REFERENCE_SPACE)
5130 goto badformat;
5131 /* Trim spaces */
5132 start = str;
5133 end = str + len - 1;
5134 while (*start == ' ')
5135 start++;
5136 while (*end == ' ' && end > start)
5137 end--;
5138 if (end - start + 1 != JIM_REFERENCE_SPACE)
5139 goto badformat;
5140 /* <reference.<1234567>.%020> */
5141 if (memcmp(start, "<reference.<", 12) != 0)
5142 goto badformat;
5143 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5144 goto badformat;
5145 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5146 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5147 if (!isrefchar(start[12 + i]))
5148 goto badformat;
5150 /* Extract info from the reference. */
5151 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5152 refId[20] = '\0';
5153 /* Try to convert the ID into an unsigned long */
5154 value = strtoul(refId, &endptr, 10);
5155 if (JimCheckConversion(refId, endptr) != JIM_OK)
5156 goto badformat;
5157 /* Check if the reference really exists! */
5158 he = Jim_FindHashEntry(&interp->references, &value);
5159 if (he == NULL) {
5160 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5161 return JIM_ERR;
5163 refPtr = Jim_GetHashEntryVal(he);
5164 /* Free the old internal repr and set the new one. */
5165 Jim_FreeIntRep(interp, objPtr);
5166 objPtr->typePtr = &referenceObjType;
5167 objPtr->internalRep.refValue.id = value;
5168 objPtr->internalRep.refValue.refPtr = refPtr;
5169 return JIM_OK;
5171 badformat:
5172 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5173 return JIM_ERR;
5176 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5177 * as finalizer command (or NULL if there is no finalizer).
5178 * The returned reference object has refcount = 0. */
5179 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5181 struct Jim_Reference *refPtr;
5182 unsigned long id;
5183 Jim_Obj *refObjPtr;
5184 const char *tag;
5185 int tagLen, i;
5187 /* Perform the Garbage Collection if needed. */
5188 Jim_CollectIfNeeded(interp);
5190 refPtr = Jim_Alloc(sizeof(*refPtr));
5191 refPtr->objPtr = objPtr;
5192 Jim_IncrRefCount(objPtr);
5193 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5194 if (cmdNamePtr)
5195 Jim_IncrRefCount(cmdNamePtr);
5196 id = interp->referenceNextId++;
5197 Jim_AddHashEntry(&interp->references, &id, refPtr);
5198 refObjPtr = Jim_NewObj(interp);
5199 refObjPtr->typePtr = &referenceObjType;
5200 refObjPtr->bytes = NULL;
5201 refObjPtr->internalRep.refValue.id = id;
5202 refObjPtr->internalRep.refValue.refPtr = refPtr;
5203 interp->referenceNextId++;
5204 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5205 * that does not pass the 'isrefchar' test is replaced with '_' */
5206 tag = Jim_GetString(tagPtr, &tagLen);
5207 if (tagLen > JIM_REFERENCE_TAGLEN)
5208 tagLen = JIM_REFERENCE_TAGLEN;
5209 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5210 if (i < tagLen && isrefchar(tag[i]))
5211 refPtr->tag[i] = tag[i];
5212 else
5213 refPtr->tag[i] = '_';
5215 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5216 return refObjPtr;
5219 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5221 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5222 return NULL;
5223 return objPtr->internalRep.refValue.refPtr;
5226 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5228 Jim_Reference *refPtr;
5230 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5231 return JIM_ERR;
5232 Jim_IncrRefCount(cmdNamePtr);
5233 if (refPtr->finalizerCmdNamePtr)
5234 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5235 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5236 return JIM_OK;
5239 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5241 Jim_Reference *refPtr;
5243 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5244 return JIM_ERR;
5245 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5246 return JIM_OK;
5249 /* -----------------------------------------------------------------------------
5250 * References Garbage Collection
5251 * ---------------------------------------------------------------------------*/
5253 /* This the hash table type for the "MARK" phase of the GC */
5254 static const Jim_HashTableType JimRefMarkHashTableType = {
5255 JimReferencesHTHashFunction, /* hash function */
5256 JimReferencesHTKeyDup, /* key dup */
5257 NULL, /* val dup */
5258 JimReferencesHTKeyCompare, /* key compare */
5259 JimReferencesHTKeyDestructor, /* key destructor */
5260 NULL /* val destructor */
5263 /* Performs the garbage collection. */
5264 int Jim_Collect(Jim_Interp *interp)
5266 int collected = 0;
5267 #ifndef JIM_BOOTSTRAP
5268 Jim_HashTable marks;
5269 Jim_HashTableIterator htiter;
5270 Jim_HashEntry *he;
5271 Jim_Obj *objPtr;
5273 /* Avoid recursive calls */
5274 if (interp->lastCollectId == -1) {
5275 /* Jim_Collect() already running. Return just now. */
5276 return 0;
5278 interp->lastCollectId = -1;
5280 /* Mark all the references found into the 'mark' hash table.
5281 * The references are searched in every live object that
5282 * is of a type that can contain references. */
5283 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5284 objPtr = interp->liveList;
5285 while (objPtr) {
5286 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5287 const char *str, *p;
5288 int len;
5290 /* If the object is of type reference, to get the
5291 * Id is simple... */
5292 if (objPtr->typePtr == &referenceObjType) {
5293 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5294 #ifdef JIM_DEBUG_GC
5295 printf("MARK (reference): %d refcount: %d\n",
5296 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5297 #endif
5298 objPtr = objPtr->nextObjPtr;
5299 continue;
5301 /* Get the string repr of the object we want
5302 * to scan for references. */
5303 p = str = Jim_GetString(objPtr, &len);
5304 /* Skip objects too little to contain references. */
5305 if (len < JIM_REFERENCE_SPACE) {
5306 objPtr = objPtr->nextObjPtr;
5307 continue;
5309 /* Extract references from the object string repr. */
5310 while (1) {
5311 int i;
5312 unsigned long id;
5314 if ((p = strstr(p, "<reference.<")) == NULL)
5315 break;
5316 /* Check if it's a valid reference. */
5317 if (len - (p - str) < JIM_REFERENCE_SPACE)
5318 break;
5319 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5320 break;
5321 for (i = 21; i <= 40; i++)
5322 if (!isdigit(UCHAR(p[i])))
5323 break;
5324 /* Get the ID */
5325 id = strtoul(p + 21, NULL, 10);
5327 /* Ok, a reference for the given ID
5328 * was found. Mark it. */
5329 Jim_AddHashEntry(&marks, &id, NULL);
5330 #ifdef JIM_DEBUG_GC
5331 printf("MARK: %d\n", (int)id);
5332 #endif
5333 p += JIM_REFERENCE_SPACE;
5336 objPtr = objPtr->nextObjPtr;
5339 /* Run the references hash table to destroy every reference that
5340 * is not referenced outside (not present in the mark HT). */
5341 JimInitHashTableIterator(&interp->references, &htiter);
5342 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5343 const unsigned long *refId;
5344 Jim_Reference *refPtr;
5346 refId = he->key;
5347 /* Check if in the mark phase we encountered
5348 * this reference. */
5349 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5350 #ifdef JIM_DEBUG_GC
5351 printf("COLLECTING %d\n", (int)*refId);
5352 #endif
5353 collected++;
5354 /* Drop the reference, but call the
5355 * finalizer first if registered. */
5356 refPtr = Jim_GetHashEntryVal(he);
5357 if (refPtr->finalizerCmdNamePtr) {
5358 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5359 Jim_Obj *objv[3], *oldResult;
5361 JimFormatReference(refstr, refPtr, *refId);
5363 objv[0] = refPtr->finalizerCmdNamePtr;
5364 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5365 objv[2] = refPtr->objPtr;
5367 /* Drop the reference itself */
5368 /* Avoid the finaliser being freed here */
5369 Jim_IncrRefCount(objv[0]);
5370 /* Don't remove the reference from the hash table just yet
5371 * since that will free refPtr, and hence refPtr->objPtr
5374 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5375 oldResult = interp->result;
5376 Jim_IncrRefCount(oldResult);
5377 Jim_EvalObjVector(interp, 3, objv);
5378 Jim_SetResult(interp, oldResult);
5379 Jim_DecrRefCount(interp, oldResult);
5381 Jim_DecrRefCount(interp, objv[0]);
5383 Jim_DeleteHashEntry(&interp->references, refId);
5386 Jim_FreeHashTable(&marks);
5387 interp->lastCollectId = interp->referenceNextId;
5388 interp->lastCollectTime = time(NULL);
5389 #endif /* JIM_BOOTSTRAP */
5390 return collected;
5393 #define JIM_COLLECT_ID_PERIOD 5000
5394 #define JIM_COLLECT_TIME_PERIOD 300
5396 void Jim_CollectIfNeeded(Jim_Interp *interp)
5398 unsigned long elapsedId;
5399 int elapsedTime;
5401 elapsedId = interp->referenceNextId - interp->lastCollectId;
5402 elapsedTime = time(NULL) - interp->lastCollectTime;
5405 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5406 Jim_Collect(interp);
5409 #endif
5411 int Jim_IsBigEndian(void)
5413 union {
5414 unsigned short s;
5415 unsigned char c[2];
5416 } uval = {0x0102};
5418 return uval.c[0] == 1;
5421 /* -----------------------------------------------------------------------------
5422 * Interpreter related functions
5423 * ---------------------------------------------------------------------------*/
5425 Jim_Interp *Jim_CreateInterp(void)
5427 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5429 memset(i, 0, sizeof(*i));
5431 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5432 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5433 i->lastCollectTime = time(NULL);
5435 /* Note that we can create objects only after the
5436 * interpreter liveList and freeList pointers are
5437 * initialized to NULL. */
5438 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5439 #ifdef JIM_REFERENCES
5440 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5441 #endif
5442 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5443 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5444 i->emptyObj = Jim_NewEmptyStringObj(i);
5445 i->trueObj = Jim_NewIntObj(i, 1);
5446 i->falseObj = Jim_NewIntObj(i, 0);
5447 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5448 i->errorFileNameObj = i->emptyObj;
5449 i->result = i->emptyObj;
5450 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5451 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5452 i->errorProc = i->emptyObj;
5453 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5454 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5455 Jim_IncrRefCount(i->emptyObj);
5456 Jim_IncrRefCount(i->errorFileNameObj);
5457 Jim_IncrRefCount(i->result);
5458 Jim_IncrRefCount(i->stackTrace);
5459 Jim_IncrRefCount(i->unknown);
5460 Jim_IncrRefCount(i->currentScriptObj);
5461 Jim_IncrRefCount(i->nullScriptObj);
5462 Jim_IncrRefCount(i->errorProc);
5463 Jim_IncrRefCount(i->trueObj);
5464 Jim_IncrRefCount(i->falseObj);
5466 /* Initialize key variables every interpreter should contain */
5467 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5468 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5470 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5471 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5472 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5473 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5474 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5475 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5476 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5477 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5479 return i;
5482 void Jim_FreeInterp(Jim_Interp *i)
5484 Jim_CallFrame *cf, *cfx;
5486 Jim_Obj *objPtr, *nextObjPtr;
5488 /* Free the active call frames list - must be done before i->commands is destroyed */
5489 for (cf = i->framePtr; cf; cf = cfx) {
5490 cfx = cf->parent;
5491 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5494 Jim_DecrRefCount(i, i->emptyObj);
5495 Jim_DecrRefCount(i, i->trueObj);
5496 Jim_DecrRefCount(i, i->falseObj);
5497 Jim_DecrRefCount(i, i->result);
5498 Jim_DecrRefCount(i, i->stackTrace);
5499 Jim_DecrRefCount(i, i->errorProc);
5500 Jim_DecrRefCount(i, i->unknown);
5501 Jim_DecrRefCount(i, i->errorFileNameObj);
5502 Jim_DecrRefCount(i, i->currentScriptObj);
5503 Jim_DecrRefCount(i, i->nullScriptObj);
5504 Jim_FreeHashTable(&i->commands);
5505 #ifdef JIM_REFERENCES
5506 Jim_FreeHashTable(&i->references);
5507 #endif
5508 Jim_FreeHashTable(&i->packages);
5509 Jim_Free(i->prngState);
5510 Jim_FreeHashTable(&i->assocData);
5512 /* Check that the live object list is empty, otherwise
5513 * there is a memory leak. */
5514 #ifdef JIM_MAINTAINER
5515 if (i->liveList != NULL) {
5516 objPtr = i->liveList;
5518 printf("\n-------------------------------------\n");
5519 printf("Objects still in the free list:\n");
5520 while (objPtr) {
5521 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5523 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5524 printf("%p (%d) %-10s: '%.20s...'\n",
5525 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5527 else {
5528 printf("%p (%d) %-10s: '%s'\n",
5529 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5531 if (objPtr->typePtr == &sourceObjType) {
5532 printf("FILE %s LINE %d\n",
5533 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5534 objPtr->internalRep.sourceValue.lineNumber);
5536 objPtr = objPtr->nextObjPtr;
5538 printf("-------------------------------------\n\n");
5539 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5541 #endif
5543 /* Free all the freed objects. */
5544 objPtr = i->freeList;
5545 while (objPtr) {
5546 nextObjPtr = objPtr->nextObjPtr;
5547 Jim_Free(objPtr);
5548 objPtr = nextObjPtr;
5551 /* Free the free call frames list */
5552 for (cf = i->freeFramesList; cf; cf = cfx) {
5553 cfx = cf->next;
5554 if (cf->vars.table)
5555 Jim_FreeHashTable(&cf->vars);
5556 Jim_Free(cf);
5559 /* Free the interpreter structure. */
5560 Jim_Free(i);
5563 /* Returns the call frame relative to the level represented by
5564 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5566 * This function accepts the 'level' argument in the form
5567 * of the commands [uplevel] and [upvar].
5569 * Returns NULL on error.
5571 * Note: for a function accepting a relative integer as level suitable
5572 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5574 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5576 long level;
5577 const char *str;
5578 Jim_CallFrame *framePtr;
5580 if (levelObjPtr) {
5581 str = Jim_String(levelObjPtr);
5582 if (str[0] == '#') {
5583 char *endptr;
5585 level = jim_strtol(str + 1, &endptr);
5586 if (str[1] == '\0' || endptr[0] != '\0') {
5587 level = -1;
5590 else {
5591 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5592 level = -1;
5594 else {
5595 /* Convert from a relative to an absolute level */
5596 level = interp->framePtr->level - level;
5600 else {
5601 str = "1"; /* Needed to format the error message. */
5602 level = interp->framePtr->level - 1;
5605 if (level == 0) {
5606 return interp->topFramePtr;
5608 if (level > 0) {
5609 /* Lookup */
5610 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5611 if (framePtr->level == level) {
5612 return framePtr;
5617 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5618 return NULL;
5621 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5622 * as a relative integer like in the [info level ?level?] command.
5624 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5626 long level;
5627 Jim_CallFrame *framePtr;
5629 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5630 if (level <= 0) {
5631 /* Convert from a relative to an absolute level */
5632 level = interp->framePtr->level + level;
5635 if (level == 0) {
5636 return interp->topFramePtr;
5639 /* Lookup */
5640 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5641 if (framePtr->level == level) {
5642 return framePtr;
5647 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5648 return NULL;
5651 static void JimResetStackTrace(Jim_Interp *interp)
5653 Jim_DecrRefCount(interp, interp->stackTrace);
5654 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5655 Jim_IncrRefCount(interp->stackTrace);
5658 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5660 int len;
5662 /* Increment reference first in case these are the same object */
5663 Jim_IncrRefCount(stackTraceObj);
5664 Jim_DecrRefCount(interp, interp->stackTrace);
5665 interp->stackTrace = stackTraceObj;
5666 interp->errorFlag = 1;
5668 /* This is a bit ugly.
5669 * If the filename of the last entry of the stack trace is empty,
5670 * the next stack level should be added.
5672 len = Jim_ListLength(interp, interp->stackTrace);
5673 if (len >= 3) {
5674 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5675 interp->addStackTrace = 1;
5680 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5681 Jim_Obj *fileNameObj, int linenr)
5683 if (strcmp(procname, "unknown") == 0) {
5684 procname = "";
5686 if (!*procname && !Jim_Length(fileNameObj)) {
5687 /* No useful info here */
5688 return;
5691 if (Jim_IsShared(interp->stackTrace)) {
5692 Jim_DecrRefCount(interp, interp->stackTrace);
5693 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5694 Jim_IncrRefCount(interp->stackTrace);
5697 /* If we have no procname but the previous element did, merge with that frame */
5698 if (!*procname && Jim_Length(fileNameObj)) {
5699 /* Just a filename. Check the previous entry */
5700 int len = Jim_ListLength(interp, interp->stackTrace);
5702 if (len >= 3) {
5703 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5704 if (Jim_Length(objPtr)) {
5705 /* Yes, the previous level had procname */
5706 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5707 if (Jim_Length(objPtr) == 0) {
5708 /* But no filename, so merge the new info with that frame */
5709 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5710 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5711 return;
5717 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5718 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5719 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5722 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5723 void *data)
5725 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5727 assocEntryPtr->delProc = delProc;
5728 assocEntryPtr->data = data;
5729 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5732 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5734 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5736 if (entryPtr != NULL) {
5737 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5738 return assocEntryPtr->data;
5740 return NULL;
5743 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5745 return Jim_DeleteHashEntry(&interp->assocData, key);
5748 int Jim_GetExitCode(Jim_Interp *interp)
5750 return interp->exitCode;
5753 /* -----------------------------------------------------------------------------
5754 * Integer object
5755 * ---------------------------------------------------------------------------*/
5756 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5757 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5759 static const Jim_ObjType intObjType = {
5760 "int",
5761 NULL,
5762 NULL,
5763 UpdateStringOfInt,
5764 JIM_TYPE_NONE,
5767 /* A coerced double is closer to an int than a double.
5768 * It is an int value temporarily masquerading as a double value.
5769 * i.e. it has the same string value as an int and Jim_GetWide()
5770 * succeeds, but also Jim_GetDouble() returns the value directly.
5772 static const Jim_ObjType coercedDoubleObjType = {
5773 "coerced-double",
5774 NULL,
5775 NULL,
5776 UpdateStringOfInt,
5777 JIM_TYPE_NONE,
5781 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5783 char buf[JIM_INTEGER_SPACE + 1];
5784 jim_wide wideValue = JimWideValue(objPtr);
5785 int pos = 0;
5787 if (wideValue == 0) {
5788 buf[pos++] = '0';
5790 else {
5791 char tmp[JIM_INTEGER_SPACE];
5792 int num = 0;
5793 int i;
5795 if (wideValue < 0) {
5796 buf[pos++] = '-';
5797 i = wideValue % 10;
5798 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5799 * whereas C99 is always -6
5800 * coverity[dead_error_line]
5802 tmp[num++] = (i > 0) ? (10 - i) : -i;
5803 wideValue /= -10;
5806 while (wideValue) {
5807 tmp[num++] = wideValue % 10;
5808 wideValue /= 10;
5811 for (i = 0; i < num; i++) {
5812 buf[pos++] = '0' + tmp[num - i - 1];
5815 buf[pos] = 0;
5817 JimSetStringBytes(objPtr, buf);
5820 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5822 jim_wide wideValue;
5823 const char *str;
5825 if (objPtr->typePtr == &coercedDoubleObjType) {
5826 /* Simple switch */
5827 objPtr->typePtr = &intObjType;
5828 return JIM_OK;
5831 /* Get the string representation */
5832 str = Jim_String(objPtr);
5833 /* Try to convert into a jim_wide */
5834 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5835 if (flags & JIM_ERRMSG) {
5836 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5838 return JIM_ERR;
5840 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5841 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5842 return JIM_ERR;
5844 /* Free the old internal repr and set the new one. */
5845 Jim_FreeIntRep(interp, objPtr);
5846 objPtr->typePtr = &intObjType;
5847 objPtr->internalRep.wideValue = wideValue;
5848 return JIM_OK;
5851 #ifdef JIM_OPTIMIZATION
5852 static int JimIsWide(Jim_Obj *objPtr)
5854 return objPtr->typePtr == &intObjType;
5856 #endif
5858 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5860 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5861 return JIM_ERR;
5862 *widePtr = JimWideValue(objPtr);
5863 return JIM_OK;
5866 /* Get a wide but does not set an error if the format is bad. */
5867 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5869 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5870 return JIM_ERR;
5871 *widePtr = JimWideValue(objPtr);
5872 return JIM_OK;
5875 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5877 jim_wide wideValue;
5878 int retval;
5880 retval = Jim_GetWide(interp, objPtr, &wideValue);
5881 if (retval == JIM_OK) {
5882 *longPtr = (long)wideValue;
5883 return JIM_OK;
5885 return JIM_ERR;
5888 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5890 Jim_Obj *objPtr;
5892 objPtr = Jim_NewObj(interp);
5893 objPtr->typePtr = &intObjType;
5894 objPtr->bytes = NULL;
5895 objPtr->internalRep.wideValue = wideValue;
5896 return objPtr;
5899 /* -----------------------------------------------------------------------------
5900 * Double object
5901 * ---------------------------------------------------------------------------*/
5902 #define JIM_DOUBLE_SPACE 30
5904 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5905 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5907 static const Jim_ObjType doubleObjType = {
5908 "double",
5909 NULL,
5910 NULL,
5911 UpdateStringOfDouble,
5912 JIM_TYPE_NONE,
5915 #ifndef HAVE_ISNAN
5916 #undef isnan
5917 #define isnan(X) ((X) != (X))
5918 #endif
5919 #ifndef HAVE_ISINF
5920 #undef isinf
5921 #define isinf(X) (1.0 / (X) == 0.0)
5922 #endif
5924 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5926 double value = objPtr->internalRep.doubleValue;
5928 if (isnan(value)) {
5929 JimSetStringBytes(objPtr, "NaN");
5930 return;
5932 if (isinf(value)) {
5933 if (value < 0) {
5934 JimSetStringBytes(objPtr, "-Inf");
5936 else {
5937 JimSetStringBytes(objPtr, "Inf");
5939 return;
5942 char buf[JIM_DOUBLE_SPACE + 1];
5943 int i;
5944 int len = sprintf(buf, "%.12g", value);
5946 /* Add a final ".0" if necessary */
5947 for (i = 0; i < len; i++) {
5948 if (buf[i] == '.' || buf[i] == 'e') {
5949 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5950 /* If 'buf' ends in e-0nn or e+0nn, remove
5951 * the 0 after the + or - and reduce the length by 1
5953 char *e = strchr(buf, 'e');
5954 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5955 /* Move it up */
5956 e += 2;
5957 memmove(e, e + 1, len - (e - buf));
5959 #endif
5960 break;
5963 if (buf[i] == '\0') {
5964 buf[i++] = '.';
5965 buf[i++] = '0';
5966 buf[i] = '\0';
5968 JimSetStringBytes(objPtr, buf);
5972 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5974 double doubleValue;
5975 jim_wide wideValue;
5976 const char *str;
5978 /* Preserve the string representation.
5979 * Needed so we can convert back to int without loss
5981 str = Jim_String(objPtr);
5983 #ifdef HAVE_LONG_LONG
5984 /* Assume a 53 bit mantissa */
5985 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5986 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5988 if (objPtr->typePtr == &intObjType
5989 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5990 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5992 /* Direct conversion to coerced double */
5993 objPtr->typePtr = &coercedDoubleObjType;
5994 return JIM_OK;
5996 else
5997 #endif
5998 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5999 /* Managed to convert to an int, so we can use this as a cooerced double */
6000 Jim_FreeIntRep(interp, objPtr);
6001 objPtr->typePtr = &coercedDoubleObjType;
6002 objPtr->internalRep.wideValue = wideValue;
6003 return JIM_OK;
6005 else {
6006 /* Try to convert into a double */
6007 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6008 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6009 return JIM_ERR;
6011 /* Free the old internal repr and set the new one. */
6012 Jim_FreeIntRep(interp, objPtr);
6014 objPtr->typePtr = &doubleObjType;
6015 objPtr->internalRep.doubleValue = doubleValue;
6016 return JIM_OK;
6019 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6021 if (objPtr->typePtr == &coercedDoubleObjType) {
6022 *doublePtr = JimWideValue(objPtr);
6023 return JIM_OK;
6025 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6026 return JIM_ERR;
6028 if (objPtr->typePtr == &coercedDoubleObjType) {
6029 *doublePtr = JimWideValue(objPtr);
6031 else {
6032 *doublePtr = objPtr->internalRep.doubleValue;
6034 return JIM_OK;
6037 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6039 Jim_Obj *objPtr;
6041 objPtr = Jim_NewObj(interp);
6042 objPtr->typePtr = &doubleObjType;
6043 objPtr->bytes = NULL;
6044 objPtr->internalRep.doubleValue = doubleValue;
6045 return objPtr;
6048 /* -----------------------------------------------------------------------------
6049 * List object
6050 * ---------------------------------------------------------------------------*/
6051 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6052 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6053 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6054 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6055 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6056 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6058 /* Note that while the elements of the list may contain references,
6059 * the list object itself can't. This basically means that the
6060 * list object string representation as a whole can't contain references
6061 * that are not presents in the single elements. */
6062 static const Jim_ObjType listObjType = {
6063 "list",
6064 FreeListInternalRep,
6065 DupListInternalRep,
6066 UpdateStringOfList,
6067 JIM_TYPE_NONE,
6070 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6072 int i;
6074 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6075 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6077 Jim_Free(objPtr->internalRep.listValue.ele);
6080 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6082 int i;
6084 JIM_NOTUSED(interp);
6086 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6087 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6088 dupPtr->internalRep.listValue.ele =
6089 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6090 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6091 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6092 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6093 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6095 dupPtr->typePtr = &listObjType;
6098 /* The following function checks if a given string can be encoded
6099 * into a list element without any kind of quoting, surrounded by braces,
6100 * or using escapes to quote. */
6101 #define JIM_ELESTR_SIMPLE 0
6102 #define JIM_ELESTR_BRACE 1
6103 #define JIM_ELESTR_QUOTE 2
6104 static unsigned char ListElementQuotingType(const char *s, int len)
6106 int i, level, blevel, trySimple = 1;
6108 /* Try with the SIMPLE case */
6109 if (len == 0)
6110 return JIM_ELESTR_BRACE;
6111 if (s[0] == '"' || s[0] == '{') {
6112 trySimple = 0;
6113 goto testbrace;
6115 for (i = 0; i < len; i++) {
6116 switch (s[i]) {
6117 case ' ':
6118 case '$':
6119 case '"':
6120 case '[':
6121 case ']':
6122 case ';':
6123 case '\\':
6124 case '\r':
6125 case '\n':
6126 case '\t':
6127 case '\f':
6128 case '\v':
6129 trySimple = 0;
6130 /* fall through */
6131 case '{':
6132 case '}':
6133 goto testbrace;
6136 return JIM_ELESTR_SIMPLE;
6138 testbrace:
6139 /* Test if it's possible to do with braces */
6140 if (s[len - 1] == '\\')
6141 return JIM_ELESTR_QUOTE;
6142 level = 0;
6143 blevel = 0;
6144 for (i = 0; i < len; i++) {
6145 switch (s[i]) {
6146 case '{':
6147 level++;
6148 break;
6149 case '}':
6150 level--;
6151 if (level < 0)
6152 return JIM_ELESTR_QUOTE;
6153 break;
6154 case '[':
6155 blevel++;
6156 break;
6157 case ']':
6158 blevel--;
6159 break;
6160 case '\\':
6161 if (s[i + 1] == '\n')
6162 return JIM_ELESTR_QUOTE;
6163 else if (s[i + 1] != '\0')
6164 i++;
6165 break;
6168 if (blevel < 0) {
6169 return JIM_ELESTR_QUOTE;
6172 if (level == 0) {
6173 if (!trySimple)
6174 return JIM_ELESTR_BRACE;
6175 for (i = 0; i < len; i++) {
6176 switch (s[i]) {
6177 case ' ':
6178 case '$':
6179 case '"':
6180 case '[':
6181 case ']':
6182 case ';':
6183 case '\\':
6184 case '\r':
6185 case '\n':
6186 case '\t':
6187 case '\f':
6188 case '\v':
6189 return JIM_ELESTR_BRACE;
6190 break;
6193 return JIM_ELESTR_SIMPLE;
6195 return JIM_ELESTR_QUOTE;
6198 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6199 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6200 * scenario.
6201 * Returns the length of the result.
6203 static int BackslashQuoteString(const char *s, int len, char *q)
6205 char *p = q;
6207 while (len--) {
6208 switch (*s) {
6209 case ' ':
6210 case '$':
6211 case '"':
6212 case '[':
6213 case ']':
6214 case '{':
6215 case '}':
6216 case ';':
6217 case '\\':
6218 *p++ = '\\';
6219 *p++ = *s++;
6220 break;
6221 case '\n':
6222 *p++ = '\\';
6223 *p++ = 'n';
6224 s++;
6225 break;
6226 case '\r':
6227 *p++ = '\\';
6228 *p++ = 'r';
6229 s++;
6230 break;
6231 case '\t':
6232 *p++ = '\\';
6233 *p++ = 't';
6234 s++;
6235 break;
6236 case '\f':
6237 *p++ = '\\';
6238 *p++ = 'f';
6239 s++;
6240 break;
6241 case '\v':
6242 *p++ = '\\';
6243 *p++ = 'v';
6244 s++;
6245 break;
6246 default:
6247 *p++ = *s++;
6248 break;
6251 *p = '\0';
6253 return p - q;
6256 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6258 #define STATIC_QUOTING_LEN 32
6259 int i, bufLen, realLength;
6260 const char *strRep;
6261 char *p;
6262 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6264 /* Estimate the space needed. */
6265 if (objc > STATIC_QUOTING_LEN) {
6266 quotingType = Jim_Alloc(objc);
6268 else {
6269 quotingType = staticQuoting;
6271 bufLen = 0;
6272 for (i = 0; i < objc; i++) {
6273 int len;
6275 strRep = Jim_GetString(objv[i], &len);
6276 quotingType[i] = ListElementQuotingType(strRep, len);
6277 switch (quotingType[i]) {
6278 case JIM_ELESTR_SIMPLE:
6279 if (i != 0 || strRep[0] != '#') {
6280 bufLen += len;
6281 break;
6283 /* Special case '#' on first element needs braces */
6284 quotingType[i] = JIM_ELESTR_BRACE;
6285 /* fall through */
6286 case JIM_ELESTR_BRACE:
6287 bufLen += len + 2;
6288 break;
6289 case JIM_ELESTR_QUOTE:
6290 bufLen += len * 2;
6291 break;
6293 bufLen++; /* elements separator. */
6295 bufLen++;
6297 /* Generate the string rep. */
6298 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6299 realLength = 0;
6300 for (i = 0; i < objc; i++) {
6301 int len, qlen;
6303 strRep = Jim_GetString(objv[i], &len);
6305 switch (quotingType[i]) {
6306 case JIM_ELESTR_SIMPLE:
6307 memcpy(p, strRep, len);
6308 p += len;
6309 realLength += len;
6310 break;
6311 case JIM_ELESTR_BRACE:
6312 *p++ = '{';
6313 memcpy(p, strRep, len);
6314 p += len;
6315 *p++ = '}';
6316 realLength += len + 2;
6317 break;
6318 case JIM_ELESTR_QUOTE:
6319 if (i == 0 && strRep[0] == '#') {
6320 *p++ = '\\';
6321 realLength++;
6323 qlen = BackslashQuoteString(strRep, len, p);
6324 p += qlen;
6325 realLength += qlen;
6326 break;
6328 /* Add a separating space */
6329 if (i + 1 != objc) {
6330 *p++ = ' ';
6331 realLength++;
6334 *p = '\0'; /* nul term. */
6335 objPtr->length = realLength;
6337 if (quotingType != staticQuoting) {
6338 Jim_Free(quotingType);
6342 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6344 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6347 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6349 struct JimParserCtx parser;
6350 const char *str;
6351 int strLen;
6352 Jim_Obj *fileNameObj;
6353 int linenr;
6355 if (objPtr->typePtr == &listObjType) {
6356 return JIM_OK;
6359 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6360 * it also preserves any source location of the dict elements
6361 * which can be very useful
6363 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6364 Jim_Obj **listObjPtrPtr;
6365 int len;
6366 int i;
6368 listObjPtrPtr = JimDictPairs(objPtr, &len);
6369 for (i = 0; i < len; i++) {
6370 Jim_IncrRefCount(listObjPtrPtr[i]);
6373 /* Now just switch the internal rep */
6374 Jim_FreeIntRep(interp, objPtr);
6375 objPtr->typePtr = &listObjType;
6376 objPtr->internalRep.listValue.len = len;
6377 objPtr->internalRep.listValue.maxLen = len;
6378 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6380 return JIM_OK;
6383 /* Try to preserve information about filename / line number */
6384 if (objPtr->typePtr == &sourceObjType) {
6385 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6386 linenr = objPtr->internalRep.sourceValue.lineNumber;
6388 else {
6389 fileNameObj = interp->emptyObj;
6390 linenr = 1;
6392 Jim_IncrRefCount(fileNameObj);
6394 /* Get the string representation */
6395 str = Jim_GetString(objPtr, &strLen);
6397 /* Free the old internal repr just now and initialize the
6398 * new one just now. The string->list conversion can't fail. */
6399 Jim_FreeIntRep(interp, objPtr);
6400 objPtr->typePtr = &listObjType;
6401 objPtr->internalRep.listValue.len = 0;
6402 objPtr->internalRep.listValue.maxLen = 0;
6403 objPtr->internalRep.listValue.ele = NULL;
6405 /* Convert into a list */
6406 if (strLen) {
6407 JimParserInit(&parser, str, strLen, linenr);
6408 while (!parser.eof) {
6409 Jim_Obj *elementPtr;
6411 JimParseList(&parser);
6412 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6413 continue;
6414 elementPtr = JimParserGetTokenObj(interp, &parser);
6415 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6416 ListAppendElement(objPtr, elementPtr);
6419 Jim_DecrRefCount(interp, fileNameObj);
6420 return JIM_OK;
6423 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6425 Jim_Obj *objPtr;
6427 objPtr = Jim_NewObj(interp);
6428 objPtr->typePtr = &listObjType;
6429 objPtr->bytes = NULL;
6430 objPtr->internalRep.listValue.ele = NULL;
6431 objPtr->internalRep.listValue.len = 0;
6432 objPtr->internalRep.listValue.maxLen = 0;
6434 if (len) {
6435 ListInsertElements(objPtr, 0, len, elements);
6438 return objPtr;
6441 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6442 * length of the vector. Note that the user of this function should make
6443 * sure that the list object can't shimmer while the vector returned
6444 * is in use, this vector is the one stored inside the internal representation
6445 * of the list object. This function is not exported, extensions should
6446 * always access to the List object elements using Jim_ListIndex(). */
6447 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6448 Jim_Obj ***listVec)
6450 *listLen = Jim_ListLength(interp, listObj);
6451 *listVec = listObj->internalRep.listValue.ele;
6454 /* Sorting uses ints, but commands may return wide */
6455 static int JimSign(jim_wide w)
6457 if (w == 0) {
6458 return 0;
6460 else if (w < 0) {
6461 return -1;
6463 return 1;
6466 /* ListSortElements type values */
6467 struct lsort_info {
6468 jmp_buf jmpbuf;
6469 Jim_Obj *command;
6470 Jim_Interp *interp;
6471 enum {
6472 JIM_LSORT_ASCII,
6473 JIM_LSORT_NOCASE,
6474 JIM_LSORT_INTEGER,
6475 JIM_LSORT_REAL,
6476 JIM_LSORT_COMMAND
6477 } type;
6478 int order;
6479 int index;
6480 int indexed;
6481 int unique;
6482 int (*subfn)(Jim_Obj **, Jim_Obj **);
6485 static struct lsort_info *sort_info;
6487 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6489 Jim_Obj *lObj, *rObj;
6491 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6492 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6493 longjmp(sort_info->jmpbuf, JIM_ERR);
6495 return sort_info->subfn(&lObj, &rObj);
6498 /* Sort the internal rep of a list. */
6499 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6501 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6504 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6506 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6509 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6511 jim_wide lhs = 0, rhs = 0;
6513 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6514 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6515 longjmp(sort_info->jmpbuf, JIM_ERR);
6518 return JimSign(lhs - rhs) * sort_info->order;
6521 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6523 double lhs = 0, rhs = 0;
6525 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6526 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6527 longjmp(sort_info->jmpbuf, JIM_ERR);
6529 if (lhs == rhs) {
6530 return 0;
6532 if (lhs > rhs) {
6533 return sort_info->order;
6535 return -sort_info->order;
6538 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6540 Jim_Obj *compare_script;
6541 int rc;
6543 jim_wide ret = 0;
6545 /* This must be a valid list */
6546 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6547 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6548 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6550 rc = Jim_EvalObj(sort_info->interp, compare_script);
6552 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6553 longjmp(sort_info->jmpbuf, rc);
6556 return JimSign(ret) * sort_info->order;
6559 /* Remove duplicate elements from the (sorted) list in-place, according to the
6560 * comparison function, comp.
6562 * Note that the last unique value is kept, not the first
6564 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6566 int src;
6567 int dst = 0;
6568 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6570 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6571 if (comp(&ele[dst], &ele[src]) == 0) {
6572 /* Match, so replace the dest with the current source */
6573 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6575 else {
6576 /* No match, so keep the current source and move to the next destination */
6577 dst++;
6579 ele[dst] = ele[src];
6581 /* At end of list, keep the final element */
6582 ele[++dst] = ele[src];
6584 /* Set the new length */
6585 listObjPtr->internalRep.listValue.len = dst;
6588 /* Sort a list *in place*. MUST be called with a non-shared list. */
6589 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6591 struct lsort_info *prev_info;
6593 typedef int (qsort_comparator) (const void *, const void *);
6594 int (*fn) (Jim_Obj **, Jim_Obj **);
6595 Jim_Obj **vector;
6596 int len;
6597 int rc;
6599 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6600 SetListFromAny(interp, listObjPtr);
6602 /* Allow lsort to be called reentrantly */
6603 prev_info = sort_info;
6604 sort_info = info;
6606 vector = listObjPtr->internalRep.listValue.ele;
6607 len = listObjPtr->internalRep.listValue.len;
6608 switch (info->type) {
6609 case JIM_LSORT_ASCII:
6610 fn = ListSortString;
6611 break;
6612 case JIM_LSORT_NOCASE:
6613 fn = ListSortStringNoCase;
6614 break;
6615 case JIM_LSORT_INTEGER:
6616 fn = ListSortInteger;
6617 break;
6618 case JIM_LSORT_REAL:
6619 fn = ListSortReal;
6620 break;
6621 case JIM_LSORT_COMMAND:
6622 fn = ListSortCommand;
6623 break;
6624 default:
6625 fn = NULL; /* avoid warning */
6626 JimPanic((1, "ListSort called with invalid sort type"));
6627 return -1; /* Should not be run but keeps static analysers happy */
6630 if (info->indexed) {
6631 /* Need to interpose a "list index" function */
6632 info->subfn = fn;
6633 fn = ListSortIndexHelper;
6636 if ((rc = setjmp(info->jmpbuf)) == 0) {
6637 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6639 if (info->unique && len > 1) {
6640 ListRemoveDuplicates(listObjPtr, fn);
6643 Jim_InvalidateStringRep(listObjPtr);
6645 sort_info = prev_info;
6647 return rc;
6650 /* This is the low-level function to insert elements into a list.
6651 * The higher-level Jim_ListInsertElements() performs shared object
6652 * check and invalidates the string repr. This version is used
6653 * in the internals of the List Object and is not exported.
6655 * NOTE: this function can be called only against objects
6656 * with internal type of List.
6658 * An insertion point (idx) of -1 means end-of-list.
6660 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6662 int currentLen = listPtr->internalRep.listValue.len;
6663 int requiredLen = currentLen + elemc;
6664 int i;
6665 Jim_Obj **point;
6667 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6668 if (requiredLen < 2) {
6669 /* Don't do allocations of under 4 pointers. */
6670 requiredLen = 4;
6672 else {
6673 requiredLen *= 2;
6676 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6677 sizeof(Jim_Obj *) * requiredLen);
6679 listPtr->internalRep.listValue.maxLen = requiredLen;
6681 if (idx < 0) {
6682 idx = currentLen;
6684 point = listPtr->internalRep.listValue.ele + idx;
6685 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6686 for (i = 0; i < elemc; ++i) {
6687 point[i] = elemVec[i];
6688 Jim_IncrRefCount(point[i]);
6690 listPtr->internalRep.listValue.len += elemc;
6693 /* Convenience call to ListInsertElements() to append a single element.
6695 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6697 ListInsertElements(listPtr, -1, 1, &objPtr);
6700 /* Appends every element of appendListPtr into listPtr.
6701 * Both have to be of the list type.
6702 * Convenience call to ListInsertElements()
6704 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6706 ListInsertElements(listPtr, -1,
6707 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6710 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6712 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6713 SetListFromAny(interp, listPtr);
6714 Jim_InvalidateStringRep(listPtr);
6715 ListAppendElement(listPtr, objPtr);
6718 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6720 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6721 SetListFromAny(interp, listPtr);
6722 SetListFromAny(interp, appendListPtr);
6723 Jim_InvalidateStringRep(listPtr);
6724 ListAppendList(listPtr, appendListPtr);
6727 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6729 SetListFromAny(interp, objPtr);
6730 return objPtr->internalRep.listValue.len;
6733 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6734 int objc, Jim_Obj *const *objVec)
6736 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6737 SetListFromAny(interp, listPtr);
6738 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6739 idx = listPtr->internalRep.listValue.len;
6740 else if (idx < 0)
6741 idx = 0;
6742 Jim_InvalidateStringRep(listPtr);
6743 ListInsertElements(listPtr, idx, objc, objVec);
6746 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6748 SetListFromAny(interp, listPtr);
6749 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6750 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6751 return NULL;
6753 if (idx < 0)
6754 idx = listPtr->internalRep.listValue.len + idx;
6755 return listPtr->internalRep.listValue.ele[idx];
6758 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6760 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6761 if (*objPtrPtr == NULL) {
6762 if (flags & JIM_ERRMSG) {
6763 Jim_SetResultString(interp, "list index out of range", -1);
6765 return JIM_ERR;
6767 return JIM_OK;
6770 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6771 Jim_Obj *newObjPtr, int flags)
6773 SetListFromAny(interp, listPtr);
6774 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6775 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6776 if (flags & JIM_ERRMSG) {
6777 Jim_SetResultString(interp, "list index out of range", -1);
6779 return JIM_ERR;
6781 if (idx < 0)
6782 idx = listPtr->internalRep.listValue.len + idx;
6783 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6784 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6785 Jim_IncrRefCount(newObjPtr);
6786 return JIM_OK;
6789 /* Modify the list stored in the variable named 'varNamePtr'
6790 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6791 * with the new element 'newObjptr'. (implements the [lset] command) */
6792 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6793 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6795 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6796 int shared, i, idx;
6798 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6799 if (objPtr == NULL)
6800 return JIM_ERR;
6801 if ((shared = Jim_IsShared(objPtr)))
6802 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6803 for (i = 0; i < indexc - 1; i++) {
6804 listObjPtr = objPtr;
6805 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6806 goto err;
6807 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6808 goto err;
6810 if (Jim_IsShared(objPtr)) {
6811 objPtr = Jim_DuplicateObj(interp, objPtr);
6812 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6814 Jim_InvalidateStringRep(listObjPtr);
6816 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6817 goto err;
6818 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6819 goto err;
6820 Jim_InvalidateStringRep(objPtr);
6821 Jim_InvalidateStringRep(varObjPtr);
6822 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6823 goto err;
6824 Jim_SetResult(interp, varObjPtr);
6825 return JIM_OK;
6826 err:
6827 if (shared) {
6828 Jim_FreeNewObj(interp, varObjPtr);
6830 return JIM_ERR;
6833 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6835 int i;
6836 int listLen = Jim_ListLength(interp, listObjPtr);
6837 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6839 for (i = 0; i < listLen; ) {
6840 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6841 if (++i != listLen) {
6842 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6845 return resObjPtr;
6848 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6850 int i;
6852 /* If all the objects in objv are lists,
6853 * it's possible to return a list as result, that's the
6854 * concatenation of all the lists. */
6855 for (i = 0; i < objc; i++) {
6856 if (!Jim_IsList(objv[i]))
6857 break;
6859 if (i == objc) {
6860 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6862 for (i = 0; i < objc; i++)
6863 ListAppendList(objPtr, objv[i]);
6864 return objPtr;
6866 else {
6867 /* Else... we have to glue strings together */
6868 int len = 0, objLen;
6869 char *bytes, *p;
6871 /* Compute the length */
6872 for (i = 0; i < objc; i++) {
6873 len += Jim_Length(objv[i]);
6875 if (objc)
6876 len += objc - 1;
6877 /* Create the string rep, and a string object holding it. */
6878 p = bytes = Jim_Alloc(len + 1);
6879 for (i = 0; i < objc; i++) {
6880 const char *s = Jim_GetString(objv[i], &objLen);
6882 /* Remove leading space */
6883 while (objLen && isspace(UCHAR(*s))) {
6884 s++;
6885 objLen--;
6886 len--;
6888 /* And trailing space */
6889 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6890 /* Handle trailing backslash-space case */
6891 if (objLen > 1 && s[objLen - 2] == '\\') {
6892 break;
6894 objLen--;
6895 len--;
6897 memcpy(p, s, objLen);
6898 p += objLen;
6899 if (i + 1 != objc) {
6900 if (objLen)
6901 *p++ = ' ';
6902 else {
6903 /* Drop the space calculated for this
6904 * element that is instead null. */
6905 len--;
6909 *p = '\0';
6910 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6914 /* Returns a list composed of the elements in the specified range.
6915 * first and start are directly accepted as Jim_Objects and
6916 * processed for the end?-index? case. */
6917 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6918 Jim_Obj *lastObjPtr)
6920 int first, last;
6921 int len, rangeLen;
6923 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6924 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6925 return NULL;
6926 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6927 first = JimRelToAbsIndex(len, first);
6928 last = JimRelToAbsIndex(len, last);
6929 JimRelToAbsRange(len, &first, &last, &rangeLen);
6930 if (first == 0 && last == len) {
6931 return listObjPtr;
6933 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6936 /* -----------------------------------------------------------------------------
6937 * Dict object
6938 * ---------------------------------------------------------------------------*/
6939 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6940 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6941 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6942 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6944 /* Dict HashTable Type.
6946 * Keys and Values are Jim objects. */
6948 static unsigned int JimObjectHTHashFunction(const void *key)
6950 int len;
6951 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6952 return Jim_GenHashFunction((const unsigned char *)str, len);
6955 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6957 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6960 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6962 Jim_IncrRefCount((Jim_Obj *)val);
6963 return (void *)val;
6966 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6968 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6971 static const Jim_HashTableType JimDictHashTableType = {
6972 JimObjectHTHashFunction, /* hash function */
6973 JimObjectHTKeyValDup, /* key dup */
6974 JimObjectHTKeyValDup, /* val dup */
6975 JimObjectHTKeyCompare, /* key compare */
6976 JimObjectHTKeyValDestructor, /* key destructor */
6977 JimObjectHTKeyValDestructor /* val destructor */
6980 /* Note that while the elements of the dict may contain references,
6981 * the list object itself can't. This basically means that the
6982 * dict object string representation as a whole can't contain references
6983 * that are not presents in the single elements. */
6984 static const Jim_ObjType dictObjType = {
6985 "dict",
6986 FreeDictInternalRep,
6987 DupDictInternalRep,
6988 UpdateStringOfDict,
6989 JIM_TYPE_NONE,
6992 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6994 JIM_NOTUSED(interp);
6996 Jim_FreeHashTable(objPtr->internalRep.ptr);
6997 Jim_Free(objPtr->internalRep.ptr);
7000 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7002 Jim_HashTable *ht, *dupHt;
7003 Jim_HashTableIterator htiter;
7004 Jim_HashEntry *he;
7006 /* Create a new hash table */
7007 ht = srcPtr->internalRep.ptr;
7008 dupHt = Jim_Alloc(sizeof(*dupHt));
7009 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7010 if (ht->size != 0)
7011 Jim_ExpandHashTable(dupHt, ht->size);
7012 /* Copy every element from the source to the dup hash table */
7013 JimInitHashTableIterator(ht, &htiter);
7014 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7015 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7018 dupPtr->internalRep.ptr = dupHt;
7019 dupPtr->typePtr = &dictObjType;
7022 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7024 Jim_HashTable *ht;
7025 Jim_HashTableIterator htiter;
7026 Jim_HashEntry *he;
7027 Jim_Obj **objv;
7028 int i;
7030 ht = dictPtr->internalRep.ptr;
7032 /* Turn the hash table into a flat vector of Jim_Objects. */
7033 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7034 JimInitHashTableIterator(ht, &htiter);
7035 i = 0;
7036 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7037 objv[i++] = Jim_GetHashEntryKey(he);
7038 objv[i++] = Jim_GetHashEntryVal(he);
7040 *len = i;
7041 return objv;
7044 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7046 /* Turn the hash table into a flat vector of Jim_Objects. */
7047 int len;
7048 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7050 /* And now generate the string rep as a list */
7051 JimMakeListStringRep(objPtr, objv, len);
7053 Jim_Free(objv);
7056 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7058 int listlen;
7060 if (objPtr->typePtr == &dictObjType) {
7061 return JIM_OK;
7064 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7065 /* A shared list, so get the string representation now to avoid
7066 * changing the order in case of fast conversion to dict.
7068 Jim_String(objPtr);
7071 /* For simplicity, convert a non-list object to a list and then to a dict */
7072 listlen = Jim_ListLength(interp, objPtr);
7073 if (listlen % 2) {
7074 Jim_SetResultString(interp, "missing value to go with key", -1);
7075 return JIM_ERR;
7077 else {
7078 /* Converting from a list to a dict can't fail */
7079 Jim_HashTable *ht;
7080 int i;
7082 ht = Jim_Alloc(sizeof(*ht));
7083 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7085 for (i = 0; i < listlen; i += 2) {
7086 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7087 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7089 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7092 Jim_FreeIntRep(interp, objPtr);
7093 objPtr->typePtr = &dictObjType;
7094 objPtr->internalRep.ptr = ht;
7096 return JIM_OK;
7100 /* Dict object API */
7102 /* Add an element to a dict. objPtr must be of the "dict" type.
7103 * The higher-level exported function is Jim_DictAddElement().
7104 * If an element with the specified key already exists, the value
7105 * associated is replaced with the new one.
7107 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7108 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7109 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7111 Jim_HashTable *ht = objPtr->internalRep.ptr;
7113 if (valueObjPtr == NULL) { /* unset */
7114 return Jim_DeleteHashEntry(ht, keyObjPtr);
7116 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7117 return JIM_OK;
7120 /* Add an element, higher-level interface for DictAddElement().
7121 * If valueObjPtr == NULL, the key is removed if it exists. */
7122 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7123 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7125 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7126 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7127 return JIM_ERR;
7129 Jim_InvalidateStringRep(objPtr);
7130 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7133 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7135 Jim_Obj *objPtr;
7136 int i;
7138 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7140 objPtr = Jim_NewObj(interp);
7141 objPtr->typePtr = &dictObjType;
7142 objPtr->bytes = NULL;
7143 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7144 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7145 for (i = 0; i < len; i += 2)
7146 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7147 return objPtr;
7150 /* Return the value associated to the specified dict key
7151 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7153 * Sets *objPtrPtr to non-NULL only upon success.
7155 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7156 Jim_Obj **objPtrPtr, int flags)
7158 Jim_HashEntry *he;
7159 Jim_HashTable *ht;
7161 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7162 return -1;
7164 ht = dictPtr->internalRep.ptr;
7165 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7166 if (flags & JIM_ERRMSG) {
7167 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7169 return JIM_ERR;
7171 *objPtrPtr = he->u.val;
7172 return JIM_OK;
7175 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7176 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7178 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7179 return JIM_ERR;
7181 *objPtrPtr = JimDictPairs(dictPtr, len);
7183 return JIM_OK;
7187 /* Return the value associated to the specified dict keys */
7188 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7189 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7191 int i;
7193 if (keyc == 0) {
7194 *objPtrPtr = dictPtr;
7195 return JIM_OK;
7198 for (i = 0; i < keyc; i++) {
7199 Jim_Obj *objPtr;
7201 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7202 if (rc != JIM_OK) {
7203 return rc;
7205 dictPtr = objPtr;
7207 *objPtrPtr = dictPtr;
7208 return JIM_OK;
7211 /* Modify the dict stored into the variable named 'varNamePtr'
7212 * setting the element specified by the 'keyc' keys objects in 'keyv',
7213 * with the new value of the element 'newObjPtr'.
7215 * If newObjPtr == NULL the operation is to remove the given key
7216 * from the dictionary.
7218 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7219 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7221 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7222 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7224 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7225 int shared, i;
7227 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7228 if (objPtr == NULL) {
7229 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7230 /* Cannot remove a key from non existing var */
7231 return JIM_ERR;
7233 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7234 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7235 Jim_FreeNewObj(interp, varObjPtr);
7236 return JIM_ERR;
7239 if ((shared = Jim_IsShared(objPtr)))
7240 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7241 for (i = 0; i < keyc; i++) {
7242 dictObjPtr = objPtr;
7244 /* Check if it's a valid dictionary */
7245 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7246 goto err;
7249 if (i == keyc - 1) {
7250 /* Last key: Note that error on unset with missing last key is OK */
7251 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7252 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7253 goto err;
7256 break;
7259 /* Check if the given key exists. */
7260 Jim_InvalidateStringRep(dictObjPtr);
7261 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7262 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7263 /* This key exists at the current level.
7264 * Make sure it's not shared!. */
7265 if (Jim_IsShared(objPtr)) {
7266 objPtr = Jim_DuplicateObj(interp, objPtr);
7267 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7270 else {
7271 /* Key not found. If it's an [unset] operation
7272 * this is an error. Only the last key may not
7273 * exist. */
7274 if (newObjPtr == NULL) {
7275 goto err;
7277 /* Otherwise set an empty dictionary
7278 * as key's value. */
7279 objPtr = Jim_NewDictObj(interp, NULL, 0);
7280 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7283 /* XXX: Is this necessary? */
7284 Jim_InvalidateStringRep(objPtr);
7285 Jim_InvalidateStringRep(varObjPtr);
7286 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7287 goto err;
7289 Jim_SetResult(interp, varObjPtr);
7290 return JIM_OK;
7291 err:
7292 if (shared) {
7293 Jim_FreeNewObj(interp, varObjPtr);
7295 return JIM_ERR;
7298 /* -----------------------------------------------------------------------------
7299 * Index object
7300 * ---------------------------------------------------------------------------*/
7301 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7302 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7304 static const Jim_ObjType indexObjType = {
7305 "index",
7306 NULL,
7307 NULL,
7308 UpdateStringOfIndex,
7309 JIM_TYPE_NONE,
7312 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7314 if (objPtr->internalRep.intValue == -1) {
7315 JimSetStringBytes(objPtr, "end");
7317 else {
7318 char buf[JIM_INTEGER_SPACE + 1];
7319 if (objPtr->internalRep.intValue >= 0) {
7320 sprintf(buf, "%d", objPtr->internalRep.intValue);
7322 else {
7323 /* Must be <= -2 */
7324 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7326 JimSetStringBytes(objPtr, buf);
7330 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7332 int idx, end = 0;
7333 const char *str;
7334 char *endptr;
7336 /* Get the string representation */
7337 str = Jim_String(objPtr);
7339 /* Try to convert into an index */
7340 if (strncmp(str, "end", 3) == 0) {
7341 end = 1;
7342 str += 3;
7343 idx = 0;
7345 else {
7346 idx = jim_strtol(str, &endptr);
7348 if (endptr == str) {
7349 goto badindex;
7351 str = endptr;
7354 /* Now str may include or +<num> or -<num> */
7355 if (*str == '+' || *str == '-') {
7356 int sign = (*str == '+' ? 1 : -1);
7358 idx += sign * jim_strtol(++str, &endptr);
7359 if (str == endptr || *endptr) {
7360 goto badindex;
7362 str = endptr;
7364 /* The only thing left should be spaces */
7365 while (isspace(UCHAR(*str))) {
7366 str++;
7368 if (*str) {
7369 goto badindex;
7371 if (end) {
7372 if (idx > 0) {
7373 idx = INT_MAX;
7375 else {
7376 /* end-1 is repesented as -2 */
7377 idx--;
7380 else if (idx < 0) {
7381 idx = -INT_MAX;
7384 /* Free the old internal repr and set the new one. */
7385 Jim_FreeIntRep(interp, objPtr);
7386 objPtr->typePtr = &indexObjType;
7387 objPtr->internalRep.intValue = idx;
7388 return JIM_OK;
7390 badindex:
7391 Jim_SetResultFormatted(interp,
7392 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7393 return JIM_ERR;
7396 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7398 /* Avoid shimmering if the object is an integer. */
7399 if (objPtr->typePtr == &intObjType) {
7400 jim_wide val = JimWideValue(objPtr);
7402 if (val < 0)
7403 *indexPtr = -INT_MAX;
7404 else if (val > INT_MAX)
7405 *indexPtr = INT_MAX;
7406 else
7407 *indexPtr = (int)val;
7408 return JIM_OK;
7410 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7411 return JIM_ERR;
7412 *indexPtr = objPtr->internalRep.intValue;
7413 return JIM_OK;
7416 /* -----------------------------------------------------------------------------
7417 * Return Code Object.
7418 * ---------------------------------------------------------------------------*/
7420 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7421 static const char * const jimReturnCodes[] = {
7422 "ok",
7423 "error",
7424 "return",
7425 "break",
7426 "continue",
7427 "signal",
7428 "exit",
7429 "eval",
7430 NULL
7433 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7435 static const Jim_ObjType returnCodeObjType = {
7436 "return-code",
7437 NULL,
7438 NULL,
7439 NULL,
7440 JIM_TYPE_NONE,
7443 /* Converts a (standard) return code to a string. Returns "?" for
7444 * non-standard return codes.
7446 const char *Jim_ReturnCode(int code)
7448 if (code < 0 || code >= (int)jimReturnCodesSize) {
7449 return "?";
7451 else {
7452 return jimReturnCodes[code];
7456 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7458 int returnCode;
7459 jim_wide wideValue;
7461 /* Try to convert into an integer */
7462 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7463 returnCode = (int)wideValue;
7464 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7465 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7466 return JIM_ERR;
7468 /* Free the old internal repr and set the new one. */
7469 Jim_FreeIntRep(interp, objPtr);
7470 objPtr->typePtr = &returnCodeObjType;
7471 objPtr->internalRep.intValue = returnCode;
7472 return JIM_OK;
7475 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7477 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7478 return JIM_ERR;
7479 *intPtr = objPtr->internalRep.intValue;
7480 return JIM_OK;
7483 /* -----------------------------------------------------------------------------
7484 * Expression Parsing
7485 * ---------------------------------------------------------------------------*/
7486 static int JimParseExprOperator(struct JimParserCtx *pc);
7487 static int JimParseExprNumber(struct JimParserCtx *pc);
7488 static int JimParseExprIrrational(struct JimParserCtx *pc);
7490 /* Exrp's Stack machine operators opcodes. */
7492 /* Binary operators (numbers) */
7493 enum
7495 /* Continues on from the JIM_TT_ space */
7496 /* Operations */
7497 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7498 JIM_EXPROP_DIV,
7499 JIM_EXPROP_MOD,
7500 JIM_EXPROP_SUB,
7501 JIM_EXPROP_ADD,
7502 JIM_EXPROP_LSHIFT,
7503 JIM_EXPROP_RSHIFT,
7504 JIM_EXPROP_ROTL,
7505 JIM_EXPROP_ROTR,
7506 JIM_EXPROP_LT,
7507 JIM_EXPROP_GT,
7508 JIM_EXPROP_LTE,
7509 JIM_EXPROP_GTE,
7510 JIM_EXPROP_NUMEQ,
7511 JIM_EXPROP_NUMNE,
7512 JIM_EXPROP_BITAND, /* 35 */
7513 JIM_EXPROP_BITXOR,
7514 JIM_EXPROP_BITOR,
7516 /* Note must keep these together */
7517 JIM_EXPROP_LOGICAND, /* 38 */
7518 JIM_EXPROP_LOGICAND_LEFT,
7519 JIM_EXPROP_LOGICAND_RIGHT,
7521 /* and these */
7522 JIM_EXPROP_LOGICOR, /* 41 */
7523 JIM_EXPROP_LOGICOR_LEFT,
7524 JIM_EXPROP_LOGICOR_RIGHT,
7526 /* and these */
7527 /* Ternary operators */
7528 JIM_EXPROP_TERNARY, /* 44 */
7529 JIM_EXPROP_TERNARY_LEFT,
7530 JIM_EXPROP_TERNARY_RIGHT,
7532 /* and these */
7533 JIM_EXPROP_COLON, /* 47 */
7534 JIM_EXPROP_COLON_LEFT,
7535 JIM_EXPROP_COLON_RIGHT,
7537 JIM_EXPROP_POW, /* 50 */
7539 /* Binary operators (strings) */
7540 JIM_EXPROP_STREQ, /* 51 */
7541 JIM_EXPROP_STRNE,
7542 JIM_EXPROP_STRIN,
7543 JIM_EXPROP_STRNI,
7545 /* Unary operators (numbers) */
7546 JIM_EXPROP_NOT, /* 55 */
7547 JIM_EXPROP_BITNOT,
7548 JIM_EXPROP_UNARYMINUS,
7549 JIM_EXPROP_UNARYPLUS,
7551 /* Functions */
7552 JIM_EXPROP_FUNC_FIRST, /* 59 */
7553 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7554 JIM_EXPROP_FUNC_WIDE,
7555 JIM_EXPROP_FUNC_ABS,
7556 JIM_EXPROP_FUNC_DOUBLE,
7557 JIM_EXPROP_FUNC_ROUND,
7558 JIM_EXPROP_FUNC_RAND,
7559 JIM_EXPROP_FUNC_SRAND,
7561 /* math functions from libm */
7562 JIM_EXPROP_FUNC_SIN, /* 65 */
7563 JIM_EXPROP_FUNC_COS,
7564 JIM_EXPROP_FUNC_TAN,
7565 JIM_EXPROP_FUNC_ASIN,
7566 JIM_EXPROP_FUNC_ACOS,
7567 JIM_EXPROP_FUNC_ATAN,
7568 JIM_EXPROP_FUNC_SINH,
7569 JIM_EXPROP_FUNC_COSH,
7570 JIM_EXPROP_FUNC_TANH,
7571 JIM_EXPROP_FUNC_CEIL,
7572 JIM_EXPROP_FUNC_FLOOR,
7573 JIM_EXPROP_FUNC_EXP,
7574 JIM_EXPROP_FUNC_LOG,
7575 JIM_EXPROP_FUNC_LOG10,
7576 JIM_EXPROP_FUNC_SQRT,
7577 JIM_EXPROP_FUNC_POW,
7580 struct JimExprState
7582 Jim_Obj **stack;
7583 int stacklen;
7584 int opcode;
7585 int skip;
7588 /* Operators table */
7589 typedef struct Jim_ExprOperator
7591 const char *name;
7592 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7593 unsigned char precedence;
7594 unsigned char arity;
7595 unsigned char lazy;
7596 unsigned char namelen;
7597 } Jim_ExprOperator;
7599 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7601 Jim_IncrRefCount(obj);
7602 e->stack[e->stacklen++] = obj;
7605 static Jim_Obj *ExprPop(struct JimExprState *e)
7607 return e->stack[--e->stacklen];
7610 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7612 int intresult = 1;
7613 int rc = JIM_OK;
7614 Jim_Obj *A = ExprPop(e);
7615 double dA, dC = 0;
7616 jim_wide wA, wC = 0;
7618 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7619 switch (e->opcode) {
7620 case JIM_EXPROP_FUNC_INT:
7621 case JIM_EXPROP_FUNC_WIDE:
7622 case JIM_EXPROP_FUNC_ROUND:
7623 case JIM_EXPROP_UNARYPLUS:
7624 wC = wA;
7625 break;
7626 case JIM_EXPROP_FUNC_DOUBLE:
7627 dC = wA;
7628 intresult = 0;
7629 break;
7630 case JIM_EXPROP_FUNC_ABS:
7631 wC = wA >= 0 ? wA : -wA;
7632 break;
7633 case JIM_EXPROP_UNARYMINUS:
7634 wC = -wA;
7635 break;
7636 case JIM_EXPROP_NOT:
7637 wC = !wA;
7638 break;
7639 default:
7640 abort();
7643 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7644 switch (e->opcode) {
7645 case JIM_EXPROP_FUNC_INT:
7646 case JIM_EXPROP_FUNC_WIDE:
7647 wC = dA;
7648 break;
7649 case JIM_EXPROP_FUNC_ROUND:
7650 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7651 break;
7652 case JIM_EXPROP_FUNC_DOUBLE:
7653 case JIM_EXPROP_UNARYPLUS:
7654 dC = dA;
7655 intresult = 0;
7656 break;
7657 case JIM_EXPROP_FUNC_ABS:
7658 dC = dA >= 0 ? dA : -dA;
7659 intresult = 0;
7660 break;
7661 case JIM_EXPROP_UNARYMINUS:
7662 dC = -dA;
7663 intresult = 0;
7664 break;
7665 case JIM_EXPROP_NOT:
7666 wC = !dA;
7667 break;
7668 default:
7669 abort();
7673 if (rc == JIM_OK) {
7674 if (intresult) {
7675 ExprPush(e, Jim_NewIntObj(interp, wC));
7677 else {
7678 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7682 Jim_DecrRefCount(interp, A);
7684 return rc;
7687 static double JimRandDouble(Jim_Interp *interp)
7689 unsigned long x;
7690 JimRandomBytes(interp, &x, sizeof(x));
7692 return (double)x / (unsigned long)~0;
7695 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7697 Jim_Obj *A = ExprPop(e);
7698 jim_wide wA;
7700 int rc = Jim_GetWide(interp, A, &wA);
7701 if (rc == JIM_OK) {
7702 switch (e->opcode) {
7703 case JIM_EXPROP_BITNOT:
7704 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7705 break;
7706 case JIM_EXPROP_FUNC_SRAND:
7707 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7708 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7709 break;
7710 default:
7711 abort();
7715 Jim_DecrRefCount(interp, A);
7717 return rc;
7720 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7722 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7724 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7726 return JIM_OK;
7729 #ifdef JIM_MATH_FUNCTIONS
7730 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7732 int rc;
7733 Jim_Obj *A = ExprPop(e);
7734 double dA, dC;
7736 rc = Jim_GetDouble(interp, A, &dA);
7737 if (rc == JIM_OK) {
7738 switch (e->opcode) {
7739 case JIM_EXPROP_FUNC_SIN:
7740 dC = sin(dA);
7741 break;
7742 case JIM_EXPROP_FUNC_COS:
7743 dC = cos(dA);
7744 break;
7745 case JIM_EXPROP_FUNC_TAN:
7746 dC = tan(dA);
7747 break;
7748 case JIM_EXPROP_FUNC_ASIN:
7749 dC = asin(dA);
7750 break;
7751 case JIM_EXPROP_FUNC_ACOS:
7752 dC = acos(dA);
7753 break;
7754 case JIM_EXPROP_FUNC_ATAN:
7755 dC = atan(dA);
7756 break;
7757 case JIM_EXPROP_FUNC_SINH:
7758 dC = sinh(dA);
7759 break;
7760 case JIM_EXPROP_FUNC_COSH:
7761 dC = cosh(dA);
7762 break;
7763 case JIM_EXPROP_FUNC_TANH:
7764 dC = tanh(dA);
7765 break;
7766 case JIM_EXPROP_FUNC_CEIL:
7767 dC = ceil(dA);
7768 break;
7769 case JIM_EXPROP_FUNC_FLOOR:
7770 dC = floor(dA);
7771 break;
7772 case JIM_EXPROP_FUNC_EXP:
7773 dC = exp(dA);
7774 break;
7775 case JIM_EXPROP_FUNC_LOG:
7776 dC = log(dA);
7777 break;
7778 case JIM_EXPROP_FUNC_LOG10:
7779 dC = log10(dA);
7780 break;
7781 case JIM_EXPROP_FUNC_SQRT:
7782 dC = sqrt(dA);
7783 break;
7784 default:
7785 abort();
7787 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7790 Jim_DecrRefCount(interp, A);
7792 return rc;
7794 #endif
7796 /* A binary operation on two ints */
7797 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7799 Jim_Obj *B = ExprPop(e);
7800 Jim_Obj *A = ExprPop(e);
7801 jim_wide wA, wB;
7802 int rc = JIM_ERR;
7804 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7805 jim_wide wC;
7807 rc = JIM_OK;
7809 switch (e->opcode) {
7810 case JIM_EXPROP_LSHIFT:
7811 wC = wA << wB;
7812 break;
7813 case JIM_EXPROP_RSHIFT:
7814 wC = wA >> wB;
7815 break;
7816 case JIM_EXPROP_BITAND:
7817 wC = wA & wB;
7818 break;
7819 case JIM_EXPROP_BITXOR:
7820 wC = wA ^ wB;
7821 break;
7822 case JIM_EXPROP_BITOR:
7823 wC = wA | wB;
7824 break;
7825 case JIM_EXPROP_MOD:
7826 if (wB == 0) {
7827 wC = 0;
7828 Jim_SetResultString(interp, "Division by zero", -1);
7829 rc = JIM_ERR;
7831 else {
7833 * From Tcl 8.x
7835 * This code is tricky: C doesn't guarantee much
7836 * about the quotient or remainder, but Tcl does.
7837 * The remainder always has the same sign as the
7838 * divisor and a smaller absolute value.
7840 int negative = 0;
7842 if (wB < 0) {
7843 wB = -wB;
7844 wA = -wA;
7845 negative = 1;
7847 wC = wA % wB;
7848 if (wC < 0) {
7849 wC += wB;
7851 if (negative) {
7852 wC = -wC;
7855 break;
7856 case JIM_EXPROP_ROTL:
7857 case JIM_EXPROP_ROTR:{
7858 /* uint32_t would be better. But not everyone has inttypes.h? */
7859 unsigned long uA = (unsigned long)wA;
7860 unsigned long uB = (unsigned long)wB;
7861 const unsigned int S = sizeof(unsigned long) * 8;
7863 /* Shift left by the word size or more is undefined. */
7864 uB %= S;
7866 if (e->opcode == JIM_EXPROP_ROTR) {
7867 uB = S - uB;
7869 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7870 break;
7872 default:
7873 abort();
7875 ExprPush(e, Jim_NewIntObj(interp, wC));
7879 Jim_DecrRefCount(interp, A);
7880 Jim_DecrRefCount(interp, B);
7882 return rc;
7886 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7887 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7889 int intresult = 1;
7890 int rc = JIM_OK;
7891 double dA, dB, dC = 0;
7892 jim_wide wA, wB, wC = 0;
7894 Jim_Obj *B = ExprPop(e);
7895 Jim_Obj *A = ExprPop(e);
7897 if ((A->typePtr != &doubleObjType || A->bytes) &&
7898 (B->typePtr != &doubleObjType || B->bytes) &&
7899 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7901 /* Both are ints */
7903 switch (e->opcode) {
7904 case JIM_EXPROP_POW:
7905 case JIM_EXPROP_FUNC_POW:
7906 wC = JimPowWide(wA, wB);
7907 break;
7908 case JIM_EXPROP_ADD:
7909 wC = wA + wB;
7910 break;
7911 case JIM_EXPROP_SUB:
7912 wC = wA - wB;
7913 break;
7914 case JIM_EXPROP_MUL:
7915 wC = wA * wB;
7916 break;
7917 case JIM_EXPROP_DIV:
7918 if (wB == 0) {
7919 Jim_SetResultString(interp, "Division by zero", -1);
7920 rc = JIM_ERR;
7922 else {
7924 * From Tcl 8.x
7926 * This code is tricky: C doesn't guarantee much
7927 * about the quotient or remainder, but Tcl does.
7928 * The remainder always has the same sign as the
7929 * divisor and a smaller absolute value.
7931 if (wB < 0) {
7932 wB = -wB;
7933 wA = -wA;
7935 wC = wA / wB;
7936 if (wA % wB < 0) {
7937 wC--;
7940 break;
7941 case JIM_EXPROP_LT:
7942 wC = wA < wB;
7943 break;
7944 case JIM_EXPROP_GT:
7945 wC = wA > wB;
7946 break;
7947 case JIM_EXPROP_LTE:
7948 wC = wA <= wB;
7949 break;
7950 case JIM_EXPROP_GTE:
7951 wC = wA >= wB;
7952 break;
7953 case JIM_EXPROP_NUMEQ:
7954 wC = wA == wB;
7955 break;
7956 case JIM_EXPROP_NUMNE:
7957 wC = wA != wB;
7958 break;
7959 default:
7960 abort();
7963 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7964 intresult = 0;
7965 switch (e->opcode) {
7966 case JIM_EXPROP_POW:
7967 case JIM_EXPROP_FUNC_POW:
7968 #ifdef JIM_MATH_FUNCTIONS
7969 dC = pow(dA, dB);
7970 #else
7971 Jim_SetResultString(interp, "unsupported", -1);
7972 rc = JIM_ERR;
7973 #endif
7974 break;
7975 case JIM_EXPROP_ADD:
7976 dC = dA + dB;
7977 break;
7978 case JIM_EXPROP_SUB:
7979 dC = dA - dB;
7980 break;
7981 case JIM_EXPROP_MUL:
7982 dC = dA * dB;
7983 break;
7984 case JIM_EXPROP_DIV:
7985 if (dB == 0) {
7986 #ifdef INFINITY
7987 dC = dA < 0 ? -INFINITY : INFINITY;
7988 #else
7989 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7990 #endif
7992 else {
7993 dC = dA / dB;
7995 break;
7996 case JIM_EXPROP_LT:
7997 wC = dA < dB;
7998 intresult = 1;
7999 break;
8000 case JIM_EXPROP_GT:
8001 wC = dA > dB;
8002 intresult = 1;
8003 break;
8004 case JIM_EXPROP_LTE:
8005 wC = dA <= dB;
8006 intresult = 1;
8007 break;
8008 case JIM_EXPROP_GTE:
8009 wC = dA >= dB;
8010 intresult = 1;
8011 break;
8012 case JIM_EXPROP_NUMEQ:
8013 wC = dA == dB;
8014 intresult = 1;
8015 break;
8016 case JIM_EXPROP_NUMNE:
8017 wC = dA != dB;
8018 intresult = 1;
8019 break;
8020 default:
8021 abort();
8024 else {
8025 /* Handle the string case */
8027 /* XXX: Could optimise the eq/ne case by checking lengths */
8028 int i = Jim_StringCompareObj(interp, A, B, 0);
8030 switch (e->opcode) {
8031 case JIM_EXPROP_LT:
8032 wC = i < 0;
8033 break;
8034 case JIM_EXPROP_GT:
8035 wC = i > 0;
8036 break;
8037 case JIM_EXPROP_LTE:
8038 wC = i <= 0;
8039 break;
8040 case JIM_EXPROP_GTE:
8041 wC = i >= 0;
8042 break;
8043 case JIM_EXPROP_NUMEQ:
8044 wC = i == 0;
8045 break;
8046 case JIM_EXPROP_NUMNE:
8047 wC = i != 0;
8048 break;
8049 default:
8050 rc = JIM_ERR;
8051 break;
8055 if (rc == JIM_OK) {
8056 if (intresult) {
8057 ExprPush(e, Jim_NewIntObj(interp, wC));
8059 else {
8060 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8064 Jim_DecrRefCount(interp, A);
8065 Jim_DecrRefCount(interp, B);
8067 return rc;
8070 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8072 int listlen;
8073 int i;
8075 listlen = Jim_ListLength(interp, listObjPtr);
8076 for (i = 0; i < listlen; i++) {
8077 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8078 return 1;
8081 return 0;
8084 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8086 Jim_Obj *B = ExprPop(e);
8087 Jim_Obj *A = ExprPop(e);
8089 jim_wide wC;
8091 switch (e->opcode) {
8092 case JIM_EXPROP_STREQ:
8093 case JIM_EXPROP_STRNE:
8094 wC = Jim_StringEqObj(A, B);
8095 if (e->opcode == JIM_EXPROP_STRNE) {
8096 wC = !wC;
8098 break;
8099 case JIM_EXPROP_STRIN:
8100 wC = JimSearchList(interp, B, A);
8101 break;
8102 case JIM_EXPROP_STRNI:
8103 wC = !JimSearchList(interp, B, A);
8104 break;
8105 default:
8106 abort();
8108 ExprPush(e, Jim_NewIntObj(interp, wC));
8110 Jim_DecrRefCount(interp, A);
8111 Jim_DecrRefCount(interp, B);
8113 return JIM_OK;
8116 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8118 long l;
8119 double d;
8121 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8122 return l != 0;
8124 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8125 return d != 0;
8127 return -1;
8130 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8132 Jim_Obj *skip = ExprPop(e);
8133 Jim_Obj *A = ExprPop(e);
8134 int rc = JIM_OK;
8136 switch (ExprBool(interp, A)) {
8137 case 0:
8138 /* false, so skip RHS opcodes with a 0 result */
8139 e->skip = JimWideValue(skip);
8140 ExprPush(e, Jim_NewIntObj(interp, 0));
8141 break;
8143 case 1:
8144 /* true so continue */
8145 break;
8147 case -1:
8148 /* Invalid */
8149 rc = JIM_ERR;
8151 Jim_DecrRefCount(interp, A);
8152 Jim_DecrRefCount(interp, skip);
8154 return rc;
8157 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8159 Jim_Obj *skip = ExprPop(e);
8160 Jim_Obj *A = ExprPop(e);
8161 int rc = JIM_OK;
8163 switch (ExprBool(interp, A)) {
8164 case 0:
8165 /* false, so do nothing */
8166 break;
8168 case 1:
8169 /* true so skip RHS opcodes with a 1 result */
8170 e->skip = JimWideValue(skip);
8171 ExprPush(e, Jim_NewIntObj(interp, 1));
8172 break;
8174 case -1:
8175 /* Invalid */
8176 rc = JIM_ERR;
8177 break;
8179 Jim_DecrRefCount(interp, A);
8180 Jim_DecrRefCount(interp, skip);
8182 return rc;
8185 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8187 Jim_Obj *A = ExprPop(e);
8188 int rc = JIM_OK;
8190 switch (ExprBool(interp, A)) {
8191 case 0:
8192 ExprPush(e, Jim_NewIntObj(interp, 0));
8193 break;
8195 case 1:
8196 ExprPush(e, Jim_NewIntObj(interp, 1));
8197 break;
8199 case -1:
8200 /* Invalid */
8201 rc = JIM_ERR;
8202 break;
8204 Jim_DecrRefCount(interp, A);
8206 return rc;
8209 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8211 Jim_Obj *skip = ExprPop(e);
8212 Jim_Obj *A = ExprPop(e);
8213 int rc = JIM_OK;
8215 /* Repush A */
8216 ExprPush(e, A);
8218 switch (ExprBool(interp, A)) {
8219 case 0:
8220 /* false, skip RHS opcodes */
8221 e->skip = JimWideValue(skip);
8222 /* Push a dummy value */
8223 ExprPush(e, Jim_NewIntObj(interp, 0));
8224 break;
8226 case 1:
8227 /* true so do nothing */
8228 break;
8230 case -1:
8231 /* Invalid */
8232 rc = JIM_ERR;
8233 break;
8235 Jim_DecrRefCount(interp, A);
8236 Jim_DecrRefCount(interp, skip);
8238 return rc;
8241 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8243 Jim_Obj *skip = ExprPop(e);
8244 Jim_Obj *B = ExprPop(e);
8245 Jim_Obj *A = ExprPop(e);
8247 /* No need to check for A as non-boolean */
8248 if (ExprBool(interp, A)) {
8249 /* true, so skip RHS opcodes */
8250 e->skip = JimWideValue(skip);
8251 /* Repush B as the answer */
8252 ExprPush(e, B);
8255 Jim_DecrRefCount(interp, skip);
8256 Jim_DecrRefCount(interp, A);
8257 Jim_DecrRefCount(interp, B);
8258 return JIM_OK;
8261 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8263 return JIM_OK;
8266 enum
8268 LAZY_NONE,
8269 LAZY_OP,
8270 LAZY_LEFT,
8271 LAZY_RIGHT
8274 /* name - precedence - arity - opcode
8276 * This array *must* be kept in sync with the JIM_EXPROP enum.
8278 * The following macros pre-compute the string length at compile time.
8280 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8281 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8283 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8284 OPRINIT("*", 110, 2, JimExprOpBin),
8285 OPRINIT("/", 110, 2, JimExprOpBin),
8286 OPRINIT("%", 110, 2, JimExprOpIntBin),
8288 OPRINIT("-", 100, 2, JimExprOpBin),
8289 OPRINIT("+", 100, 2, JimExprOpBin),
8291 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8292 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8294 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8295 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8297 OPRINIT("<", 80, 2, JimExprOpBin),
8298 OPRINIT(">", 80, 2, JimExprOpBin),
8299 OPRINIT("<=", 80, 2, JimExprOpBin),
8300 OPRINIT(">=", 80, 2, JimExprOpBin),
8302 OPRINIT("==", 70, 2, JimExprOpBin),
8303 OPRINIT("!=", 70, 2, JimExprOpBin),
8305 OPRINIT("&", 50, 2, JimExprOpIntBin),
8306 OPRINIT("^", 49, 2, JimExprOpIntBin),
8307 OPRINIT("|", 48, 2, JimExprOpIntBin),
8309 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8310 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8311 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8313 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8314 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8315 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8317 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8318 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8319 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8321 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8322 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8323 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8325 OPRINIT("**", 250, 2, JimExprOpBin),
8327 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8328 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8330 OPRINIT("in", 55, 2, JimExprOpStrBin),
8331 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8333 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8334 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8335 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8336 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8340 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8341 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8342 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8343 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8344 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8345 OPRINIT("rand", 200, 0, JimExprOpNone),
8346 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8348 #ifdef JIM_MATH_FUNCTIONS
8349 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8350 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8351 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8352 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8353 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8354 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8355 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8356 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8357 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8358 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8359 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8360 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8361 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8362 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8363 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8364 OPRINIT("pow", 200, 2, JimExprOpBin),
8365 #endif
8367 #undef OPRINIT
8368 #undef OPRINIT_LAZY
8370 #define JIM_EXPR_OPERATORS_NUM \
8371 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8373 static int JimParseExpression(struct JimParserCtx *pc)
8375 /* Discard spaces and quoted newline */
8376 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8377 if (*pc->p == '\n') {
8378 pc->linenr++;
8380 pc->p++;
8381 pc->len--;
8384 /* Common case */
8385 pc->tline = pc->linenr;
8386 pc->tstart = pc->p;
8388 if (pc->len == 0) {
8389 pc->tend = pc->p;
8390 pc->tt = JIM_TT_EOL;
8391 pc->eof = 1;
8392 return JIM_OK;
8394 switch (*(pc->p)) {
8395 case '(':
8396 pc->tt = JIM_TT_SUBEXPR_START;
8397 goto singlechar;
8398 case ')':
8399 pc->tt = JIM_TT_SUBEXPR_END;
8400 goto singlechar;
8401 case ',':
8402 pc->tt = JIM_TT_SUBEXPR_COMMA;
8403 singlechar:
8404 pc->tend = pc->p;
8405 pc->p++;
8406 pc->len--;
8407 break;
8408 case '[':
8409 return JimParseCmd(pc);
8410 case '$':
8411 if (JimParseVar(pc) == JIM_ERR)
8412 return JimParseExprOperator(pc);
8413 else {
8414 /* Don't allow expr sugar in expressions */
8415 if (pc->tt == JIM_TT_EXPRSUGAR) {
8416 return JIM_ERR;
8418 return JIM_OK;
8420 break;
8421 case '0':
8422 case '1':
8423 case '2':
8424 case '3':
8425 case '4':
8426 case '5':
8427 case '6':
8428 case '7':
8429 case '8':
8430 case '9':
8431 case '.':
8432 return JimParseExprNumber(pc);
8433 case '"':
8434 return JimParseQuote(pc);
8435 case '{':
8436 return JimParseBrace(pc);
8438 case 'N':
8439 case 'I':
8440 case 'n':
8441 case 'i':
8442 if (JimParseExprIrrational(pc) == JIM_ERR)
8443 return JimParseExprOperator(pc);
8444 break;
8445 default:
8446 return JimParseExprOperator(pc);
8447 break;
8449 return JIM_OK;
8452 static int JimParseExprNumber(struct JimParserCtx *pc)
8454 char *end;
8456 /* Assume an integer for now */
8457 pc->tt = JIM_TT_EXPR_INT;
8459 jim_strtoull(pc->p, (char **)&pc->p);
8460 /* Tried as an integer, but perhaps it parses as a double */
8461 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8462 /* Some stupid compilers insist they are cleverer that
8463 * we are. Even a (void) cast doesn't prevent this warning!
8465 if (strtod(pc->tstart, &end)) { /* nothing */ }
8466 if (end == pc->tstart)
8467 return JIM_ERR;
8468 if (end > pc->p) {
8469 /* Yes, double captured more chars */
8470 pc->tt = JIM_TT_EXPR_DOUBLE;
8471 pc->p = end;
8474 pc->tend = pc->p - 1;
8475 pc->len -= (pc->p - pc->tstart);
8476 return JIM_OK;
8479 static int JimParseExprIrrational(struct JimParserCtx *pc)
8481 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8482 int i;
8484 for (i = 0; irrationals[i]; i++) {
8485 const char *irr = irrationals[i];
8487 if (strncmp(irr, pc->p, 3) == 0) {
8488 pc->p += 3;
8489 pc->len -= 3;
8490 pc->tend = pc->p - 1;
8491 pc->tt = JIM_TT_EXPR_DOUBLE;
8492 return JIM_OK;
8495 return JIM_ERR;
8498 static int JimParseExprOperator(struct JimParserCtx *pc)
8500 int i;
8501 int bestIdx = -1, bestLen = 0;
8503 /* Try to get the longest match. */
8504 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8505 const char * const opname = Jim_ExprOperators[i].name;
8506 const int oplen = Jim_ExprOperators[i].namelen;
8508 if (opname == NULL || opname[0] != pc->p[0]) {
8509 continue;
8512 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8513 bestIdx = i + JIM_TT_EXPR_OP;
8514 bestLen = oplen;
8517 if (bestIdx == -1) {
8518 return JIM_ERR;
8521 /* Validate paretheses around function arguments */
8522 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8523 const char *p = pc->p + bestLen;
8524 int len = pc->len - bestLen;
8526 while (len && isspace(UCHAR(*p))) {
8527 len--;
8528 p++;
8530 if (*p != '(') {
8531 return JIM_ERR;
8534 pc->tend = pc->p + bestLen - 1;
8535 pc->p += bestLen;
8536 pc->len -= bestLen;
8538 pc->tt = bestIdx;
8539 return JIM_OK;
8542 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8544 static Jim_ExprOperator dummy_op;
8545 if (opcode < JIM_TT_EXPR_OP) {
8546 return &dummy_op;
8548 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8551 const char *jim_tt_name(int type)
8553 static const char * const tt_names[JIM_TT_EXPR_OP] =
8554 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8555 "DBL", "$()" };
8556 if (type < JIM_TT_EXPR_OP) {
8557 return tt_names[type];
8559 else {
8560 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8561 static char buf[20];
8563 if (op->name) {
8564 return op->name;
8566 sprintf(buf, "(%d)", type);
8567 return buf;
8571 /* -----------------------------------------------------------------------------
8572 * Expression Object
8573 * ---------------------------------------------------------------------------*/
8574 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8575 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8576 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8578 static const Jim_ObjType exprObjType = {
8579 "expression",
8580 FreeExprInternalRep,
8581 DupExprInternalRep,
8582 NULL,
8583 JIM_TYPE_REFERENCES,
8586 /* Expr bytecode structure */
8587 typedef struct ExprByteCode
8589 ScriptToken *token; /* Tokens array. */
8590 int len; /* Length as number of tokens. */
8591 int inUse; /* Used for sharing. */
8592 } ExprByteCode;
8594 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8596 int i;
8598 for (i = 0; i < expr->len; i++) {
8599 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8601 Jim_Free(expr->token);
8602 Jim_Free(expr);
8605 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8607 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8609 if (expr) {
8610 if (--expr->inUse != 0) {
8611 return;
8614 ExprFreeByteCode(interp, expr);
8618 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8620 JIM_NOTUSED(interp);
8621 JIM_NOTUSED(srcPtr);
8623 /* Just returns an simple string. */
8624 dupPtr->typePtr = NULL;
8627 /* Check if an expr program looks correct. */
8628 static int ExprCheckCorrectness(ExprByteCode * expr)
8630 int i;
8631 int stacklen = 0;
8632 int ternary = 0;
8634 /* Try to check if there are stack underflows,
8635 * and make sure at the end of the program there is
8636 * a single result on the stack. */
8637 for (i = 0; i < expr->len; i++) {
8638 ScriptToken *t = &expr->token[i];
8639 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8641 stacklen -= op->arity;
8642 if (stacklen < 0) {
8643 break;
8645 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8646 ternary++;
8648 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8649 ternary--;
8652 /* All operations and operands add one to the stack */
8653 stacklen++;
8655 if (stacklen != 1 || ternary != 0) {
8656 return JIM_ERR;
8658 return JIM_OK;
8661 /* This procedure converts every occurrence of || and && opereators
8662 * in lazy unary versions.
8664 * a b || is converted into:
8666 * a <offset> |L b |R
8668 * a b && is converted into:
8670 * a <offset> &L b &R
8672 * "|L" checks if 'a' is true:
8673 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8674 * the opcode just after |R.
8675 * 2) if it is false does nothing.
8676 * "|R" checks if 'b' is true:
8677 * 1) if it is true pushes 1, otherwise pushes 0.
8679 * "&L" checks if 'a' is true:
8680 * 1) if it is true does nothing.
8681 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8682 * the opcode just after &R
8683 * "&R" checks if 'a' is true:
8684 * if it is true pushes 1, otherwise pushes 0.
8686 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8688 int i;
8690 int leftindex, arity, offset;
8692 /* Search for the end of the first operator */
8693 leftindex = expr->len - 1;
8695 arity = 1;
8696 while (arity) {
8697 ScriptToken *tt = &expr->token[leftindex];
8699 if (tt->type >= JIM_TT_EXPR_OP) {
8700 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8702 arity--;
8703 if (--leftindex < 0) {
8704 return JIM_ERR;
8707 leftindex++;
8709 /* Move them up */
8710 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8711 sizeof(*expr->token) * (expr->len - leftindex));
8712 expr->len += 2;
8713 offset = (expr->len - leftindex) - 1;
8715 /* Now we rely on the fact that the left and right version have opcodes
8716 * 1 and 2 after the main opcode respectively
8718 expr->token[leftindex + 1].type = t->type + 1;
8719 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8721 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8722 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8724 /* Now add the 'R' operator */
8725 expr->token[expr->len].objPtr = interp->emptyObj;
8726 expr->token[expr->len].type = t->type + 2;
8727 expr->len++;
8729 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8730 for (i = leftindex - 1; i > 0; i--) {
8731 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8732 if (op->lazy == LAZY_LEFT) {
8733 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8734 JimWideValue(expr->token[i - 1].objPtr) += 2;
8738 return JIM_OK;
8741 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8743 struct ScriptToken *token = &expr->token[expr->len];
8744 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8746 if (op->lazy == LAZY_OP) {
8747 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8748 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8749 return JIM_ERR;
8752 else {
8753 token->objPtr = interp->emptyObj;
8754 token->type = t->type;
8755 expr->len++;
8757 return JIM_OK;
8761 * Returns the index of the COLON_LEFT to the left of 'right_index'
8762 * taking into account nesting.
8764 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8766 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8768 int ternary_count = 1;
8770 right_index--;
8772 while (right_index > 1) {
8773 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8774 ternary_count--;
8776 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8777 ternary_count++;
8779 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8780 return right_index;
8782 right_index--;
8785 /*notreached*/
8786 return -1;
8790 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8792 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8793 * Otherwise returns 0.
8795 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8797 int i = right_index - 1;
8798 int ternary_count = 1;
8800 while (i > 1) {
8801 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8802 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8803 *prev_right_index = i - 2;
8804 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8805 return 1;
8808 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8809 if (ternary_count == 0) {
8810 return 0;
8812 ternary_count++;
8814 i--;
8816 return 0;
8820 * ExprTernaryReorderExpression description
8821 * ========================================
8823 * ?: is right-to-left associative which doesn't work with the stack-based
8824 * expression engine. The fix is to reorder the bytecode.
8826 * The expression:
8828 * expr 1?2:0?3:4
8830 * Has initial bytecode:
8832 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8833 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8835 * The fix involves simulating this expression instead:
8837 * expr 1?2:(0?3:4)
8839 * With the following bytecode:
8841 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8842 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8844 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8845 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8846 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8847 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8849 * ExprTernaryReorderExpression works thus as follows :
8850 * - start from the end of the stack
8851 * - while walking towards the beginning of the stack
8852 * if token=JIM_EXPROP_COLON_RIGHT then
8853 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8854 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8855 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8856 * if all found then
8857 * perform the rotation
8858 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8859 * end if
8860 * end if
8862 * Note: care has to be taken for nested ternary constructs!!!
8864 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8866 int i;
8868 for (i = expr->len - 1; i > 1; i--) {
8869 int prev_right_index;
8870 int prev_left_index;
8871 int j;
8872 ScriptToken tmp;
8874 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8875 continue;
8878 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8879 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8880 continue;
8884 ** rotate tokens down
8886 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8887 ** | | |
8888 ** | V V
8889 ** | [...] : ...
8890 ** | | |
8891 ** | V V
8892 ** | [...] : ...
8893 ** | | |
8894 ** | V V
8895 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8897 tmp = expr->token[prev_right_index];
8898 for (j = prev_right_index; j < i; j++) {
8899 expr->token[j] = expr->token[j + 1];
8901 expr->token[i] = tmp;
8903 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8905 * This is 'colon left increment' = i - prev_right_index
8907 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8908 * [prev_left_index-1] : skip_count
8911 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8913 /* Adjust for i-- in the loop */
8914 i++;
8918 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8920 Jim_Stack stack;
8921 ExprByteCode *expr;
8922 int ok = 1;
8923 int i;
8924 int prevtt = JIM_TT_NONE;
8925 int have_ternary = 0;
8927 /* -1 for EOL */
8928 int count = tokenlist->count - 1;
8930 expr = Jim_Alloc(sizeof(*expr));
8931 expr->inUse = 1;
8932 expr->len = 0;
8934 Jim_InitStack(&stack);
8936 /* Need extra bytecodes for lazy operators.
8937 * Also check for the ternary operator
8939 for (i = 0; i < tokenlist->count; i++) {
8940 ParseToken *t = &tokenlist->list[i];
8941 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8943 if (op->lazy == LAZY_OP) {
8944 count += 2;
8945 /* Ternary is a lazy op but also needs reordering */
8946 if (t->type == JIM_EXPROP_TERNARY) {
8947 have_ternary = 1;
8952 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8954 for (i = 0; i < tokenlist->count && ok; i++) {
8955 ParseToken *t = &tokenlist->list[i];
8957 /* Next token will be stored here */
8958 struct ScriptToken *token = &expr->token[expr->len];
8960 if (t->type == JIM_TT_EOL) {
8961 break;
8964 switch (t->type) {
8965 case JIM_TT_STR:
8966 case JIM_TT_ESC:
8967 case JIM_TT_VAR:
8968 case JIM_TT_DICTSUGAR:
8969 case JIM_TT_EXPRSUGAR:
8970 case JIM_TT_CMD:
8971 token->type = t->type;
8972 strexpr:
8973 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8974 if (t->type == JIM_TT_CMD) {
8975 /* Only commands need source info */
8976 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8978 expr->len++;
8979 break;
8981 case JIM_TT_EXPR_INT:
8982 case JIM_TT_EXPR_DOUBLE:
8984 char *endptr;
8985 if (t->type == JIM_TT_EXPR_INT) {
8986 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8988 else {
8989 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8991 if (endptr != t->token + t->len) {
8992 /* Conversion failed, so just store it as a string */
8993 Jim_FreeNewObj(interp, token->objPtr);
8994 token->type = JIM_TT_STR;
8995 goto strexpr;
8997 token->type = t->type;
8998 expr->len++;
9000 break;
9002 case JIM_TT_SUBEXPR_START:
9003 Jim_StackPush(&stack, t);
9004 prevtt = JIM_TT_NONE;
9005 continue;
9007 case JIM_TT_SUBEXPR_COMMA:
9008 /* Simple approach. Comma is simply ignored */
9009 continue;
9011 case JIM_TT_SUBEXPR_END:
9012 ok = 0;
9013 while (Jim_StackLen(&stack)) {
9014 ParseToken *tt = Jim_StackPop(&stack);
9016 if (tt->type == JIM_TT_SUBEXPR_START) {
9017 ok = 1;
9018 break;
9021 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9022 goto err;
9025 if (!ok) {
9026 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9027 goto err;
9029 break;
9032 default:{
9033 /* Must be an operator */
9034 const struct Jim_ExprOperator *op;
9035 ParseToken *tt;
9037 /* Convert -/+ to unary minus or unary plus if necessary */
9038 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9039 if (t->type == JIM_EXPROP_SUB) {
9040 t->type = JIM_EXPROP_UNARYMINUS;
9042 else if (t->type == JIM_EXPROP_ADD) {
9043 t->type = JIM_EXPROP_UNARYPLUS;
9047 op = JimExprOperatorInfoByOpcode(t->type);
9049 /* Now handle precedence */
9050 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9051 const struct Jim_ExprOperator *tt_op =
9052 JimExprOperatorInfoByOpcode(tt->type);
9054 /* Note that right-to-left associativity of ?: operator is handled later */
9056 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9057 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9058 ok = 0;
9059 goto err;
9061 Jim_StackPop(&stack);
9063 else {
9064 break;
9067 Jim_StackPush(&stack, t);
9068 break;
9071 prevtt = t->type;
9074 /* Reduce any remaining subexpr */
9075 while (Jim_StackLen(&stack)) {
9076 ParseToken *tt = Jim_StackPop(&stack);
9078 if (tt->type == JIM_TT_SUBEXPR_START) {
9079 ok = 0;
9080 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9081 goto err;
9083 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9084 ok = 0;
9085 goto err;
9089 if (have_ternary) {
9090 ExprTernaryReorderExpression(interp, expr);
9093 err:
9094 /* Free the stack used for the compilation. */
9095 Jim_FreeStack(&stack);
9097 for (i = 0; i < expr->len; i++) {
9098 Jim_IncrRefCount(expr->token[i].objPtr);
9101 if (!ok) {
9102 ExprFreeByteCode(interp, expr);
9103 return NULL;
9106 return expr;
9110 /* This method takes the string representation of an expression
9111 * and generates a program for the Expr's stack-based VM. */
9112 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9114 int exprTextLen;
9115 const char *exprText;
9116 struct JimParserCtx parser;
9117 struct ExprByteCode *expr;
9118 ParseTokenList tokenlist;
9119 int line;
9120 Jim_Obj *fileNameObj;
9121 int rc = JIM_ERR;
9123 /* Try to get information about filename / line number */
9124 if (objPtr->typePtr == &sourceObjType) {
9125 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9126 line = objPtr->internalRep.sourceValue.lineNumber;
9128 else {
9129 fileNameObj = interp->emptyObj;
9130 line = 1;
9132 Jim_IncrRefCount(fileNameObj);
9134 exprText = Jim_GetString(objPtr, &exprTextLen);
9136 /* Initially tokenise the expression into tokenlist */
9137 ScriptTokenListInit(&tokenlist);
9139 JimParserInit(&parser, exprText, exprTextLen, line);
9140 while (!parser.eof) {
9141 if (JimParseExpression(&parser) != JIM_OK) {
9142 ScriptTokenListFree(&tokenlist);
9143 invalidexpr:
9144 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9145 expr = NULL;
9146 goto err;
9149 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9150 parser.tline);
9153 #ifdef DEBUG_SHOW_EXPR_TOKENS
9155 int i;
9156 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9157 for (i = 0; i < tokenlist.count; i++) {
9158 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9159 tokenlist.list[i].len, tokenlist.list[i].token);
9162 #endif
9164 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9165 ScriptTokenListFree(&tokenlist);
9166 Jim_DecrRefCount(interp, fileNameObj);
9167 return JIM_ERR;
9170 /* Now create the expression bytecode from the tokenlist */
9171 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9173 /* No longer need the token list */
9174 ScriptTokenListFree(&tokenlist);
9176 if (!expr) {
9177 goto err;
9180 #ifdef DEBUG_SHOW_EXPR
9182 int i;
9184 printf("==== Expr ====\n");
9185 for (i = 0; i < expr->len; i++) {
9186 ScriptToken *t = &expr->token[i];
9188 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9191 #endif
9193 /* Check program correctness. */
9194 if (ExprCheckCorrectness(expr) != JIM_OK) {
9195 ExprFreeByteCode(interp, expr);
9196 goto invalidexpr;
9199 rc = JIM_OK;
9201 err:
9202 /* Free the old internal rep and set the new one. */
9203 Jim_DecrRefCount(interp, fileNameObj);
9204 Jim_FreeIntRep(interp, objPtr);
9205 Jim_SetIntRepPtr(objPtr, expr);
9206 objPtr->typePtr = &exprObjType;
9207 return rc;
9210 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9212 if (objPtr->typePtr != &exprObjType) {
9213 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9214 return NULL;
9217 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9220 #ifdef JIM_OPTIMIZATION
9221 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9223 if (token->type == JIM_TT_EXPR_INT)
9224 return token->objPtr;
9225 else if (token->type == JIM_TT_VAR)
9226 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9227 else if (token->type == JIM_TT_DICTSUGAR)
9228 return JimExpandDictSugar(interp, token->objPtr);
9229 else
9230 return NULL;
9232 #endif
9234 /* -----------------------------------------------------------------------------
9235 * Expressions evaluation.
9236 * Jim uses a specialized stack-based virtual machine for expressions,
9237 * that takes advantage of the fact that expr's operators
9238 * can't be redefined.
9240 * Jim_EvalExpression() uses the bytecode compiled by
9241 * SetExprFromAny() method of the "expression" object.
9243 * On success a Tcl Object containing the result of the evaluation
9244 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9245 * returned.
9246 * On error the function returns a retcode != to JIM_OK and set a suitable
9247 * error on the interp.
9248 * ---------------------------------------------------------------------------*/
9249 #define JIM_EE_STATICSTACK_LEN 10
9251 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9253 ExprByteCode *expr;
9254 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9255 int i;
9256 int retcode = JIM_OK;
9257 struct JimExprState e;
9259 expr = JimGetExpression(interp, exprObjPtr);
9260 if (!expr) {
9261 return JIM_ERR; /* error in expression. */
9264 #ifdef JIM_OPTIMIZATION
9265 /* Check for one of the following common expressions used by while/for
9267 * CONST
9268 * $a
9269 * !$a
9270 * $a < CONST, $a < $b
9271 * $a <= CONST, $a <= $b
9272 * $a > CONST, $a > $b
9273 * $a >= CONST, $a >= $b
9274 * $a != CONST, $a != $b
9275 * $a == CONST, $a == $b
9278 Jim_Obj *objPtr;
9280 /* STEP 1 -- Check if there are the conditions to run the specialized
9281 * version of while */
9283 switch (expr->len) {
9284 case 1:
9285 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9286 if (objPtr) {
9287 Jim_IncrRefCount(objPtr);
9288 *exprResultPtrPtr = objPtr;
9289 return JIM_OK;
9291 break;
9293 case 2:
9294 if (expr->token[1].type == JIM_EXPROP_NOT) {
9295 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9297 if (objPtr && JimIsWide(objPtr)) {
9298 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9299 Jim_IncrRefCount(*exprResultPtrPtr);
9300 return JIM_OK;
9303 break;
9305 case 3:
9306 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9307 if (objPtr && JimIsWide(objPtr)) {
9308 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9309 if (objPtr2 && JimIsWide(objPtr2)) {
9310 jim_wide wideValueA = JimWideValue(objPtr);
9311 jim_wide wideValueB = JimWideValue(objPtr2);
9312 int cmpRes;
9313 switch (expr->token[2].type) {
9314 case JIM_EXPROP_LT:
9315 cmpRes = wideValueA < wideValueB;
9316 break;
9317 case JIM_EXPROP_LTE:
9318 cmpRes = wideValueA <= wideValueB;
9319 break;
9320 case JIM_EXPROP_GT:
9321 cmpRes = wideValueA > wideValueB;
9322 break;
9323 case JIM_EXPROP_GTE:
9324 cmpRes = wideValueA >= wideValueB;
9325 break;
9326 case JIM_EXPROP_NUMEQ:
9327 cmpRes = wideValueA == wideValueB;
9328 break;
9329 case JIM_EXPROP_NUMNE:
9330 cmpRes = wideValueA != wideValueB;
9331 break;
9332 default:
9333 goto noopt;
9335 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9336 Jim_IncrRefCount(*exprResultPtrPtr);
9337 return JIM_OK;
9340 break;
9343 noopt:
9344 #endif
9346 /* In order to avoid that the internal repr gets freed due to
9347 * shimmering of the exprObjPtr's object, we make the internal rep
9348 * shared. */
9349 expr->inUse++;
9351 /* The stack-based expr VM itself */
9353 /* Stack allocation. Expr programs have the feature that
9354 * a program of length N can't require a stack longer than
9355 * N. */
9356 if (expr->len > JIM_EE_STATICSTACK_LEN)
9357 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9358 else
9359 e.stack = staticStack;
9361 e.stacklen = 0;
9363 /* Execute every instruction */
9364 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9365 Jim_Obj *objPtr;
9367 switch (expr->token[i].type) {
9368 case JIM_TT_EXPR_INT:
9369 case JIM_TT_EXPR_DOUBLE:
9370 case JIM_TT_STR:
9371 ExprPush(&e, expr->token[i].objPtr);
9372 break;
9374 case JIM_TT_VAR:
9375 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9376 if (objPtr) {
9377 ExprPush(&e, objPtr);
9379 else {
9380 retcode = JIM_ERR;
9382 break;
9384 case JIM_TT_DICTSUGAR:
9385 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9386 if (objPtr) {
9387 ExprPush(&e, objPtr);
9389 else {
9390 retcode = JIM_ERR;
9392 break;
9394 case JIM_TT_ESC:
9395 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9396 if (retcode == JIM_OK) {
9397 ExprPush(&e, objPtr);
9399 break;
9401 case JIM_TT_CMD:
9402 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9403 if (retcode == JIM_OK) {
9404 ExprPush(&e, Jim_GetResult(interp));
9406 break;
9408 default:{
9409 /* Find and execute the operation */
9410 e.skip = 0;
9411 e.opcode = expr->token[i].type;
9413 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9414 /* Skip some opcodes if necessary */
9415 i += e.skip;
9416 continue;
9421 expr->inUse--;
9423 if (retcode == JIM_OK) {
9424 *exprResultPtrPtr = ExprPop(&e);
9426 else {
9427 for (i = 0; i < e.stacklen; i++) {
9428 Jim_DecrRefCount(interp, e.stack[i]);
9431 if (e.stack != staticStack) {
9432 Jim_Free(e.stack);
9434 return retcode;
9437 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9439 int retcode;
9440 jim_wide wideValue;
9441 double doubleValue;
9442 Jim_Obj *exprResultPtr;
9444 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9445 if (retcode != JIM_OK)
9446 return retcode;
9448 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9449 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9450 Jim_DecrRefCount(interp, exprResultPtr);
9451 return JIM_ERR;
9453 else {
9454 Jim_DecrRefCount(interp, exprResultPtr);
9455 *boolPtr = doubleValue != 0;
9456 return JIM_OK;
9459 *boolPtr = wideValue != 0;
9461 Jim_DecrRefCount(interp, exprResultPtr);
9462 return JIM_OK;
9465 /* -----------------------------------------------------------------------------
9466 * ScanFormat String Object
9467 * ---------------------------------------------------------------------------*/
9469 /* This Jim_Obj will held a parsed representation of a format string passed to
9470 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9471 * to be parsed in its entirely first and then, if correct, can be used for
9472 * scanning. To avoid endless re-parsing, the parsed representation will be
9473 * stored in an internal representation and re-used for performance reason. */
9475 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9476 * scanformat string. This part will later be used to extract information
9477 * out from the string to be parsed by Jim_ScanString */
9479 typedef struct ScanFmtPartDescr
9481 char *arg; /* Specification of a CHARSET conversion */
9482 char *prefix; /* Prefix to be scanned literally before conversion */
9483 size_t width; /* Maximal width of input to be converted */
9484 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9485 char type; /* Type of conversion (e.g. c, d, f) */
9486 char modifier; /* Modify type (e.g. l - long, h - short */
9487 } ScanFmtPartDescr;
9489 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9490 * string parsed and separated in part descriptions. Furthermore it contains
9491 * the original string representation of the scanformat string to allow for
9492 * fast update of the Jim_Obj's string representation part.
9494 * As an add-on the internal object representation adds some scratch pad area
9495 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9496 * memory for purpose of string scanning.
9498 * The error member points to a static allocated string in case of a mal-
9499 * formed scanformat string or it contains '0' (NULL) in case of a valid
9500 * parse representation.
9502 * The whole memory of the internal representation is allocated as a single
9503 * area of memory that will be internally separated. So freeing and duplicating
9504 * of such an object is cheap */
9506 typedef struct ScanFmtStringObj
9508 jim_wide size; /* Size of internal repr in bytes */
9509 char *stringRep; /* Original string representation */
9510 size_t count; /* Number of ScanFmtPartDescr contained */
9511 size_t convCount; /* Number of conversions that will assign */
9512 size_t maxPos; /* Max position index if XPG3 is used */
9513 const char *error; /* Ptr to error text (NULL if no error */
9514 char *scratch; /* Some scratch pad used by Jim_ScanString */
9515 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9516 } ScanFmtStringObj;
9519 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9520 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9521 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9523 static const Jim_ObjType scanFmtStringObjType = {
9524 "scanformatstring",
9525 FreeScanFmtInternalRep,
9526 DupScanFmtInternalRep,
9527 UpdateStringOfScanFmt,
9528 JIM_TYPE_NONE,
9531 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9533 JIM_NOTUSED(interp);
9534 Jim_Free((char *)objPtr->internalRep.ptr);
9535 objPtr->internalRep.ptr = 0;
9538 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9540 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9541 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9543 JIM_NOTUSED(interp);
9544 memcpy(newVec, srcPtr->internalRep.ptr, size);
9545 dupPtr->internalRep.ptr = newVec;
9546 dupPtr->typePtr = &scanFmtStringObjType;
9549 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9551 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9554 /* SetScanFmtFromAny will parse a given string and create the internal
9555 * representation of the format specification. In case of an error
9556 * the error data member of the internal representation will be set
9557 * to an descriptive error text and the function will be left with
9558 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9559 * specification */
9561 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9563 ScanFmtStringObj *fmtObj;
9564 char *buffer;
9565 int maxCount, i, approxSize, lastPos = -1;
9566 const char *fmt = objPtr->bytes;
9567 int maxFmtLen = objPtr->length;
9568 const char *fmtEnd = fmt + maxFmtLen;
9569 int curr;
9571 Jim_FreeIntRep(interp, objPtr);
9572 /* Count how many conversions could take place maximally */
9573 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9574 if (fmt[i] == '%')
9575 ++maxCount;
9576 /* Calculate an approximation of the memory necessary */
9577 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9578 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9579 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9580 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9581 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9582 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9583 +1; /* safety byte */
9584 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9585 memset(fmtObj, 0, approxSize);
9586 fmtObj->size = approxSize;
9587 fmtObj->maxPos = 0;
9588 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9589 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9590 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9591 buffer = fmtObj->stringRep + maxFmtLen + 1;
9592 objPtr->internalRep.ptr = fmtObj;
9593 objPtr->typePtr = &scanFmtStringObjType;
9594 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9595 int width = 0, skip;
9596 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9598 fmtObj->count++;
9599 descr->width = 0; /* Assume width unspecified */
9600 /* Overread and store any "literal" prefix */
9601 if (*fmt != '%' || fmt[1] == '%') {
9602 descr->type = 0;
9603 descr->prefix = &buffer[i];
9604 for (; fmt < fmtEnd; ++fmt) {
9605 if (*fmt == '%') {
9606 if (fmt[1] != '%')
9607 break;
9608 ++fmt;
9610 buffer[i++] = *fmt;
9612 buffer[i++] = 0;
9614 /* Skip the conversion introducing '%' sign */
9615 ++fmt;
9616 /* End reached due to non-conversion literal only? */
9617 if (fmt >= fmtEnd)
9618 goto done;
9619 descr->pos = 0; /* Assume "natural" positioning */
9620 if (*fmt == '*') {
9621 descr->pos = -1; /* Okay, conversion will not be assigned */
9622 ++fmt;
9624 else
9625 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9626 /* Check if next token is a number (could be width or pos */
9627 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9628 fmt += skip;
9629 /* Was the number a XPG3 position specifier? */
9630 if (descr->pos != -1 && *fmt == '$') {
9631 int prev;
9633 ++fmt;
9634 descr->pos = width;
9635 width = 0;
9636 /* Look if "natural" postioning and XPG3 one was mixed */
9637 if ((lastPos == 0 && descr->pos > 0)
9638 || (lastPos > 0 && descr->pos == 0)) {
9639 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9640 return JIM_ERR;
9642 /* Look if this position was already used */
9643 for (prev = 0; prev < curr; ++prev) {
9644 if (fmtObj->descr[prev].pos == -1)
9645 continue;
9646 if (fmtObj->descr[prev].pos == descr->pos) {
9647 fmtObj->error =
9648 "variable is assigned by multiple \"%n$\" conversion specifiers";
9649 return JIM_ERR;
9652 /* Try to find a width after the XPG3 specifier */
9653 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9654 descr->width = width;
9655 fmt += skip;
9657 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9658 fmtObj->maxPos = descr->pos;
9660 else {
9661 /* Number was not a XPG3, so it has to be a width */
9662 descr->width = width;
9665 /* If positioning mode was undetermined yet, fix this */
9666 if (lastPos == -1)
9667 lastPos = descr->pos;
9668 /* Handle CHARSET conversion type ... */
9669 if (*fmt == '[') {
9670 int swapped = 1, beg = i, end, j;
9672 descr->type = '[';
9673 descr->arg = &buffer[i];
9674 ++fmt;
9675 if (*fmt == '^')
9676 buffer[i++] = *fmt++;
9677 if (*fmt == ']')
9678 buffer[i++] = *fmt++;
9679 while (*fmt && *fmt != ']')
9680 buffer[i++] = *fmt++;
9681 if (*fmt != ']') {
9682 fmtObj->error = "unmatched [ in format string";
9683 return JIM_ERR;
9685 end = i;
9686 buffer[i++] = 0;
9687 /* In case a range fence was given "backwards", swap it */
9688 while (swapped) {
9689 swapped = 0;
9690 for (j = beg + 1; j < end - 1; ++j) {
9691 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9692 char tmp = buffer[j - 1];
9694 buffer[j - 1] = buffer[j + 1];
9695 buffer[j + 1] = tmp;
9696 swapped = 1;
9701 else {
9702 /* Remember any valid modifier if given */
9703 if (strchr("hlL", *fmt) != 0)
9704 descr->modifier = tolower((int)*fmt++);
9706 descr->type = *fmt;
9707 if (strchr("efgcsndoxui", *fmt) == 0) {
9708 fmtObj->error = "bad scan conversion character";
9709 return JIM_ERR;
9711 else if (*fmt == 'c' && descr->width != 0) {
9712 fmtObj->error = "field width may not be specified in %c " "conversion";
9713 return JIM_ERR;
9715 else if (*fmt == 'u' && descr->modifier == 'l') {
9716 fmtObj->error = "unsigned wide not supported";
9717 return JIM_ERR;
9720 curr++;
9722 done:
9723 return JIM_OK;
9726 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9728 #define FormatGetCnvCount(_fo_) \
9729 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9730 #define FormatGetMaxPos(_fo_) \
9731 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9732 #define FormatGetError(_fo_) \
9733 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9735 /* JimScanAString is used to scan an unspecified string that ends with
9736 * next WS, or a string that is specified via a charset.
9739 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9741 char *buffer = Jim_StrDup(str);
9742 char *p = buffer;
9744 while (*str) {
9745 int c;
9746 int n;
9748 if (!sdescr && isspace(UCHAR(*str)))
9749 break; /* EOS via WS if unspecified */
9751 n = utf8_tounicode(str, &c);
9752 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9753 break;
9754 while (n--)
9755 *p++ = *str++;
9757 *p = 0;
9758 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9761 /* ScanOneEntry will scan one entry out of the string passed as argument.
9762 * It use the sscanf() function for this task. After extracting and
9763 * converting of the value, the count of scanned characters will be
9764 * returned of -1 in case of no conversion tool place and string was
9765 * already scanned thru */
9767 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9768 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9770 const char *tok;
9771 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9772 size_t scanned = 0;
9773 size_t anchor = pos;
9774 int i;
9775 Jim_Obj *tmpObj = NULL;
9777 /* First pessimistically assume, we will not scan anything :-) */
9778 *valObjPtr = 0;
9779 if (descr->prefix) {
9780 /* There was a prefix given before the conversion, skip it and adjust
9781 * the string-to-be-parsed accordingly */
9782 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9783 /* If prefix require, skip WS */
9784 if (isspace(UCHAR(descr->prefix[i])))
9785 while (pos < strLen && isspace(UCHAR(str[pos])))
9786 ++pos;
9787 else if (descr->prefix[i] != str[pos])
9788 break; /* Prefix do not match here, leave the loop */
9789 else
9790 ++pos; /* Prefix matched so far, next round */
9792 if (pos >= strLen) {
9793 return -1; /* All of str consumed: EOF condition */
9795 else if (descr->prefix[i] != 0)
9796 return 0; /* Not whole prefix consumed, no conversion possible */
9798 /* For all but following conversion, skip leading WS */
9799 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9800 while (isspace(UCHAR(str[pos])))
9801 ++pos;
9802 /* Determine how much skipped/scanned so far */
9803 scanned = pos - anchor;
9805 /* %c is a special, simple case. no width */
9806 if (descr->type == 'n') {
9807 /* Return pseudo conversion means: how much scanned so far? */
9808 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9810 else if (pos >= strLen) {
9811 /* Cannot scan anything, as str is totally consumed */
9812 return -1;
9814 else if (descr->type == 'c') {
9815 int c;
9816 scanned += utf8_tounicode(&str[pos], &c);
9817 *valObjPtr = Jim_NewIntObj(interp, c);
9818 return scanned;
9820 else {
9821 /* Processing of conversions follows ... */
9822 if (descr->width > 0) {
9823 /* Do not try to scan as fas as possible but only the given width.
9824 * To ensure this, we copy the part that should be scanned. */
9825 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9826 size_t tLen = descr->width > sLen ? sLen : descr->width;
9828 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9829 tok = tmpObj->bytes;
9831 else {
9832 /* As no width was given, simply refer to the original string */
9833 tok = &str[pos];
9835 switch (descr->type) {
9836 case 'd':
9837 case 'o':
9838 case 'x':
9839 case 'u':
9840 case 'i':{
9841 char *endp; /* Position where the number finished */
9842 jim_wide w;
9844 int base = descr->type == 'o' ? 8
9845 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9847 /* Try to scan a number with the given base */
9848 if (base == 0) {
9849 w = jim_strtoull(tok, &endp);
9851 else {
9852 w = strtoull(tok, &endp, base);
9855 if (endp != tok) {
9856 /* There was some number sucessfully scanned! */
9857 *valObjPtr = Jim_NewIntObj(interp, w);
9859 /* Adjust the number-of-chars scanned so far */
9860 scanned += endp - tok;
9862 else {
9863 /* Nothing was scanned. We have to determine if this
9864 * happened due to e.g. prefix mismatch or input str
9865 * exhausted */
9866 scanned = *tok ? 0 : -1;
9868 break;
9870 case 's':
9871 case '[':{
9872 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9873 scanned += Jim_Length(*valObjPtr);
9874 break;
9876 case 'e':
9877 case 'f':
9878 case 'g':{
9879 char *endp;
9880 double value = strtod(tok, &endp);
9882 if (endp != tok) {
9883 /* There was some number sucessfully scanned! */
9884 *valObjPtr = Jim_NewDoubleObj(interp, value);
9885 /* Adjust the number-of-chars scanned so far */
9886 scanned += endp - tok;
9888 else {
9889 /* Nothing was scanned. We have to determine if this
9890 * happened due to e.g. prefix mismatch or input str
9891 * exhausted */
9892 scanned = *tok ? 0 : -1;
9894 break;
9897 /* If a substring was allocated (due to pre-defined width) do not
9898 * forget to free it */
9899 if (tmpObj) {
9900 Jim_FreeNewObj(interp, tmpObj);
9903 return scanned;
9906 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9907 * string and returns all converted (and not ignored) values in a list back
9908 * to the caller. If an error occured, a NULL pointer will be returned */
9910 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9912 size_t i, pos;
9913 int scanned = 1;
9914 const char *str = Jim_String(strObjPtr);
9915 int strLen = Jim_Utf8Length(interp, strObjPtr);
9916 Jim_Obj *resultList = 0;
9917 Jim_Obj **resultVec = 0;
9918 int resultc;
9919 Jim_Obj *emptyStr = 0;
9920 ScanFmtStringObj *fmtObj;
9922 /* This should never happen. The format object should already be of the correct type */
9923 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9925 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9926 /* Check if format specification was valid */
9927 if (fmtObj->error != 0) {
9928 if (flags & JIM_ERRMSG)
9929 Jim_SetResultString(interp, fmtObj->error, -1);
9930 return 0;
9932 /* Allocate a new "shared" empty string for all unassigned conversions */
9933 emptyStr = Jim_NewEmptyStringObj(interp);
9934 Jim_IncrRefCount(emptyStr);
9935 /* Create a list and fill it with empty strings up to max specified XPG3 */
9936 resultList = Jim_NewListObj(interp, NULL, 0);
9937 if (fmtObj->maxPos > 0) {
9938 for (i = 0; i < fmtObj->maxPos; ++i)
9939 Jim_ListAppendElement(interp, resultList, emptyStr);
9940 JimListGetElements(interp, resultList, &resultc, &resultVec);
9942 /* Now handle every partial format description */
9943 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9944 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9945 Jim_Obj *value = 0;
9947 /* Only last type may be "literal" w/o conversion - skip it! */
9948 if (descr->type == 0)
9949 continue;
9950 /* As long as any conversion could be done, we will proceed */
9951 if (scanned > 0)
9952 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9953 /* In case our first try results in EOF, we will leave */
9954 if (scanned == -1 && i == 0)
9955 goto eof;
9956 /* Advance next pos-to-be-scanned for the amount scanned already */
9957 pos += scanned;
9959 /* value == 0 means no conversion took place so take empty string */
9960 if (value == 0)
9961 value = Jim_NewEmptyStringObj(interp);
9962 /* If value is a non-assignable one, skip it */
9963 if (descr->pos == -1) {
9964 Jim_FreeNewObj(interp, value);
9966 else if (descr->pos == 0)
9967 /* Otherwise append it to the result list if no XPG3 was given */
9968 Jim_ListAppendElement(interp, resultList, value);
9969 else if (resultVec[descr->pos - 1] == emptyStr) {
9970 /* But due to given XPG3, put the value into the corr. slot */
9971 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9972 Jim_IncrRefCount(value);
9973 resultVec[descr->pos - 1] = value;
9975 else {
9976 /* Otherwise, the slot was already used - free obj and ERROR */
9977 Jim_FreeNewObj(interp, value);
9978 goto err;
9981 Jim_DecrRefCount(interp, emptyStr);
9982 return resultList;
9983 eof:
9984 Jim_DecrRefCount(interp, emptyStr);
9985 Jim_FreeNewObj(interp, resultList);
9986 return (Jim_Obj *)EOF;
9987 err:
9988 Jim_DecrRefCount(interp, emptyStr);
9989 Jim_FreeNewObj(interp, resultList);
9990 return 0;
9993 /* -----------------------------------------------------------------------------
9994 * Pseudo Random Number Generation
9995 * ---------------------------------------------------------------------------*/
9996 /* Initialize the sbox with the numbers from 0 to 255 */
9997 static void JimPrngInit(Jim_Interp *interp)
9999 #define PRNG_SEED_SIZE 256
10000 int i;
10001 unsigned int *seed;
10002 time_t t = time(NULL);
10004 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10006 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10007 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10008 seed[i] = (rand() ^ t ^ clock());
10010 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10011 Jim_Free(seed);
10014 /* Generates N bytes of random data */
10015 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10017 Jim_PrngState *prng;
10018 unsigned char *destByte = (unsigned char *)dest;
10019 unsigned int si, sj, x;
10021 /* initialization, only needed the first time */
10022 if (interp->prngState == NULL)
10023 JimPrngInit(interp);
10024 prng = interp->prngState;
10025 /* generates 'len' bytes of pseudo-random numbers */
10026 for (x = 0; x < len; x++) {
10027 prng->i = (prng->i + 1) & 0xff;
10028 si = prng->sbox[prng->i];
10029 prng->j = (prng->j + si) & 0xff;
10030 sj = prng->sbox[prng->j];
10031 prng->sbox[prng->i] = sj;
10032 prng->sbox[prng->j] = si;
10033 *destByte++ = prng->sbox[(si + sj) & 0xff];
10037 /* Re-seed the generator with user-provided bytes */
10038 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10040 int i;
10041 Jim_PrngState *prng;
10043 /* initialization, only needed the first time */
10044 if (interp->prngState == NULL)
10045 JimPrngInit(interp);
10046 prng = interp->prngState;
10048 /* Set the sbox[i] with i */
10049 for (i = 0; i < 256; i++)
10050 prng->sbox[i] = i;
10051 /* Now use the seed to perform a random permutation of the sbox */
10052 for (i = 0; i < seedLen; i++) {
10053 unsigned char t;
10055 t = prng->sbox[i & 0xFF];
10056 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10057 prng->sbox[seed[i]] = t;
10059 prng->i = prng->j = 0;
10061 /* discard at least the first 256 bytes of stream.
10062 * borrow the seed buffer for this
10064 for (i = 0; i < 256; i += seedLen) {
10065 JimRandomBytes(interp, seed, seedLen);
10069 /* [incr] */
10070 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10072 jim_wide wideValue, increment = 1;
10073 Jim_Obj *intObjPtr;
10075 if (argc != 2 && argc != 3) {
10076 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10077 return JIM_ERR;
10079 if (argc == 3) {
10080 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10081 return JIM_ERR;
10083 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10084 if (!intObjPtr) {
10085 /* Set missing variable to 0 */
10086 wideValue = 0;
10088 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10089 return JIM_ERR;
10091 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10092 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10093 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10094 Jim_FreeNewObj(interp, intObjPtr);
10095 return JIM_ERR;
10098 else {
10099 /* Can do it the quick way */
10100 Jim_InvalidateStringRep(intObjPtr);
10101 JimWideValue(intObjPtr) = wideValue + increment;
10103 /* The following step is required in order to invalidate the
10104 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10105 if (argv[1]->typePtr != &variableObjType) {
10106 /* Note that this can't fail since GetVariable already succeeded */
10107 Jim_SetVariable(interp, argv[1], intObjPtr);
10110 Jim_SetResult(interp, intObjPtr);
10111 return JIM_OK;
10115 /* -----------------------------------------------------------------------------
10116 * Eval
10117 * ---------------------------------------------------------------------------*/
10118 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10119 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10121 /* Handle calls to the [unknown] command */
10122 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10124 int retcode;
10126 /* If JimUnknown() is recursively called too many times...
10127 * done here
10129 if (interp->unknown_called > 50) {
10130 return JIM_ERR;
10133 /* The object interp->unknown just contains
10134 * the "unknown" string, it is used in order to
10135 * avoid to lookup the unknown command every time
10136 * but instead to cache the result. */
10138 /* If the [unknown] command does not exist ... */
10139 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10140 return JIM_ERR;
10142 interp->unknown_called++;
10143 /* XXX: Are we losing fileNameObj and linenr? */
10144 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10145 interp->unknown_called--;
10147 return retcode;
10150 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10152 int retcode;
10153 Jim_Cmd *cmdPtr;
10155 #if 0
10156 printf("invoke");
10157 int j;
10158 for (j = 0; j < objc; j++) {
10159 printf(" '%s'", Jim_String(objv[j]));
10161 printf("\n");
10162 #endif
10164 if (interp->framePtr->tailcallCmd) {
10165 /* Special tailcall command was pre-resolved */
10166 cmdPtr = interp->framePtr->tailcallCmd;
10167 interp->framePtr->tailcallCmd = NULL;
10169 else {
10170 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10171 if (cmdPtr == NULL) {
10172 return JimUnknown(interp, objc, objv);
10174 JimIncrCmdRefCount(cmdPtr);
10177 if (interp->evalDepth == interp->maxEvalDepth) {
10178 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10179 retcode = JIM_ERR;
10180 goto out;
10182 interp->evalDepth++;
10184 /* Call it -- Make sure result is an empty object. */
10185 Jim_SetEmptyResult(interp);
10186 if (cmdPtr->isproc) {
10187 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10189 else {
10190 interp->cmdPrivData = cmdPtr->u.native.privData;
10191 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10193 interp->evalDepth--;
10195 out:
10196 JimDecrCmdRefCount(interp, cmdPtr);
10198 return retcode;
10201 /* Eval the object vector 'objv' composed of 'objc' elements.
10202 * Every element is used as single argument.
10203 * Jim_EvalObj() will call this function every time its object
10204 * argument is of "list" type, with no string representation.
10206 * This is possible because the string representation of a
10207 * list object generated by the UpdateStringOfList is made
10208 * in a way that ensures that every list element is a different
10209 * command argument. */
10210 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10212 int i, retcode;
10214 /* Incr refcount of arguments. */
10215 for (i = 0; i < objc; i++)
10216 Jim_IncrRefCount(objv[i]);
10218 retcode = JimInvokeCommand(interp, objc, objv);
10220 /* Decr refcount of arguments and return the retcode */
10221 for (i = 0; i < objc; i++)
10222 Jim_DecrRefCount(interp, objv[i]);
10224 return retcode;
10228 * Invokes 'prefix' as a command with the objv array as arguments.
10230 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10232 int ret;
10233 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10235 nargv[0] = prefix;
10236 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10237 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10238 Jim_Free(nargv);
10239 return ret;
10242 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10244 if (!interp->errorFlag) {
10245 /* This is the first error, so save the file/line information and reset the stack */
10246 interp->errorFlag = 1;
10247 Jim_IncrRefCount(script->fileNameObj);
10248 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10249 interp->errorFileNameObj = script->fileNameObj;
10250 interp->errorLine = script->linenr;
10252 JimResetStackTrace(interp);
10253 /* Always add a level where the error first occurs */
10254 interp->addStackTrace++;
10257 /* Now if this is an "interesting" level, add it to the stack trace */
10258 if (interp->addStackTrace > 0) {
10259 /* Add the stack info for the current level */
10261 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10263 /* Note: if we didn't have a filename for this level,
10264 * don't clear the addStackTrace flag
10265 * so we can pick it up at the next level
10267 if (Jim_Length(script->fileNameObj)) {
10268 interp->addStackTrace = 0;
10271 Jim_DecrRefCount(interp, interp->errorProc);
10272 interp->errorProc = interp->emptyObj;
10273 Jim_IncrRefCount(interp->errorProc);
10277 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10279 Jim_Obj *objPtr;
10281 switch (token->type) {
10282 case JIM_TT_STR:
10283 case JIM_TT_ESC:
10284 objPtr = token->objPtr;
10285 break;
10286 case JIM_TT_VAR:
10287 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10288 break;
10289 case JIM_TT_DICTSUGAR:
10290 objPtr = JimExpandDictSugar(interp, token->objPtr);
10291 break;
10292 case JIM_TT_EXPRSUGAR:
10293 objPtr = JimExpandExprSugar(interp, token->objPtr);
10294 break;
10295 case JIM_TT_CMD:
10296 switch (Jim_EvalObj(interp, token->objPtr)) {
10297 case JIM_OK:
10298 case JIM_RETURN:
10299 objPtr = interp->result;
10300 break;
10301 case JIM_BREAK:
10302 /* Stop substituting */
10303 return JIM_BREAK;
10304 case JIM_CONTINUE:
10305 /* just skip this one */
10306 return JIM_CONTINUE;
10307 default:
10308 return JIM_ERR;
10310 break;
10311 default:
10312 JimPanic((1,
10313 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10314 objPtr = NULL;
10315 break;
10317 if (objPtr) {
10318 *objPtrPtr = objPtr;
10319 return JIM_OK;
10321 return JIM_ERR;
10324 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10325 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10326 * The returned object has refcount = 0.
10328 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10330 int totlen = 0, i;
10331 Jim_Obj **intv;
10332 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10333 Jim_Obj *objPtr;
10334 char *s;
10336 if (tokens <= JIM_EVAL_SINTV_LEN)
10337 intv = sintv;
10338 else
10339 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10341 /* Compute every token forming the argument
10342 * in the intv objects vector. */
10343 for (i = 0; i < tokens; i++) {
10344 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10345 case JIM_OK:
10346 case JIM_RETURN:
10347 break;
10348 case JIM_BREAK:
10349 if (flags & JIM_SUBST_FLAG) {
10350 /* Stop here */
10351 tokens = i;
10352 continue;
10354 /* XXX: Should probably set an error about break outside loop */
10355 /* fall through to error */
10356 case JIM_CONTINUE:
10357 if (flags & JIM_SUBST_FLAG) {
10358 intv[i] = NULL;
10359 continue;
10361 /* XXX: Ditto continue outside loop */
10362 /* fall through to error */
10363 default:
10364 while (i--) {
10365 Jim_DecrRefCount(interp, intv[i]);
10367 if (intv != sintv) {
10368 Jim_Free(intv);
10370 return NULL;
10372 Jim_IncrRefCount(intv[i]);
10373 Jim_String(intv[i]);
10374 totlen += intv[i]->length;
10377 /* Fast path return for a single token */
10378 if (tokens == 1 && intv[0] && intv == sintv) {
10379 Jim_DecrRefCount(interp, intv[0]);
10380 return intv[0];
10383 /* Concatenate every token in an unique
10384 * object. */
10385 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10387 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10388 && token[2].type == JIM_TT_VAR) {
10389 /* May be able to do fast interpolated object -> dictSubst */
10390 objPtr->typePtr = &interpolatedObjType;
10391 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10392 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10393 Jim_IncrRefCount(intv[2]);
10395 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10396 /* The first interpolated token is source, so preserve the source info */
10397 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10401 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10402 objPtr->length = totlen;
10403 for (i = 0; i < tokens; i++) {
10404 if (intv[i]) {
10405 memcpy(s, intv[i]->bytes, intv[i]->length);
10406 s += intv[i]->length;
10407 Jim_DecrRefCount(interp, intv[i]);
10410 objPtr->bytes[totlen] = '\0';
10411 /* Free the intv vector if not static. */
10412 if (intv != sintv) {
10413 Jim_Free(intv);
10416 return objPtr;
10420 /* listPtr *must* be a list.
10421 * The contents of the list is evaluated with the first element as the command and
10422 * the remaining elements as the arguments.
10424 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10426 int retcode = JIM_OK;
10428 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10430 if (listPtr->internalRep.listValue.len) {
10431 Jim_IncrRefCount(listPtr);
10432 retcode = JimInvokeCommand(interp,
10433 listPtr->internalRep.listValue.len,
10434 listPtr->internalRep.listValue.ele);
10435 Jim_DecrRefCount(interp, listPtr);
10437 return retcode;
10440 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10442 SetListFromAny(interp, listPtr);
10443 return JimEvalObjList(interp, listPtr);
10446 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10448 int i;
10449 ScriptObj *script;
10450 ScriptToken *token;
10451 int retcode = JIM_OK;
10452 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10453 Jim_Obj *prevScriptObj;
10455 /* If the object is of type "list", with no string rep we can call
10456 * a specialized version of Jim_EvalObj() */
10457 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10458 return JimEvalObjList(interp, scriptObjPtr);
10461 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10462 script = JimGetScript(interp, scriptObjPtr);
10463 if (!JimScriptValid(interp, script)) {
10464 Jim_DecrRefCount(interp, scriptObjPtr);
10465 return JIM_ERR;
10468 /* Reset the interpreter result. This is useful to
10469 * return the empty result in the case of empty program. */
10470 Jim_SetEmptyResult(interp);
10472 token = script->token;
10474 #ifdef JIM_OPTIMIZATION
10475 /* Check for one of the following common scripts used by for, while
10477 * {}
10478 * incr a
10480 if (script->len == 0) {
10481 Jim_DecrRefCount(interp, scriptObjPtr);
10482 return JIM_OK;
10484 if (script->len == 3
10485 && token[1].objPtr->typePtr == &commandObjType
10486 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10487 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10488 && token[2].objPtr->typePtr == &variableObjType) {
10490 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10492 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10493 JimWideValue(objPtr)++;
10494 Jim_InvalidateStringRep(objPtr);
10495 Jim_DecrRefCount(interp, scriptObjPtr);
10496 Jim_SetResult(interp, objPtr);
10497 return JIM_OK;
10500 #endif
10502 /* Now we have to make sure the internal repr will not be
10503 * freed on shimmering.
10505 * Think for example to this:
10507 * set x {llength $x; ... some more code ...}; eval $x
10509 * In order to preserve the internal rep, we increment the
10510 * inUse field of the script internal rep structure. */
10511 script->inUse++;
10513 /* Stash the current script */
10514 prevScriptObj = interp->currentScriptObj;
10515 interp->currentScriptObj = scriptObjPtr;
10517 interp->errorFlag = 0;
10518 argv = sargv;
10520 /* Execute every command sequentially until the end of the script
10521 * or an error occurs.
10523 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10524 int argc;
10525 int j;
10527 /* First token of the line is always JIM_TT_LINE */
10528 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10529 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10531 /* Allocate the arguments vector if required */
10532 if (argc > JIM_EVAL_SARGV_LEN)
10533 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10535 /* Skip the JIM_TT_LINE token */
10536 i++;
10538 /* Populate the arguments objects.
10539 * If an error occurs, retcode will be set and
10540 * 'j' will be set to the number of args expanded
10542 for (j = 0; j < argc; j++) {
10543 long wordtokens = 1;
10544 int expand = 0;
10545 Jim_Obj *wordObjPtr = NULL;
10547 if (token[i].type == JIM_TT_WORD) {
10548 wordtokens = JimWideValue(token[i++].objPtr);
10549 if (wordtokens < 0) {
10550 expand = 1;
10551 wordtokens = -wordtokens;
10555 if (wordtokens == 1) {
10556 /* Fast path if the token does not
10557 * need interpolation */
10559 switch (token[i].type) {
10560 case JIM_TT_ESC:
10561 case JIM_TT_STR:
10562 wordObjPtr = token[i].objPtr;
10563 break;
10564 case JIM_TT_VAR:
10565 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10566 break;
10567 case JIM_TT_EXPRSUGAR:
10568 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10569 break;
10570 case JIM_TT_DICTSUGAR:
10571 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10572 break;
10573 case JIM_TT_CMD:
10574 retcode = Jim_EvalObj(interp, token[i].objPtr);
10575 if (retcode == JIM_OK) {
10576 wordObjPtr = Jim_GetResult(interp);
10578 break;
10579 default:
10580 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10583 else {
10584 /* For interpolation we call a helper
10585 * function to do the work for us. */
10586 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10589 if (!wordObjPtr) {
10590 if (retcode == JIM_OK) {
10591 retcode = JIM_ERR;
10593 break;
10596 Jim_IncrRefCount(wordObjPtr);
10597 i += wordtokens;
10599 if (!expand) {
10600 argv[j] = wordObjPtr;
10602 else {
10603 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10604 int len = Jim_ListLength(interp, wordObjPtr);
10605 int newargc = argc + len - 1;
10606 int k;
10608 if (len > 1) {
10609 if (argv == sargv) {
10610 if (newargc > JIM_EVAL_SARGV_LEN) {
10611 argv = Jim_Alloc(sizeof(*argv) * newargc);
10612 memcpy(argv, sargv, sizeof(*argv) * j);
10615 else {
10616 /* Need to realloc to make room for (len - 1) more entries */
10617 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10621 /* Now copy in the expanded version */
10622 for (k = 0; k < len; k++) {
10623 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10624 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10627 /* The original object reference is no longer needed,
10628 * after the expansion it is no longer present on
10629 * the argument vector, but the single elements are
10630 * in its place. */
10631 Jim_DecrRefCount(interp, wordObjPtr);
10633 /* And update the indexes */
10634 j--;
10635 argc += len - 1;
10639 if (retcode == JIM_OK && argc) {
10640 /* Invoke the command */
10641 retcode = JimInvokeCommand(interp, argc, argv);
10642 /* Check for a signal after each command */
10643 if (Jim_CheckSignal(interp)) {
10644 retcode = JIM_SIGNAL;
10648 /* Finished with the command, so decrement ref counts of each argument */
10649 while (j-- > 0) {
10650 Jim_DecrRefCount(interp, argv[j]);
10653 if (argv != sargv) {
10654 Jim_Free(argv);
10655 argv = sargv;
10659 /* Possibly add to the error stack trace */
10660 if (retcode == JIM_ERR) {
10661 JimAddErrorToStack(interp, script);
10663 /* Propagate the addStackTrace value through 'return -code error' */
10664 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10665 /* No need to add stack trace */
10666 interp->addStackTrace = 0;
10669 /* Restore the current script */
10670 interp->currentScriptObj = prevScriptObj;
10672 /* Note that we don't have to decrement inUse, because the
10673 * following code transfers our use of the reference again to
10674 * the script object. */
10675 Jim_FreeIntRep(interp, scriptObjPtr);
10676 scriptObjPtr->typePtr = &scriptObjType;
10677 Jim_SetIntRepPtr(scriptObjPtr, script);
10678 Jim_DecrRefCount(interp, scriptObjPtr);
10680 return retcode;
10683 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10685 int retcode;
10686 /* If argObjPtr begins with '&', do an automatic upvar */
10687 const char *varname = Jim_String(argNameObj);
10688 if (*varname == '&') {
10689 /* First check that the target variable exists */
10690 Jim_Obj *objPtr;
10691 Jim_CallFrame *savedCallFrame = interp->framePtr;
10693 interp->framePtr = interp->framePtr->parent;
10694 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10695 interp->framePtr = savedCallFrame;
10696 if (!objPtr) {
10697 return JIM_ERR;
10700 /* It exists, so perform the binding. */
10701 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10702 Jim_IncrRefCount(objPtr);
10703 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10704 Jim_DecrRefCount(interp, objPtr);
10706 else {
10707 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10709 return retcode;
10713 * Sets the interp result to be an error message indicating the required proc args.
10715 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10717 /* Create a nice error message, consistent with Tcl 8.5 */
10718 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10719 int i;
10721 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10722 Jim_AppendString(interp, argmsg, " ", 1);
10724 if (i == cmd->u.proc.argsPos) {
10725 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10726 /* Renamed args */
10727 Jim_AppendString(interp, argmsg, "?", 1);
10728 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10729 Jim_AppendString(interp, argmsg, " ...?", -1);
10731 else {
10732 /* We have plain args */
10733 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10736 else {
10737 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10738 Jim_AppendString(interp, argmsg, "?", 1);
10739 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10740 Jim_AppendString(interp, argmsg, "?", 1);
10742 else {
10743 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10744 if (*arg == '&') {
10745 arg++;
10747 Jim_AppendString(interp, argmsg, arg, -1);
10751 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10752 Jim_FreeNewObj(interp, argmsg);
10755 #ifdef jim_ext_namespace
10757 * [namespace eval]
10759 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10761 Jim_CallFrame *callFramePtr;
10762 int retcode;
10764 /* Create a new callframe */
10765 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10766 callFramePtr->argv = &interp->emptyObj;
10767 callFramePtr->argc = 0;
10768 callFramePtr->procArgsObjPtr = NULL;
10769 callFramePtr->procBodyObjPtr = scriptObj;
10770 callFramePtr->staticVars = NULL;
10771 callFramePtr->fileNameObj = interp->emptyObj;
10772 callFramePtr->line = 0;
10773 Jim_IncrRefCount(scriptObj);
10774 interp->framePtr = callFramePtr;
10776 /* Check if there are too nested calls */
10777 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10778 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10779 retcode = JIM_ERR;
10781 else {
10782 /* Eval the body */
10783 retcode = Jim_EvalObj(interp, scriptObj);
10786 /* Destroy the callframe */
10787 interp->framePtr = interp->framePtr->parent;
10788 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10790 return retcode;
10792 #endif
10794 /* Call a procedure implemented in Tcl.
10795 * It's possible to speed-up a lot this function, currently
10796 * the callframes are not cached, but allocated and
10797 * destroied every time. What is expecially costly is
10798 * to create/destroy the local vars hash table every time.
10800 * This can be fixed just implementing callframes caching
10801 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10802 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10804 Jim_CallFrame *callFramePtr;
10805 int i, d, retcode, optargs;
10806 ScriptObj *script;
10808 /* Check arity */
10809 if (argc - 1 < cmd->u.proc.reqArity ||
10810 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10811 JimSetProcWrongArgs(interp, argv[0], cmd);
10812 return JIM_ERR;
10815 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10816 /* Optimise for procedure with no body - useful for optional debugging */
10817 return JIM_OK;
10820 /* Check if there are too nested calls */
10821 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10822 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10823 return JIM_ERR;
10826 /* Create a new callframe */
10827 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10828 callFramePtr->argv = argv;
10829 callFramePtr->argc = argc;
10830 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10831 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10832 callFramePtr->staticVars = cmd->u.proc.staticVars;
10834 /* Remember where we were called from. */
10835 script = JimGetScript(interp, interp->currentScriptObj);
10836 callFramePtr->fileNameObj = script->fileNameObj;
10837 callFramePtr->line = script->linenr;
10839 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10840 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10841 interp->framePtr = callFramePtr;
10843 /* How many optional args are available */
10844 optargs = (argc - 1 - cmd->u.proc.reqArity);
10846 /* Step 'i' along the actual args, and step 'd' along the formal args */
10847 i = 1;
10848 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10849 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10850 if (d == cmd->u.proc.argsPos) {
10851 /* assign $args */
10852 Jim_Obj *listObjPtr;
10853 int argsLen = 0;
10854 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10855 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10857 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10859 /* It is possible to rename args. */
10860 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10861 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10863 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10864 if (retcode != JIM_OK) {
10865 goto badargset;
10868 i += argsLen;
10869 continue;
10872 /* Optional or required? */
10873 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10874 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10876 else {
10877 /* Ran out, so use the default */
10878 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10880 if (retcode != JIM_OK) {
10881 goto badargset;
10885 /* Eval the body */
10886 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10888 badargset:
10890 /* Free the callframe */
10891 interp->framePtr = interp->framePtr->parent;
10892 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10894 /* Now chain any tailcalls in the parent frame */
10895 if (interp->framePtr->tailcallObj) {
10896 do {
10897 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10899 interp->framePtr->tailcallObj = NULL;
10901 if (retcode == JIM_EVAL) {
10902 retcode = Jim_EvalObjList(interp, tailcallObj);
10903 if (retcode == JIM_RETURN) {
10904 /* If the result of the tailcall is 'return', push
10905 * it up to the caller
10907 interp->returnLevel++;
10910 Jim_DecrRefCount(interp, tailcallObj);
10911 } while (interp->framePtr->tailcallObj);
10913 /* If the tailcall chain finished early, may need to manually discard the command */
10914 if (interp->framePtr->tailcallCmd) {
10915 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10916 interp->framePtr->tailcallCmd = NULL;
10920 /* Handle the JIM_RETURN return code */
10921 if (retcode == JIM_RETURN) {
10922 if (--interp->returnLevel <= 0) {
10923 retcode = interp->returnCode;
10924 interp->returnCode = JIM_OK;
10925 interp->returnLevel = 0;
10928 else if (retcode == JIM_ERR) {
10929 interp->addStackTrace++;
10930 Jim_DecrRefCount(interp, interp->errorProc);
10931 interp->errorProc = argv[0];
10932 Jim_IncrRefCount(interp->errorProc);
10935 return retcode;
10938 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10940 int retval;
10941 Jim_Obj *scriptObjPtr;
10943 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10944 Jim_IncrRefCount(scriptObjPtr);
10946 if (filename) {
10947 Jim_Obj *prevScriptObj;
10949 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10951 prevScriptObj = interp->currentScriptObj;
10952 interp->currentScriptObj = scriptObjPtr;
10954 retval = Jim_EvalObj(interp, scriptObjPtr);
10956 interp->currentScriptObj = prevScriptObj;
10958 else {
10959 retval = Jim_EvalObj(interp, scriptObjPtr);
10961 Jim_DecrRefCount(interp, scriptObjPtr);
10962 return retval;
10965 int Jim_Eval(Jim_Interp *interp, const char *script)
10967 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10970 /* Execute script in the scope of the global level */
10971 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10973 int retval;
10974 Jim_CallFrame *savedFramePtr = interp->framePtr;
10976 interp->framePtr = interp->topFramePtr;
10977 retval = Jim_Eval(interp, script);
10978 interp->framePtr = savedFramePtr;
10980 return retval;
10983 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10985 int retval;
10986 Jim_CallFrame *savedFramePtr = interp->framePtr;
10988 interp->framePtr = interp->topFramePtr;
10989 retval = Jim_EvalFile(interp, filename);
10990 interp->framePtr = savedFramePtr;
10992 return retval;
10995 #include <sys/stat.h>
10997 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10999 FILE *fp;
11000 char *buf;
11001 Jim_Obj *scriptObjPtr;
11002 Jim_Obj *prevScriptObj;
11003 struct stat sb;
11004 int retcode;
11005 int readlen;
11007 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11008 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11009 return JIM_ERR;
11011 if (sb.st_size == 0) {
11012 fclose(fp);
11013 return JIM_OK;
11016 buf = Jim_Alloc(sb.st_size + 1);
11017 readlen = fread(buf, 1, sb.st_size, fp);
11018 if (ferror(fp)) {
11019 fclose(fp);
11020 Jim_Free(buf);
11021 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11022 return JIM_ERR;
11024 fclose(fp);
11025 buf[readlen] = 0;
11027 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11028 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11029 Jim_IncrRefCount(scriptObjPtr);
11031 prevScriptObj = interp->currentScriptObj;
11032 interp->currentScriptObj = scriptObjPtr;
11034 retcode = Jim_EvalObj(interp, scriptObjPtr);
11036 /* Handle the JIM_RETURN return code */
11037 if (retcode == JIM_RETURN) {
11038 if (--interp->returnLevel <= 0) {
11039 retcode = interp->returnCode;
11040 interp->returnCode = JIM_OK;
11041 interp->returnLevel = 0;
11044 if (retcode == JIM_ERR) {
11045 /* EvalFile changes context, so add a stack frame here */
11046 interp->addStackTrace++;
11049 interp->currentScriptObj = prevScriptObj;
11051 Jim_DecrRefCount(interp, scriptObjPtr);
11053 return retcode;
11056 /* -----------------------------------------------------------------------------
11057 * Subst
11058 * ---------------------------------------------------------------------------*/
11059 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11061 pc->tstart = pc->p;
11062 pc->tline = pc->linenr;
11064 if (pc->len == 0) {
11065 pc->tend = pc->p;
11066 pc->tt = JIM_TT_EOL;
11067 pc->eof = 1;
11068 return;
11070 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11071 JimParseCmd(pc);
11072 return;
11074 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11075 if (JimParseVar(pc) == JIM_OK) {
11076 return;
11078 /* Not a var, so treat as a string */
11079 pc->tstart = pc->p;
11080 flags |= JIM_SUBST_NOVAR;
11082 while (pc->len) {
11083 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11084 break;
11086 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11087 break;
11089 if (*pc->p == '\\' && pc->len > 1) {
11090 pc->p++;
11091 pc->len--;
11093 pc->p++;
11094 pc->len--;
11096 pc->tend = pc->p - 1;
11097 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11100 /* The subst object type reuses most of the data structures and functions
11101 * of the script object. Script's data structures are a bit more complex
11102 * for what is needed for [subst]itution tasks, but the reuse helps to
11103 * deal with a single data structure at the cost of some more memory
11104 * usage for substitutions. */
11106 /* This method takes the string representation of an object
11107 * as a Tcl string where to perform [subst]itution, and generates
11108 * the pre-parsed internal representation. */
11109 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11111 int scriptTextLen;
11112 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11113 struct JimParserCtx parser;
11114 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11115 ParseTokenList tokenlist;
11117 /* Initially parse the subst into tokens (in tokenlist) */
11118 ScriptTokenListInit(&tokenlist);
11120 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11121 while (1) {
11122 JimParseSubst(&parser, flags);
11123 if (parser.eof) {
11124 /* Note that subst doesn't need the EOL token */
11125 break;
11127 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11128 parser.tline);
11131 /* Create the "real" subst/script tokens from the initial token list */
11132 script->inUse = 1;
11133 script->substFlags = flags;
11134 script->fileNameObj = interp->emptyObj;
11135 Jim_IncrRefCount(script->fileNameObj);
11136 SubstObjAddTokens(interp, script, &tokenlist);
11138 /* No longer need the token list */
11139 ScriptTokenListFree(&tokenlist);
11141 #ifdef DEBUG_SHOW_SUBST
11143 int i;
11145 printf("==== Subst ====\n");
11146 for (i = 0; i < script->len; i++) {
11147 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11148 Jim_String(script->token[i].objPtr));
11151 #endif
11153 /* Free the old internal rep and set the new one. */
11154 Jim_FreeIntRep(interp, objPtr);
11155 Jim_SetIntRepPtr(objPtr, script);
11156 objPtr->typePtr = &scriptObjType;
11157 return JIM_OK;
11160 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11162 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11163 SetSubstFromAny(interp, objPtr, flags);
11164 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11167 /* Performs commands,variables,blackslashes substitution,
11168 * storing the result object (with refcount 0) into
11169 * resObjPtrPtr. */
11170 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11172 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11174 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11175 /* In order to preserve the internal rep, we increment the
11176 * inUse field of the script internal rep structure. */
11177 script->inUse++;
11179 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11181 script->inUse--;
11182 Jim_DecrRefCount(interp, substObjPtr);
11183 if (*resObjPtrPtr == NULL) {
11184 return JIM_ERR;
11186 return JIM_OK;
11189 /* -----------------------------------------------------------------------------
11190 * Core commands utility functions
11191 * ---------------------------------------------------------------------------*/
11192 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11194 Jim_Obj *objPtr;
11195 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11197 if (*msg) {
11198 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11200 Jim_IncrRefCount(listObjPtr);
11201 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11202 Jim_DecrRefCount(interp, listObjPtr);
11204 Jim_IncrRefCount(objPtr);
11205 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11206 Jim_DecrRefCount(interp, objPtr);
11210 * May add the key and/or value to the list.
11212 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11213 Jim_HashEntry *he, int type);
11215 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11218 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11219 * invoke the callback to add entries to a list.
11220 * Returns the list.
11222 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11223 JimHashtableIteratorCallbackType *callback, int type)
11225 Jim_HashEntry *he;
11226 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11228 /* Check for the non-pattern case. We can do this much more efficiently. */
11229 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11230 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11231 if (he) {
11232 callback(interp, listObjPtr, he, type);
11235 else {
11236 Jim_HashTableIterator htiter;
11237 JimInitHashTableIterator(ht, &htiter);
11238 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11239 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11240 callback(interp, listObjPtr, he, type);
11244 return listObjPtr;
11247 /* Keep these in order */
11248 #define JIM_CMDLIST_COMMANDS 0
11249 #define JIM_CMDLIST_PROCS 1
11250 #define JIM_CMDLIST_CHANNELS 2
11253 * Adds matching command names (procs, channels) to the list.
11255 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11256 Jim_HashEntry *he, int type)
11258 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11259 Jim_Obj *objPtr;
11261 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11262 /* not a proc */
11263 return;
11266 objPtr = Jim_NewStringObj(interp, he->key, -1);
11267 Jim_IncrRefCount(objPtr);
11269 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11270 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11272 Jim_DecrRefCount(interp, objPtr);
11275 /* type is JIM_CMDLIST_xxx */
11276 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11278 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11281 /* Keep these in order */
11282 #define JIM_VARLIST_GLOBALS 0
11283 #define JIM_VARLIST_LOCALS 1
11284 #define JIM_VARLIST_VARS 2
11286 #define JIM_VARLIST_VALUES 0x1000
11289 * Adds matching variable names to the list.
11291 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11292 Jim_HashEntry *he, int type)
11294 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11296 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11297 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11298 if (type & JIM_VARLIST_VALUES) {
11299 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11304 /* mode is JIM_VARLIST_xxx */
11305 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11307 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11308 /* For [info locals], if we are at top level an emtpy list
11309 * is returned. I don't agree, but we aim at compatibility (SS) */
11310 return interp->emptyObj;
11312 else {
11313 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11314 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11318 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11319 Jim_Obj **objPtrPtr, int info_level_cmd)
11321 Jim_CallFrame *targetCallFrame;
11323 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11324 if (targetCallFrame == NULL) {
11325 return JIM_ERR;
11327 /* No proc call at toplevel callframe */
11328 if (targetCallFrame == interp->topFramePtr) {
11329 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11330 return JIM_ERR;
11332 if (info_level_cmd) {
11333 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11335 else {
11336 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11338 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11339 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11340 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11341 *objPtrPtr = listObj;
11343 return JIM_OK;
11346 /* -----------------------------------------------------------------------------
11347 * Core commands
11348 * ---------------------------------------------------------------------------*/
11350 /* fake [puts] -- not the real puts, just for debugging. */
11351 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11353 if (argc != 2 && argc != 3) {
11354 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11355 return JIM_ERR;
11357 if (argc == 3) {
11358 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11359 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11360 return JIM_ERR;
11362 else {
11363 fputs(Jim_String(argv[2]), stdout);
11366 else {
11367 puts(Jim_String(argv[1]));
11369 return JIM_OK;
11372 /* Helper for [+] and [*] */
11373 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11375 jim_wide wideValue, res;
11376 double doubleValue, doubleRes;
11377 int i;
11379 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11381 for (i = 1; i < argc; i++) {
11382 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11383 goto trydouble;
11384 if (op == JIM_EXPROP_ADD)
11385 res += wideValue;
11386 else
11387 res *= wideValue;
11389 Jim_SetResultInt(interp, res);
11390 return JIM_OK;
11391 trydouble:
11392 doubleRes = (double)res;
11393 for (; i < argc; i++) {
11394 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11395 return JIM_ERR;
11396 if (op == JIM_EXPROP_ADD)
11397 doubleRes += doubleValue;
11398 else
11399 doubleRes *= doubleValue;
11401 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11402 return JIM_OK;
11405 /* Helper for [-] and [/] */
11406 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11408 jim_wide wideValue, res = 0;
11409 double doubleValue, doubleRes = 0;
11410 int i = 2;
11412 if (argc < 2) {
11413 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11414 return JIM_ERR;
11416 else if (argc == 2) {
11417 /* The arity = 2 case is different. For [- x] returns -x,
11418 * while [/ x] returns 1/x. */
11419 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11420 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11421 return JIM_ERR;
11423 else {
11424 if (op == JIM_EXPROP_SUB)
11425 doubleRes = -doubleValue;
11426 else
11427 doubleRes = 1.0 / doubleValue;
11428 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11429 return JIM_OK;
11432 if (op == JIM_EXPROP_SUB) {
11433 res = -wideValue;
11434 Jim_SetResultInt(interp, res);
11436 else {
11437 doubleRes = 1.0 / wideValue;
11438 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11440 return JIM_OK;
11442 else {
11443 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11444 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11445 != JIM_OK) {
11446 return JIM_ERR;
11448 else {
11449 goto trydouble;
11453 for (i = 2; i < argc; i++) {
11454 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11455 doubleRes = (double)res;
11456 goto trydouble;
11458 if (op == JIM_EXPROP_SUB)
11459 res -= wideValue;
11460 else
11461 res /= wideValue;
11463 Jim_SetResultInt(interp, res);
11464 return JIM_OK;
11465 trydouble:
11466 for (; i < argc; i++) {
11467 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11468 return JIM_ERR;
11469 if (op == JIM_EXPROP_SUB)
11470 doubleRes -= doubleValue;
11471 else
11472 doubleRes /= doubleValue;
11474 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11475 return JIM_OK;
11479 /* [+] */
11480 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11482 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11485 /* [*] */
11486 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11488 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11491 /* [-] */
11492 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11494 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11497 /* [/] */
11498 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11500 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11503 /* [set] */
11504 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11506 if (argc != 2 && argc != 3) {
11507 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11508 return JIM_ERR;
11510 if (argc == 2) {
11511 Jim_Obj *objPtr;
11513 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11514 if (!objPtr)
11515 return JIM_ERR;
11516 Jim_SetResult(interp, objPtr);
11517 return JIM_OK;
11519 /* argc == 3 case. */
11520 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11521 return JIM_ERR;
11522 Jim_SetResult(interp, argv[2]);
11523 return JIM_OK;
11526 /* [unset]
11528 * unset ?-nocomplain? ?--? ?varName ...?
11530 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11532 int i = 1;
11533 int complain = 1;
11535 while (i < argc) {
11536 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11537 i++;
11538 break;
11540 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11541 complain = 0;
11542 i++;
11543 continue;
11545 break;
11548 while (i < argc) {
11549 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11550 && complain) {
11551 return JIM_ERR;
11553 i++;
11555 return JIM_OK;
11558 /* [while] */
11559 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11561 if (argc != 3) {
11562 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11563 return JIM_ERR;
11566 /* The general purpose implementation of while starts here */
11567 while (1) {
11568 int boolean, retval;
11570 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11571 return retval;
11572 if (!boolean)
11573 break;
11575 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11576 switch (retval) {
11577 case JIM_BREAK:
11578 goto out;
11579 break;
11580 case JIM_CONTINUE:
11581 continue;
11582 break;
11583 default:
11584 return retval;
11588 out:
11589 Jim_SetEmptyResult(interp);
11590 return JIM_OK;
11593 /* [for] */
11594 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11596 int retval;
11597 int boolean = 1;
11598 Jim_Obj *varNamePtr = NULL;
11599 Jim_Obj *stopVarNamePtr = NULL;
11601 if (argc != 5) {
11602 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11603 return JIM_ERR;
11606 /* Do the initialisation */
11607 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11608 return retval;
11611 /* And do the first test now. Better for optimisation
11612 * if we can do next/test at the bottom of the loop
11614 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11616 /* Ready to do the body as follows:
11617 * while (1) {
11618 * body // check retcode
11619 * next // check retcode
11620 * test // check retcode/test bool
11624 #ifdef JIM_OPTIMIZATION
11625 /* Check if the for is on the form:
11626 * for ... {$i < CONST} {incr i}
11627 * for ... {$i < $j} {incr i}
11629 if (retval == JIM_OK && boolean) {
11630 ScriptObj *incrScript;
11631 ExprByteCode *expr;
11632 jim_wide stop, currentVal;
11633 Jim_Obj *objPtr;
11634 int cmpOffset;
11636 /* Do it only if there aren't shared arguments */
11637 expr = JimGetExpression(interp, argv[2]);
11638 incrScript = JimGetScript(interp, argv[3]);
11640 /* Ensure proper lengths to start */
11641 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11642 goto evalstart;
11644 /* Ensure proper token types. */
11645 if (incrScript->token[1].type != JIM_TT_ESC ||
11646 expr->token[0].type != JIM_TT_VAR ||
11647 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11648 goto evalstart;
11651 if (expr->token[2].type == JIM_EXPROP_LT) {
11652 cmpOffset = 0;
11654 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11655 cmpOffset = 1;
11657 else {
11658 goto evalstart;
11661 /* Update command must be incr */
11662 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11663 goto evalstart;
11666 /* incr, expression must be about the same variable */
11667 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11668 goto evalstart;
11671 /* Get the stop condition (must be a variable or integer) */
11672 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11673 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11674 goto evalstart;
11677 else {
11678 stopVarNamePtr = expr->token[1].objPtr;
11679 Jim_IncrRefCount(stopVarNamePtr);
11680 /* Keep the compiler happy */
11681 stop = 0;
11684 /* Initialization */
11685 varNamePtr = expr->token[0].objPtr;
11686 Jim_IncrRefCount(varNamePtr);
11688 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11689 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11690 goto testcond;
11693 /* --- OPTIMIZED FOR --- */
11694 while (retval == JIM_OK) {
11695 /* === Check condition === */
11696 /* Note that currentVal is already set here */
11698 /* Immediate or Variable? get the 'stop' value if the latter. */
11699 if (stopVarNamePtr) {
11700 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11701 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11702 goto testcond;
11706 if (currentVal >= stop + cmpOffset) {
11707 break;
11710 /* Eval body */
11711 retval = Jim_EvalObj(interp, argv[4]);
11712 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11713 retval = JIM_OK;
11715 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11717 /* Increment */
11718 if (objPtr == NULL) {
11719 retval = JIM_ERR;
11720 goto out;
11722 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11723 currentVal = ++JimWideValue(objPtr);
11724 Jim_InvalidateStringRep(objPtr);
11726 else {
11727 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11728 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11729 ++currentVal)) != JIM_OK) {
11730 goto evalnext;
11735 goto out;
11737 evalstart:
11738 #endif
11740 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11741 /* Body */
11742 retval = Jim_EvalObj(interp, argv[4]);
11744 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11745 /* increment */
11746 evalnext:
11747 retval = Jim_EvalObj(interp, argv[3]);
11748 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11749 /* test */
11750 testcond:
11751 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11755 out:
11756 if (stopVarNamePtr) {
11757 Jim_DecrRefCount(interp, stopVarNamePtr);
11759 if (varNamePtr) {
11760 Jim_DecrRefCount(interp, varNamePtr);
11763 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11764 Jim_SetEmptyResult(interp);
11765 return JIM_OK;
11768 return retval;
11771 /* [loop] */
11772 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11774 int retval;
11775 jim_wide i;
11776 jim_wide limit;
11777 jim_wide incr = 1;
11778 Jim_Obj *bodyObjPtr;
11780 if (argc != 5 && argc != 6) {
11781 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11782 return JIM_ERR;
11785 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11786 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11787 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11788 return JIM_ERR;
11790 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11792 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11794 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11795 retval = Jim_EvalObj(interp, bodyObjPtr);
11796 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11797 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11799 retval = JIM_OK;
11801 /* Increment */
11802 i += incr;
11804 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11805 if (argv[1]->typePtr != &variableObjType) {
11806 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11807 return JIM_ERR;
11810 JimWideValue(objPtr) = i;
11811 Jim_InvalidateStringRep(objPtr);
11813 /* The following step is required in order to invalidate the
11814 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11815 if (argv[1]->typePtr != &variableObjType) {
11816 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11817 retval = JIM_ERR;
11818 break;
11822 else {
11823 objPtr = Jim_NewIntObj(interp, i);
11824 retval = Jim_SetVariable(interp, argv[1], objPtr);
11825 if (retval != JIM_OK) {
11826 Jim_FreeNewObj(interp, objPtr);
11832 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11833 Jim_SetEmptyResult(interp);
11834 return JIM_OK;
11836 return retval;
11839 /* List iterators make it easy to iterate over a list.
11840 * At some point iterators will be expanded to support generators.
11842 typedef struct {
11843 Jim_Obj *objPtr;
11844 int idx;
11845 } Jim_ListIter;
11848 * Initialise the iterator at the start of the list.
11850 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11852 iter->objPtr = objPtr;
11853 iter->idx = 0;
11857 * Returns the next object from the list, or NULL on end-of-list.
11859 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11861 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11862 return NULL;
11864 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11868 * Returns 1 if end-of-list has been reached.
11870 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11872 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11875 /* foreach + lmap implementation. */
11876 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11878 int result = JIM_OK;
11879 int i, numargs;
11880 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11881 Jim_ListIter *iters;
11882 Jim_Obj *script;
11883 Jim_Obj *resultObj;
11885 if (argc < 4 || argc % 2 != 0) {
11886 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11887 return JIM_ERR;
11889 script = argv[argc - 1]; /* Last argument is a script */
11890 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11892 if (numargs == 2) {
11893 iters = twoiters;
11895 else {
11896 iters = Jim_Alloc(numargs * sizeof(*iters));
11898 for (i = 0; i < numargs; i++) {
11899 JimListIterInit(&iters[i], argv[i + 1]);
11900 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11901 result = JIM_ERR;
11904 if (result != JIM_OK) {
11905 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11906 return result;
11909 if (doMap) {
11910 resultObj = Jim_NewListObj(interp, NULL, 0);
11912 else {
11913 resultObj = interp->emptyObj;
11915 Jim_IncrRefCount(resultObj);
11917 while (1) {
11918 /* Have we expired all lists? */
11919 for (i = 0; i < numargs; i += 2) {
11920 if (!JimListIterDone(interp, &iters[i + 1])) {
11921 break;
11924 if (i == numargs) {
11925 /* All done */
11926 break;
11929 /* For each list */
11930 for (i = 0; i < numargs; i += 2) {
11931 Jim_Obj *varName;
11933 /* foreach var */
11934 JimListIterInit(&iters[i], argv[i + 1]);
11935 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11936 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11937 if (!valObj) {
11938 /* Ran out, so store the empty string */
11939 valObj = interp->emptyObj;
11941 /* Avoid shimmering */
11942 Jim_IncrRefCount(valObj);
11943 result = Jim_SetVariable(interp, varName, valObj);
11944 Jim_DecrRefCount(interp, valObj);
11945 if (result != JIM_OK) {
11946 goto err;
11950 switch (result = Jim_EvalObj(interp, script)) {
11951 case JIM_OK:
11952 if (doMap) {
11953 Jim_ListAppendElement(interp, resultObj, interp->result);
11955 break;
11956 case JIM_CONTINUE:
11957 break;
11958 case JIM_BREAK:
11959 goto out;
11960 default:
11961 goto err;
11964 out:
11965 result = JIM_OK;
11966 Jim_SetResult(interp, resultObj);
11967 err:
11968 Jim_DecrRefCount(interp, resultObj);
11969 if (numargs > 2) {
11970 Jim_Free(iters);
11972 return result;
11975 /* [foreach] */
11976 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11978 return JimForeachMapHelper(interp, argc, argv, 0);
11981 /* [lmap] */
11982 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11984 return JimForeachMapHelper(interp, argc, argv, 1);
11987 /* [lassign] */
11988 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11990 int result = JIM_ERR;
11991 int i;
11992 Jim_ListIter iter;
11993 Jim_Obj *resultObj;
11995 if (argc < 2) {
11996 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11997 return JIM_ERR;
12000 JimListIterInit(&iter, argv[1]);
12002 for (i = 2; i < argc; i++) {
12003 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12004 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12005 if (result != JIM_OK) {
12006 return result;
12010 resultObj = Jim_NewListObj(interp, NULL, 0);
12011 while (!JimListIterDone(interp, &iter)) {
12012 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12015 Jim_SetResult(interp, resultObj);
12017 return JIM_OK;
12020 /* [if] */
12021 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12023 int boolean, retval, current = 1, falsebody = 0;
12025 if (argc >= 3) {
12026 while (1) {
12027 /* Far not enough arguments given! */
12028 if (current >= argc)
12029 goto err;
12030 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12031 != JIM_OK)
12032 return retval;
12033 /* There lacks something, isn't it? */
12034 if (current >= argc)
12035 goto err;
12036 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12037 current++;
12038 /* Tsk tsk, no then-clause? */
12039 if (current >= argc)
12040 goto err;
12041 if (boolean)
12042 return Jim_EvalObj(interp, argv[current]);
12043 /* Ok: no else-clause follows */
12044 if (++current >= argc) {
12045 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12046 return JIM_OK;
12048 falsebody = current++;
12049 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12050 /* IIICKS - else-clause isn't last cmd? */
12051 if (current != argc - 1)
12052 goto err;
12053 return Jim_EvalObj(interp, argv[current]);
12055 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12056 /* Ok: elseif follows meaning all the stuff
12057 * again (how boring...) */
12058 continue;
12059 /* OOPS - else-clause is not last cmd? */
12060 else if (falsebody != argc - 1)
12061 goto err;
12062 return Jim_EvalObj(interp, argv[falsebody]);
12064 return JIM_OK;
12066 err:
12067 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12068 return JIM_ERR;
12072 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12073 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12074 Jim_Obj *stringObj, int nocase)
12076 Jim_Obj *parms[4];
12077 int argc = 0;
12078 long eq;
12079 int rc;
12081 parms[argc++] = commandObj;
12082 if (nocase) {
12083 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12085 parms[argc++] = patternObj;
12086 parms[argc++] = stringObj;
12088 rc = Jim_EvalObjVector(interp, argc, parms);
12090 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12091 eq = -rc;
12094 return eq;
12097 enum
12098 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12100 /* [switch] */
12101 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12103 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12104 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12105 Jim_Obj *script = 0;
12107 if (argc < 3) {
12108 wrongnumargs:
12109 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12110 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12111 return JIM_ERR;
12113 for (opt = 1; opt < argc; ++opt) {
12114 const char *option = Jim_String(argv[opt]);
12116 if (*option != '-')
12117 break;
12118 else if (strncmp(option, "--", 2) == 0) {
12119 ++opt;
12120 break;
12122 else if (strncmp(option, "-exact", 2) == 0)
12123 matchOpt = SWITCH_EXACT;
12124 else if (strncmp(option, "-glob", 2) == 0)
12125 matchOpt = SWITCH_GLOB;
12126 else if (strncmp(option, "-regexp", 2) == 0)
12127 matchOpt = SWITCH_RE;
12128 else if (strncmp(option, "-command", 2) == 0) {
12129 matchOpt = SWITCH_CMD;
12130 if ((argc - opt) < 2)
12131 goto wrongnumargs;
12132 command = argv[++opt];
12134 else {
12135 Jim_SetResultFormatted(interp,
12136 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12137 argv[opt]);
12138 return JIM_ERR;
12140 if ((argc - opt) < 2)
12141 goto wrongnumargs;
12143 strObj = argv[opt++];
12144 patCount = argc - opt;
12145 if (patCount == 1) {
12146 Jim_Obj **vector;
12148 JimListGetElements(interp, argv[opt], &patCount, &vector);
12149 caseList = vector;
12151 else
12152 caseList = &argv[opt];
12153 if (patCount == 0 || patCount % 2 != 0)
12154 goto wrongnumargs;
12155 for (i = 0; script == 0 && i < patCount; i += 2) {
12156 Jim_Obj *patObj = caseList[i];
12158 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12159 || i < (patCount - 2)) {
12160 switch (matchOpt) {
12161 case SWITCH_EXACT:
12162 if (Jim_StringEqObj(strObj, patObj))
12163 script = caseList[i + 1];
12164 break;
12165 case SWITCH_GLOB:
12166 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12167 script = caseList[i + 1];
12168 break;
12169 case SWITCH_RE:
12170 command = Jim_NewStringObj(interp, "regexp", -1);
12171 /* Fall thru intentionally */
12172 case SWITCH_CMD:{
12173 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12175 /* After the execution of a command we need to
12176 * make sure to reconvert the object into a list
12177 * again. Only for the single-list style [switch]. */
12178 if (argc - opt == 1) {
12179 Jim_Obj **vector;
12181 JimListGetElements(interp, argv[opt], &patCount, &vector);
12182 caseList = vector;
12184 /* command is here already decref'd */
12185 if (rc < 0) {
12186 return -rc;
12188 if (rc)
12189 script = caseList[i + 1];
12190 break;
12194 else {
12195 script = caseList[i + 1];
12198 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12199 script = caseList[i + 1];
12200 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12201 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12202 return JIM_ERR;
12204 Jim_SetEmptyResult(interp);
12205 if (script) {
12206 return Jim_EvalObj(interp, script);
12208 return JIM_OK;
12211 /* [list] */
12212 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12214 Jim_Obj *listObjPtr;
12216 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12217 Jim_SetResult(interp, listObjPtr);
12218 return JIM_OK;
12221 /* [lindex] */
12222 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12224 Jim_Obj *objPtr, *listObjPtr;
12225 int i;
12226 int idx;
12228 if (argc < 2) {
12229 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12230 return JIM_ERR;
12232 objPtr = argv[1];
12233 Jim_IncrRefCount(objPtr);
12234 for (i = 2; i < argc; i++) {
12235 listObjPtr = objPtr;
12236 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12237 Jim_DecrRefCount(interp, listObjPtr);
12238 return JIM_ERR;
12240 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12241 /* Returns an empty object if the index
12242 * is out of range. */
12243 Jim_DecrRefCount(interp, listObjPtr);
12244 Jim_SetEmptyResult(interp);
12245 return JIM_OK;
12247 Jim_IncrRefCount(objPtr);
12248 Jim_DecrRefCount(interp, listObjPtr);
12250 Jim_SetResult(interp, objPtr);
12251 Jim_DecrRefCount(interp, objPtr);
12252 return JIM_OK;
12255 /* [llength] */
12256 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12258 if (argc != 2) {
12259 Jim_WrongNumArgs(interp, 1, argv, "list");
12260 return JIM_ERR;
12262 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12263 return JIM_OK;
12266 /* [lsearch] */
12267 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12269 static const char * const options[] = {
12270 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12271 NULL
12273 enum
12274 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12275 OPT_COMMAND };
12276 int i;
12277 int opt_bool = 0;
12278 int opt_not = 0;
12279 int opt_nocase = 0;
12280 int opt_all = 0;
12281 int opt_inline = 0;
12282 int opt_match = OPT_EXACT;
12283 int listlen;
12284 int rc = JIM_OK;
12285 Jim_Obj *listObjPtr = NULL;
12286 Jim_Obj *commandObj = NULL;
12288 if (argc < 3) {
12289 wrongargs:
12290 Jim_WrongNumArgs(interp, 1, argv,
12291 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12292 return JIM_ERR;
12295 for (i = 1; i < argc - 2; i++) {
12296 int option;
12298 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12299 return JIM_ERR;
12301 switch (option) {
12302 case OPT_BOOL:
12303 opt_bool = 1;
12304 opt_inline = 0;
12305 break;
12306 case OPT_NOT:
12307 opt_not = 1;
12308 break;
12309 case OPT_NOCASE:
12310 opt_nocase = 1;
12311 break;
12312 case OPT_INLINE:
12313 opt_inline = 1;
12314 opt_bool = 0;
12315 break;
12316 case OPT_ALL:
12317 opt_all = 1;
12318 break;
12319 case OPT_COMMAND:
12320 if (i >= argc - 2) {
12321 goto wrongargs;
12323 commandObj = argv[++i];
12324 /* fallthru */
12325 case OPT_EXACT:
12326 case OPT_GLOB:
12327 case OPT_REGEXP:
12328 opt_match = option;
12329 break;
12333 argv += i;
12335 if (opt_all) {
12336 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12338 if (opt_match == OPT_REGEXP) {
12339 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12341 if (commandObj) {
12342 Jim_IncrRefCount(commandObj);
12345 listlen = Jim_ListLength(interp, argv[0]);
12346 for (i = 0; i < listlen; i++) {
12347 int eq = 0;
12348 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12350 switch (opt_match) {
12351 case OPT_EXACT:
12352 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12353 break;
12355 case OPT_GLOB:
12356 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12357 break;
12359 case OPT_REGEXP:
12360 case OPT_COMMAND:
12361 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12362 if (eq < 0) {
12363 if (listObjPtr) {
12364 Jim_FreeNewObj(interp, listObjPtr);
12366 rc = JIM_ERR;
12367 goto done;
12369 break;
12372 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12373 if (!eq && opt_bool && opt_not && !opt_all) {
12374 continue;
12377 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12378 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12379 Jim_Obj *resultObj;
12381 if (opt_bool) {
12382 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12384 else if (!opt_inline) {
12385 resultObj = Jim_NewIntObj(interp, i);
12387 else {
12388 resultObj = objPtr;
12391 if (opt_all) {
12392 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12394 else {
12395 Jim_SetResult(interp, resultObj);
12396 goto done;
12401 if (opt_all) {
12402 Jim_SetResult(interp, listObjPtr);
12404 else {
12405 /* No match */
12406 if (opt_bool) {
12407 Jim_SetResultBool(interp, opt_not);
12409 else if (!opt_inline) {
12410 Jim_SetResultInt(interp, -1);
12414 done:
12415 if (commandObj) {
12416 Jim_DecrRefCount(interp, commandObj);
12418 return rc;
12421 /* [lappend] */
12422 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12424 Jim_Obj *listObjPtr;
12425 int new_obj = 0;
12426 int i;
12428 if (argc < 2) {
12429 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12430 return JIM_ERR;
12432 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12433 if (!listObjPtr) {
12434 /* Create the list if it does not exist */
12435 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12436 new_obj = 1;
12438 else if (Jim_IsShared(listObjPtr)) {
12439 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12440 new_obj = 1;
12442 for (i = 2; i < argc; i++)
12443 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12444 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12445 if (new_obj)
12446 Jim_FreeNewObj(interp, listObjPtr);
12447 return JIM_ERR;
12449 Jim_SetResult(interp, listObjPtr);
12450 return JIM_OK;
12453 /* [linsert] */
12454 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12456 int idx, len;
12457 Jim_Obj *listPtr;
12459 if (argc < 3) {
12460 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12461 return JIM_ERR;
12463 listPtr = argv[1];
12464 if (Jim_IsShared(listPtr))
12465 listPtr = Jim_DuplicateObj(interp, listPtr);
12466 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12467 goto err;
12468 len = Jim_ListLength(interp, listPtr);
12469 if (idx >= len)
12470 idx = len;
12471 else if (idx < 0)
12472 idx = len + idx + 1;
12473 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12474 Jim_SetResult(interp, listPtr);
12475 return JIM_OK;
12476 err:
12477 if (listPtr != argv[1]) {
12478 Jim_FreeNewObj(interp, listPtr);
12480 return JIM_ERR;
12483 /* [lreplace] */
12484 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12486 int first, last, len, rangeLen;
12487 Jim_Obj *listObj;
12488 Jim_Obj *newListObj;
12490 if (argc < 4) {
12491 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12492 return JIM_ERR;
12494 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12495 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12496 return JIM_ERR;
12499 listObj = argv[1];
12500 len = Jim_ListLength(interp, listObj);
12502 first = JimRelToAbsIndex(len, first);
12503 last = JimRelToAbsIndex(len, last);
12504 JimRelToAbsRange(len, &first, &last, &rangeLen);
12506 /* Now construct a new list which consists of:
12507 * <elements before first> <supplied elements> <elements after last>
12510 /* Check to see if trying to replace past the end of the list */
12511 if (first < len) {
12512 /* OK. Not past the end */
12514 else if (len == 0) {
12515 /* Special for empty list, adjust first to 0 */
12516 first = 0;
12518 else {
12519 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12520 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12521 return JIM_ERR;
12524 /* Add the first set of elements */
12525 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12527 /* Add supplied elements */
12528 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12530 /* Add the remaining elements */
12531 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12533 Jim_SetResult(interp, newListObj);
12534 return JIM_OK;
12537 /* [lset] */
12538 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12540 if (argc < 3) {
12541 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12542 return JIM_ERR;
12544 else if (argc == 3) {
12545 /* With no indexes, simply implements [set] */
12546 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12547 return JIM_ERR;
12548 Jim_SetResult(interp, argv[2]);
12549 return JIM_OK;
12551 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12554 /* [lsort] */
12555 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12557 static const char * const options[] = {
12558 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12560 enum
12561 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12562 Jim_Obj *resObj;
12563 int i;
12564 int retCode;
12566 struct lsort_info info;
12568 if (argc < 2) {
12569 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12570 return JIM_ERR;
12573 info.type = JIM_LSORT_ASCII;
12574 info.order = 1;
12575 info.indexed = 0;
12576 info.unique = 0;
12577 info.command = NULL;
12578 info.interp = interp;
12580 for (i = 1; i < (argc - 1); i++) {
12581 int option;
12583 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12584 != JIM_OK)
12585 return JIM_ERR;
12586 switch (option) {
12587 case OPT_ASCII:
12588 info.type = JIM_LSORT_ASCII;
12589 break;
12590 case OPT_NOCASE:
12591 info.type = JIM_LSORT_NOCASE;
12592 break;
12593 case OPT_INTEGER:
12594 info.type = JIM_LSORT_INTEGER;
12595 break;
12596 case OPT_REAL:
12597 info.type = JIM_LSORT_REAL;
12598 break;
12599 case OPT_INCREASING:
12600 info.order = 1;
12601 break;
12602 case OPT_DECREASING:
12603 info.order = -1;
12604 break;
12605 case OPT_UNIQUE:
12606 info.unique = 1;
12607 break;
12608 case OPT_COMMAND:
12609 if (i >= (argc - 2)) {
12610 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12611 return JIM_ERR;
12613 info.type = JIM_LSORT_COMMAND;
12614 info.command = argv[i + 1];
12615 i++;
12616 break;
12617 case OPT_INDEX:
12618 if (i >= (argc - 2)) {
12619 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12620 return JIM_ERR;
12622 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12623 return JIM_ERR;
12625 info.indexed = 1;
12626 i++;
12627 break;
12630 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12631 retCode = ListSortElements(interp, resObj, &info);
12632 if (retCode == JIM_OK) {
12633 Jim_SetResult(interp, resObj);
12635 else {
12636 Jim_FreeNewObj(interp, resObj);
12638 return retCode;
12641 /* [append] */
12642 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12644 Jim_Obj *stringObjPtr;
12645 int i;
12647 if (argc < 2) {
12648 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12649 return JIM_ERR;
12651 if (argc == 2) {
12652 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12653 if (!stringObjPtr)
12654 return JIM_ERR;
12656 else {
12657 int new_obj = 0;
12658 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12659 if (!stringObjPtr) {
12660 /* Create the string if it doesn't exist */
12661 stringObjPtr = Jim_NewEmptyStringObj(interp);
12662 new_obj = 1;
12664 else if (Jim_IsShared(stringObjPtr)) {
12665 new_obj = 1;
12666 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12668 for (i = 2; i < argc; i++) {
12669 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12671 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12672 if (new_obj) {
12673 Jim_FreeNewObj(interp, stringObjPtr);
12675 return JIM_ERR;
12678 Jim_SetResult(interp, stringObjPtr);
12679 return JIM_OK;
12682 /* [debug] */
12683 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12685 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12686 static const char * const options[] = {
12687 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12688 "exprbc", "show",
12689 NULL
12691 enum
12693 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12694 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12696 int option;
12698 if (argc < 2) {
12699 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12700 return JIM_ERR;
12702 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12703 return JIM_ERR;
12704 if (option == OPT_REFCOUNT) {
12705 if (argc != 3) {
12706 Jim_WrongNumArgs(interp, 2, argv, "object");
12707 return JIM_ERR;
12709 Jim_SetResultInt(interp, argv[2]->refCount);
12710 return JIM_OK;
12712 else if (option == OPT_OBJCOUNT) {
12713 int freeobj = 0, liveobj = 0;
12714 char buf[256];
12715 Jim_Obj *objPtr;
12717 if (argc != 2) {
12718 Jim_WrongNumArgs(interp, 2, argv, "");
12719 return JIM_ERR;
12721 /* Count the number of free objects. */
12722 objPtr = interp->freeList;
12723 while (objPtr) {
12724 freeobj++;
12725 objPtr = objPtr->nextObjPtr;
12727 /* Count the number of live objects. */
12728 objPtr = interp->liveList;
12729 while (objPtr) {
12730 liveobj++;
12731 objPtr = objPtr->nextObjPtr;
12733 /* Set the result string and return. */
12734 sprintf(buf, "free %d used %d", freeobj, liveobj);
12735 Jim_SetResultString(interp, buf, -1);
12736 return JIM_OK;
12738 else if (option == OPT_OBJECTS) {
12739 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12741 /* Count the number of live objects. */
12742 objPtr = interp->liveList;
12743 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12744 while (objPtr) {
12745 char buf[128];
12746 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12748 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12749 sprintf(buf, "%p", objPtr);
12750 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12751 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12752 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12753 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12754 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12755 objPtr = objPtr->nextObjPtr;
12757 Jim_SetResult(interp, listObjPtr);
12758 return JIM_OK;
12760 else if (option == OPT_INVSTR) {
12761 Jim_Obj *objPtr;
12763 if (argc != 3) {
12764 Jim_WrongNumArgs(interp, 2, argv, "object");
12765 return JIM_ERR;
12767 objPtr = argv[2];
12768 if (objPtr->typePtr != NULL)
12769 Jim_InvalidateStringRep(objPtr);
12770 Jim_SetEmptyResult(interp);
12771 return JIM_OK;
12773 else if (option == OPT_SHOW) {
12774 const char *s;
12775 int len, charlen;
12777 if (argc != 3) {
12778 Jim_WrongNumArgs(interp, 2, argv, "object");
12779 return JIM_ERR;
12781 s = Jim_GetString(argv[2], &len);
12782 #ifdef JIM_UTF8
12783 charlen = utf8_strlen(s, len);
12784 #else
12785 charlen = len;
12786 #endif
12787 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12788 printf("chars (%d): <<%s>>\n", charlen, s);
12789 printf("bytes (%d):", len);
12790 while (len--) {
12791 printf(" %02x", (unsigned char)*s++);
12793 printf("\n");
12794 return JIM_OK;
12796 else if (option == OPT_SCRIPTLEN) {
12797 ScriptObj *script;
12799 if (argc != 3) {
12800 Jim_WrongNumArgs(interp, 2, argv, "script");
12801 return JIM_ERR;
12803 script = JimGetScript(interp, argv[2]);
12804 if (script == NULL)
12805 return JIM_ERR;
12806 Jim_SetResultInt(interp, script->len);
12807 return JIM_OK;
12809 else if (option == OPT_EXPRLEN) {
12810 ExprByteCode *expr;
12812 if (argc != 3) {
12813 Jim_WrongNumArgs(interp, 2, argv, "expression");
12814 return JIM_ERR;
12816 expr = JimGetExpression(interp, argv[2]);
12817 if (expr == NULL)
12818 return JIM_ERR;
12819 Jim_SetResultInt(interp, expr->len);
12820 return JIM_OK;
12822 else if (option == OPT_EXPRBC) {
12823 Jim_Obj *objPtr;
12824 ExprByteCode *expr;
12825 int i;
12827 if (argc != 3) {
12828 Jim_WrongNumArgs(interp, 2, argv, "expression");
12829 return JIM_ERR;
12831 expr = JimGetExpression(interp, argv[2]);
12832 if (expr == NULL)
12833 return JIM_ERR;
12834 objPtr = Jim_NewListObj(interp, NULL, 0);
12835 for (i = 0; i < expr->len; i++) {
12836 const char *type;
12837 const Jim_ExprOperator *op;
12838 Jim_Obj *obj = expr->token[i].objPtr;
12840 switch (expr->token[i].type) {
12841 case JIM_TT_EXPR_INT:
12842 type = "int";
12843 break;
12844 case JIM_TT_EXPR_DOUBLE:
12845 type = "double";
12846 break;
12847 case JIM_TT_CMD:
12848 type = "command";
12849 break;
12850 case JIM_TT_VAR:
12851 type = "variable";
12852 break;
12853 case JIM_TT_DICTSUGAR:
12854 type = "dictsugar";
12855 break;
12856 case JIM_TT_EXPRSUGAR:
12857 type = "exprsugar";
12858 break;
12859 case JIM_TT_ESC:
12860 type = "subst";
12861 break;
12862 case JIM_TT_STR:
12863 type = "string";
12864 break;
12865 default:
12866 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12867 if (op == NULL) {
12868 type = "private";
12870 else {
12871 type = "operator";
12873 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12874 break;
12876 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12877 Jim_ListAppendElement(interp, objPtr, obj);
12879 Jim_SetResult(interp, objPtr);
12880 return JIM_OK;
12882 else {
12883 Jim_SetResultString(interp,
12884 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12885 return JIM_ERR;
12887 /* unreached */
12888 #endif /* JIM_BOOTSTRAP */
12889 #if !defined(JIM_DEBUG_COMMAND)
12890 Jim_SetResultString(interp, "unsupported", -1);
12891 return JIM_ERR;
12892 #endif
12895 /* [eval] */
12896 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12898 int rc;
12900 if (argc < 2) {
12901 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12902 return JIM_ERR;
12905 if (argc == 2) {
12906 rc = Jim_EvalObj(interp, argv[1]);
12908 else {
12909 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12912 if (rc == JIM_ERR) {
12913 /* eval is "interesting", so add a stack frame here */
12914 interp->addStackTrace++;
12916 return rc;
12919 /* [uplevel] */
12920 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12922 if (argc >= 2) {
12923 int retcode;
12924 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12925 const char *str;
12927 /* Save the old callframe pointer */
12928 savedCallFrame = interp->framePtr;
12930 /* Lookup the target frame pointer */
12931 str = Jim_String(argv[1]);
12932 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12933 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12934 argc--;
12935 argv++;
12937 else {
12938 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12940 if (targetCallFrame == NULL) {
12941 return JIM_ERR;
12943 if (argc < 2) {
12944 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12945 return JIM_ERR;
12947 /* Eval the code in the target callframe. */
12948 interp->framePtr = targetCallFrame;
12949 if (argc == 2) {
12950 retcode = Jim_EvalObj(interp, argv[1]);
12952 else {
12953 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12955 interp->framePtr = savedCallFrame;
12956 return retcode;
12958 else {
12959 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12960 return JIM_ERR;
12964 /* [expr] */
12965 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12967 Jim_Obj *exprResultPtr;
12968 int retcode;
12970 if (argc == 2) {
12971 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12973 else if (argc > 2) {
12974 Jim_Obj *objPtr;
12976 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12977 Jim_IncrRefCount(objPtr);
12978 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12979 Jim_DecrRefCount(interp, objPtr);
12981 else {
12982 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12983 return JIM_ERR;
12985 if (retcode != JIM_OK)
12986 return retcode;
12987 Jim_SetResult(interp, exprResultPtr);
12988 Jim_DecrRefCount(interp, exprResultPtr);
12989 return JIM_OK;
12992 /* [break] */
12993 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12995 if (argc != 1) {
12996 Jim_WrongNumArgs(interp, 1, argv, "");
12997 return JIM_ERR;
12999 return JIM_BREAK;
13002 /* [continue] */
13003 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13005 if (argc != 1) {
13006 Jim_WrongNumArgs(interp, 1, argv, "");
13007 return JIM_ERR;
13009 return JIM_CONTINUE;
13012 /* [return] */
13013 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13015 int i;
13016 Jim_Obj *stackTraceObj = NULL;
13017 Jim_Obj *errorCodeObj = NULL;
13018 int returnCode = JIM_OK;
13019 long level = 1;
13021 for (i = 1; i < argc - 1; i += 2) {
13022 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13023 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13024 return JIM_ERR;
13027 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13028 stackTraceObj = argv[i + 1];
13030 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13031 errorCodeObj = argv[i + 1];
13033 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13034 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13035 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13036 return JIM_ERR;
13039 else {
13040 break;
13044 if (i != argc - 1 && i != argc) {
13045 Jim_WrongNumArgs(interp, 1, argv,
13046 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13049 /* If a stack trace is supplied and code is error, set the stack trace */
13050 if (stackTraceObj && returnCode == JIM_ERR) {
13051 JimSetStackTrace(interp, stackTraceObj);
13053 /* If an error code list is supplied, set the global $errorCode */
13054 if (errorCodeObj && returnCode == JIM_ERR) {
13055 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13057 interp->returnCode = returnCode;
13058 interp->returnLevel = level;
13060 if (i == argc - 1) {
13061 Jim_SetResult(interp, argv[i]);
13063 return JIM_RETURN;
13066 /* [tailcall] */
13067 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13069 if (interp->framePtr->level == 0) {
13070 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13071 return JIM_ERR;
13073 else if (argc >= 2) {
13074 /* Need to resolve the tailcall command in the current context */
13075 Jim_CallFrame *cf = interp->framePtr->parent;
13077 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13078 if (cmdPtr == NULL) {
13079 return JIM_ERR;
13082 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13084 /* And stash this pre-resolved command */
13085 JimIncrCmdRefCount(cmdPtr);
13086 cf->tailcallCmd = cmdPtr;
13088 /* And stash the command list */
13089 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13091 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13092 Jim_IncrRefCount(cf->tailcallObj);
13094 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13095 return JIM_EVAL;
13097 return JIM_OK;
13100 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13102 Jim_Obj *cmdList;
13103 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13105 /* prefixListObj is a list to which the args need to be appended */
13106 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13107 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13109 return JimEvalObjList(interp, cmdList);
13112 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13114 Jim_Obj *prefixListObj = privData;
13115 Jim_DecrRefCount(interp, prefixListObj);
13118 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13120 Jim_Obj *prefixListObj;
13121 const char *newname;
13123 if (argc < 3) {
13124 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13125 return JIM_ERR;
13128 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13129 Jim_IncrRefCount(prefixListObj);
13130 newname = Jim_String(argv[1]);
13131 if (newname[0] == ':' && newname[1] == ':') {
13132 while (*++newname == ':') {
13136 Jim_SetResult(interp, argv[1]);
13138 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13141 /* [proc] */
13142 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13144 Jim_Cmd *cmd;
13146 if (argc != 4 && argc != 5) {
13147 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13148 return JIM_ERR;
13151 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13152 return JIM_ERR;
13155 if (argc == 4) {
13156 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13158 else {
13159 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13162 if (cmd) {
13163 /* Add the new command */
13164 Jim_Obj *qualifiedCmdNameObj;
13165 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13167 JimCreateCommand(interp, cmdname, cmd);
13169 /* Calculate and set the namespace for this proc */
13170 JimUpdateProcNamespace(interp, cmd, cmdname);
13172 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13174 /* Unlike Tcl, set the name of the proc as the result */
13175 Jim_SetResult(interp, argv[1]);
13176 return JIM_OK;
13178 return JIM_ERR;
13181 /* [local] */
13182 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13184 int retcode;
13186 if (argc < 2) {
13187 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13188 return JIM_ERR;
13191 /* Evaluate the arguments with 'local' in force */
13192 interp->local++;
13193 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13194 interp->local--;
13197 /* If OK, and the result is a proc, add it to the list of local procs */
13198 if (retcode == 0) {
13199 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13201 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13202 return JIM_ERR;
13204 if (interp->framePtr->localCommands == NULL) {
13205 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13206 Jim_InitStack(interp->framePtr->localCommands);
13208 Jim_IncrRefCount(cmdNameObj);
13209 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13212 return retcode;
13215 /* [upcall] */
13216 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13218 if (argc < 2) {
13219 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13220 return JIM_ERR;
13222 else {
13223 int retcode;
13225 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13226 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13227 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13228 return JIM_ERR;
13230 /* OK. Mark this command as being in an upcall */
13231 cmdPtr->u.proc.upcall++;
13232 JimIncrCmdRefCount(cmdPtr);
13234 /* Invoke the command as normal */
13235 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13237 /* No longer in an upcall */
13238 cmdPtr->u.proc.upcall--;
13239 JimDecrCmdRefCount(interp, cmdPtr);
13241 return retcode;
13245 /* [apply] */
13246 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13248 if (argc < 2) {
13249 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13250 return JIM_ERR;
13252 else {
13253 int ret;
13254 Jim_Cmd *cmd;
13255 Jim_Obj *argListObjPtr;
13256 Jim_Obj *bodyObjPtr;
13257 Jim_Obj *nsObj = NULL;
13258 Jim_Obj **nargv;
13260 int len = Jim_ListLength(interp, argv[1]);
13261 if (len != 2 && len != 3) {
13262 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13263 return JIM_ERR;
13266 if (len == 3) {
13267 #ifdef jim_ext_namespace
13268 /* Need to canonicalise the given namespace. */
13269 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13270 #else
13271 Jim_SetResultString(interp, "namespaces not enabled", -1);
13272 return JIM_ERR;
13273 #endif
13275 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13276 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13278 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13280 if (cmd) {
13281 /* Create a new argv array with a dummy argv[0], for error messages */
13282 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13283 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13284 Jim_IncrRefCount(nargv[0]);
13285 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13286 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13287 Jim_DecrRefCount(interp, nargv[0]);
13288 Jim_Free(nargv);
13290 JimDecrCmdRefCount(interp, cmd);
13291 return ret;
13293 return JIM_ERR;
13298 /* [concat] */
13299 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13301 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13302 return JIM_OK;
13305 /* [upvar] */
13306 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13308 int i;
13309 Jim_CallFrame *targetCallFrame;
13311 /* Lookup the target frame pointer */
13312 if (argc > 3 && (argc % 2 == 0)) {
13313 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13314 argc--;
13315 argv++;
13317 else {
13318 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13320 if (targetCallFrame == NULL) {
13321 return JIM_ERR;
13324 /* Check for arity */
13325 if (argc < 3) {
13326 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13327 return JIM_ERR;
13330 /* Now... for every other/local couple: */
13331 for (i = 1; i < argc; i += 2) {
13332 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13333 return JIM_ERR;
13335 return JIM_OK;
13338 /* [global] */
13339 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13341 int i;
13343 if (argc < 2) {
13344 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13345 return JIM_ERR;
13347 /* Link every var to the toplevel having the same name */
13348 if (interp->framePtr->level == 0)
13349 return JIM_OK; /* global at toplevel... */
13350 for (i = 1; i < argc; i++) {
13351 /* global ::blah does nothing */
13352 const char *name = Jim_String(argv[i]);
13353 if (name[0] != ':' || name[1] != ':') {
13354 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13355 return JIM_ERR;
13358 return JIM_OK;
13361 /* does the [string map] operation. On error NULL is returned,
13362 * otherwise a new string object with the result, having refcount = 0,
13363 * is returned. */
13364 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13365 Jim_Obj *objPtr, int nocase)
13367 int numMaps;
13368 const char *str, *noMatchStart = NULL;
13369 int strLen, i;
13370 Jim_Obj *resultObjPtr;
13372 numMaps = Jim_ListLength(interp, mapListObjPtr);
13373 if (numMaps % 2) {
13374 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13375 return NULL;
13378 str = Jim_String(objPtr);
13379 strLen = Jim_Utf8Length(interp, objPtr);
13381 /* Map it */
13382 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13383 while (strLen) {
13384 for (i = 0; i < numMaps; i += 2) {
13385 Jim_Obj *objPtr;
13386 const char *k;
13387 int kl;
13389 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13390 k = Jim_String(objPtr);
13391 kl = Jim_Utf8Length(interp, objPtr);
13393 if (strLen >= kl && kl) {
13394 int rc;
13395 rc = JimStringCompareLen(str, k, kl, nocase);
13396 if (rc == 0) {
13397 if (noMatchStart) {
13398 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13399 noMatchStart = NULL;
13401 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13402 str += utf8_index(str, kl);
13403 strLen -= kl;
13404 break;
13408 if (i == numMaps) { /* no match */
13409 int c;
13410 if (noMatchStart == NULL)
13411 noMatchStart = str;
13412 str += utf8_tounicode(str, &c);
13413 strLen--;
13416 if (noMatchStart) {
13417 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13419 return resultObjPtr;
13422 /* [string] */
13423 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13425 int len;
13426 int opt_case = 1;
13427 int option;
13428 static const char * const options[] = {
13429 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13430 "map", "repeat", "reverse", "index", "first", "last", "cat",
13431 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13433 enum
13435 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13436 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13437 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13439 static const char * const nocase_options[] = {
13440 "-nocase", NULL
13442 static const char * const nocase_length_options[] = {
13443 "-nocase", "-length", NULL
13446 if (argc < 2) {
13447 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13448 return JIM_ERR;
13450 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13451 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13452 return JIM_ERR;
13454 switch (option) {
13455 case OPT_LENGTH:
13456 case OPT_BYTELENGTH:
13457 if (argc != 3) {
13458 Jim_WrongNumArgs(interp, 2, argv, "string");
13459 return JIM_ERR;
13461 if (option == OPT_LENGTH) {
13462 len = Jim_Utf8Length(interp, argv[2]);
13464 else {
13465 len = Jim_Length(argv[2]);
13467 Jim_SetResultInt(interp, len);
13468 return JIM_OK;
13470 case OPT_CAT:{
13471 Jim_Obj *objPtr;
13472 if (argc == 3) {
13473 /* optimise the one-arg case */
13474 objPtr = argv[2];
13476 else {
13477 int i;
13479 objPtr = Jim_NewStringObj(interp, "", 0);
13481 for (i = 2; i < argc; i++) {
13482 Jim_AppendObj(interp, objPtr, argv[i]);
13485 Jim_SetResult(interp, objPtr);
13486 return JIM_OK;
13489 case OPT_COMPARE:
13490 case OPT_EQUAL:
13492 /* n is the number of remaining option args */
13493 long opt_length = -1;
13494 int n = argc - 4;
13495 int i = 2;
13496 while (n > 0) {
13497 int subopt;
13498 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13499 JIM_ENUM_ABBREV) != JIM_OK) {
13500 badcompareargs:
13501 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13502 return JIM_ERR;
13504 if (subopt == 0) {
13505 /* -nocase */
13506 opt_case = 0;
13507 n--;
13509 else {
13510 /* -length */
13511 if (n < 2) {
13512 goto badcompareargs;
13514 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13515 return JIM_ERR;
13517 n -= 2;
13520 if (n) {
13521 goto badcompareargs;
13523 argv += argc - 2;
13524 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13525 /* Fast version - [string equal], case sensitive, no length */
13526 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13528 else {
13529 if (opt_length >= 0) {
13530 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13532 else {
13533 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13535 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13537 return JIM_OK;
13540 case OPT_MATCH:
13541 if (argc != 4 &&
13542 (argc != 5 ||
13543 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13544 JIM_ENUM_ABBREV) != JIM_OK)) {
13545 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13546 return JIM_ERR;
13548 if (opt_case == 0) {
13549 argv++;
13551 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13552 return JIM_OK;
13554 case OPT_MAP:{
13555 Jim_Obj *objPtr;
13557 if (argc != 4 &&
13558 (argc != 5 ||
13559 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13560 JIM_ENUM_ABBREV) != JIM_OK)) {
13561 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13562 return JIM_ERR;
13565 if (opt_case == 0) {
13566 argv++;
13568 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13569 if (objPtr == NULL) {
13570 return JIM_ERR;
13572 Jim_SetResult(interp, objPtr);
13573 return JIM_OK;
13576 case OPT_RANGE:
13577 case OPT_BYTERANGE:{
13578 Jim_Obj *objPtr;
13580 if (argc != 5) {
13581 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13582 return JIM_ERR;
13584 if (option == OPT_RANGE) {
13585 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13587 else
13589 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13592 if (objPtr == NULL) {
13593 return JIM_ERR;
13595 Jim_SetResult(interp, objPtr);
13596 return JIM_OK;
13599 case OPT_REPLACE:{
13600 Jim_Obj *objPtr;
13602 if (argc != 5 && argc != 6) {
13603 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13604 return JIM_ERR;
13606 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13607 if (objPtr == NULL) {
13608 return JIM_ERR;
13610 Jim_SetResult(interp, objPtr);
13611 return JIM_OK;
13615 case OPT_REPEAT:{
13616 Jim_Obj *objPtr;
13617 jim_wide count;
13619 if (argc != 4) {
13620 Jim_WrongNumArgs(interp, 2, argv, "string count");
13621 return JIM_ERR;
13623 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13624 return JIM_ERR;
13626 objPtr = Jim_NewStringObj(interp, "", 0);
13627 if (count > 0) {
13628 while (count--) {
13629 Jim_AppendObj(interp, objPtr, argv[2]);
13632 Jim_SetResult(interp, objPtr);
13633 return JIM_OK;
13636 case OPT_REVERSE:{
13637 char *buf, *p;
13638 const char *str;
13639 int len;
13640 int i;
13642 if (argc != 3) {
13643 Jim_WrongNumArgs(interp, 2, argv, "string");
13644 return JIM_ERR;
13647 str = Jim_GetString(argv[2], &len);
13648 buf = Jim_Alloc(len + 1);
13649 p = buf + len;
13650 *p = 0;
13651 for (i = 0; i < len; ) {
13652 int c;
13653 int l = utf8_tounicode(str, &c);
13654 memcpy(p - l, str, l);
13655 p -= l;
13656 i += l;
13657 str += l;
13659 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13660 return JIM_OK;
13663 case OPT_INDEX:{
13664 int idx;
13665 const char *str;
13667 if (argc != 4) {
13668 Jim_WrongNumArgs(interp, 2, argv, "string index");
13669 return JIM_ERR;
13671 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13672 return JIM_ERR;
13674 str = Jim_String(argv[2]);
13675 len = Jim_Utf8Length(interp, argv[2]);
13676 if (idx != INT_MIN && idx != INT_MAX) {
13677 idx = JimRelToAbsIndex(len, idx);
13679 if (idx < 0 || idx >= len || str == NULL) {
13680 Jim_SetResultString(interp, "", 0);
13682 else if (len == Jim_Length(argv[2])) {
13683 /* ASCII optimisation */
13684 Jim_SetResultString(interp, str + idx, 1);
13686 else {
13687 int c;
13688 int i = utf8_index(str, idx);
13689 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13691 return JIM_OK;
13694 case OPT_FIRST:
13695 case OPT_LAST:{
13696 int idx = 0, l1, l2;
13697 const char *s1, *s2;
13699 if (argc != 4 && argc != 5) {
13700 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13701 return JIM_ERR;
13703 s1 = Jim_String(argv[2]);
13704 s2 = Jim_String(argv[3]);
13705 l1 = Jim_Utf8Length(interp, argv[2]);
13706 l2 = Jim_Utf8Length(interp, argv[3]);
13707 if (argc == 5) {
13708 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13709 return JIM_ERR;
13711 idx = JimRelToAbsIndex(l2, idx);
13713 else if (option == OPT_LAST) {
13714 idx = l2;
13716 if (option == OPT_FIRST) {
13717 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13719 else {
13720 #ifdef JIM_UTF8
13721 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13722 #else
13723 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13724 #endif
13726 return JIM_OK;
13729 case OPT_TRIM:
13730 case OPT_TRIMLEFT:
13731 case OPT_TRIMRIGHT:{
13732 Jim_Obj *trimchars;
13734 if (argc != 3 && argc != 4) {
13735 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13736 return JIM_ERR;
13738 trimchars = (argc == 4 ? argv[3] : NULL);
13739 if (option == OPT_TRIM) {
13740 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13742 else if (option == OPT_TRIMLEFT) {
13743 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13745 else if (option == OPT_TRIMRIGHT) {
13746 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13748 return JIM_OK;
13751 case OPT_TOLOWER:
13752 case OPT_TOUPPER:
13753 case OPT_TOTITLE:
13754 if (argc != 3) {
13755 Jim_WrongNumArgs(interp, 2, argv, "string");
13756 return JIM_ERR;
13758 if (option == OPT_TOLOWER) {
13759 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13761 else if (option == OPT_TOUPPER) {
13762 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13764 else {
13765 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13767 return JIM_OK;
13769 case OPT_IS:
13770 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13771 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13773 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13774 return JIM_ERR;
13776 return JIM_OK;
13779 /* [time] */
13780 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13782 long i, count = 1;
13783 jim_wide start, elapsed;
13784 char buf[60];
13785 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13787 if (argc < 2) {
13788 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13789 return JIM_ERR;
13791 if (argc == 3) {
13792 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13793 return JIM_ERR;
13795 if (count < 0)
13796 return JIM_OK;
13797 i = count;
13798 start = JimClock();
13799 while (i-- > 0) {
13800 int retval;
13802 retval = Jim_EvalObj(interp, argv[1]);
13803 if (retval != JIM_OK) {
13804 return retval;
13807 elapsed = JimClock() - start;
13808 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13809 Jim_SetResultString(interp, buf, -1);
13810 return JIM_OK;
13813 /* [exit] */
13814 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13816 long exitCode = 0;
13818 if (argc > 2) {
13819 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13820 return JIM_ERR;
13822 if (argc == 2) {
13823 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13824 return JIM_ERR;
13826 interp->exitCode = exitCode;
13827 return JIM_EXIT;
13830 /* [catch] */
13831 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13833 int exitCode = 0;
13834 int i;
13835 int sig = 0;
13837 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13838 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13839 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13841 /* Reset the error code before catch.
13842 * Note that this is not strictly correct.
13844 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13846 for (i = 1; i < argc - 1; i++) {
13847 const char *arg = Jim_String(argv[i]);
13848 jim_wide option;
13849 int ignore;
13851 /* It's a pity we can't use Jim_GetEnum here :-( */
13852 if (strcmp(arg, "--") == 0) {
13853 i++;
13854 break;
13856 if (*arg != '-') {
13857 break;
13860 if (strncmp(arg, "-no", 3) == 0) {
13861 arg += 3;
13862 ignore = 1;
13864 else {
13865 arg++;
13866 ignore = 0;
13869 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13870 option = -1;
13872 if (option < 0) {
13873 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13875 if (option < 0) {
13876 goto wrongargs;
13879 if (ignore) {
13880 ignore_mask |= ((jim_wide)1 << option);
13882 else {
13883 ignore_mask &= (~((jim_wide)1 << option));
13887 argc -= i;
13888 if (argc < 1 || argc > 3) {
13889 wrongargs:
13890 Jim_WrongNumArgs(interp, 1, argv,
13891 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13892 return JIM_ERR;
13894 argv += i;
13896 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13897 sig++;
13900 interp->signal_level += sig;
13901 if (Jim_CheckSignal(interp)) {
13902 /* If a signal is set, don't even try to execute the body */
13903 exitCode = JIM_SIGNAL;
13905 else {
13906 exitCode = Jim_EvalObj(interp, argv[0]);
13907 /* Don't want any caught error included in a later stack trace */
13908 interp->errorFlag = 0;
13910 interp->signal_level -= sig;
13912 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13913 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13914 /* Not caught, pass it up */
13915 return exitCode;
13918 if (sig && exitCode == JIM_SIGNAL) {
13919 /* Catch the signal at this level */
13920 if (interp->signal_set_result) {
13921 interp->signal_set_result(interp, interp->sigmask);
13923 else {
13924 Jim_SetResultInt(interp, interp->sigmask);
13926 interp->sigmask = 0;
13929 if (argc >= 2) {
13930 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13931 return JIM_ERR;
13933 if (argc == 3) {
13934 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13936 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13937 Jim_ListAppendElement(interp, optListObj,
13938 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13939 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13940 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13941 if (exitCode == JIM_ERR) {
13942 Jim_Obj *errorCode;
13943 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13944 -1));
13945 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13947 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13948 if (errorCode) {
13949 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13950 Jim_ListAppendElement(interp, optListObj, errorCode);
13953 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13954 return JIM_ERR;
13958 Jim_SetResultInt(interp, exitCode);
13959 return JIM_OK;
13962 #ifdef JIM_REFERENCES
13964 /* [ref] */
13965 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13967 if (argc != 3 && argc != 4) {
13968 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13969 return JIM_ERR;
13971 if (argc == 3) {
13972 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13974 else {
13975 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13977 return JIM_OK;
13980 /* [getref] */
13981 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13983 Jim_Reference *refPtr;
13985 if (argc != 2) {
13986 Jim_WrongNumArgs(interp, 1, argv, "reference");
13987 return JIM_ERR;
13989 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13990 return JIM_ERR;
13991 Jim_SetResult(interp, refPtr->objPtr);
13992 return JIM_OK;
13995 /* [setref] */
13996 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13998 Jim_Reference *refPtr;
14000 if (argc != 3) {
14001 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14002 return JIM_ERR;
14004 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14005 return JIM_ERR;
14006 Jim_IncrRefCount(argv[2]);
14007 Jim_DecrRefCount(interp, refPtr->objPtr);
14008 refPtr->objPtr = argv[2];
14009 Jim_SetResult(interp, argv[2]);
14010 return JIM_OK;
14013 /* [collect] */
14014 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14016 if (argc != 1) {
14017 Jim_WrongNumArgs(interp, 1, argv, "");
14018 return JIM_ERR;
14020 Jim_SetResultInt(interp, Jim_Collect(interp));
14022 /* Free all the freed objects. */
14023 while (interp->freeList) {
14024 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14025 Jim_Free(interp->freeList);
14026 interp->freeList = nextObjPtr;
14029 return JIM_OK;
14032 /* [finalize] reference ?newValue? */
14033 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14035 if (argc != 2 && argc != 3) {
14036 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14037 return JIM_ERR;
14039 if (argc == 2) {
14040 Jim_Obj *cmdNamePtr;
14042 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14043 return JIM_ERR;
14044 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14045 Jim_SetResult(interp, cmdNamePtr);
14047 else {
14048 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14049 return JIM_ERR;
14050 Jim_SetResult(interp, argv[2]);
14052 return JIM_OK;
14055 /* [info references] */
14056 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14058 Jim_Obj *listObjPtr;
14059 Jim_HashTableIterator htiter;
14060 Jim_HashEntry *he;
14062 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14064 JimInitHashTableIterator(&interp->references, &htiter);
14065 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14066 char buf[JIM_REFERENCE_SPACE + 1];
14067 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14068 const unsigned long *refId = he->key;
14070 JimFormatReference(buf, refPtr, *refId);
14071 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14073 Jim_SetResult(interp, listObjPtr);
14074 return JIM_OK;
14076 #endif
14078 /* [rename] */
14079 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14081 if (argc != 3) {
14082 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14083 return JIM_ERR;
14086 if (JimValidName(interp, "new procedure", argv[2])) {
14087 return JIM_ERR;
14090 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14093 #define JIM_DICTMATCH_VALUES 0x0001
14095 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14097 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14099 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14100 if (type & JIM_DICTMATCH_VALUES) {
14101 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14106 * Like JimHashtablePatternMatch, but for dictionaries.
14108 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14109 JimDictMatchCallbackType *callback, int type)
14111 Jim_HashEntry *he;
14112 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14114 /* Check for the non-pattern case. We can do this much more efficiently. */
14115 Jim_HashTableIterator htiter;
14116 JimInitHashTableIterator(ht, &htiter);
14117 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14118 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14119 callback(interp, listObjPtr, he, type);
14123 return listObjPtr;
14127 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14129 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14130 return JIM_ERR;
14132 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14133 return JIM_OK;
14136 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14138 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14139 return JIM_ERR;
14141 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14142 return JIM_OK;
14145 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14147 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14148 return -1;
14150 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14153 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14155 Jim_HashTable *ht;
14156 unsigned int i;
14158 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14159 return JIM_ERR;
14162 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14164 /* Note that this uses internal knowledge of the hash table */
14165 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14167 for (i = 0; i < ht->size; i++) {
14168 Jim_HashEntry *he = ht->table[i];
14170 if (he) {
14171 printf("%d: ", i);
14173 while (he) {
14174 printf(" %s", Jim_String(he->key));
14175 he = he->next;
14177 printf("\n");
14180 return JIM_OK;
14183 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14185 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14187 Jim_AppendString(interp, prefixObj, " ", 1);
14188 Jim_AppendString(interp, prefixObj, subcmd, -1);
14190 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14193 /* [dict] */
14194 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14196 Jim_Obj *objPtr;
14197 int option;
14198 static const char * const options[] = {
14199 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14200 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14201 "replace", "update", NULL
14203 enum
14205 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14206 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14207 OPT_REPLACE, OPT_UPDATE,
14210 if (argc < 2) {
14211 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14212 return JIM_ERR;
14215 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14216 return JIM_ERR;
14219 switch (option) {
14220 case OPT_GET:
14221 if (argc < 3) {
14222 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14223 return JIM_ERR;
14225 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14226 JIM_ERRMSG) != JIM_OK) {
14227 return JIM_ERR;
14229 Jim_SetResult(interp, objPtr);
14230 return JIM_OK;
14232 case OPT_SET:
14233 if (argc < 5) {
14234 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14235 return JIM_ERR;
14237 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14239 case OPT_EXISTS:
14240 if (argc < 4) {
14241 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14242 return JIM_ERR;
14244 else {
14245 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14246 if (rc < 0) {
14247 return JIM_ERR;
14249 Jim_SetResultBool(interp, rc == JIM_OK);
14250 return JIM_OK;
14253 case OPT_UNSET:
14254 if (argc < 4) {
14255 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14256 return JIM_ERR;
14258 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14259 return JIM_ERR;
14261 return JIM_OK;
14263 case OPT_KEYS:
14264 if (argc != 3 && argc != 4) {
14265 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14266 return JIM_ERR;
14268 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14270 case OPT_SIZE:
14271 if (argc != 3) {
14272 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14273 return JIM_ERR;
14275 else if (Jim_DictSize(interp, argv[2]) < 0) {
14276 return JIM_ERR;
14278 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14279 return JIM_OK;
14281 case OPT_MERGE:
14282 if (argc == 2) {
14283 return JIM_OK;
14285 if (Jim_DictSize(interp, argv[2]) < 0) {
14286 return JIM_ERR;
14288 /* Handle as ensemble */
14289 break;
14291 case OPT_UPDATE:
14292 if (argc < 6 || argc % 2) {
14293 /* Better error message */
14294 argc = 2;
14296 break;
14298 case OPT_CREATE:
14299 if (argc % 2) {
14300 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14301 return JIM_ERR;
14303 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14304 Jim_SetResult(interp, objPtr);
14305 return JIM_OK;
14307 case OPT_INFO:
14308 if (argc != 3) {
14309 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14310 return JIM_ERR;
14312 return Jim_DictInfo(interp, argv[2]);
14314 /* Handle command as an ensemble */
14315 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14318 /* [subst] */
14319 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14321 static const char * const options[] = {
14322 "-nobackslashes", "-nocommands", "-novariables", NULL
14324 enum
14325 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14326 int i;
14327 int flags = JIM_SUBST_FLAG;
14328 Jim_Obj *objPtr;
14330 if (argc < 2) {
14331 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14332 return JIM_ERR;
14334 for (i = 1; i < (argc - 1); i++) {
14335 int option;
14337 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14338 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14339 return JIM_ERR;
14341 switch (option) {
14342 case OPT_NOBACKSLASHES:
14343 flags |= JIM_SUBST_NOESC;
14344 break;
14345 case OPT_NOCOMMANDS:
14346 flags |= JIM_SUBST_NOCMD;
14347 break;
14348 case OPT_NOVARIABLES:
14349 flags |= JIM_SUBST_NOVAR;
14350 break;
14353 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14354 return JIM_ERR;
14356 Jim_SetResult(interp, objPtr);
14357 return JIM_OK;
14360 /* [info] */
14361 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14363 int cmd;
14364 Jim_Obj *objPtr;
14365 int mode = 0;
14367 static const char * const commands[] = {
14368 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14369 "vars", "version", "patchlevel", "complete", "args", "hostname",
14370 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14371 "references", "alias", NULL
14373 enum
14374 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14375 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14376 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14377 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14380 #ifdef jim_ext_namespace
14381 int nons = 0;
14383 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14384 /* This is for internal use only */
14385 argc--;
14386 argv++;
14387 nons = 1;
14389 #endif
14391 if (argc < 2) {
14392 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14393 return JIM_ERR;
14395 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14396 != JIM_OK) {
14397 return JIM_ERR;
14400 /* Test for the most common commands first, just in case it makes a difference */
14401 switch (cmd) {
14402 case INFO_EXISTS:
14403 if (argc != 3) {
14404 Jim_WrongNumArgs(interp, 2, argv, "varName");
14405 return JIM_ERR;
14407 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14408 break;
14410 case INFO_ALIAS:{
14411 Jim_Cmd *cmdPtr;
14413 if (argc != 3) {
14414 Jim_WrongNumArgs(interp, 2, argv, "command");
14415 return JIM_ERR;
14417 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14418 return JIM_ERR;
14420 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14421 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14422 return JIM_ERR;
14424 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14425 return JIM_OK;
14428 case INFO_CHANNELS:
14429 mode++; /* JIM_CMDLIST_CHANNELS */
14430 #ifndef jim_ext_aio
14431 Jim_SetResultString(interp, "aio not enabled", -1);
14432 return JIM_ERR;
14433 #endif
14434 /* fall through */
14435 case INFO_PROCS:
14436 mode++; /* JIM_CMDLIST_PROCS */
14437 /* fall through */
14438 case INFO_COMMANDS:
14439 /* mode 0 => JIM_CMDLIST_COMMANDS */
14440 if (argc != 2 && argc != 3) {
14441 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14442 return JIM_ERR;
14444 #ifdef jim_ext_namespace
14445 if (!nons) {
14446 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14447 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14450 #endif
14451 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14452 break;
14454 case INFO_VARS:
14455 mode++; /* JIM_VARLIST_VARS */
14456 /* fall through */
14457 case INFO_LOCALS:
14458 mode++; /* JIM_VARLIST_LOCALS */
14459 /* fall through */
14460 case INFO_GLOBALS:
14461 /* mode 0 => JIM_VARLIST_GLOBALS */
14462 if (argc != 2 && argc != 3) {
14463 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14464 return JIM_ERR;
14466 #ifdef jim_ext_namespace
14467 if (!nons) {
14468 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14469 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14472 #endif
14473 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14474 break;
14476 case INFO_SCRIPT:
14477 if (argc != 2) {
14478 Jim_WrongNumArgs(interp, 2, argv, "");
14479 return JIM_ERR;
14481 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14482 break;
14484 case INFO_SOURCE:{
14485 jim_wide line;
14486 Jim_Obj *resObjPtr;
14487 Jim_Obj *fileNameObj;
14489 if (argc != 3 && argc != 5) {
14490 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14491 return JIM_ERR;
14493 if (argc == 5) {
14494 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14495 return JIM_ERR;
14497 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14498 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14500 else {
14501 if (argv[2]->typePtr == &sourceObjType) {
14502 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14503 line = argv[2]->internalRep.sourceValue.lineNumber;
14505 else if (argv[2]->typePtr == &scriptObjType) {
14506 ScriptObj *script = JimGetScript(interp, argv[2]);
14507 fileNameObj = script->fileNameObj;
14508 line = script->firstline;
14510 else {
14511 fileNameObj = interp->emptyObj;
14512 line = 1;
14514 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14515 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14516 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14518 Jim_SetResult(interp, resObjPtr);
14519 break;
14522 case INFO_STACKTRACE:
14523 Jim_SetResult(interp, interp->stackTrace);
14524 break;
14526 case INFO_LEVEL:
14527 case INFO_FRAME:
14528 switch (argc) {
14529 case 2:
14530 Jim_SetResultInt(interp, interp->framePtr->level);
14531 break;
14533 case 3:
14534 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14535 return JIM_ERR;
14537 Jim_SetResult(interp, objPtr);
14538 break;
14540 default:
14541 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14542 return JIM_ERR;
14544 break;
14546 case INFO_BODY:
14547 case INFO_STATICS:
14548 case INFO_ARGS:{
14549 Jim_Cmd *cmdPtr;
14551 if (argc != 3) {
14552 Jim_WrongNumArgs(interp, 2, argv, "procname");
14553 return JIM_ERR;
14555 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14556 return JIM_ERR;
14558 if (!cmdPtr->isproc) {
14559 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14560 return JIM_ERR;
14562 switch (cmd) {
14563 case INFO_BODY:
14564 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14565 break;
14566 case INFO_ARGS:
14567 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14568 break;
14569 case INFO_STATICS:
14570 if (cmdPtr->u.proc.staticVars) {
14571 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14572 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14573 NULL, JimVariablesMatch, mode));
14575 break;
14577 break;
14580 case INFO_VERSION:
14581 case INFO_PATCHLEVEL:{
14582 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14584 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14585 Jim_SetResultString(interp, buf, -1);
14586 break;
14589 case INFO_COMPLETE:
14590 if (argc != 3 && argc != 4) {
14591 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14592 return JIM_ERR;
14594 else {
14595 char missing;
14597 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14598 if (missing != ' ' && argc == 4) {
14599 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14602 break;
14604 case INFO_HOSTNAME:
14605 /* Redirect to os.gethostname if it exists */
14606 return Jim_Eval(interp, "os.gethostname");
14608 case INFO_NAMEOFEXECUTABLE:
14609 /* Redirect to Tcl proc */
14610 return Jim_Eval(interp, "{info nameofexecutable}");
14612 case INFO_RETURNCODES:
14613 if (argc == 2) {
14614 int i;
14615 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14617 for (i = 0; jimReturnCodes[i]; i++) {
14618 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14619 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14620 jimReturnCodes[i], -1));
14623 Jim_SetResult(interp, listObjPtr);
14625 else if (argc == 3) {
14626 long code;
14627 const char *name;
14629 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14630 return JIM_ERR;
14632 name = Jim_ReturnCode(code);
14633 if (*name == '?') {
14634 Jim_SetResultInt(interp, code);
14636 else {
14637 Jim_SetResultString(interp, name, -1);
14640 else {
14641 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14642 return JIM_ERR;
14644 break;
14645 case INFO_REFERENCES:
14646 #ifdef JIM_REFERENCES
14647 return JimInfoReferences(interp, argc, argv);
14648 #else
14649 Jim_SetResultString(interp, "not supported", -1);
14650 return JIM_ERR;
14651 #endif
14653 return JIM_OK;
14656 /* [exists] */
14657 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14659 Jim_Obj *objPtr;
14660 int result = 0;
14662 static const char * const options[] = {
14663 "-command", "-proc", "-alias", "-var", NULL
14665 enum
14667 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14669 int option;
14671 if (argc == 2) {
14672 option = OPT_VAR;
14673 objPtr = argv[1];
14675 else if (argc == 3) {
14676 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14677 return JIM_ERR;
14679 objPtr = argv[2];
14681 else {
14682 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14683 return JIM_ERR;
14686 if (option == OPT_VAR) {
14687 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14689 else {
14690 /* Now different kinds of commands */
14691 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14693 if (cmd) {
14694 switch (option) {
14695 case OPT_COMMAND:
14696 result = 1;
14697 break;
14699 case OPT_ALIAS:
14700 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14701 break;
14703 case OPT_PROC:
14704 result = cmd->isproc;
14705 break;
14709 Jim_SetResultBool(interp, result);
14710 return JIM_OK;
14713 /* [split] */
14714 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14716 const char *str, *splitChars, *noMatchStart;
14717 int splitLen, strLen;
14718 Jim_Obj *resObjPtr;
14719 int c;
14720 int len;
14722 if (argc != 2 && argc != 3) {
14723 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14724 return JIM_ERR;
14727 str = Jim_GetString(argv[1], &len);
14728 if (len == 0) {
14729 return JIM_OK;
14731 strLen = Jim_Utf8Length(interp, argv[1]);
14733 /* Init */
14734 if (argc == 2) {
14735 splitChars = " \n\t\r";
14736 splitLen = 4;
14738 else {
14739 splitChars = Jim_String(argv[2]);
14740 splitLen = Jim_Utf8Length(interp, argv[2]);
14743 noMatchStart = str;
14744 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14746 /* Split */
14747 if (splitLen) {
14748 Jim_Obj *objPtr;
14749 while (strLen--) {
14750 const char *sc = splitChars;
14751 int scLen = splitLen;
14752 int sl = utf8_tounicode(str, &c);
14753 while (scLen--) {
14754 int pc;
14755 sc += utf8_tounicode(sc, &pc);
14756 if (c == pc) {
14757 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14758 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14759 noMatchStart = str + sl;
14760 break;
14763 str += sl;
14765 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14766 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14768 else {
14769 /* This handles the special case of splitchars eq {}
14770 * Optimise by sharing common (ASCII) characters
14772 Jim_Obj **commonObj = NULL;
14773 #define NUM_COMMON (128 - 9)
14774 while (strLen--) {
14775 int n = utf8_tounicode(str, &c);
14776 #ifdef JIM_OPTIMIZATION
14777 if (c >= 9 && c < 128) {
14778 /* Common ASCII char. Note that 9 is the tab character */
14779 c -= 9;
14780 if (!commonObj) {
14781 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14782 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14784 if (!commonObj[c]) {
14785 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14787 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14788 str++;
14789 continue;
14791 #endif
14792 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14793 str += n;
14795 Jim_Free(commonObj);
14798 Jim_SetResult(interp, resObjPtr);
14799 return JIM_OK;
14802 /* [join] */
14803 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14805 const char *joinStr;
14806 int joinStrLen;
14808 if (argc != 2 && argc != 3) {
14809 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14810 return JIM_ERR;
14812 /* Init */
14813 if (argc == 2) {
14814 joinStr = " ";
14815 joinStrLen = 1;
14817 else {
14818 joinStr = Jim_GetString(argv[2], &joinStrLen);
14820 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14821 return JIM_OK;
14824 /* [format] */
14825 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14827 Jim_Obj *objPtr;
14829 if (argc < 2) {
14830 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14831 return JIM_ERR;
14833 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14834 if (objPtr == NULL)
14835 return JIM_ERR;
14836 Jim_SetResult(interp, objPtr);
14837 return JIM_OK;
14840 /* [scan] */
14841 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14843 Jim_Obj *listPtr, **outVec;
14844 int outc, i;
14846 if (argc < 3) {
14847 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14848 return JIM_ERR;
14850 if (argv[2]->typePtr != &scanFmtStringObjType)
14851 SetScanFmtFromAny(interp, argv[2]);
14852 if (FormatGetError(argv[2]) != 0) {
14853 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14854 return JIM_ERR;
14856 if (argc > 3) {
14857 int maxPos = FormatGetMaxPos(argv[2]);
14858 int count = FormatGetCnvCount(argv[2]);
14860 if (maxPos > argc - 3) {
14861 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14862 return JIM_ERR;
14864 else if (count > argc - 3) {
14865 Jim_SetResultString(interp, "different numbers of variable names and "
14866 "field specifiers", -1);
14867 return JIM_ERR;
14869 else if (count < argc - 3) {
14870 Jim_SetResultString(interp, "variable is not assigned by any "
14871 "conversion specifiers", -1);
14872 return JIM_ERR;
14875 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14876 if (listPtr == 0)
14877 return JIM_ERR;
14878 if (argc > 3) {
14879 int rc = JIM_OK;
14880 int count = 0;
14882 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14883 int len = Jim_ListLength(interp, listPtr);
14885 if (len != 0) {
14886 JimListGetElements(interp, listPtr, &outc, &outVec);
14887 for (i = 0; i < outc; ++i) {
14888 if (Jim_Length(outVec[i]) > 0) {
14889 ++count;
14890 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14891 rc = JIM_ERR;
14896 Jim_FreeNewObj(interp, listPtr);
14898 else {
14899 count = -1;
14901 if (rc == JIM_OK) {
14902 Jim_SetResultInt(interp, count);
14904 return rc;
14906 else {
14907 if (listPtr == (Jim_Obj *)EOF) {
14908 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14909 return JIM_OK;
14911 Jim_SetResult(interp, listPtr);
14913 return JIM_OK;
14916 /* [error] */
14917 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14919 if (argc != 2 && argc != 3) {
14920 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14921 return JIM_ERR;
14923 Jim_SetResult(interp, argv[1]);
14924 if (argc == 3) {
14925 JimSetStackTrace(interp, argv[2]);
14926 return JIM_ERR;
14928 interp->addStackTrace++;
14929 return JIM_ERR;
14932 /* [lrange] */
14933 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14935 Jim_Obj *objPtr;
14937 if (argc != 4) {
14938 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14939 return JIM_ERR;
14941 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14942 return JIM_ERR;
14943 Jim_SetResult(interp, objPtr);
14944 return JIM_OK;
14947 /* [lrepeat] */
14948 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14950 Jim_Obj *objPtr;
14951 long count;
14953 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14954 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14955 return JIM_ERR;
14958 if (count == 0 || argc == 2) {
14959 return JIM_OK;
14962 argc -= 2;
14963 argv += 2;
14965 objPtr = Jim_NewListObj(interp, argv, argc);
14966 while (--count) {
14967 ListInsertElements(objPtr, -1, argc, argv);
14970 Jim_SetResult(interp, objPtr);
14971 return JIM_OK;
14974 char **Jim_GetEnviron(void)
14976 #if defined(HAVE__NSGETENVIRON)
14977 return *_NSGetEnviron();
14978 #else
14979 #if !defined(NO_ENVIRON_EXTERN)
14980 extern char **environ;
14981 #endif
14983 return environ;
14984 #endif
14987 void Jim_SetEnviron(char **env)
14989 #if defined(HAVE__NSGETENVIRON)
14990 *_NSGetEnviron() = env;
14991 #else
14992 #if !defined(NO_ENVIRON_EXTERN)
14993 extern char **environ;
14994 #endif
14996 environ = env;
14997 #endif
15000 /* [env] */
15001 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15003 const char *key;
15004 const char *val;
15006 if (argc == 1) {
15007 char **e = Jim_GetEnviron();
15009 int i;
15010 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15012 for (i = 0; e[i]; i++) {
15013 const char *equals = strchr(e[i], '=');
15015 if (equals) {
15016 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15017 equals - e[i]));
15018 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15022 Jim_SetResult(interp, listObjPtr);
15023 return JIM_OK;
15026 if (argc < 2) {
15027 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15028 return JIM_ERR;
15030 key = Jim_String(argv[1]);
15031 val = getenv(key);
15032 if (val == NULL) {
15033 if (argc < 3) {
15034 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15035 return JIM_ERR;
15037 val = Jim_String(argv[2]);
15039 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15040 return JIM_OK;
15043 /* [source] */
15044 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15046 int retval;
15048 if (argc != 2) {
15049 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15050 return JIM_ERR;
15052 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15053 if (retval == JIM_RETURN)
15054 return JIM_OK;
15055 return retval;
15058 /* [lreverse] */
15059 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15061 Jim_Obj *revObjPtr, **ele;
15062 int len;
15064 if (argc != 2) {
15065 Jim_WrongNumArgs(interp, 1, argv, "list");
15066 return JIM_ERR;
15068 JimListGetElements(interp, argv[1], &len, &ele);
15069 len--;
15070 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15071 while (len >= 0)
15072 ListAppendElement(revObjPtr, ele[len--]);
15073 Jim_SetResult(interp, revObjPtr);
15074 return JIM_OK;
15077 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15079 jim_wide len;
15081 if (step == 0)
15082 return -1;
15083 if (start == end)
15084 return 0;
15085 else if (step > 0 && start > end)
15086 return -1;
15087 else if (step < 0 && end > start)
15088 return -1;
15089 len = end - start;
15090 if (len < 0)
15091 len = -len; /* abs(len) */
15092 if (step < 0)
15093 step = -step; /* abs(step) */
15094 len = 1 + ((len - 1) / step);
15095 /* We can truncate safely to INT_MAX, the range command
15096 * will always return an error for a such long range
15097 * because Tcl lists can't be so long. */
15098 if (len > INT_MAX)
15099 len = INT_MAX;
15100 return (int)((len < 0) ? -1 : len);
15103 /* [range] */
15104 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15106 jim_wide start = 0, end, step = 1;
15107 int len, i;
15108 Jim_Obj *objPtr;
15110 if (argc < 2 || argc > 4) {
15111 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15112 return JIM_ERR;
15114 if (argc == 2) {
15115 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15116 return JIM_ERR;
15118 else {
15119 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15120 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15121 return JIM_ERR;
15122 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15123 return JIM_ERR;
15125 if ((len = JimRangeLen(start, end, step)) == -1) {
15126 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15127 return JIM_ERR;
15129 objPtr = Jim_NewListObj(interp, NULL, 0);
15130 for (i = 0; i < len; i++)
15131 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15132 Jim_SetResult(interp, objPtr);
15133 return JIM_OK;
15136 /* [rand] */
15137 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15139 jim_wide min = 0, max = 0, len, maxMul;
15141 if (argc < 1 || argc > 3) {
15142 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15143 return JIM_ERR;
15145 if (argc == 1) {
15146 max = JIM_WIDE_MAX;
15147 } else if (argc == 2) {
15148 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15149 return JIM_ERR;
15150 } else if (argc == 3) {
15151 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15152 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15153 return JIM_ERR;
15155 len = max-min;
15156 if (len < 0) {
15157 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15158 return JIM_ERR;
15160 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15161 while (1) {
15162 jim_wide r;
15164 JimRandomBytes(interp, &r, sizeof(jim_wide));
15165 if (r < 0 || r >= maxMul) continue;
15166 r = (len == 0) ? 0 : r%len;
15167 Jim_SetResultInt(interp, min+r);
15168 return JIM_OK;
15172 static const struct {
15173 const char *name;
15174 Jim_CmdProc *cmdProc;
15175 } Jim_CoreCommandsTable[] = {
15176 {"alias", Jim_AliasCoreCommand},
15177 {"set", Jim_SetCoreCommand},
15178 {"unset", Jim_UnsetCoreCommand},
15179 {"puts", Jim_PutsCoreCommand},
15180 {"+", Jim_AddCoreCommand},
15181 {"*", Jim_MulCoreCommand},
15182 {"-", Jim_SubCoreCommand},
15183 {"/", Jim_DivCoreCommand},
15184 {"incr", Jim_IncrCoreCommand},
15185 {"while", Jim_WhileCoreCommand},
15186 {"loop", Jim_LoopCoreCommand},
15187 {"for", Jim_ForCoreCommand},
15188 {"foreach", Jim_ForeachCoreCommand},
15189 {"lmap", Jim_LmapCoreCommand},
15190 {"lassign", Jim_LassignCoreCommand},
15191 {"if", Jim_IfCoreCommand},
15192 {"switch", Jim_SwitchCoreCommand},
15193 {"list", Jim_ListCoreCommand},
15194 {"lindex", Jim_LindexCoreCommand},
15195 {"lset", Jim_LsetCoreCommand},
15196 {"lsearch", Jim_LsearchCoreCommand},
15197 {"llength", Jim_LlengthCoreCommand},
15198 {"lappend", Jim_LappendCoreCommand},
15199 {"linsert", Jim_LinsertCoreCommand},
15200 {"lreplace", Jim_LreplaceCoreCommand},
15201 {"lsort", Jim_LsortCoreCommand},
15202 {"append", Jim_AppendCoreCommand},
15203 {"debug", Jim_DebugCoreCommand},
15204 {"eval", Jim_EvalCoreCommand},
15205 {"uplevel", Jim_UplevelCoreCommand},
15206 {"expr", Jim_ExprCoreCommand},
15207 {"break", Jim_BreakCoreCommand},
15208 {"continue", Jim_ContinueCoreCommand},
15209 {"proc", Jim_ProcCoreCommand},
15210 {"concat", Jim_ConcatCoreCommand},
15211 {"return", Jim_ReturnCoreCommand},
15212 {"upvar", Jim_UpvarCoreCommand},
15213 {"global", Jim_GlobalCoreCommand},
15214 {"string", Jim_StringCoreCommand},
15215 {"time", Jim_TimeCoreCommand},
15216 {"exit", Jim_ExitCoreCommand},
15217 {"catch", Jim_CatchCoreCommand},
15218 #ifdef JIM_REFERENCES
15219 {"ref", Jim_RefCoreCommand},
15220 {"getref", Jim_GetrefCoreCommand},
15221 {"setref", Jim_SetrefCoreCommand},
15222 {"finalize", Jim_FinalizeCoreCommand},
15223 {"collect", Jim_CollectCoreCommand},
15224 #endif
15225 {"rename", Jim_RenameCoreCommand},
15226 {"dict", Jim_DictCoreCommand},
15227 {"subst", Jim_SubstCoreCommand},
15228 {"info", Jim_InfoCoreCommand},
15229 {"exists", Jim_ExistsCoreCommand},
15230 {"split", Jim_SplitCoreCommand},
15231 {"join", Jim_JoinCoreCommand},
15232 {"format", Jim_FormatCoreCommand},
15233 {"scan", Jim_ScanCoreCommand},
15234 {"error", Jim_ErrorCoreCommand},
15235 {"lrange", Jim_LrangeCoreCommand},
15236 {"lrepeat", Jim_LrepeatCoreCommand},
15237 {"env", Jim_EnvCoreCommand},
15238 {"source", Jim_SourceCoreCommand},
15239 {"lreverse", Jim_LreverseCoreCommand},
15240 {"range", Jim_RangeCoreCommand},
15241 {"rand", Jim_RandCoreCommand},
15242 {"tailcall", Jim_TailcallCoreCommand},
15243 {"local", Jim_LocalCoreCommand},
15244 {"upcall", Jim_UpcallCoreCommand},
15245 {"apply", Jim_ApplyCoreCommand},
15246 {NULL, NULL},
15249 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15251 int i = 0;
15253 while (Jim_CoreCommandsTable[i].name != NULL) {
15254 Jim_CreateCommand(interp,
15255 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15256 i++;
15260 /* -----------------------------------------------------------------------------
15261 * Interactive prompt
15262 * ---------------------------------------------------------------------------*/
15263 void Jim_MakeErrorMessage(Jim_Interp *interp)
15265 Jim_Obj *argv[2];
15267 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15268 argv[1] = interp->result;
15270 Jim_EvalObjVector(interp, 2, argv);
15273 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15274 const char *prefix, const char *const *tablePtr, const char *name)
15276 int count;
15277 char **tablePtrSorted;
15278 int i;
15280 for (count = 0; tablePtr[count]; count++) {
15283 if (name == NULL) {
15284 name = "option";
15287 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15288 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15289 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15290 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15291 for (i = 0; i < count; i++) {
15292 if (i + 1 == count && count > 1) {
15293 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15295 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15296 if (i + 1 != count) {
15297 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15300 Jim_Free(tablePtrSorted);
15303 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15304 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15306 const char *bad = "bad ";
15307 const char *const *entryPtr = NULL;
15308 int i;
15309 int match = -1;
15310 int arglen;
15311 const char *arg = Jim_GetString(objPtr, &arglen);
15313 *indexPtr = -1;
15315 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15316 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15317 /* Found an exact match */
15318 *indexPtr = i;
15319 return JIM_OK;
15321 if (flags & JIM_ENUM_ABBREV) {
15322 /* Accept an unambiguous abbreviation.
15323 * Note that '-' doesnt' consitute a valid abbreviation
15325 if (strncmp(arg, *entryPtr, arglen) == 0) {
15326 if (*arg == '-' && arglen == 1) {
15327 break;
15329 if (match >= 0) {
15330 bad = "ambiguous ";
15331 goto ambiguous;
15333 match = i;
15338 /* If we had an unambiguous partial match */
15339 if (match >= 0) {
15340 *indexPtr = match;
15341 return JIM_OK;
15344 ambiguous:
15345 if (flags & JIM_ERRMSG) {
15346 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15348 return JIM_ERR;
15351 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15353 int i;
15355 for (i = 0; i < (int)len; i++) {
15356 if (array[i] && strcmp(array[i], name) == 0) {
15357 return i;
15360 return -1;
15363 int Jim_IsDict(Jim_Obj *objPtr)
15365 return objPtr->typePtr == &dictObjType;
15368 int Jim_IsList(Jim_Obj *objPtr)
15370 return objPtr->typePtr == &listObjType;
15374 * Very simple printf-like formatting, designed for error messages.
15376 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15377 * The resulting string is created and set as the result.
15379 * Each '%s' should correspond to a regular string parameter.
15380 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15381 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15383 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15385 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15387 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15389 /* Initial space needed */
15390 int len = strlen(format);
15391 int extra = 0;
15392 int n = 0;
15393 const char *params[5];
15394 char *buf;
15395 va_list args;
15396 int i;
15398 va_start(args, format);
15400 for (i = 0; i < len && n < 5; i++) {
15401 int l;
15403 if (strncmp(format + i, "%s", 2) == 0) {
15404 params[n] = va_arg(args, char *);
15406 l = strlen(params[n]);
15408 else if (strncmp(format + i, "%#s", 3) == 0) {
15409 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15411 params[n] = Jim_GetString(objPtr, &l);
15413 else {
15414 if (format[i] == '%') {
15415 i++;
15417 continue;
15419 n++;
15420 extra += l;
15423 len += extra;
15424 buf = Jim_Alloc(len + 1);
15425 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15427 va_end(args);
15429 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15432 /* stubs */
15433 #ifndef jim_ext_package
15434 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15436 return JIM_OK;
15438 #endif
15439 #ifndef jim_ext_aio
15440 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15442 Jim_SetResultString(interp, "aio not enabled", -1);
15443 return NULL;
15445 #endif
15449 * Local Variables: ***
15450 * c-basic-offset: 4 ***
15451 * tab-width: 4 ***
15452 * End: ***