expr: fixes for pow/**
[jimtcl.git] / jim.c
blob1532c1c1ef0d02bcc20b59a9a7f321ed15922141
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 res = 1;
568 /* Special cases */
569 if (b == 1) {
570 /* 1 ^ any = 1 */
571 return 1;
573 if (e < 0) {
574 if (b != -1) {
575 return 0;
577 /* Only special case is -1 ^ -n
578 * -1^-1 = -1
579 * -1^-2 = 1
580 * i.e. same as +ve n
582 e = -e;
584 while (e)
586 if (e & 1) {
587 res *= b;
589 e >>= 1;
590 b *= b;
592 return res;
595 /* -----------------------------------------------------------------------------
596 * Special functions
597 * ---------------------------------------------------------------------------*/
598 #ifdef JIM_DEBUG_PANIC
599 static void JimPanicDump(int condition, const char *fmt, ...)
601 va_list ap;
603 if (!condition) {
604 return;
607 va_start(ap, fmt);
609 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
610 vfprintf(stderr, fmt, ap);
611 fprintf(stderr, "\n\n");
612 va_end(ap);
614 #ifdef HAVE_BACKTRACE
616 void *array[40];
617 int size, i;
618 char **strings;
620 size = backtrace(array, 40);
621 strings = backtrace_symbols(array, size);
622 for (i = 0; i < size; i++)
623 fprintf(stderr, "[backtrace] %s\n", strings[i]);
624 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
625 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
627 #endif
629 exit(1);
631 #endif
633 /* -----------------------------------------------------------------------------
634 * Memory allocation
635 * ---------------------------------------------------------------------------*/
637 void *Jim_Alloc(int size)
639 return size ? malloc(size) : NULL;
642 void Jim_Free(void *ptr)
644 free(ptr);
647 void *Jim_Realloc(void *ptr, int size)
649 return realloc(ptr, size);
652 char *Jim_StrDup(const char *s)
654 return strdup(s);
657 char *Jim_StrDupLen(const char *s, int l)
659 char *copy = Jim_Alloc(l + 1);
661 memcpy(copy, s, l + 1);
662 copy[l] = 0; /* Just to be sure, original could be substring */
663 return copy;
666 /* -----------------------------------------------------------------------------
667 * Time related functions
668 * ---------------------------------------------------------------------------*/
670 /* Returns current time in microseconds */
671 static jim_wide JimClock(void)
673 struct timeval tv;
675 gettimeofday(&tv, NULL);
676 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
679 /* -----------------------------------------------------------------------------
680 * Hash Tables
681 * ---------------------------------------------------------------------------*/
683 /* -------------------------- private prototypes ---------------------------- */
684 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
685 static unsigned int JimHashTableNextPower(unsigned int size);
686 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
688 /* -------------------------- hash functions -------------------------------- */
690 /* Thomas Wang's 32 bit Mix Function */
691 unsigned int Jim_IntHashFunction(unsigned int key)
693 key += ~(key << 15);
694 key ^= (key >> 10);
695 key += (key << 3);
696 key ^= (key >> 6);
697 key += ~(key << 11);
698 key ^= (key >> 16);
699 return key;
702 /* Generic hash function (we are using to multiply by 9 and add the byte
703 * as Tcl) */
704 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
706 unsigned int h = 0;
708 while (len--)
709 h += (h << 3) + *buf++;
710 return h;
713 /* ----------------------------- API implementation ------------------------- */
715 /* reset a hashtable already initialized */
716 static void JimResetHashTable(Jim_HashTable *ht)
718 ht->table = NULL;
719 ht->size = 0;
720 ht->sizemask = 0;
721 ht->used = 0;
722 ht->collisions = 0;
723 #ifdef JIM_RANDOMISE_HASH
724 /* This is initialised to a random value to avoid a hash collision attack.
725 * See: n.runs-SA-2011.004
727 ht->uniq = (rand() ^ time(NULL) ^ clock());
728 #else
729 ht->uniq = 0;
730 #endif
733 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
735 iter->ht = ht;
736 iter->index = -1;
737 iter->entry = NULL;
738 iter->nextEntry = NULL;
741 /* Initialize the hash table */
742 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
744 JimResetHashTable(ht);
745 ht->type = type;
746 ht->privdata = privDataPtr;
747 return JIM_OK;
750 /* Resize the table to the minimal size that contains all the elements,
751 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
752 void Jim_ResizeHashTable(Jim_HashTable *ht)
754 int minimal = ht->used;
756 if (minimal < JIM_HT_INITIAL_SIZE)
757 minimal = JIM_HT_INITIAL_SIZE;
758 Jim_ExpandHashTable(ht, minimal);
761 /* Expand or create the hashtable */
762 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
764 Jim_HashTable n; /* the new hashtable */
765 unsigned int realsize = JimHashTableNextPower(size), i;
767 /* the size is invalid if it is smaller than the number of
768 * elements already inside the hashtable */
769 if (size <= ht->used)
770 return;
772 Jim_InitHashTable(&n, ht->type, ht->privdata);
773 n.size = realsize;
774 n.sizemask = realsize - 1;
775 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
776 /* Keep the same 'uniq' as the original */
777 n.uniq = ht->uniq;
779 /* Initialize all the pointers to NULL */
780 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
782 /* Copy all the elements from the old to the new table:
783 * note that if the old hash table is empty ht->used is zero,
784 * so Jim_ExpandHashTable just creates an empty hash table. */
785 n.used = ht->used;
786 for (i = 0; ht->used > 0; i++) {
787 Jim_HashEntry *he, *nextHe;
789 if (ht->table[i] == NULL)
790 continue;
792 /* For each hash entry on this slot... */
793 he = ht->table[i];
794 while (he) {
795 unsigned int h;
797 nextHe = he->next;
798 /* Get the new element index */
799 h = Jim_HashKey(ht, he->key) & n.sizemask;
800 he->next = n.table[h];
801 n.table[h] = he;
802 ht->used--;
803 /* Pass to the next element */
804 he = nextHe;
807 assert(ht->used == 0);
808 Jim_Free(ht->table);
810 /* Remap the new hashtable in the old */
811 *ht = n;
814 /* Add an element to the target hash table */
815 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
817 Jim_HashEntry *entry;
819 /* Get the index of the new element, or -1 if
820 * the element already exists. */
821 entry = JimInsertHashEntry(ht, key, 0);
822 if (entry == NULL)
823 return JIM_ERR;
825 /* Set the hash entry fields. */
826 Jim_SetHashKey(ht, entry, key);
827 Jim_SetHashVal(ht, entry, val);
828 return JIM_OK;
831 /* Add an element, discarding the old if the key already exists */
832 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
834 int existed;
835 Jim_HashEntry *entry;
837 /* Get the index of the new element, or -1 if
838 * the element already exists. */
839 entry = JimInsertHashEntry(ht, key, 1);
840 if (entry->key) {
841 /* It already exists, so only replace the value.
842 * Note if both a destructor and a duplicate function exist,
843 * need to dup before destroy. perhaps they are the same
844 * reference counted object
846 if (ht->type->valDestructor && ht->type->valDup) {
847 void *newval = ht->type->valDup(ht->privdata, val);
848 ht->type->valDestructor(ht->privdata, entry->u.val);
849 entry->u.val = newval;
851 else {
852 Jim_FreeEntryVal(ht, entry);
853 Jim_SetHashVal(ht, entry, val);
855 existed = 1;
857 else {
858 /* Doesn't exist, so set the key */
859 Jim_SetHashKey(ht, entry, key);
860 Jim_SetHashVal(ht, entry, val);
861 existed = 0;
864 return existed;
867 /* Search and remove an element */
868 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
870 unsigned int h;
871 Jim_HashEntry *he, *prevHe;
873 if (ht->used == 0)
874 return JIM_ERR;
875 h = Jim_HashKey(ht, key) & ht->sizemask;
876 he = ht->table[h];
878 prevHe = NULL;
879 while (he) {
880 if (Jim_CompareHashKeys(ht, key, he->key)) {
881 /* Unlink the element from the list */
882 if (prevHe)
883 prevHe->next = he->next;
884 else
885 ht->table[h] = he->next;
886 Jim_FreeEntryKey(ht, he);
887 Jim_FreeEntryVal(ht, he);
888 Jim_Free(he);
889 ht->used--;
890 return JIM_OK;
892 prevHe = he;
893 he = he->next;
895 return JIM_ERR; /* not found */
898 /* Destroy an entire hash table and leave it ready for reuse */
899 int Jim_FreeHashTable(Jim_HashTable *ht)
901 unsigned int i;
903 /* Free all the elements */
904 for (i = 0; ht->used > 0; i++) {
905 Jim_HashEntry *he, *nextHe;
907 if ((he = ht->table[i]) == NULL)
908 continue;
909 while (he) {
910 nextHe = he->next;
911 Jim_FreeEntryKey(ht, he);
912 Jim_FreeEntryVal(ht, he);
913 Jim_Free(he);
914 ht->used--;
915 he = nextHe;
918 /* Free the table and the allocated cache structure */
919 Jim_Free(ht->table);
920 /* Re-initialize the table */
921 JimResetHashTable(ht);
922 return JIM_OK; /* never fails */
925 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
927 Jim_HashEntry *he;
928 unsigned int h;
930 if (ht->used == 0)
931 return NULL;
932 h = Jim_HashKey(ht, key) & ht->sizemask;
933 he = ht->table[h];
934 while (he) {
935 if (Jim_CompareHashKeys(ht, key, he->key))
936 return he;
937 he = he->next;
939 return NULL;
942 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
944 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
945 JimInitHashTableIterator(ht, iter);
946 return iter;
949 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
951 while (1) {
952 if (iter->entry == NULL) {
953 iter->index++;
954 if (iter->index >= (signed)iter->ht->size)
955 break;
956 iter->entry = iter->ht->table[iter->index];
958 else {
959 iter->entry = iter->nextEntry;
961 if (iter->entry) {
962 /* We need to save the 'next' here, the iterator user
963 * may delete the entry we are returning. */
964 iter->nextEntry = iter->entry->next;
965 return iter->entry;
968 return NULL;
971 /* ------------------------- private functions ------------------------------ */
973 /* Expand the hash table if needed */
974 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
976 /* If the hash table is empty expand it to the intial size,
977 * if the table is "full" dobule its size. */
978 if (ht->size == 0)
979 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
980 if (ht->size == ht->used)
981 Jim_ExpandHashTable(ht, ht->size * 2);
984 /* Our hash table capability is a power of two */
985 static unsigned int JimHashTableNextPower(unsigned int size)
987 unsigned int i = JIM_HT_INITIAL_SIZE;
989 if (size >= 2147483648U)
990 return 2147483648U;
991 while (1) {
992 if (i >= size)
993 return i;
994 i *= 2;
998 /* Returns the index of a free slot that can be populated with
999 * a hash entry for the given 'key'.
1000 * If the key already exists, -1 is returned. */
1001 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1003 unsigned int h;
1004 Jim_HashEntry *he;
1006 /* Expand the hashtable if needed */
1007 JimExpandHashTableIfNeeded(ht);
1009 /* Compute the key hash value */
1010 h = Jim_HashKey(ht, key) & ht->sizemask;
1011 /* Search if this slot does not already contain the given key */
1012 he = ht->table[h];
1013 while (he) {
1014 if (Jim_CompareHashKeys(ht, key, he->key))
1015 return replace ? he : NULL;
1016 he = he->next;
1019 /* Allocates the memory and stores key */
1020 he = Jim_Alloc(sizeof(*he));
1021 he->next = ht->table[h];
1022 ht->table[h] = he;
1023 ht->used++;
1024 he->key = NULL;
1026 return he;
1029 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1031 static unsigned int JimStringCopyHTHashFunction(const void *key)
1033 return Jim_GenHashFunction(key, strlen(key));
1036 static void *JimStringCopyHTDup(void *privdata, const void *key)
1038 return Jim_StrDup(key);
1041 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1043 return strcmp(key1, key2) == 0;
1046 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1048 Jim_Free(key);
1051 static const Jim_HashTableType JimPackageHashTableType = {
1052 JimStringCopyHTHashFunction, /* hash function */
1053 JimStringCopyHTDup, /* key dup */
1054 NULL, /* val dup */
1055 JimStringCopyHTKeyCompare, /* key compare */
1056 JimStringCopyHTKeyDestructor, /* key destructor */
1057 NULL /* val destructor */
1060 typedef struct AssocDataValue
1062 Jim_InterpDeleteProc *delProc;
1063 void *data;
1064 } AssocDataValue;
1066 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1068 AssocDataValue *assocPtr = (AssocDataValue *) data;
1070 if (assocPtr->delProc != NULL)
1071 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1072 Jim_Free(data);
1075 static const Jim_HashTableType JimAssocDataHashTableType = {
1076 JimStringCopyHTHashFunction, /* hash function */
1077 JimStringCopyHTDup, /* key dup */
1078 NULL, /* val dup */
1079 JimStringCopyHTKeyCompare, /* key compare */
1080 JimStringCopyHTKeyDestructor, /* key destructor */
1081 JimAssocDataHashTableValueDestructor /* val destructor */
1084 /* -----------------------------------------------------------------------------
1085 * Stack - This is a simple generic stack implementation. It is used for
1086 * example in the 'expr' expression compiler.
1087 * ---------------------------------------------------------------------------*/
1088 void Jim_InitStack(Jim_Stack *stack)
1090 stack->len = 0;
1091 stack->maxlen = 0;
1092 stack->vector = NULL;
1095 void Jim_FreeStack(Jim_Stack *stack)
1097 Jim_Free(stack->vector);
1100 int Jim_StackLen(Jim_Stack *stack)
1102 return stack->len;
1105 void Jim_StackPush(Jim_Stack *stack, void *element)
1107 int neededLen = stack->len + 1;
1109 if (neededLen > stack->maxlen) {
1110 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1111 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1113 stack->vector[stack->len] = element;
1114 stack->len++;
1117 void *Jim_StackPop(Jim_Stack *stack)
1119 if (stack->len == 0)
1120 return NULL;
1121 stack->len--;
1122 return stack->vector[stack->len];
1125 void *Jim_StackPeek(Jim_Stack *stack)
1127 if (stack->len == 0)
1128 return NULL;
1129 return stack->vector[stack->len - 1];
1132 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1134 int i;
1136 for (i = 0; i < stack->len; i++)
1137 freeFunc(stack->vector[i]);
1140 /* -----------------------------------------------------------------------------
1141 * Tcl Parser
1142 * ---------------------------------------------------------------------------*/
1144 /* Token types */
1145 #define JIM_TT_NONE 0 /* No token returned */
1146 #define JIM_TT_STR 1 /* simple string */
1147 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1148 #define JIM_TT_VAR 3 /* var substitution */
1149 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1150 #define JIM_TT_CMD 5 /* command substitution */
1151 /* Note: Keep these three together for TOKEN_IS_SEP() */
1152 #define JIM_TT_SEP 6 /* word separator (white space) */
1153 #define JIM_TT_EOL 7 /* line separator */
1154 #define JIM_TT_EOF 8 /* end of script */
1156 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1157 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1159 /* Additional token types needed for expressions */
1160 #define JIM_TT_SUBEXPR_START 11
1161 #define JIM_TT_SUBEXPR_END 12
1162 #define JIM_TT_SUBEXPR_COMMA 13
1163 #define JIM_TT_EXPR_INT 14
1164 #define JIM_TT_EXPR_DOUBLE 15
1165 #define JIM_TT_EXPR_BOOLEAN 16
1167 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1169 /* Operator token types start here */
1170 #define JIM_TT_EXPR_OP 20
1172 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1173 /* Can this token start an expression? */
1174 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1175 /* Is this token an expression operator? */
1176 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1179 * Results of missing quotes, braces, etc. from parsing.
1181 struct JimParseMissing {
1182 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1183 int line; /* Line number starting the missing token */
1186 /* Parser context structure. The same context is used both to parse
1187 * Tcl scripts and lists. */
1188 struct JimParserCtx
1190 const char *p; /* Pointer to the point of the program we are parsing */
1191 int len; /* Remaining length */
1192 int linenr; /* Current line number */
1193 const char *tstart;
1194 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1195 int tline; /* Line number of the returned token */
1196 int tt; /* Token type */
1197 int eof; /* Non zero if EOF condition is true. */
1198 int inquote; /* Parsing a quoted string */
1199 int comment; /* Non zero if the next chars may be a comment. */
1200 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1203 static int JimParseScript(struct JimParserCtx *pc);
1204 static int JimParseSep(struct JimParserCtx *pc);
1205 static int JimParseEol(struct JimParserCtx *pc);
1206 static int JimParseCmd(struct JimParserCtx *pc);
1207 static int JimParseQuote(struct JimParserCtx *pc);
1208 static int JimParseVar(struct JimParserCtx *pc);
1209 static int JimParseBrace(struct JimParserCtx *pc);
1210 static int JimParseStr(struct JimParserCtx *pc);
1211 static int JimParseComment(struct JimParserCtx *pc);
1212 static void JimParseSubCmd(struct JimParserCtx *pc);
1213 static int JimParseSubQuote(struct JimParserCtx *pc);
1214 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1216 /* Initialize a parser context.
1217 * 'prg' is a pointer to the program text, linenr is the line
1218 * number of the first line contained in the program. */
1219 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1221 pc->p = prg;
1222 pc->len = len;
1223 pc->tstart = NULL;
1224 pc->tend = NULL;
1225 pc->tline = 0;
1226 pc->tt = JIM_TT_NONE;
1227 pc->eof = 0;
1228 pc->inquote = 0;
1229 pc->linenr = linenr;
1230 pc->comment = 1;
1231 pc->missing.ch = ' ';
1232 pc->missing.line = linenr;
1235 static int JimParseScript(struct JimParserCtx *pc)
1237 while (1) { /* the while is used to reiterate with continue if needed */
1238 if (!pc->len) {
1239 pc->tstart = pc->p;
1240 pc->tend = pc->p - 1;
1241 pc->tline = pc->linenr;
1242 pc->tt = JIM_TT_EOL;
1243 pc->eof = 1;
1244 return JIM_OK;
1246 switch (*(pc->p)) {
1247 case '\\':
1248 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1249 return JimParseSep(pc);
1251 pc->comment = 0;
1252 return JimParseStr(pc);
1253 case ' ':
1254 case '\t':
1255 case '\r':
1256 case '\f':
1257 if (!pc->inquote)
1258 return JimParseSep(pc);
1259 pc->comment = 0;
1260 return JimParseStr(pc);
1261 case '\n':
1262 case ';':
1263 pc->comment = 1;
1264 if (!pc->inquote)
1265 return JimParseEol(pc);
1266 return JimParseStr(pc);
1267 case '[':
1268 pc->comment = 0;
1269 return JimParseCmd(pc);
1270 case '$':
1271 pc->comment = 0;
1272 if (JimParseVar(pc) == JIM_ERR) {
1273 /* An orphan $. Create as a separate token */
1274 pc->tstart = pc->tend = pc->p++;
1275 pc->len--;
1276 pc->tt = JIM_TT_ESC;
1278 return JIM_OK;
1279 case '#':
1280 if (pc->comment) {
1281 JimParseComment(pc);
1282 continue;
1284 return JimParseStr(pc);
1285 default:
1286 pc->comment = 0;
1287 return JimParseStr(pc);
1289 return JIM_OK;
1293 static int JimParseSep(struct JimParserCtx *pc)
1295 pc->tstart = pc->p;
1296 pc->tline = pc->linenr;
1297 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1298 if (*pc->p == '\n') {
1299 break;
1301 if (*pc->p == '\\') {
1302 pc->p++;
1303 pc->len--;
1304 pc->linenr++;
1306 pc->p++;
1307 pc->len--;
1309 pc->tend = pc->p - 1;
1310 pc->tt = JIM_TT_SEP;
1311 return JIM_OK;
1314 static int JimParseEol(struct JimParserCtx *pc)
1316 pc->tstart = pc->p;
1317 pc->tline = pc->linenr;
1318 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1319 if (*pc->p == '\n')
1320 pc->linenr++;
1321 pc->p++;
1322 pc->len--;
1324 pc->tend = pc->p - 1;
1325 pc->tt = JIM_TT_EOL;
1326 return JIM_OK;
1330 ** Here are the rules for parsing:
1331 ** {braced expression}
1332 ** - Count open and closing braces
1333 ** - Backslash escapes meaning of braces
1335 ** "quoted expression"
1336 ** - First double quote at start of word terminates the expression
1337 ** - Backslash escapes quote and bracket
1338 ** - [commands brackets] are counted/nested
1339 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1341 ** [command expression]
1342 ** - Count open and closing brackets
1343 ** - Backslash escapes quote, bracket and brace
1344 ** - [commands brackets] are counted/nested
1345 ** - "quoted expressions" are parsed according to quoting rules
1346 ** - {braced expressions} are parsed according to brace rules
1348 ** For everything, backslash escapes the next char, newline increments current line
1352 * Parses a braced expression starting at pc->p.
1354 * Positions the parser at the end of the braced expression,
1355 * sets pc->tend and possibly pc->missing.
1357 static void JimParseSubBrace(struct JimParserCtx *pc)
1359 int level = 1;
1361 /* Skip the brace */
1362 pc->p++;
1363 pc->len--;
1364 while (pc->len) {
1365 switch (*pc->p) {
1366 case '\\':
1367 if (pc->len > 1) {
1368 if (*++pc->p == '\n') {
1369 pc->linenr++;
1371 pc->len--;
1373 break;
1375 case '{':
1376 level++;
1377 break;
1379 case '}':
1380 if (--level == 0) {
1381 pc->tend = pc->p - 1;
1382 pc->p++;
1383 pc->len--;
1384 return;
1386 break;
1388 case '\n':
1389 pc->linenr++;
1390 break;
1392 pc->p++;
1393 pc->len--;
1395 pc->missing.ch = '{';
1396 pc->missing.line = pc->tline;
1397 pc->tend = pc->p - 1;
1401 * Parses a quoted expression starting at pc->p.
1403 * Positions the parser at the end of the quoted expression,
1404 * sets pc->tend and possibly pc->missing.
1406 * Returns the type of the token of the string,
1407 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1408 * or JIM_TT_STR.
1410 static int JimParseSubQuote(struct JimParserCtx *pc)
1412 int tt = JIM_TT_STR;
1413 int line = pc->tline;
1415 /* Skip the quote */
1416 pc->p++;
1417 pc->len--;
1418 while (pc->len) {
1419 switch (*pc->p) {
1420 case '\\':
1421 if (pc->len > 1) {
1422 if (*++pc->p == '\n') {
1423 pc->linenr++;
1425 pc->len--;
1426 tt = JIM_TT_ESC;
1428 break;
1430 case '"':
1431 pc->tend = pc->p - 1;
1432 pc->p++;
1433 pc->len--;
1434 return tt;
1436 case '[':
1437 JimParseSubCmd(pc);
1438 tt = JIM_TT_ESC;
1439 continue;
1441 case '\n':
1442 pc->linenr++;
1443 break;
1445 case '$':
1446 tt = JIM_TT_ESC;
1447 break;
1449 pc->p++;
1450 pc->len--;
1452 pc->missing.ch = '"';
1453 pc->missing.line = line;
1454 pc->tend = pc->p - 1;
1455 return tt;
1459 * Parses a [command] expression starting at pc->p.
1461 * Positions the parser at the end of the command expression,
1462 * sets pc->tend and possibly pc->missing.
1464 static void JimParseSubCmd(struct JimParserCtx *pc)
1466 int level = 1;
1467 int startofword = 1;
1468 int line = pc->tline;
1470 /* Skip the bracket */
1471 pc->p++;
1472 pc->len--;
1473 while (pc->len) {
1474 switch (*pc->p) {
1475 case '\\':
1476 if (pc->len > 1) {
1477 if (*++pc->p == '\n') {
1478 pc->linenr++;
1480 pc->len--;
1482 break;
1484 case '[':
1485 level++;
1486 break;
1488 case ']':
1489 if (--level == 0) {
1490 pc->tend = pc->p - 1;
1491 pc->p++;
1492 pc->len--;
1493 return;
1495 break;
1497 case '"':
1498 if (startofword) {
1499 JimParseSubQuote(pc);
1500 continue;
1502 break;
1504 case '{':
1505 JimParseSubBrace(pc);
1506 startofword = 0;
1507 continue;
1509 case '\n':
1510 pc->linenr++;
1511 break;
1513 startofword = isspace(UCHAR(*pc->p));
1514 pc->p++;
1515 pc->len--;
1517 pc->missing.ch = '[';
1518 pc->missing.line = line;
1519 pc->tend = pc->p - 1;
1522 static int JimParseBrace(struct JimParserCtx *pc)
1524 pc->tstart = pc->p + 1;
1525 pc->tline = pc->linenr;
1526 pc->tt = JIM_TT_STR;
1527 JimParseSubBrace(pc);
1528 return JIM_OK;
1531 static int JimParseCmd(struct JimParserCtx *pc)
1533 pc->tstart = pc->p + 1;
1534 pc->tline = pc->linenr;
1535 pc->tt = JIM_TT_CMD;
1536 JimParseSubCmd(pc);
1537 return JIM_OK;
1540 static int JimParseQuote(struct JimParserCtx *pc)
1542 pc->tstart = pc->p + 1;
1543 pc->tline = pc->linenr;
1544 pc->tt = JimParseSubQuote(pc);
1545 return JIM_OK;
1548 static int JimParseVar(struct JimParserCtx *pc)
1550 /* skip the $ */
1551 pc->p++;
1552 pc->len--;
1554 #ifdef EXPRSUGAR_BRACKET
1555 if (*pc->p == '[') {
1556 /* Parse $[...] expr shorthand syntax */
1557 JimParseCmd(pc);
1558 pc->tt = JIM_TT_EXPRSUGAR;
1559 return JIM_OK;
1561 #endif
1563 pc->tstart = pc->p;
1564 pc->tt = JIM_TT_VAR;
1565 pc->tline = pc->linenr;
1567 if (*pc->p == '{') {
1568 pc->tstart = ++pc->p;
1569 pc->len--;
1571 while (pc->len && *pc->p != '}') {
1572 if (*pc->p == '\n') {
1573 pc->linenr++;
1575 pc->p++;
1576 pc->len--;
1578 pc->tend = pc->p - 1;
1579 if (pc->len) {
1580 pc->p++;
1581 pc->len--;
1584 else {
1585 while (1) {
1586 /* Skip double colon, but not single colon! */
1587 if (pc->p[0] == ':' && pc->p[1] == ':') {
1588 while (*pc->p == ':') {
1589 pc->p++;
1590 pc->len--;
1592 continue;
1594 /* Note that any char >= 0x80 must be part of a utf-8 char.
1595 * We consider all unicode points outside of ASCII as letters
1597 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1598 pc->p++;
1599 pc->len--;
1600 continue;
1602 break;
1604 /* Parse [dict get] syntax sugar. */
1605 if (*pc->p == '(') {
1606 int count = 1;
1607 const char *paren = NULL;
1609 pc->tt = JIM_TT_DICTSUGAR;
1611 while (count && pc->len) {
1612 pc->p++;
1613 pc->len--;
1614 if (*pc->p == '\\' && pc->len >= 1) {
1615 pc->p++;
1616 pc->len--;
1618 else if (*pc->p == '(') {
1619 count++;
1621 else if (*pc->p == ')') {
1622 paren = pc->p;
1623 count--;
1626 if (count == 0) {
1627 pc->p++;
1628 pc->len--;
1630 else if (paren) {
1631 /* Did not find a matching paren. Back up */
1632 paren++;
1633 pc->len += (pc->p - paren);
1634 pc->p = paren;
1636 #ifndef EXPRSUGAR_BRACKET
1637 if (*pc->tstart == '(') {
1638 pc->tt = JIM_TT_EXPRSUGAR;
1640 #endif
1642 pc->tend = pc->p - 1;
1644 /* Check if we parsed just the '$' character.
1645 * That's not a variable so an error is returned
1646 * to tell the state machine to consider this '$' just
1647 * a string. */
1648 if (pc->tstart == pc->p) {
1649 pc->p--;
1650 pc->len++;
1651 return JIM_ERR;
1653 return JIM_OK;
1656 static int JimParseStr(struct JimParserCtx *pc)
1658 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1659 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1660 /* Starting a new word */
1661 if (*pc->p == '{') {
1662 return JimParseBrace(pc);
1664 if (*pc->p == '"') {
1665 pc->inquote = 1;
1666 pc->p++;
1667 pc->len--;
1668 /* In case the end quote is missing */
1669 pc->missing.line = pc->tline;
1672 pc->tstart = pc->p;
1673 pc->tline = pc->linenr;
1674 while (1) {
1675 if (pc->len == 0) {
1676 if (pc->inquote) {
1677 pc->missing.ch = '"';
1679 pc->tend = pc->p - 1;
1680 pc->tt = JIM_TT_ESC;
1681 return JIM_OK;
1683 switch (*pc->p) {
1684 case '\\':
1685 if (!pc->inquote && *(pc->p + 1) == '\n') {
1686 pc->tend = pc->p - 1;
1687 pc->tt = JIM_TT_ESC;
1688 return JIM_OK;
1690 if (pc->len >= 2) {
1691 if (*(pc->p + 1) == '\n') {
1692 pc->linenr++;
1694 pc->p++;
1695 pc->len--;
1697 else if (pc->len == 1) {
1698 /* End of script with trailing backslash */
1699 pc->missing.ch = '\\';
1701 break;
1702 case '(':
1703 /* If the following token is not '$' just keep going */
1704 if (pc->len > 1 && pc->p[1] != '$') {
1705 break;
1707 /* fall through */
1708 case ')':
1709 /* Only need a separate ')' token if the previous was a var */
1710 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1711 if (pc->p == pc->tstart) {
1712 /* At the start of the token, so just return this char */
1713 pc->p++;
1714 pc->len--;
1716 pc->tend = pc->p - 1;
1717 pc->tt = JIM_TT_ESC;
1718 return JIM_OK;
1720 break;
1722 case '$':
1723 case '[':
1724 pc->tend = pc->p - 1;
1725 pc->tt = JIM_TT_ESC;
1726 return JIM_OK;
1727 case ' ':
1728 case '\t':
1729 case '\n':
1730 case '\r':
1731 case '\f':
1732 case ';':
1733 if (!pc->inquote) {
1734 pc->tend = pc->p - 1;
1735 pc->tt = JIM_TT_ESC;
1736 return JIM_OK;
1738 else if (*pc->p == '\n') {
1739 pc->linenr++;
1741 break;
1742 case '"':
1743 if (pc->inquote) {
1744 pc->tend = pc->p - 1;
1745 pc->tt = JIM_TT_ESC;
1746 pc->p++;
1747 pc->len--;
1748 pc->inquote = 0;
1749 return JIM_OK;
1751 break;
1753 pc->p++;
1754 pc->len--;
1756 return JIM_OK; /* unreached */
1759 static int JimParseComment(struct JimParserCtx *pc)
1761 while (*pc->p) {
1762 if (*pc->p == '\\') {
1763 pc->p++;
1764 pc->len--;
1765 if (pc->len == 0) {
1766 pc->missing.ch = '\\';
1767 return JIM_OK;
1769 if (*pc->p == '\n') {
1770 pc->linenr++;
1773 else if (*pc->p == '\n') {
1774 pc->p++;
1775 pc->len--;
1776 pc->linenr++;
1777 break;
1779 pc->p++;
1780 pc->len--;
1782 return JIM_OK;
1785 /* xdigitval and odigitval are helper functions for JimEscape() */
1786 static int xdigitval(int c)
1788 if (c >= '0' && c <= '9')
1789 return c - '0';
1790 if (c >= 'a' && c <= 'f')
1791 return c - 'a' + 10;
1792 if (c >= 'A' && c <= 'F')
1793 return c - 'A' + 10;
1794 return -1;
1797 static int odigitval(int c)
1799 if (c >= '0' && c <= '7')
1800 return c - '0';
1801 return -1;
1804 /* Perform Tcl escape substitution of 's', storing the result
1805 * string into 'dest'. The escaped string is guaranteed to
1806 * be the same length or shorted than the source string.
1807 * Slen is the length of the string at 's'.
1809 * The function returns the length of the resulting string. */
1810 static int JimEscape(char *dest, const char *s, int slen)
1812 char *p = dest;
1813 int i, len;
1815 for (i = 0; i < slen; i++) {
1816 switch (s[i]) {
1817 case '\\':
1818 switch (s[i + 1]) {
1819 case 'a':
1820 *p++ = 0x7;
1821 i++;
1822 break;
1823 case 'b':
1824 *p++ = 0x8;
1825 i++;
1826 break;
1827 case 'f':
1828 *p++ = 0xc;
1829 i++;
1830 break;
1831 case 'n':
1832 *p++ = 0xa;
1833 i++;
1834 break;
1835 case 'r':
1836 *p++ = 0xd;
1837 i++;
1838 break;
1839 case 't':
1840 *p++ = 0x9;
1841 i++;
1842 break;
1843 case 'u':
1844 case 'U':
1845 case 'x':
1846 /* A unicode or hex sequence.
1847 * \x Expect 1-2 hex chars and convert to hex.
1848 * \u Expect 1-4 hex chars and convert to utf-8.
1849 * \U Expect 1-8 hex chars and convert to utf-8.
1850 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1851 * An invalid sequence means simply the escaped char.
1854 unsigned val = 0;
1855 int k;
1856 int maxchars = 2;
1858 i++;
1860 if (s[i] == 'U') {
1861 maxchars = 8;
1863 else if (s[i] == 'u') {
1864 if (s[i + 1] == '{') {
1865 maxchars = 6;
1866 i++;
1868 else {
1869 maxchars = 4;
1873 for (k = 0; k < maxchars; k++) {
1874 int c = xdigitval(s[i + k + 1]);
1875 if (c == -1) {
1876 break;
1878 val = (val << 4) | c;
1880 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1881 if (s[i] == '{') {
1882 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1883 /* Back up */
1884 i--;
1885 k = 0;
1887 else {
1888 /* Skip the closing brace */
1889 k++;
1892 if (k) {
1893 /* Got a valid sequence, so convert */
1894 if (s[i] == 'x') {
1895 *p++ = val;
1897 else {
1898 p += utf8_fromunicode(p, val);
1900 i += k;
1901 break;
1903 /* Not a valid codepoint, just an escaped char */
1904 *p++ = s[i];
1906 break;
1907 case 'v':
1908 *p++ = 0xb;
1909 i++;
1910 break;
1911 case '\0':
1912 *p++ = '\\';
1913 i++;
1914 break;
1915 case '\n':
1916 /* Replace all spaces and tabs after backslash newline with a single space*/
1917 *p++ = ' ';
1918 do {
1919 i++;
1920 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1921 break;
1922 case '0':
1923 case '1':
1924 case '2':
1925 case '3':
1926 case '4':
1927 case '5':
1928 case '6':
1929 case '7':
1930 /* octal escape */
1932 int val = 0;
1933 int c = odigitval(s[i + 1]);
1935 val = c;
1936 c = odigitval(s[i + 2]);
1937 if (c == -1) {
1938 *p++ = val;
1939 i++;
1940 break;
1942 val = (val * 8) + c;
1943 c = odigitval(s[i + 3]);
1944 if (c == -1) {
1945 *p++ = val;
1946 i += 2;
1947 break;
1949 val = (val * 8) + c;
1950 *p++ = val;
1951 i += 3;
1953 break;
1954 default:
1955 *p++ = s[i + 1];
1956 i++;
1957 break;
1959 break;
1960 default:
1961 *p++ = s[i];
1962 break;
1965 len = p - dest;
1966 *p = '\0';
1967 return len;
1970 /* Returns a dynamically allocated copy of the current token in the
1971 * parser context. The function performs conversion of escapes if
1972 * the token is of type JIM_TT_ESC.
1974 * Note that after the conversion, tokens that are grouped with
1975 * braces in the source code, are always recognizable from the
1976 * identical string obtained in a different way from the type.
1978 * For example the string:
1980 * {*}$a
1982 * will return as first token "*", of type JIM_TT_STR
1984 * While the string:
1986 * *$a
1988 * will return as first token "*", of type JIM_TT_ESC
1990 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1992 const char *start, *end;
1993 char *token;
1994 int len;
1996 start = pc->tstart;
1997 end = pc->tend;
1998 if (start > end) {
1999 len = 0;
2000 token = Jim_Alloc(1);
2001 token[0] = '\0';
2003 else {
2004 len = (end - start) + 1;
2005 token = Jim_Alloc(len + 1);
2006 if (pc->tt != JIM_TT_ESC) {
2007 /* No escape conversion needed? Just copy it. */
2008 memcpy(token, start, len);
2009 token[len] = '\0';
2011 else {
2012 /* Else convert the escape chars. */
2013 len = JimEscape(token, start, len);
2017 return Jim_NewStringObjNoAlloc(interp, token, len);
2020 /* -----------------------------------------------------------------------------
2021 * Tcl Lists parsing
2022 * ---------------------------------------------------------------------------*/
2023 static int JimParseListSep(struct JimParserCtx *pc);
2024 static int JimParseListStr(struct JimParserCtx *pc);
2025 static int JimParseListQuote(struct JimParserCtx *pc);
2027 static int JimParseList(struct JimParserCtx *pc)
2029 if (isspace(UCHAR(*pc->p))) {
2030 return JimParseListSep(pc);
2032 switch (*pc->p) {
2033 case '"':
2034 return JimParseListQuote(pc);
2036 case '{':
2037 return JimParseBrace(pc);
2039 default:
2040 if (pc->len) {
2041 return JimParseListStr(pc);
2043 break;
2046 pc->tstart = pc->tend = pc->p;
2047 pc->tline = pc->linenr;
2048 pc->tt = JIM_TT_EOL;
2049 pc->eof = 1;
2050 return JIM_OK;
2053 static int JimParseListSep(struct JimParserCtx *pc)
2055 pc->tstart = pc->p;
2056 pc->tline = pc->linenr;
2057 while (isspace(UCHAR(*pc->p))) {
2058 if (*pc->p == '\n') {
2059 pc->linenr++;
2061 pc->p++;
2062 pc->len--;
2064 pc->tend = pc->p - 1;
2065 pc->tt = JIM_TT_SEP;
2066 return JIM_OK;
2069 static int JimParseListQuote(struct JimParserCtx *pc)
2071 pc->p++;
2072 pc->len--;
2074 pc->tstart = pc->p;
2075 pc->tline = pc->linenr;
2076 pc->tt = JIM_TT_STR;
2078 while (pc->len) {
2079 switch (*pc->p) {
2080 case '\\':
2081 pc->tt = JIM_TT_ESC;
2082 if (--pc->len == 0) {
2083 /* Trailing backslash */
2084 pc->tend = pc->p;
2085 return JIM_OK;
2087 pc->p++;
2088 break;
2089 case '\n':
2090 pc->linenr++;
2091 break;
2092 case '"':
2093 pc->tend = pc->p - 1;
2094 pc->p++;
2095 pc->len--;
2096 return JIM_OK;
2098 pc->p++;
2099 pc->len--;
2102 pc->tend = pc->p - 1;
2103 return JIM_OK;
2106 static int JimParseListStr(struct JimParserCtx *pc)
2108 pc->tstart = pc->p;
2109 pc->tline = pc->linenr;
2110 pc->tt = JIM_TT_STR;
2112 while (pc->len) {
2113 if (isspace(UCHAR(*pc->p))) {
2114 pc->tend = pc->p - 1;
2115 return JIM_OK;
2117 if (*pc->p == '\\') {
2118 if (--pc->len == 0) {
2119 /* Trailing backslash */
2120 pc->tend = pc->p;
2121 return JIM_OK;
2123 pc->tt = JIM_TT_ESC;
2124 pc->p++;
2126 pc->p++;
2127 pc->len--;
2129 pc->tend = pc->p - 1;
2130 return JIM_OK;
2133 /* -----------------------------------------------------------------------------
2134 * Jim_Obj related functions
2135 * ---------------------------------------------------------------------------*/
2137 /* Return a new initialized object. */
2138 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2140 Jim_Obj *objPtr;
2142 /* -- Check if there are objects in the free list -- */
2143 if (interp->freeList != NULL) {
2144 /* -- Unlink the object from the free list -- */
2145 objPtr = interp->freeList;
2146 interp->freeList = objPtr->nextObjPtr;
2148 else {
2149 /* -- No ready to use objects: allocate a new one -- */
2150 objPtr = Jim_Alloc(sizeof(*objPtr));
2153 /* Object is returned with refCount of 0. Every
2154 * kind of GC implemented should take care to don't try
2155 * to scan objects with refCount == 0. */
2156 objPtr->refCount = 0;
2157 /* All the other fields are left not initialized to save time.
2158 * The caller will probably want to set them to the right
2159 * value anyway. */
2161 /* -- Put the object into the live list -- */
2162 objPtr->prevObjPtr = NULL;
2163 objPtr->nextObjPtr = interp->liveList;
2164 if (interp->liveList)
2165 interp->liveList->prevObjPtr = objPtr;
2166 interp->liveList = objPtr;
2168 return objPtr;
2171 /* Free an object. Actually objects are never freed, but
2172 * just moved to the free objects list, where they will be
2173 * reused by Jim_NewObj(). */
2174 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2176 /* Check if the object was already freed, panic. */
2177 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2178 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2180 /* Free the internal representation */
2181 Jim_FreeIntRep(interp, objPtr);
2182 /* Free the string representation */
2183 if (objPtr->bytes != NULL) {
2184 if (objPtr->bytes != JimEmptyStringRep)
2185 Jim_Free(objPtr->bytes);
2187 /* Unlink the object from the live objects list */
2188 if (objPtr->prevObjPtr)
2189 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2190 if (objPtr->nextObjPtr)
2191 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2192 if (interp->liveList == objPtr)
2193 interp->liveList = objPtr->nextObjPtr;
2194 #ifdef JIM_DISABLE_OBJECT_POOL
2195 Jim_Free(objPtr);
2196 #else
2197 /* Link the object into the free objects list */
2198 objPtr->prevObjPtr = NULL;
2199 objPtr->nextObjPtr = interp->freeList;
2200 if (interp->freeList)
2201 interp->freeList->prevObjPtr = objPtr;
2202 interp->freeList = objPtr;
2203 objPtr->refCount = -1;
2204 #endif
2207 /* Invalidate the string representation of an object. */
2208 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2210 if (objPtr->bytes != NULL) {
2211 if (objPtr->bytes != JimEmptyStringRep)
2212 Jim_Free(objPtr->bytes);
2214 objPtr->bytes = NULL;
2217 /* Duplicate an object. The returned object has refcount = 0. */
2218 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2220 Jim_Obj *dupPtr;
2222 dupPtr = Jim_NewObj(interp);
2223 if (objPtr->bytes == NULL) {
2224 /* Object does not have a valid string representation. */
2225 dupPtr->bytes = NULL;
2227 else if (objPtr->length == 0) {
2228 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2229 dupPtr->bytes = JimEmptyStringRep;
2230 dupPtr->length = 0;
2231 dupPtr->typePtr = NULL;
2232 return dupPtr;
2234 else {
2235 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2236 dupPtr->length = objPtr->length;
2237 /* Copy the null byte too */
2238 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2241 /* By default, the new object has the same type as the old object */
2242 dupPtr->typePtr = objPtr->typePtr;
2243 if (objPtr->typePtr != NULL) {
2244 if (objPtr->typePtr->dupIntRepProc == NULL) {
2245 dupPtr->internalRep = objPtr->internalRep;
2247 else {
2248 /* The dup proc may set a different type, e.g. NULL */
2249 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2252 return dupPtr;
2255 /* Return the string representation for objPtr. If the object's
2256 * string representation is invalid, calls the updateStringProc method to create
2257 * a new one from the internal representation of the object.
2259 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2261 if (objPtr->bytes == NULL) {
2262 /* Invalid string repr. Generate it. */
2263 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2264 objPtr->typePtr->updateStringProc(objPtr);
2266 if (lenPtr)
2267 *lenPtr = objPtr->length;
2268 return objPtr->bytes;
2271 /* Just returns the length of the object's string rep */
2272 int Jim_Length(Jim_Obj *objPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2277 objPtr->typePtr->updateStringProc(objPtr);
2279 return objPtr->length;
2282 /* Just returns object's string rep */
2283 const char *Jim_String(Jim_Obj *objPtr)
2285 if (objPtr->bytes == NULL) {
2286 /* Invalid string repr. Generate it. */
2287 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2288 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2289 objPtr->typePtr->updateStringProc(objPtr);
2291 return objPtr->bytes;
2294 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2296 objPtr->bytes = Jim_StrDup(str);
2297 objPtr->length = strlen(str);
2300 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2301 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2303 static const Jim_ObjType dictSubstObjType = {
2304 "dict-substitution",
2305 FreeDictSubstInternalRep,
2306 DupDictSubstInternalRep,
2307 NULL,
2308 JIM_TYPE_NONE,
2311 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2313 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2316 static const Jim_ObjType interpolatedObjType = {
2317 "interpolated",
2318 FreeInterpolatedInternalRep,
2319 NULL,
2320 NULL,
2321 JIM_TYPE_NONE,
2324 /* -----------------------------------------------------------------------------
2325 * String Object
2326 * ---------------------------------------------------------------------------*/
2327 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2328 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2330 static const Jim_ObjType stringObjType = {
2331 "string",
2332 NULL,
2333 DupStringInternalRep,
2334 NULL,
2335 JIM_TYPE_REFERENCES,
2338 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2340 JIM_NOTUSED(interp);
2342 /* This is a bit subtle: the only caller of this function
2343 * should be Jim_DuplicateObj(), that will copy the
2344 * string representaion. After the copy, the duplicated
2345 * object will not have more room in the buffer than
2346 * srcPtr->length bytes. So we just set it to length. */
2347 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2348 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2351 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2353 if (objPtr->typePtr != &stringObjType) {
2354 /* Get a fresh string representation. */
2355 if (objPtr->bytes == NULL) {
2356 /* Invalid string repr. Generate it. */
2357 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2358 objPtr->typePtr->updateStringProc(objPtr);
2360 /* Free any other internal representation. */
2361 Jim_FreeIntRep(interp, objPtr);
2362 /* Set it as string, i.e. just set the maxLength field. */
2363 objPtr->typePtr = &stringObjType;
2364 objPtr->internalRep.strValue.maxLength = objPtr->length;
2365 /* Don't know the utf-8 length yet */
2366 objPtr->internalRep.strValue.charLength = -1;
2368 return JIM_OK;
2372 * Returns the length of the object string in chars, not bytes.
2374 * These may be different for a utf-8 string.
2376 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2378 #ifdef JIM_UTF8
2379 SetStringFromAny(interp, objPtr);
2381 if (objPtr->internalRep.strValue.charLength < 0) {
2382 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2384 return objPtr->internalRep.strValue.charLength;
2385 #else
2386 return Jim_Length(objPtr);
2387 #endif
2390 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2391 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2393 Jim_Obj *objPtr = Jim_NewObj(interp);
2395 /* Need to find out how many bytes the string requires */
2396 if (len == -1)
2397 len = strlen(s);
2398 /* Alloc/Set the string rep. */
2399 if (len == 0) {
2400 objPtr->bytes = JimEmptyStringRep;
2402 else {
2403 objPtr->bytes = Jim_Alloc(len + 1);
2404 memcpy(objPtr->bytes, s, len);
2405 objPtr->bytes[len] = '\0';
2407 objPtr->length = len;
2409 /* No typePtr field for the vanilla string object. */
2410 objPtr->typePtr = NULL;
2411 return objPtr;
2414 /* charlen is in characters -- see also Jim_NewStringObj() */
2415 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2417 #ifdef JIM_UTF8
2418 /* Need to find out how many bytes the string requires */
2419 int bytelen = utf8_index(s, charlen);
2421 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2423 /* Remember the utf8 length, so set the type */
2424 objPtr->typePtr = &stringObjType;
2425 objPtr->internalRep.strValue.maxLength = bytelen;
2426 objPtr->internalRep.strValue.charLength = charlen;
2428 return objPtr;
2429 #else
2430 return Jim_NewStringObj(interp, s, charlen);
2431 #endif
2434 /* This version does not try to duplicate the 's' pointer, but
2435 * use it directly. */
2436 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2438 Jim_Obj *objPtr = Jim_NewObj(interp);
2440 objPtr->bytes = s;
2441 objPtr->length = (len == -1) ? strlen(s) : len;
2442 objPtr->typePtr = NULL;
2443 return objPtr;
2446 /* Low-level string append. Use it only against unshared objects
2447 * of type "string". */
2448 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2450 int needlen;
2452 if (len == -1)
2453 len = strlen(str);
2454 needlen = objPtr->length + len;
2455 if (objPtr->internalRep.strValue.maxLength < needlen ||
2456 objPtr->internalRep.strValue.maxLength == 0) {
2457 needlen *= 2;
2458 /* Inefficient to malloc() for less than 8 bytes */
2459 if (needlen < 7) {
2460 needlen = 7;
2462 if (objPtr->bytes == JimEmptyStringRep) {
2463 objPtr->bytes = Jim_Alloc(needlen + 1);
2465 else {
2466 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2468 objPtr->internalRep.strValue.maxLength = needlen;
2470 memcpy(objPtr->bytes + objPtr->length, str, len);
2471 objPtr->bytes[objPtr->length + len] = '\0';
2473 if (objPtr->internalRep.strValue.charLength >= 0) {
2474 /* Update the utf-8 char length */
2475 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2477 objPtr->length += len;
2480 /* Higher level API to append strings to objects.
2481 * Object must not be unshared for each of these.
2483 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2485 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2486 SetStringFromAny(interp, objPtr);
2487 StringAppendString(objPtr, str, len);
2490 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2492 int len;
2493 const char *str = Jim_GetString(appendObjPtr, &len);
2494 Jim_AppendString(interp, objPtr, str, len);
2497 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2499 va_list ap;
2501 SetStringFromAny(interp, objPtr);
2502 va_start(ap, objPtr);
2503 while (1) {
2504 const char *s = va_arg(ap, const char *);
2506 if (s == NULL)
2507 break;
2508 Jim_AppendString(interp, objPtr, s, -1);
2510 va_end(ap);
2513 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2515 if (aObjPtr == bObjPtr) {
2516 return 1;
2518 else {
2519 int Alen, Blen;
2520 const char *sA = Jim_GetString(aObjPtr, &Alen);
2521 const char *sB = Jim_GetString(bObjPtr, &Blen);
2523 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2528 * Note. Does not support embedded nulls in either the pattern or the object.
2530 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2532 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2536 * Note: does not support embedded nulls for the nocase option.
2538 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2540 int l1, l2;
2541 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2542 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2544 if (nocase) {
2545 /* Do a character compare for nocase */
2546 return JimStringCompareLen(s1, s2, -1, nocase);
2548 return JimStringCompare(s1, l1, s2, l2);
2552 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2554 * Note: does not support embedded nulls
2556 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2558 const char *s1 = Jim_String(firstObjPtr);
2559 const char *s2 = Jim_String(secondObjPtr);
2561 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2564 /* Convert a range, as returned by Jim_GetRange(), into
2565 * an absolute index into an object of the specified length.
2566 * This function may return negative values, or values
2567 * greater than or equal to the length of the list if the index
2568 * is out of range. */
2569 static int JimRelToAbsIndex(int len, int idx)
2571 if (idx < 0)
2572 return len + idx;
2573 return idx;
2576 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2577 * into a form suitable for implementation of commands like [string range] and [lrange].
2579 * The resulting range is guaranteed to address valid elements of
2580 * the structure.
2582 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2584 int rangeLen;
2586 if (*firstPtr > *lastPtr) {
2587 rangeLen = 0;
2589 else {
2590 rangeLen = *lastPtr - *firstPtr + 1;
2591 if (rangeLen) {
2592 if (*firstPtr < 0) {
2593 rangeLen += *firstPtr;
2594 *firstPtr = 0;
2596 if (*lastPtr >= len) {
2597 rangeLen -= (*lastPtr - (len - 1));
2598 *lastPtr = len - 1;
2602 if (rangeLen < 0)
2603 rangeLen = 0;
2605 *rangeLenPtr = rangeLen;
2608 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2609 int len, int *first, int *last, int *range)
2611 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2612 return JIM_ERR;
2614 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2615 return JIM_ERR;
2617 *first = JimRelToAbsIndex(len, *first);
2618 *last = JimRelToAbsIndex(len, *last);
2619 JimRelToAbsRange(len, first, last, range);
2620 return JIM_OK;
2623 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2624 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2626 int first, last;
2627 const char *str;
2628 int rangeLen;
2629 int bytelen;
2631 str = Jim_GetString(strObjPtr, &bytelen);
2633 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2634 return NULL;
2637 if (first == 0 && rangeLen == bytelen) {
2638 return strObjPtr;
2640 return Jim_NewStringObj(interp, str + first, rangeLen);
2643 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2644 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2646 #ifdef JIM_UTF8
2647 int first, last;
2648 const char *str;
2649 int len, rangeLen;
2650 int bytelen;
2652 str = Jim_GetString(strObjPtr, &bytelen);
2653 len = Jim_Utf8Length(interp, strObjPtr);
2655 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2656 return NULL;
2659 if (first == 0 && rangeLen == len) {
2660 return strObjPtr;
2662 if (len == bytelen) {
2663 /* ASCII optimisation */
2664 return Jim_NewStringObj(interp, str + first, rangeLen);
2666 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2667 #else
2668 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2669 #endif
2672 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2673 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2675 int first, last;
2676 const char *str;
2677 int len, rangeLen;
2678 Jim_Obj *objPtr;
2680 len = Jim_Utf8Length(interp, strObjPtr);
2682 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2683 return NULL;
2686 if (last < first) {
2687 return strObjPtr;
2690 str = Jim_String(strObjPtr);
2692 /* Before part */
2693 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2695 /* Replacement */
2696 if (newStrObj) {
2697 Jim_AppendObj(interp, objPtr, newStrObj);
2700 /* After part */
2701 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2703 return objPtr;
2707 * Note: does not support embedded nulls.
2709 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2711 while (*str) {
2712 int c;
2713 str += utf8_tounicode(str, &c);
2714 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2716 *dest = 0;
2720 * Note: does not support embedded nulls.
2722 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2724 char *buf;
2725 int len;
2726 const char *str;
2728 SetStringFromAny(interp, strObjPtr);
2730 str = Jim_GetString(strObjPtr, &len);
2732 #ifdef JIM_UTF8
2733 /* Case mapping can change the utf-8 length of the string.
2734 * But at worst it will be by one extra byte per char
2736 len *= 2;
2737 #endif
2738 buf = Jim_Alloc(len + 1);
2739 JimStrCopyUpperLower(buf, str, 0);
2740 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2744 * Note: does not support embedded nulls.
2746 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2748 char *buf;
2749 const char *str;
2750 int len;
2752 if (strObjPtr->typePtr != &stringObjType) {
2753 SetStringFromAny(interp, strObjPtr);
2756 str = Jim_GetString(strObjPtr, &len);
2758 #ifdef JIM_UTF8
2759 /* Case mapping can change the utf-8 length of the string.
2760 * But at worst it will be by one extra byte per char
2762 len *= 2;
2763 #endif
2764 buf = Jim_Alloc(len + 1);
2765 JimStrCopyUpperLower(buf, str, 1);
2766 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2770 * Note: does not support embedded nulls.
2772 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2774 char *buf, *p;
2775 int len;
2776 int c;
2777 const char *str;
2779 str = Jim_GetString(strObjPtr, &len);
2780 if (len == 0) {
2781 return strObjPtr;
2783 #ifdef JIM_UTF8
2784 /* Case mapping can change the utf-8 length of the string.
2785 * But at worst it will be by one extra byte per char
2787 len *= 2;
2788 #endif
2789 buf = p = Jim_Alloc(len + 1);
2791 str += utf8_tounicode(str, &c);
2792 p += utf8_getchars(p, utf8_title(c));
2794 JimStrCopyUpperLower(p, str, 0);
2796 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2799 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2800 * for unicode character 'c'.
2801 * Returns the position if found or NULL if not
2803 static const char *utf8_memchr(const char *str, int len, int c)
2805 #ifdef JIM_UTF8
2806 while (len) {
2807 int sc;
2808 int n = utf8_tounicode(str, &sc);
2809 if (sc == c) {
2810 return str;
2812 str += n;
2813 len -= n;
2815 return NULL;
2816 #else
2817 return memchr(str, c, len);
2818 #endif
2822 * Searches for the first non-trim char in string (str, len)
2824 * If none is found, returns just past the last char.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2830 while (len) {
2831 int c;
2832 int n = utf8_tounicode(str, &c);
2834 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2835 /* Not a trim char, so stop */
2836 break;
2838 str += n;
2839 len -= n;
2841 return str;
2845 * Searches backwards for a non-trim char in string (str, len).
2847 * Returns a pointer to just after the non-trim char, or NULL if not found.
2849 * Lengths are in bytes.
2851 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2853 str += len;
2855 while (len) {
2856 int c;
2857 int n = utf8_prev_len(str, len);
2859 len -= n;
2860 str -= n;
2862 n = utf8_tounicode(str, &c);
2864 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2865 return str + n;
2869 return NULL;
2872 static const char default_trim_chars[] = " \t\n\r";
2873 /* sizeof() here includes the null byte */
2874 static int default_trim_chars_len = sizeof(default_trim_chars);
2876 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2878 int len;
2879 const char *str = Jim_GetString(strObjPtr, &len);
2880 const char *trimchars = default_trim_chars;
2881 int trimcharslen = default_trim_chars_len;
2882 const char *newstr;
2884 if (trimcharsObjPtr) {
2885 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2888 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2889 if (newstr == str) {
2890 return strObjPtr;
2893 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2896 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2898 int len;
2899 const char *trimchars = default_trim_chars;
2900 int trimcharslen = default_trim_chars_len;
2901 const char *nontrim;
2903 if (trimcharsObjPtr) {
2904 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2907 SetStringFromAny(interp, strObjPtr);
2909 len = Jim_Length(strObjPtr);
2910 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2912 if (nontrim == NULL) {
2913 /* All trim, so return a zero-length string */
2914 return Jim_NewEmptyStringObj(interp);
2916 if (nontrim == strObjPtr->bytes + len) {
2917 /* All non-trim, so return the original object */
2918 return strObjPtr;
2921 if (Jim_IsShared(strObjPtr)) {
2922 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2924 else {
2925 /* Can modify this string in place */
2926 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2927 strObjPtr->length = (nontrim - strObjPtr->bytes);
2930 return strObjPtr;
2933 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2935 /* First trim left. */
2936 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2938 /* Now trim right */
2939 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2941 /* Note: refCount check is needed since objPtr may be emptyObj */
2942 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2943 /* We don't want this object to be leaked */
2944 Jim_FreeNewObj(interp, objPtr);
2947 return strObjPtr;
2950 /* Some platforms don't have isascii - need a non-macro version */
2951 #ifdef HAVE_ISASCII
2952 #define jim_isascii isascii
2953 #else
2954 static int jim_isascii(int c)
2956 return !(c & ~0x7f);
2958 #endif
2960 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2962 static const char * const strclassnames[] = {
2963 "integer", "alpha", "alnum", "ascii", "digit",
2964 "double", "lower", "upper", "space", "xdigit",
2965 "control", "print", "graph", "punct", "boolean",
2966 NULL
2968 enum {
2969 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2970 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2971 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2973 int strclass;
2974 int len;
2975 int i;
2976 const char *str;
2977 int (*isclassfunc)(int c) = NULL;
2979 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2980 return JIM_ERR;
2983 str = Jim_GetString(strObjPtr, &len);
2984 if (len == 0) {
2985 Jim_SetResultBool(interp, !strict);
2986 return JIM_OK;
2989 switch (strclass) {
2990 case STR_IS_INTEGER:
2992 jim_wide w;
2993 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2994 return JIM_OK;
2997 case STR_IS_DOUBLE:
2999 double d;
3000 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3001 return JIM_OK;
3004 case STR_IS_BOOLEAN:
3006 int b;
3007 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3008 return JIM_OK;
3011 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3012 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3013 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3014 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3015 case STR_IS_LOWER: isclassfunc = islower; break;
3016 case STR_IS_UPPER: isclassfunc = isupper; break;
3017 case STR_IS_SPACE: isclassfunc = isspace; break;
3018 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3019 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3020 case STR_IS_PRINT: isclassfunc = isprint; break;
3021 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3022 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3023 default:
3024 return JIM_ERR;
3027 for (i = 0; i < len; i++) {
3028 if (!isclassfunc(str[i])) {
3029 Jim_SetResultBool(interp, 0);
3030 return JIM_OK;
3033 Jim_SetResultBool(interp, 1);
3034 return JIM_OK;
3037 /* -----------------------------------------------------------------------------
3038 * Compared String Object
3039 * ---------------------------------------------------------------------------*/
3041 /* This is strange object that allows comparison of a C literal string
3042 * with a Jim object in a very short time if the same comparison is done
3043 * multiple times. For example every time the [if] command is executed,
3044 * Jim has to check if a given argument is "else".
3045 * If the code has no errors, this comparison is true most of the time,
3046 * so we can cache the pointer of the string of the last matching
3047 * comparison inside the object. Because most C compilers perform literal sharing,
3048 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3049 * this works pretty well even if comparisons are at different places
3050 * inside the C code. */
3052 static const Jim_ObjType comparedStringObjType = {
3053 "compared-string",
3054 NULL,
3055 NULL,
3056 NULL,
3057 JIM_TYPE_REFERENCES,
3060 /* The only way this object is exposed to the API is via the following
3061 * function. Returns true if the string and the object string repr.
3062 * are the same, otherwise zero is returned.
3064 * Note: this isn't binary safe, but it hardly needs to be.*/
3065 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3067 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3068 return 1;
3070 else {
3071 const char *objStr = Jim_String(objPtr);
3073 if (strcmp(str, objStr) != 0)
3074 return 0;
3076 if (objPtr->typePtr != &comparedStringObjType) {
3077 Jim_FreeIntRep(interp, objPtr);
3078 objPtr->typePtr = &comparedStringObjType;
3080 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3081 return 1;
3085 static int qsortCompareStringPointers(const void *a, const void *b)
3087 char *const *sa = (char *const *)a;
3088 char *const *sb = (char *const *)b;
3090 return strcmp(*sa, *sb);
3094 /* -----------------------------------------------------------------------------
3095 * Source Object
3097 * This object is just a string from the language point of view, but
3098 * the internal representation contains the filename and line number
3099 * where this token was read. This information is used by
3100 * Jim_EvalObj() if the object passed happens to be of type "source".
3102 * This allows propagation of the information about line numbers and file
3103 * names and gives error messages with absolute line numbers.
3105 * Note that this object uses the internal representation of the Jim_Object,
3106 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3108 * Also the object will be converted to something else if the given
3109 * token it represents in the source file is not something to be
3110 * evaluated (not a script), and will be specialized in some other way,
3111 * so the time overhead is also almost zero.
3112 * ---------------------------------------------------------------------------*/
3114 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3115 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3117 static const Jim_ObjType sourceObjType = {
3118 "source",
3119 FreeSourceInternalRep,
3120 DupSourceInternalRep,
3121 NULL,
3122 JIM_TYPE_REFERENCES,
3125 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3127 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3130 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3132 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3133 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3136 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3137 Jim_Obj *fileNameObj, int lineNumber)
3139 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3140 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3141 Jim_IncrRefCount(fileNameObj);
3142 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3143 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3144 objPtr->typePtr = &sourceObjType;
3147 /* -----------------------------------------------------------------------------
3148 * ScriptLine Object
3150 * This object is used only in the Script internal represenation.
3151 * For each line of the script, it holds the number of tokens on the line
3152 * and the source line number.
3154 static const Jim_ObjType scriptLineObjType = {
3155 "scriptline",
3156 NULL,
3157 NULL,
3158 NULL,
3159 JIM_NONE,
3162 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3164 Jim_Obj *objPtr;
3166 #ifdef DEBUG_SHOW_SCRIPT
3167 char buf[100];
3168 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3169 objPtr = Jim_NewStringObj(interp, buf, -1);
3170 #else
3171 objPtr = Jim_NewEmptyStringObj(interp);
3172 #endif
3173 objPtr->typePtr = &scriptLineObjType;
3174 objPtr->internalRep.scriptLineValue.argc = argc;
3175 objPtr->internalRep.scriptLineValue.line = line;
3177 return objPtr;
3180 /* -----------------------------------------------------------------------------
3181 * Script Object
3183 * This object holds the parsed internal representation of a script.
3184 * This representation is help within an allocated ScriptObj (see below)
3186 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3187 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3189 static const Jim_ObjType scriptObjType = {
3190 "script",
3191 FreeScriptInternalRep,
3192 DupScriptInternalRep,
3193 NULL,
3194 JIM_TYPE_REFERENCES,
3197 /* Each token of a script is represented by a ScriptToken.
3198 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3199 * can be specialized by commands operating on it.
3201 typedef struct ScriptToken
3203 Jim_Obj *objPtr;
3204 int type;
3205 } ScriptToken;
3207 /* This is the script object internal representation. An array of
3208 * ScriptToken structures, including a pre-computed representation of the
3209 * command length and arguments.
3211 * For example the script:
3213 * puts hello
3214 * set $i $x$y [foo]BAR
3216 * will produce a ScriptObj with the following ScriptToken's:
3218 * LIN 2
3219 * ESC puts
3220 * ESC hello
3221 * LIN 4
3222 * ESC set
3223 * VAR i
3224 * WRD 2
3225 * VAR x
3226 * VAR y
3227 * WRD 2
3228 * CMD foo
3229 * ESC BAR
3231 * "puts hello" has two args (LIN 2), composed of single tokens.
3232 * (Note that the WRD token is omitted for the common case of a single token.)
3234 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3235 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3237 * The precomputation of the command structure makes Jim_Eval() faster,
3238 * and simpler because there aren't dynamic lengths / allocations.
3240 * -- {expand}/{*} handling --
3242 * Expand is handled in a special way.
3244 * If a "word" begins with {*}, the word token count is -ve.
3246 * For example the command:
3248 * list {*}{a b}
3250 * Will produce the following cmdstruct array:
3252 * LIN 2
3253 * ESC list
3254 * WRD -1
3255 * STR a b
3257 * Note that the 'LIN' token also contains the source information for the
3258 * first word of the line for error reporting purposes
3260 * -- the substFlags field of the structure --
3262 * The scriptObj structure is used to represent both "script" objects
3263 * and "subst" objects. In the second case, there are no LIN and WRD
3264 * tokens. Instead SEP and EOL tokens are added as-is.
3265 * In addition, the field 'substFlags' is used to represent the flags used to turn
3266 * the string into the internal representation.
3267 * If these flags do not match what the application requires,
3268 * the scriptObj is created again. For example the script:
3270 * subst -nocommands $string
3271 * subst -novariables $string
3273 * Will (re)create the internal representation of the $string object
3274 * two times.
3276 typedef struct ScriptObj
3278 ScriptToken *token; /* Tokens array. */
3279 Jim_Obj *fileNameObj; /* Filename */
3280 int len; /* Length of token[] */
3281 int substFlags; /* flags used for the compilation of "subst" objects */
3282 int inUse; /* Used to share a ScriptObj. Currently
3283 only used by Jim_EvalObj() as protection against
3284 shimmering of the currently evaluated object. */
3285 int firstline; /* Line number of the first line */
3286 int linenr; /* Error line number, if any */
3287 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3288 } ScriptObj;
3290 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3291 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3292 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3294 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3296 int i;
3297 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3299 if (--script->inUse != 0)
3300 return;
3301 for (i = 0; i < script->len; i++) {
3302 Jim_DecrRefCount(interp, script->token[i].objPtr);
3304 Jim_Free(script->token);
3305 Jim_DecrRefCount(interp, script->fileNameObj);
3306 Jim_Free(script);
3309 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3311 JIM_NOTUSED(interp);
3312 JIM_NOTUSED(srcPtr);
3314 /* Just return a simple string. We don't try to preserve the source info
3315 * since in practice scripts are never duplicated
3317 dupPtr->typePtr = NULL;
3320 /* A simple parse token.
3321 * As the script is parsed, the created tokens point into the script string rep.
3323 typedef struct
3325 const char *token; /* Pointer to the start of the token */
3326 int len; /* Length of this token */
3327 int type; /* Token type */
3328 int line; /* Line number */
3329 } ParseToken;
3331 /* A list of parsed tokens representing a script.
3332 * Tokens are added to this list as the script is parsed.
3333 * It grows as needed.
3335 typedef struct
3337 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3338 ParseToken *list; /* Array of tokens */
3339 int size; /* Current size of the list */
3340 int count; /* Number of entries used */
3341 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3342 } ParseTokenList;
3344 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3346 tokenlist->list = tokenlist->static_list;
3347 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3348 tokenlist->count = 0;
3351 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3353 if (tokenlist->list != tokenlist->static_list) {
3354 Jim_Free(tokenlist->list);
3359 * Adds the new token to the tokenlist.
3360 * The token has the given length, type and line number.
3361 * The token list is resized as necessary.
3363 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3364 int line)
3366 ParseToken *t;
3368 if (tokenlist->count == tokenlist->size) {
3369 /* Resize the list */
3370 tokenlist->size *= 2;
3371 if (tokenlist->list != tokenlist->static_list) {
3372 tokenlist->list =
3373 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3375 else {
3376 /* The list needs to become allocated */
3377 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3378 memcpy(tokenlist->list, tokenlist->static_list,
3379 tokenlist->count * sizeof(*tokenlist->list));
3382 t = &tokenlist->list[tokenlist->count++];
3383 t->token = token;
3384 t->len = len;
3385 t->type = type;
3386 t->line = line;
3389 /* Counts the number of adjoining non-separator tokens.
3391 * Returns -ve if the first token is the expansion
3392 * operator (in which case the count doesn't include
3393 * that token).
3395 static int JimCountWordTokens(ParseToken *t)
3397 int expand = 1;
3398 int count = 0;
3400 /* Is the first word {*} or {expand}? */
3401 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3402 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3403 /* Create an expand token */
3404 expand = -1;
3405 t++;
3409 /* Now count non-separator words */
3410 while (!TOKEN_IS_SEP(t->type)) {
3411 t++;
3412 count++;
3415 return count * expand;
3419 * Create a script/subst object from the given token.
3421 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3423 Jim_Obj *objPtr;
3425 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3426 /* Convert backlash escapes. The result will never be longer than the original */
3427 int len = t->len;
3428 char *str = Jim_Alloc(len + 1);
3429 len = JimEscape(str, t->token, len);
3430 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3432 else {
3433 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3434 * with a single space.
3436 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3438 return objPtr;
3442 * Takes a tokenlist and creates the allocated list of script tokens
3443 * in script->token, of length script->len.
3445 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3446 * as required.
3448 * Also sets script->line to the line number of the first token
3450 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3451 ParseTokenList *tokenlist)
3453 int i;
3454 struct ScriptToken *token;
3455 /* Number of tokens so far for the current command */
3456 int lineargs = 0;
3457 /* This is the first token for the current command */
3458 ScriptToken *linefirst;
3459 int count;
3460 int linenr;
3462 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3463 printf("==== Tokens ====\n");
3464 for (i = 0; i < tokenlist->count; i++) {
3465 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3466 tokenlist->list[i].len, tokenlist->list[i].token);
3468 #endif
3470 /* May need up to one extra script token for each EOL in the worst case */
3471 count = tokenlist->count;
3472 for (i = 0; i < tokenlist->count; i++) {
3473 if (tokenlist->list[i].type == JIM_TT_EOL) {
3474 count++;
3477 linenr = script->firstline = tokenlist->list[0].line;
3479 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3481 /* This is the first token for the current command */
3482 linefirst = token++;
3484 for (i = 0; i < tokenlist->count; ) {
3485 /* Look ahead to find out how many tokens make up the next word */
3486 int wordtokens;
3488 /* Skip any leading separators */
3489 while (tokenlist->list[i].type == JIM_TT_SEP) {
3490 i++;
3493 wordtokens = JimCountWordTokens(tokenlist->list + i);
3495 if (wordtokens == 0) {
3496 /* None, so at end of line */
3497 if (lineargs) {
3498 linefirst->type = JIM_TT_LINE;
3499 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3500 Jim_IncrRefCount(linefirst->objPtr);
3502 /* Reset for new line */
3503 lineargs = 0;
3504 linefirst = token++;
3506 i++;
3507 continue;
3509 else if (wordtokens != 1) {
3510 /* More than 1, or {*}, so insert a WORD token */
3511 token->type = JIM_TT_WORD;
3512 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3513 Jim_IncrRefCount(token->objPtr);
3514 token++;
3515 if (wordtokens < 0) {
3516 /* Skip the expand token */
3517 i++;
3518 wordtokens = -wordtokens - 1;
3519 lineargs--;
3523 if (lineargs == 0) {
3524 /* First real token on the line, so record the line number */
3525 linenr = tokenlist->list[i].line;
3527 lineargs++;
3529 /* Add each non-separator word token to the line */
3530 while (wordtokens--) {
3531 const ParseToken *t = &tokenlist->list[i++];
3533 token->type = t->type;
3534 token->objPtr = JimMakeScriptObj(interp, t);
3535 Jim_IncrRefCount(token->objPtr);
3537 /* Every object is initially a string of type 'source', but the
3538 * internal type may be specialized during execution of the
3539 * script. */
3540 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3541 token++;
3545 if (lineargs == 0) {
3546 token--;
3549 script->len = token - script->token;
3551 JimPanic((script->len >= count, "allocated script array is too short"));
3553 #ifdef DEBUG_SHOW_SCRIPT
3554 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3555 for (i = 0; i < script->len; i++) {
3556 const ScriptToken *t = &script->token[i];
3557 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3559 #endif
3563 /* Parses the given string object to determine if it represents a complete script.
3565 * This is useful for interactive shells implementation, for [info complete].
3567 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3568 * '{' on scripts incomplete missing one or more '}' to be balanced.
3569 * '[' on scripts incomplete missing one or more ']' to be balanced.
3570 * '"' on scripts incomplete missing a '"' char.
3571 * '\\' on scripts with a trailing backslash.
3573 * If the script is complete, 1 is returned, otherwise 0.
3575 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3577 ScriptObj *script = JimGetScript(interp, scriptObj);
3578 if (stateCharPtr) {
3579 *stateCharPtr = script->missing;
3581 return (script->missing == ' ');
3585 * Sets an appropriate error message for a missing script/expression terminator.
3587 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3589 * Note that a trailing backslash is not considered to be an error.
3591 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3593 const char *msg;
3595 switch (ch) {
3596 case '\\':
3597 case ' ':
3598 return JIM_OK;
3600 case '[':
3601 msg = "unmatched \"[\"";
3602 break;
3603 case '{':
3604 msg = "missing close-brace";
3605 break;
3606 case '"':
3607 default:
3608 msg = "missing quote";
3609 break;
3612 Jim_SetResultString(interp, msg, -1);
3613 return JIM_ERR;
3617 * Similar to ScriptObjAddTokens(), but for subst objects.
3619 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3620 ParseTokenList *tokenlist)
3622 int i;
3623 struct ScriptToken *token;
3625 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3627 for (i = 0; i < tokenlist->count; i++) {
3628 const ParseToken *t = &tokenlist->list[i];
3630 /* Create a token for 't' */
3631 token->type = t->type;
3632 token->objPtr = JimMakeScriptObj(interp, t);
3633 Jim_IncrRefCount(token->objPtr);
3634 token++;
3637 script->len = i;
3640 /* This method takes the string representation of an object
3641 * as a Tcl script, and generates the pre-parsed internal representation
3642 * of the script.
3644 * On parse error, sets an error message and returns JIM_ERR
3645 * (Note: the object is still converted to a script, even if an error occurs)
3647 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3649 int scriptTextLen;
3650 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3651 struct JimParserCtx parser;
3652 struct ScriptObj *script;
3653 ParseTokenList tokenlist;
3654 int line = 1;
3656 /* Try to get information about filename / line number */
3657 if (objPtr->typePtr == &sourceObjType) {
3658 line = objPtr->internalRep.sourceValue.lineNumber;
3661 /* Initially parse the script into tokens (in tokenlist) */
3662 ScriptTokenListInit(&tokenlist);
3664 JimParserInit(&parser, scriptText, scriptTextLen, line);
3665 while (!parser.eof) {
3666 JimParseScript(&parser);
3667 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3668 parser.tline);
3671 /* Add a final EOF token */
3672 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3674 /* Create the "real" script tokens from the parsed tokens */
3675 script = Jim_Alloc(sizeof(*script));
3676 memset(script, 0, sizeof(*script));
3677 script->inUse = 1;
3678 if (objPtr->typePtr == &sourceObjType) {
3679 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3681 else {
3682 script->fileNameObj = interp->emptyObj;
3684 Jim_IncrRefCount(script->fileNameObj);
3685 script->missing = parser.missing.ch;
3686 script->linenr = parser.missing.line;
3688 ScriptObjAddTokens(interp, script, &tokenlist);
3690 /* No longer need the token list */
3691 ScriptTokenListFree(&tokenlist);
3693 /* Free the old internal rep and set the new one. */
3694 Jim_FreeIntRep(interp, objPtr);
3695 Jim_SetIntRepPtr(objPtr, script);
3696 objPtr->typePtr = &scriptObjType;
3699 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3702 * Returns the parsed script.
3703 * Note that if there is any possibility that the script is not valid,
3704 * call JimScriptValid() to check
3706 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3708 if (objPtr == interp->emptyObj) {
3709 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3710 objPtr = interp->nullScriptObj;
3713 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3714 JimSetScriptFromAny(interp, objPtr);
3717 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3721 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3722 * and leaves an error message in the interp result.
3725 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3727 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3728 JimAddErrorToStack(interp, script);
3729 return 0;
3731 return 1;
3735 /* -----------------------------------------------------------------------------
3736 * Commands
3737 * ---------------------------------------------------------------------------*/
3738 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3740 cmdPtr->inUse++;
3743 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3745 if (--cmdPtr->inUse == 0) {
3746 if (cmdPtr->isproc) {
3747 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3748 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3749 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3750 if (cmdPtr->u.proc.staticVars) {
3751 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3752 Jim_Free(cmdPtr->u.proc.staticVars);
3755 else {
3756 /* native (C) */
3757 if (cmdPtr->u.native.delProc) {
3758 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3761 if (cmdPtr->prevCmd) {
3762 /* Delete any pushed command too */
3763 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3765 Jim_Free(cmdPtr);
3769 /* Variables HashTable Type.
3771 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3774 /* Variables HashTable Type.
3776 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3777 static void JimVariablesHTValDestructor(void *interp, void *val)
3779 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3780 Jim_Free(val);
3783 static const Jim_HashTableType JimVariablesHashTableType = {
3784 JimStringCopyHTHashFunction, /* hash function */
3785 JimStringCopyHTDup, /* key dup */
3786 NULL, /* val dup */
3787 JimStringCopyHTKeyCompare, /* key compare */
3788 JimStringCopyHTKeyDestructor, /* key destructor */
3789 JimVariablesHTValDestructor /* val destructor */
3792 /* Commands HashTable Type.
3794 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3796 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3798 JimDecrCmdRefCount(interp, val);
3801 static const Jim_HashTableType JimCommandsHashTableType = {
3802 JimStringCopyHTHashFunction, /* hash function */
3803 JimStringCopyHTDup, /* key dup */
3804 NULL, /* val dup */
3805 JimStringCopyHTKeyCompare, /* key compare */
3806 JimStringCopyHTKeyDestructor, /* key destructor */
3807 JimCommandsHT_ValDestructor /* val destructor */
3810 /* ------------------------- Commands related functions --------------------- */
3812 #ifdef jim_ext_namespace
3814 * Returns the "unscoped" version of the given namespace.
3815 * That is, the fully qualified name without the leading ::
3816 * The returned value is either nsObj, or an object with a zero ref count.
3818 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3820 const char *name = Jim_String(nsObj);
3821 if (name[0] == ':' && name[1] == ':') {
3822 /* This command is being defined in the global namespace */
3823 while (*++name == ':') {
3825 nsObj = Jim_NewStringObj(interp, name, -1);
3827 else if (Jim_Length(interp->framePtr->nsObj)) {
3828 /* This command is being defined in a non-global namespace */
3829 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3830 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3832 return nsObj;
3835 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3837 Jim_Obj *resultObj;
3839 const char *name = Jim_String(nameObjPtr);
3840 if (name[0] == ':' && name[1] == ':') {
3841 return nameObjPtr;
3843 Jim_IncrRefCount(nameObjPtr);
3844 resultObj = Jim_NewStringObj(interp, "::", -1);
3845 Jim_AppendObj(interp, resultObj, nameObjPtr);
3846 Jim_DecrRefCount(interp, nameObjPtr);
3848 return resultObj;
3852 * An efficient version of JimQualifyNameObj() where the name is
3853 * available (and needed) as a 'const char *'.
3854 * Avoids creating an object if not necessary.
3855 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3857 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3859 Jim_Obj *objPtr = interp->emptyObj;
3861 if (name[0] == ':' && name[1] == ':') {
3862 /* This command is being defined in the global namespace */
3863 while (*++name == ':') {
3866 else if (Jim_Length(interp->framePtr->nsObj)) {
3867 /* This command is being defined in a non-global namespace */
3868 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3869 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3870 name = Jim_String(objPtr);
3872 Jim_IncrRefCount(objPtr);
3873 *objPtrPtr = objPtr;
3874 return name;
3877 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3879 #else
3880 /* We can be more efficient in the no-namespace case */
3881 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3882 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3884 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3886 return nameObjPtr;
3888 #endif
3890 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3892 /* It may already exist, so we try to delete the old one.
3893 * Note that reference count means that it won't be deleted yet if
3894 * it exists in the call stack.
3896 * BUT, if 'local' is in force, instead of deleting the existing
3897 * proc, we stash a reference to the old proc here.
3899 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3900 if (he) {
3901 /* There was an old cmd with the same name,
3902 * so this requires a 'proc epoch' update. */
3904 /* If a procedure with the same name didn't exist there is no need
3905 * to increment the 'proc epoch' because creation of a new procedure
3906 * can never affect existing cached commands. We don't do
3907 * negative caching. */
3908 Jim_InterpIncrProcEpoch(interp);
3911 if (he && interp->local) {
3912 /* Push this command over the top of the previous one */
3913 cmd->prevCmd = Jim_GetHashEntryVal(he);
3914 Jim_SetHashVal(&interp->commands, he, cmd);
3916 else {
3917 if (he) {
3918 /* Replace the existing command */
3919 Jim_DeleteHashEntry(&interp->commands, name);
3922 Jim_AddHashEntry(&interp->commands, name, cmd);
3924 return JIM_OK;
3928 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3929 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3931 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3933 /* Store the new details for this command */
3934 memset(cmdPtr, 0, sizeof(*cmdPtr));
3935 cmdPtr->inUse = 1;
3936 cmdPtr->u.native.delProc = delProc;
3937 cmdPtr->u.native.cmdProc = cmdProc;
3938 cmdPtr->u.native.privData = privData;
3940 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3942 return JIM_OK;
3945 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3947 int len, i;
3949 len = Jim_ListLength(interp, staticsListObjPtr);
3950 if (len == 0) {
3951 return JIM_OK;
3954 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3955 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3956 for (i = 0; i < len; i++) {
3957 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3958 Jim_Var *varPtr;
3959 int subLen;
3961 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3962 /* Check if it's composed of two elements. */
3963 subLen = Jim_ListLength(interp, objPtr);
3964 if (subLen == 1 || subLen == 2) {
3965 /* Try to get the variable value from the current
3966 * environment. */
3967 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3968 if (subLen == 1) {
3969 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3970 if (initObjPtr == NULL) {
3971 Jim_SetResultFormatted(interp,
3972 "variable for initialization of static \"%#s\" not found in the local context",
3973 nameObjPtr);
3974 return JIM_ERR;
3977 else {
3978 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3980 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3981 return JIM_ERR;
3984 varPtr = Jim_Alloc(sizeof(*varPtr));
3985 varPtr->objPtr = initObjPtr;
3986 Jim_IncrRefCount(initObjPtr);
3987 varPtr->linkFramePtr = NULL;
3988 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3989 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3990 Jim_SetResultFormatted(interp,
3991 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3992 Jim_DecrRefCount(interp, initObjPtr);
3993 Jim_Free(varPtr);
3994 return JIM_ERR;
3997 else {
3998 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3999 objPtr);
4000 return JIM_ERR;
4003 return JIM_OK;
4006 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4008 #ifdef jim_ext_namespace
4009 if (cmdPtr->isproc) {
4010 /* XXX: Really need JimNamespaceSplit() */
4011 const char *pt = strrchr(cmdname, ':');
4012 if (pt && pt != cmdname && pt[-1] == ':') {
4013 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4014 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4015 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4017 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4018 /* This commands shadows a global command, so a proc epoch update is required */
4019 Jim_InterpIncrProcEpoch(interp);
4023 #endif
4026 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4027 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4029 Jim_Cmd *cmdPtr;
4030 int argListLen;
4031 int i;
4033 argListLen = Jim_ListLength(interp, argListObjPtr);
4035 /* Allocate space for both the command pointer and the arg list */
4036 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4037 memset(cmdPtr, 0, sizeof(*cmdPtr));
4038 cmdPtr->inUse = 1;
4039 cmdPtr->isproc = 1;
4040 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4041 cmdPtr->u.proc.argListLen = argListLen;
4042 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4043 cmdPtr->u.proc.argsPos = -1;
4044 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4045 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4046 Jim_IncrRefCount(argListObjPtr);
4047 Jim_IncrRefCount(bodyObjPtr);
4048 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4050 /* Create the statics hash table. */
4051 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4052 goto err;
4055 /* Parse the args out into arglist, validating as we go */
4056 /* Examine the argument list for default parameters and 'args' */
4057 for (i = 0; i < argListLen; i++) {
4058 Jim_Obj *argPtr;
4059 Jim_Obj *nameObjPtr;
4060 Jim_Obj *defaultObjPtr;
4061 int len;
4063 /* Examine a parameter */
4064 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4065 len = Jim_ListLength(interp, argPtr);
4066 if (len == 0) {
4067 Jim_SetResultString(interp, "argument with no name", -1);
4068 err:
4069 JimDecrCmdRefCount(interp, cmdPtr);
4070 return NULL;
4072 if (len > 2) {
4073 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4074 goto err;
4077 if (len == 2) {
4078 /* Optional parameter */
4079 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4080 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4082 else {
4083 /* Required parameter */
4084 nameObjPtr = argPtr;
4085 defaultObjPtr = NULL;
4089 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4090 if (cmdPtr->u.proc.argsPos >= 0) {
4091 Jim_SetResultString(interp, "'args' specified more than once", -1);
4092 goto err;
4094 cmdPtr->u.proc.argsPos = i;
4096 else {
4097 if (len == 2) {
4098 cmdPtr->u.proc.optArity++;
4100 else {
4101 cmdPtr->u.proc.reqArity++;
4105 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4106 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4109 return cmdPtr;
4112 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4114 int ret = JIM_OK;
4115 Jim_Obj *qualifiedNameObj;
4116 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4118 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4119 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4120 ret = JIM_ERR;
4122 else {
4123 Jim_InterpIncrProcEpoch(interp);
4126 JimFreeQualifiedName(interp, qualifiedNameObj);
4128 return ret;
4131 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4133 int ret = JIM_ERR;
4134 Jim_HashEntry *he;
4135 Jim_Cmd *cmdPtr;
4136 Jim_Obj *qualifiedOldNameObj;
4137 Jim_Obj *qualifiedNewNameObj;
4138 const char *fqold;
4139 const char *fqnew;
4141 if (newName[0] == 0) {
4142 return Jim_DeleteCommand(interp, oldName);
4145 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4146 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4148 /* Does it exist? */
4149 he = Jim_FindHashEntry(&interp->commands, fqold);
4150 if (he == NULL) {
4151 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4153 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4154 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4156 else {
4157 /* Add the new name first */
4158 cmdPtr = Jim_GetHashEntryVal(he);
4159 JimIncrCmdRefCount(cmdPtr);
4160 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4161 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4163 /* Now remove the old name */
4164 Jim_DeleteHashEntry(&interp->commands, fqold);
4166 /* Increment the epoch */
4167 Jim_InterpIncrProcEpoch(interp);
4169 ret = JIM_OK;
4172 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4173 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4175 return ret;
4178 /* -----------------------------------------------------------------------------
4179 * Command object
4180 * ---------------------------------------------------------------------------*/
4182 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4184 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4187 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4189 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4190 dupPtr->typePtr = srcPtr->typePtr;
4191 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4194 static const Jim_ObjType commandObjType = {
4195 "command",
4196 FreeCommandInternalRep,
4197 DupCommandInternalRep,
4198 NULL,
4199 JIM_TYPE_REFERENCES,
4202 /* This function returns the command structure for the command name
4203 * stored in objPtr. It tries to specialize the objPtr to contain
4204 * a cached info instead to perform the lookup into the hash table
4205 * every time. The information cached may not be uptodate, in such
4206 * a case the lookup is performed and the cache updated.
4208 * Respects the 'upcall' setting
4210 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4212 Jim_Cmd *cmd;
4214 /* In order to be valid, the proc epoch must match and
4215 * the lookup must have occurred in the same namespace
4217 if (objPtr->typePtr != &commandObjType ||
4218 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4219 #ifdef jim_ext_namespace
4220 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4221 #endif
4223 /* Not cached or out of date, so lookup */
4225 /* Do we need to try the local namespace? */
4226 const char *name = Jim_String(objPtr);
4227 Jim_HashEntry *he;
4229 if (name[0] == ':' && name[1] == ':') {
4230 while (*++name == ':') {
4233 #ifdef jim_ext_namespace
4234 else if (Jim_Length(interp->framePtr->nsObj)) {
4235 /* This command is being defined in a non-global namespace */
4236 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4237 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4238 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4239 Jim_FreeNewObj(interp, nameObj);
4240 if (he) {
4241 goto found;
4244 #endif
4246 /* Lookup in the global namespace */
4247 he = Jim_FindHashEntry(&interp->commands, name);
4248 if (he == NULL) {
4249 if (flags & JIM_ERRMSG) {
4250 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4252 return NULL;
4254 #ifdef jim_ext_namespace
4255 found:
4256 #endif
4257 cmd = Jim_GetHashEntryVal(he);
4259 /* Free the old internal repr and set the new one. */
4260 Jim_FreeIntRep(interp, objPtr);
4261 objPtr->typePtr = &commandObjType;
4262 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4263 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4264 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4265 Jim_IncrRefCount(interp->framePtr->nsObj);
4267 else {
4268 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4270 while (cmd->u.proc.upcall) {
4271 cmd = cmd->prevCmd;
4273 return cmd;
4276 /* -----------------------------------------------------------------------------
4277 * Variables
4278 * ---------------------------------------------------------------------------*/
4280 /* -----------------------------------------------------------------------------
4281 * Variable object
4282 * ---------------------------------------------------------------------------*/
4284 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4286 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4288 static const Jim_ObjType variableObjType = {
4289 "variable",
4290 NULL,
4291 NULL,
4292 NULL,
4293 JIM_TYPE_REFERENCES,
4297 * Check that the name does not contain embedded nulls.
4299 * Variable and procedure names are manipulated as null terminated strings, so
4300 * don't allow names with embedded nulls.
4302 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4304 /* Variable names and proc names can't contain embedded nulls */
4305 if (nameObjPtr->typePtr != &variableObjType) {
4306 int len;
4307 const char *str = Jim_GetString(nameObjPtr, &len);
4308 if (memchr(str, '\0', len)) {
4309 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4310 return JIM_ERR;
4313 return JIM_OK;
4316 /* This method should be called only by the variable API.
4317 * It returns JIM_OK on success (variable already exists),
4318 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4319 * a variable name, but syntax glue for [dict] i.e. the last
4320 * character is ')' */
4321 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4323 const char *varName;
4324 Jim_CallFrame *framePtr;
4325 Jim_HashEntry *he;
4326 int global;
4327 int len;
4329 /* Check if the object is already an uptodate variable */
4330 if (objPtr->typePtr == &variableObjType) {
4331 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4332 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4333 /* nothing to do */
4334 return JIM_OK;
4336 /* Need to re-resolve the variable in the updated callframe */
4338 else if (objPtr->typePtr == &dictSubstObjType) {
4339 return JIM_DICT_SUGAR;
4341 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4342 return JIM_ERR;
4346 varName = Jim_GetString(objPtr, &len);
4348 /* Make sure it's not syntax glue to get/set dict. */
4349 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4350 return JIM_DICT_SUGAR;
4353 if (varName[0] == ':' && varName[1] == ':') {
4354 while (*++varName == ':') {
4356 global = 1;
4357 framePtr = interp->topFramePtr;
4359 else {
4360 global = 0;
4361 framePtr = interp->framePtr;
4364 /* Resolve this name in the variables hash table */
4365 he = Jim_FindHashEntry(&framePtr->vars, varName);
4366 if (he == NULL) {
4367 if (!global && framePtr->staticVars) {
4368 /* Try with static vars. */
4369 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4371 if (he == NULL) {
4372 return JIM_ERR;
4376 /* Free the old internal repr and set the new one. */
4377 Jim_FreeIntRep(interp, objPtr);
4378 objPtr->typePtr = &variableObjType;
4379 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4380 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4381 objPtr->internalRep.varValue.global = global;
4382 return JIM_OK;
4385 /* -------------------- Variables related functions ------------------------- */
4386 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4387 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4389 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4391 const char *name;
4392 Jim_CallFrame *framePtr;
4393 int global;
4395 /* New variable to create */
4396 Jim_Var *var = Jim_Alloc(sizeof(*var));
4398 var->objPtr = valObjPtr;
4399 Jim_IncrRefCount(valObjPtr);
4400 var->linkFramePtr = NULL;
4402 name = Jim_String(nameObjPtr);
4403 if (name[0] == ':' && name[1] == ':') {
4404 while (*++name == ':') {
4406 framePtr = interp->topFramePtr;
4407 global = 1;
4409 else {
4410 framePtr = interp->framePtr;
4411 global = 0;
4414 /* Insert the new variable */
4415 Jim_AddHashEntry(&framePtr->vars, name, var);
4417 /* Make the object int rep a variable */
4418 Jim_FreeIntRep(interp, nameObjPtr);
4419 nameObjPtr->typePtr = &variableObjType;
4420 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4421 nameObjPtr->internalRep.varValue.varPtr = var;
4422 nameObjPtr->internalRep.varValue.global = global;
4424 return var;
4427 /* For now that's dummy. Variables lookup should be optimized
4428 * in many ways, with caching of lookups, and possibly with
4429 * a table of pre-allocated vars in every CallFrame for local vars.
4430 * All the caching should also have an 'epoch' mechanism similar
4431 * to the one used by Tcl for procedures lookup caching. */
4433 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4435 int err;
4436 Jim_Var *var;
4438 switch (SetVariableFromAny(interp, nameObjPtr)) {
4439 case JIM_DICT_SUGAR:
4440 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4442 case JIM_ERR:
4443 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4444 return JIM_ERR;
4446 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4447 break;
4449 case JIM_OK:
4450 var = nameObjPtr->internalRep.varValue.varPtr;
4451 if (var->linkFramePtr == NULL) {
4452 Jim_IncrRefCount(valObjPtr);
4453 Jim_DecrRefCount(interp, var->objPtr);
4454 var->objPtr = valObjPtr;
4456 else { /* Else handle the link */
4457 Jim_CallFrame *savedCallFrame;
4459 savedCallFrame = interp->framePtr;
4460 interp->framePtr = var->linkFramePtr;
4461 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4462 interp->framePtr = savedCallFrame;
4463 if (err != JIM_OK)
4464 return err;
4467 return JIM_OK;
4470 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4472 Jim_Obj *nameObjPtr;
4473 int result;
4475 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4476 Jim_IncrRefCount(nameObjPtr);
4477 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4478 Jim_DecrRefCount(interp, nameObjPtr);
4479 return result;
4482 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4484 Jim_CallFrame *savedFramePtr;
4485 int result;
4487 savedFramePtr = interp->framePtr;
4488 interp->framePtr = interp->topFramePtr;
4489 result = Jim_SetVariableStr(interp, name, objPtr);
4490 interp->framePtr = savedFramePtr;
4491 return result;
4494 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4496 Jim_Obj *nameObjPtr, *valObjPtr;
4497 int result;
4499 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4500 valObjPtr = Jim_NewStringObj(interp, val, -1);
4501 Jim_IncrRefCount(nameObjPtr);
4502 Jim_IncrRefCount(valObjPtr);
4503 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4504 Jim_DecrRefCount(interp, nameObjPtr);
4505 Jim_DecrRefCount(interp, valObjPtr);
4506 return result;
4509 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4510 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4512 const char *varName;
4513 const char *targetName;
4514 Jim_CallFrame *framePtr;
4515 Jim_Var *varPtr;
4517 /* Check for an existing variable or link */
4518 switch (SetVariableFromAny(interp, nameObjPtr)) {
4519 case JIM_DICT_SUGAR:
4520 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4521 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4522 return JIM_ERR;
4524 case JIM_OK:
4525 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4527 if (varPtr->linkFramePtr == NULL) {
4528 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4529 return JIM_ERR;
4532 /* It exists, but is a link, so first delete the link */
4533 varPtr->linkFramePtr = NULL;
4534 break;
4537 /* Resolve the call frames for both variables */
4538 /* XXX: SetVariableFromAny() already did this! */
4539 varName = Jim_String(nameObjPtr);
4541 if (varName[0] == ':' && varName[1] == ':') {
4542 while (*++varName == ':') {
4544 /* Linking a global var does nothing */
4545 framePtr = interp->topFramePtr;
4547 else {
4548 framePtr = interp->framePtr;
4551 targetName = Jim_String(targetNameObjPtr);
4552 if (targetName[0] == ':' && targetName[1] == ':') {
4553 while (*++targetName == ':') {
4555 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4556 targetCallFrame = interp->topFramePtr;
4558 Jim_IncrRefCount(targetNameObjPtr);
4560 if (framePtr->level < targetCallFrame->level) {
4561 Jim_SetResultFormatted(interp,
4562 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4563 nameObjPtr);
4564 Jim_DecrRefCount(interp, targetNameObjPtr);
4565 return JIM_ERR;
4568 /* Check for cycles. */
4569 if (framePtr == targetCallFrame) {
4570 Jim_Obj *objPtr = targetNameObjPtr;
4572 /* Cycles are only possible with 'uplevel 0' */
4573 while (1) {
4574 if (strcmp(Jim_String(objPtr), varName) == 0) {
4575 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4576 Jim_DecrRefCount(interp, targetNameObjPtr);
4577 return JIM_ERR;
4579 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4580 break;
4581 varPtr = objPtr->internalRep.varValue.varPtr;
4582 if (varPtr->linkFramePtr != targetCallFrame)
4583 break;
4584 objPtr = varPtr->objPtr;
4588 /* Perform the binding */
4589 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4590 /* We are now sure 'nameObjPtr' type is variableObjType */
4591 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4592 Jim_DecrRefCount(interp, targetNameObjPtr);
4593 return JIM_OK;
4596 /* Return the Jim_Obj pointer associated with a variable name,
4597 * or NULL if the variable was not found in the current context.
4598 * The same optimization discussed in the comment to the
4599 * 'SetVariable' function should apply here.
4601 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4602 * in a dictionary which is shared, the array variable value is duplicated first.
4603 * This allows the array element to be updated (e.g. append, lappend) without
4604 * affecting other references to the dictionary.
4606 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4608 switch (SetVariableFromAny(interp, nameObjPtr)) {
4609 case JIM_OK:{
4610 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4612 if (varPtr->linkFramePtr == NULL) {
4613 return varPtr->objPtr;
4615 else {
4616 Jim_Obj *objPtr;
4618 /* The variable is a link? Resolve it. */
4619 Jim_CallFrame *savedCallFrame = interp->framePtr;
4621 interp->framePtr = varPtr->linkFramePtr;
4622 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4623 interp->framePtr = savedCallFrame;
4624 if (objPtr) {
4625 return objPtr;
4627 /* Error, so fall through to the error message */
4630 break;
4632 case JIM_DICT_SUGAR:
4633 /* [dict] syntax sugar. */
4634 return JimDictSugarGet(interp, nameObjPtr, flags);
4636 if (flags & JIM_ERRMSG) {
4637 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4639 return NULL;
4642 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4644 Jim_CallFrame *savedFramePtr;
4645 Jim_Obj *objPtr;
4647 savedFramePtr = interp->framePtr;
4648 interp->framePtr = interp->topFramePtr;
4649 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4650 interp->framePtr = savedFramePtr;
4652 return objPtr;
4655 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4657 Jim_Obj *nameObjPtr, *varObjPtr;
4659 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4660 Jim_IncrRefCount(nameObjPtr);
4661 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4662 Jim_DecrRefCount(interp, nameObjPtr);
4663 return varObjPtr;
4666 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4668 Jim_CallFrame *savedFramePtr;
4669 Jim_Obj *objPtr;
4671 savedFramePtr = interp->framePtr;
4672 interp->framePtr = interp->topFramePtr;
4673 objPtr = Jim_GetVariableStr(interp, name, flags);
4674 interp->framePtr = savedFramePtr;
4676 return objPtr;
4679 /* Unset a variable.
4680 * Note: On success unset invalidates all the variable objects created
4681 * in the current call frame incrementing. */
4682 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4684 Jim_Var *varPtr;
4685 int retval;
4686 Jim_CallFrame *framePtr;
4688 retval = SetVariableFromAny(interp, nameObjPtr);
4689 if (retval == JIM_DICT_SUGAR) {
4690 /* [dict] syntax sugar. */
4691 return JimDictSugarSet(interp, nameObjPtr, NULL);
4693 else if (retval == JIM_OK) {
4694 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4696 /* If it's a link call UnsetVariable recursively */
4697 if (varPtr->linkFramePtr) {
4698 framePtr = interp->framePtr;
4699 interp->framePtr = varPtr->linkFramePtr;
4700 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4701 interp->framePtr = framePtr;
4703 else {
4704 const char *name = Jim_String(nameObjPtr);
4705 if (nameObjPtr->internalRep.varValue.global) {
4706 name += 2;
4707 framePtr = interp->topFramePtr;
4709 else {
4710 framePtr = interp->framePtr;
4713 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4714 if (retval == JIM_OK) {
4715 /* Change the callframe id, invalidating var lookup caching */
4716 framePtr->id = interp->callFrameEpoch++;
4720 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4721 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4723 return retval;
4726 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4728 /* Given a variable name for [dict] operation syntax sugar,
4729 * this function returns two objects, the first with the name
4730 * of the variable to set, and the second with the respective key.
4731 * For example "foo(bar)" will return objects with string repr. of
4732 * "foo" and "bar".
4734 * The returned objects have refcount = 1. The function can't fail. */
4735 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4736 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4738 const char *str, *p;
4739 int len, keyLen;
4740 Jim_Obj *varObjPtr, *keyObjPtr;
4742 str = Jim_GetString(objPtr, &len);
4744 p = strchr(str, '(');
4745 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4747 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4749 p++;
4750 keyLen = (str + len) - p;
4751 if (str[len - 1] == ')') {
4752 keyLen--;
4755 /* Create the objects with the variable name and key. */
4756 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4758 Jim_IncrRefCount(varObjPtr);
4759 Jim_IncrRefCount(keyObjPtr);
4760 *varPtrPtr = varObjPtr;
4761 *keyPtrPtr = keyObjPtr;
4764 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4765 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4766 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4768 int err;
4770 SetDictSubstFromAny(interp, objPtr);
4772 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4773 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4775 if (err == JIM_OK) {
4776 /* Don't keep an extra ref to the result */
4777 Jim_SetEmptyResult(interp);
4779 else {
4780 if (!valObjPtr) {
4781 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4782 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4783 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4784 objPtr);
4785 return err;
4788 /* Make the error more informative and Tcl-compatible */
4789 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4790 (valObjPtr ? "set" : "unset"), objPtr);
4792 return err;
4796 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4798 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4799 * and stored back to the variable before expansion.
4801 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4802 Jim_Obj *keyObjPtr, int flags)
4804 Jim_Obj *dictObjPtr;
4805 Jim_Obj *resObjPtr = NULL;
4806 int ret;
4808 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4809 if (!dictObjPtr) {
4810 return NULL;
4813 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4814 if (ret != JIM_OK) {
4815 Jim_SetResultFormatted(interp,
4816 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4817 ret < 0 ? "variable isn't" : "no such element in");
4819 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4820 /* Update the variable to have an unshared copy */
4821 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4824 return resObjPtr;
4827 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4828 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4830 SetDictSubstFromAny(interp, objPtr);
4832 return JimDictExpandArrayVariable(interp,
4833 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4834 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4837 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4839 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4841 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4842 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4845 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4847 JIM_NOTUSED(interp);
4849 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4850 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4851 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4852 dupPtr->typePtr = &dictSubstObjType;
4855 /* Note: The object *must* be in dict-sugar format */
4856 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4858 if (objPtr->typePtr != &dictSubstObjType) {
4859 Jim_Obj *varObjPtr, *keyObjPtr;
4861 if (objPtr->typePtr == &interpolatedObjType) {
4862 /* An interpolated object in dict-sugar form */
4864 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4865 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4867 Jim_IncrRefCount(varObjPtr);
4868 Jim_IncrRefCount(keyObjPtr);
4870 else {
4871 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4874 Jim_FreeIntRep(interp, objPtr);
4875 objPtr->typePtr = &dictSubstObjType;
4876 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4877 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4881 /* This function is used to expand [dict get] sugar in the form
4882 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4883 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4884 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4885 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4886 * the [dict]ionary contained in variable VARNAME. */
4887 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4889 Jim_Obj *resObjPtr = NULL;
4890 Jim_Obj *substKeyObjPtr = NULL;
4892 SetDictSubstFromAny(interp, objPtr);
4894 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4895 &substKeyObjPtr, JIM_NONE)
4896 != JIM_OK) {
4897 return NULL;
4899 Jim_IncrRefCount(substKeyObjPtr);
4900 resObjPtr =
4901 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4902 substKeyObjPtr, 0);
4903 Jim_DecrRefCount(interp, substKeyObjPtr);
4905 return resObjPtr;
4908 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4910 Jim_Obj *resultObjPtr;
4912 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4913 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4914 resultObjPtr->refCount--;
4915 return resultObjPtr;
4917 return NULL;
4920 /* -----------------------------------------------------------------------------
4921 * CallFrame
4922 * ---------------------------------------------------------------------------*/
4924 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4926 Jim_CallFrame *cf;
4928 if (interp->freeFramesList) {
4929 cf = interp->freeFramesList;
4930 interp->freeFramesList = cf->next;
4932 cf->argv = NULL;
4933 cf->argc = 0;
4934 cf->procArgsObjPtr = NULL;
4935 cf->procBodyObjPtr = NULL;
4936 cf->next = NULL;
4937 cf->staticVars = NULL;
4938 cf->localCommands = NULL;
4939 cf->tailcallObj = NULL;
4940 cf->tailcallCmd = NULL;
4942 else {
4943 cf = Jim_Alloc(sizeof(*cf));
4944 memset(cf, 0, sizeof(*cf));
4946 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4949 cf->id = interp->callFrameEpoch++;
4950 cf->parent = parent;
4951 cf->level = parent ? parent->level + 1 : 0;
4952 cf->nsObj = nsObj;
4953 Jim_IncrRefCount(nsObj);
4955 return cf;
4958 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4960 /* Delete any local procs */
4961 if (localCommands) {
4962 Jim_Obj *cmdNameObj;
4964 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4965 Jim_HashEntry *he;
4966 Jim_Obj *fqObjName;
4967 Jim_HashTable *ht = &interp->commands;
4969 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4971 he = Jim_FindHashEntry(ht, fqname);
4973 if (he) {
4974 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4975 if (cmd->prevCmd) {
4976 Jim_Cmd *prevCmd = cmd->prevCmd;
4977 cmd->prevCmd = NULL;
4979 /* Delete the old command */
4980 JimDecrCmdRefCount(interp, cmd);
4982 /* And restore the original */
4983 Jim_SetHashVal(ht, he, prevCmd);
4985 else {
4986 Jim_DeleteHashEntry(ht, fqname);
4987 Jim_InterpIncrProcEpoch(interp);
4990 Jim_DecrRefCount(interp, cmdNameObj);
4991 JimFreeQualifiedName(interp, fqObjName);
4993 Jim_FreeStack(localCommands);
4994 Jim_Free(localCommands);
4996 return JIM_OK;
5000 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5001 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5002 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5004 JimDeleteLocalProcs(interp, cf->localCommands);
5006 if (cf->procArgsObjPtr)
5007 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5008 if (cf->procBodyObjPtr)
5009 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5010 Jim_DecrRefCount(interp, cf->nsObj);
5011 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5012 Jim_FreeHashTable(&cf->vars);
5013 else {
5014 int i;
5015 Jim_HashEntry **table = cf->vars.table, *he;
5017 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5018 he = table[i];
5019 while (he != NULL) {
5020 Jim_HashEntry *nextEntry = he->next;
5021 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5023 Jim_DecrRefCount(interp, varPtr->objPtr);
5024 Jim_Free(Jim_GetHashEntryKey(he));
5025 Jim_Free(varPtr);
5026 Jim_Free(he);
5027 table[i] = NULL;
5028 he = nextEntry;
5031 cf->vars.used = 0;
5033 cf->next = interp->freeFramesList;
5034 interp->freeFramesList = cf;
5038 /* -----------------------------------------------------------------------------
5039 * References
5040 * ---------------------------------------------------------------------------*/
5041 #ifdef JIM_REFERENCES
5043 /* References HashTable Type.
5045 * Keys are unsigned long integers, dynamically allocated for now but in the
5046 * future it's worth to cache this 4 bytes objects. Values are pointers
5047 * to Jim_References. */
5048 static void JimReferencesHTValDestructor(void *interp, void *val)
5050 Jim_Reference *refPtr = (void *)val;
5052 Jim_DecrRefCount(interp, refPtr->objPtr);
5053 if (refPtr->finalizerCmdNamePtr != NULL) {
5054 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5056 Jim_Free(val);
5059 static unsigned int JimReferencesHTHashFunction(const void *key)
5061 /* Only the least significant bits are used. */
5062 const unsigned long *widePtr = key;
5063 unsigned int intValue = (unsigned int)*widePtr;
5065 return Jim_IntHashFunction(intValue);
5068 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5070 void *copy = Jim_Alloc(sizeof(unsigned long));
5072 JIM_NOTUSED(privdata);
5074 memcpy(copy, key, sizeof(unsigned long));
5075 return copy;
5078 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5080 JIM_NOTUSED(privdata);
5082 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5085 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5087 JIM_NOTUSED(privdata);
5089 Jim_Free(key);
5092 static const Jim_HashTableType JimReferencesHashTableType = {
5093 JimReferencesHTHashFunction, /* hash function */
5094 JimReferencesHTKeyDup, /* key dup */
5095 NULL, /* val dup */
5096 JimReferencesHTKeyCompare, /* key compare */
5097 JimReferencesHTKeyDestructor, /* key destructor */
5098 JimReferencesHTValDestructor /* val destructor */
5101 /* -----------------------------------------------------------------------------
5102 * Reference object type and References API
5103 * ---------------------------------------------------------------------------*/
5105 /* The string representation of references has two features in order
5106 * to make the GC faster. The first is that every reference starts
5107 * with a non common character '<', in order to make the string matching
5108 * faster. The second is that the reference string rep is 42 characters
5109 * in length, this means that it is not necessary to check any object with a string
5110 * repr < 42, and usually there aren't many of these objects. */
5112 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5114 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5116 const char *fmt = "<reference.<%s>.%020lu>";
5118 sprintf(buf, fmt, refPtr->tag, id);
5119 return JIM_REFERENCE_SPACE;
5122 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5124 static const Jim_ObjType referenceObjType = {
5125 "reference",
5126 NULL,
5127 NULL,
5128 UpdateStringOfReference,
5129 JIM_TYPE_REFERENCES,
5132 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5134 char buf[JIM_REFERENCE_SPACE + 1];
5136 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5137 JimSetStringBytes(objPtr, buf);
5140 /* returns true if 'c' is a valid reference tag character.
5141 * i.e. inside the range [_a-zA-Z0-9] */
5142 static int isrefchar(int c)
5144 return (c == '_' || isalnum(c));
5147 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5149 unsigned long value;
5150 int i, len;
5151 const char *str, *start, *end;
5152 char refId[21];
5153 Jim_Reference *refPtr;
5154 Jim_HashEntry *he;
5155 char *endptr;
5157 /* Get the string representation */
5158 str = Jim_GetString(objPtr, &len);
5159 /* Check if it looks like a reference */
5160 if (len < JIM_REFERENCE_SPACE)
5161 goto badformat;
5162 /* Trim spaces */
5163 start = str;
5164 end = str + len - 1;
5165 while (*start == ' ')
5166 start++;
5167 while (*end == ' ' && end > start)
5168 end--;
5169 if (end - start + 1 != JIM_REFERENCE_SPACE)
5170 goto badformat;
5171 /* <reference.<1234567>.%020> */
5172 if (memcmp(start, "<reference.<", 12) != 0)
5173 goto badformat;
5174 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5175 goto badformat;
5176 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5177 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5178 if (!isrefchar(start[12 + i]))
5179 goto badformat;
5181 /* Extract info from the reference. */
5182 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5183 refId[20] = '\0';
5184 /* Try to convert the ID into an unsigned long */
5185 value = strtoul(refId, &endptr, 10);
5186 if (JimCheckConversion(refId, endptr) != JIM_OK)
5187 goto badformat;
5188 /* Check if the reference really exists! */
5189 he = Jim_FindHashEntry(&interp->references, &value);
5190 if (he == NULL) {
5191 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5192 return JIM_ERR;
5194 refPtr = Jim_GetHashEntryVal(he);
5195 /* Free the old internal repr and set the new one. */
5196 Jim_FreeIntRep(interp, objPtr);
5197 objPtr->typePtr = &referenceObjType;
5198 objPtr->internalRep.refValue.id = value;
5199 objPtr->internalRep.refValue.refPtr = refPtr;
5200 return JIM_OK;
5202 badformat:
5203 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5204 return JIM_ERR;
5207 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5208 * as finalizer command (or NULL if there is no finalizer).
5209 * The returned reference object has refcount = 0. */
5210 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5212 struct Jim_Reference *refPtr;
5213 unsigned long id;
5214 Jim_Obj *refObjPtr;
5215 const char *tag;
5216 int tagLen, i;
5218 /* Perform the Garbage Collection if needed. */
5219 Jim_CollectIfNeeded(interp);
5221 refPtr = Jim_Alloc(sizeof(*refPtr));
5222 refPtr->objPtr = objPtr;
5223 Jim_IncrRefCount(objPtr);
5224 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5225 if (cmdNamePtr)
5226 Jim_IncrRefCount(cmdNamePtr);
5227 id = interp->referenceNextId++;
5228 Jim_AddHashEntry(&interp->references, &id, refPtr);
5229 refObjPtr = Jim_NewObj(interp);
5230 refObjPtr->typePtr = &referenceObjType;
5231 refObjPtr->bytes = NULL;
5232 refObjPtr->internalRep.refValue.id = id;
5233 refObjPtr->internalRep.refValue.refPtr = refPtr;
5234 interp->referenceNextId++;
5235 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5236 * that does not pass the 'isrefchar' test is replaced with '_' */
5237 tag = Jim_GetString(tagPtr, &tagLen);
5238 if (tagLen > JIM_REFERENCE_TAGLEN)
5239 tagLen = JIM_REFERENCE_TAGLEN;
5240 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5241 if (i < tagLen && isrefchar(tag[i]))
5242 refPtr->tag[i] = tag[i];
5243 else
5244 refPtr->tag[i] = '_';
5246 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5247 return refObjPtr;
5250 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5252 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5253 return NULL;
5254 return objPtr->internalRep.refValue.refPtr;
5257 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5259 Jim_Reference *refPtr;
5261 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5262 return JIM_ERR;
5263 Jim_IncrRefCount(cmdNamePtr);
5264 if (refPtr->finalizerCmdNamePtr)
5265 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5266 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5267 return JIM_OK;
5270 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5272 Jim_Reference *refPtr;
5274 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5275 return JIM_ERR;
5276 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5277 return JIM_OK;
5280 /* -----------------------------------------------------------------------------
5281 * References Garbage Collection
5282 * ---------------------------------------------------------------------------*/
5284 /* This the hash table type for the "MARK" phase of the GC */
5285 static const Jim_HashTableType JimRefMarkHashTableType = {
5286 JimReferencesHTHashFunction, /* hash function */
5287 JimReferencesHTKeyDup, /* key dup */
5288 NULL, /* val dup */
5289 JimReferencesHTKeyCompare, /* key compare */
5290 JimReferencesHTKeyDestructor, /* key destructor */
5291 NULL /* val destructor */
5294 /* Performs the garbage collection. */
5295 int Jim_Collect(Jim_Interp *interp)
5297 int collected = 0;
5298 #ifndef JIM_BOOTSTRAP
5299 Jim_HashTable marks;
5300 Jim_HashTableIterator htiter;
5301 Jim_HashEntry *he;
5302 Jim_Obj *objPtr;
5304 /* Avoid recursive calls */
5305 if (interp->lastCollectId == -1) {
5306 /* Jim_Collect() already running. Return just now. */
5307 return 0;
5309 interp->lastCollectId = -1;
5311 /* Mark all the references found into the 'mark' hash table.
5312 * The references are searched in every live object that
5313 * is of a type that can contain references. */
5314 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5315 objPtr = interp->liveList;
5316 while (objPtr) {
5317 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5318 const char *str, *p;
5319 int len;
5321 /* If the object is of type reference, to get the
5322 * Id is simple... */
5323 if (objPtr->typePtr == &referenceObjType) {
5324 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5325 #ifdef JIM_DEBUG_GC
5326 printf("MARK (reference): %d refcount: %d\n",
5327 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5328 #endif
5329 objPtr = objPtr->nextObjPtr;
5330 continue;
5332 /* Get the string repr of the object we want
5333 * to scan for references. */
5334 p = str = Jim_GetString(objPtr, &len);
5335 /* Skip objects too little to contain references. */
5336 if (len < JIM_REFERENCE_SPACE) {
5337 objPtr = objPtr->nextObjPtr;
5338 continue;
5340 /* Extract references from the object string repr. */
5341 while (1) {
5342 int i;
5343 unsigned long id;
5345 if ((p = strstr(p, "<reference.<")) == NULL)
5346 break;
5347 /* Check if it's a valid reference. */
5348 if (len - (p - str) < JIM_REFERENCE_SPACE)
5349 break;
5350 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5351 break;
5352 for (i = 21; i <= 40; i++)
5353 if (!isdigit(UCHAR(p[i])))
5354 break;
5355 /* Get the ID */
5356 id = strtoul(p + 21, NULL, 10);
5358 /* Ok, a reference for the given ID
5359 * was found. Mark it. */
5360 Jim_AddHashEntry(&marks, &id, NULL);
5361 #ifdef JIM_DEBUG_GC
5362 printf("MARK: %d\n", (int)id);
5363 #endif
5364 p += JIM_REFERENCE_SPACE;
5367 objPtr = objPtr->nextObjPtr;
5370 /* Run the references hash table to destroy every reference that
5371 * is not referenced outside (not present in the mark HT). */
5372 JimInitHashTableIterator(&interp->references, &htiter);
5373 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5374 const unsigned long *refId;
5375 Jim_Reference *refPtr;
5377 refId = he->key;
5378 /* Check if in the mark phase we encountered
5379 * this reference. */
5380 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5381 #ifdef JIM_DEBUG_GC
5382 printf("COLLECTING %d\n", (int)*refId);
5383 #endif
5384 collected++;
5385 /* Drop the reference, but call the
5386 * finalizer first if registered. */
5387 refPtr = Jim_GetHashEntryVal(he);
5388 if (refPtr->finalizerCmdNamePtr) {
5389 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5390 Jim_Obj *objv[3], *oldResult;
5392 JimFormatReference(refstr, refPtr, *refId);
5394 objv[0] = refPtr->finalizerCmdNamePtr;
5395 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5396 objv[2] = refPtr->objPtr;
5398 /* Drop the reference itself */
5399 /* Avoid the finaliser being freed here */
5400 Jim_IncrRefCount(objv[0]);
5401 /* Don't remove the reference from the hash table just yet
5402 * since that will free refPtr, and hence refPtr->objPtr
5405 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5406 oldResult = interp->result;
5407 Jim_IncrRefCount(oldResult);
5408 Jim_EvalObjVector(interp, 3, objv);
5409 Jim_SetResult(interp, oldResult);
5410 Jim_DecrRefCount(interp, oldResult);
5412 Jim_DecrRefCount(interp, objv[0]);
5414 Jim_DeleteHashEntry(&interp->references, refId);
5417 Jim_FreeHashTable(&marks);
5418 interp->lastCollectId = interp->referenceNextId;
5419 interp->lastCollectTime = time(NULL);
5420 #endif /* JIM_BOOTSTRAP */
5421 return collected;
5424 #define JIM_COLLECT_ID_PERIOD 5000
5425 #define JIM_COLLECT_TIME_PERIOD 300
5427 void Jim_CollectIfNeeded(Jim_Interp *interp)
5429 unsigned long elapsedId;
5430 int elapsedTime;
5432 elapsedId = interp->referenceNextId - interp->lastCollectId;
5433 elapsedTime = time(NULL) - interp->lastCollectTime;
5436 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5437 Jim_Collect(interp);
5440 #endif
5442 int Jim_IsBigEndian(void)
5444 union {
5445 unsigned short s;
5446 unsigned char c[2];
5447 } uval = {0x0102};
5449 return uval.c[0] == 1;
5452 /* -----------------------------------------------------------------------------
5453 * Interpreter related functions
5454 * ---------------------------------------------------------------------------*/
5456 Jim_Interp *Jim_CreateInterp(void)
5458 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5460 memset(i, 0, sizeof(*i));
5462 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5463 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5464 i->lastCollectTime = time(NULL);
5466 /* Note that we can create objects only after the
5467 * interpreter liveList and freeList pointers are
5468 * initialized to NULL. */
5469 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5470 #ifdef JIM_REFERENCES
5471 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5472 #endif
5473 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5474 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5475 i->emptyObj = Jim_NewEmptyStringObj(i);
5476 i->trueObj = Jim_NewIntObj(i, 1);
5477 i->falseObj = Jim_NewIntObj(i, 0);
5478 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5479 i->errorFileNameObj = i->emptyObj;
5480 i->result = i->emptyObj;
5481 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5482 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5483 i->errorProc = i->emptyObj;
5484 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5485 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5486 Jim_IncrRefCount(i->emptyObj);
5487 Jim_IncrRefCount(i->errorFileNameObj);
5488 Jim_IncrRefCount(i->result);
5489 Jim_IncrRefCount(i->stackTrace);
5490 Jim_IncrRefCount(i->unknown);
5491 Jim_IncrRefCount(i->currentScriptObj);
5492 Jim_IncrRefCount(i->nullScriptObj);
5493 Jim_IncrRefCount(i->errorProc);
5494 Jim_IncrRefCount(i->trueObj);
5495 Jim_IncrRefCount(i->falseObj);
5497 /* Initialize key variables every interpreter should contain */
5498 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5499 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5501 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5502 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5503 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5504 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5505 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5506 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5507 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5508 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5510 return i;
5513 void Jim_FreeInterp(Jim_Interp *i)
5515 Jim_CallFrame *cf, *cfx;
5517 Jim_Obj *objPtr, *nextObjPtr;
5519 /* Free the active call frames list - must be done before i->commands is destroyed */
5520 for (cf = i->framePtr; cf; cf = cfx) {
5521 cfx = cf->parent;
5522 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5525 Jim_DecrRefCount(i, i->emptyObj);
5526 Jim_DecrRefCount(i, i->trueObj);
5527 Jim_DecrRefCount(i, i->falseObj);
5528 Jim_DecrRefCount(i, i->result);
5529 Jim_DecrRefCount(i, i->stackTrace);
5530 Jim_DecrRefCount(i, i->errorProc);
5531 Jim_DecrRefCount(i, i->unknown);
5532 Jim_DecrRefCount(i, i->errorFileNameObj);
5533 Jim_DecrRefCount(i, i->currentScriptObj);
5534 Jim_DecrRefCount(i, i->nullScriptObj);
5535 Jim_FreeHashTable(&i->commands);
5536 #ifdef JIM_REFERENCES
5537 Jim_FreeHashTable(&i->references);
5538 #endif
5539 Jim_FreeHashTable(&i->packages);
5540 Jim_Free(i->prngState);
5541 Jim_FreeHashTable(&i->assocData);
5543 /* Check that the live object list is empty, otherwise
5544 * there is a memory leak. */
5545 #ifdef JIM_MAINTAINER
5546 if (i->liveList != NULL) {
5547 objPtr = i->liveList;
5549 printf("\n-------------------------------------\n");
5550 printf("Objects still in the free list:\n");
5551 while (objPtr) {
5552 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5554 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5555 printf("%p (%d) %-10s: '%.20s...'\n",
5556 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5558 else {
5559 printf("%p (%d) %-10s: '%s'\n",
5560 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5562 if (objPtr->typePtr == &sourceObjType) {
5563 printf("FILE %s LINE %d\n",
5564 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5565 objPtr->internalRep.sourceValue.lineNumber);
5567 objPtr = objPtr->nextObjPtr;
5569 printf("-------------------------------------\n\n");
5570 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5572 #endif
5574 /* Free all the freed objects. */
5575 objPtr = i->freeList;
5576 while (objPtr) {
5577 nextObjPtr = objPtr->nextObjPtr;
5578 Jim_Free(objPtr);
5579 objPtr = nextObjPtr;
5582 /* Free the free call frames list */
5583 for (cf = i->freeFramesList; cf; cf = cfx) {
5584 cfx = cf->next;
5585 if (cf->vars.table)
5586 Jim_FreeHashTable(&cf->vars);
5587 Jim_Free(cf);
5590 /* Free the interpreter structure. */
5591 Jim_Free(i);
5594 /* Returns the call frame relative to the level represented by
5595 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5597 * This function accepts the 'level' argument in the form
5598 * of the commands [uplevel] and [upvar].
5600 * Returns NULL on error.
5602 * Note: for a function accepting a relative integer as level suitable
5603 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5605 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5607 long level;
5608 const char *str;
5609 Jim_CallFrame *framePtr;
5611 if (levelObjPtr) {
5612 str = Jim_String(levelObjPtr);
5613 if (str[0] == '#') {
5614 char *endptr;
5616 level = jim_strtol(str + 1, &endptr);
5617 if (str[1] == '\0' || endptr[0] != '\0') {
5618 level = -1;
5621 else {
5622 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5623 level = -1;
5625 else {
5626 /* Convert from a relative to an absolute level */
5627 level = interp->framePtr->level - level;
5631 else {
5632 str = "1"; /* Needed to format the error message. */
5633 level = interp->framePtr->level - 1;
5636 if (level == 0) {
5637 return interp->topFramePtr;
5639 if (level > 0) {
5640 /* Lookup */
5641 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5642 if (framePtr->level == level) {
5643 return framePtr;
5648 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5649 return NULL;
5652 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5653 * as a relative integer like in the [info level ?level?] command.
5655 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5657 long level;
5658 Jim_CallFrame *framePtr;
5660 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5661 if (level <= 0) {
5662 /* Convert from a relative to an absolute level */
5663 level = interp->framePtr->level + level;
5666 if (level == 0) {
5667 return interp->topFramePtr;
5670 /* Lookup */
5671 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5672 if (framePtr->level == level) {
5673 return framePtr;
5678 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5679 return NULL;
5682 static void JimResetStackTrace(Jim_Interp *interp)
5684 Jim_DecrRefCount(interp, interp->stackTrace);
5685 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5686 Jim_IncrRefCount(interp->stackTrace);
5689 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5691 int len;
5693 /* Increment reference first in case these are the same object */
5694 Jim_IncrRefCount(stackTraceObj);
5695 Jim_DecrRefCount(interp, interp->stackTrace);
5696 interp->stackTrace = stackTraceObj;
5697 interp->errorFlag = 1;
5699 /* This is a bit ugly.
5700 * If the filename of the last entry of the stack trace is empty,
5701 * the next stack level should be added.
5703 len = Jim_ListLength(interp, interp->stackTrace);
5704 if (len >= 3) {
5705 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5706 interp->addStackTrace = 1;
5711 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5712 Jim_Obj *fileNameObj, int linenr)
5714 if (strcmp(procname, "unknown") == 0) {
5715 procname = "";
5717 if (!*procname && !Jim_Length(fileNameObj)) {
5718 /* No useful info here */
5719 return;
5722 if (Jim_IsShared(interp->stackTrace)) {
5723 Jim_DecrRefCount(interp, interp->stackTrace);
5724 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5725 Jim_IncrRefCount(interp->stackTrace);
5728 /* If we have no procname but the previous element did, merge with that frame */
5729 if (!*procname && Jim_Length(fileNameObj)) {
5730 /* Just a filename. Check the previous entry */
5731 int len = Jim_ListLength(interp, interp->stackTrace);
5733 if (len >= 3) {
5734 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5735 if (Jim_Length(objPtr)) {
5736 /* Yes, the previous level had procname */
5737 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5738 if (Jim_Length(objPtr) == 0) {
5739 /* But no filename, so merge the new info with that frame */
5740 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5741 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5742 return;
5748 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5749 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5750 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5753 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5754 void *data)
5756 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5758 assocEntryPtr->delProc = delProc;
5759 assocEntryPtr->data = data;
5760 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5763 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5765 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5767 if (entryPtr != NULL) {
5768 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5769 return assocEntryPtr->data;
5771 return NULL;
5774 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5776 return Jim_DeleteHashEntry(&interp->assocData, key);
5779 int Jim_GetExitCode(Jim_Interp *interp)
5781 return interp->exitCode;
5784 /* -----------------------------------------------------------------------------
5785 * Integer object
5786 * ---------------------------------------------------------------------------*/
5787 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5788 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5790 static const Jim_ObjType intObjType = {
5791 "int",
5792 NULL,
5793 NULL,
5794 UpdateStringOfInt,
5795 JIM_TYPE_NONE,
5798 /* A coerced double is closer to an int than a double.
5799 * It is an int value temporarily masquerading as a double value.
5800 * i.e. it has the same string value as an int and Jim_GetWide()
5801 * succeeds, but also Jim_GetDouble() returns the value directly.
5803 static const Jim_ObjType coercedDoubleObjType = {
5804 "coerced-double",
5805 NULL,
5806 NULL,
5807 UpdateStringOfInt,
5808 JIM_TYPE_NONE,
5812 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5814 char buf[JIM_INTEGER_SPACE + 1];
5815 jim_wide wideValue = JimWideValue(objPtr);
5816 int pos = 0;
5818 if (wideValue == 0) {
5819 buf[pos++] = '0';
5821 else {
5822 char tmp[JIM_INTEGER_SPACE];
5823 int num = 0;
5824 int i;
5826 if (wideValue < 0) {
5827 buf[pos++] = '-';
5828 i = wideValue % 10;
5829 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5830 * whereas C99 is always -6
5831 * coverity[dead_error_line]
5833 tmp[num++] = (i > 0) ? (10 - i) : -i;
5834 wideValue /= -10;
5837 while (wideValue) {
5838 tmp[num++] = wideValue % 10;
5839 wideValue /= 10;
5842 for (i = 0; i < num; i++) {
5843 buf[pos++] = '0' + tmp[num - i - 1];
5846 buf[pos] = 0;
5848 JimSetStringBytes(objPtr, buf);
5851 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5853 jim_wide wideValue;
5854 const char *str;
5856 if (objPtr->typePtr == &coercedDoubleObjType) {
5857 /* Simple switch */
5858 objPtr->typePtr = &intObjType;
5859 return JIM_OK;
5862 /* Get the string representation */
5863 str = Jim_String(objPtr);
5864 /* Try to convert into a jim_wide */
5865 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5866 if (flags & JIM_ERRMSG) {
5867 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5869 return JIM_ERR;
5871 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5872 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5873 return JIM_ERR;
5875 /* Free the old internal repr and set the new one. */
5876 Jim_FreeIntRep(interp, objPtr);
5877 objPtr->typePtr = &intObjType;
5878 objPtr->internalRep.wideValue = wideValue;
5879 return JIM_OK;
5882 #ifdef JIM_OPTIMIZATION
5883 static int JimIsWide(Jim_Obj *objPtr)
5885 return objPtr->typePtr == &intObjType;
5887 #endif
5889 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5891 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5892 return JIM_ERR;
5893 *widePtr = JimWideValue(objPtr);
5894 return JIM_OK;
5897 /* Get a wide but does not set an error if the format is bad. */
5898 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5900 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5901 return JIM_ERR;
5902 *widePtr = JimWideValue(objPtr);
5903 return JIM_OK;
5906 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5908 jim_wide wideValue;
5909 int retval;
5911 retval = Jim_GetWide(interp, objPtr, &wideValue);
5912 if (retval == JIM_OK) {
5913 *longPtr = (long)wideValue;
5914 return JIM_OK;
5916 return JIM_ERR;
5919 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5921 Jim_Obj *objPtr;
5923 objPtr = Jim_NewObj(interp);
5924 objPtr->typePtr = &intObjType;
5925 objPtr->bytes = NULL;
5926 objPtr->internalRep.wideValue = wideValue;
5927 return objPtr;
5930 /* -----------------------------------------------------------------------------
5931 * Double object
5932 * ---------------------------------------------------------------------------*/
5933 #define JIM_DOUBLE_SPACE 30
5935 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5936 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5938 static const Jim_ObjType doubleObjType = {
5939 "double",
5940 NULL,
5941 NULL,
5942 UpdateStringOfDouble,
5943 JIM_TYPE_NONE,
5946 #ifndef HAVE_ISNAN
5947 #undef isnan
5948 #define isnan(X) ((X) != (X))
5949 #endif
5950 #ifndef HAVE_ISINF
5951 #undef isinf
5952 #define isinf(X) (1.0 / (X) == 0.0)
5953 #endif
5955 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5957 double value = objPtr->internalRep.doubleValue;
5959 if (isnan(value)) {
5960 JimSetStringBytes(objPtr, "NaN");
5961 return;
5963 if (isinf(value)) {
5964 if (value < 0) {
5965 JimSetStringBytes(objPtr, "-Inf");
5967 else {
5968 JimSetStringBytes(objPtr, "Inf");
5970 return;
5973 char buf[JIM_DOUBLE_SPACE + 1];
5974 int i;
5975 int len = sprintf(buf, "%.12g", value);
5977 /* Add a final ".0" if necessary */
5978 for (i = 0; i < len; i++) {
5979 if (buf[i] == '.' || buf[i] == 'e') {
5980 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5981 /* If 'buf' ends in e-0nn or e+0nn, remove
5982 * the 0 after the + or - and reduce the length by 1
5984 char *e = strchr(buf, 'e');
5985 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5986 /* Move it up */
5987 e += 2;
5988 memmove(e, e + 1, len - (e - buf));
5990 #endif
5991 break;
5994 if (buf[i] == '\0') {
5995 buf[i++] = '.';
5996 buf[i++] = '0';
5997 buf[i] = '\0';
5999 JimSetStringBytes(objPtr, buf);
6003 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6005 double doubleValue;
6006 jim_wide wideValue;
6007 const char *str;
6009 /* Preserve the string representation.
6010 * Needed so we can convert back to int without loss
6012 str = Jim_String(objPtr);
6014 #ifdef HAVE_LONG_LONG
6015 /* Assume a 53 bit mantissa */
6016 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6017 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6019 if (objPtr->typePtr == &intObjType
6020 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6021 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6023 /* Direct conversion to coerced double */
6024 objPtr->typePtr = &coercedDoubleObjType;
6025 return JIM_OK;
6027 else
6028 #endif
6029 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6030 /* Managed to convert to an int, so we can use this as a cooerced double */
6031 Jim_FreeIntRep(interp, objPtr);
6032 objPtr->typePtr = &coercedDoubleObjType;
6033 objPtr->internalRep.wideValue = wideValue;
6034 return JIM_OK;
6036 else {
6037 /* Try to convert into a double */
6038 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6039 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6040 return JIM_ERR;
6042 /* Free the old internal repr and set the new one. */
6043 Jim_FreeIntRep(interp, objPtr);
6045 objPtr->typePtr = &doubleObjType;
6046 objPtr->internalRep.doubleValue = doubleValue;
6047 return JIM_OK;
6050 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6052 if (objPtr->typePtr == &coercedDoubleObjType) {
6053 *doublePtr = JimWideValue(objPtr);
6054 return JIM_OK;
6056 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6057 return JIM_ERR;
6059 if (objPtr->typePtr == &coercedDoubleObjType) {
6060 *doublePtr = JimWideValue(objPtr);
6062 else {
6063 *doublePtr = objPtr->internalRep.doubleValue;
6065 return JIM_OK;
6068 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6070 Jim_Obj *objPtr;
6072 objPtr = Jim_NewObj(interp);
6073 objPtr->typePtr = &doubleObjType;
6074 objPtr->bytes = NULL;
6075 objPtr->internalRep.doubleValue = doubleValue;
6076 return objPtr;
6079 /* -----------------------------------------------------------------------------
6080 * Boolean conversion
6081 * ---------------------------------------------------------------------------*/
6082 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6084 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6086 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6087 return JIM_ERR;
6088 *booleanPtr = (int) JimWideValue(objPtr);
6089 return JIM_OK;
6092 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6094 static const char * const falses[] = {
6095 "0", "false", "no", "off", NULL
6097 static const char * const trues[] = {
6098 "1", "true", "yes", "on", NULL
6101 int boolean;
6103 int index;
6104 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6105 boolean = 0;
6106 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6107 boolean = 1;
6108 } else {
6109 if (flags & JIM_ERRMSG) {
6110 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6112 return JIM_ERR;
6115 /* Free the old internal repr and set the new one. */
6116 Jim_FreeIntRep(interp, objPtr);
6117 objPtr->typePtr = &intObjType;
6118 objPtr->internalRep.wideValue = boolean;
6119 return JIM_OK;
6122 /* -----------------------------------------------------------------------------
6123 * List object
6124 * ---------------------------------------------------------------------------*/
6125 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6126 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6127 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6128 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6129 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6130 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6132 /* Note that while the elements of the list may contain references,
6133 * the list object itself can't. This basically means that the
6134 * list object string representation as a whole can't contain references
6135 * that are not presents in the single elements. */
6136 static const Jim_ObjType listObjType = {
6137 "list",
6138 FreeListInternalRep,
6139 DupListInternalRep,
6140 UpdateStringOfList,
6141 JIM_TYPE_NONE,
6144 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6146 int i;
6148 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6149 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6151 Jim_Free(objPtr->internalRep.listValue.ele);
6154 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6156 int i;
6158 JIM_NOTUSED(interp);
6160 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6161 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6162 dupPtr->internalRep.listValue.ele =
6163 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6164 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6165 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6166 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6167 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6169 dupPtr->typePtr = &listObjType;
6172 /* The following function checks if a given string can be encoded
6173 * into a list element without any kind of quoting, surrounded by braces,
6174 * or using escapes to quote. */
6175 #define JIM_ELESTR_SIMPLE 0
6176 #define JIM_ELESTR_BRACE 1
6177 #define JIM_ELESTR_QUOTE 2
6178 static unsigned char ListElementQuotingType(const char *s, int len)
6180 int i, level, blevel, trySimple = 1;
6182 /* Try with the SIMPLE case */
6183 if (len == 0)
6184 return JIM_ELESTR_BRACE;
6185 if (s[0] == '"' || s[0] == '{') {
6186 trySimple = 0;
6187 goto testbrace;
6189 for (i = 0; i < len; i++) {
6190 switch (s[i]) {
6191 case ' ':
6192 case '$':
6193 case '"':
6194 case '[':
6195 case ']':
6196 case ';':
6197 case '\\':
6198 case '\r':
6199 case '\n':
6200 case '\t':
6201 case '\f':
6202 case '\v':
6203 trySimple = 0;
6204 /* fall through */
6205 case '{':
6206 case '}':
6207 goto testbrace;
6210 return JIM_ELESTR_SIMPLE;
6212 testbrace:
6213 /* Test if it's possible to do with braces */
6214 if (s[len - 1] == '\\')
6215 return JIM_ELESTR_QUOTE;
6216 level = 0;
6217 blevel = 0;
6218 for (i = 0; i < len; i++) {
6219 switch (s[i]) {
6220 case '{':
6221 level++;
6222 break;
6223 case '}':
6224 level--;
6225 if (level < 0)
6226 return JIM_ELESTR_QUOTE;
6227 break;
6228 case '[':
6229 blevel++;
6230 break;
6231 case ']':
6232 blevel--;
6233 break;
6234 case '\\':
6235 if (s[i + 1] == '\n')
6236 return JIM_ELESTR_QUOTE;
6237 else if (s[i + 1] != '\0')
6238 i++;
6239 break;
6242 if (blevel < 0) {
6243 return JIM_ELESTR_QUOTE;
6246 if (level == 0) {
6247 if (!trySimple)
6248 return JIM_ELESTR_BRACE;
6249 for (i = 0; i < len; i++) {
6250 switch (s[i]) {
6251 case ' ':
6252 case '$':
6253 case '"':
6254 case '[':
6255 case ']':
6256 case ';':
6257 case '\\':
6258 case '\r':
6259 case '\n':
6260 case '\t':
6261 case '\f':
6262 case '\v':
6263 return JIM_ELESTR_BRACE;
6264 break;
6267 return JIM_ELESTR_SIMPLE;
6269 return JIM_ELESTR_QUOTE;
6272 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6273 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6274 * scenario.
6275 * Returns the length of the result.
6277 static int BackslashQuoteString(const char *s, int len, char *q)
6279 char *p = q;
6281 while (len--) {
6282 switch (*s) {
6283 case ' ':
6284 case '$':
6285 case '"':
6286 case '[':
6287 case ']':
6288 case '{':
6289 case '}':
6290 case ';':
6291 case '\\':
6292 *p++ = '\\';
6293 *p++ = *s++;
6294 break;
6295 case '\n':
6296 *p++ = '\\';
6297 *p++ = 'n';
6298 s++;
6299 break;
6300 case '\r':
6301 *p++ = '\\';
6302 *p++ = 'r';
6303 s++;
6304 break;
6305 case '\t':
6306 *p++ = '\\';
6307 *p++ = 't';
6308 s++;
6309 break;
6310 case '\f':
6311 *p++ = '\\';
6312 *p++ = 'f';
6313 s++;
6314 break;
6315 case '\v':
6316 *p++ = '\\';
6317 *p++ = 'v';
6318 s++;
6319 break;
6320 default:
6321 *p++ = *s++;
6322 break;
6325 *p = '\0';
6327 return p - q;
6330 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6332 #define STATIC_QUOTING_LEN 32
6333 int i, bufLen, realLength;
6334 const char *strRep;
6335 char *p;
6336 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6338 /* Estimate the space needed. */
6339 if (objc > STATIC_QUOTING_LEN) {
6340 quotingType = Jim_Alloc(objc);
6342 else {
6343 quotingType = staticQuoting;
6345 bufLen = 0;
6346 for (i = 0; i < objc; i++) {
6347 int len;
6349 strRep = Jim_GetString(objv[i], &len);
6350 quotingType[i] = ListElementQuotingType(strRep, len);
6351 switch (quotingType[i]) {
6352 case JIM_ELESTR_SIMPLE:
6353 if (i != 0 || strRep[0] != '#') {
6354 bufLen += len;
6355 break;
6357 /* Special case '#' on first element needs braces */
6358 quotingType[i] = JIM_ELESTR_BRACE;
6359 /* fall through */
6360 case JIM_ELESTR_BRACE:
6361 bufLen += len + 2;
6362 break;
6363 case JIM_ELESTR_QUOTE:
6364 bufLen += len * 2;
6365 break;
6367 bufLen++; /* elements separator. */
6369 bufLen++;
6371 /* Generate the string rep. */
6372 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6373 realLength = 0;
6374 for (i = 0; i < objc; i++) {
6375 int len, qlen;
6377 strRep = Jim_GetString(objv[i], &len);
6379 switch (quotingType[i]) {
6380 case JIM_ELESTR_SIMPLE:
6381 memcpy(p, strRep, len);
6382 p += len;
6383 realLength += len;
6384 break;
6385 case JIM_ELESTR_BRACE:
6386 *p++ = '{';
6387 memcpy(p, strRep, len);
6388 p += len;
6389 *p++ = '}';
6390 realLength += len + 2;
6391 break;
6392 case JIM_ELESTR_QUOTE:
6393 if (i == 0 && strRep[0] == '#') {
6394 *p++ = '\\';
6395 realLength++;
6397 qlen = BackslashQuoteString(strRep, len, p);
6398 p += qlen;
6399 realLength += qlen;
6400 break;
6402 /* Add a separating space */
6403 if (i + 1 != objc) {
6404 *p++ = ' ';
6405 realLength++;
6408 *p = '\0'; /* nul term. */
6409 objPtr->length = realLength;
6411 if (quotingType != staticQuoting) {
6412 Jim_Free(quotingType);
6416 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6418 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6421 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6423 struct JimParserCtx parser;
6424 const char *str;
6425 int strLen;
6426 Jim_Obj *fileNameObj;
6427 int linenr;
6429 if (objPtr->typePtr == &listObjType) {
6430 return JIM_OK;
6433 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6434 * it also preserves any source location of the dict elements
6435 * which can be very useful
6437 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6438 Jim_Obj **listObjPtrPtr;
6439 int len;
6440 int i;
6442 listObjPtrPtr = JimDictPairs(objPtr, &len);
6443 for (i = 0; i < len; i++) {
6444 Jim_IncrRefCount(listObjPtrPtr[i]);
6447 /* Now just switch the internal rep */
6448 Jim_FreeIntRep(interp, objPtr);
6449 objPtr->typePtr = &listObjType;
6450 objPtr->internalRep.listValue.len = len;
6451 objPtr->internalRep.listValue.maxLen = len;
6452 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6454 return JIM_OK;
6457 /* Try to preserve information about filename / line number */
6458 if (objPtr->typePtr == &sourceObjType) {
6459 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6460 linenr = objPtr->internalRep.sourceValue.lineNumber;
6462 else {
6463 fileNameObj = interp->emptyObj;
6464 linenr = 1;
6466 Jim_IncrRefCount(fileNameObj);
6468 /* Get the string representation */
6469 str = Jim_GetString(objPtr, &strLen);
6471 /* Free the old internal repr just now and initialize the
6472 * new one just now. The string->list conversion can't fail. */
6473 Jim_FreeIntRep(interp, objPtr);
6474 objPtr->typePtr = &listObjType;
6475 objPtr->internalRep.listValue.len = 0;
6476 objPtr->internalRep.listValue.maxLen = 0;
6477 objPtr->internalRep.listValue.ele = NULL;
6479 /* Convert into a list */
6480 if (strLen) {
6481 JimParserInit(&parser, str, strLen, linenr);
6482 while (!parser.eof) {
6483 Jim_Obj *elementPtr;
6485 JimParseList(&parser);
6486 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6487 continue;
6488 elementPtr = JimParserGetTokenObj(interp, &parser);
6489 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6490 ListAppendElement(objPtr, elementPtr);
6493 Jim_DecrRefCount(interp, fileNameObj);
6494 return JIM_OK;
6497 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6499 Jim_Obj *objPtr;
6501 objPtr = Jim_NewObj(interp);
6502 objPtr->typePtr = &listObjType;
6503 objPtr->bytes = NULL;
6504 objPtr->internalRep.listValue.ele = NULL;
6505 objPtr->internalRep.listValue.len = 0;
6506 objPtr->internalRep.listValue.maxLen = 0;
6508 if (len) {
6509 ListInsertElements(objPtr, 0, len, elements);
6512 return objPtr;
6515 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6516 * length of the vector. Note that the user of this function should make
6517 * sure that the list object can't shimmer while the vector returned
6518 * is in use, this vector is the one stored inside the internal representation
6519 * of the list object. This function is not exported, extensions should
6520 * always access to the List object elements using Jim_ListIndex(). */
6521 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6522 Jim_Obj ***listVec)
6524 *listLen = Jim_ListLength(interp, listObj);
6525 *listVec = listObj->internalRep.listValue.ele;
6528 /* Sorting uses ints, but commands may return wide */
6529 static int JimSign(jim_wide w)
6531 if (w == 0) {
6532 return 0;
6534 else if (w < 0) {
6535 return -1;
6537 return 1;
6540 /* ListSortElements type values */
6541 struct lsort_info {
6542 jmp_buf jmpbuf;
6543 Jim_Obj *command;
6544 Jim_Interp *interp;
6545 enum {
6546 JIM_LSORT_ASCII,
6547 JIM_LSORT_NOCASE,
6548 JIM_LSORT_INTEGER,
6549 JIM_LSORT_REAL,
6550 JIM_LSORT_COMMAND
6551 } type;
6552 int order;
6553 int index;
6554 int indexed;
6555 int unique;
6556 int (*subfn)(Jim_Obj **, Jim_Obj **);
6559 static struct lsort_info *sort_info;
6561 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6563 Jim_Obj *lObj, *rObj;
6565 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6566 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6567 longjmp(sort_info->jmpbuf, JIM_ERR);
6569 return sort_info->subfn(&lObj, &rObj);
6572 /* Sort the internal rep of a list. */
6573 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6575 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6578 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6580 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6583 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6585 jim_wide lhs = 0, rhs = 0;
6587 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6588 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6589 longjmp(sort_info->jmpbuf, JIM_ERR);
6592 return JimSign(lhs - rhs) * sort_info->order;
6595 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6597 double lhs = 0, rhs = 0;
6599 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6600 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6601 longjmp(sort_info->jmpbuf, JIM_ERR);
6603 if (lhs == rhs) {
6604 return 0;
6606 if (lhs > rhs) {
6607 return sort_info->order;
6609 return -sort_info->order;
6612 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6614 Jim_Obj *compare_script;
6615 int rc;
6617 jim_wide ret = 0;
6619 /* This must be a valid list */
6620 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6621 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6622 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6624 rc = Jim_EvalObj(sort_info->interp, compare_script);
6626 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6627 longjmp(sort_info->jmpbuf, rc);
6630 return JimSign(ret) * sort_info->order;
6633 /* Remove duplicate elements from the (sorted) list in-place, according to the
6634 * comparison function, comp.
6636 * Note that the last unique value is kept, not the first
6638 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6640 int src;
6641 int dst = 0;
6642 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6644 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6645 if (comp(&ele[dst], &ele[src]) == 0) {
6646 /* Match, so replace the dest with the current source */
6647 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6649 else {
6650 /* No match, so keep the current source and move to the next destination */
6651 dst++;
6653 ele[dst] = ele[src];
6655 /* At end of list, keep the final element */
6656 ele[++dst] = ele[src];
6658 /* Set the new length */
6659 listObjPtr->internalRep.listValue.len = dst;
6662 /* Sort a list *in place*. MUST be called with a non-shared list. */
6663 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6665 struct lsort_info *prev_info;
6667 typedef int (qsort_comparator) (const void *, const void *);
6668 int (*fn) (Jim_Obj **, Jim_Obj **);
6669 Jim_Obj **vector;
6670 int len;
6671 int rc;
6673 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6674 SetListFromAny(interp, listObjPtr);
6676 /* Allow lsort to be called reentrantly */
6677 prev_info = sort_info;
6678 sort_info = info;
6680 vector = listObjPtr->internalRep.listValue.ele;
6681 len = listObjPtr->internalRep.listValue.len;
6682 switch (info->type) {
6683 case JIM_LSORT_ASCII:
6684 fn = ListSortString;
6685 break;
6686 case JIM_LSORT_NOCASE:
6687 fn = ListSortStringNoCase;
6688 break;
6689 case JIM_LSORT_INTEGER:
6690 fn = ListSortInteger;
6691 break;
6692 case JIM_LSORT_REAL:
6693 fn = ListSortReal;
6694 break;
6695 case JIM_LSORT_COMMAND:
6696 fn = ListSortCommand;
6697 break;
6698 default:
6699 fn = NULL; /* avoid warning */
6700 JimPanic((1, "ListSort called with invalid sort type"));
6701 return -1; /* Should not be run but keeps static analysers happy */
6704 if (info->indexed) {
6705 /* Need to interpose a "list index" function */
6706 info->subfn = fn;
6707 fn = ListSortIndexHelper;
6710 if ((rc = setjmp(info->jmpbuf)) == 0) {
6711 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6713 if (info->unique && len > 1) {
6714 ListRemoveDuplicates(listObjPtr, fn);
6717 Jim_InvalidateStringRep(listObjPtr);
6719 sort_info = prev_info;
6721 return rc;
6724 /* This is the low-level function to insert elements into a list.
6725 * The higher-level Jim_ListInsertElements() performs shared object
6726 * check and invalidates the string repr. This version is used
6727 * in the internals of the List Object and is not exported.
6729 * NOTE: this function can be called only against objects
6730 * with internal type of List.
6732 * An insertion point (idx) of -1 means end-of-list.
6734 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6736 int currentLen = listPtr->internalRep.listValue.len;
6737 int requiredLen = currentLen + elemc;
6738 int i;
6739 Jim_Obj **point;
6741 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6742 if (requiredLen < 2) {
6743 /* Don't do allocations of under 4 pointers. */
6744 requiredLen = 4;
6746 else {
6747 requiredLen *= 2;
6750 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6751 sizeof(Jim_Obj *) * requiredLen);
6753 listPtr->internalRep.listValue.maxLen = requiredLen;
6755 if (idx < 0) {
6756 idx = currentLen;
6758 point = listPtr->internalRep.listValue.ele + idx;
6759 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6760 for (i = 0; i < elemc; ++i) {
6761 point[i] = elemVec[i];
6762 Jim_IncrRefCount(point[i]);
6764 listPtr->internalRep.listValue.len += elemc;
6767 /* Convenience call to ListInsertElements() to append a single element.
6769 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6771 ListInsertElements(listPtr, -1, 1, &objPtr);
6774 /* Appends every element of appendListPtr into listPtr.
6775 * Both have to be of the list type.
6776 * Convenience call to ListInsertElements()
6778 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6780 ListInsertElements(listPtr, -1,
6781 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6784 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6786 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6787 SetListFromAny(interp, listPtr);
6788 Jim_InvalidateStringRep(listPtr);
6789 ListAppendElement(listPtr, objPtr);
6792 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6794 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6795 SetListFromAny(interp, listPtr);
6796 SetListFromAny(interp, appendListPtr);
6797 Jim_InvalidateStringRep(listPtr);
6798 ListAppendList(listPtr, appendListPtr);
6801 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6803 SetListFromAny(interp, objPtr);
6804 return objPtr->internalRep.listValue.len;
6807 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6808 int objc, Jim_Obj *const *objVec)
6810 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6811 SetListFromAny(interp, listPtr);
6812 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6813 idx = listPtr->internalRep.listValue.len;
6814 else if (idx < 0)
6815 idx = 0;
6816 Jim_InvalidateStringRep(listPtr);
6817 ListInsertElements(listPtr, idx, objc, objVec);
6820 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6822 SetListFromAny(interp, listPtr);
6823 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6824 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6825 return NULL;
6827 if (idx < 0)
6828 idx = listPtr->internalRep.listValue.len + idx;
6829 return listPtr->internalRep.listValue.ele[idx];
6832 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6834 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6835 if (*objPtrPtr == NULL) {
6836 if (flags & JIM_ERRMSG) {
6837 Jim_SetResultString(interp, "list index out of range", -1);
6839 return JIM_ERR;
6841 return JIM_OK;
6844 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6845 Jim_Obj *newObjPtr, int flags)
6847 SetListFromAny(interp, listPtr);
6848 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6849 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6850 if (flags & JIM_ERRMSG) {
6851 Jim_SetResultString(interp, "list index out of range", -1);
6853 return JIM_ERR;
6855 if (idx < 0)
6856 idx = listPtr->internalRep.listValue.len + idx;
6857 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6858 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6859 Jim_IncrRefCount(newObjPtr);
6860 return JIM_OK;
6863 /* Modify the list stored in the variable named 'varNamePtr'
6864 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6865 * with the new element 'newObjptr'. (implements the [lset] command) */
6866 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6867 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6869 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6870 int shared, i, idx;
6872 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6873 if (objPtr == NULL)
6874 return JIM_ERR;
6875 if ((shared = Jim_IsShared(objPtr)))
6876 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6877 for (i = 0; i < indexc - 1; i++) {
6878 listObjPtr = objPtr;
6879 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6880 goto err;
6881 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6882 goto err;
6884 if (Jim_IsShared(objPtr)) {
6885 objPtr = Jim_DuplicateObj(interp, objPtr);
6886 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6888 Jim_InvalidateStringRep(listObjPtr);
6890 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6891 goto err;
6892 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6893 goto err;
6894 Jim_InvalidateStringRep(objPtr);
6895 Jim_InvalidateStringRep(varObjPtr);
6896 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6897 goto err;
6898 Jim_SetResult(interp, varObjPtr);
6899 return JIM_OK;
6900 err:
6901 if (shared) {
6902 Jim_FreeNewObj(interp, varObjPtr);
6904 return JIM_ERR;
6907 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6909 int i;
6910 int listLen = Jim_ListLength(interp, listObjPtr);
6911 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6913 for (i = 0; i < listLen; ) {
6914 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6915 if (++i != listLen) {
6916 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6919 return resObjPtr;
6922 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6924 int i;
6926 /* If all the objects in objv are lists,
6927 * it's possible to return a list as result, that's the
6928 * concatenation of all the lists. */
6929 for (i = 0; i < objc; i++) {
6930 if (!Jim_IsList(objv[i]))
6931 break;
6933 if (i == objc) {
6934 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6936 for (i = 0; i < objc; i++)
6937 ListAppendList(objPtr, objv[i]);
6938 return objPtr;
6940 else {
6941 /* Else... we have to glue strings together */
6942 int len = 0, objLen;
6943 char *bytes, *p;
6945 /* Compute the length */
6946 for (i = 0; i < objc; i++) {
6947 len += Jim_Length(objv[i]);
6949 if (objc)
6950 len += objc - 1;
6951 /* Create the string rep, and a string object holding it. */
6952 p = bytes = Jim_Alloc(len + 1);
6953 for (i = 0; i < objc; i++) {
6954 const char *s = Jim_GetString(objv[i], &objLen);
6956 /* Remove leading space */
6957 while (objLen && isspace(UCHAR(*s))) {
6958 s++;
6959 objLen--;
6960 len--;
6962 /* And trailing space */
6963 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6964 /* Handle trailing backslash-space case */
6965 if (objLen > 1 && s[objLen - 2] == '\\') {
6966 break;
6968 objLen--;
6969 len--;
6971 memcpy(p, s, objLen);
6972 p += objLen;
6973 if (i + 1 != objc) {
6974 if (objLen)
6975 *p++ = ' ';
6976 else {
6977 /* Drop the space calculated for this
6978 * element that is instead null. */
6979 len--;
6983 *p = '\0';
6984 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6988 /* Returns a list composed of the elements in the specified range.
6989 * first and start are directly accepted as Jim_Objects and
6990 * processed for the end?-index? case. */
6991 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6992 Jim_Obj *lastObjPtr)
6994 int first, last;
6995 int len, rangeLen;
6997 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6998 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6999 return NULL;
7000 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7001 first = JimRelToAbsIndex(len, first);
7002 last = JimRelToAbsIndex(len, last);
7003 JimRelToAbsRange(len, &first, &last, &rangeLen);
7004 if (first == 0 && last == len) {
7005 return listObjPtr;
7007 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7010 /* -----------------------------------------------------------------------------
7011 * Dict object
7012 * ---------------------------------------------------------------------------*/
7013 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7014 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7015 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7016 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7018 /* Dict HashTable Type.
7020 * Keys and Values are Jim objects. */
7022 static unsigned int JimObjectHTHashFunction(const void *key)
7024 int len;
7025 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7026 return Jim_GenHashFunction((const unsigned char *)str, len);
7029 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7031 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7034 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7036 Jim_IncrRefCount((Jim_Obj *)val);
7037 return (void *)val;
7040 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7042 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7045 static const Jim_HashTableType JimDictHashTableType = {
7046 JimObjectHTHashFunction, /* hash function */
7047 JimObjectHTKeyValDup, /* key dup */
7048 JimObjectHTKeyValDup, /* val dup */
7049 JimObjectHTKeyCompare, /* key compare */
7050 JimObjectHTKeyValDestructor, /* key destructor */
7051 JimObjectHTKeyValDestructor /* val destructor */
7054 /* Note that while the elements of the dict may contain references,
7055 * the list object itself can't. This basically means that the
7056 * dict object string representation as a whole can't contain references
7057 * that are not presents in the single elements. */
7058 static const Jim_ObjType dictObjType = {
7059 "dict",
7060 FreeDictInternalRep,
7061 DupDictInternalRep,
7062 UpdateStringOfDict,
7063 JIM_TYPE_NONE,
7066 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7068 JIM_NOTUSED(interp);
7070 Jim_FreeHashTable(objPtr->internalRep.ptr);
7071 Jim_Free(objPtr->internalRep.ptr);
7074 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7076 Jim_HashTable *ht, *dupHt;
7077 Jim_HashTableIterator htiter;
7078 Jim_HashEntry *he;
7080 /* Create a new hash table */
7081 ht = srcPtr->internalRep.ptr;
7082 dupHt = Jim_Alloc(sizeof(*dupHt));
7083 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7084 if (ht->size != 0)
7085 Jim_ExpandHashTable(dupHt, ht->size);
7086 /* Copy every element from the source to the dup hash table */
7087 JimInitHashTableIterator(ht, &htiter);
7088 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7089 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7092 dupPtr->internalRep.ptr = dupHt;
7093 dupPtr->typePtr = &dictObjType;
7096 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7098 Jim_HashTable *ht;
7099 Jim_HashTableIterator htiter;
7100 Jim_HashEntry *he;
7101 Jim_Obj **objv;
7102 int i;
7104 ht = dictPtr->internalRep.ptr;
7106 /* Turn the hash table into a flat vector of Jim_Objects. */
7107 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7108 JimInitHashTableIterator(ht, &htiter);
7109 i = 0;
7110 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7111 objv[i++] = Jim_GetHashEntryKey(he);
7112 objv[i++] = Jim_GetHashEntryVal(he);
7114 *len = i;
7115 return objv;
7118 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7120 /* Turn the hash table into a flat vector of Jim_Objects. */
7121 int len;
7122 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7124 /* And now generate the string rep as a list */
7125 JimMakeListStringRep(objPtr, objv, len);
7127 Jim_Free(objv);
7130 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7132 int listlen;
7134 if (objPtr->typePtr == &dictObjType) {
7135 return JIM_OK;
7138 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7139 /* A shared list, so get the string representation now to avoid
7140 * changing the order in case of fast conversion to dict.
7142 Jim_String(objPtr);
7145 /* For simplicity, convert a non-list object to a list and then to a dict */
7146 listlen = Jim_ListLength(interp, objPtr);
7147 if (listlen % 2) {
7148 Jim_SetResultString(interp, "missing value to go with key", -1);
7149 return JIM_ERR;
7151 else {
7152 /* Converting from a list to a dict can't fail */
7153 Jim_HashTable *ht;
7154 int i;
7156 ht = Jim_Alloc(sizeof(*ht));
7157 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7159 for (i = 0; i < listlen; i += 2) {
7160 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7161 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7163 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7166 Jim_FreeIntRep(interp, objPtr);
7167 objPtr->typePtr = &dictObjType;
7168 objPtr->internalRep.ptr = ht;
7170 return JIM_OK;
7174 /* Dict object API */
7176 /* Add an element to a dict. objPtr must be of the "dict" type.
7177 * The higher-level exported function is Jim_DictAddElement().
7178 * If an element with the specified key already exists, the value
7179 * associated is replaced with the new one.
7181 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7182 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7183 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7185 Jim_HashTable *ht = objPtr->internalRep.ptr;
7187 if (valueObjPtr == NULL) { /* unset */
7188 return Jim_DeleteHashEntry(ht, keyObjPtr);
7190 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7191 return JIM_OK;
7194 /* Add an element, higher-level interface for DictAddElement().
7195 * If valueObjPtr == NULL, the key is removed if it exists. */
7196 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7197 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7199 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7200 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7201 return JIM_ERR;
7203 Jim_InvalidateStringRep(objPtr);
7204 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7207 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7209 Jim_Obj *objPtr;
7210 int i;
7212 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7214 objPtr = Jim_NewObj(interp);
7215 objPtr->typePtr = &dictObjType;
7216 objPtr->bytes = NULL;
7217 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7218 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7219 for (i = 0; i < len; i += 2)
7220 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7221 return objPtr;
7224 /* Return the value associated to the specified dict key
7225 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7227 * Sets *objPtrPtr to non-NULL only upon success.
7229 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7230 Jim_Obj **objPtrPtr, int flags)
7232 Jim_HashEntry *he;
7233 Jim_HashTable *ht;
7235 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7236 return -1;
7238 ht = dictPtr->internalRep.ptr;
7239 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7240 if (flags & JIM_ERRMSG) {
7241 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7243 return JIM_ERR;
7245 *objPtrPtr = he->u.val;
7246 return JIM_OK;
7249 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7250 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7252 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7253 return JIM_ERR;
7255 *objPtrPtr = JimDictPairs(dictPtr, len);
7257 return JIM_OK;
7261 /* Return the value associated to the specified dict keys */
7262 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7263 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7265 int i;
7267 if (keyc == 0) {
7268 *objPtrPtr = dictPtr;
7269 return JIM_OK;
7272 for (i = 0; i < keyc; i++) {
7273 Jim_Obj *objPtr;
7275 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7276 if (rc != JIM_OK) {
7277 return rc;
7279 dictPtr = objPtr;
7281 *objPtrPtr = dictPtr;
7282 return JIM_OK;
7285 /* Modify the dict stored into the variable named 'varNamePtr'
7286 * setting the element specified by the 'keyc' keys objects in 'keyv',
7287 * with the new value of the element 'newObjPtr'.
7289 * If newObjPtr == NULL the operation is to remove the given key
7290 * from the dictionary.
7292 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7293 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7295 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7296 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7298 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7299 int shared, i;
7301 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7302 if (objPtr == NULL) {
7303 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7304 /* Cannot remove a key from non existing var */
7305 return JIM_ERR;
7307 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7308 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7309 Jim_FreeNewObj(interp, varObjPtr);
7310 return JIM_ERR;
7313 if ((shared = Jim_IsShared(objPtr)))
7314 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7315 for (i = 0; i < keyc; i++) {
7316 dictObjPtr = objPtr;
7318 /* Check if it's a valid dictionary */
7319 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7320 goto err;
7323 if (i == keyc - 1) {
7324 /* Last key: Note that error on unset with missing last key is OK */
7325 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7326 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7327 goto err;
7330 break;
7333 /* Check if the given key exists. */
7334 Jim_InvalidateStringRep(dictObjPtr);
7335 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7336 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7337 /* This key exists at the current level.
7338 * Make sure it's not shared!. */
7339 if (Jim_IsShared(objPtr)) {
7340 objPtr = Jim_DuplicateObj(interp, objPtr);
7341 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7344 else {
7345 /* Key not found. If it's an [unset] operation
7346 * this is an error. Only the last key may not
7347 * exist. */
7348 if (newObjPtr == NULL) {
7349 goto err;
7351 /* Otherwise set an empty dictionary
7352 * as key's value. */
7353 objPtr = Jim_NewDictObj(interp, NULL, 0);
7354 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7357 /* XXX: Is this necessary? */
7358 Jim_InvalidateStringRep(objPtr);
7359 Jim_InvalidateStringRep(varObjPtr);
7360 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7361 goto err;
7363 Jim_SetResult(interp, varObjPtr);
7364 return JIM_OK;
7365 err:
7366 if (shared) {
7367 Jim_FreeNewObj(interp, varObjPtr);
7369 return JIM_ERR;
7372 /* -----------------------------------------------------------------------------
7373 * Index object
7374 * ---------------------------------------------------------------------------*/
7375 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7376 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7378 static const Jim_ObjType indexObjType = {
7379 "index",
7380 NULL,
7381 NULL,
7382 UpdateStringOfIndex,
7383 JIM_TYPE_NONE,
7386 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7388 if (objPtr->internalRep.intValue == -1) {
7389 JimSetStringBytes(objPtr, "end");
7391 else {
7392 char buf[JIM_INTEGER_SPACE + 1];
7393 if (objPtr->internalRep.intValue >= 0) {
7394 sprintf(buf, "%d", objPtr->internalRep.intValue);
7396 else {
7397 /* Must be <= -2 */
7398 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7400 JimSetStringBytes(objPtr, buf);
7404 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7406 int idx, end = 0;
7407 const char *str;
7408 char *endptr;
7410 /* Get the string representation */
7411 str = Jim_String(objPtr);
7413 /* Try to convert into an index */
7414 if (strncmp(str, "end", 3) == 0) {
7415 end = 1;
7416 str += 3;
7417 idx = 0;
7419 else {
7420 idx = jim_strtol(str, &endptr);
7422 if (endptr == str) {
7423 goto badindex;
7425 str = endptr;
7428 /* Now str may include or +<num> or -<num> */
7429 if (*str == '+' || *str == '-') {
7430 int sign = (*str == '+' ? 1 : -1);
7432 idx += sign * jim_strtol(++str, &endptr);
7433 if (str == endptr || *endptr) {
7434 goto badindex;
7436 str = endptr;
7438 /* The only thing left should be spaces */
7439 while (isspace(UCHAR(*str))) {
7440 str++;
7442 if (*str) {
7443 goto badindex;
7445 if (end) {
7446 if (idx > 0) {
7447 idx = INT_MAX;
7449 else {
7450 /* end-1 is repesented as -2 */
7451 idx--;
7454 else if (idx < 0) {
7455 idx = -INT_MAX;
7458 /* Free the old internal repr and set the new one. */
7459 Jim_FreeIntRep(interp, objPtr);
7460 objPtr->typePtr = &indexObjType;
7461 objPtr->internalRep.intValue = idx;
7462 return JIM_OK;
7464 badindex:
7465 Jim_SetResultFormatted(interp,
7466 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7467 return JIM_ERR;
7470 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7472 /* Avoid shimmering if the object is an integer. */
7473 if (objPtr->typePtr == &intObjType) {
7474 jim_wide val = JimWideValue(objPtr);
7476 if (val < 0)
7477 *indexPtr = -INT_MAX;
7478 else if (val > INT_MAX)
7479 *indexPtr = INT_MAX;
7480 else
7481 *indexPtr = (int)val;
7482 return JIM_OK;
7484 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7485 return JIM_ERR;
7486 *indexPtr = objPtr->internalRep.intValue;
7487 return JIM_OK;
7490 /* -----------------------------------------------------------------------------
7491 * Return Code Object.
7492 * ---------------------------------------------------------------------------*/
7494 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7495 static const char * const jimReturnCodes[] = {
7496 "ok",
7497 "error",
7498 "return",
7499 "break",
7500 "continue",
7501 "signal",
7502 "exit",
7503 "eval",
7504 NULL
7507 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7509 static const Jim_ObjType returnCodeObjType = {
7510 "return-code",
7511 NULL,
7512 NULL,
7513 NULL,
7514 JIM_TYPE_NONE,
7517 /* Converts a (standard) return code to a string. Returns "?" for
7518 * non-standard return codes.
7520 const char *Jim_ReturnCode(int code)
7522 if (code < 0 || code >= (int)jimReturnCodesSize) {
7523 return "?";
7525 else {
7526 return jimReturnCodes[code];
7530 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7532 int returnCode;
7533 jim_wide wideValue;
7535 /* Try to convert into an integer */
7536 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7537 returnCode = (int)wideValue;
7538 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7539 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7540 return JIM_ERR;
7542 /* Free the old internal repr and set the new one. */
7543 Jim_FreeIntRep(interp, objPtr);
7544 objPtr->typePtr = &returnCodeObjType;
7545 objPtr->internalRep.intValue = returnCode;
7546 return JIM_OK;
7549 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7551 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7552 return JIM_ERR;
7553 *intPtr = objPtr->internalRep.intValue;
7554 return JIM_OK;
7557 /* -----------------------------------------------------------------------------
7558 * Expression Parsing
7559 * ---------------------------------------------------------------------------*/
7560 static int JimParseExprOperator(struct JimParserCtx *pc);
7561 static int JimParseExprNumber(struct JimParserCtx *pc);
7562 static int JimParseExprIrrational(struct JimParserCtx *pc);
7563 static int JimParseExprBoolean(struct JimParserCtx *pc);
7565 /* Exrp's Stack machine operators opcodes. */
7567 /* Binary operators (numbers) */
7568 enum
7570 /* Continues on from the JIM_TT_ space */
7571 /* Operations */
7572 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7573 JIM_EXPROP_DIV,
7574 JIM_EXPROP_MOD,
7575 JIM_EXPROP_SUB,
7576 JIM_EXPROP_ADD,
7577 JIM_EXPROP_LSHIFT,
7578 JIM_EXPROP_RSHIFT,
7579 JIM_EXPROP_ROTL,
7580 JIM_EXPROP_ROTR,
7581 JIM_EXPROP_LT,
7582 JIM_EXPROP_GT,
7583 JIM_EXPROP_LTE,
7584 JIM_EXPROP_GTE,
7585 JIM_EXPROP_NUMEQ,
7586 JIM_EXPROP_NUMNE,
7587 JIM_EXPROP_BITAND, /* 35 */
7588 JIM_EXPROP_BITXOR,
7589 JIM_EXPROP_BITOR,
7591 /* Note must keep these together */
7592 JIM_EXPROP_LOGICAND, /* 38 */
7593 JIM_EXPROP_LOGICAND_LEFT,
7594 JIM_EXPROP_LOGICAND_RIGHT,
7596 /* and these */
7597 JIM_EXPROP_LOGICOR, /* 41 */
7598 JIM_EXPROP_LOGICOR_LEFT,
7599 JIM_EXPROP_LOGICOR_RIGHT,
7601 /* and these */
7602 /* Ternary operators */
7603 JIM_EXPROP_TERNARY, /* 44 */
7604 JIM_EXPROP_TERNARY_LEFT,
7605 JIM_EXPROP_TERNARY_RIGHT,
7607 /* and these */
7608 JIM_EXPROP_COLON, /* 47 */
7609 JIM_EXPROP_COLON_LEFT,
7610 JIM_EXPROP_COLON_RIGHT,
7612 JIM_EXPROP_POW, /* 50 */
7614 /* Binary operators (strings) */
7615 JIM_EXPROP_STREQ, /* 51 */
7616 JIM_EXPROP_STRNE,
7617 JIM_EXPROP_STRIN,
7618 JIM_EXPROP_STRNI,
7620 /* Unary operators (numbers) */
7621 JIM_EXPROP_NOT, /* 55 */
7622 JIM_EXPROP_BITNOT,
7623 JIM_EXPROP_UNARYMINUS,
7624 JIM_EXPROP_UNARYPLUS,
7626 /* Functions */
7627 JIM_EXPROP_FUNC_FIRST, /* 59 */
7628 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7629 JIM_EXPROP_FUNC_WIDE,
7630 JIM_EXPROP_FUNC_ABS,
7631 JIM_EXPROP_FUNC_DOUBLE,
7632 JIM_EXPROP_FUNC_ROUND,
7633 JIM_EXPROP_FUNC_RAND,
7634 JIM_EXPROP_FUNC_SRAND,
7636 /* math functions from libm */
7637 JIM_EXPROP_FUNC_SIN, /* 65 */
7638 JIM_EXPROP_FUNC_COS,
7639 JIM_EXPROP_FUNC_TAN,
7640 JIM_EXPROP_FUNC_ASIN,
7641 JIM_EXPROP_FUNC_ACOS,
7642 JIM_EXPROP_FUNC_ATAN,
7643 JIM_EXPROP_FUNC_ATAN2,
7644 JIM_EXPROP_FUNC_SINH,
7645 JIM_EXPROP_FUNC_COSH,
7646 JIM_EXPROP_FUNC_TANH,
7647 JIM_EXPROP_FUNC_CEIL,
7648 JIM_EXPROP_FUNC_FLOOR,
7649 JIM_EXPROP_FUNC_EXP,
7650 JIM_EXPROP_FUNC_LOG,
7651 JIM_EXPROP_FUNC_LOG10,
7652 JIM_EXPROP_FUNC_SQRT,
7653 JIM_EXPROP_FUNC_POW,
7654 JIM_EXPROP_FUNC_HYPOT,
7655 JIM_EXPROP_FUNC_FMOD,
7658 struct JimExprState
7660 Jim_Obj **stack;
7661 int stacklen;
7662 int opcode;
7663 int skip;
7666 /* Operators table */
7667 typedef struct Jim_ExprOperator
7669 const char *name;
7670 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7671 unsigned char precedence;
7672 unsigned char arity;
7673 unsigned char lazy;
7674 unsigned char namelen;
7675 } Jim_ExprOperator;
7677 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7679 Jim_IncrRefCount(obj);
7680 e->stack[e->stacklen++] = obj;
7683 static Jim_Obj *ExprPop(struct JimExprState *e)
7685 return e->stack[--e->stacklen];
7688 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7690 int intresult = 1;
7691 int rc = JIM_OK;
7692 Jim_Obj *A = ExprPop(e);
7693 double dA, dC = 0;
7694 jim_wide wA, wC = 0;
7696 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7697 switch (e->opcode) {
7698 case JIM_EXPROP_FUNC_INT:
7699 case JIM_EXPROP_FUNC_WIDE:
7700 case JIM_EXPROP_FUNC_ROUND:
7701 case JIM_EXPROP_UNARYPLUS:
7702 wC = wA;
7703 break;
7704 case JIM_EXPROP_FUNC_DOUBLE:
7705 dC = wA;
7706 intresult = 0;
7707 break;
7708 case JIM_EXPROP_FUNC_ABS:
7709 wC = wA >= 0 ? wA : -wA;
7710 break;
7711 case JIM_EXPROP_UNARYMINUS:
7712 wC = -wA;
7713 break;
7714 case JIM_EXPROP_NOT:
7715 wC = !wA;
7716 break;
7717 default:
7718 abort();
7721 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7722 switch (e->opcode) {
7723 case JIM_EXPROP_FUNC_INT:
7724 case JIM_EXPROP_FUNC_WIDE:
7725 wC = dA;
7726 break;
7727 case JIM_EXPROP_FUNC_ROUND:
7728 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7729 break;
7730 case JIM_EXPROP_FUNC_DOUBLE:
7731 case JIM_EXPROP_UNARYPLUS:
7732 dC = dA;
7733 intresult = 0;
7734 break;
7735 case JIM_EXPROP_FUNC_ABS:
7736 dC = dA >= 0 ? dA : -dA;
7737 intresult = 0;
7738 break;
7739 case JIM_EXPROP_UNARYMINUS:
7740 dC = -dA;
7741 intresult = 0;
7742 break;
7743 case JIM_EXPROP_NOT:
7744 wC = !dA;
7745 break;
7746 default:
7747 abort();
7751 if (rc == JIM_OK) {
7752 if (intresult) {
7753 ExprPush(e, Jim_NewIntObj(interp, wC));
7755 else {
7756 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7760 Jim_DecrRefCount(interp, A);
7762 return rc;
7765 static double JimRandDouble(Jim_Interp *interp)
7767 unsigned long x;
7768 JimRandomBytes(interp, &x, sizeof(x));
7770 return (double)x / (unsigned long)~0;
7773 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7775 Jim_Obj *A = ExprPop(e);
7776 jim_wide wA;
7778 int rc = Jim_GetWide(interp, A, &wA);
7779 if (rc == JIM_OK) {
7780 switch (e->opcode) {
7781 case JIM_EXPROP_BITNOT:
7782 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7783 break;
7784 case JIM_EXPROP_FUNC_SRAND:
7785 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7786 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7787 break;
7788 default:
7789 abort();
7793 Jim_DecrRefCount(interp, A);
7795 return rc;
7798 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7800 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7802 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7804 return JIM_OK;
7807 #ifdef JIM_MATH_FUNCTIONS
7808 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7810 int rc;
7811 Jim_Obj *A = ExprPop(e);
7812 double dA, dC;
7814 rc = Jim_GetDouble(interp, A, &dA);
7815 if (rc == JIM_OK) {
7816 switch (e->opcode) {
7817 case JIM_EXPROP_FUNC_SIN:
7818 dC = sin(dA);
7819 break;
7820 case JIM_EXPROP_FUNC_COS:
7821 dC = cos(dA);
7822 break;
7823 case JIM_EXPROP_FUNC_TAN:
7824 dC = tan(dA);
7825 break;
7826 case JIM_EXPROP_FUNC_ASIN:
7827 dC = asin(dA);
7828 break;
7829 case JIM_EXPROP_FUNC_ACOS:
7830 dC = acos(dA);
7831 break;
7832 case JIM_EXPROP_FUNC_ATAN:
7833 dC = atan(dA);
7834 break;
7835 case JIM_EXPROP_FUNC_SINH:
7836 dC = sinh(dA);
7837 break;
7838 case JIM_EXPROP_FUNC_COSH:
7839 dC = cosh(dA);
7840 break;
7841 case JIM_EXPROP_FUNC_TANH:
7842 dC = tanh(dA);
7843 break;
7844 case JIM_EXPROP_FUNC_CEIL:
7845 dC = ceil(dA);
7846 break;
7847 case JIM_EXPROP_FUNC_FLOOR:
7848 dC = floor(dA);
7849 break;
7850 case JIM_EXPROP_FUNC_EXP:
7851 dC = exp(dA);
7852 break;
7853 case JIM_EXPROP_FUNC_LOG:
7854 dC = log(dA);
7855 break;
7856 case JIM_EXPROP_FUNC_LOG10:
7857 dC = log10(dA);
7858 break;
7859 case JIM_EXPROP_FUNC_SQRT:
7860 dC = sqrt(dA);
7861 break;
7862 default:
7863 abort();
7865 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7868 Jim_DecrRefCount(interp, A);
7870 return rc;
7872 #endif
7874 /* A binary operation on two ints */
7875 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7877 Jim_Obj *B = ExprPop(e);
7878 Jim_Obj *A = ExprPop(e);
7879 jim_wide wA, wB;
7880 int rc = JIM_ERR;
7882 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7883 jim_wide wC;
7885 rc = JIM_OK;
7887 switch (e->opcode) {
7888 case JIM_EXPROP_LSHIFT:
7889 wC = wA << wB;
7890 break;
7891 case JIM_EXPROP_RSHIFT:
7892 wC = wA >> wB;
7893 break;
7894 case JIM_EXPROP_BITAND:
7895 wC = wA & wB;
7896 break;
7897 case JIM_EXPROP_BITXOR:
7898 wC = wA ^ wB;
7899 break;
7900 case JIM_EXPROP_BITOR:
7901 wC = wA | wB;
7902 break;
7903 case JIM_EXPROP_MOD:
7904 if (wB == 0) {
7905 wC = 0;
7906 Jim_SetResultString(interp, "Division by zero", -1);
7907 rc = JIM_ERR;
7909 else {
7911 * From Tcl 8.x
7913 * This code is tricky: C doesn't guarantee much
7914 * about the quotient or remainder, but Tcl does.
7915 * The remainder always has the same sign as the
7916 * divisor and a smaller absolute value.
7918 int negative = 0;
7920 if (wB < 0) {
7921 wB = -wB;
7922 wA = -wA;
7923 negative = 1;
7925 wC = wA % wB;
7926 if (wC < 0) {
7927 wC += wB;
7929 if (negative) {
7930 wC = -wC;
7933 break;
7934 case JIM_EXPROP_ROTL:
7935 case JIM_EXPROP_ROTR:{
7936 /* uint32_t would be better. But not everyone has inttypes.h? */
7937 unsigned long uA = (unsigned long)wA;
7938 unsigned long uB = (unsigned long)wB;
7939 const unsigned int S = sizeof(unsigned long) * 8;
7941 /* Shift left by the word size or more is undefined. */
7942 uB %= S;
7944 if (e->opcode == JIM_EXPROP_ROTR) {
7945 uB = S - uB;
7947 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7948 break;
7950 default:
7951 abort();
7953 ExprPush(e, Jim_NewIntObj(interp, wC));
7957 Jim_DecrRefCount(interp, A);
7958 Jim_DecrRefCount(interp, B);
7960 return rc;
7964 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7965 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7967 int rc = JIM_OK;
7968 double dA, dB, dC = 0;
7969 jim_wide wA, wB, wC = 0;
7971 Jim_Obj *B = ExprPop(e);
7972 Jim_Obj *A = ExprPop(e);
7974 if ((A->typePtr != &doubleObjType || A->bytes) &&
7975 (B->typePtr != &doubleObjType || B->bytes) &&
7976 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7978 /* Both are ints */
7980 switch (e->opcode) {
7981 case JIM_EXPROP_POW:
7982 case JIM_EXPROP_FUNC_POW:
7983 if (wA == 0 && wB < 0) {
7984 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
7985 rc = JIM_ERR;
7986 goto done;
7988 wC = JimPowWide(wA, wB);
7989 goto intresult;
7990 case JIM_EXPROP_ADD:
7991 wC = wA + wB;
7992 goto intresult;
7993 case JIM_EXPROP_SUB:
7994 wC = wA - wB;
7995 goto intresult;
7996 case JIM_EXPROP_MUL:
7997 wC = wA * wB;
7998 goto intresult;
7999 case JIM_EXPROP_DIV:
8000 if (wB == 0) {
8001 Jim_SetResultString(interp, "Division by zero", -1);
8002 rc = JIM_ERR;
8003 goto done;
8005 else {
8007 * From Tcl 8.x
8009 * This code is tricky: C doesn't guarantee much
8010 * about the quotient or remainder, but Tcl does.
8011 * The remainder always has the same sign as the
8012 * divisor and a smaller absolute value.
8014 if (wB < 0) {
8015 wB = -wB;
8016 wA = -wA;
8018 wC = wA / wB;
8019 if (wA % wB < 0) {
8020 wC--;
8022 goto intresult;
8024 case JIM_EXPROP_LT:
8025 wC = wA < wB;
8026 goto intresult;
8027 case JIM_EXPROP_GT:
8028 wC = wA > wB;
8029 goto intresult;
8030 case JIM_EXPROP_LTE:
8031 wC = wA <= wB;
8032 goto intresult;
8033 case JIM_EXPROP_GTE:
8034 wC = wA >= wB;
8035 goto intresult;
8036 case JIM_EXPROP_NUMEQ:
8037 wC = wA == wB;
8038 goto intresult;
8039 case JIM_EXPROP_NUMNE:
8040 wC = wA != wB;
8041 goto intresult;
8044 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8045 switch (e->opcode) {
8046 #ifndef JIM_MATH_FUNCTIONS
8047 case JIM_EXPROP_POW:
8048 case JIM_EXPROP_FUNC_POW:
8049 case JIM_EXPROP_FUNC_ATAN2:
8050 case JIM_EXPROP_FUNC_HYPOT:
8051 case JIM_EXPROP_FUNC_FMOD:
8052 Jim_SetResultString(interp, "unsupported", -1);
8053 rc = JIM_ERR;
8054 goto done;
8055 #else
8056 case JIM_EXPROP_POW:
8057 case JIM_EXPROP_FUNC_POW:
8058 dC = pow(dA, dB);
8059 goto doubleresult;
8060 case JIM_EXPROP_FUNC_ATAN2:
8061 dC = atan2(dA, dB);
8062 goto doubleresult;
8063 case JIM_EXPROP_FUNC_HYPOT:
8064 dC = hypot(dA, dB);
8065 goto doubleresult;
8066 case JIM_EXPROP_FUNC_FMOD:
8067 dC = fmod(dA, dB);
8068 goto doubleresult;
8069 #endif
8070 case JIM_EXPROP_ADD:
8071 dC = dA + dB;
8072 goto doubleresult;
8073 case JIM_EXPROP_SUB:
8074 dC = dA - dB;
8075 goto doubleresult;
8076 case JIM_EXPROP_MUL:
8077 dC = dA * dB;
8078 goto doubleresult;
8079 case JIM_EXPROP_DIV:
8080 if (dB == 0) {
8081 #ifdef INFINITY
8082 dC = dA < 0 ? -INFINITY : INFINITY;
8083 #else
8084 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8085 #endif
8087 else {
8088 dC = dA / dB;
8090 goto doubleresult;
8091 case JIM_EXPROP_LT:
8092 wC = dA < dB;
8093 goto intresult;
8094 case JIM_EXPROP_GT:
8095 wC = dA > dB;
8096 goto intresult;
8097 case JIM_EXPROP_LTE:
8098 wC = dA <= dB;
8099 goto intresult;
8100 case JIM_EXPROP_GTE:
8101 wC = dA >= dB;
8102 goto intresult;
8103 case JIM_EXPROP_NUMEQ:
8104 wC = dA == dB;
8105 goto intresult;
8106 case JIM_EXPROP_NUMNE:
8107 wC = dA != dB;
8108 goto intresult;
8111 else {
8112 /* Handle the string case */
8114 /* XXX: Could optimise the eq/ne case by checking lengths */
8115 int i = Jim_StringCompareObj(interp, A, B, 0);
8117 switch (e->opcode) {
8118 case JIM_EXPROP_LT:
8119 wC = i < 0;
8120 goto intresult;
8121 case JIM_EXPROP_GT:
8122 wC = i > 0;
8123 goto intresult;
8124 case JIM_EXPROP_LTE:
8125 wC = i <= 0;
8126 goto intresult;
8127 case JIM_EXPROP_GTE:
8128 wC = i >= 0;
8129 goto intresult;
8130 case JIM_EXPROP_NUMEQ:
8131 wC = i == 0;
8132 goto intresult;
8133 case JIM_EXPROP_NUMNE:
8134 wC = i != 0;
8135 goto intresult;
8138 /* If we get here, it is an error */
8139 rc = JIM_ERR;
8140 done:
8141 Jim_DecrRefCount(interp, A);
8142 Jim_DecrRefCount(interp, B);
8143 return rc;
8144 intresult:
8145 ExprPush(e, Jim_NewIntObj(interp, wC));
8146 goto done;
8147 doubleresult:
8148 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8149 goto done;
8152 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8154 int listlen;
8155 int i;
8157 listlen = Jim_ListLength(interp, listObjPtr);
8158 for (i = 0; i < listlen; i++) {
8159 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8160 return 1;
8163 return 0;
8166 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8168 Jim_Obj *B = ExprPop(e);
8169 Jim_Obj *A = ExprPop(e);
8171 jim_wide wC;
8173 switch (e->opcode) {
8174 case JIM_EXPROP_STREQ:
8175 case JIM_EXPROP_STRNE:
8176 wC = Jim_StringEqObj(A, B);
8177 if (e->opcode == JIM_EXPROP_STRNE) {
8178 wC = !wC;
8180 break;
8181 case JIM_EXPROP_STRIN:
8182 wC = JimSearchList(interp, B, A);
8183 break;
8184 case JIM_EXPROP_STRNI:
8185 wC = !JimSearchList(interp, B, A);
8186 break;
8187 default:
8188 abort();
8190 ExprPush(e, Jim_NewIntObj(interp, wC));
8192 Jim_DecrRefCount(interp, A);
8193 Jim_DecrRefCount(interp, B);
8195 return JIM_OK;
8198 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8200 long l;
8201 double d;
8202 int b;
8204 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8205 return l != 0;
8207 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8208 return d != 0;
8210 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8211 return b != 0;
8213 return -1;
8216 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8218 Jim_Obj *skip = ExprPop(e);
8219 Jim_Obj *A = ExprPop(e);
8220 int rc = JIM_OK;
8222 switch (ExprBool(interp, A)) {
8223 case 0:
8224 /* false, so skip RHS opcodes with a 0 result */
8225 e->skip = JimWideValue(skip);
8226 ExprPush(e, Jim_NewIntObj(interp, 0));
8227 break;
8229 case 1:
8230 /* true so continue */
8231 break;
8233 case -1:
8234 /* Invalid */
8235 rc = JIM_ERR;
8237 Jim_DecrRefCount(interp, A);
8238 Jim_DecrRefCount(interp, skip);
8240 return rc;
8243 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8245 Jim_Obj *skip = ExprPop(e);
8246 Jim_Obj *A = ExprPop(e);
8247 int rc = JIM_OK;
8249 switch (ExprBool(interp, A)) {
8250 case 0:
8251 /* false, so do nothing */
8252 break;
8254 case 1:
8255 /* true so skip RHS opcodes with a 1 result */
8256 e->skip = JimWideValue(skip);
8257 ExprPush(e, Jim_NewIntObj(interp, 1));
8258 break;
8260 case -1:
8261 /* Invalid */
8262 rc = JIM_ERR;
8263 break;
8265 Jim_DecrRefCount(interp, A);
8266 Jim_DecrRefCount(interp, skip);
8268 return rc;
8271 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8273 Jim_Obj *A = ExprPop(e);
8274 int rc = JIM_OK;
8276 switch (ExprBool(interp, A)) {
8277 case 0:
8278 ExprPush(e, Jim_NewIntObj(interp, 0));
8279 break;
8281 case 1:
8282 ExprPush(e, Jim_NewIntObj(interp, 1));
8283 break;
8285 case -1:
8286 /* Invalid */
8287 rc = JIM_ERR;
8288 break;
8290 Jim_DecrRefCount(interp, A);
8292 return rc;
8295 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8297 Jim_Obj *skip = ExprPop(e);
8298 Jim_Obj *A = ExprPop(e);
8299 int rc = JIM_OK;
8301 /* Repush A */
8302 ExprPush(e, A);
8304 switch (ExprBool(interp, A)) {
8305 case 0:
8306 /* false, skip RHS opcodes */
8307 e->skip = JimWideValue(skip);
8308 /* Push a dummy value */
8309 ExprPush(e, Jim_NewIntObj(interp, 0));
8310 break;
8312 case 1:
8313 /* true so do nothing */
8314 break;
8316 case -1:
8317 /* Invalid */
8318 rc = JIM_ERR;
8319 break;
8321 Jim_DecrRefCount(interp, A);
8322 Jim_DecrRefCount(interp, skip);
8324 return rc;
8327 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8329 Jim_Obj *skip = ExprPop(e);
8330 Jim_Obj *B = ExprPop(e);
8331 Jim_Obj *A = ExprPop(e);
8333 /* No need to check for A as non-boolean */
8334 if (ExprBool(interp, A)) {
8335 /* true, so skip RHS opcodes */
8336 e->skip = JimWideValue(skip);
8337 /* Repush B as the answer */
8338 ExprPush(e, B);
8341 Jim_DecrRefCount(interp, skip);
8342 Jim_DecrRefCount(interp, A);
8343 Jim_DecrRefCount(interp, B);
8344 return JIM_OK;
8347 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8349 return JIM_OK;
8352 enum
8354 LAZY_NONE,
8355 LAZY_OP,
8356 LAZY_LEFT,
8357 LAZY_RIGHT,
8358 RIGHT_ASSOC, /* reuse this field for right associativity too */
8361 /* name - precedence - arity - opcode
8363 * This array *must* be kept in sync with the JIM_EXPROP enum.
8365 * The following macros pre-compute the string length at compile time.
8367 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8368 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8370 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8371 OPRINIT("*", 110, 2, JimExprOpBin),
8372 OPRINIT("/", 110, 2, JimExprOpBin),
8373 OPRINIT("%", 110, 2, JimExprOpIntBin),
8375 OPRINIT("-", 100, 2, JimExprOpBin),
8376 OPRINIT("+", 100, 2, JimExprOpBin),
8378 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8379 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8381 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8382 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8384 OPRINIT("<", 80, 2, JimExprOpBin),
8385 OPRINIT(">", 80, 2, JimExprOpBin),
8386 OPRINIT("<=", 80, 2, JimExprOpBin),
8387 OPRINIT(">=", 80, 2, JimExprOpBin),
8389 OPRINIT("==", 70, 2, JimExprOpBin),
8390 OPRINIT("!=", 70, 2, JimExprOpBin),
8392 OPRINIT("&", 50, 2, JimExprOpIntBin),
8393 OPRINIT("^", 49, 2, JimExprOpIntBin),
8394 OPRINIT("|", 48, 2, JimExprOpIntBin),
8396 OPRINIT_ATTR("&&", 10, 2, NULL, LAZY_OP),
8397 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8398 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8400 OPRINIT_ATTR("||", 9, 2, NULL, LAZY_OP),
8401 OPRINIT_ATTR(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8402 OPRINIT_ATTR(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8404 OPRINIT_ATTR("?", 5, 2, JimExprOpNull, LAZY_OP),
8405 OPRINIT_ATTR(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8406 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8408 OPRINIT_ATTR(":", 5, 2, JimExprOpNull, LAZY_OP),
8409 OPRINIT_ATTR(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8410 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8412 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8413 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, RIGHT_ASSOC),
8415 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8416 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8418 OPRINIT("in", 55, 2, JimExprOpStrBin),
8419 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8421 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8422 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8423 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8424 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8428 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8429 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8430 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8431 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8432 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8433 OPRINIT("rand", 200, 0, JimExprOpNone),
8434 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8436 #ifdef JIM_MATH_FUNCTIONS
8437 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8438 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8439 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8440 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8441 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8442 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8443 OPRINIT("atan2", 200, 2, JimExprOpBin),
8444 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8445 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8446 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8447 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8448 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8449 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8450 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8451 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8452 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8453 OPRINIT("pow", 200, 2, JimExprOpBin),
8454 OPRINIT("hypot", 200, 2, JimExprOpBin),
8455 OPRINIT("fmod", 200, 2, JimExprOpBin),
8456 #endif
8458 #undef OPRINIT
8459 #undef OPRINIT_LAZY
8461 #define JIM_EXPR_OPERATORS_NUM \
8462 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8464 static int JimParseExpression(struct JimParserCtx *pc)
8466 /* Discard spaces and quoted newline */
8467 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8468 if (*pc->p == '\n') {
8469 pc->linenr++;
8471 pc->p++;
8472 pc->len--;
8475 /* Common case */
8476 pc->tline = pc->linenr;
8477 pc->tstart = pc->p;
8479 if (pc->len == 0) {
8480 pc->tend = pc->p;
8481 pc->tt = JIM_TT_EOL;
8482 pc->eof = 1;
8483 return JIM_OK;
8485 switch (*(pc->p)) {
8486 case '(':
8487 pc->tt = JIM_TT_SUBEXPR_START;
8488 goto singlechar;
8489 case ')':
8490 pc->tt = JIM_TT_SUBEXPR_END;
8491 goto singlechar;
8492 case ',':
8493 pc->tt = JIM_TT_SUBEXPR_COMMA;
8494 singlechar:
8495 pc->tend = pc->p;
8496 pc->p++;
8497 pc->len--;
8498 break;
8499 case '[':
8500 return JimParseCmd(pc);
8501 case '$':
8502 if (JimParseVar(pc) == JIM_ERR)
8503 return JimParseExprOperator(pc);
8504 else {
8505 /* Don't allow expr sugar in expressions */
8506 if (pc->tt == JIM_TT_EXPRSUGAR) {
8507 return JIM_ERR;
8509 return JIM_OK;
8511 break;
8512 case '0':
8513 case '1':
8514 case '2':
8515 case '3':
8516 case '4':
8517 case '5':
8518 case '6':
8519 case '7':
8520 case '8':
8521 case '9':
8522 case '.':
8523 return JimParseExprNumber(pc);
8524 case '"':
8525 return JimParseQuote(pc);
8526 case '{':
8527 return JimParseBrace(pc);
8529 case 'N':
8530 case 'I':
8531 case 'n':
8532 case 'i':
8533 if (JimParseExprIrrational(pc) == JIM_ERR)
8534 if (JimParseExprBoolean(pc) == JIM_ERR)
8535 return JimParseExprOperator(pc);
8536 break;
8537 case 't':
8538 case 'f':
8539 case 'o':
8540 case 'y':
8541 if (JimParseExprBoolean(pc) == JIM_ERR)
8542 return JimParseExprOperator(pc);
8543 break;
8544 default:
8545 return JimParseExprOperator(pc);
8546 break;
8548 return JIM_OK;
8551 static int JimParseExprNumber(struct JimParserCtx *pc)
8553 char *end;
8555 /* Assume an integer for now */
8556 pc->tt = JIM_TT_EXPR_INT;
8558 jim_strtoull(pc->p, (char **)&pc->p);
8559 /* Tried as an integer, but perhaps it parses as a double */
8560 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8561 /* Some stupid compilers insist they are cleverer that
8562 * we are. Even a (void) cast doesn't prevent this warning!
8564 if (strtod(pc->tstart, &end)) { /* nothing */ }
8565 if (end == pc->tstart)
8566 return JIM_ERR;
8567 if (end > pc->p) {
8568 /* Yes, double captured more chars */
8569 pc->tt = JIM_TT_EXPR_DOUBLE;
8570 pc->p = end;
8573 pc->tend = pc->p - 1;
8574 pc->len -= (pc->p - pc->tstart);
8575 return JIM_OK;
8578 static int JimParseExprIrrational(struct JimParserCtx *pc)
8580 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8581 int i;
8583 for (i = 0; irrationals[i]; i++) {
8584 const char *irr = irrationals[i];
8586 if (strncmp(irr, pc->p, 3) == 0) {
8587 pc->p += 3;
8588 pc->len -= 3;
8589 pc->tend = pc->p - 1;
8590 pc->tt = JIM_TT_EXPR_DOUBLE;
8591 return JIM_OK;
8594 return JIM_ERR;
8597 static int JimParseExprBoolean(struct JimParserCtx *pc)
8599 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8600 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8601 int i;
8603 for (i = 0; booleans[i]; i++) {
8604 const char *boolean = booleans[i];
8605 int length = lengths[i];
8607 if (strncmp(boolean, pc->p, length) == 0) {
8608 pc->p += length;
8609 pc->len -= length;
8610 pc->tend = pc->p - 1;
8611 pc->tt = JIM_TT_EXPR_BOOLEAN;
8612 return JIM_OK;
8615 return JIM_ERR;
8618 static int JimParseExprOperator(struct JimParserCtx *pc)
8620 int i;
8621 int bestIdx = -1, bestLen = 0;
8623 /* Try to get the longest match. */
8624 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8625 const char * const opname = Jim_ExprOperators[i].name;
8626 const int oplen = Jim_ExprOperators[i].namelen;
8628 if (opname == NULL || opname[0] != pc->p[0]) {
8629 continue;
8632 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8633 bestIdx = i + JIM_TT_EXPR_OP;
8634 bestLen = oplen;
8637 if (bestIdx == -1) {
8638 return JIM_ERR;
8641 /* Validate paretheses around function arguments */
8642 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8643 const char *p = pc->p + bestLen;
8644 int len = pc->len - bestLen;
8646 while (len && isspace(UCHAR(*p))) {
8647 len--;
8648 p++;
8650 if (*p != '(') {
8651 return JIM_ERR;
8654 pc->tend = pc->p + bestLen - 1;
8655 pc->p += bestLen;
8656 pc->len -= bestLen;
8658 pc->tt = bestIdx;
8659 return JIM_OK;
8662 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8664 static Jim_ExprOperator dummy_op;
8665 if (opcode < JIM_TT_EXPR_OP) {
8666 return &dummy_op;
8668 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8671 const char *jim_tt_name(int type)
8673 static const char * const tt_names[JIM_TT_EXPR_OP] =
8674 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8675 "DBL", "BOO", "$()" };
8676 if (type < JIM_TT_EXPR_OP) {
8677 return tt_names[type];
8679 else if (type == JIM_EXPROP_UNARYMINUS) {
8680 return "-VE";
8682 else if (type == JIM_EXPROP_UNARYPLUS) {
8683 return "+VE";
8685 else {
8686 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8687 static char buf[20];
8689 if (op->name) {
8690 return op->name;
8692 sprintf(buf, "(%d)", type);
8693 return buf;
8697 /* -----------------------------------------------------------------------------
8698 * Expression Object
8699 * ---------------------------------------------------------------------------*/
8700 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8701 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8702 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8704 static const Jim_ObjType exprObjType = {
8705 "expression",
8706 FreeExprInternalRep,
8707 DupExprInternalRep,
8708 NULL,
8709 JIM_TYPE_REFERENCES,
8712 /* Expr bytecode structure */
8713 typedef struct ExprByteCode
8715 ScriptToken *token; /* Tokens array. */
8716 int len; /* Length as number of tokens. */
8717 int inUse; /* Used for sharing. */
8718 } ExprByteCode;
8720 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8722 int i;
8724 for (i = 0; i < expr->len; i++) {
8725 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8727 Jim_Free(expr->token);
8728 Jim_Free(expr);
8731 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8733 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8735 if (expr) {
8736 if (--expr->inUse != 0) {
8737 return;
8740 ExprFreeByteCode(interp, expr);
8744 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8746 JIM_NOTUSED(interp);
8747 JIM_NOTUSED(srcPtr);
8749 /* Just returns an simple string. */
8750 dupPtr->typePtr = NULL;
8753 /* Check if an expr program looks correct
8754 * Sets an error result on invalid
8756 static int ExprCheckCorrectness(Jim_Interp *interp, Jim_Obj *exprObjPtr, ExprByteCode * expr)
8758 int i;
8759 int stacklen = 0;
8760 int ternary = 0;
8761 int lasttt = JIM_TT_NONE;
8762 const char *errmsg;
8764 /* Try to check if there are stack underflows,
8765 * and make sure at the end of the program there is
8766 * a single result on the stack. */
8767 for (i = 0; i < expr->len; i++) {
8768 ScriptToken *t = &expr->token[i];
8769 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8770 lasttt = t->type;
8772 stacklen -= op->arity;
8774 if (stacklen < 0) {
8775 break;
8777 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8778 ternary++;
8780 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8781 ternary--;
8784 /* All operations and operands add one to the stack */
8785 stacklen++;
8787 if (stacklen == 1 && ternary == 0) {
8788 return JIM_OK;
8791 if (stacklen <= 0) {
8792 /* Too few args */
8793 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8794 errmsg = "too few arguments for math function";
8795 Jim_SetResultString(interp, "too few arguments for math function", -1);
8796 } else {
8797 errmsg = "premature end of expression";
8800 else if (stacklen > 1) {
8801 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8802 errmsg = "too many arguments for math function";
8803 } else {
8804 errmsg = "extra tokens at end of expression";
8807 else {
8808 errmsg = "invalid ternary expression";
8810 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": %s", exprObjPtr, errmsg);
8811 return JIM_ERR;
8814 /* This procedure converts every occurrence of || and && opereators
8815 * in lazy unary versions.
8817 * a b || is converted into:
8819 * a <offset> |L b |R
8821 * a b && is converted into:
8823 * a <offset> &L b &R
8825 * "|L" checks if 'a' is true:
8826 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8827 * the opcode just after |R.
8828 * 2) if it is false does nothing.
8829 * "|R" checks if 'b' is true:
8830 * 1) if it is true pushes 1, otherwise pushes 0.
8832 * "&L" checks if 'a' is true:
8833 * 1) if it is true does nothing.
8834 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8835 * the opcode just after &R
8836 * "&R" checks if 'a' is true:
8837 * if it is true pushes 1, otherwise pushes 0.
8839 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8841 int i;
8843 int leftindex, arity, offset;
8845 /* Search for the end of the first operator */
8846 leftindex = expr->len - 1;
8848 arity = 1;
8849 while (arity) {
8850 ScriptToken *tt = &expr->token[leftindex];
8852 if (tt->type >= JIM_TT_EXPR_OP) {
8853 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8855 arity--;
8856 if (--leftindex < 0) {
8857 return JIM_ERR;
8860 leftindex++;
8862 /* Move them up */
8863 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8864 sizeof(*expr->token) * (expr->len - leftindex));
8865 expr->len += 2;
8866 offset = (expr->len - leftindex) - 1;
8868 /* Now we rely on the fact that the left and right version have opcodes
8869 * 1 and 2 after the main opcode respectively
8871 expr->token[leftindex + 1].type = t->type + 1;
8872 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8874 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8875 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8877 /* Now add the 'R' operator */
8878 expr->token[expr->len].objPtr = interp->emptyObj;
8879 expr->token[expr->len].type = t->type + 2;
8880 expr->len++;
8882 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8883 for (i = leftindex - 1; i > 0; i--) {
8884 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8885 if (op->lazy == LAZY_LEFT) {
8886 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8887 JimWideValue(expr->token[i - 1].objPtr) += 2;
8891 return JIM_OK;
8894 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8896 struct ScriptToken *token = &expr->token[expr->len];
8897 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8899 if (op->lazy == LAZY_OP) {
8900 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8901 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8902 return JIM_ERR;
8905 else {
8906 token->objPtr = interp->emptyObj;
8907 token->type = t->type;
8908 expr->len++;
8910 return JIM_OK;
8914 * Returns the index of the COLON_LEFT to the left of 'right_index'
8915 * taking into account nesting.
8917 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8919 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8921 int ternary_count = 1;
8923 right_index--;
8925 while (right_index > 1) {
8926 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8927 ternary_count--;
8929 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8930 ternary_count++;
8932 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8933 return right_index;
8935 right_index--;
8938 /*notreached*/
8939 return -1;
8943 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8945 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8946 * Otherwise returns 0.
8948 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8950 int i = right_index - 1;
8951 int ternary_count = 1;
8953 while (i > 1) {
8954 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8955 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8956 *prev_right_index = i - 2;
8957 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8958 return 1;
8961 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8962 if (ternary_count == 0) {
8963 return 0;
8965 ternary_count++;
8967 i--;
8969 return 0;
8973 * ExprTernaryReorderExpression description
8974 * ========================================
8976 * ?: is right-to-left associative which doesn't work with the stack-based
8977 * expression engine. The fix is to reorder the bytecode.
8979 * The expression:
8981 * expr 1?2:0?3:4
8983 * Has initial bytecode:
8985 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8986 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8988 * The fix involves simulating this expression instead:
8990 * expr 1?2:(0?3:4)
8992 * With the following bytecode:
8994 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8995 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8997 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8998 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8999 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9000 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9002 * ExprTernaryReorderExpression works thus as follows :
9003 * - start from the end of the stack
9004 * - while walking towards the beginning of the stack
9005 * if token=JIM_EXPROP_COLON_RIGHT then
9006 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9007 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9008 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9009 * if all found then
9010 * perform the rotation
9011 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9012 * end if
9013 * end if
9015 * Note: care has to be taken for nested ternary constructs!!!
9017 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
9019 int i;
9021 for (i = expr->len - 1; i > 1; i--) {
9022 int prev_right_index;
9023 int prev_left_index;
9024 int j;
9025 ScriptToken tmp;
9027 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
9028 continue;
9031 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9032 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
9033 continue;
9037 ** rotate tokens down
9039 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9040 ** | | |
9041 ** | V V
9042 ** | [...] : ...
9043 ** | | |
9044 ** | V V
9045 ** | [...] : ...
9046 ** | | |
9047 ** | V V
9048 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9050 tmp = expr->token[prev_right_index];
9051 for (j = prev_right_index; j < i; j++) {
9052 expr->token[j] = expr->token[j + 1];
9054 expr->token[i] = tmp;
9056 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9058 * This is 'colon left increment' = i - prev_right_index
9060 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9061 * [prev_left_index-1] : skip_count
9064 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9066 /* Adjust for i-- in the loop */
9067 i++;
9071 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9073 Jim_Stack stack;
9074 ExprByteCode *expr;
9075 int ok = 1;
9076 int i;
9077 int prevtt = JIM_TT_NONE;
9078 int have_ternary = 0;
9080 /* -1 for EOL */
9081 int count = tokenlist->count - 1;
9083 expr = Jim_Alloc(sizeof(*expr));
9084 expr->inUse = 1;
9085 expr->len = 0;
9087 Jim_InitStack(&stack);
9089 /* Need extra bytecodes for lazy operators.
9090 * Also check for the ternary operator
9092 for (i = 0; i < tokenlist->count; i++) {
9093 ParseToken *t = &tokenlist->list[i];
9094 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9096 if (op->lazy == LAZY_OP) {
9097 count += 2;
9098 /* Ternary is a lazy op but also needs reordering */
9099 if (t->type == JIM_EXPROP_TERNARY) {
9100 have_ternary = 1;
9105 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9107 for (i = 0; i < tokenlist->count && ok; i++) {
9108 ParseToken *t = &tokenlist->list[i];
9110 /* Next token will be stored here */
9111 struct ScriptToken *token = &expr->token[expr->len];
9113 if (t->type == JIM_TT_EOL) {
9114 break;
9117 if (TOKEN_IS_EXPR_OP(t->type)) {
9118 const struct Jim_ExprOperator *op;
9119 ParseToken *tt;
9121 /* Convert -/+ to unary minus or unary plus if necessary */
9122 if (prevtt == JIM_TT_NONE || prevtt == JIM_TT_SUBEXPR_START || prevtt == JIM_TT_SUBEXPR_COMMA || prevtt >= JIM_TT_EXPR_OP) {
9123 if (t->type == JIM_EXPROP_SUB) {
9124 t->type = JIM_EXPROP_UNARYMINUS;
9126 else if (t->type == JIM_EXPROP_ADD) {
9127 t->type = JIM_EXPROP_UNARYPLUS;
9131 op = JimExprOperatorInfoByOpcode(t->type);
9133 /* Handle precedence */
9134 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9135 const struct Jim_ExprOperator *tt_op =
9136 JimExprOperatorInfoByOpcode(tt->type);
9138 /* Note that right-to-left associativity of ?: operator is handled later.
9141 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9142 /* Don't reduce if right associative with equal precedence? */
9143 if (tt_op->precedence == op->precedence && tt_op->lazy == RIGHT_ASSOC) {
9144 break;
9146 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9147 ok = 0;
9148 goto err;
9150 Jim_StackPop(&stack);
9152 else {
9153 break;
9156 Jim_StackPush(&stack, t);
9158 else if (t->type == JIM_TT_SUBEXPR_START) {
9159 Jim_StackPush(&stack, t);
9161 else if (t->type == JIM_TT_SUBEXPR_END || t->type == JIM_TT_SUBEXPR_COMMA) {
9162 /* Reduce the expression back to the previous ( or , */
9163 ok = 0;
9164 while (Jim_StackLen(&stack)) {
9165 ParseToken *tt = Jim_StackPop(&stack);
9167 if (tt->type == JIM_TT_SUBEXPR_START || tt->type == JIM_TT_SUBEXPR_COMMA) {
9168 if (t->type == JIM_TT_SUBEXPR_COMMA) {
9169 /* Need to push back the previous START or COMMA in the case of comma */
9170 Jim_StackPush(&stack, tt);
9172 ok = 1;
9173 break;
9175 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9176 goto err;
9179 if (!ok) {
9180 Jim_SetResultFormatted(interp, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr);
9181 goto err;
9184 else {
9185 Jim_Obj *objPtr = NULL;
9187 /* This is a simple non-operator term, so create and push the appropriate object */
9188 token->type = t->type;
9190 /* Two consecutive terms without an operator is invalid */
9191 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9192 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", exprObjPtr);
9193 ok = 0;
9194 goto err;
9197 /* Immediately create a double or int object? */
9198 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9199 char *endptr;
9200 if (t->type == JIM_TT_EXPR_INT) {
9201 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9203 else {
9204 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9206 if (endptr != t->token + t->len) {
9207 /* Conversion failed, so just store it as a string */
9208 Jim_FreeNewObj(interp, objPtr);
9209 objPtr = NULL;
9213 if (objPtr) {
9214 token->objPtr = objPtr;
9216 else {
9217 /* Everything else is stored a simple string term */
9218 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9219 if (t->type == JIM_TT_CMD) {
9220 /* Only commands need source info */
9221 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9224 expr->len++;
9226 prevtt = t->type;
9229 /* Reduce any remaining subexpr */
9230 while (Jim_StackLen(&stack)) {
9231 ParseToken *tt = Jim_StackPop(&stack);
9233 if (tt->type == JIM_TT_SUBEXPR_START) {
9234 ok = 0;
9235 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9236 goto err;
9238 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9239 ok = 0;
9240 goto err;
9244 if (have_ternary) {
9245 ExprTernaryReorderExpression(interp, expr);
9248 err:
9249 /* Free the stack used for the compilation. */
9250 Jim_FreeStack(&stack);
9252 for (i = 0; i < expr->len; i++) {
9253 Jim_IncrRefCount(expr->token[i].objPtr);
9256 if (!ok) {
9257 ExprFreeByteCode(interp, expr);
9258 return NULL;
9261 return expr;
9265 /* This method takes the string representation of an expression
9266 * and generates a program for the Expr's stack-based VM. */
9267 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9269 int exprTextLen;
9270 const char *exprText;
9271 struct JimParserCtx parser;
9272 struct ExprByteCode *expr;
9273 ParseTokenList tokenlist;
9274 int line;
9275 Jim_Obj *fileNameObj;
9276 int rc = JIM_ERR;
9278 /* Try to get information about filename / line number */
9279 if (objPtr->typePtr == &sourceObjType) {
9280 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9281 line = objPtr->internalRep.sourceValue.lineNumber;
9283 else {
9284 fileNameObj = interp->emptyObj;
9285 line = 1;
9287 Jim_IncrRefCount(fileNameObj);
9289 exprText = Jim_GetString(objPtr, &exprTextLen);
9291 /* Initially tokenise the expression into tokenlist */
9292 ScriptTokenListInit(&tokenlist);
9294 JimParserInit(&parser, exprText, exprTextLen, line);
9295 while (!parser.eof) {
9296 if (JimParseExpression(&parser) != JIM_OK) {
9297 ScriptTokenListFree(&tokenlist);
9298 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9299 expr = NULL;
9300 goto err;
9303 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9304 parser.tline);
9307 #ifdef DEBUG_SHOW_EXPR_TOKENS
9309 int i;
9310 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9311 for (i = 0; i < tokenlist.count; i++) {
9312 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9313 tokenlist.list[i].len, tokenlist.list[i].token);
9316 #endif
9318 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9319 ScriptTokenListFree(&tokenlist);
9320 Jim_DecrRefCount(interp, fileNameObj);
9321 return JIM_ERR;
9324 /* Now create the expression bytecode from the tokenlist */
9325 expr = ExprCreateByteCode(interp, &tokenlist, objPtr, fileNameObj);
9327 /* No longer need the token list */
9328 ScriptTokenListFree(&tokenlist);
9330 if (!expr) {
9331 goto err;
9334 #ifdef DEBUG_SHOW_EXPR
9336 int i;
9338 printf("==== Expr ====\n");
9339 for (i = 0; i < expr->len; i++) {
9340 ScriptToken *t = &expr->token[i];
9342 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9345 #endif
9347 /* Check program correctness. */
9348 if (ExprCheckCorrectness(interp, objPtr, expr) != JIM_OK) {
9349 /* ExprCheckCorrectness set an error in this case */
9350 ExprFreeByteCode(interp, expr);
9351 expr = NULL;
9352 goto err;
9355 rc = JIM_OK;
9357 err:
9358 /* Free the old internal rep and set the new one. */
9359 Jim_DecrRefCount(interp, fileNameObj);
9360 Jim_FreeIntRep(interp, objPtr);
9361 Jim_SetIntRepPtr(objPtr, expr);
9362 objPtr->typePtr = &exprObjType;
9363 return rc;
9366 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9368 if (objPtr->typePtr != &exprObjType) {
9369 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9370 return NULL;
9373 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9376 #ifdef JIM_OPTIMIZATION
9377 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9379 if (token->type == JIM_TT_EXPR_INT)
9380 return token->objPtr;
9381 else if (token->type == JIM_TT_VAR)
9382 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9383 else if (token->type == JIM_TT_DICTSUGAR)
9384 return JimExpandDictSugar(interp, token->objPtr);
9385 else
9386 return NULL;
9388 #endif
9390 /* -----------------------------------------------------------------------------
9391 * Expressions evaluation.
9392 * Jim uses a specialized stack-based virtual machine for expressions,
9393 * that takes advantage of the fact that expr's operators
9394 * can't be redefined.
9396 * Jim_EvalExpression() uses the bytecode compiled by
9397 * SetExprFromAny() method of the "expression" object.
9399 * On success a Tcl Object containing the result of the evaluation
9400 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9401 * returned.
9402 * On error the function returns a retcode != to JIM_OK and set a suitable
9403 * error on the interp.
9404 * ---------------------------------------------------------------------------*/
9405 #define JIM_EE_STATICSTACK_LEN 10
9407 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9409 ExprByteCode *expr;
9410 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9411 int i;
9412 int retcode = JIM_OK;
9413 struct JimExprState e;
9415 expr = JimGetExpression(interp, exprObjPtr);
9416 if (!expr) {
9417 return JIM_ERR; /* error in expression. */
9420 #ifdef JIM_OPTIMIZATION
9421 /* Check for one of the following common expressions used by while/for
9423 * CONST
9424 * $a
9425 * !$a
9426 * $a < CONST, $a < $b
9427 * $a <= CONST, $a <= $b
9428 * $a > CONST, $a > $b
9429 * $a >= CONST, $a >= $b
9430 * $a != CONST, $a != $b
9431 * $a == CONST, $a == $b
9434 Jim_Obj *objPtr;
9436 /* STEP 1 -- Check if there are the conditions to run the specialized
9437 * version of while */
9439 switch (expr->len) {
9440 case 1:
9441 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9442 if (objPtr) {
9443 Jim_IncrRefCount(objPtr);
9444 *exprResultPtrPtr = objPtr;
9445 return JIM_OK;
9447 break;
9449 case 2:
9450 if (expr->token[1].type == JIM_EXPROP_NOT) {
9451 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9453 if (objPtr && JimIsWide(objPtr)) {
9454 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9455 Jim_IncrRefCount(*exprResultPtrPtr);
9456 return JIM_OK;
9459 break;
9461 case 3:
9462 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9463 if (objPtr && JimIsWide(objPtr)) {
9464 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9465 if (objPtr2 && JimIsWide(objPtr2)) {
9466 jim_wide wideValueA = JimWideValue(objPtr);
9467 jim_wide wideValueB = JimWideValue(objPtr2);
9468 int cmpRes;
9469 switch (expr->token[2].type) {
9470 case JIM_EXPROP_LT:
9471 cmpRes = wideValueA < wideValueB;
9472 break;
9473 case JIM_EXPROP_LTE:
9474 cmpRes = wideValueA <= wideValueB;
9475 break;
9476 case JIM_EXPROP_GT:
9477 cmpRes = wideValueA > wideValueB;
9478 break;
9479 case JIM_EXPROP_GTE:
9480 cmpRes = wideValueA >= wideValueB;
9481 break;
9482 case JIM_EXPROP_NUMEQ:
9483 cmpRes = wideValueA == wideValueB;
9484 break;
9485 case JIM_EXPROP_NUMNE:
9486 cmpRes = wideValueA != wideValueB;
9487 break;
9488 default:
9489 goto noopt;
9491 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9492 Jim_IncrRefCount(*exprResultPtrPtr);
9493 return JIM_OK;
9496 break;
9499 noopt:
9500 #endif
9502 /* In order to avoid that the internal repr gets freed due to
9503 * shimmering of the exprObjPtr's object, we make the internal rep
9504 * shared. */
9505 expr->inUse++;
9507 /* The stack-based expr VM itself */
9509 /* Stack allocation. Expr programs have the feature that
9510 * a program of length N can't require a stack longer than
9511 * N. */
9512 if (expr->len > JIM_EE_STATICSTACK_LEN)
9513 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9514 else
9515 e.stack = staticStack;
9517 e.stacklen = 0;
9519 /* Execute every instruction */
9520 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9521 Jim_Obj *objPtr;
9523 switch (expr->token[i].type) {
9524 case JIM_TT_EXPR_INT:
9525 case JIM_TT_EXPR_DOUBLE:
9526 case JIM_TT_EXPR_BOOLEAN:
9527 case JIM_TT_STR:
9528 ExprPush(&e, expr->token[i].objPtr);
9529 break;
9531 case JIM_TT_VAR:
9532 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9533 if (objPtr) {
9534 ExprPush(&e, objPtr);
9536 else {
9537 retcode = JIM_ERR;
9539 break;
9541 case JIM_TT_DICTSUGAR:
9542 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9543 if (objPtr) {
9544 ExprPush(&e, objPtr);
9546 else {
9547 retcode = JIM_ERR;
9549 break;
9551 case JIM_TT_ESC:
9552 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9553 if (retcode == JIM_OK) {
9554 ExprPush(&e, objPtr);
9556 break;
9558 case JIM_TT_CMD:
9559 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9560 if (retcode == JIM_OK) {
9561 ExprPush(&e, Jim_GetResult(interp));
9563 break;
9565 default:{
9566 /* Find and execute the operation */
9567 e.skip = 0;
9568 e.opcode = expr->token[i].type;
9570 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9571 /* Skip some opcodes if necessary */
9572 i += e.skip;
9573 continue;
9578 expr->inUse--;
9580 if (retcode == JIM_OK) {
9581 *exprResultPtrPtr = ExprPop(&e);
9583 else {
9584 for (i = 0; i < e.stacklen; i++) {
9585 Jim_DecrRefCount(interp, e.stack[i]);
9588 if (e.stack != staticStack) {
9589 Jim_Free(e.stack);
9591 return retcode;
9594 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9596 int retcode;
9597 jim_wide wideValue;
9598 double doubleValue;
9599 int booleanValue;
9600 Jim_Obj *exprResultPtr;
9602 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9603 if (retcode != JIM_OK)
9604 return retcode;
9606 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9607 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9608 if (Jim_GetBoolean(interp, exprResultPtr, &booleanValue) != JIM_OK) {
9609 Jim_DecrRefCount(interp, exprResultPtr);
9610 return JIM_ERR;
9611 } else {
9612 Jim_DecrRefCount(interp, exprResultPtr);
9613 *boolPtr = booleanValue;
9614 return JIM_OK;
9617 else {
9618 Jim_DecrRefCount(interp, exprResultPtr);
9619 *boolPtr = doubleValue != 0;
9620 return JIM_OK;
9623 *boolPtr = wideValue != 0;
9625 Jim_DecrRefCount(interp, exprResultPtr);
9626 return JIM_OK;
9629 /* -----------------------------------------------------------------------------
9630 * ScanFormat String Object
9631 * ---------------------------------------------------------------------------*/
9633 /* This Jim_Obj will held a parsed representation of a format string passed to
9634 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9635 * to be parsed in its entirely first and then, if correct, can be used for
9636 * scanning. To avoid endless re-parsing, the parsed representation will be
9637 * stored in an internal representation and re-used for performance reason. */
9639 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9640 * scanformat string. This part will later be used to extract information
9641 * out from the string to be parsed by Jim_ScanString */
9643 typedef struct ScanFmtPartDescr
9645 char *arg; /* Specification of a CHARSET conversion */
9646 char *prefix; /* Prefix to be scanned literally before conversion */
9647 size_t width; /* Maximal width of input to be converted */
9648 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9649 char type; /* Type of conversion (e.g. c, d, f) */
9650 char modifier; /* Modify type (e.g. l - long, h - short */
9651 } ScanFmtPartDescr;
9653 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9654 * string parsed and separated in part descriptions. Furthermore it contains
9655 * the original string representation of the scanformat string to allow for
9656 * fast update of the Jim_Obj's string representation part.
9658 * As an add-on the internal object representation adds some scratch pad area
9659 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9660 * memory for purpose of string scanning.
9662 * The error member points to a static allocated string in case of a mal-
9663 * formed scanformat string or it contains '0' (NULL) in case of a valid
9664 * parse representation.
9666 * The whole memory of the internal representation is allocated as a single
9667 * area of memory that will be internally separated. So freeing and duplicating
9668 * of such an object is cheap */
9670 typedef struct ScanFmtStringObj
9672 jim_wide size; /* Size of internal repr in bytes */
9673 char *stringRep; /* Original string representation */
9674 size_t count; /* Number of ScanFmtPartDescr contained */
9675 size_t convCount; /* Number of conversions that will assign */
9676 size_t maxPos; /* Max position index if XPG3 is used */
9677 const char *error; /* Ptr to error text (NULL if no error */
9678 char *scratch; /* Some scratch pad used by Jim_ScanString */
9679 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9680 } ScanFmtStringObj;
9683 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9684 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9685 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9687 static const Jim_ObjType scanFmtStringObjType = {
9688 "scanformatstring",
9689 FreeScanFmtInternalRep,
9690 DupScanFmtInternalRep,
9691 UpdateStringOfScanFmt,
9692 JIM_TYPE_NONE,
9695 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9697 JIM_NOTUSED(interp);
9698 Jim_Free((char *)objPtr->internalRep.ptr);
9699 objPtr->internalRep.ptr = 0;
9702 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9704 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9705 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9707 JIM_NOTUSED(interp);
9708 memcpy(newVec, srcPtr->internalRep.ptr, size);
9709 dupPtr->internalRep.ptr = newVec;
9710 dupPtr->typePtr = &scanFmtStringObjType;
9713 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9715 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9718 /* SetScanFmtFromAny will parse a given string and create the internal
9719 * representation of the format specification. In case of an error
9720 * the error data member of the internal representation will be set
9721 * to an descriptive error text and the function will be left with
9722 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9723 * specification */
9725 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9727 ScanFmtStringObj *fmtObj;
9728 char *buffer;
9729 int maxCount, i, approxSize, lastPos = -1;
9730 const char *fmt = objPtr->bytes;
9731 int maxFmtLen = objPtr->length;
9732 const char *fmtEnd = fmt + maxFmtLen;
9733 int curr;
9735 Jim_FreeIntRep(interp, objPtr);
9736 /* Count how many conversions could take place maximally */
9737 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9738 if (fmt[i] == '%')
9739 ++maxCount;
9740 /* Calculate an approximation of the memory necessary */
9741 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9742 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9743 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9744 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9745 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9746 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9747 +1; /* safety byte */
9748 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9749 memset(fmtObj, 0, approxSize);
9750 fmtObj->size = approxSize;
9751 fmtObj->maxPos = 0;
9752 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9753 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9754 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9755 buffer = fmtObj->stringRep + maxFmtLen + 1;
9756 objPtr->internalRep.ptr = fmtObj;
9757 objPtr->typePtr = &scanFmtStringObjType;
9758 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9759 int width = 0, skip;
9760 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9762 fmtObj->count++;
9763 descr->width = 0; /* Assume width unspecified */
9764 /* Overread and store any "literal" prefix */
9765 if (*fmt != '%' || fmt[1] == '%') {
9766 descr->type = 0;
9767 descr->prefix = &buffer[i];
9768 for (; fmt < fmtEnd; ++fmt) {
9769 if (*fmt == '%') {
9770 if (fmt[1] != '%')
9771 break;
9772 ++fmt;
9774 buffer[i++] = *fmt;
9776 buffer[i++] = 0;
9778 /* Skip the conversion introducing '%' sign */
9779 ++fmt;
9780 /* End reached due to non-conversion literal only? */
9781 if (fmt >= fmtEnd)
9782 goto done;
9783 descr->pos = 0; /* Assume "natural" positioning */
9784 if (*fmt == '*') {
9785 descr->pos = -1; /* Okay, conversion will not be assigned */
9786 ++fmt;
9788 else
9789 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9790 /* Check if next token is a number (could be width or pos */
9791 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9792 fmt += skip;
9793 /* Was the number a XPG3 position specifier? */
9794 if (descr->pos != -1 && *fmt == '$') {
9795 int prev;
9797 ++fmt;
9798 descr->pos = width;
9799 width = 0;
9800 /* Look if "natural" postioning and XPG3 one was mixed */
9801 if ((lastPos == 0 && descr->pos > 0)
9802 || (lastPos > 0 && descr->pos == 0)) {
9803 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9804 return JIM_ERR;
9806 /* Look if this position was already used */
9807 for (prev = 0; prev < curr; ++prev) {
9808 if (fmtObj->descr[prev].pos == -1)
9809 continue;
9810 if (fmtObj->descr[prev].pos == descr->pos) {
9811 fmtObj->error =
9812 "variable is assigned by multiple \"%n$\" conversion specifiers";
9813 return JIM_ERR;
9816 /* Try to find a width after the XPG3 specifier */
9817 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9818 descr->width = width;
9819 fmt += skip;
9821 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9822 fmtObj->maxPos = descr->pos;
9824 else {
9825 /* Number was not a XPG3, so it has to be a width */
9826 descr->width = width;
9829 /* If positioning mode was undetermined yet, fix this */
9830 if (lastPos == -1)
9831 lastPos = descr->pos;
9832 /* Handle CHARSET conversion type ... */
9833 if (*fmt == '[') {
9834 int swapped = 1, beg = i, end, j;
9836 descr->type = '[';
9837 descr->arg = &buffer[i];
9838 ++fmt;
9839 if (*fmt == '^')
9840 buffer[i++] = *fmt++;
9841 if (*fmt == ']')
9842 buffer[i++] = *fmt++;
9843 while (*fmt && *fmt != ']')
9844 buffer[i++] = *fmt++;
9845 if (*fmt != ']') {
9846 fmtObj->error = "unmatched [ in format string";
9847 return JIM_ERR;
9849 end = i;
9850 buffer[i++] = 0;
9851 /* In case a range fence was given "backwards", swap it */
9852 while (swapped) {
9853 swapped = 0;
9854 for (j = beg + 1; j < end - 1; ++j) {
9855 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9856 char tmp = buffer[j - 1];
9858 buffer[j - 1] = buffer[j + 1];
9859 buffer[j + 1] = tmp;
9860 swapped = 1;
9865 else {
9866 /* Remember any valid modifier if given */
9867 if (strchr("hlL", *fmt) != 0)
9868 descr->modifier = tolower((int)*fmt++);
9870 descr->type = *fmt;
9871 if (strchr("efgcsndoxui", *fmt) == 0) {
9872 fmtObj->error = "bad scan conversion character";
9873 return JIM_ERR;
9875 else if (*fmt == 'c' && descr->width != 0) {
9876 fmtObj->error = "field width may not be specified in %c " "conversion";
9877 return JIM_ERR;
9879 else if (*fmt == 'u' && descr->modifier == 'l') {
9880 fmtObj->error = "unsigned wide not supported";
9881 return JIM_ERR;
9884 curr++;
9886 done:
9887 return JIM_OK;
9890 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9892 #define FormatGetCnvCount(_fo_) \
9893 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9894 #define FormatGetMaxPos(_fo_) \
9895 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9896 #define FormatGetError(_fo_) \
9897 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9899 /* JimScanAString is used to scan an unspecified string that ends with
9900 * next WS, or a string that is specified via a charset.
9903 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9905 char *buffer = Jim_StrDup(str);
9906 char *p = buffer;
9908 while (*str) {
9909 int c;
9910 int n;
9912 if (!sdescr && isspace(UCHAR(*str)))
9913 break; /* EOS via WS if unspecified */
9915 n = utf8_tounicode(str, &c);
9916 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9917 break;
9918 while (n--)
9919 *p++ = *str++;
9921 *p = 0;
9922 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9925 /* ScanOneEntry will scan one entry out of the string passed as argument.
9926 * It use the sscanf() function for this task. After extracting and
9927 * converting of the value, the count of scanned characters will be
9928 * returned of -1 in case of no conversion tool place and string was
9929 * already scanned thru */
9931 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9932 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9934 const char *tok;
9935 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9936 size_t scanned = 0;
9937 size_t anchor = pos;
9938 int i;
9939 Jim_Obj *tmpObj = NULL;
9941 /* First pessimistically assume, we will not scan anything :-) */
9942 *valObjPtr = 0;
9943 if (descr->prefix) {
9944 /* There was a prefix given before the conversion, skip it and adjust
9945 * the string-to-be-parsed accordingly */
9946 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9947 /* If prefix require, skip WS */
9948 if (isspace(UCHAR(descr->prefix[i])))
9949 while (pos < strLen && isspace(UCHAR(str[pos])))
9950 ++pos;
9951 else if (descr->prefix[i] != str[pos])
9952 break; /* Prefix do not match here, leave the loop */
9953 else
9954 ++pos; /* Prefix matched so far, next round */
9956 if (pos >= strLen) {
9957 return -1; /* All of str consumed: EOF condition */
9959 else if (descr->prefix[i] != 0)
9960 return 0; /* Not whole prefix consumed, no conversion possible */
9962 /* For all but following conversion, skip leading WS */
9963 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9964 while (isspace(UCHAR(str[pos])))
9965 ++pos;
9966 /* Determine how much skipped/scanned so far */
9967 scanned = pos - anchor;
9969 /* %c is a special, simple case. no width */
9970 if (descr->type == 'n') {
9971 /* Return pseudo conversion means: how much scanned so far? */
9972 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9974 else if (pos >= strLen) {
9975 /* Cannot scan anything, as str is totally consumed */
9976 return -1;
9978 else if (descr->type == 'c') {
9979 int c;
9980 scanned += utf8_tounicode(&str[pos], &c);
9981 *valObjPtr = Jim_NewIntObj(interp, c);
9982 return scanned;
9984 else {
9985 /* Processing of conversions follows ... */
9986 if (descr->width > 0) {
9987 /* Do not try to scan as fas as possible but only the given width.
9988 * To ensure this, we copy the part that should be scanned. */
9989 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9990 size_t tLen = descr->width > sLen ? sLen : descr->width;
9992 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9993 tok = tmpObj->bytes;
9995 else {
9996 /* As no width was given, simply refer to the original string */
9997 tok = &str[pos];
9999 switch (descr->type) {
10000 case 'd':
10001 case 'o':
10002 case 'x':
10003 case 'u':
10004 case 'i':{
10005 char *endp; /* Position where the number finished */
10006 jim_wide w;
10008 int base = descr->type == 'o' ? 8
10009 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
10011 /* Try to scan a number with the given base */
10012 if (base == 0) {
10013 w = jim_strtoull(tok, &endp);
10015 else {
10016 w = strtoull(tok, &endp, base);
10019 if (endp != tok) {
10020 /* There was some number sucessfully scanned! */
10021 *valObjPtr = Jim_NewIntObj(interp, w);
10023 /* Adjust the number-of-chars scanned so far */
10024 scanned += endp - tok;
10026 else {
10027 /* Nothing was scanned. We have to determine if this
10028 * happened due to e.g. prefix mismatch or input str
10029 * exhausted */
10030 scanned = *tok ? 0 : -1;
10032 break;
10034 case 's':
10035 case '[':{
10036 *valObjPtr = JimScanAString(interp, descr->arg, tok);
10037 scanned += Jim_Length(*valObjPtr);
10038 break;
10040 case 'e':
10041 case 'f':
10042 case 'g':{
10043 char *endp;
10044 double value = strtod(tok, &endp);
10046 if (endp != tok) {
10047 /* There was some number sucessfully scanned! */
10048 *valObjPtr = Jim_NewDoubleObj(interp, value);
10049 /* Adjust the number-of-chars scanned so far */
10050 scanned += endp - tok;
10052 else {
10053 /* Nothing was scanned. We have to determine if this
10054 * happened due to e.g. prefix mismatch or input str
10055 * exhausted */
10056 scanned = *tok ? 0 : -1;
10058 break;
10061 /* If a substring was allocated (due to pre-defined width) do not
10062 * forget to free it */
10063 if (tmpObj) {
10064 Jim_FreeNewObj(interp, tmpObj);
10067 return scanned;
10070 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10071 * string and returns all converted (and not ignored) values in a list back
10072 * to the caller. If an error occured, a NULL pointer will be returned */
10074 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10076 size_t i, pos;
10077 int scanned = 1;
10078 const char *str = Jim_String(strObjPtr);
10079 int strLen = Jim_Utf8Length(interp, strObjPtr);
10080 Jim_Obj *resultList = 0;
10081 Jim_Obj **resultVec = 0;
10082 int resultc;
10083 Jim_Obj *emptyStr = 0;
10084 ScanFmtStringObj *fmtObj;
10086 /* This should never happen. The format object should already be of the correct type */
10087 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10089 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10090 /* Check if format specification was valid */
10091 if (fmtObj->error != 0) {
10092 if (flags & JIM_ERRMSG)
10093 Jim_SetResultString(interp, fmtObj->error, -1);
10094 return 0;
10096 /* Allocate a new "shared" empty string for all unassigned conversions */
10097 emptyStr = Jim_NewEmptyStringObj(interp);
10098 Jim_IncrRefCount(emptyStr);
10099 /* Create a list and fill it with empty strings up to max specified XPG3 */
10100 resultList = Jim_NewListObj(interp, NULL, 0);
10101 if (fmtObj->maxPos > 0) {
10102 for (i = 0; i < fmtObj->maxPos; ++i)
10103 Jim_ListAppendElement(interp, resultList, emptyStr);
10104 JimListGetElements(interp, resultList, &resultc, &resultVec);
10106 /* Now handle every partial format description */
10107 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10108 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10109 Jim_Obj *value = 0;
10111 /* Only last type may be "literal" w/o conversion - skip it! */
10112 if (descr->type == 0)
10113 continue;
10114 /* As long as any conversion could be done, we will proceed */
10115 if (scanned > 0)
10116 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10117 /* In case our first try results in EOF, we will leave */
10118 if (scanned == -1 && i == 0)
10119 goto eof;
10120 /* Advance next pos-to-be-scanned for the amount scanned already */
10121 pos += scanned;
10123 /* value == 0 means no conversion took place so take empty string */
10124 if (value == 0)
10125 value = Jim_NewEmptyStringObj(interp);
10126 /* If value is a non-assignable one, skip it */
10127 if (descr->pos == -1) {
10128 Jim_FreeNewObj(interp, value);
10130 else if (descr->pos == 0)
10131 /* Otherwise append it to the result list if no XPG3 was given */
10132 Jim_ListAppendElement(interp, resultList, value);
10133 else if (resultVec[descr->pos - 1] == emptyStr) {
10134 /* But due to given XPG3, put the value into the corr. slot */
10135 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10136 Jim_IncrRefCount(value);
10137 resultVec[descr->pos - 1] = value;
10139 else {
10140 /* Otherwise, the slot was already used - free obj and ERROR */
10141 Jim_FreeNewObj(interp, value);
10142 goto err;
10145 Jim_DecrRefCount(interp, emptyStr);
10146 return resultList;
10147 eof:
10148 Jim_DecrRefCount(interp, emptyStr);
10149 Jim_FreeNewObj(interp, resultList);
10150 return (Jim_Obj *)EOF;
10151 err:
10152 Jim_DecrRefCount(interp, emptyStr);
10153 Jim_FreeNewObj(interp, resultList);
10154 return 0;
10157 /* -----------------------------------------------------------------------------
10158 * Pseudo Random Number Generation
10159 * ---------------------------------------------------------------------------*/
10160 /* Initialize the sbox with the numbers from 0 to 255 */
10161 static void JimPrngInit(Jim_Interp *interp)
10163 #define PRNG_SEED_SIZE 256
10164 int i;
10165 unsigned int *seed;
10166 time_t t = time(NULL);
10168 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10170 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10171 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10172 seed[i] = (rand() ^ t ^ clock());
10174 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10175 Jim_Free(seed);
10178 /* Generates N bytes of random data */
10179 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10181 Jim_PrngState *prng;
10182 unsigned char *destByte = (unsigned char *)dest;
10183 unsigned int si, sj, x;
10185 /* initialization, only needed the first time */
10186 if (interp->prngState == NULL)
10187 JimPrngInit(interp);
10188 prng = interp->prngState;
10189 /* generates 'len' bytes of pseudo-random numbers */
10190 for (x = 0; x < len; x++) {
10191 prng->i = (prng->i + 1) & 0xff;
10192 si = prng->sbox[prng->i];
10193 prng->j = (prng->j + si) & 0xff;
10194 sj = prng->sbox[prng->j];
10195 prng->sbox[prng->i] = sj;
10196 prng->sbox[prng->j] = si;
10197 *destByte++ = prng->sbox[(si + sj) & 0xff];
10201 /* Re-seed the generator with user-provided bytes */
10202 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10204 int i;
10205 Jim_PrngState *prng;
10207 /* initialization, only needed the first time */
10208 if (interp->prngState == NULL)
10209 JimPrngInit(interp);
10210 prng = interp->prngState;
10212 /* Set the sbox[i] with i */
10213 for (i = 0; i < 256; i++)
10214 prng->sbox[i] = i;
10215 /* Now use the seed to perform a random permutation of the sbox */
10216 for (i = 0; i < seedLen; i++) {
10217 unsigned char t;
10219 t = prng->sbox[i & 0xFF];
10220 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10221 prng->sbox[seed[i]] = t;
10223 prng->i = prng->j = 0;
10225 /* discard at least the first 256 bytes of stream.
10226 * borrow the seed buffer for this
10228 for (i = 0; i < 256; i += seedLen) {
10229 JimRandomBytes(interp, seed, seedLen);
10233 /* [incr] */
10234 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10236 jim_wide wideValue, increment = 1;
10237 Jim_Obj *intObjPtr;
10239 if (argc != 2 && argc != 3) {
10240 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10241 return JIM_ERR;
10243 if (argc == 3) {
10244 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10245 return JIM_ERR;
10247 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10248 if (!intObjPtr) {
10249 /* Set missing variable to 0 */
10250 wideValue = 0;
10252 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10253 return JIM_ERR;
10255 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10256 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10257 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10258 Jim_FreeNewObj(interp, intObjPtr);
10259 return JIM_ERR;
10262 else {
10263 /* Can do it the quick way */
10264 Jim_InvalidateStringRep(intObjPtr);
10265 JimWideValue(intObjPtr) = wideValue + increment;
10267 /* The following step is required in order to invalidate the
10268 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10269 if (argv[1]->typePtr != &variableObjType) {
10270 /* Note that this can't fail since GetVariable already succeeded */
10271 Jim_SetVariable(interp, argv[1], intObjPtr);
10274 Jim_SetResult(interp, intObjPtr);
10275 return JIM_OK;
10279 /* -----------------------------------------------------------------------------
10280 * Eval
10281 * ---------------------------------------------------------------------------*/
10282 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10283 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10285 /* Handle calls to the [unknown] command */
10286 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10288 int retcode;
10290 /* If JimUnknown() is recursively called too many times...
10291 * done here
10293 if (interp->unknown_called > 50) {
10294 return JIM_ERR;
10297 /* The object interp->unknown just contains
10298 * the "unknown" string, it is used in order to
10299 * avoid to lookup the unknown command every time
10300 * but instead to cache the result. */
10302 /* If the [unknown] command does not exist ... */
10303 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10304 return JIM_ERR;
10306 interp->unknown_called++;
10307 /* XXX: Are we losing fileNameObj and linenr? */
10308 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10309 interp->unknown_called--;
10311 return retcode;
10314 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10316 int retcode;
10317 Jim_Cmd *cmdPtr;
10319 #if 0
10320 printf("invoke");
10321 int j;
10322 for (j = 0; j < objc; j++) {
10323 printf(" '%s'", Jim_String(objv[j]));
10325 printf("\n");
10326 #endif
10328 if (interp->framePtr->tailcallCmd) {
10329 /* Special tailcall command was pre-resolved */
10330 cmdPtr = interp->framePtr->tailcallCmd;
10331 interp->framePtr->tailcallCmd = NULL;
10333 else {
10334 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10335 if (cmdPtr == NULL) {
10336 return JimUnknown(interp, objc, objv);
10338 JimIncrCmdRefCount(cmdPtr);
10341 if (interp->evalDepth == interp->maxEvalDepth) {
10342 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10343 retcode = JIM_ERR;
10344 goto out;
10346 interp->evalDepth++;
10348 /* Call it -- Make sure result is an empty object. */
10349 Jim_SetEmptyResult(interp);
10350 if (cmdPtr->isproc) {
10351 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10353 else {
10354 interp->cmdPrivData = cmdPtr->u.native.privData;
10355 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10357 interp->evalDepth--;
10359 out:
10360 JimDecrCmdRefCount(interp, cmdPtr);
10362 return retcode;
10365 /* Eval the object vector 'objv' composed of 'objc' elements.
10366 * Every element is used as single argument.
10367 * Jim_EvalObj() will call this function every time its object
10368 * argument is of "list" type, with no string representation.
10370 * This is possible because the string representation of a
10371 * list object generated by the UpdateStringOfList is made
10372 * in a way that ensures that every list element is a different
10373 * command argument. */
10374 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10376 int i, retcode;
10378 /* Incr refcount of arguments. */
10379 for (i = 0; i < objc; i++)
10380 Jim_IncrRefCount(objv[i]);
10382 retcode = JimInvokeCommand(interp, objc, objv);
10384 /* Decr refcount of arguments and return the retcode */
10385 for (i = 0; i < objc; i++)
10386 Jim_DecrRefCount(interp, objv[i]);
10388 return retcode;
10392 * Invokes 'prefix' as a command with the objv array as arguments.
10394 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10396 int ret;
10397 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10399 nargv[0] = prefix;
10400 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10401 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10402 Jim_Free(nargv);
10403 return ret;
10406 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10408 if (!interp->errorFlag) {
10409 /* This is the first error, so save the file/line information and reset the stack */
10410 interp->errorFlag = 1;
10411 Jim_IncrRefCount(script->fileNameObj);
10412 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10413 interp->errorFileNameObj = script->fileNameObj;
10414 interp->errorLine = script->linenr;
10416 JimResetStackTrace(interp);
10417 /* Always add a level where the error first occurs */
10418 interp->addStackTrace++;
10421 /* Now if this is an "interesting" level, add it to the stack trace */
10422 if (interp->addStackTrace > 0) {
10423 /* Add the stack info for the current level */
10425 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10427 /* Note: if we didn't have a filename for this level,
10428 * don't clear the addStackTrace flag
10429 * so we can pick it up at the next level
10431 if (Jim_Length(script->fileNameObj)) {
10432 interp->addStackTrace = 0;
10435 Jim_DecrRefCount(interp, interp->errorProc);
10436 interp->errorProc = interp->emptyObj;
10437 Jim_IncrRefCount(interp->errorProc);
10441 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10443 Jim_Obj *objPtr;
10445 switch (token->type) {
10446 case JIM_TT_STR:
10447 case JIM_TT_ESC:
10448 objPtr = token->objPtr;
10449 break;
10450 case JIM_TT_VAR:
10451 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10452 break;
10453 case JIM_TT_DICTSUGAR:
10454 objPtr = JimExpandDictSugar(interp, token->objPtr);
10455 break;
10456 case JIM_TT_EXPRSUGAR:
10457 objPtr = JimExpandExprSugar(interp, token->objPtr);
10458 break;
10459 case JIM_TT_CMD:
10460 switch (Jim_EvalObj(interp, token->objPtr)) {
10461 case JIM_OK:
10462 case JIM_RETURN:
10463 objPtr = interp->result;
10464 break;
10465 case JIM_BREAK:
10466 /* Stop substituting */
10467 return JIM_BREAK;
10468 case JIM_CONTINUE:
10469 /* just skip this one */
10470 return JIM_CONTINUE;
10471 default:
10472 return JIM_ERR;
10474 break;
10475 default:
10476 JimPanic((1,
10477 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10478 objPtr = NULL;
10479 break;
10481 if (objPtr) {
10482 *objPtrPtr = objPtr;
10483 return JIM_OK;
10485 return JIM_ERR;
10488 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10489 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10490 * The returned object has refcount = 0.
10492 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10494 int totlen = 0, i;
10495 Jim_Obj **intv;
10496 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10497 Jim_Obj *objPtr;
10498 char *s;
10500 if (tokens <= JIM_EVAL_SINTV_LEN)
10501 intv = sintv;
10502 else
10503 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10505 /* Compute every token forming the argument
10506 * in the intv objects vector. */
10507 for (i = 0; i < tokens; i++) {
10508 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10509 case JIM_OK:
10510 case JIM_RETURN:
10511 break;
10512 case JIM_BREAK:
10513 if (flags & JIM_SUBST_FLAG) {
10514 /* Stop here */
10515 tokens = i;
10516 continue;
10518 /* XXX: Should probably set an error about break outside loop */
10519 /* fall through to error */
10520 case JIM_CONTINUE:
10521 if (flags & JIM_SUBST_FLAG) {
10522 intv[i] = NULL;
10523 continue;
10525 /* XXX: Ditto continue outside loop */
10526 /* fall through to error */
10527 default:
10528 while (i--) {
10529 Jim_DecrRefCount(interp, intv[i]);
10531 if (intv != sintv) {
10532 Jim_Free(intv);
10534 return NULL;
10536 Jim_IncrRefCount(intv[i]);
10537 Jim_String(intv[i]);
10538 totlen += intv[i]->length;
10541 /* Fast path return for a single token */
10542 if (tokens == 1 && intv[0] && intv == sintv) {
10543 Jim_DecrRefCount(interp, intv[0]);
10544 return intv[0];
10547 /* Concatenate every token in an unique
10548 * object. */
10549 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10551 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10552 && token[2].type == JIM_TT_VAR) {
10553 /* May be able to do fast interpolated object -> dictSubst */
10554 objPtr->typePtr = &interpolatedObjType;
10555 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10556 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10557 Jim_IncrRefCount(intv[2]);
10559 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10560 /* The first interpolated token is source, so preserve the source info */
10561 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10565 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10566 objPtr->length = totlen;
10567 for (i = 0; i < tokens; i++) {
10568 if (intv[i]) {
10569 memcpy(s, intv[i]->bytes, intv[i]->length);
10570 s += intv[i]->length;
10571 Jim_DecrRefCount(interp, intv[i]);
10574 objPtr->bytes[totlen] = '\0';
10575 /* Free the intv vector if not static. */
10576 if (intv != sintv) {
10577 Jim_Free(intv);
10580 return objPtr;
10584 /* listPtr *must* be a list.
10585 * The contents of the list is evaluated with the first element as the command and
10586 * the remaining elements as the arguments.
10588 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10590 int retcode = JIM_OK;
10592 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10594 if (listPtr->internalRep.listValue.len) {
10595 Jim_IncrRefCount(listPtr);
10596 retcode = JimInvokeCommand(interp,
10597 listPtr->internalRep.listValue.len,
10598 listPtr->internalRep.listValue.ele);
10599 Jim_DecrRefCount(interp, listPtr);
10601 return retcode;
10604 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10606 SetListFromAny(interp, listPtr);
10607 return JimEvalObjList(interp, listPtr);
10610 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10612 int i;
10613 ScriptObj *script;
10614 ScriptToken *token;
10615 int retcode = JIM_OK;
10616 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10617 Jim_Obj *prevScriptObj;
10619 /* If the object is of type "list", with no string rep we can call
10620 * a specialized version of Jim_EvalObj() */
10621 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10622 return JimEvalObjList(interp, scriptObjPtr);
10625 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10626 script = JimGetScript(interp, scriptObjPtr);
10627 if (!JimScriptValid(interp, script)) {
10628 Jim_DecrRefCount(interp, scriptObjPtr);
10629 return JIM_ERR;
10632 /* Reset the interpreter result. This is useful to
10633 * return the empty result in the case of empty program. */
10634 Jim_SetEmptyResult(interp);
10636 token = script->token;
10638 #ifdef JIM_OPTIMIZATION
10639 /* Check for one of the following common scripts used by for, while
10641 * {}
10642 * incr a
10644 if (script->len == 0) {
10645 Jim_DecrRefCount(interp, scriptObjPtr);
10646 return JIM_OK;
10648 if (script->len == 3
10649 && token[1].objPtr->typePtr == &commandObjType
10650 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10651 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10652 && token[2].objPtr->typePtr == &variableObjType) {
10654 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10656 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10657 JimWideValue(objPtr)++;
10658 Jim_InvalidateStringRep(objPtr);
10659 Jim_DecrRefCount(interp, scriptObjPtr);
10660 Jim_SetResult(interp, objPtr);
10661 return JIM_OK;
10664 #endif
10666 /* Now we have to make sure the internal repr will not be
10667 * freed on shimmering.
10669 * Think for example to this:
10671 * set x {llength $x; ... some more code ...}; eval $x
10673 * In order to preserve the internal rep, we increment the
10674 * inUse field of the script internal rep structure. */
10675 script->inUse++;
10677 /* Stash the current script */
10678 prevScriptObj = interp->currentScriptObj;
10679 interp->currentScriptObj = scriptObjPtr;
10681 interp->errorFlag = 0;
10682 argv = sargv;
10684 /* Execute every command sequentially until the end of the script
10685 * or an error occurs.
10687 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10688 int argc;
10689 int j;
10691 /* First token of the line is always JIM_TT_LINE */
10692 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10693 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10695 /* Allocate the arguments vector if required */
10696 if (argc > JIM_EVAL_SARGV_LEN)
10697 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10699 /* Skip the JIM_TT_LINE token */
10700 i++;
10702 /* Populate the arguments objects.
10703 * If an error occurs, retcode will be set and
10704 * 'j' will be set to the number of args expanded
10706 for (j = 0; j < argc; j++) {
10707 long wordtokens = 1;
10708 int expand = 0;
10709 Jim_Obj *wordObjPtr = NULL;
10711 if (token[i].type == JIM_TT_WORD) {
10712 wordtokens = JimWideValue(token[i++].objPtr);
10713 if (wordtokens < 0) {
10714 expand = 1;
10715 wordtokens = -wordtokens;
10719 if (wordtokens == 1) {
10720 /* Fast path if the token does not
10721 * need interpolation */
10723 switch (token[i].type) {
10724 case JIM_TT_ESC:
10725 case JIM_TT_STR:
10726 wordObjPtr = token[i].objPtr;
10727 break;
10728 case JIM_TT_VAR:
10729 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10730 break;
10731 case JIM_TT_EXPRSUGAR:
10732 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10733 break;
10734 case JIM_TT_DICTSUGAR:
10735 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10736 break;
10737 case JIM_TT_CMD:
10738 retcode = Jim_EvalObj(interp, token[i].objPtr);
10739 if (retcode == JIM_OK) {
10740 wordObjPtr = Jim_GetResult(interp);
10742 break;
10743 default:
10744 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10747 else {
10748 /* For interpolation we call a helper
10749 * function to do the work for us. */
10750 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10753 if (!wordObjPtr) {
10754 if (retcode == JIM_OK) {
10755 retcode = JIM_ERR;
10757 break;
10760 Jim_IncrRefCount(wordObjPtr);
10761 i += wordtokens;
10763 if (!expand) {
10764 argv[j] = wordObjPtr;
10766 else {
10767 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10768 int len = Jim_ListLength(interp, wordObjPtr);
10769 int newargc = argc + len - 1;
10770 int k;
10772 if (len > 1) {
10773 if (argv == sargv) {
10774 if (newargc > JIM_EVAL_SARGV_LEN) {
10775 argv = Jim_Alloc(sizeof(*argv) * newargc);
10776 memcpy(argv, sargv, sizeof(*argv) * j);
10779 else {
10780 /* Need to realloc to make room for (len - 1) more entries */
10781 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10785 /* Now copy in the expanded version */
10786 for (k = 0; k < len; k++) {
10787 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10788 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10791 /* The original object reference is no longer needed,
10792 * after the expansion it is no longer present on
10793 * the argument vector, but the single elements are
10794 * in its place. */
10795 Jim_DecrRefCount(interp, wordObjPtr);
10797 /* And update the indexes */
10798 j--;
10799 argc += len - 1;
10803 if (retcode == JIM_OK && argc) {
10804 /* Invoke the command */
10805 retcode = JimInvokeCommand(interp, argc, argv);
10806 /* Check for a signal after each command */
10807 if (Jim_CheckSignal(interp)) {
10808 retcode = JIM_SIGNAL;
10812 /* Finished with the command, so decrement ref counts of each argument */
10813 while (j-- > 0) {
10814 Jim_DecrRefCount(interp, argv[j]);
10817 if (argv != sargv) {
10818 Jim_Free(argv);
10819 argv = sargv;
10823 /* Possibly add to the error stack trace */
10824 if (retcode == JIM_ERR) {
10825 JimAddErrorToStack(interp, script);
10827 /* Propagate the addStackTrace value through 'return -code error' */
10828 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10829 /* No need to add stack trace */
10830 interp->addStackTrace = 0;
10833 /* Restore the current script */
10834 interp->currentScriptObj = prevScriptObj;
10836 /* Note that we don't have to decrement inUse, because the
10837 * following code transfers our use of the reference again to
10838 * the script object. */
10839 Jim_FreeIntRep(interp, scriptObjPtr);
10840 scriptObjPtr->typePtr = &scriptObjType;
10841 Jim_SetIntRepPtr(scriptObjPtr, script);
10842 Jim_DecrRefCount(interp, scriptObjPtr);
10844 return retcode;
10847 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10849 int retcode;
10850 /* If argObjPtr begins with '&', do an automatic upvar */
10851 const char *varname = Jim_String(argNameObj);
10852 if (*varname == '&') {
10853 /* First check that the target variable exists */
10854 Jim_Obj *objPtr;
10855 Jim_CallFrame *savedCallFrame = interp->framePtr;
10857 interp->framePtr = interp->framePtr->parent;
10858 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10859 interp->framePtr = savedCallFrame;
10860 if (!objPtr) {
10861 return JIM_ERR;
10864 /* It exists, so perform the binding. */
10865 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10866 Jim_IncrRefCount(objPtr);
10867 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10868 Jim_DecrRefCount(interp, objPtr);
10870 else {
10871 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10873 return retcode;
10877 * Sets the interp result to be an error message indicating the required proc args.
10879 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10881 /* Create a nice error message, consistent with Tcl 8.5 */
10882 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10883 int i;
10885 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10886 Jim_AppendString(interp, argmsg, " ", 1);
10888 if (i == cmd->u.proc.argsPos) {
10889 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10890 /* Renamed args */
10891 Jim_AppendString(interp, argmsg, "?", 1);
10892 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10893 Jim_AppendString(interp, argmsg, " ...?", -1);
10895 else {
10896 /* We have plain args */
10897 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10900 else {
10901 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10902 Jim_AppendString(interp, argmsg, "?", 1);
10903 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10904 Jim_AppendString(interp, argmsg, "?", 1);
10906 else {
10907 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10908 if (*arg == '&') {
10909 arg++;
10911 Jim_AppendString(interp, argmsg, arg, -1);
10915 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10916 Jim_FreeNewObj(interp, argmsg);
10919 #ifdef jim_ext_namespace
10921 * [namespace eval]
10923 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10925 Jim_CallFrame *callFramePtr;
10926 int retcode;
10928 /* Create a new callframe */
10929 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10930 callFramePtr->argv = &interp->emptyObj;
10931 callFramePtr->argc = 0;
10932 callFramePtr->procArgsObjPtr = NULL;
10933 callFramePtr->procBodyObjPtr = scriptObj;
10934 callFramePtr->staticVars = NULL;
10935 callFramePtr->fileNameObj = interp->emptyObj;
10936 callFramePtr->line = 0;
10937 Jim_IncrRefCount(scriptObj);
10938 interp->framePtr = callFramePtr;
10940 /* Check if there are too nested calls */
10941 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10942 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10943 retcode = JIM_ERR;
10945 else {
10946 /* Eval the body */
10947 retcode = Jim_EvalObj(interp, scriptObj);
10950 /* Destroy the callframe */
10951 interp->framePtr = interp->framePtr->parent;
10952 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10954 return retcode;
10956 #endif
10958 /* Call a procedure implemented in Tcl.
10959 * It's possible to speed-up a lot this function, currently
10960 * the callframes are not cached, but allocated and
10961 * destroied every time. What is expecially costly is
10962 * to create/destroy the local vars hash table every time.
10964 * This can be fixed just implementing callframes caching
10965 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10966 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10968 Jim_CallFrame *callFramePtr;
10969 int i, d, retcode, optargs;
10970 ScriptObj *script;
10972 /* Check arity */
10973 if (argc - 1 < cmd->u.proc.reqArity ||
10974 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10975 JimSetProcWrongArgs(interp, argv[0], cmd);
10976 return JIM_ERR;
10979 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10980 /* Optimise for procedure with no body - useful for optional debugging */
10981 return JIM_OK;
10984 /* Check if there are too nested calls */
10985 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10986 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10987 return JIM_ERR;
10990 /* Create a new callframe */
10991 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10992 callFramePtr->argv = argv;
10993 callFramePtr->argc = argc;
10994 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10995 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10996 callFramePtr->staticVars = cmd->u.proc.staticVars;
10998 /* Remember where we were called from. */
10999 script = JimGetScript(interp, interp->currentScriptObj);
11000 callFramePtr->fileNameObj = script->fileNameObj;
11001 callFramePtr->line = script->linenr;
11003 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
11004 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
11005 interp->framePtr = callFramePtr;
11007 /* How many optional args are available */
11008 optargs = (argc - 1 - cmd->u.proc.reqArity);
11010 /* Step 'i' along the actual args, and step 'd' along the formal args */
11011 i = 1;
11012 for (d = 0; d < cmd->u.proc.argListLen; d++) {
11013 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
11014 if (d == cmd->u.proc.argsPos) {
11015 /* assign $args */
11016 Jim_Obj *listObjPtr;
11017 int argsLen = 0;
11018 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
11019 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
11021 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
11023 /* It is possible to rename args. */
11024 if (cmd->u.proc.arglist[d].defaultObjPtr) {
11025 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
11027 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
11028 if (retcode != JIM_OK) {
11029 goto badargset;
11032 i += argsLen;
11033 continue;
11036 /* Optional or required? */
11037 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
11038 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
11040 else {
11041 /* Ran out, so use the default */
11042 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
11044 if (retcode != JIM_OK) {
11045 goto badargset;
11049 /* Eval the body */
11050 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
11052 badargset:
11054 /* Free the callframe */
11055 interp->framePtr = interp->framePtr->parent;
11056 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
11058 /* Now chain any tailcalls in the parent frame */
11059 if (interp->framePtr->tailcallObj) {
11060 do {
11061 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
11063 interp->framePtr->tailcallObj = NULL;
11065 if (retcode == JIM_EVAL) {
11066 retcode = Jim_EvalObjList(interp, tailcallObj);
11067 if (retcode == JIM_RETURN) {
11068 /* If the result of the tailcall is 'return', push
11069 * it up to the caller
11071 interp->returnLevel++;
11074 Jim_DecrRefCount(interp, tailcallObj);
11075 } while (interp->framePtr->tailcallObj);
11077 /* If the tailcall chain finished early, may need to manually discard the command */
11078 if (interp->framePtr->tailcallCmd) {
11079 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11080 interp->framePtr->tailcallCmd = NULL;
11084 /* Handle the JIM_RETURN return code */
11085 if (retcode == JIM_RETURN) {
11086 if (--interp->returnLevel <= 0) {
11087 retcode = interp->returnCode;
11088 interp->returnCode = JIM_OK;
11089 interp->returnLevel = 0;
11092 else if (retcode == JIM_ERR) {
11093 interp->addStackTrace++;
11094 Jim_DecrRefCount(interp, interp->errorProc);
11095 interp->errorProc = argv[0];
11096 Jim_IncrRefCount(interp->errorProc);
11099 return retcode;
11102 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11104 int retval;
11105 Jim_Obj *scriptObjPtr;
11107 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11108 Jim_IncrRefCount(scriptObjPtr);
11110 if (filename) {
11111 Jim_Obj *prevScriptObj;
11113 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11115 prevScriptObj = interp->currentScriptObj;
11116 interp->currentScriptObj = scriptObjPtr;
11118 retval = Jim_EvalObj(interp, scriptObjPtr);
11120 interp->currentScriptObj = prevScriptObj;
11122 else {
11123 retval = Jim_EvalObj(interp, scriptObjPtr);
11125 Jim_DecrRefCount(interp, scriptObjPtr);
11126 return retval;
11129 int Jim_Eval(Jim_Interp *interp, const char *script)
11131 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11134 /* Execute script in the scope of the global level */
11135 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11137 int retval;
11138 Jim_CallFrame *savedFramePtr = interp->framePtr;
11140 interp->framePtr = interp->topFramePtr;
11141 retval = Jim_Eval(interp, script);
11142 interp->framePtr = savedFramePtr;
11144 return retval;
11147 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11149 int retval;
11150 Jim_CallFrame *savedFramePtr = interp->framePtr;
11152 interp->framePtr = interp->topFramePtr;
11153 retval = Jim_EvalFile(interp, filename);
11154 interp->framePtr = savedFramePtr;
11156 return retval;
11159 #include <sys/stat.h>
11161 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11163 FILE *fp;
11164 char *buf;
11165 Jim_Obj *scriptObjPtr;
11166 Jim_Obj *prevScriptObj;
11167 struct stat sb;
11168 int retcode;
11169 int readlen;
11171 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11172 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11173 return JIM_ERR;
11175 if (sb.st_size == 0) {
11176 fclose(fp);
11177 return JIM_OK;
11180 buf = Jim_Alloc(sb.st_size + 1);
11181 readlen = fread(buf, 1, sb.st_size, fp);
11182 if (ferror(fp)) {
11183 fclose(fp);
11184 Jim_Free(buf);
11185 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11186 return JIM_ERR;
11188 fclose(fp);
11189 buf[readlen] = 0;
11191 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11192 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11193 Jim_IncrRefCount(scriptObjPtr);
11195 prevScriptObj = interp->currentScriptObj;
11196 interp->currentScriptObj = scriptObjPtr;
11198 retcode = Jim_EvalObj(interp, scriptObjPtr);
11200 /* Handle the JIM_RETURN return code */
11201 if (retcode == JIM_RETURN) {
11202 if (--interp->returnLevel <= 0) {
11203 retcode = interp->returnCode;
11204 interp->returnCode = JIM_OK;
11205 interp->returnLevel = 0;
11208 if (retcode == JIM_ERR) {
11209 /* EvalFile changes context, so add a stack frame here */
11210 interp->addStackTrace++;
11213 interp->currentScriptObj = prevScriptObj;
11215 Jim_DecrRefCount(interp, scriptObjPtr);
11217 return retcode;
11220 /* -----------------------------------------------------------------------------
11221 * Subst
11222 * ---------------------------------------------------------------------------*/
11223 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11225 pc->tstart = pc->p;
11226 pc->tline = pc->linenr;
11228 if (pc->len == 0) {
11229 pc->tend = pc->p;
11230 pc->tt = JIM_TT_EOL;
11231 pc->eof = 1;
11232 return;
11234 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11235 JimParseCmd(pc);
11236 return;
11238 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11239 if (JimParseVar(pc) == JIM_OK) {
11240 return;
11242 /* Not a var, so treat as a string */
11243 pc->tstart = pc->p;
11244 flags |= JIM_SUBST_NOVAR;
11246 while (pc->len) {
11247 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11248 break;
11250 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11251 break;
11253 if (*pc->p == '\\' && pc->len > 1) {
11254 pc->p++;
11255 pc->len--;
11257 pc->p++;
11258 pc->len--;
11260 pc->tend = pc->p - 1;
11261 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11264 /* The subst object type reuses most of the data structures and functions
11265 * of the script object. Script's data structures are a bit more complex
11266 * for what is needed for [subst]itution tasks, but the reuse helps to
11267 * deal with a single data structure at the cost of some more memory
11268 * usage for substitutions. */
11270 /* This method takes the string representation of an object
11271 * as a Tcl string where to perform [subst]itution, and generates
11272 * the pre-parsed internal representation. */
11273 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11275 int scriptTextLen;
11276 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11277 struct JimParserCtx parser;
11278 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11279 ParseTokenList tokenlist;
11281 /* Initially parse the subst into tokens (in tokenlist) */
11282 ScriptTokenListInit(&tokenlist);
11284 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11285 while (1) {
11286 JimParseSubst(&parser, flags);
11287 if (parser.eof) {
11288 /* Note that subst doesn't need the EOL token */
11289 break;
11291 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11292 parser.tline);
11295 /* Create the "real" subst/script tokens from the initial token list */
11296 script->inUse = 1;
11297 script->substFlags = flags;
11298 script->fileNameObj = interp->emptyObj;
11299 Jim_IncrRefCount(script->fileNameObj);
11300 SubstObjAddTokens(interp, script, &tokenlist);
11302 /* No longer need the token list */
11303 ScriptTokenListFree(&tokenlist);
11305 #ifdef DEBUG_SHOW_SUBST
11307 int i;
11309 printf("==== Subst ====\n");
11310 for (i = 0; i < script->len; i++) {
11311 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11312 Jim_String(script->token[i].objPtr));
11315 #endif
11317 /* Free the old internal rep and set the new one. */
11318 Jim_FreeIntRep(interp, objPtr);
11319 Jim_SetIntRepPtr(objPtr, script);
11320 objPtr->typePtr = &scriptObjType;
11321 return JIM_OK;
11324 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11326 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11327 SetSubstFromAny(interp, objPtr, flags);
11328 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11331 /* Performs commands,variables,blackslashes substitution,
11332 * storing the result object (with refcount 0) into
11333 * resObjPtrPtr. */
11334 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11336 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11338 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11339 /* In order to preserve the internal rep, we increment the
11340 * inUse field of the script internal rep structure. */
11341 script->inUse++;
11343 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11345 script->inUse--;
11346 Jim_DecrRefCount(interp, substObjPtr);
11347 if (*resObjPtrPtr == NULL) {
11348 return JIM_ERR;
11350 return JIM_OK;
11353 /* -----------------------------------------------------------------------------
11354 * Core commands utility functions
11355 * ---------------------------------------------------------------------------*/
11356 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11358 Jim_Obj *objPtr;
11359 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11361 if (*msg) {
11362 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11364 Jim_IncrRefCount(listObjPtr);
11365 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11366 Jim_DecrRefCount(interp, listObjPtr);
11368 Jim_IncrRefCount(objPtr);
11369 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11370 Jim_DecrRefCount(interp, objPtr);
11374 * May add the key and/or value to the list.
11376 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11377 Jim_HashEntry *he, int type);
11379 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11382 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11383 * invoke the callback to add entries to a list.
11384 * Returns the list.
11386 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11387 JimHashtableIteratorCallbackType *callback, int type)
11389 Jim_HashEntry *he;
11390 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11392 /* Check for the non-pattern case. We can do this much more efficiently. */
11393 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11394 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11395 if (he) {
11396 callback(interp, listObjPtr, he, type);
11399 else {
11400 Jim_HashTableIterator htiter;
11401 JimInitHashTableIterator(ht, &htiter);
11402 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11403 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11404 callback(interp, listObjPtr, he, type);
11408 return listObjPtr;
11411 /* Keep these in order */
11412 #define JIM_CMDLIST_COMMANDS 0
11413 #define JIM_CMDLIST_PROCS 1
11414 #define JIM_CMDLIST_CHANNELS 2
11417 * Adds matching command names (procs, channels) to the list.
11419 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11420 Jim_HashEntry *he, int type)
11422 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11423 Jim_Obj *objPtr;
11425 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11426 /* not a proc */
11427 return;
11430 objPtr = Jim_NewStringObj(interp, he->key, -1);
11431 Jim_IncrRefCount(objPtr);
11433 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11434 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11436 Jim_DecrRefCount(interp, objPtr);
11439 /* type is JIM_CMDLIST_xxx */
11440 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11442 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11445 /* Keep these in order */
11446 #define JIM_VARLIST_GLOBALS 0
11447 #define JIM_VARLIST_LOCALS 1
11448 #define JIM_VARLIST_VARS 2
11450 #define JIM_VARLIST_VALUES 0x1000
11453 * Adds matching variable names to the list.
11455 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11456 Jim_HashEntry *he, int type)
11458 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11460 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11461 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11462 if (type & JIM_VARLIST_VALUES) {
11463 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11468 /* mode is JIM_VARLIST_xxx */
11469 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11471 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11472 /* For [info locals], if we are at top level an emtpy list
11473 * is returned. I don't agree, but we aim at compatibility (SS) */
11474 return interp->emptyObj;
11476 else {
11477 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11478 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11482 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11483 Jim_Obj **objPtrPtr, int info_level_cmd)
11485 Jim_CallFrame *targetCallFrame;
11487 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11488 if (targetCallFrame == NULL) {
11489 return JIM_ERR;
11491 /* No proc call at toplevel callframe */
11492 if (targetCallFrame == interp->topFramePtr) {
11493 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11494 return JIM_ERR;
11496 if (info_level_cmd) {
11497 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11499 else {
11500 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11502 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11503 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11504 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11505 *objPtrPtr = listObj;
11507 return JIM_OK;
11510 /* -----------------------------------------------------------------------------
11511 * Core commands
11512 * ---------------------------------------------------------------------------*/
11514 /* fake [puts] -- not the real puts, just for debugging. */
11515 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11517 if (argc != 2 && argc != 3) {
11518 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11519 return JIM_ERR;
11521 if (argc == 3) {
11522 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11523 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11524 return JIM_ERR;
11526 else {
11527 fputs(Jim_String(argv[2]), stdout);
11530 else {
11531 puts(Jim_String(argv[1]));
11533 return JIM_OK;
11536 /* Helper for [+] and [*] */
11537 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11539 jim_wide wideValue, res;
11540 double doubleValue, doubleRes;
11541 int i;
11543 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11545 for (i = 1; i < argc; i++) {
11546 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11547 goto trydouble;
11548 if (op == JIM_EXPROP_ADD)
11549 res += wideValue;
11550 else
11551 res *= wideValue;
11553 Jim_SetResultInt(interp, res);
11554 return JIM_OK;
11555 trydouble:
11556 doubleRes = (double)res;
11557 for (; i < argc; i++) {
11558 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11559 return JIM_ERR;
11560 if (op == JIM_EXPROP_ADD)
11561 doubleRes += doubleValue;
11562 else
11563 doubleRes *= doubleValue;
11565 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11566 return JIM_OK;
11569 /* Helper for [-] and [/] */
11570 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11572 jim_wide wideValue, res = 0;
11573 double doubleValue, doubleRes = 0;
11574 int i = 2;
11576 if (argc < 2) {
11577 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11578 return JIM_ERR;
11580 else if (argc == 2) {
11581 /* The arity = 2 case is different. For [- x] returns -x,
11582 * while [/ x] returns 1/x. */
11583 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11584 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11585 return JIM_ERR;
11587 else {
11588 if (op == JIM_EXPROP_SUB)
11589 doubleRes = -doubleValue;
11590 else
11591 doubleRes = 1.0 / doubleValue;
11592 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11593 return JIM_OK;
11596 if (op == JIM_EXPROP_SUB) {
11597 res = -wideValue;
11598 Jim_SetResultInt(interp, res);
11600 else {
11601 doubleRes = 1.0 / wideValue;
11602 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11604 return JIM_OK;
11606 else {
11607 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11608 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11609 != JIM_OK) {
11610 return JIM_ERR;
11612 else {
11613 goto trydouble;
11617 for (i = 2; i < argc; i++) {
11618 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11619 doubleRes = (double)res;
11620 goto trydouble;
11622 if (op == JIM_EXPROP_SUB)
11623 res -= wideValue;
11624 else
11625 res /= wideValue;
11627 Jim_SetResultInt(interp, res);
11628 return JIM_OK;
11629 trydouble:
11630 for (; i < argc; i++) {
11631 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11632 return JIM_ERR;
11633 if (op == JIM_EXPROP_SUB)
11634 doubleRes -= doubleValue;
11635 else
11636 doubleRes /= doubleValue;
11638 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11639 return JIM_OK;
11643 /* [+] */
11644 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11646 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11649 /* [*] */
11650 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11652 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11655 /* [-] */
11656 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11658 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11661 /* [/] */
11662 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11664 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11667 /* [set] */
11668 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11670 if (argc != 2 && argc != 3) {
11671 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11672 return JIM_ERR;
11674 if (argc == 2) {
11675 Jim_Obj *objPtr;
11677 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11678 if (!objPtr)
11679 return JIM_ERR;
11680 Jim_SetResult(interp, objPtr);
11681 return JIM_OK;
11683 /* argc == 3 case. */
11684 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11685 return JIM_ERR;
11686 Jim_SetResult(interp, argv[2]);
11687 return JIM_OK;
11690 /* [unset]
11692 * unset ?-nocomplain? ?--? ?varName ...?
11694 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11696 int i = 1;
11697 int complain = 1;
11699 while (i < argc) {
11700 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11701 i++;
11702 break;
11704 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11705 complain = 0;
11706 i++;
11707 continue;
11709 break;
11712 while (i < argc) {
11713 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11714 && complain) {
11715 return JIM_ERR;
11717 i++;
11719 return JIM_OK;
11722 /* [while] */
11723 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11725 if (argc != 3) {
11726 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11727 return JIM_ERR;
11730 /* The general purpose implementation of while starts here */
11731 while (1) {
11732 int boolean, retval;
11734 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11735 return retval;
11736 if (!boolean)
11737 break;
11739 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11740 switch (retval) {
11741 case JIM_BREAK:
11742 goto out;
11743 break;
11744 case JIM_CONTINUE:
11745 continue;
11746 break;
11747 default:
11748 return retval;
11752 out:
11753 Jim_SetEmptyResult(interp);
11754 return JIM_OK;
11757 /* [for] */
11758 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11760 int retval;
11761 int boolean = 1;
11762 Jim_Obj *varNamePtr = NULL;
11763 Jim_Obj *stopVarNamePtr = NULL;
11765 if (argc != 5) {
11766 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11767 return JIM_ERR;
11770 /* Do the initialisation */
11771 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11772 return retval;
11775 /* And do the first test now. Better for optimisation
11776 * if we can do next/test at the bottom of the loop
11778 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11780 /* Ready to do the body as follows:
11781 * while (1) {
11782 * body // check retcode
11783 * next // check retcode
11784 * test // check retcode/test bool
11788 #ifdef JIM_OPTIMIZATION
11789 /* Check if the for is on the form:
11790 * for ... {$i < CONST} {incr i}
11791 * for ... {$i < $j} {incr i}
11793 if (retval == JIM_OK && boolean) {
11794 ScriptObj *incrScript;
11795 ExprByteCode *expr;
11796 jim_wide stop, currentVal;
11797 Jim_Obj *objPtr;
11798 int cmpOffset;
11800 /* Do it only if there aren't shared arguments */
11801 expr = JimGetExpression(interp, argv[2]);
11802 incrScript = JimGetScript(interp, argv[3]);
11804 /* Ensure proper lengths to start */
11805 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11806 goto evalstart;
11808 /* Ensure proper token types. */
11809 if (incrScript->token[1].type != JIM_TT_ESC ||
11810 expr->token[0].type != JIM_TT_VAR ||
11811 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11812 goto evalstart;
11815 if (expr->token[2].type == JIM_EXPROP_LT) {
11816 cmpOffset = 0;
11818 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11819 cmpOffset = 1;
11821 else {
11822 goto evalstart;
11825 /* Update command must be incr */
11826 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11827 goto evalstart;
11830 /* incr, expression must be about the same variable */
11831 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11832 goto evalstart;
11835 /* Get the stop condition (must be a variable or integer) */
11836 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11837 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11838 goto evalstart;
11841 else {
11842 stopVarNamePtr = expr->token[1].objPtr;
11843 Jim_IncrRefCount(stopVarNamePtr);
11844 /* Keep the compiler happy */
11845 stop = 0;
11848 /* Initialization */
11849 varNamePtr = expr->token[0].objPtr;
11850 Jim_IncrRefCount(varNamePtr);
11852 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11853 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11854 goto testcond;
11857 /* --- OPTIMIZED FOR --- */
11858 while (retval == JIM_OK) {
11859 /* === Check condition === */
11860 /* Note that currentVal is already set here */
11862 /* Immediate or Variable? get the 'stop' value if the latter. */
11863 if (stopVarNamePtr) {
11864 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11865 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11866 goto testcond;
11870 if (currentVal >= stop + cmpOffset) {
11871 break;
11874 /* Eval body */
11875 retval = Jim_EvalObj(interp, argv[4]);
11876 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11877 retval = JIM_OK;
11879 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11881 /* Increment */
11882 if (objPtr == NULL) {
11883 retval = JIM_ERR;
11884 goto out;
11886 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11887 currentVal = ++JimWideValue(objPtr);
11888 Jim_InvalidateStringRep(objPtr);
11890 else {
11891 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11892 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11893 ++currentVal)) != JIM_OK) {
11894 goto evalnext;
11899 goto out;
11901 evalstart:
11902 #endif
11904 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11905 /* Body */
11906 retval = Jim_EvalObj(interp, argv[4]);
11908 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11909 /* increment */
11910 evalnext:
11911 retval = Jim_EvalObj(interp, argv[3]);
11912 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11913 /* test */
11914 testcond:
11915 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11919 out:
11920 if (stopVarNamePtr) {
11921 Jim_DecrRefCount(interp, stopVarNamePtr);
11923 if (varNamePtr) {
11924 Jim_DecrRefCount(interp, varNamePtr);
11927 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11928 Jim_SetEmptyResult(interp);
11929 return JIM_OK;
11932 return retval;
11935 /* [loop] */
11936 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11938 int retval;
11939 jim_wide i;
11940 jim_wide limit;
11941 jim_wide incr = 1;
11942 Jim_Obj *bodyObjPtr;
11944 if (argc != 5 && argc != 6) {
11945 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11946 return JIM_ERR;
11949 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11950 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11951 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11952 return JIM_ERR;
11954 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11956 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11958 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11959 retval = Jim_EvalObj(interp, bodyObjPtr);
11960 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11961 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11963 retval = JIM_OK;
11965 /* Increment */
11966 i += incr;
11968 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11969 if (argv[1]->typePtr != &variableObjType) {
11970 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11971 return JIM_ERR;
11974 JimWideValue(objPtr) = i;
11975 Jim_InvalidateStringRep(objPtr);
11977 /* The following step is required in order to invalidate the
11978 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11979 if (argv[1]->typePtr != &variableObjType) {
11980 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11981 retval = JIM_ERR;
11982 break;
11986 else {
11987 objPtr = Jim_NewIntObj(interp, i);
11988 retval = Jim_SetVariable(interp, argv[1], objPtr);
11989 if (retval != JIM_OK) {
11990 Jim_FreeNewObj(interp, objPtr);
11996 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11997 Jim_SetEmptyResult(interp);
11998 return JIM_OK;
12000 return retval;
12003 /* List iterators make it easy to iterate over a list.
12004 * At some point iterators will be expanded to support generators.
12006 typedef struct {
12007 Jim_Obj *objPtr;
12008 int idx;
12009 } Jim_ListIter;
12012 * Initialise the iterator at the start of the list.
12014 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
12016 iter->objPtr = objPtr;
12017 iter->idx = 0;
12021 * Returns the next object from the list, or NULL on end-of-list.
12023 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
12025 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
12026 return NULL;
12028 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
12032 * Returns 1 if end-of-list has been reached.
12034 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
12036 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
12039 /* foreach + lmap implementation. */
12040 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
12042 int result = JIM_OK;
12043 int i, numargs;
12044 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
12045 Jim_ListIter *iters;
12046 Jim_Obj *script;
12047 Jim_Obj *resultObj;
12049 if (argc < 4 || argc % 2 != 0) {
12050 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
12051 return JIM_ERR;
12053 script = argv[argc - 1]; /* Last argument is a script */
12054 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
12056 if (numargs == 2) {
12057 iters = twoiters;
12059 else {
12060 iters = Jim_Alloc(numargs * sizeof(*iters));
12062 for (i = 0; i < numargs; i++) {
12063 JimListIterInit(&iters[i], argv[i + 1]);
12064 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12065 result = JIM_ERR;
12068 if (result != JIM_OK) {
12069 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12070 return result;
12073 if (doMap) {
12074 resultObj = Jim_NewListObj(interp, NULL, 0);
12076 else {
12077 resultObj = interp->emptyObj;
12079 Jim_IncrRefCount(resultObj);
12081 while (1) {
12082 /* Have we expired all lists? */
12083 for (i = 0; i < numargs; i += 2) {
12084 if (!JimListIterDone(interp, &iters[i + 1])) {
12085 break;
12088 if (i == numargs) {
12089 /* All done */
12090 break;
12093 /* For each list */
12094 for (i = 0; i < numargs; i += 2) {
12095 Jim_Obj *varName;
12097 /* foreach var */
12098 JimListIterInit(&iters[i], argv[i + 1]);
12099 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12100 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12101 if (!valObj) {
12102 /* Ran out, so store the empty string */
12103 valObj = interp->emptyObj;
12105 /* Avoid shimmering */
12106 Jim_IncrRefCount(valObj);
12107 result = Jim_SetVariable(interp, varName, valObj);
12108 Jim_DecrRefCount(interp, valObj);
12109 if (result != JIM_OK) {
12110 goto err;
12114 switch (result = Jim_EvalObj(interp, script)) {
12115 case JIM_OK:
12116 if (doMap) {
12117 Jim_ListAppendElement(interp, resultObj, interp->result);
12119 break;
12120 case JIM_CONTINUE:
12121 break;
12122 case JIM_BREAK:
12123 goto out;
12124 default:
12125 goto err;
12128 out:
12129 result = JIM_OK;
12130 Jim_SetResult(interp, resultObj);
12131 err:
12132 Jim_DecrRefCount(interp, resultObj);
12133 if (numargs > 2) {
12134 Jim_Free(iters);
12136 return result;
12139 /* [foreach] */
12140 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12142 return JimForeachMapHelper(interp, argc, argv, 0);
12145 /* [lmap] */
12146 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12148 return JimForeachMapHelper(interp, argc, argv, 1);
12151 /* [lassign] */
12152 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12154 int result = JIM_ERR;
12155 int i;
12156 Jim_ListIter iter;
12157 Jim_Obj *resultObj;
12159 if (argc < 2) {
12160 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12161 return JIM_ERR;
12164 JimListIterInit(&iter, argv[1]);
12166 for (i = 2; i < argc; i++) {
12167 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12168 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12169 if (result != JIM_OK) {
12170 return result;
12174 resultObj = Jim_NewListObj(interp, NULL, 0);
12175 while (!JimListIterDone(interp, &iter)) {
12176 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12179 Jim_SetResult(interp, resultObj);
12181 return JIM_OK;
12184 /* [if] */
12185 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12187 int boolean, retval, current = 1, falsebody = 0;
12189 if (argc >= 3) {
12190 while (1) {
12191 /* Far not enough arguments given! */
12192 if (current >= argc)
12193 goto err;
12194 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12195 != JIM_OK)
12196 return retval;
12197 /* There lacks something, isn't it? */
12198 if (current >= argc)
12199 goto err;
12200 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12201 current++;
12202 /* Tsk tsk, no then-clause? */
12203 if (current >= argc)
12204 goto err;
12205 if (boolean)
12206 return Jim_EvalObj(interp, argv[current]);
12207 /* Ok: no else-clause follows */
12208 if (++current >= argc) {
12209 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12210 return JIM_OK;
12212 falsebody = current++;
12213 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12214 /* IIICKS - else-clause isn't last cmd? */
12215 if (current != argc - 1)
12216 goto err;
12217 return Jim_EvalObj(interp, argv[current]);
12219 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12220 /* Ok: elseif follows meaning all the stuff
12221 * again (how boring...) */
12222 continue;
12223 /* OOPS - else-clause is not last cmd? */
12224 else if (falsebody != argc - 1)
12225 goto err;
12226 return Jim_EvalObj(interp, argv[falsebody]);
12228 return JIM_OK;
12230 err:
12231 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12232 return JIM_ERR;
12236 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12237 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12238 Jim_Obj *stringObj, int nocase)
12240 Jim_Obj *parms[4];
12241 int argc = 0;
12242 long eq;
12243 int rc;
12245 parms[argc++] = commandObj;
12246 if (nocase) {
12247 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12249 parms[argc++] = patternObj;
12250 parms[argc++] = stringObj;
12252 rc = Jim_EvalObjVector(interp, argc, parms);
12254 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12255 eq = -rc;
12258 return eq;
12261 enum
12262 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12264 /* [switch] */
12265 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12267 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12268 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12269 Jim_Obj *script = 0;
12271 if (argc < 3) {
12272 wrongnumargs:
12273 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12274 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12275 return JIM_ERR;
12277 for (opt = 1; opt < argc; ++opt) {
12278 const char *option = Jim_String(argv[opt]);
12280 if (*option != '-')
12281 break;
12282 else if (strncmp(option, "--", 2) == 0) {
12283 ++opt;
12284 break;
12286 else if (strncmp(option, "-exact", 2) == 0)
12287 matchOpt = SWITCH_EXACT;
12288 else if (strncmp(option, "-glob", 2) == 0)
12289 matchOpt = SWITCH_GLOB;
12290 else if (strncmp(option, "-regexp", 2) == 0)
12291 matchOpt = SWITCH_RE;
12292 else if (strncmp(option, "-command", 2) == 0) {
12293 matchOpt = SWITCH_CMD;
12294 if ((argc - opt) < 2)
12295 goto wrongnumargs;
12296 command = argv[++opt];
12298 else {
12299 Jim_SetResultFormatted(interp,
12300 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12301 argv[opt]);
12302 return JIM_ERR;
12304 if ((argc - opt) < 2)
12305 goto wrongnumargs;
12307 strObj = argv[opt++];
12308 patCount = argc - opt;
12309 if (patCount == 1) {
12310 Jim_Obj **vector;
12312 JimListGetElements(interp, argv[opt], &patCount, &vector);
12313 caseList = vector;
12315 else
12316 caseList = &argv[opt];
12317 if (patCount == 0 || patCount % 2 != 0)
12318 goto wrongnumargs;
12319 for (i = 0; script == 0 && i < patCount; i += 2) {
12320 Jim_Obj *patObj = caseList[i];
12322 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12323 || i < (patCount - 2)) {
12324 switch (matchOpt) {
12325 case SWITCH_EXACT:
12326 if (Jim_StringEqObj(strObj, patObj))
12327 script = caseList[i + 1];
12328 break;
12329 case SWITCH_GLOB:
12330 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12331 script = caseList[i + 1];
12332 break;
12333 case SWITCH_RE:
12334 command = Jim_NewStringObj(interp, "regexp", -1);
12335 /* Fall thru intentionally */
12336 case SWITCH_CMD:{
12337 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12339 /* After the execution of a command we need to
12340 * make sure to reconvert the object into a list
12341 * again. Only for the single-list style [switch]. */
12342 if (argc - opt == 1) {
12343 Jim_Obj **vector;
12345 JimListGetElements(interp, argv[opt], &patCount, &vector);
12346 caseList = vector;
12348 /* command is here already decref'd */
12349 if (rc < 0) {
12350 return -rc;
12352 if (rc)
12353 script = caseList[i + 1];
12354 break;
12358 else {
12359 script = caseList[i + 1];
12362 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12363 script = caseList[i + 1];
12364 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12365 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12366 return JIM_ERR;
12368 Jim_SetEmptyResult(interp);
12369 if (script) {
12370 return Jim_EvalObj(interp, script);
12372 return JIM_OK;
12375 /* [list] */
12376 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12378 Jim_Obj *listObjPtr;
12380 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12381 Jim_SetResult(interp, listObjPtr);
12382 return JIM_OK;
12385 /* [lindex] */
12386 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12388 Jim_Obj *objPtr, *listObjPtr;
12389 int i;
12390 int idx;
12392 if (argc < 2) {
12393 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12394 return JIM_ERR;
12396 objPtr = argv[1];
12397 Jim_IncrRefCount(objPtr);
12398 for (i = 2; i < argc; i++) {
12399 listObjPtr = objPtr;
12400 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12401 Jim_DecrRefCount(interp, listObjPtr);
12402 return JIM_ERR;
12404 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12405 /* Returns an empty object if the index
12406 * is out of range. */
12407 Jim_DecrRefCount(interp, listObjPtr);
12408 Jim_SetEmptyResult(interp);
12409 return JIM_OK;
12411 Jim_IncrRefCount(objPtr);
12412 Jim_DecrRefCount(interp, listObjPtr);
12414 Jim_SetResult(interp, objPtr);
12415 Jim_DecrRefCount(interp, objPtr);
12416 return JIM_OK;
12419 /* [llength] */
12420 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12422 if (argc != 2) {
12423 Jim_WrongNumArgs(interp, 1, argv, "list");
12424 return JIM_ERR;
12426 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12427 return JIM_OK;
12430 /* [lsearch] */
12431 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12433 static const char * const options[] = {
12434 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12435 NULL
12437 enum
12438 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12439 OPT_COMMAND };
12440 int i;
12441 int opt_bool = 0;
12442 int opt_not = 0;
12443 int opt_nocase = 0;
12444 int opt_all = 0;
12445 int opt_inline = 0;
12446 int opt_match = OPT_EXACT;
12447 int listlen;
12448 int rc = JIM_OK;
12449 Jim_Obj *listObjPtr = NULL;
12450 Jim_Obj *commandObj = NULL;
12452 if (argc < 3) {
12453 wrongargs:
12454 Jim_WrongNumArgs(interp, 1, argv,
12455 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12456 return JIM_ERR;
12459 for (i = 1; i < argc - 2; i++) {
12460 int option;
12462 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12463 return JIM_ERR;
12465 switch (option) {
12466 case OPT_BOOL:
12467 opt_bool = 1;
12468 opt_inline = 0;
12469 break;
12470 case OPT_NOT:
12471 opt_not = 1;
12472 break;
12473 case OPT_NOCASE:
12474 opt_nocase = 1;
12475 break;
12476 case OPT_INLINE:
12477 opt_inline = 1;
12478 opt_bool = 0;
12479 break;
12480 case OPT_ALL:
12481 opt_all = 1;
12482 break;
12483 case OPT_COMMAND:
12484 if (i >= argc - 2) {
12485 goto wrongargs;
12487 commandObj = argv[++i];
12488 /* fallthru */
12489 case OPT_EXACT:
12490 case OPT_GLOB:
12491 case OPT_REGEXP:
12492 opt_match = option;
12493 break;
12497 argv += i;
12499 if (opt_all) {
12500 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12502 if (opt_match == OPT_REGEXP) {
12503 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12505 if (commandObj) {
12506 Jim_IncrRefCount(commandObj);
12509 listlen = Jim_ListLength(interp, argv[0]);
12510 for (i = 0; i < listlen; i++) {
12511 int eq = 0;
12512 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12514 switch (opt_match) {
12515 case OPT_EXACT:
12516 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12517 break;
12519 case OPT_GLOB:
12520 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12521 break;
12523 case OPT_REGEXP:
12524 case OPT_COMMAND:
12525 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12526 if (eq < 0) {
12527 if (listObjPtr) {
12528 Jim_FreeNewObj(interp, listObjPtr);
12530 rc = JIM_ERR;
12531 goto done;
12533 break;
12536 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12537 if (!eq && opt_bool && opt_not && !opt_all) {
12538 continue;
12541 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12542 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12543 Jim_Obj *resultObj;
12545 if (opt_bool) {
12546 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12548 else if (!opt_inline) {
12549 resultObj = Jim_NewIntObj(interp, i);
12551 else {
12552 resultObj = objPtr;
12555 if (opt_all) {
12556 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12558 else {
12559 Jim_SetResult(interp, resultObj);
12560 goto done;
12565 if (opt_all) {
12566 Jim_SetResult(interp, listObjPtr);
12568 else {
12569 /* No match */
12570 if (opt_bool) {
12571 Jim_SetResultBool(interp, opt_not);
12573 else if (!opt_inline) {
12574 Jim_SetResultInt(interp, -1);
12578 done:
12579 if (commandObj) {
12580 Jim_DecrRefCount(interp, commandObj);
12582 return rc;
12585 /* [lappend] */
12586 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12588 Jim_Obj *listObjPtr;
12589 int new_obj = 0;
12590 int i;
12592 if (argc < 2) {
12593 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12594 return JIM_ERR;
12596 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12597 if (!listObjPtr) {
12598 /* Create the list if it does not exist */
12599 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12600 new_obj = 1;
12602 else if (Jim_IsShared(listObjPtr)) {
12603 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12604 new_obj = 1;
12606 for (i = 2; i < argc; i++)
12607 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12608 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12609 if (new_obj)
12610 Jim_FreeNewObj(interp, listObjPtr);
12611 return JIM_ERR;
12613 Jim_SetResult(interp, listObjPtr);
12614 return JIM_OK;
12617 /* [linsert] */
12618 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12620 int idx, len;
12621 Jim_Obj *listPtr;
12623 if (argc < 3) {
12624 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12625 return JIM_ERR;
12627 listPtr = argv[1];
12628 if (Jim_IsShared(listPtr))
12629 listPtr = Jim_DuplicateObj(interp, listPtr);
12630 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12631 goto err;
12632 len = Jim_ListLength(interp, listPtr);
12633 if (idx >= len)
12634 idx = len;
12635 else if (idx < 0)
12636 idx = len + idx + 1;
12637 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12638 Jim_SetResult(interp, listPtr);
12639 return JIM_OK;
12640 err:
12641 if (listPtr != argv[1]) {
12642 Jim_FreeNewObj(interp, listPtr);
12644 return JIM_ERR;
12647 /* [lreplace] */
12648 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12650 int first, last, len, rangeLen;
12651 Jim_Obj *listObj;
12652 Jim_Obj *newListObj;
12654 if (argc < 4) {
12655 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12656 return JIM_ERR;
12658 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12659 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12660 return JIM_ERR;
12663 listObj = argv[1];
12664 len = Jim_ListLength(interp, listObj);
12666 first = JimRelToAbsIndex(len, first);
12667 last = JimRelToAbsIndex(len, last);
12668 JimRelToAbsRange(len, &first, &last, &rangeLen);
12670 /* Now construct a new list which consists of:
12671 * <elements before first> <supplied elements> <elements after last>
12674 /* Check to see if trying to replace past the end of the list */
12675 if (first < len) {
12676 /* OK. Not past the end */
12678 else if (len == 0) {
12679 /* Special for empty list, adjust first to 0 */
12680 first = 0;
12682 else {
12683 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12684 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12685 return JIM_ERR;
12688 /* Add the first set of elements */
12689 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12691 /* Add supplied elements */
12692 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12694 /* Add the remaining elements */
12695 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12697 Jim_SetResult(interp, newListObj);
12698 return JIM_OK;
12701 /* [lset] */
12702 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12704 if (argc < 3) {
12705 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12706 return JIM_ERR;
12708 else if (argc == 3) {
12709 /* With no indexes, simply implements [set] */
12710 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12711 return JIM_ERR;
12712 Jim_SetResult(interp, argv[2]);
12713 return JIM_OK;
12715 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12718 /* [lsort] */
12719 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12721 static const char * const options[] = {
12722 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12724 enum
12725 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12726 Jim_Obj *resObj;
12727 int i;
12728 int retCode;
12730 struct lsort_info info;
12732 if (argc < 2) {
12733 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12734 return JIM_ERR;
12737 info.type = JIM_LSORT_ASCII;
12738 info.order = 1;
12739 info.indexed = 0;
12740 info.unique = 0;
12741 info.command = NULL;
12742 info.interp = interp;
12744 for (i = 1; i < (argc - 1); i++) {
12745 int option;
12747 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12748 != JIM_OK)
12749 return JIM_ERR;
12750 switch (option) {
12751 case OPT_ASCII:
12752 info.type = JIM_LSORT_ASCII;
12753 break;
12754 case OPT_NOCASE:
12755 info.type = JIM_LSORT_NOCASE;
12756 break;
12757 case OPT_INTEGER:
12758 info.type = JIM_LSORT_INTEGER;
12759 break;
12760 case OPT_REAL:
12761 info.type = JIM_LSORT_REAL;
12762 break;
12763 case OPT_INCREASING:
12764 info.order = 1;
12765 break;
12766 case OPT_DECREASING:
12767 info.order = -1;
12768 break;
12769 case OPT_UNIQUE:
12770 info.unique = 1;
12771 break;
12772 case OPT_COMMAND:
12773 if (i >= (argc - 2)) {
12774 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12775 return JIM_ERR;
12777 info.type = JIM_LSORT_COMMAND;
12778 info.command = argv[i + 1];
12779 i++;
12780 break;
12781 case OPT_INDEX:
12782 if (i >= (argc - 2)) {
12783 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12784 return JIM_ERR;
12786 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12787 return JIM_ERR;
12789 info.indexed = 1;
12790 i++;
12791 break;
12794 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12795 retCode = ListSortElements(interp, resObj, &info);
12796 if (retCode == JIM_OK) {
12797 Jim_SetResult(interp, resObj);
12799 else {
12800 Jim_FreeNewObj(interp, resObj);
12802 return retCode;
12805 /* [append] */
12806 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12808 Jim_Obj *stringObjPtr;
12809 int i;
12811 if (argc < 2) {
12812 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12813 return JIM_ERR;
12815 if (argc == 2) {
12816 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12817 if (!stringObjPtr)
12818 return JIM_ERR;
12820 else {
12821 int new_obj = 0;
12822 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12823 if (!stringObjPtr) {
12824 /* Create the string if it doesn't exist */
12825 stringObjPtr = Jim_NewEmptyStringObj(interp);
12826 new_obj = 1;
12828 else if (Jim_IsShared(stringObjPtr)) {
12829 new_obj = 1;
12830 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12832 for (i = 2; i < argc; i++) {
12833 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12835 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12836 if (new_obj) {
12837 Jim_FreeNewObj(interp, stringObjPtr);
12839 return JIM_ERR;
12842 Jim_SetResult(interp, stringObjPtr);
12843 return JIM_OK;
12846 /* [debug] */
12847 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12849 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12850 static const char * const options[] = {
12851 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12852 "exprbc", "show",
12853 NULL
12855 enum
12857 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12858 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12860 int option;
12862 if (argc < 2) {
12863 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12864 return JIM_ERR;
12866 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12867 return JIM_ERR;
12868 if (option == OPT_REFCOUNT) {
12869 if (argc != 3) {
12870 Jim_WrongNumArgs(interp, 2, argv, "object");
12871 return JIM_ERR;
12873 Jim_SetResultInt(interp, argv[2]->refCount);
12874 return JIM_OK;
12876 else if (option == OPT_OBJCOUNT) {
12877 int freeobj = 0, liveobj = 0;
12878 char buf[256];
12879 Jim_Obj *objPtr;
12881 if (argc != 2) {
12882 Jim_WrongNumArgs(interp, 2, argv, "");
12883 return JIM_ERR;
12885 /* Count the number of free objects. */
12886 objPtr = interp->freeList;
12887 while (objPtr) {
12888 freeobj++;
12889 objPtr = objPtr->nextObjPtr;
12891 /* Count the number of live objects. */
12892 objPtr = interp->liveList;
12893 while (objPtr) {
12894 liveobj++;
12895 objPtr = objPtr->nextObjPtr;
12897 /* Set the result string and return. */
12898 sprintf(buf, "free %d used %d", freeobj, liveobj);
12899 Jim_SetResultString(interp, buf, -1);
12900 return JIM_OK;
12902 else if (option == OPT_OBJECTS) {
12903 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12905 /* Count the number of live objects. */
12906 objPtr = interp->liveList;
12907 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12908 while (objPtr) {
12909 char buf[128];
12910 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12912 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12913 sprintf(buf, "%p", objPtr);
12914 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12915 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12916 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12917 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12918 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12919 objPtr = objPtr->nextObjPtr;
12921 Jim_SetResult(interp, listObjPtr);
12922 return JIM_OK;
12924 else if (option == OPT_INVSTR) {
12925 Jim_Obj *objPtr;
12927 if (argc != 3) {
12928 Jim_WrongNumArgs(interp, 2, argv, "object");
12929 return JIM_ERR;
12931 objPtr = argv[2];
12932 if (objPtr->typePtr != NULL)
12933 Jim_InvalidateStringRep(objPtr);
12934 Jim_SetEmptyResult(interp);
12935 return JIM_OK;
12937 else if (option == OPT_SHOW) {
12938 const char *s;
12939 int len, charlen;
12941 if (argc != 3) {
12942 Jim_WrongNumArgs(interp, 2, argv, "object");
12943 return JIM_ERR;
12945 s = Jim_GetString(argv[2], &len);
12946 #ifdef JIM_UTF8
12947 charlen = utf8_strlen(s, len);
12948 #else
12949 charlen = len;
12950 #endif
12951 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12952 printf("chars (%d): <<%s>>\n", charlen, s);
12953 printf("bytes (%d):", len);
12954 while (len--) {
12955 printf(" %02x", (unsigned char)*s++);
12957 printf("\n");
12958 return JIM_OK;
12960 else if (option == OPT_SCRIPTLEN) {
12961 ScriptObj *script;
12963 if (argc != 3) {
12964 Jim_WrongNumArgs(interp, 2, argv, "script");
12965 return JIM_ERR;
12967 script = JimGetScript(interp, argv[2]);
12968 if (script == NULL)
12969 return JIM_ERR;
12970 Jim_SetResultInt(interp, script->len);
12971 return JIM_OK;
12973 else if (option == OPT_EXPRLEN) {
12974 ExprByteCode *expr;
12976 if (argc != 3) {
12977 Jim_WrongNumArgs(interp, 2, argv, "expression");
12978 return JIM_ERR;
12980 expr = JimGetExpression(interp, argv[2]);
12981 if (expr == NULL)
12982 return JIM_ERR;
12983 Jim_SetResultInt(interp, expr->len);
12984 return JIM_OK;
12986 else if (option == OPT_EXPRBC) {
12987 Jim_Obj *objPtr;
12988 ExprByteCode *expr;
12989 int i;
12991 if (argc != 3) {
12992 Jim_WrongNumArgs(interp, 2, argv, "expression");
12993 return JIM_ERR;
12995 expr = JimGetExpression(interp, argv[2]);
12996 if (expr == NULL)
12997 return JIM_ERR;
12998 objPtr = Jim_NewListObj(interp, NULL, 0);
12999 for (i = 0; i < expr->len; i++) {
13000 const char *type;
13001 const Jim_ExprOperator *op;
13002 Jim_Obj *obj = expr->token[i].objPtr;
13004 switch (expr->token[i].type) {
13005 case JIM_TT_EXPR_INT:
13006 type = "int";
13007 break;
13008 case JIM_TT_EXPR_DOUBLE:
13009 type = "double";
13010 break;
13011 case JIM_TT_EXPR_BOOLEAN:
13012 type = "boolean";
13013 break;
13014 case JIM_TT_CMD:
13015 type = "command";
13016 break;
13017 case JIM_TT_VAR:
13018 type = "variable";
13019 break;
13020 case JIM_TT_DICTSUGAR:
13021 type = "dictsugar";
13022 break;
13023 case JIM_TT_EXPRSUGAR:
13024 type = "exprsugar";
13025 break;
13026 case JIM_TT_ESC:
13027 type = "subst";
13028 break;
13029 case JIM_TT_STR:
13030 type = "string";
13031 break;
13032 default:
13033 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
13034 if (op == NULL) {
13035 type = "private";
13037 else {
13038 type = "operator";
13040 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
13041 break;
13043 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
13044 Jim_ListAppendElement(interp, objPtr, obj);
13046 Jim_SetResult(interp, objPtr);
13047 return JIM_OK;
13049 else {
13050 Jim_SetResultString(interp,
13051 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13052 return JIM_ERR;
13054 /* unreached */
13055 #endif /* JIM_BOOTSTRAP */
13056 #if !defined(JIM_DEBUG_COMMAND)
13057 Jim_SetResultString(interp, "unsupported", -1);
13058 return JIM_ERR;
13059 #endif
13062 /* [eval] */
13063 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13065 int rc;
13067 if (argc < 2) {
13068 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13069 return JIM_ERR;
13072 if (argc == 2) {
13073 rc = Jim_EvalObj(interp, argv[1]);
13075 else {
13076 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13079 if (rc == JIM_ERR) {
13080 /* eval is "interesting", so add a stack frame here */
13081 interp->addStackTrace++;
13083 return rc;
13086 /* [uplevel] */
13087 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13089 if (argc >= 2) {
13090 int retcode;
13091 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13092 const char *str;
13094 /* Save the old callframe pointer */
13095 savedCallFrame = interp->framePtr;
13097 /* Lookup the target frame pointer */
13098 str = Jim_String(argv[1]);
13099 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13100 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13101 argc--;
13102 argv++;
13104 else {
13105 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13107 if (targetCallFrame == NULL) {
13108 return JIM_ERR;
13110 if (argc < 2) {
13111 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13112 return JIM_ERR;
13114 /* Eval the code in the target callframe. */
13115 interp->framePtr = targetCallFrame;
13116 if (argc == 2) {
13117 retcode = Jim_EvalObj(interp, argv[1]);
13119 else {
13120 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13122 interp->framePtr = savedCallFrame;
13123 return retcode;
13125 else {
13126 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13127 return JIM_ERR;
13131 /* [expr] */
13132 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13134 Jim_Obj *exprResultPtr;
13135 int retcode;
13137 if (argc == 2) {
13138 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13140 else if (argc > 2) {
13141 Jim_Obj *objPtr;
13143 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13144 Jim_IncrRefCount(objPtr);
13145 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13146 Jim_DecrRefCount(interp, objPtr);
13148 else {
13149 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13150 return JIM_ERR;
13152 if (retcode != JIM_OK)
13153 return retcode;
13154 Jim_SetResult(interp, exprResultPtr);
13155 Jim_DecrRefCount(interp, exprResultPtr);
13156 return JIM_OK;
13159 /* [break] */
13160 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13162 if (argc != 1) {
13163 Jim_WrongNumArgs(interp, 1, argv, "");
13164 return JIM_ERR;
13166 return JIM_BREAK;
13169 /* [continue] */
13170 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13172 if (argc != 1) {
13173 Jim_WrongNumArgs(interp, 1, argv, "");
13174 return JIM_ERR;
13176 return JIM_CONTINUE;
13179 /* [return] */
13180 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13182 int i;
13183 Jim_Obj *stackTraceObj = NULL;
13184 Jim_Obj *errorCodeObj = NULL;
13185 int returnCode = JIM_OK;
13186 long level = 1;
13188 for (i = 1; i < argc - 1; i += 2) {
13189 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13190 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13191 return JIM_ERR;
13194 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13195 stackTraceObj = argv[i + 1];
13197 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13198 errorCodeObj = argv[i + 1];
13200 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13201 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13202 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13203 return JIM_ERR;
13206 else {
13207 break;
13211 if (i != argc - 1 && i != argc) {
13212 Jim_WrongNumArgs(interp, 1, argv,
13213 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13216 /* If a stack trace is supplied and code is error, set the stack trace */
13217 if (stackTraceObj && returnCode == JIM_ERR) {
13218 JimSetStackTrace(interp, stackTraceObj);
13220 /* If an error code list is supplied, set the global $errorCode */
13221 if (errorCodeObj && returnCode == JIM_ERR) {
13222 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13224 interp->returnCode = returnCode;
13225 interp->returnLevel = level;
13227 if (i == argc - 1) {
13228 Jim_SetResult(interp, argv[i]);
13230 return JIM_RETURN;
13233 /* [tailcall] */
13234 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13236 if (interp->framePtr->level == 0) {
13237 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13238 return JIM_ERR;
13240 else if (argc >= 2) {
13241 /* Need to resolve the tailcall command in the current context */
13242 Jim_CallFrame *cf = interp->framePtr->parent;
13244 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13245 if (cmdPtr == NULL) {
13246 return JIM_ERR;
13249 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13251 /* And stash this pre-resolved command */
13252 JimIncrCmdRefCount(cmdPtr);
13253 cf->tailcallCmd = cmdPtr;
13255 /* And stash the command list */
13256 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13258 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13259 Jim_IncrRefCount(cf->tailcallObj);
13261 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13262 return JIM_EVAL;
13264 return JIM_OK;
13267 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13269 Jim_Obj *cmdList;
13270 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13272 /* prefixListObj is a list to which the args need to be appended */
13273 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13274 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13276 return JimEvalObjList(interp, cmdList);
13279 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13281 Jim_Obj *prefixListObj = privData;
13282 Jim_DecrRefCount(interp, prefixListObj);
13285 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13287 Jim_Obj *prefixListObj;
13288 const char *newname;
13290 if (argc < 3) {
13291 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13292 return JIM_ERR;
13295 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13296 Jim_IncrRefCount(prefixListObj);
13297 newname = Jim_String(argv[1]);
13298 if (newname[0] == ':' && newname[1] == ':') {
13299 while (*++newname == ':') {
13303 Jim_SetResult(interp, argv[1]);
13305 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13308 /* [proc] */
13309 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13311 Jim_Cmd *cmd;
13313 if (argc != 4 && argc != 5) {
13314 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13315 return JIM_ERR;
13318 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13319 return JIM_ERR;
13322 if (argc == 4) {
13323 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13325 else {
13326 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13329 if (cmd) {
13330 /* Add the new command */
13331 Jim_Obj *qualifiedCmdNameObj;
13332 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13334 JimCreateCommand(interp, cmdname, cmd);
13336 /* Calculate and set the namespace for this proc */
13337 JimUpdateProcNamespace(interp, cmd, cmdname);
13339 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13341 /* Unlike Tcl, set the name of the proc as the result */
13342 Jim_SetResult(interp, argv[1]);
13343 return JIM_OK;
13345 return JIM_ERR;
13348 /* [local] */
13349 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13351 int retcode;
13353 if (argc < 2) {
13354 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13355 return JIM_ERR;
13358 /* Evaluate the arguments with 'local' in force */
13359 interp->local++;
13360 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13361 interp->local--;
13364 /* If OK, and the result is a proc, add it to the list of local procs */
13365 if (retcode == 0) {
13366 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13368 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13369 return JIM_ERR;
13371 if (interp->framePtr->localCommands == NULL) {
13372 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13373 Jim_InitStack(interp->framePtr->localCommands);
13375 Jim_IncrRefCount(cmdNameObj);
13376 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13379 return retcode;
13382 /* [upcall] */
13383 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13385 if (argc < 2) {
13386 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13387 return JIM_ERR;
13389 else {
13390 int retcode;
13392 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13393 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13394 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13395 return JIM_ERR;
13397 /* OK. Mark this command as being in an upcall */
13398 cmdPtr->u.proc.upcall++;
13399 JimIncrCmdRefCount(cmdPtr);
13401 /* Invoke the command as normal */
13402 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13404 /* No longer in an upcall */
13405 cmdPtr->u.proc.upcall--;
13406 JimDecrCmdRefCount(interp, cmdPtr);
13408 return retcode;
13412 /* [apply] */
13413 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13415 if (argc < 2) {
13416 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13417 return JIM_ERR;
13419 else {
13420 int ret;
13421 Jim_Cmd *cmd;
13422 Jim_Obj *argListObjPtr;
13423 Jim_Obj *bodyObjPtr;
13424 Jim_Obj *nsObj = NULL;
13425 Jim_Obj **nargv;
13427 int len = Jim_ListLength(interp, argv[1]);
13428 if (len != 2 && len != 3) {
13429 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13430 return JIM_ERR;
13433 if (len == 3) {
13434 #ifdef jim_ext_namespace
13435 /* Need to canonicalise the given namespace. */
13436 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13437 #else
13438 Jim_SetResultString(interp, "namespaces not enabled", -1);
13439 return JIM_ERR;
13440 #endif
13442 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13443 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13445 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13447 if (cmd) {
13448 /* Create a new argv array with a dummy argv[0], for error messages */
13449 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13450 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13451 Jim_IncrRefCount(nargv[0]);
13452 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13453 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13454 Jim_DecrRefCount(interp, nargv[0]);
13455 Jim_Free(nargv);
13457 JimDecrCmdRefCount(interp, cmd);
13458 return ret;
13460 return JIM_ERR;
13465 /* [concat] */
13466 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13468 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13469 return JIM_OK;
13472 /* [upvar] */
13473 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13475 int i;
13476 Jim_CallFrame *targetCallFrame;
13478 /* Lookup the target frame pointer */
13479 if (argc > 3 && (argc % 2 == 0)) {
13480 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13481 argc--;
13482 argv++;
13484 else {
13485 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13487 if (targetCallFrame == NULL) {
13488 return JIM_ERR;
13491 /* Check for arity */
13492 if (argc < 3) {
13493 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13494 return JIM_ERR;
13497 /* Now... for every other/local couple: */
13498 for (i = 1; i < argc; i += 2) {
13499 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13500 return JIM_ERR;
13502 return JIM_OK;
13505 /* [global] */
13506 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13508 int i;
13510 if (argc < 2) {
13511 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13512 return JIM_ERR;
13514 /* Link every var to the toplevel having the same name */
13515 if (interp->framePtr->level == 0)
13516 return JIM_OK; /* global at toplevel... */
13517 for (i = 1; i < argc; i++) {
13518 /* global ::blah does nothing */
13519 const char *name = Jim_String(argv[i]);
13520 if (name[0] != ':' || name[1] != ':') {
13521 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13522 return JIM_ERR;
13525 return JIM_OK;
13528 /* does the [string map] operation. On error NULL is returned,
13529 * otherwise a new string object with the result, having refcount = 0,
13530 * is returned. */
13531 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13532 Jim_Obj *objPtr, int nocase)
13534 int numMaps;
13535 const char *str, *noMatchStart = NULL;
13536 int strLen, i;
13537 Jim_Obj *resultObjPtr;
13539 numMaps = Jim_ListLength(interp, mapListObjPtr);
13540 if (numMaps % 2) {
13541 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13542 return NULL;
13545 str = Jim_String(objPtr);
13546 strLen = Jim_Utf8Length(interp, objPtr);
13548 /* Map it */
13549 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13550 while (strLen) {
13551 for (i = 0; i < numMaps; i += 2) {
13552 Jim_Obj *objPtr;
13553 const char *k;
13554 int kl;
13556 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13557 k = Jim_String(objPtr);
13558 kl = Jim_Utf8Length(interp, objPtr);
13560 if (strLen >= kl && kl) {
13561 int rc;
13562 rc = JimStringCompareLen(str, k, kl, nocase);
13563 if (rc == 0) {
13564 if (noMatchStart) {
13565 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13566 noMatchStart = NULL;
13568 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13569 str += utf8_index(str, kl);
13570 strLen -= kl;
13571 break;
13575 if (i == numMaps) { /* no match */
13576 int c;
13577 if (noMatchStart == NULL)
13578 noMatchStart = str;
13579 str += utf8_tounicode(str, &c);
13580 strLen--;
13583 if (noMatchStart) {
13584 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13586 return resultObjPtr;
13589 /* [string] */
13590 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13592 int len;
13593 int opt_case = 1;
13594 int option;
13595 static const char * const options[] = {
13596 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13597 "map", "repeat", "reverse", "index", "first", "last", "cat",
13598 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13600 enum
13602 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13603 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13604 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13606 static const char * const nocase_options[] = {
13607 "-nocase", NULL
13609 static const char * const nocase_length_options[] = {
13610 "-nocase", "-length", NULL
13613 if (argc < 2) {
13614 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13615 return JIM_ERR;
13617 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13618 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13619 return JIM_ERR;
13621 switch (option) {
13622 case OPT_LENGTH:
13623 case OPT_BYTELENGTH:
13624 if (argc != 3) {
13625 Jim_WrongNumArgs(interp, 2, argv, "string");
13626 return JIM_ERR;
13628 if (option == OPT_LENGTH) {
13629 len = Jim_Utf8Length(interp, argv[2]);
13631 else {
13632 len = Jim_Length(argv[2]);
13634 Jim_SetResultInt(interp, len);
13635 return JIM_OK;
13637 case OPT_CAT:{
13638 Jim_Obj *objPtr;
13639 if (argc == 3) {
13640 /* optimise the one-arg case */
13641 objPtr = argv[2];
13643 else {
13644 int i;
13646 objPtr = Jim_NewStringObj(interp, "", 0);
13648 for (i = 2; i < argc; i++) {
13649 Jim_AppendObj(interp, objPtr, argv[i]);
13652 Jim_SetResult(interp, objPtr);
13653 return JIM_OK;
13656 case OPT_COMPARE:
13657 case OPT_EQUAL:
13659 /* n is the number of remaining option args */
13660 long opt_length = -1;
13661 int n = argc - 4;
13662 int i = 2;
13663 while (n > 0) {
13664 int subopt;
13665 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13666 JIM_ENUM_ABBREV) != JIM_OK) {
13667 badcompareargs:
13668 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13669 return JIM_ERR;
13671 if (subopt == 0) {
13672 /* -nocase */
13673 opt_case = 0;
13674 n--;
13676 else {
13677 /* -length */
13678 if (n < 2) {
13679 goto badcompareargs;
13681 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13682 return JIM_ERR;
13684 n -= 2;
13687 if (n) {
13688 goto badcompareargs;
13690 argv += argc - 2;
13691 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13692 /* Fast version - [string equal], case sensitive, no length */
13693 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13695 else {
13696 if (opt_length >= 0) {
13697 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13699 else {
13700 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13702 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13704 return JIM_OK;
13707 case OPT_MATCH:
13708 if (argc != 4 &&
13709 (argc != 5 ||
13710 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13711 JIM_ENUM_ABBREV) != JIM_OK)) {
13712 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13713 return JIM_ERR;
13715 if (opt_case == 0) {
13716 argv++;
13718 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13719 return JIM_OK;
13721 case OPT_MAP:{
13722 Jim_Obj *objPtr;
13724 if (argc != 4 &&
13725 (argc != 5 ||
13726 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13727 JIM_ENUM_ABBREV) != JIM_OK)) {
13728 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13729 return JIM_ERR;
13732 if (opt_case == 0) {
13733 argv++;
13735 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13736 if (objPtr == NULL) {
13737 return JIM_ERR;
13739 Jim_SetResult(interp, objPtr);
13740 return JIM_OK;
13743 case OPT_RANGE:
13744 case OPT_BYTERANGE:{
13745 Jim_Obj *objPtr;
13747 if (argc != 5) {
13748 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13749 return JIM_ERR;
13751 if (option == OPT_RANGE) {
13752 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13754 else
13756 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13759 if (objPtr == NULL) {
13760 return JIM_ERR;
13762 Jim_SetResult(interp, objPtr);
13763 return JIM_OK;
13766 case OPT_REPLACE:{
13767 Jim_Obj *objPtr;
13769 if (argc != 5 && argc != 6) {
13770 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13771 return JIM_ERR;
13773 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13774 if (objPtr == NULL) {
13775 return JIM_ERR;
13777 Jim_SetResult(interp, objPtr);
13778 return JIM_OK;
13782 case OPT_REPEAT:{
13783 Jim_Obj *objPtr;
13784 jim_wide count;
13786 if (argc != 4) {
13787 Jim_WrongNumArgs(interp, 2, argv, "string count");
13788 return JIM_ERR;
13790 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13791 return JIM_ERR;
13793 objPtr = Jim_NewStringObj(interp, "", 0);
13794 if (count > 0) {
13795 while (count--) {
13796 Jim_AppendObj(interp, objPtr, argv[2]);
13799 Jim_SetResult(interp, objPtr);
13800 return JIM_OK;
13803 case OPT_REVERSE:{
13804 char *buf, *p;
13805 const char *str;
13806 int len;
13807 int i;
13809 if (argc != 3) {
13810 Jim_WrongNumArgs(interp, 2, argv, "string");
13811 return JIM_ERR;
13814 str = Jim_GetString(argv[2], &len);
13815 buf = Jim_Alloc(len + 1);
13816 p = buf + len;
13817 *p = 0;
13818 for (i = 0; i < len; ) {
13819 int c;
13820 int l = utf8_tounicode(str, &c);
13821 memcpy(p - l, str, l);
13822 p -= l;
13823 i += l;
13824 str += l;
13826 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13827 return JIM_OK;
13830 case OPT_INDEX:{
13831 int idx;
13832 const char *str;
13834 if (argc != 4) {
13835 Jim_WrongNumArgs(interp, 2, argv, "string index");
13836 return JIM_ERR;
13838 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13839 return JIM_ERR;
13841 str = Jim_String(argv[2]);
13842 len = Jim_Utf8Length(interp, argv[2]);
13843 if (idx != INT_MIN && idx != INT_MAX) {
13844 idx = JimRelToAbsIndex(len, idx);
13846 if (idx < 0 || idx >= len || str == NULL) {
13847 Jim_SetResultString(interp, "", 0);
13849 else if (len == Jim_Length(argv[2])) {
13850 /* ASCII optimisation */
13851 Jim_SetResultString(interp, str + idx, 1);
13853 else {
13854 int c;
13855 int i = utf8_index(str, idx);
13856 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13858 return JIM_OK;
13861 case OPT_FIRST:
13862 case OPT_LAST:{
13863 int idx = 0, l1, l2;
13864 const char *s1, *s2;
13866 if (argc != 4 && argc != 5) {
13867 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13868 return JIM_ERR;
13870 s1 = Jim_String(argv[2]);
13871 s2 = Jim_String(argv[3]);
13872 l1 = Jim_Utf8Length(interp, argv[2]);
13873 l2 = Jim_Utf8Length(interp, argv[3]);
13874 if (argc == 5) {
13875 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13876 return JIM_ERR;
13878 idx = JimRelToAbsIndex(l2, idx);
13880 else if (option == OPT_LAST) {
13881 idx = l2;
13883 if (option == OPT_FIRST) {
13884 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13886 else {
13887 #ifdef JIM_UTF8
13888 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13889 #else
13890 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13891 #endif
13893 return JIM_OK;
13896 case OPT_TRIM:
13897 case OPT_TRIMLEFT:
13898 case OPT_TRIMRIGHT:{
13899 Jim_Obj *trimchars;
13901 if (argc != 3 && argc != 4) {
13902 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13903 return JIM_ERR;
13905 trimchars = (argc == 4 ? argv[3] : NULL);
13906 if (option == OPT_TRIM) {
13907 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13909 else if (option == OPT_TRIMLEFT) {
13910 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13912 else if (option == OPT_TRIMRIGHT) {
13913 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13915 return JIM_OK;
13918 case OPT_TOLOWER:
13919 case OPT_TOUPPER:
13920 case OPT_TOTITLE:
13921 if (argc != 3) {
13922 Jim_WrongNumArgs(interp, 2, argv, "string");
13923 return JIM_ERR;
13925 if (option == OPT_TOLOWER) {
13926 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13928 else if (option == OPT_TOUPPER) {
13929 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13931 else {
13932 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13934 return JIM_OK;
13936 case OPT_IS:
13937 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13938 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13940 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13941 return JIM_ERR;
13943 return JIM_OK;
13946 /* [time] */
13947 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13949 long i, count = 1;
13950 jim_wide start, elapsed;
13951 char buf[60];
13952 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13954 if (argc < 2) {
13955 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13956 return JIM_ERR;
13958 if (argc == 3) {
13959 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13960 return JIM_ERR;
13962 if (count < 0)
13963 return JIM_OK;
13964 i = count;
13965 start = JimClock();
13966 while (i-- > 0) {
13967 int retval;
13969 retval = Jim_EvalObj(interp, argv[1]);
13970 if (retval != JIM_OK) {
13971 return retval;
13974 elapsed = JimClock() - start;
13975 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13976 Jim_SetResultString(interp, buf, -1);
13977 return JIM_OK;
13980 /* [exit] */
13981 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13983 long exitCode = 0;
13985 if (argc > 2) {
13986 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13987 return JIM_ERR;
13989 if (argc == 2) {
13990 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13991 return JIM_ERR;
13993 interp->exitCode = exitCode;
13994 return JIM_EXIT;
13997 /* [catch] */
13998 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14000 int exitCode = 0;
14001 int i;
14002 int sig = 0;
14004 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14005 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
14006 static const int max_ignore_code = sizeof(ignore_mask) * 8;
14008 /* Reset the error code before catch.
14009 * Note that this is not strictly correct.
14011 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
14013 for (i = 1; i < argc - 1; i++) {
14014 const char *arg = Jim_String(argv[i]);
14015 jim_wide option;
14016 int ignore;
14018 /* It's a pity we can't use Jim_GetEnum here :-( */
14019 if (strcmp(arg, "--") == 0) {
14020 i++;
14021 break;
14023 if (*arg != '-') {
14024 break;
14027 if (strncmp(arg, "-no", 3) == 0) {
14028 arg += 3;
14029 ignore = 1;
14031 else {
14032 arg++;
14033 ignore = 0;
14036 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
14037 option = -1;
14039 if (option < 0) {
14040 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
14042 if (option < 0) {
14043 goto wrongargs;
14046 if (ignore) {
14047 ignore_mask |= ((jim_wide)1 << option);
14049 else {
14050 ignore_mask &= (~((jim_wide)1 << option));
14054 argc -= i;
14055 if (argc < 1 || argc > 3) {
14056 wrongargs:
14057 Jim_WrongNumArgs(interp, 1, argv,
14058 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14059 return JIM_ERR;
14061 argv += i;
14063 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
14064 sig++;
14067 interp->signal_level += sig;
14068 if (Jim_CheckSignal(interp)) {
14069 /* If a signal is set, don't even try to execute the body */
14070 exitCode = JIM_SIGNAL;
14072 else {
14073 exitCode = Jim_EvalObj(interp, argv[0]);
14074 /* Don't want any caught error included in a later stack trace */
14075 interp->errorFlag = 0;
14077 interp->signal_level -= sig;
14079 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14080 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14081 /* Not caught, pass it up */
14082 return exitCode;
14085 if (sig && exitCode == JIM_SIGNAL) {
14086 /* Catch the signal at this level */
14087 if (interp->signal_set_result) {
14088 interp->signal_set_result(interp, interp->sigmask);
14090 else {
14091 Jim_SetResultInt(interp, interp->sigmask);
14093 interp->sigmask = 0;
14096 if (argc >= 2) {
14097 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14098 return JIM_ERR;
14100 if (argc == 3) {
14101 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14103 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14104 Jim_ListAppendElement(interp, optListObj,
14105 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14106 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14107 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14108 if (exitCode == JIM_ERR) {
14109 Jim_Obj *errorCode;
14110 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14111 -1));
14112 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14114 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14115 if (errorCode) {
14116 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14117 Jim_ListAppendElement(interp, optListObj, errorCode);
14120 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14121 return JIM_ERR;
14125 Jim_SetResultInt(interp, exitCode);
14126 return JIM_OK;
14129 #ifdef JIM_REFERENCES
14131 /* [ref] */
14132 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14134 if (argc != 3 && argc != 4) {
14135 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14136 return JIM_ERR;
14138 if (argc == 3) {
14139 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14141 else {
14142 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14144 return JIM_OK;
14147 /* [getref] */
14148 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14150 Jim_Reference *refPtr;
14152 if (argc != 2) {
14153 Jim_WrongNumArgs(interp, 1, argv, "reference");
14154 return JIM_ERR;
14156 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14157 return JIM_ERR;
14158 Jim_SetResult(interp, refPtr->objPtr);
14159 return JIM_OK;
14162 /* [setref] */
14163 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14165 Jim_Reference *refPtr;
14167 if (argc != 3) {
14168 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14169 return JIM_ERR;
14171 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14172 return JIM_ERR;
14173 Jim_IncrRefCount(argv[2]);
14174 Jim_DecrRefCount(interp, refPtr->objPtr);
14175 refPtr->objPtr = argv[2];
14176 Jim_SetResult(interp, argv[2]);
14177 return JIM_OK;
14180 /* [collect] */
14181 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14183 if (argc != 1) {
14184 Jim_WrongNumArgs(interp, 1, argv, "");
14185 return JIM_ERR;
14187 Jim_SetResultInt(interp, Jim_Collect(interp));
14189 /* Free all the freed objects. */
14190 while (interp->freeList) {
14191 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14192 Jim_Free(interp->freeList);
14193 interp->freeList = nextObjPtr;
14196 return JIM_OK;
14199 /* [finalize] reference ?newValue? */
14200 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14202 if (argc != 2 && argc != 3) {
14203 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14204 return JIM_ERR;
14206 if (argc == 2) {
14207 Jim_Obj *cmdNamePtr;
14209 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14210 return JIM_ERR;
14211 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14212 Jim_SetResult(interp, cmdNamePtr);
14214 else {
14215 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14216 return JIM_ERR;
14217 Jim_SetResult(interp, argv[2]);
14219 return JIM_OK;
14222 /* [info references] */
14223 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14225 Jim_Obj *listObjPtr;
14226 Jim_HashTableIterator htiter;
14227 Jim_HashEntry *he;
14229 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14231 JimInitHashTableIterator(&interp->references, &htiter);
14232 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14233 char buf[JIM_REFERENCE_SPACE + 1];
14234 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14235 const unsigned long *refId = he->key;
14237 JimFormatReference(buf, refPtr, *refId);
14238 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14240 Jim_SetResult(interp, listObjPtr);
14241 return JIM_OK;
14243 #endif
14245 /* [rename] */
14246 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14248 if (argc != 3) {
14249 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14250 return JIM_ERR;
14253 if (JimValidName(interp, "new procedure", argv[2])) {
14254 return JIM_ERR;
14257 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14260 #define JIM_DICTMATCH_VALUES 0x0001
14262 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14264 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14266 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14267 if (type & JIM_DICTMATCH_VALUES) {
14268 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14273 * Like JimHashtablePatternMatch, but for dictionaries.
14275 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14276 JimDictMatchCallbackType *callback, int type)
14278 Jim_HashEntry *he;
14279 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14281 /* Check for the non-pattern case. We can do this much more efficiently. */
14282 Jim_HashTableIterator htiter;
14283 JimInitHashTableIterator(ht, &htiter);
14284 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14285 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14286 callback(interp, listObjPtr, he, type);
14290 return listObjPtr;
14294 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14296 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14297 return JIM_ERR;
14299 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14300 return JIM_OK;
14303 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14305 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14306 return JIM_ERR;
14308 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14309 return JIM_OK;
14312 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14314 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14315 return -1;
14317 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14320 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14322 Jim_HashTable *ht;
14323 unsigned int i;
14325 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14326 return JIM_ERR;
14329 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14331 /* Note that this uses internal knowledge of the hash table */
14332 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14334 for (i = 0; i < ht->size; i++) {
14335 Jim_HashEntry *he = ht->table[i];
14337 if (he) {
14338 printf("%d: ", i);
14340 while (he) {
14341 printf(" %s", Jim_String(he->key));
14342 he = he->next;
14344 printf("\n");
14347 return JIM_OK;
14350 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14352 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14354 Jim_AppendString(interp, prefixObj, " ", 1);
14355 Jim_AppendString(interp, prefixObj, subcmd, -1);
14357 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14360 /* [dict] */
14361 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14363 Jim_Obj *objPtr;
14364 int option;
14365 static const char * const options[] = {
14366 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14367 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14368 "replace", "update", NULL
14370 enum
14372 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14373 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14374 OPT_REPLACE, OPT_UPDATE,
14377 if (argc < 2) {
14378 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14379 return JIM_ERR;
14382 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14383 return JIM_ERR;
14386 switch (option) {
14387 case OPT_GET:
14388 if (argc < 3) {
14389 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14390 return JIM_ERR;
14392 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14393 JIM_ERRMSG) != JIM_OK) {
14394 return JIM_ERR;
14396 Jim_SetResult(interp, objPtr);
14397 return JIM_OK;
14399 case OPT_SET:
14400 if (argc < 5) {
14401 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14402 return JIM_ERR;
14404 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14406 case OPT_EXISTS:
14407 if (argc < 4) {
14408 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14409 return JIM_ERR;
14411 else {
14412 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14413 if (rc < 0) {
14414 return JIM_ERR;
14416 Jim_SetResultBool(interp, rc == JIM_OK);
14417 return JIM_OK;
14420 case OPT_UNSET:
14421 if (argc < 4) {
14422 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14423 return JIM_ERR;
14425 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14426 return JIM_ERR;
14428 return JIM_OK;
14430 case OPT_KEYS:
14431 if (argc != 3 && argc != 4) {
14432 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14433 return JIM_ERR;
14435 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14437 case OPT_SIZE:
14438 if (argc != 3) {
14439 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14440 return JIM_ERR;
14442 else if (Jim_DictSize(interp, argv[2]) < 0) {
14443 return JIM_ERR;
14445 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14446 return JIM_OK;
14448 case OPT_MERGE:
14449 if (argc == 2) {
14450 return JIM_OK;
14452 if (Jim_DictSize(interp, argv[2]) < 0) {
14453 return JIM_ERR;
14455 /* Handle as ensemble */
14456 break;
14458 case OPT_UPDATE:
14459 if (argc < 6 || argc % 2) {
14460 /* Better error message */
14461 argc = 2;
14463 break;
14465 case OPT_CREATE:
14466 if (argc % 2) {
14467 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14468 return JIM_ERR;
14470 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14471 Jim_SetResult(interp, objPtr);
14472 return JIM_OK;
14474 case OPT_INFO:
14475 if (argc != 3) {
14476 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14477 return JIM_ERR;
14479 return Jim_DictInfo(interp, argv[2]);
14481 /* Handle command as an ensemble */
14482 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14485 /* [subst] */
14486 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14488 static const char * const options[] = {
14489 "-nobackslashes", "-nocommands", "-novariables", NULL
14491 enum
14492 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14493 int i;
14494 int flags = JIM_SUBST_FLAG;
14495 Jim_Obj *objPtr;
14497 if (argc < 2) {
14498 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14499 return JIM_ERR;
14501 for (i = 1; i < (argc - 1); i++) {
14502 int option;
14504 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14505 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14506 return JIM_ERR;
14508 switch (option) {
14509 case OPT_NOBACKSLASHES:
14510 flags |= JIM_SUBST_NOESC;
14511 break;
14512 case OPT_NOCOMMANDS:
14513 flags |= JIM_SUBST_NOCMD;
14514 break;
14515 case OPT_NOVARIABLES:
14516 flags |= JIM_SUBST_NOVAR;
14517 break;
14520 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14521 return JIM_ERR;
14523 Jim_SetResult(interp, objPtr);
14524 return JIM_OK;
14527 /* [info] */
14528 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14530 int cmd;
14531 Jim_Obj *objPtr;
14532 int mode = 0;
14534 static const char * const commands[] = {
14535 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14536 "vars", "version", "patchlevel", "complete", "args", "hostname",
14537 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14538 "references", "alias", NULL
14540 enum
14541 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14542 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14543 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14544 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14547 #ifdef jim_ext_namespace
14548 int nons = 0;
14550 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14551 /* This is for internal use only */
14552 argc--;
14553 argv++;
14554 nons = 1;
14556 #endif
14558 if (argc < 2) {
14559 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14560 return JIM_ERR;
14562 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14563 != JIM_OK) {
14564 return JIM_ERR;
14567 /* Test for the most common commands first, just in case it makes a difference */
14568 switch (cmd) {
14569 case INFO_EXISTS:
14570 if (argc != 3) {
14571 Jim_WrongNumArgs(interp, 2, argv, "varName");
14572 return JIM_ERR;
14574 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14575 break;
14577 case INFO_ALIAS:{
14578 Jim_Cmd *cmdPtr;
14580 if (argc != 3) {
14581 Jim_WrongNumArgs(interp, 2, argv, "command");
14582 return JIM_ERR;
14584 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14585 return JIM_ERR;
14587 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14588 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14589 return JIM_ERR;
14591 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14592 return JIM_OK;
14595 case INFO_CHANNELS:
14596 mode++; /* JIM_CMDLIST_CHANNELS */
14597 #ifndef jim_ext_aio
14598 Jim_SetResultString(interp, "aio not enabled", -1);
14599 return JIM_ERR;
14600 #endif
14601 /* fall through */
14602 case INFO_PROCS:
14603 mode++; /* JIM_CMDLIST_PROCS */
14604 /* fall through */
14605 case INFO_COMMANDS:
14606 /* mode 0 => JIM_CMDLIST_COMMANDS */
14607 if (argc != 2 && argc != 3) {
14608 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14609 return JIM_ERR;
14611 #ifdef jim_ext_namespace
14612 if (!nons) {
14613 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14614 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14617 #endif
14618 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14619 break;
14621 case INFO_VARS:
14622 mode++; /* JIM_VARLIST_VARS */
14623 /* fall through */
14624 case INFO_LOCALS:
14625 mode++; /* JIM_VARLIST_LOCALS */
14626 /* fall through */
14627 case INFO_GLOBALS:
14628 /* mode 0 => JIM_VARLIST_GLOBALS */
14629 if (argc != 2 && argc != 3) {
14630 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14631 return JIM_ERR;
14633 #ifdef jim_ext_namespace
14634 if (!nons) {
14635 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14636 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14639 #endif
14640 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14641 break;
14643 case INFO_SCRIPT:
14644 if (argc != 2) {
14645 Jim_WrongNumArgs(interp, 2, argv, "");
14646 return JIM_ERR;
14648 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14649 break;
14651 case INFO_SOURCE:{
14652 jim_wide line;
14653 Jim_Obj *resObjPtr;
14654 Jim_Obj *fileNameObj;
14656 if (argc != 3 && argc != 5) {
14657 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14658 return JIM_ERR;
14660 if (argc == 5) {
14661 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14662 return JIM_ERR;
14664 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14665 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14667 else {
14668 if (argv[2]->typePtr == &sourceObjType) {
14669 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14670 line = argv[2]->internalRep.sourceValue.lineNumber;
14672 else if (argv[2]->typePtr == &scriptObjType) {
14673 ScriptObj *script = JimGetScript(interp, argv[2]);
14674 fileNameObj = script->fileNameObj;
14675 line = script->firstline;
14677 else {
14678 fileNameObj = interp->emptyObj;
14679 line = 1;
14681 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14682 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14683 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14685 Jim_SetResult(interp, resObjPtr);
14686 break;
14689 case INFO_STACKTRACE:
14690 Jim_SetResult(interp, interp->stackTrace);
14691 break;
14693 case INFO_LEVEL:
14694 case INFO_FRAME:
14695 switch (argc) {
14696 case 2:
14697 Jim_SetResultInt(interp, interp->framePtr->level);
14698 break;
14700 case 3:
14701 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14702 return JIM_ERR;
14704 Jim_SetResult(interp, objPtr);
14705 break;
14707 default:
14708 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14709 return JIM_ERR;
14711 break;
14713 case INFO_BODY:
14714 case INFO_STATICS:
14715 case INFO_ARGS:{
14716 Jim_Cmd *cmdPtr;
14718 if (argc != 3) {
14719 Jim_WrongNumArgs(interp, 2, argv, "procname");
14720 return JIM_ERR;
14722 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14723 return JIM_ERR;
14725 if (!cmdPtr->isproc) {
14726 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14727 return JIM_ERR;
14729 switch (cmd) {
14730 case INFO_BODY:
14731 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14732 break;
14733 case INFO_ARGS:
14734 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14735 break;
14736 case INFO_STATICS:
14737 if (cmdPtr->u.proc.staticVars) {
14738 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14739 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14740 NULL, JimVariablesMatch, mode));
14742 break;
14744 break;
14747 case INFO_VERSION:
14748 case INFO_PATCHLEVEL:{
14749 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14751 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14752 Jim_SetResultString(interp, buf, -1);
14753 break;
14756 case INFO_COMPLETE:
14757 if (argc != 3 && argc != 4) {
14758 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14759 return JIM_ERR;
14761 else {
14762 char missing;
14764 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14765 if (missing != ' ' && argc == 4) {
14766 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14769 break;
14771 case INFO_HOSTNAME:
14772 /* Redirect to os.gethostname if it exists */
14773 return Jim_Eval(interp, "os.gethostname");
14775 case INFO_NAMEOFEXECUTABLE:
14776 /* Redirect to Tcl proc */
14777 return Jim_Eval(interp, "{info nameofexecutable}");
14779 case INFO_RETURNCODES:
14780 if (argc == 2) {
14781 int i;
14782 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14784 for (i = 0; jimReturnCodes[i]; i++) {
14785 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14786 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14787 jimReturnCodes[i], -1));
14790 Jim_SetResult(interp, listObjPtr);
14792 else if (argc == 3) {
14793 long code;
14794 const char *name;
14796 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14797 return JIM_ERR;
14799 name = Jim_ReturnCode(code);
14800 if (*name == '?') {
14801 Jim_SetResultInt(interp, code);
14803 else {
14804 Jim_SetResultString(interp, name, -1);
14807 else {
14808 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14809 return JIM_ERR;
14811 break;
14812 case INFO_REFERENCES:
14813 #ifdef JIM_REFERENCES
14814 return JimInfoReferences(interp, argc, argv);
14815 #else
14816 Jim_SetResultString(interp, "not supported", -1);
14817 return JIM_ERR;
14818 #endif
14820 return JIM_OK;
14823 /* [exists] */
14824 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14826 Jim_Obj *objPtr;
14827 int result = 0;
14829 static const char * const options[] = {
14830 "-command", "-proc", "-alias", "-var", NULL
14832 enum
14834 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14836 int option;
14838 if (argc == 2) {
14839 option = OPT_VAR;
14840 objPtr = argv[1];
14842 else if (argc == 3) {
14843 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14844 return JIM_ERR;
14846 objPtr = argv[2];
14848 else {
14849 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14850 return JIM_ERR;
14853 if (option == OPT_VAR) {
14854 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14856 else {
14857 /* Now different kinds of commands */
14858 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14860 if (cmd) {
14861 switch (option) {
14862 case OPT_COMMAND:
14863 result = 1;
14864 break;
14866 case OPT_ALIAS:
14867 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14868 break;
14870 case OPT_PROC:
14871 result = cmd->isproc;
14872 break;
14876 Jim_SetResultBool(interp, result);
14877 return JIM_OK;
14880 /* [split] */
14881 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14883 const char *str, *splitChars, *noMatchStart;
14884 int splitLen, strLen;
14885 Jim_Obj *resObjPtr;
14886 int c;
14887 int len;
14889 if (argc != 2 && argc != 3) {
14890 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14891 return JIM_ERR;
14894 str = Jim_GetString(argv[1], &len);
14895 if (len == 0) {
14896 return JIM_OK;
14898 strLen = Jim_Utf8Length(interp, argv[1]);
14900 /* Init */
14901 if (argc == 2) {
14902 splitChars = " \n\t\r";
14903 splitLen = 4;
14905 else {
14906 splitChars = Jim_String(argv[2]);
14907 splitLen = Jim_Utf8Length(interp, argv[2]);
14910 noMatchStart = str;
14911 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14913 /* Split */
14914 if (splitLen) {
14915 Jim_Obj *objPtr;
14916 while (strLen--) {
14917 const char *sc = splitChars;
14918 int scLen = splitLen;
14919 int sl = utf8_tounicode(str, &c);
14920 while (scLen--) {
14921 int pc;
14922 sc += utf8_tounicode(sc, &pc);
14923 if (c == pc) {
14924 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14925 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14926 noMatchStart = str + sl;
14927 break;
14930 str += sl;
14932 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14933 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14935 else {
14936 /* This handles the special case of splitchars eq {}
14937 * Optimise by sharing common (ASCII) characters
14939 Jim_Obj **commonObj = NULL;
14940 #define NUM_COMMON (128 - 9)
14941 while (strLen--) {
14942 int n = utf8_tounicode(str, &c);
14943 #ifdef JIM_OPTIMIZATION
14944 if (c >= 9 && c < 128) {
14945 /* Common ASCII char. Note that 9 is the tab character */
14946 c -= 9;
14947 if (!commonObj) {
14948 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14949 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14951 if (!commonObj[c]) {
14952 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14954 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14955 str++;
14956 continue;
14958 #endif
14959 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14960 str += n;
14962 Jim_Free(commonObj);
14965 Jim_SetResult(interp, resObjPtr);
14966 return JIM_OK;
14969 /* [join] */
14970 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14972 const char *joinStr;
14973 int joinStrLen;
14975 if (argc != 2 && argc != 3) {
14976 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14977 return JIM_ERR;
14979 /* Init */
14980 if (argc == 2) {
14981 joinStr = " ";
14982 joinStrLen = 1;
14984 else {
14985 joinStr = Jim_GetString(argv[2], &joinStrLen);
14987 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14988 return JIM_OK;
14991 /* [format] */
14992 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14994 Jim_Obj *objPtr;
14996 if (argc < 2) {
14997 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14998 return JIM_ERR;
15000 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
15001 if (objPtr == NULL)
15002 return JIM_ERR;
15003 Jim_SetResult(interp, objPtr);
15004 return JIM_OK;
15007 /* [scan] */
15008 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15010 Jim_Obj *listPtr, **outVec;
15011 int outc, i;
15013 if (argc < 3) {
15014 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
15015 return JIM_ERR;
15017 if (argv[2]->typePtr != &scanFmtStringObjType)
15018 SetScanFmtFromAny(interp, argv[2]);
15019 if (FormatGetError(argv[2]) != 0) {
15020 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15021 return JIM_ERR;
15023 if (argc > 3) {
15024 int maxPos = FormatGetMaxPos(argv[2]);
15025 int count = FormatGetCnvCount(argv[2]);
15027 if (maxPos > argc - 3) {
15028 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15029 return JIM_ERR;
15031 else if (count > argc - 3) {
15032 Jim_SetResultString(interp, "different numbers of variable names and "
15033 "field specifiers", -1);
15034 return JIM_ERR;
15036 else if (count < argc - 3) {
15037 Jim_SetResultString(interp, "variable is not assigned by any "
15038 "conversion specifiers", -1);
15039 return JIM_ERR;
15042 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15043 if (listPtr == 0)
15044 return JIM_ERR;
15045 if (argc > 3) {
15046 int rc = JIM_OK;
15047 int count = 0;
15049 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15050 int len = Jim_ListLength(interp, listPtr);
15052 if (len != 0) {
15053 JimListGetElements(interp, listPtr, &outc, &outVec);
15054 for (i = 0; i < outc; ++i) {
15055 if (Jim_Length(outVec[i]) > 0) {
15056 ++count;
15057 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15058 rc = JIM_ERR;
15063 Jim_FreeNewObj(interp, listPtr);
15065 else {
15066 count = -1;
15068 if (rc == JIM_OK) {
15069 Jim_SetResultInt(interp, count);
15071 return rc;
15073 else {
15074 if (listPtr == (Jim_Obj *)EOF) {
15075 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15076 return JIM_OK;
15078 Jim_SetResult(interp, listPtr);
15080 return JIM_OK;
15083 /* [error] */
15084 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15086 if (argc != 2 && argc != 3) {
15087 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15088 return JIM_ERR;
15090 Jim_SetResult(interp, argv[1]);
15091 if (argc == 3) {
15092 JimSetStackTrace(interp, argv[2]);
15093 return JIM_ERR;
15095 interp->addStackTrace++;
15096 return JIM_ERR;
15099 /* [lrange] */
15100 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15102 Jim_Obj *objPtr;
15104 if (argc != 4) {
15105 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15106 return JIM_ERR;
15108 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15109 return JIM_ERR;
15110 Jim_SetResult(interp, objPtr);
15111 return JIM_OK;
15114 /* [lrepeat] */
15115 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15117 Jim_Obj *objPtr;
15118 long count;
15120 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15121 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15122 return JIM_ERR;
15125 if (count == 0 || argc == 2) {
15126 return JIM_OK;
15129 argc -= 2;
15130 argv += 2;
15132 objPtr = Jim_NewListObj(interp, argv, argc);
15133 while (--count) {
15134 ListInsertElements(objPtr, -1, argc, argv);
15137 Jim_SetResult(interp, objPtr);
15138 return JIM_OK;
15141 char **Jim_GetEnviron(void)
15143 #if defined(HAVE__NSGETENVIRON)
15144 return *_NSGetEnviron();
15145 #else
15146 #if !defined(NO_ENVIRON_EXTERN)
15147 extern char **environ;
15148 #endif
15150 return environ;
15151 #endif
15154 void Jim_SetEnviron(char **env)
15156 #if defined(HAVE__NSGETENVIRON)
15157 *_NSGetEnviron() = env;
15158 #else
15159 #if !defined(NO_ENVIRON_EXTERN)
15160 extern char **environ;
15161 #endif
15163 environ = env;
15164 #endif
15167 /* [env] */
15168 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15170 const char *key;
15171 const char *val;
15173 if (argc == 1) {
15174 char **e = Jim_GetEnviron();
15176 int i;
15177 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15179 for (i = 0; e[i]; i++) {
15180 const char *equals = strchr(e[i], '=');
15182 if (equals) {
15183 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15184 equals - e[i]));
15185 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15189 Jim_SetResult(interp, listObjPtr);
15190 return JIM_OK;
15193 if (argc < 2) {
15194 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15195 return JIM_ERR;
15197 key = Jim_String(argv[1]);
15198 val = getenv(key);
15199 if (val == NULL) {
15200 if (argc < 3) {
15201 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15202 return JIM_ERR;
15204 val = Jim_String(argv[2]);
15206 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15207 return JIM_OK;
15210 /* [source] */
15211 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15213 int retval;
15215 if (argc != 2) {
15216 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15217 return JIM_ERR;
15219 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15220 if (retval == JIM_RETURN)
15221 return JIM_OK;
15222 return retval;
15225 /* [lreverse] */
15226 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15228 Jim_Obj *revObjPtr, **ele;
15229 int len;
15231 if (argc != 2) {
15232 Jim_WrongNumArgs(interp, 1, argv, "list");
15233 return JIM_ERR;
15235 JimListGetElements(interp, argv[1], &len, &ele);
15236 len--;
15237 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15238 while (len >= 0)
15239 ListAppendElement(revObjPtr, ele[len--]);
15240 Jim_SetResult(interp, revObjPtr);
15241 return JIM_OK;
15244 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15246 jim_wide len;
15248 if (step == 0)
15249 return -1;
15250 if (start == end)
15251 return 0;
15252 else if (step > 0 && start > end)
15253 return -1;
15254 else if (step < 0 && end > start)
15255 return -1;
15256 len = end - start;
15257 if (len < 0)
15258 len = -len; /* abs(len) */
15259 if (step < 0)
15260 step = -step; /* abs(step) */
15261 len = 1 + ((len - 1) / step);
15262 /* We can truncate safely to INT_MAX, the range command
15263 * will always return an error for a such long range
15264 * because Tcl lists can't be so long. */
15265 if (len > INT_MAX)
15266 len = INT_MAX;
15267 return (int)((len < 0) ? -1 : len);
15270 /* [range] */
15271 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15273 jim_wide start = 0, end, step = 1;
15274 int len, i;
15275 Jim_Obj *objPtr;
15277 if (argc < 2 || argc > 4) {
15278 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15279 return JIM_ERR;
15281 if (argc == 2) {
15282 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15283 return JIM_ERR;
15285 else {
15286 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15287 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15288 return JIM_ERR;
15289 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15290 return JIM_ERR;
15292 if ((len = JimRangeLen(start, end, step)) == -1) {
15293 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15294 return JIM_ERR;
15296 objPtr = Jim_NewListObj(interp, NULL, 0);
15297 for (i = 0; i < len; i++)
15298 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15299 Jim_SetResult(interp, objPtr);
15300 return JIM_OK;
15303 /* [rand] */
15304 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15306 jim_wide min = 0, max = 0, len, maxMul;
15308 if (argc < 1 || argc > 3) {
15309 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15310 return JIM_ERR;
15312 if (argc == 1) {
15313 max = JIM_WIDE_MAX;
15314 } else if (argc == 2) {
15315 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15316 return JIM_ERR;
15317 } else if (argc == 3) {
15318 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15319 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15320 return JIM_ERR;
15322 len = max-min;
15323 if (len < 0) {
15324 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15325 return JIM_ERR;
15327 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15328 while (1) {
15329 jim_wide r;
15331 JimRandomBytes(interp, &r, sizeof(jim_wide));
15332 if (r < 0 || r >= maxMul) continue;
15333 r = (len == 0) ? 0 : r%len;
15334 Jim_SetResultInt(interp, min+r);
15335 return JIM_OK;
15339 static const struct {
15340 const char *name;
15341 Jim_CmdProc *cmdProc;
15342 } Jim_CoreCommandsTable[] = {
15343 {"alias", Jim_AliasCoreCommand},
15344 {"set", Jim_SetCoreCommand},
15345 {"unset", Jim_UnsetCoreCommand},
15346 {"puts", Jim_PutsCoreCommand},
15347 {"+", Jim_AddCoreCommand},
15348 {"*", Jim_MulCoreCommand},
15349 {"-", Jim_SubCoreCommand},
15350 {"/", Jim_DivCoreCommand},
15351 {"incr", Jim_IncrCoreCommand},
15352 {"while", Jim_WhileCoreCommand},
15353 {"loop", Jim_LoopCoreCommand},
15354 {"for", Jim_ForCoreCommand},
15355 {"foreach", Jim_ForeachCoreCommand},
15356 {"lmap", Jim_LmapCoreCommand},
15357 {"lassign", Jim_LassignCoreCommand},
15358 {"if", Jim_IfCoreCommand},
15359 {"switch", Jim_SwitchCoreCommand},
15360 {"list", Jim_ListCoreCommand},
15361 {"lindex", Jim_LindexCoreCommand},
15362 {"lset", Jim_LsetCoreCommand},
15363 {"lsearch", Jim_LsearchCoreCommand},
15364 {"llength", Jim_LlengthCoreCommand},
15365 {"lappend", Jim_LappendCoreCommand},
15366 {"linsert", Jim_LinsertCoreCommand},
15367 {"lreplace", Jim_LreplaceCoreCommand},
15368 {"lsort", Jim_LsortCoreCommand},
15369 {"append", Jim_AppendCoreCommand},
15370 {"debug", Jim_DebugCoreCommand},
15371 {"eval", Jim_EvalCoreCommand},
15372 {"uplevel", Jim_UplevelCoreCommand},
15373 {"expr", Jim_ExprCoreCommand},
15374 {"break", Jim_BreakCoreCommand},
15375 {"continue", Jim_ContinueCoreCommand},
15376 {"proc", Jim_ProcCoreCommand},
15377 {"concat", Jim_ConcatCoreCommand},
15378 {"return", Jim_ReturnCoreCommand},
15379 {"upvar", Jim_UpvarCoreCommand},
15380 {"global", Jim_GlobalCoreCommand},
15381 {"string", Jim_StringCoreCommand},
15382 {"time", Jim_TimeCoreCommand},
15383 {"exit", Jim_ExitCoreCommand},
15384 {"catch", Jim_CatchCoreCommand},
15385 #ifdef JIM_REFERENCES
15386 {"ref", Jim_RefCoreCommand},
15387 {"getref", Jim_GetrefCoreCommand},
15388 {"setref", Jim_SetrefCoreCommand},
15389 {"finalize", Jim_FinalizeCoreCommand},
15390 {"collect", Jim_CollectCoreCommand},
15391 #endif
15392 {"rename", Jim_RenameCoreCommand},
15393 {"dict", Jim_DictCoreCommand},
15394 {"subst", Jim_SubstCoreCommand},
15395 {"info", Jim_InfoCoreCommand},
15396 {"exists", Jim_ExistsCoreCommand},
15397 {"split", Jim_SplitCoreCommand},
15398 {"join", Jim_JoinCoreCommand},
15399 {"format", Jim_FormatCoreCommand},
15400 {"scan", Jim_ScanCoreCommand},
15401 {"error", Jim_ErrorCoreCommand},
15402 {"lrange", Jim_LrangeCoreCommand},
15403 {"lrepeat", Jim_LrepeatCoreCommand},
15404 {"env", Jim_EnvCoreCommand},
15405 {"source", Jim_SourceCoreCommand},
15406 {"lreverse", Jim_LreverseCoreCommand},
15407 {"range", Jim_RangeCoreCommand},
15408 {"rand", Jim_RandCoreCommand},
15409 {"tailcall", Jim_TailcallCoreCommand},
15410 {"local", Jim_LocalCoreCommand},
15411 {"upcall", Jim_UpcallCoreCommand},
15412 {"apply", Jim_ApplyCoreCommand},
15413 {NULL, NULL},
15416 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15418 int i = 0;
15420 while (Jim_CoreCommandsTable[i].name != NULL) {
15421 Jim_CreateCommand(interp,
15422 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15423 i++;
15427 /* -----------------------------------------------------------------------------
15428 * Interactive prompt
15429 * ---------------------------------------------------------------------------*/
15430 void Jim_MakeErrorMessage(Jim_Interp *interp)
15432 Jim_Obj *argv[2];
15434 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15435 argv[1] = interp->result;
15437 Jim_EvalObjVector(interp, 2, argv);
15440 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15441 const char *prefix, const char *const *tablePtr, const char *name)
15443 int count;
15444 char **tablePtrSorted;
15445 int i;
15447 for (count = 0; tablePtr[count]; count++) {
15450 if (name == NULL) {
15451 name = "option";
15454 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15455 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15456 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15457 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15458 for (i = 0; i < count; i++) {
15459 if (i + 1 == count && count > 1) {
15460 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15462 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15463 if (i + 1 != count) {
15464 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15467 Jim_Free(tablePtrSorted);
15470 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15471 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15473 const char *bad = "bad ";
15474 const char *const *entryPtr = NULL;
15475 int i;
15476 int match = -1;
15477 int arglen;
15478 const char *arg = Jim_GetString(objPtr, &arglen);
15480 *indexPtr = -1;
15482 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15483 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15484 /* Found an exact match */
15485 *indexPtr = i;
15486 return JIM_OK;
15488 if (flags & JIM_ENUM_ABBREV) {
15489 /* Accept an unambiguous abbreviation.
15490 * Note that '-' doesnt' consitute a valid abbreviation
15492 if (strncmp(arg, *entryPtr, arglen) == 0) {
15493 if (*arg == '-' && arglen == 1) {
15494 break;
15496 if (match >= 0) {
15497 bad = "ambiguous ";
15498 goto ambiguous;
15500 match = i;
15505 /* If we had an unambiguous partial match */
15506 if (match >= 0) {
15507 *indexPtr = match;
15508 return JIM_OK;
15511 ambiguous:
15512 if (flags & JIM_ERRMSG) {
15513 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15515 return JIM_ERR;
15518 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15520 int i;
15522 for (i = 0; i < (int)len; i++) {
15523 if (array[i] && strcmp(array[i], name) == 0) {
15524 return i;
15527 return -1;
15530 int Jim_IsDict(Jim_Obj *objPtr)
15532 return objPtr->typePtr == &dictObjType;
15535 int Jim_IsList(Jim_Obj *objPtr)
15537 return objPtr->typePtr == &listObjType;
15541 * Very simple printf-like formatting, designed for error messages.
15543 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15544 * The resulting string is created and set as the result.
15546 * Each '%s' should correspond to a regular string parameter.
15547 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15548 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15550 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15552 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15554 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15556 /* Initial space needed */
15557 int len = strlen(format);
15558 int extra = 0;
15559 int n = 0;
15560 const char *params[5];
15561 char *buf;
15562 va_list args;
15563 int i;
15565 va_start(args, format);
15567 for (i = 0; i < len && n < 5; i++) {
15568 int l;
15570 if (strncmp(format + i, "%s", 2) == 0) {
15571 params[n] = va_arg(args, char *);
15573 l = strlen(params[n]);
15575 else if (strncmp(format + i, "%#s", 3) == 0) {
15576 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15578 params[n] = Jim_GetString(objPtr, &l);
15580 else {
15581 if (format[i] == '%') {
15582 i++;
15584 continue;
15586 n++;
15587 extra += l;
15590 len += extra;
15591 buf = Jim_Alloc(len + 1);
15592 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15594 va_end(args);
15596 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15599 /* stubs */
15600 #ifndef jim_ext_package
15601 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15603 return JIM_OK;
15605 #endif
15606 #ifndef jim_ext_aio
15607 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15609 Jim_SetResultString(interp, "aio not enabled", -1);
15610 return NULL;
15612 #endif
15616 * Local Variables: ***
15617 * c-basic-offset: 4 ***
15618 * tab-width: 4 ***
15619 * End: ***