expr: add support for atan2, hypot and fmod
[jimtcl.git] / jim.c
blobca3bcec07bf4f4bd6c478b5b4a4c55ab48eb50a2
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
130 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
131 int flags);
132 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
133 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
134 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
135 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
136 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
137 const char *prefix, const char *const *tablePtr, const char *name);
138 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
139 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
140 static int JimSign(jim_wide w);
141 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
142 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
143 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s, int *uc, int upper)
153 int l = utf8_tounicode(s, uc);
154 if (upper) {
155 *uc = utf8_upper(*uc);
157 return l;
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
182 int not = 0;
183 int pchar;
184 int match = 0;
185 int nocase = 0;
187 if (flags & JIM_NOCASE) {
188 nocase++;
189 c = utf8_upper(c);
192 if (flags & JIM_CHARSET_SCAN) {
193 if (*pattern == '^') {
194 not++;
195 pattern++;
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern == ']') {
200 goto first;
204 while (*pattern && *pattern != ']') {
205 /* Exact match */
206 if (pattern[0] == '\\') {
207 first:
208 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
210 else {
211 /* Is this a range? a-z */
212 int start;
213 int end;
215 pattern += utf8_tounicode_case(pattern, &start, nocase);
216 if (pattern[0] == '-' && pattern[1]) {
217 /* skip '-' */
218 pattern += utf8_tounicode(pattern, &pchar);
219 pattern += utf8_tounicode_case(pattern, &end, nocase);
221 /* Handle reversed range too */
222 if ((c >= start && c <= end) || (c >= end && c <= start)) {
223 match = 1;
225 continue;
227 pchar = start;
230 if (pchar == c) {
231 match = 1;
234 if (not) {
235 match = !match;
238 return match ? pattern : NULL;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
311 * string comparison. Works on binary data.
313 * Returns -1, 0 or 1
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
319 if (l1 < l2) {
320 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
322 else if (l2 < l1) {
323 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
325 else {
326 return JimSign(memcmp(s1, s2, l1));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
340 while (*s1 && *s2 && maxchars) {
341 int c1, c2;
342 s1 += utf8_tounicode_case(s1, &c1, nocase);
343 s2 += utf8_tounicode_case(s2, &c2, nocase);
344 if (c1 != c2) {
345 return JimSign(c1 - c2);
347 maxchars--;
349 if (!maxchars) {
350 return 0;
352 /* One string or both terminated */
353 if (*s1) {
354 return 1;
356 if (*s2) {
357 return -1;
359 return 0;
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
367 int i;
368 int l1bytelen;
370 if (!l1 || !l2 || l1 > l2) {
371 return -1;
373 if (idx < 0)
374 idx = 0;
375 s2 += utf8_index(s2, idx);
377 l1bytelen = utf8_index(s1, l1);
379 for (i = idx; i <= l2 - l1; i++) {
380 int c;
381 if (memcmp(s2, s1, l1bytelen) == 0) {
382 return i;
384 s2 += utf8_tounicode(s2, &c);
386 return -1;
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
394 const char *p;
396 if (!l1 || !l2 || l1 > l2)
397 return -1;
399 /* Now search for the needle */
400 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
401 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
402 return p - s2;
405 return -1;
408 #ifdef JIM_UTF8
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
414 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
415 if (n > 0) {
416 n = utf8_strlen(s2, n);
418 return n;
420 #endif
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str, const char *endptr)
431 if (str[0] == '\0' || str == endptr) {
432 return JIM_ERR;
435 if (endptr[0] != '\0') {
436 while (*endptr) {
437 if (!isspace(UCHAR(*endptr))) {
438 return JIM_ERR;
440 endptr++;
443 return JIM_OK;
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str, int *base, int *sign)
451 int i = 0;
453 *base = 10;
455 while (isspace(UCHAR(str[i]))) {
456 i++;
459 if (str[i] == '-') {
460 *sign = -1;
461 i++;
463 else {
464 if (str[i] == '+') {
465 i++;
467 *sign = 1;
470 if (str[i] != '0') {
471 /* base 10 */
472 return 0;
475 /* We have 0<x>, so see if we can convert it */
476 switch (str[i + 1]) {
477 case 'x': case 'X': *base = 16; break;
478 case 'o': case 'O': *base = 8; break;
479 case 'b': case 'B': *base = 2; break;
480 default: return 0;
482 i += 2;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
485 /* Parse according to this base */
486 return i;
488 /* Parse as base 10 */
489 *base = 10;
490 return 0;
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str, char **endptr)
498 int sign;
499 int base;
500 int i = JimNumberBase(str, &base, &sign);
502 if (base != 10) {
503 long value = strtol(str + i, endptr, base);
504 if (endptr == NULL || *endptr != str + i) {
505 return value * sign;
509 /* Can just do a regular base-10 conversion */
510 return strtol(str, endptr, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide jim_strtoull(const char *str, char **endptr)
519 #ifdef HAVE_LONG_LONG
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 jim_wide value = strtoull(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str, endptr, 10);
533 #else
534 return (unsigned long)jim_strtol(str, endptr);
535 #endif
538 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
540 char *endptr;
542 if (base) {
543 *widePtr = strtoull(str, &endptr, base);
545 else {
546 *widePtr = jim_strtoull(str, &endptr);
549 return JimCheckConversion(str, endptr);
552 int Jim_StringToDouble(const char *str, double *doublePtr)
554 char *endptr;
556 /* Callers can check for underflow via ERANGE */
557 errno = 0;
559 *doublePtr = strtod(str, &endptr);
561 return JimCheckConversion(str, endptr);
564 static jim_wide JimPowWide(jim_wide b, jim_wide e)
566 jim_wide i, res = 1;
568 if ((b == 0 && e != 0) || (e < 0))
569 return 0;
570 for (i = 0; i < e; i++) {
571 res *= b;
573 return res;
576 /* -----------------------------------------------------------------------------
577 * Special functions
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition, const char *fmt, ...)
582 va_list ap;
584 if (!condition) {
585 return;
588 va_start(ap, fmt);
590 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr, fmt, ap);
592 fprintf(stderr, "\n\n");
593 va_end(ap);
595 #ifdef HAVE_BACKTRACE
597 void *array[40];
598 int size, i;
599 char **strings;
601 size = backtrace(array, 40);
602 strings = backtrace_symbols(array, size);
603 for (i = 0; i < size; i++)
604 fprintf(stderr, "[backtrace] %s\n", strings[i]);
605 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
608 #endif
610 exit(1);
612 #endif
614 /* -----------------------------------------------------------------------------
615 * Memory allocation
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size)
620 return size ? malloc(size) : NULL;
623 void Jim_Free(void *ptr)
625 free(ptr);
628 void *Jim_Realloc(void *ptr, int size)
630 return realloc(ptr, size);
633 char *Jim_StrDup(const char *s)
635 return strdup(s);
638 char *Jim_StrDupLen(const char *s, int l)
640 char *copy = Jim_Alloc(l + 1);
642 memcpy(copy, s, l + 1);
643 copy[l] = 0; /* Just to be sure, original could be substring */
644 return copy;
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide JimClock(void)
654 struct timeval tv;
656 gettimeofday(&tv, NULL);
657 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
660 /* -----------------------------------------------------------------------------
661 * Hash Tables
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
666 static unsigned int JimHashTableNextPower(unsigned int size);
667 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key)
674 key += ~(key << 15);
675 key ^= (key >> 10);
676 key += (key << 3);
677 key ^= (key >> 6);
678 key += ~(key << 11);
679 key ^= (key >> 16);
680 return key;
683 /* Generic hash function (we are using to multiply by 9 and add the byte
684 * as Tcl) */
685 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
687 unsigned int h = 0;
689 while (len--)
690 h += (h << 3) + *buf++;
691 return h;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable *ht)
699 ht->table = NULL;
700 ht->size = 0;
701 ht->sizemask = 0;
702 ht->used = 0;
703 ht->collisions = 0;
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht->uniq = (rand() ^ time(NULL) ^ clock());
709 #else
710 ht->uniq = 0;
711 #endif
714 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
716 iter->ht = ht;
717 iter->index = -1;
718 iter->entry = NULL;
719 iter->nextEntry = NULL;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
725 JimResetHashTable(ht);
726 ht->type = type;
727 ht->privdata = privDataPtr;
728 return JIM_OK;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable *ht)
735 int minimal = ht->used;
737 if (minimal < JIM_HT_INITIAL_SIZE)
738 minimal = JIM_HT_INITIAL_SIZE;
739 Jim_ExpandHashTable(ht, minimal);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
745 Jim_HashTable n; /* the new hashtable */
746 unsigned int realsize = JimHashTableNextPower(size), i;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size <= ht->used)
751 return;
753 Jim_InitHashTable(&n, ht->type, ht->privdata);
754 n.size = realsize;
755 n.sizemask = realsize - 1;
756 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
757 /* Keep the same 'uniq' as the original */
758 n.uniq = ht->uniq;
760 /* Initialize all the pointers to NULL */
761 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
766 n.used = ht->used;
767 for (i = 0; ht->used > 0; i++) {
768 Jim_HashEntry *he, *nextHe;
770 if (ht->table[i] == NULL)
771 continue;
773 /* For each hash entry on this slot... */
774 he = ht->table[i];
775 while (he) {
776 unsigned int h;
778 nextHe = he->next;
779 /* Get the new element index */
780 h = Jim_HashKey(ht, he->key) & n.sizemask;
781 he->next = n.table[h];
782 n.table[h] = he;
783 ht->used--;
784 /* Pass to the next element */
785 he = nextHe;
788 assert(ht->used == 0);
789 Jim_Free(ht->table);
791 /* Remap the new hashtable in the old */
792 *ht = n;
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
798 Jim_HashEntry *entry;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry = JimInsertHashEntry(ht, key, 0);
803 if (entry == NULL)
804 return JIM_ERR;
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht, entry, key);
808 Jim_SetHashVal(ht, entry, val);
809 return JIM_OK;
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
815 int existed;
816 Jim_HashEntry *entry;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry = JimInsertHashEntry(ht, key, 1);
821 if (entry->key) {
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht->type->valDestructor && ht->type->valDup) {
828 void *newval = ht->type->valDup(ht->privdata, val);
829 ht->type->valDestructor(ht->privdata, entry->u.val);
830 entry->u.val = newval;
832 else {
833 Jim_FreeEntryVal(ht, entry);
834 Jim_SetHashVal(ht, entry, val);
836 existed = 1;
838 else {
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht, entry, key);
841 Jim_SetHashVal(ht, entry, val);
842 existed = 0;
845 return existed;
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
851 unsigned int h;
852 Jim_HashEntry *he, *prevHe;
854 if (ht->used == 0)
855 return JIM_ERR;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
859 prevHe = NULL;
860 while (he) {
861 if (Jim_CompareHashKeys(ht, key, he->key)) {
862 /* Unlink the element from the list */
863 if (prevHe)
864 prevHe->next = he->next;
865 else
866 ht->table[h] = he->next;
867 Jim_FreeEntryKey(ht, he);
868 Jim_FreeEntryVal(ht, he);
869 Jim_Free(he);
870 ht->used--;
871 return JIM_OK;
873 prevHe = he;
874 he = he->next;
876 return JIM_ERR; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable *ht)
882 unsigned int i;
884 /* Free all the elements */
885 for (i = 0; ht->used > 0; i++) {
886 Jim_HashEntry *he, *nextHe;
888 if ((he = ht->table[i]) == NULL)
889 continue;
890 while (he) {
891 nextHe = he->next;
892 Jim_FreeEntryKey(ht, he);
893 Jim_FreeEntryVal(ht, he);
894 Jim_Free(he);
895 ht->used--;
896 he = nextHe;
899 /* Free the table and the allocated cache structure */
900 Jim_Free(ht->table);
901 /* Re-initialize the table */
902 JimResetHashTable(ht);
903 return JIM_OK; /* never fails */
906 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
908 Jim_HashEntry *he;
909 unsigned int h;
911 if (ht->used == 0)
912 return NULL;
913 h = Jim_HashKey(ht, key) & ht->sizemask;
914 he = ht->table[h];
915 while (he) {
916 if (Jim_CompareHashKeys(ht, key, he->key))
917 return he;
918 he = he->next;
920 return NULL;
923 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
925 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
926 JimInitHashTableIterator(ht, iter);
927 return iter;
930 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
932 while (1) {
933 if (iter->entry == NULL) {
934 iter->index++;
935 if (iter->index >= (signed)iter->ht->size)
936 break;
937 iter->entry = iter->ht->table[iter->index];
939 else {
940 iter->entry = iter->nextEntry;
942 if (iter->entry) {
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter->nextEntry = iter->entry->next;
946 return iter->entry;
949 return NULL;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
959 if (ht->size == 0)
960 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
961 if (ht->size == ht->used)
962 Jim_ExpandHashTable(ht, ht->size * 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size)
968 unsigned int i = JIM_HT_INITIAL_SIZE;
970 if (size >= 2147483648U)
971 return 2147483648U;
972 while (1) {
973 if (i >= size)
974 return i;
975 i *= 2;
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
984 unsigned int h;
985 Jim_HashEntry *he;
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht);
990 /* Compute the key hash value */
991 h = Jim_HashKey(ht, key) & ht->sizemask;
992 /* Search if this slot does not already contain the given key */
993 he = ht->table[h];
994 while (he) {
995 if (Jim_CompareHashKeys(ht, key, he->key))
996 return replace ? he : NULL;
997 he = he->next;
1000 /* Allocates the memory and stores key */
1001 he = Jim_Alloc(sizeof(*he));
1002 he->next = ht->table[h];
1003 ht->table[h] = he;
1004 ht->used++;
1005 he->key = NULL;
1007 return he;
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key)
1014 return Jim_GenHashFunction(key, strlen(key));
1017 static void *JimStringCopyHTDup(void *privdata, const void *key)
1019 return Jim_StrDup(key);
1022 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1024 return strcmp(key1, key2) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1029 Jim_Free(key);
1032 static const Jim_HashTableType JimPackageHashTableType = {
1033 JimStringCopyHTHashFunction, /* hash function */
1034 JimStringCopyHTDup, /* key dup */
1035 NULL, /* val dup */
1036 JimStringCopyHTKeyCompare, /* key compare */
1037 JimStringCopyHTKeyDestructor, /* key destructor */
1038 NULL /* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc *delProc;
1044 void *data;
1045 } AssocDataValue;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1049 AssocDataValue *assocPtr = (AssocDataValue *) data;
1051 if (assocPtr->delProc != NULL)
1052 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1053 Jim_Free(data);
1056 static const Jim_HashTableType JimAssocDataHashTableType = {
1057 JimStringCopyHTHashFunction, /* hash function */
1058 JimStringCopyHTDup, /* key dup */
1059 NULL, /* val dup */
1060 JimStringCopyHTKeyCompare, /* key compare */
1061 JimStringCopyHTKeyDestructor, /* key destructor */
1062 JimAssocDataHashTableValueDestructor /* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack *stack)
1071 stack->len = 0;
1072 stack->maxlen = 0;
1073 stack->vector = NULL;
1076 void Jim_FreeStack(Jim_Stack *stack)
1078 Jim_Free(stack->vector);
1081 int Jim_StackLen(Jim_Stack *stack)
1083 return stack->len;
1086 void Jim_StackPush(Jim_Stack *stack, void *element)
1088 int neededLen = stack->len + 1;
1090 if (neededLen > stack->maxlen) {
1091 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1092 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1094 stack->vector[stack->len] = element;
1095 stack->len++;
1098 void *Jim_StackPop(Jim_Stack *stack)
1100 if (stack->len == 0)
1101 return NULL;
1102 stack->len--;
1103 return stack->vector[stack->len];
1106 void *Jim_StackPeek(Jim_Stack *stack)
1108 if (stack->len == 0)
1109 return NULL;
1110 return stack->vector[stack->len - 1];
1113 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1115 int i;
1117 for (i = 0; i < stack->len; i++)
1118 freeFunc(stack->vector[i]);
1121 /* -----------------------------------------------------------------------------
1122 * Tcl Parser
1123 * ---------------------------------------------------------------------------*/
1125 /* Token types */
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1146 #define JIM_TT_EXPR_BOOLEAN 16
1148 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1150 /* Operator token types start here */
1151 #define JIM_TT_EXPR_OP 20
1153 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1156 * Results of missing quotes, braces, etc. from parsing.
1158 struct JimParseMissing {
1159 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1160 int line; /* Line number starting the missing token */
1163 /* Parser context structure. The same context is used both to parse
1164 * Tcl scripts and lists. */
1165 struct JimParserCtx
1167 const char *p; /* Pointer to the point of the program we are parsing */
1168 int len; /* Remaining length */
1169 int linenr; /* Current line number */
1170 const char *tstart;
1171 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1172 int tline; /* Line number of the returned token */
1173 int tt; /* Token type */
1174 int eof; /* Non zero if EOF condition is true. */
1175 int inquote; /* Parsing a quoted string */
1176 int comment; /* Non zero if the next chars may be a comment. */
1177 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1180 static int JimParseScript(struct JimParserCtx *pc);
1181 static int JimParseSep(struct JimParserCtx *pc);
1182 static int JimParseEol(struct JimParserCtx *pc);
1183 static int JimParseCmd(struct JimParserCtx *pc);
1184 static int JimParseQuote(struct JimParserCtx *pc);
1185 static int JimParseVar(struct JimParserCtx *pc);
1186 static int JimParseBrace(struct JimParserCtx *pc);
1187 static int JimParseStr(struct JimParserCtx *pc);
1188 static int JimParseComment(struct JimParserCtx *pc);
1189 static void JimParseSubCmd(struct JimParserCtx *pc);
1190 static int JimParseSubQuote(struct JimParserCtx *pc);
1191 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1193 /* Initialize a parser context.
1194 * 'prg' is a pointer to the program text, linenr is the line
1195 * number of the first line contained in the program. */
1196 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1198 pc->p = prg;
1199 pc->len = len;
1200 pc->tstart = NULL;
1201 pc->tend = NULL;
1202 pc->tline = 0;
1203 pc->tt = JIM_TT_NONE;
1204 pc->eof = 0;
1205 pc->inquote = 0;
1206 pc->linenr = linenr;
1207 pc->comment = 1;
1208 pc->missing.ch = ' ';
1209 pc->missing.line = linenr;
1212 static int JimParseScript(struct JimParserCtx *pc)
1214 while (1) { /* the while is used to reiterate with continue if needed */
1215 if (!pc->len) {
1216 pc->tstart = pc->p;
1217 pc->tend = pc->p - 1;
1218 pc->tline = pc->linenr;
1219 pc->tt = JIM_TT_EOL;
1220 pc->eof = 1;
1221 return JIM_OK;
1223 switch (*(pc->p)) {
1224 case '\\':
1225 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1226 return JimParseSep(pc);
1228 pc->comment = 0;
1229 return JimParseStr(pc);
1230 case ' ':
1231 case '\t':
1232 case '\r':
1233 case '\f':
1234 if (!pc->inquote)
1235 return JimParseSep(pc);
1236 pc->comment = 0;
1237 return JimParseStr(pc);
1238 case '\n':
1239 case ';':
1240 pc->comment = 1;
1241 if (!pc->inquote)
1242 return JimParseEol(pc);
1243 return JimParseStr(pc);
1244 case '[':
1245 pc->comment = 0;
1246 return JimParseCmd(pc);
1247 case '$':
1248 pc->comment = 0;
1249 if (JimParseVar(pc) == JIM_ERR) {
1250 /* An orphan $. Create as a separate token */
1251 pc->tstart = pc->tend = pc->p++;
1252 pc->len--;
1253 pc->tt = JIM_TT_ESC;
1255 return JIM_OK;
1256 case '#':
1257 if (pc->comment) {
1258 JimParseComment(pc);
1259 continue;
1261 return JimParseStr(pc);
1262 default:
1263 pc->comment = 0;
1264 return JimParseStr(pc);
1266 return JIM_OK;
1270 static int JimParseSep(struct JimParserCtx *pc)
1272 pc->tstart = pc->p;
1273 pc->tline = pc->linenr;
1274 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1275 if (*pc->p == '\n') {
1276 break;
1278 if (*pc->p == '\\') {
1279 pc->p++;
1280 pc->len--;
1281 pc->linenr++;
1283 pc->p++;
1284 pc->len--;
1286 pc->tend = pc->p - 1;
1287 pc->tt = JIM_TT_SEP;
1288 return JIM_OK;
1291 static int JimParseEol(struct JimParserCtx *pc)
1293 pc->tstart = pc->p;
1294 pc->tline = pc->linenr;
1295 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1296 if (*pc->p == '\n')
1297 pc->linenr++;
1298 pc->p++;
1299 pc->len--;
1301 pc->tend = pc->p - 1;
1302 pc->tt = JIM_TT_EOL;
1303 return JIM_OK;
1307 ** Here are the rules for parsing:
1308 ** {braced expression}
1309 ** - Count open and closing braces
1310 ** - Backslash escapes meaning of braces
1312 ** "quoted expression"
1313 ** - First double quote at start of word terminates the expression
1314 ** - Backslash escapes quote and bracket
1315 ** - [commands brackets] are counted/nested
1316 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1318 ** [command expression]
1319 ** - Count open and closing brackets
1320 ** - Backslash escapes quote, bracket and brace
1321 ** - [commands brackets] are counted/nested
1322 ** - "quoted expressions" are parsed according to quoting rules
1323 ** - {braced expressions} are parsed according to brace rules
1325 ** For everything, backslash escapes the next char, newline increments current line
1329 * Parses a braced expression starting at pc->p.
1331 * Positions the parser at the end of the braced expression,
1332 * sets pc->tend and possibly pc->missing.
1334 static void JimParseSubBrace(struct JimParserCtx *pc)
1336 int level = 1;
1338 /* Skip the brace */
1339 pc->p++;
1340 pc->len--;
1341 while (pc->len) {
1342 switch (*pc->p) {
1343 case '\\':
1344 if (pc->len > 1) {
1345 if (*++pc->p == '\n') {
1346 pc->linenr++;
1348 pc->len--;
1350 break;
1352 case '{':
1353 level++;
1354 break;
1356 case '}':
1357 if (--level == 0) {
1358 pc->tend = pc->p - 1;
1359 pc->p++;
1360 pc->len--;
1361 return;
1363 break;
1365 case '\n':
1366 pc->linenr++;
1367 break;
1369 pc->p++;
1370 pc->len--;
1372 pc->missing.ch = '{';
1373 pc->missing.line = pc->tline;
1374 pc->tend = pc->p - 1;
1378 * Parses a quoted expression starting at pc->p.
1380 * Positions the parser at the end of the quoted expression,
1381 * sets pc->tend and possibly pc->missing.
1383 * Returns the type of the token of the string,
1384 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1385 * or JIM_TT_STR.
1387 static int JimParseSubQuote(struct JimParserCtx *pc)
1389 int tt = JIM_TT_STR;
1390 int line = pc->tline;
1392 /* Skip the quote */
1393 pc->p++;
1394 pc->len--;
1395 while (pc->len) {
1396 switch (*pc->p) {
1397 case '\\':
1398 if (pc->len > 1) {
1399 if (*++pc->p == '\n') {
1400 pc->linenr++;
1402 pc->len--;
1403 tt = JIM_TT_ESC;
1405 break;
1407 case '"':
1408 pc->tend = pc->p - 1;
1409 pc->p++;
1410 pc->len--;
1411 return tt;
1413 case '[':
1414 JimParseSubCmd(pc);
1415 tt = JIM_TT_ESC;
1416 continue;
1418 case '\n':
1419 pc->linenr++;
1420 break;
1422 case '$':
1423 tt = JIM_TT_ESC;
1424 break;
1426 pc->p++;
1427 pc->len--;
1429 pc->missing.ch = '"';
1430 pc->missing.line = line;
1431 pc->tend = pc->p - 1;
1432 return tt;
1436 * Parses a [command] expression starting at pc->p.
1438 * Positions the parser at the end of the command expression,
1439 * sets pc->tend and possibly pc->missing.
1441 static void JimParseSubCmd(struct JimParserCtx *pc)
1443 int level = 1;
1444 int startofword = 1;
1445 int line = pc->tline;
1447 /* Skip the bracket */
1448 pc->p++;
1449 pc->len--;
1450 while (pc->len) {
1451 switch (*pc->p) {
1452 case '\\':
1453 if (pc->len > 1) {
1454 if (*++pc->p == '\n') {
1455 pc->linenr++;
1457 pc->len--;
1459 break;
1461 case '[':
1462 level++;
1463 break;
1465 case ']':
1466 if (--level == 0) {
1467 pc->tend = pc->p - 1;
1468 pc->p++;
1469 pc->len--;
1470 return;
1472 break;
1474 case '"':
1475 if (startofword) {
1476 JimParseSubQuote(pc);
1477 continue;
1479 break;
1481 case '{':
1482 JimParseSubBrace(pc);
1483 startofword = 0;
1484 continue;
1486 case '\n':
1487 pc->linenr++;
1488 break;
1490 startofword = isspace(UCHAR(*pc->p));
1491 pc->p++;
1492 pc->len--;
1494 pc->missing.ch = '[';
1495 pc->missing.line = line;
1496 pc->tend = pc->p - 1;
1499 static int JimParseBrace(struct JimParserCtx *pc)
1501 pc->tstart = pc->p + 1;
1502 pc->tline = pc->linenr;
1503 pc->tt = JIM_TT_STR;
1504 JimParseSubBrace(pc);
1505 return JIM_OK;
1508 static int JimParseCmd(struct JimParserCtx *pc)
1510 pc->tstart = pc->p + 1;
1511 pc->tline = pc->linenr;
1512 pc->tt = JIM_TT_CMD;
1513 JimParseSubCmd(pc);
1514 return JIM_OK;
1517 static int JimParseQuote(struct JimParserCtx *pc)
1519 pc->tstart = pc->p + 1;
1520 pc->tline = pc->linenr;
1521 pc->tt = JimParseSubQuote(pc);
1522 return JIM_OK;
1525 static int JimParseVar(struct JimParserCtx *pc)
1527 /* skip the $ */
1528 pc->p++;
1529 pc->len--;
1531 #ifdef EXPRSUGAR_BRACKET
1532 if (*pc->p == '[') {
1533 /* Parse $[...] expr shorthand syntax */
1534 JimParseCmd(pc);
1535 pc->tt = JIM_TT_EXPRSUGAR;
1536 return JIM_OK;
1538 #endif
1540 pc->tstart = pc->p;
1541 pc->tt = JIM_TT_VAR;
1542 pc->tline = pc->linenr;
1544 if (*pc->p == '{') {
1545 pc->tstart = ++pc->p;
1546 pc->len--;
1548 while (pc->len && *pc->p != '}') {
1549 if (*pc->p == '\n') {
1550 pc->linenr++;
1552 pc->p++;
1553 pc->len--;
1555 pc->tend = pc->p - 1;
1556 if (pc->len) {
1557 pc->p++;
1558 pc->len--;
1561 else {
1562 while (1) {
1563 /* Skip double colon, but not single colon! */
1564 if (pc->p[0] == ':' && pc->p[1] == ':') {
1565 while (*pc->p == ':') {
1566 pc->p++;
1567 pc->len--;
1569 continue;
1571 /* Note that any char >= 0x80 must be part of a utf-8 char.
1572 * We consider all unicode points outside of ASCII as letters
1574 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1575 pc->p++;
1576 pc->len--;
1577 continue;
1579 break;
1581 /* Parse [dict get] syntax sugar. */
1582 if (*pc->p == '(') {
1583 int count = 1;
1584 const char *paren = NULL;
1586 pc->tt = JIM_TT_DICTSUGAR;
1588 while (count && pc->len) {
1589 pc->p++;
1590 pc->len--;
1591 if (*pc->p == '\\' && pc->len >= 1) {
1592 pc->p++;
1593 pc->len--;
1595 else if (*pc->p == '(') {
1596 count++;
1598 else if (*pc->p == ')') {
1599 paren = pc->p;
1600 count--;
1603 if (count == 0) {
1604 pc->p++;
1605 pc->len--;
1607 else if (paren) {
1608 /* Did not find a matching paren. Back up */
1609 paren++;
1610 pc->len += (pc->p - paren);
1611 pc->p = paren;
1613 #ifndef EXPRSUGAR_BRACKET
1614 if (*pc->tstart == '(') {
1615 pc->tt = JIM_TT_EXPRSUGAR;
1617 #endif
1619 pc->tend = pc->p - 1;
1621 /* Check if we parsed just the '$' character.
1622 * That's not a variable so an error is returned
1623 * to tell the state machine to consider this '$' just
1624 * a string. */
1625 if (pc->tstart == pc->p) {
1626 pc->p--;
1627 pc->len++;
1628 return JIM_ERR;
1630 return JIM_OK;
1633 static int JimParseStr(struct JimParserCtx *pc)
1635 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1636 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1637 /* Starting a new word */
1638 if (*pc->p == '{') {
1639 return JimParseBrace(pc);
1641 if (*pc->p == '"') {
1642 pc->inquote = 1;
1643 pc->p++;
1644 pc->len--;
1645 /* In case the end quote is missing */
1646 pc->missing.line = pc->tline;
1649 pc->tstart = pc->p;
1650 pc->tline = pc->linenr;
1651 while (1) {
1652 if (pc->len == 0) {
1653 if (pc->inquote) {
1654 pc->missing.ch = '"';
1656 pc->tend = pc->p - 1;
1657 pc->tt = JIM_TT_ESC;
1658 return JIM_OK;
1660 switch (*pc->p) {
1661 case '\\':
1662 if (!pc->inquote && *(pc->p + 1) == '\n') {
1663 pc->tend = pc->p - 1;
1664 pc->tt = JIM_TT_ESC;
1665 return JIM_OK;
1667 if (pc->len >= 2) {
1668 if (*(pc->p + 1) == '\n') {
1669 pc->linenr++;
1671 pc->p++;
1672 pc->len--;
1674 else if (pc->len == 1) {
1675 /* End of script with trailing backslash */
1676 pc->missing.ch = '\\';
1678 break;
1679 case '(':
1680 /* If the following token is not '$' just keep going */
1681 if (pc->len > 1 && pc->p[1] != '$') {
1682 break;
1684 /* fall through */
1685 case ')':
1686 /* Only need a separate ')' token if the previous was a var */
1687 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1688 if (pc->p == pc->tstart) {
1689 /* At the start of the token, so just return this char */
1690 pc->p++;
1691 pc->len--;
1693 pc->tend = pc->p - 1;
1694 pc->tt = JIM_TT_ESC;
1695 return JIM_OK;
1697 break;
1699 case '$':
1700 case '[':
1701 pc->tend = pc->p - 1;
1702 pc->tt = JIM_TT_ESC;
1703 return JIM_OK;
1704 case ' ':
1705 case '\t':
1706 case '\n':
1707 case '\r':
1708 case '\f':
1709 case ';':
1710 if (!pc->inquote) {
1711 pc->tend = pc->p - 1;
1712 pc->tt = JIM_TT_ESC;
1713 return JIM_OK;
1715 else if (*pc->p == '\n') {
1716 pc->linenr++;
1718 break;
1719 case '"':
1720 if (pc->inquote) {
1721 pc->tend = pc->p - 1;
1722 pc->tt = JIM_TT_ESC;
1723 pc->p++;
1724 pc->len--;
1725 pc->inquote = 0;
1726 return JIM_OK;
1728 break;
1730 pc->p++;
1731 pc->len--;
1733 return JIM_OK; /* unreached */
1736 static int JimParseComment(struct JimParserCtx *pc)
1738 while (*pc->p) {
1739 if (*pc->p == '\\') {
1740 pc->p++;
1741 pc->len--;
1742 if (pc->len == 0) {
1743 pc->missing.ch = '\\';
1744 return JIM_OK;
1746 if (*pc->p == '\n') {
1747 pc->linenr++;
1750 else if (*pc->p == '\n') {
1751 pc->p++;
1752 pc->len--;
1753 pc->linenr++;
1754 break;
1756 pc->p++;
1757 pc->len--;
1759 return JIM_OK;
1762 /* xdigitval and odigitval are helper functions for JimEscape() */
1763 static int xdigitval(int c)
1765 if (c >= '0' && c <= '9')
1766 return c - '0';
1767 if (c >= 'a' && c <= 'f')
1768 return c - 'a' + 10;
1769 if (c >= 'A' && c <= 'F')
1770 return c - 'A' + 10;
1771 return -1;
1774 static int odigitval(int c)
1776 if (c >= '0' && c <= '7')
1777 return c - '0';
1778 return -1;
1781 /* Perform Tcl escape substitution of 's', storing the result
1782 * string into 'dest'. The escaped string is guaranteed to
1783 * be the same length or shorted than the source string.
1784 * Slen is the length of the string at 's'.
1786 * The function returns the length of the resulting string. */
1787 static int JimEscape(char *dest, const char *s, int slen)
1789 char *p = dest;
1790 int i, len;
1792 for (i = 0; i < slen; i++) {
1793 switch (s[i]) {
1794 case '\\':
1795 switch (s[i + 1]) {
1796 case 'a':
1797 *p++ = 0x7;
1798 i++;
1799 break;
1800 case 'b':
1801 *p++ = 0x8;
1802 i++;
1803 break;
1804 case 'f':
1805 *p++ = 0xc;
1806 i++;
1807 break;
1808 case 'n':
1809 *p++ = 0xa;
1810 i++;
1811 break;
1812 case 'r':
1813 *p++ = 0xd;
1814 i++;
1815 break;
1816 case 't':
1817 *p++ = 0x9;
1818 i++;
1819 break;
1820 case 'u':
1821 case 'U':
1822 case 'x':
1823 /* A unicode or hex sequence.
1824 * \x Expect 1-2 hex chars and convert to hex.
1825 * \u Expect 1-4 hex chars and convert to utf-8.
1826 * \U Expect 1-8 hex chars and convert to utf-8.
1827 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1828 * An invalid sequence means simply the escaped char.
1831 unsigned val = 0;
1832 int k;
1833 int maxchars = 2;
1835 i++;
1837 if (s[i] == 'U') {
1838 maxchars = 8;
1840 else if (s[i] == 'u') {
1841 if (s[i + 1] == '{') {
1842 maxchars = 6;
1843 i++;
1845 else {
1846 maxchars = 4;
1850 for (k = 0; k < maxchars; k++) {
1851 int c = xdigitval(s[i + k + 1]);
1852 if (c == -1) {
1853 break;
1855 val = (val << 4) | c;
1857 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1858 if (s[i] == '{') {
1859 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1860 /* Back up */
1861 i--;
1862 k = 0;
1864 else {
1865 /* Skip the closing brace */
1866 k++;
1869 if (k) {
1870 /* Got a valid sequence, so convert */
1871 if (s[i] == 'x') {
1872 *p++ = val;
1874 else {
1875 p += utf8_fromunicode(p, val);
1877 i += k;
1878 break;
1880 /* Not a valid codepoint, just an escaped char */
1881 *p++ = s[i];
1883 break;
1884 case 'v':
1885 *p++ = 0xb;
1886 i++;
1887 break;
1888 case '\0':
1889 *p++ = '\\';
1890 i++;
1891 break;
1892 case '\n':
1893 /* Replace all spaces and tabs after backslash newline with a single space*/
1894 *p++ = ' ';
1895 do {
1896 i++;
1897 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1898 break;
1899 case '0':
1900 case '1':
1901 case '2':
1902 case '3':
1903 case '4':
1904 case '5':
1905 case '6':
1906 case '7':
1907 /* octal escape */
1909 int val = 0;
1910 int c = odigitval(s[i + 1]);
1912 val = c;
1913 c = odigitval(s[i + 2]);
1914 if (c == -1) {
1915 *p++ = val;
1916 i++;
1917 break;
1919 val = (val * 8) + c;
1920 c = odigitval(s[i + 3]);
1921 if (c == -1) {
1922 *p++ = val;
1923 i += 2;
1924 break;
1926 val = (val * 8) + c;
1927 *p++ = val;
1928 i += 3;
1930 break;
1931 default:
1932 *p++ = s[i + 1];
1933 i++;
1934 break;
1936 break;
1937 default:
1938 *p++ = s[i];
1939 break;
1942 len = p - dest;
1943 *p = '\0';
1944 return len;
1947 /* Returns a dynamically allocated copy of the current token in the
1948 * parser context. The function performs conversion of escapes if
1949 * the token is of type JIM_TT_ESC.
1951 * Note that after the conversion, tokens that are grouped with
1952 * braces in the source code, are always recognizable from the
1953 * identical string obtained in a different way from the type.
1955 * For example the string:
1957 * {*}$a
1959 * will return as first token "*", of type JIM_TT_STR
1961 * While the string:
1963 * *$a
1965 * will return as first token "*", of type JIM_TT_ESC
1967 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1969 const char *start, *end;
1970 char *token;
1971 int len;
1973 start = pc->tstart;
1974 end = pc->tend;
1975 if (start > end) {
1976 len = 0;
1977 token = Jim_Alloc(1);
1978 token[0] = '\0';
1980 else {
1981 len = (end - start) + 1;
1982 token = Jim_Alloc(len + 1);
1983 if (pc->tt != JIM_TT_ESC) {
1984 /* No escape conversion needed? Just copy it. */
1985 memcpy(token, start, len);
1986 token[len] = '\0';
1988 else {
1989 /* Else convert the escape chars. */
1990 len = JimEscape(token, start, len);
1994 return Jim_NewStringObjNoAlloc(interp, token, len);
1997 /* -----------------------------------------------------------------------------
1998 * Tcl Lists parsing
1999 * ---------------------------------------------------------------------------*/
2000 static int JimParseListSep(struct JimParserCtx *pc);
2001 static int JimParseListStr(struct JimParserCtx *pc);
2002 static int JimParseListQuote(struct JimParserCtx *pc);
2004 static int JimParseList(struct JimParserCtx *pc)
2006 if (isspace(UCHAR(*pc->p))) {
2007 return JimParseListSep(pc);
2009 switch (*pc->p) {
2010 case '"':
2011 return JimParseListQuote(pc);
2013 case '{':
2014 return JimParseBrace(pc);
2016 default:
2017 if (pc->len) {
2018 return JimParseListStr(pc);
2020 break;
2023 pc->tstart = pc->tend = pc->p;
2024 pc->tline = pc->linenr;
2025 pc->tt = JIM_TT_EOL;
2026 pc->eof = 1;
2027 return JIM_OK;
2030 static int JimParseListSep(struct JimParserCtx *pc)
2032 pc->tstart = pc->p;
2033 pc->tline = pc->linenr;
2034 while (isspace(UCHAR(*pc->p))) {
2035 if (*pc->p == '\n') {
2036 pc->linenr++;
2038 pc->p++;
2039 pc->len--;
2041 pc->tend = pc->p - 1;
2042 pc->tt = JIM_TT_SEP;
2043 return JIM_OK;
2046 static int JimParseListQuote(struct JimParserCtx *pc)
2048 pc->p++;
2049 pc->len--;
2051 pc->tstart = pc->p;
2052 pc->tline = pc->linenr;
2053 pc->tt = JIM_TT_STR;
2055 while (pc->len) {
2056 switch (*pc->p) {
2057 case '\\':
2058 pc->tt = JIM_TT_ESC;
2059 if (--pc->len == 0) {
2060 /* Trailing backslash */
2061 pc->tend = pc->p;
2062 return JIM_OK;
2064 pc->p++;
2065 break;
2066 case '\n':
2067 pc->linenr++;
2068 break;
2069 case '"':
2070 pc->tend = pc->p - 1;
2071 pc->p++;
2072 pc->len--;
2073 return JIM_OK;
2075 pc->p++;
2076 pc->len--;
2079 pc->tend = pc->p - 1;
2080 return JIM_OK;
2083 static int JimParseListStr(struct JimParserCtx *pc)
2085 pc->tstart = pc->p;
2086 pc->tline = pc->linenr;
2087 pc->tt = JIM_TT_STR;
2089 while (pc->len) {
2090 if (isspace(UCHAR(*pc->p))) {
2091 pc->tend = pc->p - 1;
2092 return JIM_OK;
2094 if (*pc->p == '\\') {
2095 if (--pc->len == 0) {
2096 /* Trailing backslash */
2097 pc->tend = pc->p;
2098 return JIM_OK;
2100 pc->tt = JIM_TT_ESC;
2101 pc->p++;
2103 pc->p++;
2104 pc->len--;
2106 pc->tend = pc->p - 1;
2107 return JIM_OK;
2110 /* -----------------------------------------------------------------------------
2111 * Jim_Obj related functions
2112 * ---------------------------------------------------------------------------*/
2114 /* Return a new initialized object. */
2115 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2117 Jim_Obj *objPtr;
2119 /* -- Check if there are objects in the free list -- */
2120 if (interp->freeList != NULL) {
2121 /* -- Unlink the object from the free list -- */
2122 objPtr = interp->freeList;
2123 interp->freeList = objPtr->nextObjPtr;
2125 else {
2126 /* -- No ready to use objects: allocate a new one -- */
2127 objPtr = Jim_Alloc(sizeof(*objPtr));
2130 /* Object is returned with refCount of 0. Every
2131 * kind of GC implemented should take care to don't try
2132 * to scan objects with refCount == 0. */
2133 objPtr->refCount = 0;
2134 /* All the other fields are left not initialized to save time.
2135 * The caller will probably want to set them to the right
2136 * value anyway. */
2138 /* -- Put the object into the live list -- */
2139 objPtr->prevObjPtr = NULL;
2140 objPtr->nextObjPtr = interp->liveList;
2141 if (interp->liveList)
2142 interp->liveList->prevObjPtr = objPtr;
2143 interp->liveList = objPtr;
2145 return objPtr;
2148 /* Free an object. Actually objects are never freed, but
2149 * just moved to the free objects list, where they will be
2150 * reused by Jim_NewObj(). */
2151 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2153 /* Check if the object was already freed, panic. */
2154 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2155 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2157 /* Free the internal representation */
2158 Jim_FreeIntRep(interp, objPtr);
2159 /* Free the string representation */
2160 if (objPtr->bytes != NULL) {
2161 if (objPtr->bytes != JimEmptyStringRep)
2162 Jim_Free(objPtr->bytes);
2164 /* Unlink the object from the live objects list */
2165 if (objPtr->prevObjPtr)
2166 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2167 if (objPtr->nextObjPtr)
2168 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2169 if (interp->liveList == objPtr)
2170 interp->liveList = objPtr->nextObjPtr;
2171 #ifdef JIM_DISABLE_OBJECT_POOL
2172 Jim_Free(objPtr);
2173 #else
2174 /* Link the object into the free objects list */
2175 objPtr->prevObjPtr = NULL;
2176 objPtr->nextObjPtr = interp->freeList;
2177 if (interp->freeList)
2178 interp->freeList->prevObjPtr = objPtr;
2179 interp->freeList = objPtr;
2180 objPtr->refCount = -1;
2181 #endif
2184 /* Invalidate the string representation of an object. */
2185 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2187 if (objPtr->bytes != NULL) {
2188 if (objPtr->bytes != JimEmptyStringRep)
2189 Jim_Free(objPtr->bytes);
2191 objPtr->bytes = NULL;
2194 /* Duplicate an object. The returned object has refcount = 0. */
2195 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2197 Jim_Obj *dupPtr;
2199 dupPtr = Jim_NewObj(interp);
2200 if (objPtr->bytes == NULL) {
2201 /* Object does not have a valid string representation. */
2202 dupPtr->bytes = NULL;
2204 else if (objPtr->length == 0) {
2205 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2206 dupPtr->bytes = JimEmptyStringRep;
2207 dupPtr->length = 0;
2208 dupPtr->typePtr = NULL;
2209 return dupPtr;
2211 else {
2212 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2213 dupPtr->length = objPtr->length;
2214 /* Copy the null byte too */
2215 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2218 /* By default, the new object has the same type as the old object */
2219 dupPtr->typePtr = objPtr->typePtr;
2220 if (objPtr->typePtr != NULL) {
2221 if (objPtr->typePtr->dupIntRepProc == NULL) {
2222 dupPtr->internalRep = objPtr->internalRep;
2224 else {
2225 /* The dup proc may set a different type, e.g. NULL */
2226 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2229 return dupPtr;
2232 /* Return the string representation for objPtr. If the object's
2233 * string representation is invalid, calls the updateStringProc method to create
2234 * a new one from the internal representation of the object.
2236 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2238 if (objPtr->bytes == NULL) {
2239 /* Invalid string repr. Generate it. */
2240 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2241 objPtr->typePtr->updateStringProc(objPtr);
2243 if (lenPtr)
2244 *lenPtr = objPtr->length;
2245 return objPtr->bytes;
2248 /* Just returns the length of the object's string rep */
2249 int Jim_Length(Jim_Obj *objPtr)
2251 if (objPtr->bytes == NULL) {
2252 /* Invalid string repr. Generate it. */
2253 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2254 objPtr->typePtr->updateStringProc(objPtr);
2256 return objPtr->length;
2259 /* Just returns object's string rep */
2260 const char *Jim_String(Jim_Obj *objPtr)
2262 if (objPtr->bytes == NULL) {
2263 /* Invalid string repr. Generate it. */
2264 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2265 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2266 objPtr->typePtr->updateStringProc(objPtr);
2268 return objPtr->bytes;
2271 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2273 objPtr->bytes = Jim_StrDup(str);
2274 objPtr->length = strlen(str);
2277 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2278 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2280 static const Jim_ObjType dictSubstObjType = {
2281 "dict-substitution",
2282 FreeDictSubstInternalRep,
2283 DupDictSubstInternalRep,
2284 NULL,
2285 JIM_TYPE_NONE,
2288 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2290 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2293 static const Jim_ObjType interpolatedObjType = {
2294 "interpolated",
2295 FreeInterpolatedInternalRep,
2296 NULL,
2297 NULL,
2298 JIM_TYPE_NONE,
2301 /* -----------------------------------------------------------------------------
2302 * String Object
2303 * ---------------------------------------------------------------------------*/
2304 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2305 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2307 static const Jim_ObjType stringObjType = {
2308 "string",
2309 NULL,
2310 DupStringInternalRep,
2311 NULL,
2312 JIM_TYPE_REFERENCES,
2315 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2317 JIM_NOTUSED(interp);
2319 /* This is a bit subtle: the only caller of this function
2320 * should be Jim_DuplicateObj(), that will copy the
2321 * string representaion. After the copy, the duplicated
2322 * object will not have more room in the buffer than
2323 * srcPtr->length bytes. So we just set it to length. */
2324 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2325 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2328 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2330 if (objPtr->typePtr != &stringObjType) {
2331 /* Get a fresh string representation. */
2332 if (objPtr->bytes == NULL) {
2333 /* Invalid string repr. Generate it. */
2334 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2335 objPtr->typePtr->updateStringProc(objPtr);
2337 /* Free any other internal representation. */
2338 Jim_FreeIntRep(interp, objPtr);
2339 /* Set it as string, i.e. just set the maxLength field. */
2340 objPtr->typePtr = &stringObjType;
2341 objPtr->internalRep.strValue.maxLength = objPtr->length;
2342 /* Don't know the utf-8 length yet */
2343 objPtr->internalRep.strValue.charLength = -1;
2345 return JIM_OK;
2349 * Returns the length of the object string in chars, not bytes.
2351 * These may be different for a utf-8 string.
2353 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2355 #ifdef JIM_UTF8
2356 SetStringFromAny(interp, objPtr);
2358 if (objPtr->internalRep.strValue.charLength < 0) {
2359 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2361 return objPtr->internalRep.strValue.charLength;
2362 #else
2363 return Jim_Length(objPtr);
2364 #endif
2367 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2368 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2370 Jim_Obj *objPtr = Jim_NewObj(interp);
2372 /* Need to find out how many bytes the string requires */
2373 if (len == -1)
2374 len = strlen(s);
2375 /* Alloc/Set the string rep. */
2376 if (len == 0) {
2377 objPtr->bytes = JimEmptyStringRep;
2379 else {
2380 objPtr->bytes = Jim_Alloc(len + 1);
2381 memcpy(objPtr->bytes, s, len);
2382 objPtr->bytes[len] = '\0';
2384 objPtr->length = len;
2386 /* No typePtr field for the vanilla string object. */
2387 objPtr->typePtr = NULL;
2388 return objPtr;
2391 /* charlen is in characters -- see also Jim_NewStringObj() */
2392 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2394 #ifdef JIM_UTF8
2395 /* Need to find out how many bytes the string requires */
2396 int bytelen = utf8_index(s, charlen);
2398 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2400 /* Remember the utf8 length, so set the type */
2401 objPtr->typePtr = &stringObjType;
2402 objPtr->internalRep.strValue.maxLength = bytelen;
2403 objPtr->internalRep.strValue.charLength = charlen;
2405 return objPtr;
2406 #else
2407 return Jim_NewStringObj(interp, s, charlen);
2408 #endif
2411 /* This version does not try to duplicate the 's' pointer, but
2412 * use it directly. */
2413 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2415 Jim_Obj *objPtr = Jim_NewObj(interp);
2417 objPtr->bytes = s;
2418 objPtr->length = (len == -1) ? strlen(s) : len;
2419 objPtr->typePtr = NULL;
2420 return objPtr;
2423 /* Low-level string append. Use it only against unshared objects
2424 * of type "string". */
2425 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2427 int needlen;
2429 if (len == -1)
2430 len = strlen(str);
2431 needlen = objPtr->length + len;
2432 if (objPtr->internalRep.strValue.maxLength < needlen ||
2433 objPtr->internalRep.strValue.maxLength == 0) {
2434 needlen *= 2;
2435 /* Inefficient to malloc() for less than 8 bytes */
2436 if (needlen < 7) {
2437 needlen = 7;
2439 if (objPtr->bytes == JimEmptyStringRep) {
2440 objPtr->bytes = Jim_Alloc(needlen + 1);
2442 else {
2443 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2445 objPtr->internalRep.strValue.maxLength = needlen;
2447 memcpy(objPtr->bytes + objPtr->length, str, len);
2448 objPtr->bytes[objPtr->length + len] = '\0';
2450 if (objPtr->internalRep.strValue.charLength >= 0) {
2451 /* Update the utf-8 char length */
2452 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2454 objPtr->length += len;
2457 /* Higher level API to append strings to objects.
2458 * Object must not be unshared for each of these.
2460 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2462 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2463 SetStringFromAny(interp, objPtr);
2464 StringAppendString(objPtr, str, len);
2467 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2469 int len;
2470 const char *str = Jim_GetString(appendObjPtr, &len);
2471 Jim_AppendString(interp, objPtr, str, len);
2474 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2476 va_list ap;
2478 SetStringFromAny(interp, objPtr);
2479 va_start(ap, objPtr);
2480 while (1) {
2481 const char *s = va_arg(ap, const char *);
2483 if (s == NULL)
2484 break;
2485 Jim_AppendString(interp, objPtr, s, -1);
2487 va_end(ap);
2490 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2492 if (aObjPtr == bObjPtr) {
2493 return 1;
2495 else {
2496 int Alen, Blen;
2497 const char *sA = Jim_GetString(aObjPtr, &Alen);
2498 const char *sB = Jim_GetString(bObjPtr, &Blen);
2500 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2505 * Note. Does not support embedded nulls in either the pattern or the object.
2507 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2509 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2513 * Note: does not support embedded nulls for the nocase option.
2515 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2517 int l1, l2;
2518 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2519 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2521 if (nocase) {
2522 /* Do a character compare for nocase */
2523 return JimStringCompareLen(s1, s2, -1, nocase);
2525 return JimStringCompare(s1, l1, s2, l2);
2529 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2531 * Note: does not support embedded nulls
2533 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2535 const char *s1 = Jim_String(firstObjPtr);
2536 const char *s2 = Jim_String(secondObjPtr);
2538 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2541 /* Convert a range, as returned by Jim_GetRange(), into
2542 * an absolute index into an object of the specified length.
2543 * This function may return negative values, or values
2544 * greater than or equal to the length of the list if the index
2545 * is out of range. */
2546 static int JimRelToAbsIndex(int len, int idx)
2548 if (idx < 0)
2549 return len + idx;
2550 return idx;
2553 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2554 * into a form suitable for implementation of commands like [string range] and [lrange].
2556 * The resulting range is guaranteed to address valid elements of
2557 * the structure.
2559 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2561 int rangeLen;
2563 if (*firstPtr > *lastPtr) {
2564 rangeLen = 0;
2566 else {
2567 rangeLen = *lastPtr - *firstPtr + 1;
2568 if (rangeLen) {
2569 if (*firstPtr < 0) {
2570 rangeLen += *firstPtr;
2571 *firstPtr = 0;
2573 if (*lastPtr >= len) {
2574 rangeLen -= (*lastPtr - (len - 1));
2575 *lastPtr = len - 1;
2579 if (rangeLen < 0)
2580 rangeLen = 0;
2582 *rangeLenPtr = rangeLen;
2585 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2586 int len, int *first, int *last, int *range)
2588 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2589 return JIM_ERR;
2591 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2592 return JIM_ERR;
2594 *first = JimRelToAbsIndex(len, *first);
2595 *last = JimRelToAbsIndex(len, *last);
2596 JimRelToAbsRange(len, first, last, range);
2597 return JIM_OK;
2600 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2601 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2603 int first, last;
2604 const char *str;
2605 int rangeLen;
2606 int bytelen;
2608 str = Jim_GetString(strObjPtr, &bytelen);
2610 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2611 return NULL;
2614 if (first == 0 && rangeLen == bytelen) {
2615 return strObjPtr;
2617 return Jim_NewStringObj(interp, str + first, rangeLen);
2620 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2621 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2623 #ifdef JIM_UTF8
2624 int first, last;
2625 const char *str;
2626 int len, rangeLen;
2627 int bytelen;
2629 str = Jim_GetString(strObjPtr, &bytelen);
2630 len = Jim_Utf8Length(interp, strObjPtr);
2632 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2633 return NULL;
2636 if (first == 0 && rangeLen == len) {
2637 return strObjPtr;
2639 if (len == bytelen) {
2640 /* ASCII optimisation */
2641 return Jim_NewStringObj(interp, str + first, rangeLen);
2643 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2644 #else
2645 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2646 #endif
2649 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2650 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2652 int first, last;
2653 const char *str;
2654 int len, rangeLen;
2655 Jim_Obj *objPtr;
2657 len = Jim_Utf8Length(interp, strObjPtr);
2659 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2660 return NULL;
2663 if (last < first) {
2664 return strObjPtr;
2667 str = Jim_String(strObjPtr);
2669 /* Before part */
2670 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2672 /* Replacement */
2673 if (newStrObj) {
2674 Jim_AppendObj(interp, objPtr, newStrObj);
2677 /* After part */
2678 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2680 return objPtr;
2684 * Note: does not support embedded nulls.
2686 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2688 while (*str) {
2689 int c;
2690 str += utf8_tounicode(str, &c);
2691 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2693 *dest = 0;
2697 * Note: does not support embedded nulls.
2699 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2701 char *buf;
2702 int len;
2703 const char *str;
2705 SetStringFromAny(interp, strObjPtr);
2707 str = Jim_GetString(strObjPtr, &len);
2709 #ifdef JIM_UTF8
2710 /* Case mapping can change the utf-8 length of the string.
2711 * But at worst it will be by one extra byte per char
2713 len *= 2;
2714 #endif
2715 buf = Jim_Alloc(len + 1);
2716 JimStrCopyUpperLower(buf, str, 0);
2717 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2721 * Note: does not support embedded nulls.
2723 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2725 char *buf;
2726 const char *str;
2727 int len;
2729 if (strObjPtr->typePtr != &stringObjType) {
2730 SetStringFromAny(interp, strObjPtr);
2733 str = Jim_GetString(strObjPtr, &len);
2735 #ifdef JIM_UTF8
2736 /* Case mapping can change the utf-8 length of the string.
2737 * But at worst it will be by one extra byte per char
2739 len *= 2;
2740 #endif
2741 buf = Jim_Alloc(len + 1);
2742 JimStrCopyUpperLower(buf, str, 1);
2743 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2747 * Note: does not support embedded nulls.
2749 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2751 char *buf, *p;
2752 int len;
2753 int c;
2754 const char *str;
2756 str = Jim_GetString(strObjPtr, &len);
2757 if (len == 0) {
2758 return strObjPtr;
2760 #ifdef JIM_UTF8
2761 /* Case mapping can change the utf-8 length of the string.
2762 * But at worst it will be by one extra byte per char
2764 len *= 2;
2765 #endif
2766 buf = p = Jim_Alloc(len + 1);
2768 str += utf8_tounicode(str, &c);
2769 p += utf8_getchars(p, utf8_title(c));
2771 JimStrCopyUpperLower(p, str, 0);
2773 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2776 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2777 * for unicode character 'c'.
2778 * Returns the position if found or NULL if not
2780 static const char *utf8_memchr(const char *str, int len, int c)
2782 #ifdef JIM_UTF8
2783 while (len) {
2784 int sc;
2785 int n = utf8_tounicode(str, &sc);
2786 if (sc == c) {
2787 return str;
2789 str += n;
2790 len -= n;
2792 return NULL;
2793 #else
2794 return memchr(str, c, len);
2795 #endif
2799 * Searches for the first non-trim char in string (str, len)
2801 * If none is found, returns just past the last char.
2803 * Lengths are in bytes.
2805 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2807 while (len) {
2808 int c;
2809 int n = utf8_tounicode(str, &c);
2811 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2812 /* Not a trim char, so stop */
2813 break;
2815 str += n;
2816 len -= n;
2818 return str;
2822 * Searches backwards for a non-trim char in string (str, len).
2824 * Returns a pointer to just after the non-trim char, or NULL if not found.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2830 str += len;
2832 while (len) {
2833 int c;
2834 int n = utf8_prev_len(str, len);
2836 len -= n;
2837 str -= n;
2839 n = utf8_tounicode(str, &c);
2841 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2842 return str + n;
2846 return NULL;
2849 static const char default_trim_chars[] = " \t\n\r";
2850 /* sizeof() here includes the null byte */
2851 static int default_trim_chars_len = sizeof(default_trim_chars);
2853 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2855 int len;
2856 const char *str = Jim_GetString(strObjPtr, &len);
2857 const char *trimchars = default_trim_chars;
2858 int trimcharslen = default_trim_chars_len;
2859 const char *newstr;
2861 if (trimcharsObjPtr) {
2862 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2865 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2866 if (newstr == str) {
2867 return strObjPtr;
2870 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2873 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2875 int len;
2876 const char *trimchars = default_trim_chars;
2877 int trimcharslen = default_trim_chars_len;
2878 const char *nontrim;
2880 if (trimcharsObjPtr) {
2881 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2884 SetStringFromAny(interp, strObjPtr);
2886 len = Jim_Length(strObjPtr);
2887 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2889 if (nontrim == NULL) {
2890 /* All trim, so return a zero-length string */
2891 return Jim_NewEmptyStringObj(interp);
2893 if (nontrim == strObjPtr->bytes + len) {
2894 /* All non-trim, so return the original object */
2895 return strObjPtr;
2898 if (Jim_IsShared(strObjPtr)) {
2899 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2901 else {
2902 /* Can modify this string in place */
2903 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2904 strObjPtr->length = (nontrim - strObjPtr->bytes);
2907 return strObjPtr;
2910 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2912 /* First trim left. */
2913 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2915 /* Now trim right */
2916 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2918 /* Note: refCount check is needed since objPtr may be emptyObj */
2919 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2920 /* We don't want this object to be leaked */
2921 Jim_FreeNewObj(interp, objPtr);
2924 return strObjPtr;
2927 /* Some platforms don't have isascii - need a non-macro version */
2928 #ifdef HAVE_ISASCII
2929 #define jim_isascii isascii
2930 #else
2931 static int jim_isascii(int c)
2933 return !(c & ~0x7f);
2935 #endif
2937 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2939 static const char * const strclassnames[] = {
2940 "integer", "alpha", "alnum", "ascii", "digit",
2941 "double", "lower", "upper", "space", "xdigit",
2942 "control", "print", "graph", "punct", "boolean",
2943 NULL
2945 enum {
2946 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2947 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2948 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2950 int strclass;
2951 int len;
2952 int i;
2953 const char *str;
2954 int (*isclassfunc)(int c) = NULL;
2956 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2957 return JIM_ERR;
2960 str = Jim_GetString(strObjPtr, &len);
2961 if (len == 0) {
2962 Jim_SetResultBool(interp, !strict);
2963 return JIM_OK;
2966 switch (strclass) {
2967 case STR_IS_INTEGER:
2969 jim_wide w;
2970 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2971 return JIM_OK;
2974 case STR_IS_DOUBLE:
2976 double d;
2977 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2978 return JIM_OK;
2981 case STR_IS_BOOLEAN:
2983 int b;
2984 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
2985 return JIM_OK;
2988 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2989 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2990 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
2991 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2992 case STR_IS_LOWER: isclassfunc = islower; break;
2993 case STR_IS_UPPER: isclassfunc = isupper; break;
2994 case STR_IS_SPACE: isclassfunc = isspace; break;
2995 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2996 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2997 case STR_IS_PRINT: isclassfunc = isprint; break;
2998 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2999 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3000 default:
3001 return JIM_ERR;
3004 for (i = 0; i < len; i++) {
3005 if (!isclassfunc(str[i])) {
3006 Jim_SetResultBool(interp, 0);
3007 return JIM_OK;
3010 Jim_SetResultBool(interp, 1);
3011 return JIM_OK;
3014 /* -----------------------------------------------------------------------------
3015 * Compared String Object
3016 * ---------------------------------------------------------------------------*/
3018 /* This is strange object that allows comparison of a C literal string
3019 * with a Jim object in a very short time if the same comparison is done
3020 * multiple times. For example every time the [if] command is executed,
3021 * Jim has to check if a given argument is "else".
3022 * If the code has no errors, this comparison is true most of the time,
3023 * so we can cache the pointer of the string of the last matching
3024 * comparison inside the object. Because most C compilers perform literal sharing,
3025 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3026 * this works pretty well even if comparisons are at different places
3027 * inside the C code. */
3029 static const Jim_ObjType comparedStringObjType = {
3030 "compared-string",
3031 NULL,
3032 NULL,
3033 NULL,
3034 JIM_TYPE_REFERENCES,
3037 /* The only way this object is exposed to the API is via the following
3038 * function. Returns true if the string and the object string repr.
3039 * are the same, otherwise zero is returned.
3041 * Note: this isn't binary safe, but it hardly needs to be.*/
3042 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3044 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3045 return 1;
3047 else {
3048 const char *objStr = Jim_String(objPtr);
3050 if (strcmp(str, objStr) != 0)
3051 return 0;
3053 if (objPtr->typePtr != &comparedStringObjType) {
3054 Jim_FreeIntRep(interp, objPtr);
3055 objPtr->typePtr = &comparedStringObjType;
3057 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3058 return 1;
3062 static int qsortCompareStringPointers(const void *a, const void *b)
3064 char *const *sa = (char *const *)a;
3065 char *const *sb = (char *const *)b;
3067 return strcmp(*sa, *sb);
3071 /* -----------------------------------------------------------------------------
3072 * Source Object
3074 * This object is just a string from the language point of view, but
3075 * the internal representation contains the filename and line number
3076 * where this token was read. This information is used by
3077 * Jim_EvalObj() if the object passed happens to be of type "source".
3079 * This allows propagation of the information about line numbers and file
3080 * names and gives error messages with absolute line numbers.
3082 * Note that this object uses the internal representation of the Jim_Object,
3083 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3085 * Also the object will be converted to something else if the given
3086 * token it represents in the source file is not something to be
3087 * evaluated (not a script), and will be specialized in some other way,
3088 * so the time overhead is also almost zero.
3089 * ---------------------------------------------------------------------------*/
3091 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3092 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3094 static const Jim_ObjType sourceObjType = {
3095 "source",
3096 FreeSourceInternalRep,
3097 DupSourceInternalRep,
3098 NULL,
3099 JIM_TYPE_REFERENCES,
3102 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3104 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3107 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3109 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3110 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3113 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3114 Jim_Obj *fileNameObj, int lineNumber)
3116 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3117 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3118 Jim_IncrRefCount(fileNameObj);
3119 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3120 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3121 objPtr->typePtr = &sourceObjType;
3124 /* -----------------------------------------------------------------------------
3125 * ScriptLine Object
3127 * This object is used only in the Script internal represenation.
3128 * For each line of the script, it holds the number of tokens on the line
3129 * and the source line number.
3131 static const Jim_ObjType scriptLineObjType = {
3132 "scriptline",
3133 NULL,
3134 NULL,
3135 NULL,
3136 JIM_NONE,
3139 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3141 Jim_Obj *objPtr;
3143 #ifdef DEBUG_SHOW_SCRIPT
3144 char buf[100];
3145 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3146 objPtr = Jim_NewStringObj(interp, buf, -1);
3147 #else
3148 objPtr = Jim_NewEmptyStringObj(interp);
3149 #endif
3150 objPtr->typePtr = &scriptLineObjType;
3151 objPtr->internalRep.scriptLineValue.argc = argc;
3152 objPtr->internalRep.scriptLineValue.line = line;
3154 return objPtr;
3157 /* -----------------------------------------------------------------------------
3158 * Script Object
3160 * This object holds the parsed internal representation of a script.
3161 * This representation is help within an allocated ScriptObj (see below)
3163 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3164 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3166 static const Jim_ObjType scriptObjType = {
3167 "script",
3168 FreeScriptInternalRep,
3169 DupScriptInternalRep,
3170 NULL,
3171 JIM_TYPE_REFERENCES,
3174 /* Each token of a script is represented by a ScriptToken.
3175 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3176 * can be specialized by commands operating on it.
3178 typedef struct ScriptToken
3180 Jim_Obj *objPtr;
3181 int type;
3182 } ScriptToken;
3184 /* This is the script object internal representation. An array of
3185 * ScriptToken structures, including a pre-computed representation of the
3186 * command length and arguments.
3188 * For example the script:
3190 * puts hello
3191 * set $i $x$y [foo]BAR
3193 * will produce a ScriptObj with the following ScriptToken's:
3195 * LIN 2
3196 * ESC puts
3197 * ESC hello
3198 * LIN 4
3199 * ESC set
3200 * VAR i
3201 * WRD 2
3202 * VAR x
3203 * VAR y
3204 * WRD 2
3205 * CMD foo
3206 * ESC BAR
3208 * "puts hello" has two args (LIN 2), composed of single tokens.
3209 * (Note that the WRD token is omitted for the common case of a single token.)
3211 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3212 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3214 * The precomputation of the command structure makes Jim_Eval() faster,
3215 * and simpler because there aren't dynamic lengths / allocations.
3217 * -- {expand}/{*} handling --
3219 * Expand is handled in a special way.
3221 * If a "word" begins with {*}, the word token count is -ve.
3223 * For example the command:
3225 * list {*}{a b}
3227 * Will produce the following cmdstruct array:
3229 * LIN 2
3230 * ESC list
3231 * WRD -1
3232 * STR a b
3234 * Note that the 'LIN' token also contains the source information for the
3235 * first word of the line for error reporting purposes
3237 * -- the substFlags field of the structure --
3239 * The scriptObj structure is used to represent both "script" objects
3240 * and "subst" objects. In the second case, there are no LIN and WRD
3241 * tokens. Instead SEP and EOL tokens are added as-is.
3242 * In addition, the field 'substFlags' is used to represent the flags used to turn
3243 * the string into the internal representation.
3244 * If these flags do not match what the application requires,
3245 * the scriptObj is created again. For example the script:
3247 * subst -nocommands $string
3248 * subst -novariables $string
3250 * Will (re)create the internal representation of the $string object
3251 * two times.
3253 typedef struct ScriptObj
3255 ScriptToken *token; /* Tokens array. */
3256 Jim_Obj *fileNameObj; /* Filename */
3257 int len; /* Length of token[] */
3258 int substFlags; /* flags used for the compilation of "subst" objects */
3259 int inUse; /* Used to share a ScriptObj. Currently
3260 only used by Jim_EvalObj() as protection against
3261 shimmering of the currently evaluated object. */
3262 int firstline; /* Line number of the first line */
3263 int linenr; /* Error line number, if any */
3264 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3265 } ScriptObj;
3267 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3268 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3269 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3271 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3273 int i;
3274 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3276 if (--script->inUse != 0)
3277 return;
3278 for (i = 0; i < script->len; i++) {
3279 Jim_DecrRefCount(interp, script->token[i].objPtr);
3281 Jim_Free(script->token);
3282 Jim_DecrRefCount(interp, script->fileNameObj);
3283 Jim_Free(script);
3286 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3288 JIM_NOTUSED(interp);
3289 JIM_NOTUSED(srcPtr);
3291 /* Just return a simple string. We don't try to preserve the source info
3292 * since in practice scripts are never duplicated
3294 dupPtr->typePtr = NULL;
3297 /* A simple parse token.
3298 * As the script is parsed, the created tokens point into the script string rep.
3300 typedef struct
3302 const char *token; /* Pointer to the start of the token */
3303 int len; /* Length of this token */
3304 int type; /* Token type */
3305 int line; /* Line number */
3306 } ParseToken;
3308 /* A list of parsed tokens representing a script.
3309 * Tokens are added to this list as the script is parsed.
3310 * It grows as needed.
3312 typedef struct
3314 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3315 ParseToken *list; /* Array of tokens */
3316 int size; /* Current size of the list */
3317 int count; /* Number of entries used */
3318 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3319 } ParseTokenList;
3321 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3323 tokenlist->list = tokenlist->static_list;
3324 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3325 tokenlist->count = 0;
3328 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3330 if (tokenlist->list != tokenlist->static_list) {
3331 Jim_Free(tokenlist->list);
3336 * Adds the new token to the tokenlist.
3337 * The token has the given length, type and line number.
3338 * The token list is resized as necessary.
3340 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3341 int line)
3343 ParseToken *t;
3345 if (tokenlist->count == tokenlist->size) {
3346 /* Resize the list */
3347 tokenlist->size *= 2;
3348 if (tokenlist->list != tokenlist->static_list) {
3349 tokenlist->list =
3350 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3352 else {
3353 /* The list needs to become allocated */
3354 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3355 memcpy(tokenlist->list, tokenlist->static_list,
3356 tokenlist->count * sizeof(*tokenlist->list));
3359 t = &tokenlist->list[tokenlist->count++];
3360 t->token = token;
3361 t->len = len;
3362 t->type = type;
3363 t->line = line;
3366 /* Counts the number of adjoining non-separator tokens.
3368 * Returns -ve if the first token is the expansion
3369 * operator (in which case the count doesn't include
3370 * that token).
3372 static int JimCountWordTokens(ParseToken *t)
3374 int expand = 1;
3375 int count = 0;
3377 /* Is the first word {*} or {expand}? */
3378 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3379 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3380 /* Create an expand token */
3381 expand = -1;
3382 t++;
3386 /* Now count non-separator words */
3387 while (!TOKEN_IS_SEP(t->type)) {
3388 t++;
3389 count++;
3392 return count * expand;
3396 * Create a script/subst object from the given token.
3398 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3400 Jim_Obj *objPtr;
3402 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3403 /* Convert backlash escapes. The result will never be longer than the original */
3404 int len = t->len;
3405 char *str = Jim_Alloc(len + 1);
3406 len = JimEscape(str, t->token, len);
3407 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3409 else {
3410 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3411 * with a single space.
3413 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3415 return objPtr;
3419 * Takes a tokenlist and creates the allocated list of script tokens
3420 * in script->token, of length script->len.
3422 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3423 * as required.
3425 * Also sets script->line to the line number of the first token
3427 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3428 ParseTokenList *tokenlist)
3430 int i;
3431 struct ScriptToken *token;
3432 /* Number of tokens so far for the current command */
3433 int lineargs = 0;
3434 /* This is the first token for the current command */
3435 ScriptToken *linefirst;
3436 int count;
3437 int linenr;
3439 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3440 printf("==== Tokens ====\n");
3441 for (i = 0; i < tokenlist->count; i++) {
3442 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3443 tokenlist->list[i].len, tokenlist->list[i].token);
3445 #endif
3447 /* May need up to one extra script token for each EOL in the worst case */
3448 count = tokenlist->count;
3449 for (i = 0; i < tokenlist->count; i++) {
3450 if (tokenlist->list[i].type == JIM_TT_EOL) {
3451 count++;
3454 linenr = script->firstline = tokenlist->list[0].line;
3456 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3458 /* This is the first token for the current command */
3459 linefirst = token++;
3461 for (i = 0; i < tokenlist->count; ) {
3462 /* Look ahead to find out how many tokens make up the next word */
3463 int wordtokens;
3465 /* Skip any leading separators */
3466 while (tokenlist->list[i].type == JIM_TT_SEP) {
3467 i++;
3470 wordtokens = JimCountWordTokens(tokenlist->list + i);
3472 if (wordtokens == 0) {
3473 /* None, so at end of line */
3474 if (lineargs) {
3475 linefirst->type = JIM_TT_LINE;
3476 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3477 Jim_IncrRefCount(linefirst->objPtr);
3479 /* Reset for new line */
3480 lineargs = 0;
3481 linefirst = token++;
3483 i++;
3484 continue;
3486 else if (wordtokens != 1) {
3487 /* More than 1, or {*}, so insert a WORD token */
3488 token->type = JIM_TT_WORD;
3489 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3490 Jim_IncrRefCount(token->objPtr);
3491 token++;
3492 if (wordtokens < 0) {
3493 /* Skip the expand token */
3494 i++;
3495 wordtokens = -wordtokens - 1;
3496 lineargs--;
3500 if (lineargs == 0) {
3501 /* First real token on the line, so record the line number */
3502 linenr = tokenlist->list[i].line;
3504 lineargs++;
3506 /* Add each non-separator word token to the line */
3507 while (wordtokens--) {
3508 const ParseToken *t = &tokenlist->list[i++];
3510 token->type = t->type;
3511 token->objPtr = JimMakeScriptObj(interp, t);
3512 Jim_IncrRefCount(token->objPtr);
3514 /* Every object is initially a string of type 'source', but the
3515 * internal type may be specialized during execution of the
3516 * script. */
3517 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3518 token++;
3522 if (lineargs == 0) {
3523 token--;
3526 script->len = token - script->token;
3528 JimPanic((script->len >= count, "allocated script array is too short"));
3530 #ifdef DEBUG_SHOW_SCRIPT
3531 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3532 for (i = 0; i < script->len; i++) {
3533 const ScriptToken *t = &script->token[i];
3534 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3536 #endif
3540 /* Parses the given string object to determine if it represents a complete script.
3542 * This is useful for interactive shells implementation, for [info complete].
3544 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3545 * '{' on scripts incomplete missing one or more '}' to be balanced.
3546 * '[' on scripts incomplete missing one or more ']' to be balanced.
3547 * '"' on scripts incomplete missing a '"' char.
3548 * '\\' on scripts with a trailing backslash.
3550 * If the script is complete, 1 is returned, otherwise 0.
3552 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3554 ScriptObj *script = JimGetScript(interp, scriptObj);
3555 if (stateCharPtr) {
3556 *stateCharPtr = script->missing;
3558 return (script->missing == ' ');
3562 * Sets an appropriate error message for a missing script/expression terminator.
3564 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3566 * Note that a trailing backslash is not considered to be an error.
3568 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3570 const char *msg;
3572 switch (ch) {
3573 case '\\':
3574 case ' ':
3575 return JIM_OK;
3577 case '[':
3578 msg = "unmatched \"[\"";
3579 break;
3580 case '{':
3581 msg = "missing close-brace";
3582 break;
3583 case '"':
3584 default:
3585 msg = "missing quote";
3586 break;
3589 Jim_SetResultString(interp, msg, -1);
3590 return JIM_ERR;
3594 * Similar to ScriptObjAddTokens(), but for subst objects.
3596 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3597 ParseTokenList *tokenlist)
3599 int i;
3600 struct ScriptToken *token;
3602 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3604 for (i = 0; i < tokenlist->count; i++) {
3605 const ParseToken *t = &tokenlist->list[i];
3607 /* Create a token for 't' */
3608 token->type = t->type;
3609 token->objPtr = JimMakeScriptObj(interp, t);
3610 Jim_IncrRefCount(token->objPtr);
3611 token++;
3614 script->len = i;
3617 /* This method takes the string representation of an object
3618 * as a Tcl script, and generates the pre-parsed internal representation
3619 * of the script.
3621 * On parse error, sets an error message and returns JIM_ERR
3622 * (Note: the object is still converted to a script, even if an error occurs)
3624 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3626 int scriptTextLen;
3627 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3628 struct JimParserCtx parser;
3629 struct ScriptObj *script;
3630 ParseTokenList tokenlist;
3631 int line = 1;
3633 /* Try to get information about filename / line number */
3634 if (objPtr->typePtr == &sourceObjType) {
3635 line = objPtr->internalRep.sourceValue.lineNumber;
3638 /* Initially parse the script into tokens (in tokenlist) */
3639 ScriptTokenListInit(&tokenlist);
3641 JimParserInit(&parser, scriptText, scriptTextLen, line);
3642 while (!parser.eof) {
3643 JimParseScript(&parser);
3644 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3645 parser.tline);
3648 /* Add a final EOF token */
3649 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3651 /* Create the "real" script tokens from the parsed tokens */
3652 script = Jim_Alloc(sizeof(*script));
3653 memset(script, 0, sizeof(*script));
3654 script->inUse = 1;
3655 if (objPtr->typePtr == &sourceObjType) {
3656 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3658 else {
3659 script->fileNameObj = interp->emptyObj;
3661 Jim_IncrRefCount(script->fileNameObj);
3662 script->missing = parser.missing.ch;
3663 script->linenr = parser.missing.line;
3665 ScriptObjAddTokens(interp, script, &tokenlist);
3667 /* No longer need the token list */
3668 ScriptTokenListFree(&tokenlist);
3670 /* Free the old internal rep and set the new one. */
3671 Jim_FreeIntRep(interp, objPtr);
3672 Jim_SetIntRepPtr(objPtr, script);
3673 objPtr->typePtr = &scriptObjType;
3676 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3679 * Returns the parsed script.
3680 * Note that if there is any possibility that the script is not valid,
3681 * call JimScriptValid() to check
3683 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3685 if (objPtr == interp->emptyObj) {
3686 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3687 objPtr = interp->nullScriptObj;
3690 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3691 JimSetScriptFromAny(interp, objPtr);
3694 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3698 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3699 * and leaves an error message in the interp result.
3702 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3704 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3705 JimAddErrorToStack(interp, script);
3706 return 0;
3708 return 1;
3712 /* -----------------------------------------------------------------------------
3713 * Commands
3714 * ---------------------------------------------------------------------------*/
3715 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3717 cmdPtr->inUse++;
3720 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3722 if (--cmdPtr->inUse == 0) {
3723 if (cmdPtr->isproc) {
3724 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3725 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3726 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3727 if (cmdPtr->u.proc.staticVars) {
3728 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3729 Jim_Free(cmdPtr->u.proc.staticVars);
3732 else {
3733 /* native (C) */
3734 if (cmdPtr->u.native.delProc) {
3735 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3738 if (cmdPtr->prevCmd) {
3739 /* Delete any pushed command too */
3740 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3742 Jim_Free(cmdPtr);
3746 /* Variables HashTable Type.
3748 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3751 /* Variables HashTable Type.
3753 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3754 static void JimVariablesHTValDestructor(void *interp, void *val)
3756 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3757 Jim_Free(val);
3760 static const Jim_HashTableType JimVariablesHashTableType = {
3761 JimStringCopyHTHashFunction, /* hash function */
3762 JimStringCopyHTDup, /* key dup */
3763 NULL, /* val dup */
3764 JimStringCopyHTKeyCompare, /* key compare */
3765 JimStringCopyHTKeyDestructor, /* key destructor */
3766 JimVariablesHTValDestructor /* val destructor */
3769 /* Commands HashTable Type.
3771 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3773 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3775 JimDecrCmdRefCount(interp, val);
3778 static const Jim_HashTableType JimCommandsHashTableType = {
3779 JimStringCopyHTHashFunction, /* hash function */
3780 JimStringCopyHTDup, /* key dup */
3781 NULL, /* val dup */
3782 JimStringCopyHTKeyCompare, /* key compare */
3783 JimStringCopyHTKeyDestructor, /* key destructor */
3784 JimCommandsHT_ValDestructor /* val destructor */
3787 /* ------------------------- Commands related functions --------------------- */
3789 #ifdef jim_ext_namespace
3791 * Returns the "unscoped" version of the given namespace.
3792 * That is, the fully qualified name without the leading ::
3793 * The returned value is either nsObj, or an object with a zero ref count.
3795 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3797 const char *name = Jim_String(nsObj);
3798 if (name[0] == ':' && name[1] == ':') {
3799 /* This command is being defined in the global namespace */
3800 while (*++name == ':') {
3802 nsObj = Jim_NewStringObj(interp, name, -1);
3804 else if (Jim_Length(interp->framePtr->nsObj)) {
3805 /* This command is being defined in a non-global namespace */
3806 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3807 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3809 return nsObj;
3812 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3814 Jim_Obj *resultObj;
3816 const char *name = Jim_String(nameObjPtr);
3817 if (name[0] == ':' && name[1] == ':') {
3818 return nameObjPtr;
3820 Jim_IncrRefCount(nameObjPtr);
3821 resultObj = Jim_NewStringObj(interp, "::", -1);
3822 Jim_AppendObj(interp, resultObj, nameObjPtr);
3823 Jim_DecrRefCount(interp, nameObjPtr);
3825 return resultObj;
3829 * An efficient version of JimQualifyNameObj() where the name is
3830 * available (and needed) as a 'const char *'.
3831 * Avoids creating an object if not necessary.
3832 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3834 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3836 Jim_Obj *objPtr = interp->emptyObj;
3838 if (name[0] == ':' && name[1] == ':') {
3839 /* This command is being defined in the global namespace */
3840 while (*++name == ':') {
3843 else if (Jim_Length(interp->framePtr->nsObj)) {
3844 /* This command is being defined in a non-global namespace */
3845 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3846 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3847 name = Jim_String(objPtr);
3849 Jim_IncrRefCount(objPtr);
3850 *objPtrPtr = objPtr;
3851 return name;
3854 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3856 #else
3857 /* We can be more efficient in the no-namespace case */
3858 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3859 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3861 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3863 return nameObjPtr;
3865 #endif
3867 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3869 /* It may already exist, so we try to delete the old one.
3870 * Note that reference count means that it won't be deleted yet if
3871 * it exists in the call stack.
3873 * BUT, if 'local' is in force, instead of deleting the existing
3874 * proc, we stash a reference to the old proc here.
3876 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3877 if (he) {
3878 /* There was an old cmd with the same name,
3879 * so this requires a 'proc epoch' update. */
3881 /* If a procedure with the same name didn't exist there is no need
3882 * to increment the 'proc epoch' because creation of a new procedure
3883 * can never affect existing cached commands. We don't do
3884 * negative caching. */
3885 Jim_InterpIncrProcEpoch(interp);
3888 if (he && interp->local) {
3889 /* Push this command over the top of the previous one */
3890 cmd->prevCmd = Jim_GetHashEntryVal(he);
3891 Jim_SetHashVal(&interp->commands, he, cmd);
3893 else {
3894 if (he) {
3895 /* Replace the existing command */
3896 Jim_DeleteHashEntry(&interp->commands, name);
3899 Jim_AddHashEntry(&interp->commands, name, cmd);
3901 return JIM_OK;
3905 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3906 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3908 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3910 /* Store the new details for this command */
3911 memset(cmdPtr, 0, sizeof(*cmdPtr));
3912 cmdPtr->inUse = 1;
3913 cmdPtr->u.native.delProc = delProc;
3914 cmdPtr->u.native.cmdProc = cmdProc;
3915 cmdPtr->u.native.privData = privData;
3917 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3919 return JIM_OK;
3922 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3924 int len, i;
3926 len = Jim_ListLength(interp, staticsListObjPtr);
3927 if (len == 0) {
3928 return JIM_OK;
3931 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3932 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3933 for (i = 0; i < len; i++) {
3934 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3935 Jim_Var *varPtr;
3936 int subLen;
3938 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3939 /* Check if it's composed of two elements. */
3940 subLen = Jim_ListLength(interp, objPtr);
3941 if (subLen == 1 || subLen == 2) {
3942 /* Try to get the variable value from the current
3943 * environment. */
3944 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3945 if (subLen == 1) {
3946 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3947 if (initObjPtr == NULL) {
3948 Jim_SetResultFormatted(interp,
3949 "variable for initialization of static \"%#s\" not found in the local context",
3950 nameObjPtr);
3951 return JIM_ERR;
3954 else {
3955 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3957 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3958 return JIM_ERR;
3961 varPtr = Jim_Alloc(sizeof(*varPtr));
3962 varPtr->objPtr = initObjPtr;
3963 Jim_IncrRefCount(initObjPtr);
3964 varPtr->linkFramePtr = NULL;
3965 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3966 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3967 Jim_SetResultFormatted(interp,
3968 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3969 Jim_DecrRefCount(interp, initObjPtr);
3970 Jim_Free(varPtr);
3971 return JIM_ERR;
3974 else {
3975 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3976 objPtr);
3977 return JIM_ERR;
3980 return JIM_OK;
3983 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3985 #ifdef jim_ext_namespace
3986 if (cmdPtr->isproc) {
3987 /* XXX: Really need JimNamespaceSplit() */
3988 const char *pt = strrchr(cmdname, ':');
3989 if (pt && pt != cmdname && pt[-1] == ':') {
3990 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3991 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3992 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3994 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3995 /* This commands shadows a global command, so a proc epoch update is required */
3996 Jim_InterpIncrProcEpoch(interp);
4000 #endif
4003 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4004 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4006 Jim_Cmd *cmdPtr;
4007 int argListLen;
4008 int i;
4010 argListLen = Jim_ListLength(interp, argListObjPtr);
4012 /* Allocate space for both the command pointer and the arg list */
4013 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4014 memset(cmdPtr, 0, sizeof(*cmdPtr));
4015 cmdPtr->inUse = 1;
4016 cmdPtr->isproc = 1;
4017 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4018 cmdPtr->u.proc.argListLen = argListLen;
4019 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4020 cmdPtr->u.proc.argsPos = -1;
4021 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4022 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4023 Jim_IncrRefCount(argListObjPtr);
4024 Jim_IncrRefCount(bodyObjPtr);
4025 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4027 /* Create the statics hash table. */
4028 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4029 goto err;
4032 /* Parse the args out into arglist, validating as we go */
4033 /* Examine the argument list for default parameters and 'args' */
4034 for (i = 0; i < argListLen; i++) {
4035 Jim_Obj *argPtr;
4036 Jim_Obj *nameObjPtr;
4037 Jim_Obj *defaultObjPtr;
4038 int len;
4040 /* Examine a parameter */
4041 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4042 len = Jim_ListLength(interp, argPtr);
4043 if (len == 0) {
4044 Jim_SetResultString(interp, "argument with no name", -1);
4045 err:
4046 JimDecrCmdRefCount(interp, cmdPtr);
4047 return NULL;
4049 if (len > 2) {
4050 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4051 goto err;
4054 if (len == 2) {
4055 /* Optional parameter */
4056 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4057 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4059 else {
4060 /* Required parameter */
4061 nameObjPtr = argPtr;
4062 defaultObjPtr = NULL;
4066 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4067 if (cmdPtr->u.proc.argsPos >= 0) {
4068 Jim_SetResultString(interp, "'args' specified more than once", -1);
4069 goto err;
4071 cmdPtr->u.proc.argsPos = i;
4073 else {
4074 if (len == 2) {
4075 cmdPtr->u.proc.optArity++;
4077 else {
4078 cmdPtr->u.proc.reqArity++;
4082 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4083 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4086 return cmdPtr;
4089 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4091 int ret = JIM_OK;
4092 Jim_Obj *qualifiedNameObj;
4093 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4095 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4096 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4097 ret = JIM_ERR;
4099 else {
4100 Jim_InterpIncrProcEpoch(interp);
4103 JimFreeQualifiedName(interp, qualifiedNameObj);
4105 return ret;
4108 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4110 int ret = JIM_ERR;
4111 Jim_HashEntry *he;
4112 Jim_Cmd *cmdPtr;
4113 Jim_Obj *qualifiedOldNameObj;
4114 Jim_Obj *qualifiedNewNameObj;
4115 const char *fqold;
4116 const char *fqnew;
4118 if (newName[0] == 0) {
4119 return Jim_DeleteCommand(interp, oldName);
4122 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4123 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4125 /* Does it exist? */
4126 he = Jim_FindHashEntry(&interp->commands, fqold);
4127 if (he == NULL) {
4128 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4130 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4131 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4133 else {
4134 /* Add the new name first */
4135 cmdPtr = Jim_GetHashEntryVal(he);
4136 JimIncrCmdRefCount(cmdPtr);
4137 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4138 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4140 /* Now remove the old name */
4141 Jim_DeleteHashEntry(&interp->commands, fqold);
4143 /* Increment the epoch */
4144 Jim_InterpIncrProcEpoch(interp);
4146 ret = JIM_OK;
4149 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4150 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4152 return ret;
4155 /* -----------------------------------------------------------------------------
4156 * Command object
4157 * ---------------------------------------------------------------------------*/
4159 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4161 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4164 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4166 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4167 dupPtr->typePtr = srcPtr->typePtr;
4168 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4171 static const Jim_ObjType commandObjType = {
4172 "command",
4173 FreeCommandInternalRep,
4174 DupCommandInternalRep,
4175 NULL,
4176 JIM_TYPE_REFERENCES,
4179 /* This function returns the command structure for the command name
4180 * stored in objPtr. It tries to specialize the objPtr to contain
4181 * a cached info instead to perform the lookup into the hash table
4182 * every time. The information cached may not be uptodate, in such
4183 * a case the lookup is performed and the cache updated.
4185 * Respects the 'upcall' setting
4187 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4189 Jim_Cmd *cmd;
4191 /* In order to be valid, the proc epoch must match and
4192 * the lookup must have occurred in the same namespace
4194 if (objPtr->typePtr != &commandObjType ||
4195 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4196 #ifdef jim_ext_namespace
4197 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4198 #endif
4200 /* Not cached or out of date, so lookup */
4202 /* Do we need to try the local namespace? */
4203 const char *name = Jim_String(objPtr);
4204 Jim_HashEntry *he;
4206 if (name[0] == ':' && name[1] == ':') {
4207 while (*++name == ':') {
4210 #ifdef jim_ext_namespace
4211 else if (Jim_Length(interp->framePtr->nsObj)) {
4212 /* This command is being defined in a non-global namespace */
4213 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4214 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4215 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4216 Jim_FreeNewObj(interp, nameObj);
4217 if (he) {
4218 goto found;
4221 #endif
4223 /* Lookup in the global namespace */
4224 he = Jim_FindHashEntry(&interp->commands, name);
4225 if (he == NULL) {
4226 if (flags & JIM_ERRMSG) {
4227 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4229 return NULL;
4231 #ifdef jim_ext_namespace
4232 found:
4233 #endif
4234 cmd = Jim_GetHashEntryVal(he);
4236 /* Free the old internal repr and set the new one. */
4237 Jim_FreeIntRep(interp, objPtr);
4238 objPtr->typePtr = &commandObjType;
4239 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4240 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4241 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4242 Jim_IncrRefCount(interp->framePtr->nsObj);
4244 else {
4245 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4247 while (cmd->u.proc.upcall) {
4248 cmd = cmd->prevCmd;
4250 return cmd;
4253 /* -----------------------------------------------------------------------------
4254 * Variables
4255 * ---------------------------------------------------------------------------*/
4257 /* -----------------------------------------------------------------------------
4258 * Variable object
4259 * ---------------------------------------------------------------------------*/
4261 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4263 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4265 static const Jim_ObjType variableObjType = {
4266 "variable",
4267 NULL,
4268 NULL,
4269 NULL,
4270 JIM_TYPE_REFERENCES,
4274 * Check that the name does not contain embedded nulls.
4276 * Variable and procedure names are manipulated as null terminated strings, so
4277 * don't allow names with embedded nulls.
4279 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4281 /* Variable names and proc names can't contain embedded nulls */
4282 if (nameObjPtr->typePtr != &variableObjType) {
4283 int len;
4284 const char *str = Jim_GetString(nameObjPtr, &len);
4285 if (memchr(str, '\0', len)) {
4286 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4287 return JIM_ERR;
4290 return JIM_OK;
4293 /* This method should be called only by the variable API.
4294 * It returns JIM_OK on success (variable already exists),
4295 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4296 * a variable name, but syntax glue for [dict] i.e. the last
4297 * character is ')' */
4298 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4300 const char *varName;
4301 Jim_CallFrame *framePtr;
4302 Jim_HashEntry *he;
4303 int global;
4304 int len;
4306 /* Check if the object is already an uptodate variable */
4307 if (objPtr->typePtr == &variableObjType) {
4308 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4309 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4310 /* nothing to do */
4311 return JIM_OK;
4313 /* Need to re-resolve the variable in the updated callframe */
4315 else if (objPtr->typePtr == &dictSubstObjType) {
4316 return JIM_DICT_SUGAR;
4318 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4319 return JIM_ERR;
4323 varName = Jim_GetString(objPtr, &len);
4325 /* Make sure it's not syntax glue to get/set dict. */
4326 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4327 return JIM_DICT_SUGAR;
4330 if (varName[0] == ':' && varName[1] == ':') {
4331 while (*++varName == ':') {
4333 global = 1;
4334 framePtr = interp->topFramePtr;
4336 else {
4337 global = 0;
4338 framePtr = interp->framePtr;
4341 /* Resolve this name in the variables hash table */
4342 he = Jim_FindHashEntry(&framePtr->vars, varName);
4343 if (he == NULL) {
4344 if (!global && framePtr->staticVars) {
4345 /* Try with static vars. */
4346 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4348 if (he == NULL) {
4349 return JIM_ERR;
4353 /* Free the old internal repr and set the new one. */
4354 Jim_FreeIntRep(interp, objPtr);
4355 objPtr->typePtr = &variableObjType;
4356 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4357 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4358 objPtr->internalRep.varValue.global = global;
4359 return JIM_OK;
4362 /* -------------------- Variables related functions ------------------------- */
4363 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4364 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4366 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4368 const char *name;
4369 Jim_CallFrame *framePtr;
4370 int global;
4372 /* New variable to create */
4373 Jim_Var *var = Jim_Alloc(sizeof(*var));
4375 var->objPtr = valObjPtr;
4376 Jim_IncrRefCount(valObjPtr);
4377 var->linkFramePtr = NULL;
4379 name = Jim_String(nameObjPtr);
4380 if (name[0] == ':' && name[1] == ':') {
4381 while (*++name == ':') {
4383 framePtr = interp->topFramePtr;
4384 global = 1;
4386 else {
4387 framePtr = interp->framePtr;
4388 global = 0;
4391 /* Insert the new variable */
4392 Jim_AddHashEntry(&framePtr->vars, name, var);
4394 /* Make the object int rep a variable */
4395 Jim_FreeIntRep(interp, nameObjPtr);
4396 nameObjPtr->typePtr = &variableObjType;
4397 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4398 nameObjPtr->internalRep.varValue.varPtr = var;
4399 nameObjPtr->internalRep.varValue.global = global;
4401 return var;
4404 /* For now that's dummy. Variables lookup should be optimized
4405 * in many ways, with caching of lookups, and possibly with
4406 * a table of pre-allocated vars in every CallFrame for local vars.
4407 * All the caching should also have an 'epoch' mechanism similar
4408 * to the one used by Tcl for procedures lookup caching. */
4410 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4412 int err;
4413 Jim_Var *var;
4415 switch (SetVariableFromAny(interp, nameObjPtr)) {
4416 case JIM_DICT_SUGAR:
4417 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4419 case JIM_ERR:
4420 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4421 return JIM_ERR;
4423 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4424 break;
4426 case JIM_OK:
4427 var = nameObjPtr->internalRep.varValue.varPtr;
4428 if (var->linkFramePtr == NULL) {
4429 Jim_IncrRefCount(valObjPtr);
4430 Jim_DecrRefCount(interp, var->objPtr);
4431 var->objPtr = valObjPtr;
4433 else { /* Else handle the link */
4434 Jim_CallFrame *savedCallFrame;
4436 savedCallFrame = interp->framePtr;
4437 interp->framePtr = var->linkFramePtr;
4438 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4439 interp->framePtr = savedCallFrame;
4440 if (err != JIM_OK)
4441 return err;
4444 return JIM_OK;
4447 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4449 Jim_Obj *nameObjPtr;
4450 int result;
4452 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4453 Jim_IncrRefCount(nameObjPtr);
4454 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4455 Jim_DecrRefCount(interp, nameObjPtr);
4456 return result;
4459 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4461 Jim_CallFrame *savedFramePtr;
4462 int result;
4464 savedFramePtr = interp->framePtr;
4465 interp->framePtr = interp->topFramePtr;
4466 result = Jim_SetVariableStr(interp, name, objPtr);
4467 interp->framePtr = savedFramePtr;
4468 return result;
4471 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4473 Jim_Obj *nameObjPtr, *valObjPtr;
4474 int result;
4476 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4477 valObjPtr = Jim_NewStringObj(interp, val, -1);
4478 Jim_IncrRefCount(nameObjPtr);
4479 Jim_IncrRefCount(valObjPtr);
4480 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4481 Jim_DecrRefCount(interp, nameObjPtr);
4482 Jim_DecrRefCount(interp, valObjPtr);
4483 return result;
4486 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4487 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4489 const char *varName;
4490 const char *targetName;
4491 Jim_CallFrame *framePtr;
4492 Jim_Var *varPtr;
4494 /* Check for an existing variable or link */
4495 switch (SetVariableFromAny(interp, nameObjPtr)) {
4496 case JIM_DICT_SUGAR:
4497 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4498 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4499 return JIM_ERR;
4501 case JIM_OK:
4502 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4504 if (varPtr->linkFramePtr == NULL) {
4505 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4506 return JIM_ERR;
4509 /* It exists, but is a link, so first delete the link */
4510 varPtr->linkFramePtr = NULL;
4511 break;
4514 /* Resolve the call frames for both variables */
4515 /* XXX: SetVariableFromAny() already did this! */
4516 varName = Jim_String(nameObjPtr);
4518 if (varName[0] == ':' && varName[1] == ':') {
4519 while (*++varName == ':') {
4521 /* Linking a global var does nothing */
4522 framePtr = interp->topFramePtr;
4524 else {
4525 framePtr = interp->framePtr;
4528 targetName = Jim_String(targetNameObjPtr);
4529 if (targetName[0] == ':' && targetName[1] == ':') {
4530 while (*++targetName == ':') {
4532 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4533 targetCallFrame = interp->topFramePtr;
4535 Jim_IncrRefCount(targetNameObjPtr);
4537 if (framePtr->level < targetCallFrame->level) {
4538 Jim_SetResultFormatted(interp,
4539 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4540 nameObjPtr);
4541 Jim_DecrRefCount(interp, targetNameObjPtr);
4542 return JIM_ERR;
4545 /* Check for cycles. */
4546 if (framePtr == targetCallFrame) {
4547 Jim_Obj *objPtr = targetNameObjPtr;
4549 /* Cycles are only possible with 'uplevel 0' */
4550 while (1) {
4551 if (strcmp(Jim_String(objPtr), varName) == 0) {
4552 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4553 Jim_DecrRefCount(interp, targetNameObjPtr);
4554 return JIM_ERR;
4556 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4557 break;
4558 varPtr = objPtr->internalRep.varValue.varPtr;
4559 if (varPtr->linkFramePtr != targetCallFrame)
4560 break;
4561 objPtr = varPtr->objPtr;
4565 /* Perform the binding */
4566 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4567 /* We are now sure 'nameObjPtr' type is variableObjType */
4568 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4569 Jim_DecrRefCount(interp, targetNameObjPtr);
4570 return JIM_OK;
4573 /* Return the Jim_Obj pointer associated with a variable name,
4574 * or NULL if the variable was not found in the current context.
4575 * The same optimization discussed in the comment to the
4576 * 'SetVariable' function should apply here.
4578 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4579 * in a dictionary which is shared, the array variable value is duplicated first.
4580 * This allows the array element to be updated (e.g. append, lappend) without
4581 * affecting other references to the dictionary.
4583 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4585 switch (SetVariableFromAny(interp, nameObjPtr)) {
4586 case JIM_OK:{
4587 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4589 if (varPtr->linkFramePtr == NULL) {
4590 return varPtr->objPtr;
4592 else {
4593 Jim_Obj *objPtr;
4595 /* The variable is a link? Resolve it. */
4596 Jim_CallFrame *savedCallFrame = interp->framePtr;
4598 interp->framePtr = varPtr->linkFramePtr;
4599 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4600 interp->framePtr = savedCallFrame;
4601 if (objPtr) {
4602 return objPtr;
4604 /* Error, so fall through to the error message */
4607 break;
4609 case JIM_DICT_SUGAR:
4610 /* [dict] syntax sugar. */
4611 return JimDictSugarGet(interp, nameObjPtr, flags);
4613 if (flags & JIM_ERRMSG) {
4614 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4616 return NULL;
4619 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4621 Jim_CallFrame *savedFramePtr;
4622 Jim_Obj *objPtr;
4624 savedFramePtr = interp->framePtr;
4625 interp->framePtr = interp->topFramePtr;
4626 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4627 interp->framePtr = savedFramePtr;
4629 return objPtr;
4632 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4634 Jim_Obj *nameObjPtr, *varObjPtr;
4636 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4637 Jim_IncrRefCount(nameObjPtr);
4638 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4639 Jim_DecrRefCount(interp, nameObjPtr);
4640 return varObjPtr;
4643 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4645 Jim_CallFrame *savedFramePtr;
4646 Jim_Obj *objPtr;
4648 savedFramePtr = interp->framePtr;
4649 interp->framePtr = interp->topFramePtr;
4650 objPtr = Jim_GetVariableStr(interp, name, flags);
4651 interp->framePtr = savedFramePtr;
4653 return objPtr;
4656 /* Unset a variable.
4657 * Note: On success unset invalidates all the variable objects created
4658 * in the current call frame incrementing. */
4659 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4661 Jim_Var *varPtr;
4662 int retval;
4663 Jim_CallFrame *framePtr;
4665 retval = SetVariableFromAny(interp, nameObjPtr);
4666 if (retval == JIM_DICT_SUGAR) {
4667 /* [dict] syntax sugar. */
4668 return JimDictSugarSet(interp, nameObjPtr, NULL);
4670 else if (retval == JIM_OK) {
4671 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4673 /* If it's a link call UnsetVariable recursively */
4674 if (varPtr->linkFramePtr) {
4675 framePtr = interp->framePtr;
4676 interp->framePtr = varPtr->linkFramePtr;
4677 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4678 interp->framePtr = framePtr;
4680 else {
4681 const char *name = Jim_String(nameObjPtr);
4682 if (nameObjPtr->internalRep.varValue.global) {
4683 name += 2;
4684 framePtr = interp->topFramePtr;
4686 else {
4687 framePtr = interp->framePtr;
4690 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4691 if (retval == JIM_OK) {
4692 /* Change the callframe id, invalidating var lookup caching */
4693 framePtr->id = interp->callFrameEpoch++;
4697 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4698 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4700 return retval;
4703 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4705 /* Given a variable name for [dict] operation syntax sugar,
4706 * this function returns two objects, the first with the name
4707 * of the variable to set, and the second with the respective key.
4708 * For example "foo(bar)" will return objects with string repr. of
4709 * "foo" and "bar".
4711 * The returned objects have refcount = 1. The function can't fail. */
4712 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4713 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4715 const char *str, *p;
4716 int len, keyLen;
4717 Jim_Obj *varObjPtr, *keyObjPtr;
4719 str = Jim_GetString(objPtr, &len);
4721 p = strchr(str, '(');
4722 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4724 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4726 p++;
4727 keyLen = (str + len) - p;
4728 if (str[len - 1] == ')') {
4729 keyLen--;
4732 /* Create the objects with the variable name and key. */
4733 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4735 Jim_IncrRefCount(varObjPtr);
4736 Jim_IncrRefCount(keyObjPtr);
4737 *varPtrPtr = varObjPtr;
4738 *keyPtrPtr = keyObjPtr;
4741 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4742 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4743 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4745 int err;
4747 SetDictSubstFromAny(interp, objPtr);
4749 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4750 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4752 if (err == JIM_OK) {
4753 /* Don't keep an extra ref to the result */
4754 Jim_SetEmptyResult(interp);
4756 else {
4757 if (!valObjPtr) {
4758 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4759 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4760 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4761 objPtr);
4762 return err;
4765 /* Make the error more informative and Tcl-compatible */
4766 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4767 (valObjPtr ? "set" : "unset"), objPtr);
4769 return err;
4773 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4775 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4776 * and stored back to the variable before expansion.
4778 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4779 Jim_Obj *keyObjPtr, int flags)
4781 Jim_Obj *dictObjPtr;
4782 Jim_Obj *resObjPtr = NULL;
4783 int ret;
4785 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4786 if (!dictObjPtr) {
4787 return NULL;
4790 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4791 if (ret != JIM_OK) {
4792 Jim_SetResultFormatted(interp,
4793 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4794 ret < 0 ? "variable isn't" : "no such element in");
4796 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4797 /* Update the variable to have an unshared copy */
4798 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4801 return resObjPtr;
4804 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4805 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4807 SetDictSubstFromAny(interp, objPtr);
4809 return JimDictExpandArrayVariable(interp,
4810 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4811 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4814 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4816 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4818 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4819 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4822 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4824 JIM_NOTUSED(interp);
4826 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4827 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4828 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4829 dupPtr->typePtr = &dictSubstObjType;
4832 /* Note: The object *must* be in dict-sugar format */
4833 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4835 if (objPtr->typePtr != &dictSubstObjType) {
4836 Jim_Obj *varObjPtr, *keyObjPtr;
4838 if (objPtr->typePtr == &interpolatedObjType) {
4839 /* An interpolated object in dict-sugar form */
4841 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4842 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4844 Jim_IncrRefCount(varObjPtr);
4845 Jim_IncrRefCount(keyObjPtr);
4847 else {
4848 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4851 Jim_FreeIntRep(interp, objPtr);
4852 objPtr->typePtr = &dictSubstObjType;
4853 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4854 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4858 /* This function is used to expand [dict get] sugar in the form
4859 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4860 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4861 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4862 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4863 * the [dict]ionary contained in variable VARNAME. */
4864 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4866 Jim_Obj *resObjPtr = NULL;
4867 Jim_Obj *substKeyObjPtr = NULL;
4869 SetDictSubstFromAny(interp, objPtr);
4871 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4872 &substKeyObjPtr, JIM_NONE)
4873 != JIM_OK) {
4874 return NULL;
4876 Jim_IncrRefCount(substKeyObjPtr);
4877 resObjPtr =
4878 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4879 substKeyObjPtr, 0);
4880 Jim_DecrRefCount(interp, substKeyObjPtr);
4882 return resObjPtr;
4885 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4887 Jim_Obj *resultObjPtr;
4889 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4890 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4891 resultObjPtr->refCount--;
4892 return resultObjPtr;
4894 return NULL;
4897 /* -----------------------------------------------------------------------------
4898 * CallFrame
4899 * ---------------------------------------------------------------------------*/
4901 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4903 Jim_CallFrame *cf;
4905 if (interp->freeFramesList) {
4906 cf = interp->freeFramesList;
4907 interp->freeFramesList = cf->next;
4909 cf->argv = NULL;
4910 cf->argc = 0;
4911 cf->procArgsObjPtr = NULL;
4912 cf->procBodyObjPtr = NULL;
4913 cf->next = NULL;
4914 cf->staticVars = NULL;
4915 cf->localCommands = NULL;
4916 cf->tailcallObj = NULL;
4917 cf->tailcallCmd = NULL;
4919 else {
4920 cf = Jim_Alloc(sizeof(*cf));
4921 memset(cf, 0, sizeof(*cf));
4923 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4926 cf->id = interp->callFrameEpoch++;
4927 cf->parent = parent;
4928 cf->level = parent ? parent->level + 1 : 0;
4929 cf->nsObj = nsObj;
4930 Jim_IncrRefCount(nsObj);
4932 return cf;
4935 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4937 /* Delete any local procs */
4938 if (localCommands) {
4939 Jim_Obj *cmdNameObj;
4941 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4942 Jim_HashEntry *he;
4943 Jim_Obj *fqObjName;
4944 Jim_HashTable *ht = &interp->commands;
4946 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4948 he = Jim_FindHashEntry(ht, fqname);
4950 if (he) {
4951 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4952 if (cmd->prevCmd) {
4953 Jim_Cmd *prevCmd = cmd->prevCmd;
4954 cmd->prevCmd = NULL;
4956 /* Delete the old command */
4957 JimDecrCmdRefCount(interp, cmd);
4959 /* And restore the original */
4960 Jim_SetHashVal(ht, he, prevCmd);
4962 else {
4963 Jim_DeleteHashEntry(ht, fqname);
4964 Jim_InterpIncrProcEpoch(interp);
4967 Jim_DecrRefCount(interp, cmdNameObj);
4968 JimFreeQualifiedName(interp, fqObjName);
4970 Jim_FreeStack(localCommands);
4971 Jim_Free(localCommands);
4973 return JIM_OK;
4977 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4978 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4979 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4981 JimDeleteLocalProcs(interp, cf->localCommands);
4983 if (cf->procArgsObjPtr)
4984 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4985 if (cf->procBodyObjPtr)
4986 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4987 Jim_DecrRefCount(interp, cf->nsObj);
4988 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4989 Jim_FreeHashTable(&cf->vars);
4990 else {
4991 int i;
4992 Jim_HashEntry **table = cf->vars.table, *he;
4994 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4995 he = table[i];
4996 while (he != NULL) {
4997 Jim_HashEntry *nextEntry = he->next;
4998 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5000 Jim_DecrRefCount(interp, varPtr->objPtr);
5001 Jim_Free(Jim_GetHashEntryKey(he));
5002 Jim_Free(varPtr);
5003 Jim_Free(he);
5004 table[i] = NULL;
5005 he = nextEntry;
5008 cf->vars.used = 0;
5010 cf->next = interp->freeFramesList;
5011 interp->freeFramesList = cf;
5015 /* -----------------------------------------------------------------------------
5016 * References
5017 * ---------------------------------------------------------------------------*/
5018 #ifdef JIM_REFERENCES
5020 /* References HashTable Type.
5022 * Keys are unsigned long integers, dynamically allocated for now but in the
5023 * future it's worth to cache this 4 bytes objects. Values are pointers
5024 * to Jim_References. */
5025 static void JimReferencesHTValDestructor(void *interp, void *val)
5027 Jim_Reference *refPtr = (void *)val;
5029 Jim_DecrRefCount(interp, refPtr->objPtr);
5030 if (refPtr->finalizerCmdNamePtr != NULL) {
5031 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5033 Jim_Free(val);
5036 static unsigned int JimReferencesHTHashFunction(const void *key)
5038 /* Only the least significant bits are used. */
5039 const unsigned long *widePtr = key;
5040 unsigned int intValue = (unsigned int)*widePtr;
5042 return Jim_IntHashFunction(intValue);
5045 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5047 void *copy = Jim_Alloc(sizeof(unsigned long));
5049 JIM_NOTUSED(privdata);
5051 memcpy(copy, key, sizeof(unsigned long));
5052 return copy;
5055 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5057 JIM_NOTUSED(privdata);
5059 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5062 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5064 JIM_NOTUSED(privdata);
5066 Jim_Free(key);
5069 static const Jim_HashTableType JimReferencesHashTableType = {
5070 JimReferencesHTHashFunction, /* hash function */
5071 JimReferencesHTKeyDup, /* key dup */
5072 NULL, /* val dup */
5073 JimReferencesHTKeyCompare, /* key compare */
5074 JimReferencesHTKeyDestructor, /* key destructor */
5075 JimReferencesHTValDestructor /* val destructor */
5078 /* -----------------------------------------------------------------------------
5079 * Reference object type and References API
5080 * ---------------------------------------------------------------------------*/
5082 /* The string representation of references has two features in order
5083 * to make the GC faster. The first is that every reference starts
5084 * with a non common character '<', in order to make the string matching
5085 * faster. The second is that the reference string rep is 42 characters
5086 * in length, this means that it is not necessary to check any object with a string
5087 * repr < 42, and usually there aren't many of these objects. */
5089 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5091 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5093 const char *fmt = "<reference.<%s>.%020lu>";
5095 sprintf(buf, fmt, refPtr->tag, id);
5096 return JIM_REFERENCE_SPACE;
5099 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5101 static const Jim_ObjType referenceObjType = {
5102 "reference",
5103 NULL,
5104 NULL,
5105 UpdateStringOfReference,
5106 JIM_TYPE_REFERENCES,
5109 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5111 char buf[JIM_REFERENCE_SPACE + 1];
5113 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5114 JimSetStringBytes(objPtr, buf);
5117 /* returns true if 'c' is a valid reference tag character.
5118 * i.e. inside the range [_a-zA-Z0-9] */
5119 static int isrefchar(int c)
5121 return (c == '_' || isalnum(c));
5124 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5126 unsigned long value;
5127 int i, len;
5128 const char *str, *start, *end;
5129 char refId[21];
5130 Jim_Reference *refPtr;
5131 Jim_HashEntry *he;
5132 char *endptr;
5134 /* Get the string representation */
5135 str = Jim_GetString(objPtr, &len);
5136 /* Check if it looks like a reference */
5137 if (len < JIM_REFERENCE_SPACE)
5138 goto badformat;
5139 /* Trim spaces */
5140 start = str;
5141 end = str + len - 1;
5142 while (*start == ' ')
5143 start++;
5144 while (*end == ' ' && end > start)
5145 end--;
5146 if (end - start + 1 != JIM_REFERENCE_SPACE)
5147 goto badformat;
5148 /* <reference.<1234567>.%020> */
5149 if (memcmp(start, "<reference.<", 12) != 0)
5150 goto badformat;
5151 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5152 goto badformat;
5153 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5154 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5155 if (!isrefchar(start[12 + i]))
5156 goto badformat;
5158 /* Extract info from the reference. */
5159 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5160 refId[20] = '\0';
5161 /* Try to convert the ID into an unsigned long */
5162 value = strtoul(refId, &endptr, 10);
5163 if (JimCheckConversion(refId, endptr) != JIM_OK)
5164 goto badformat;
5165 /* Check if the reference really exists! */
5166 he = Jim_FindHashEntry(&interp->references, &value);
5167 if (he == NULL) {
5168 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5169 return JIM_ERR;
5171 refPtr = Jim_GetHashEntryVal(he);
5172 /* Free the old internal repr and set the new one. */
5173 Jim_FreeIntRep(interp, objPtr);
5174 objPtr->typePtr = &referenceObjType;
5175 objPtr->internalRep.refValue.id = value;
5176 objPtr->internalRep.refValue.refPtr = refPtr;
5177 return JIM_OK;
5179 badformat:
5180 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5181 return JIM_ERR;
5184 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5185 * as finalizer command (or NULL if there is no finalizer).
5186 * The returned reference object has refcount = 0. */
5187 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5189 struct Jim_Reference *refPtr;
5190 unsigned long id;
5191 Jim_Obj *refObjPtr;
5192 const char *tag;
5193 int tagLen, i;
5195 /* Perform the Garbage Collection if needed. */
5196 Jim_CollectIfNeeded(interp);
5198 refPtr = Jim_Alloc(sizeof(*refPtr));
5199 refPtr->objPtr = objPtr;
5200 Jim_IncrRefCount(objPtr);
5201 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5202 if (cmdNamePtr)
5203 Jim_IncrRefCount(cmdNamePtr);
5204 id = interp->referenceNextId++;
5205 Jim_AddHashEntry(&interp->references, &id, refPtr);
5206 refObjPtr = Jim_NewObj(interp);
5207 refObjPtr->typePtr = &referenceObjType;
5208 refObjPtr->bytes = NULL;
5209 refObjPtr->internalRep.refValue.id = id;
5210 refObjPtr->internalRep.refValue.refPtr = refPtr;
5211 interp->referenceNextId++;
5212 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5213 * that does not pass the 'isrefchar' test is replaced with '_' */
5214 tag = Jim_GetString(tagPtr, &tagLen);
5215 if (tagLen > JIM_REFERENCE_TAGLEN)
5216 tagLen = JIM_REFERENCE_TAGLEN;
5217 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5218 if (i < tagLen && isrefchar(tag[i]))
5219 refPtr->tag[i] = tag[i];
5220 else
5221 refPtr->tag[i] = '_';
5223 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5224 return refObjPtr;
5227 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5229 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5230 return NULL;
5231 return objPtr->internalRep.refValue.refPtr;
5234 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5236 Jim_Reference *refPtr;
5238 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5239 return JIM_ERR;
5240 Jim_IncrRefCount(cmdNamePtr);
5241 if (refPtr->finalizerCmdNamePtr)
5242 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5243 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5244 return JIM_OK;
5247 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5249 Jim_Reference *refPtr;
5251 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5252 return JIM_ERR;
5253 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5254 return JIM_OK;
5257 /* -----------------------------------------------------------------------------
5258 * References Garbage Collection
5259 * ---------------------------------------------------------------------------*/
5261 /* This the hash table type for the "MARK" phase of the GC */
5262 static const Jim_HashTableType JimRefMarkHashTableType = {
5263 JimReferencesHTHashFunction, /* hash function */
5264 JimReferencesHTKeyDup, /* key dup */
5265 NULL, /* val dup */
5266 JimReferencesHTKeyCompare, /* key compare */
5267 JimReferencesHTKeyDestructor, /* key destructor */
5268 NULL /* val destructor */
5271 /* Performs the garbage collection. */
5272 int Jim_Collect(Jim_Interp *interp)
5274 int collected = 0;
5275 #ifndef JIM_BOOTSTRAP
5276 Jim_HashTable marks;
5277 Jim_HashTableIterator htiter;
5278 Jim_HashEntry *he;
5279 Jim_Obj *objPtr;
5281 /* Avoid recursive calls */
5282 if (interp->lastCollectId == -1) {
5283 /* Jim_Collect() already running. Return just now. */
5284 return 0;
5286 interp->lastCollectId = -1;
5288 /* Mark all the references found into the 'mark' hash table.
5289 * The references are searched in every live object that
5290 * is of a type that can contain references. */
5291 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5292 objPtr = interp->liveList;
5293 while (objPtr) {
5294 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5295 const char *str, *p;
5296 int len;
5298 /* If the object is of type reference, to get the
5299 * Id is simple... */
5300 if (objPtr->typePtr == &referenceObjType) {
5301 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5302 #ifdef JIM_DEBUG_GC
5303 printf("MARK (reference): %d refcount: %d\n",
5304 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5305 #endif
5306 objPtr = objPtr->nextObjPtr;
5307 continue;
5309 /* Get the string repr of the object we want
5310 * to scan for references. */
5311 p = str = Jim_GetString(objPtr, &len);
5312 /* Skip objects too little to contain references. */
5313 if (len < JIM_REFERENCE_SPACE) {
5314 objPtr = objPtr->nextObjPtr;
5315 continue;
5317 /* Extract references from the object string repr. */
5318 while (1) {
5319 int i;
5320 unsigned long id;
5322 if ((p = strstr(p, "<reference.<")) == NULL)
5323 break;
5324 /* Check if it's a valid reference. */
5325 if (len - (p - str) < JIM_REFERENCE_SPACE)
5326 break;
5327 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5328 break;
5329 for (i = 21; i <= 40; i++)
5330 if (!isdigit(UCHAR(p[i])))
5331 break;
5332 /* Get the ID */
5333 id = strtoul(p + 21, NULL, 10);
5335 /* Ok, a reference for the given ID
5336 * was found. Mark it. */
5337 Jim_AddHashEntry(&marks, &id, NULL);
5338 #ifdef JIM_DEBUG_GC
5339 printf("MARK: %d\n", (int)id);
5340 #endif
5341 p += JIM_REFERENCE_SPACE;
5344 objPtr = objPtr->nextObjPtr;
5347 /* Run the references hash table to destroy every reference that
5348 * is not referenced outside (not present in the mark HT). */
5349 JimInitHashTableIterator(&interp->references, &htiter);
5350 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5351 const unsigned long *refId;
5352 Jim_Reference *refPtr;
5354 refId = he->key;
5355 /* Check if in the mark phase we encountered
5356 * this reference. */
5357 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5358 #ifdef JIM_DEBUG_GC
5359 printf("COLLECTING %d\n", (int)*refId);
5360 #endif
5361 collected++;
5362 /* Drop the reference, but call the
5363 * finalizer first if registered. */
5364 refPtr = Jim_GetHashEntryVal(he);
5365 if (refPtr->finalizerCmdNamePtr) {
5366 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5367 Jim_Obj *objv[3], *oldResult;
5369 JimFormatReference(refstr, refPtr, *refId);
5371 objv[0] = refPtr->finalizerCmdNamePtr;
5372 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5373 objv[2] = refPtr->objPtr;
5375 /* Drop the reference itself */
5376 /* Avoid the finaliser being freed here */
5377 Jim_IncrRefCount(objv[0]);
5378 /* Don't remove the reference from the hash table just yet
5379 * since that will free refPtr, and hence refPtr->objPtr
5382 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5383 oldResult = interp->result;
5384 Jim_IncrRefCount(oldResult);
5385 Jim_EvalObjVector(interp, 3, objv);
5386 Jim_SetResult(interp, oldResult);
5387 Jim_DecrRefCount(interp, oldResult);
5389 Jim_DecrRefCount(interp, objv[0]);
5391 Jim_DeleteHashEntry(&interp->references, refId);
5394 Jim_FreeHashTable(&marks);
5395 interp->lastCollectId = interp->referenceNextId;
5396 interp->lastCollectTime = time(NULL);
5397 #endif /* JIM_BOOTSTRAP */
5398 return collected;
5401 #define JIM_COLLECT_ID_PERIOD 5000
5402 #define JIM_COLLECT_TIME_PERIOD 300
5404 void Jim_CollectIfNeeded(Jim_Interp *interp)
5406 unsigned long elapsedId;
5407 int elapsedTime;
5409 elapsedId = interp->referenceNextId - interp->lastCollectId;
5410 elapsedTime = time(NULL) - interp->lastCollectTime;
5413 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5414 Jim_Collect(interp);
5417 #endif
5419 int Jim_IsBigEndian(void)
5421 union {
5422 unsigned short s;
5423 unsigned char c[2];
5424 } uval = {0x0102};
5426 return uval.c[0] == 1;
5429 /* -----------------------------------------------------------------------------
5430 * Interpreter related functions
5431 * ---------------------------------------------------------------------------*/
5433 Jim_Interp *Jim_CreateInterp(void)
5435 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5437 memset(i, 0, sizeof(*i));
5439 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5440 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5441 i->lastCollectTime = time(NULL);
5443 /* Note that we can create objects only after the
5444 * interpreter liveList and freeList pointers are
5445 * initialized to NULL. */
5446 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5447 #ifdef JIM_REFERENCES
5448 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5449 #endif
5450 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5451 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5452 i->emptyObj = Jim_NewEmptyStringObj(i);
5453 i->trueObj = Jim_NewIntObj(i, 1);
5454 i->falseObj = Jim_NewIntObj(i, 0);
5455 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5456 i->errorFileNameObj = i->emptyObj;
5457 i->result = i->emptyObj;
5458 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5459 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5460 i->errorProc = i->emptyObj;
5461 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5462 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5463 Jim_IncrRefCount(i->emptyObj);
5464 Jim_IncrRefCount(i->errorFileNameObj);
5465 Jim_IncrRefCount(i->result);
5466 Jim_IncrRefCount(i->stackTrace);
5467 Jim_IncrRefCount(i->unknown);
5468 Jim_IncrRefCount(i->currentScriptObj);
5469 Jim_IncrRefCount(i->nullScriptObj);
5470 Jim_IncrRefCount(i->errorProc);
5471 Jim_IncrRefCount(i->trueObj);
5472 Jim_IncrRefCount(i->falseObj);
5474 /* Initialize key variables every interpreter should contain */
5475 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5476 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5478 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5479 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5480 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5481 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5482 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5483 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5484 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5485 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5487 return i;
5490 void Jim_FreeInterp(Jim_Interp *i)
5492 Jim_CallFrame *cf, *cfx;
5494 Jim_Obj *objPtr, *nextObjPtr;
5496 /* Free the active call frames list - must be done before i->commands is destroyed */
5497 for (cf = i->framePtr; cf; cf = cfx) {
5498 cfx = cf->parent;
5499 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5502 Jim_DecrRefCount(i, i->emptyObj);
5503 Jim_DecrRefCount(i, i->trueObj);
5504 Jim_DecrRefCount(i, i->falseObj);
5505 Jim_DecrRefCount(i, i->result);
5506 Jim_DecrRefCount(i, i->stackTrace);
5507 Jim_DecrRefCount(i, i->errorProc);
5508 Jim_DecrRefCount(i, i->unknown);
5509 Jim_DecrRefCount(i, i->errorFileNameObj);
5510 Jim_DecrRefCount(i, i->currentScriptObj);
5511 Jim_DecrRefCount(i, i->nullScriptObj);
5512 Jim_FreeHashTable(&i->commands);
5513 #ifdef JIM_REFERENCES
5514 Jim_FreeHashTable(&i->references);
5515 #endif
5516 Jim_FreeHashTable(&i->packages);
5517 Jim_Free(i->prngState);
5518 Jim_FreeHashTable(&i->assocData);
5520 /* Check that the live object list is empty, otherwise
5521 * there is a memory leak. */
5522 #ifdef JIM_MAINTAINER
5523 if (i->liveList != NULL) {
5524 objPtr = i->liveList;
5526 printf("\n-------------------------------------\n");
5527 printf("Objects still in the free list:\n");
5528 while (objPtr) {
5529 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5531 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5532 printf("%p (%d) %-10s: '%.20s...'\n",
5533 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5535 else {
5536 printf("%p (%d) %-10s: '%s'\n",
5537 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5539 if (objPtr->typePtr == &sourceObjType) {
5540 printf("FILE %s LINE %d\n",
5541 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5542 objPtr->internalRep.sourceValue.lineNumber);
5544 objPtr = objPtr->nextObjPtr;
5546 printf("-------------------------------------\n\n");
5547 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5549 #endif
5551 /* Free all the freed objects. */
5552 objPtr = i->freeList;
5553 while (objPtr) {
5554 nextObjPtr = objPtr->nextObjPtr;
5555 Jim_Free(objPtr);
5556 objPtr = nextObjPtr;
5559 /* Free the free call frames list */
5560 for (cf = i->freeFramesList; cf; cf = cfx) {
5561 cfx = cf->next;
5562 if (cf->vars.table)
5563 Jim_FreeHashTable(&cf->vars);
5564 Jim_Free(cf);
5567 /* Free the interpreter structure. */
5568 Jim_Free(i);
5571 /* Returns the call frame relative to the level represented by
5572 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5574 * This function accepts the 'level' argument in the form
5575 * of the commands [uplevel] and [upvar].
5577 * Returns NULL on error.
5579 * Note: for a function accepting a relative integer as level suitable
5580 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5582 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5584 long level;
5585 const char *str;
5586 Jim_CallFrame *framePtr;
5588 if (levelObjPtr) {
5589 str = Jim_String(levelObjPtr);
5590 if (str[0] == '#') {
5591 char *endptr;
5593 level = jim_strtol(str + 1, &endptr);
5594 if (str[1] == '\0' || endptr[0] != '\0') {
5595 level = -1;
5598 else {
5599 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5600 level = -1;
5602 else {
5603 /* Convert from a relative to an absolute level */
5604 level = interp->framePtr->level - level;
5608 else {
5609 str = "1"; /* Needed to format the error message. */
5610 level = interp->framePtr->level - 1;
5613 if (level == 0) {
5614 return interp->topFramePtr;
5616 if (level > 0) {
5617 /* Lookup */
5618 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5619 if (framePtr->level == level) {
5620 return framePtr;
5625 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5626 return NULL;
5629 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5630 * as a relative integer like in the [info level ?level?] command.
5632 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5634 long level;
5635 Jim_CallFrame *framePtr;
5637 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5638 if (level <= 0) {
5639 /* Convert from a relative to an absolute level */
5640 level = interp->framePtr->level + level;
5643 if (level == 0) {
5644 return interp->topFramePtr;
5647 /* Lookup */
5648 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5649 if (framePtr->level == level) {
5650 return framePtr;
5655 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5656 return NULL;
5659 static void JimResetStackTrace(Jim_Interp *interp)
5661 Jim_DecrRefCount(interp, interp->stackTrace);
5662 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5663 Jim_IncrRefCount(interp->stackTrace);
5666 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5668 int len;
5670 /* Increment reference first in case these are the same object */
5671 Jim_IncrRefCount(stackTraceObj);
5672 Jim_DecrRefCount(interp, interp->stackTrace);
5673 interp->stackTrace = stackTraceObj;
5674 interp->errorFlag = 1;
5676 /* This is a bit ugly.
5677 * If the filename of the last entry of the stack trace is empty,
5678 * the next stack level should be added.
5680 len = Jim_ListLength(interp, interp->stackTrace);
5681 if (len >= 3) {
5682 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5683 interp->addStackTrace = 1;
5688 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5689 Jim_Obj *fileNameObj, int linenr)
5691 if (strcmp(procname, "unknown") == 0) {
5692 procname = "";
5694 if (!*procname && !Jim_Length(fileNameObj)) {
5695 /* No useful info here */
5696 return;
5699 if (Jim_IsShared(interp->stackTrace)) {
5700 Jim_DecrRefCount(interp, interp->stackTrace);
5701 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5702 Jim_IncrRefCount(interp->stackTrace);
5705 /* If we have no procname but the previous element did, merge with that frame */
5706 if (!*procname && Jim_Length(fileNameObj)) {
5707 /* Just a filename. Check the previous entry */
5708 int len = Jim_ListLength(interp, interp->stackTrace);
5710 if (len >= 3) {
5711 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5712 if (Jim_Length(objPtr)) {
5713 /* Yes, the previous level had procname */
5714 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5715 if (Jim_Length(objPtr) == 0) {
5716 /* But no filename, so merge the new info with that frame */
5717 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5718 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5719 return;
5725 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5726 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5727 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5730 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5731 void *data)
5733 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5735 assocEntryPtr->delProc = delProc;
5736 assocEntryPtr->data = data;
5737 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5740 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5742 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5744 if (entryPtr != NULL) {
5745 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5746 return assocEntryPtr->data;
5748 return NULL;
5751 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5753 return Jim_DeleteHashEntry(&interp->assocData, key);
5756 int Jim_GetExitCode(Jim_Interp *interp)
5758 return interp->exitCode;
5761 /* -----------------------------------------------------------------------------
5762 * Integer object
5763 * ---------------------------------------------------------------------------*/
5764 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5765 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5767 static const Jim_ObjType intObjType = {
5768 "int",
5769 NULL,
5770 NULL,
5771 UpdateStringOfInt,
5772 JIM_TYPE_NONE,
5775 /* A coerced double is closer to an int than a double.
5776 * It is an int value temporarily masquerading as a double value.
5777 * i.e. it has the same string value as an int and Jim_GetWide()
5778 * succeeds, but also Jim_GetDouble() returns the value directly.
5780 static const Jim_ObjType coercedDoubleObjType = {
5781 "coerced-double",
5782 NULL,
5783 NULL,
5784 UpdateStringOfInt,
5785 JIM_TYPE_NONE,
5789 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5791 char buf[JIM_INTEGER_SPACE + 1];
5792 jim_wide wideValue = JimWideValue(objPtr);
5793 int pos = 0;
5795 if (wideValue == 0) {
5796 buf[pos++] = '0';
5798 else {
5799 char tmp[JIM_INTEGER_SPACE];
5800 int num = 0;
5801 int i;
5803 if (wideValue < 0) {
5804 buf[pos++] = '-';
5805 i = wideValue % 10;
5806 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5807 * whereas C99 is always -6
5808 * coverity[dead_error_line]
5810 tmp[num++] = (i > 0) ? (10 - i) : -i;
5811 wideValue /= -10;
5814 while (wideValue) {
5815 tmp[num++] = wideValue % 10;
5816 wideValue /= 10;
5819 for (i = 0; i < num; i++) {
5820 buf[pos++] = '0' + tmp[num - i - 1];
5823 buf[pos] = 0;
5825 JimSetStringBytes(objPtr, buf);
5828 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5830 jim_wide wideValue;
5831 const char *str;
5833 if (objPtr->typePtr == &coercedDoubleObjType) {
5834 /* Simple switch */
5835 objPtr->typePtr = &intObjType;
5836 return JIM_OK;
5839 /* Get the string representation */
5840 str = Jim_String(objPtr);
5841 /* Try to convert into a jim_wide */
5842 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5843 if (flags & JIM_ERRMSG) {
5844 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5846 return JIM_ERR;
5848 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5849 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5850 return JIM_ERR;
5852 /* Free the old internal repr and set the new one. */
5853 Jim_FreeIntRep(interp, objPtr);
5854 objPtr->typePtr = &intObjType;
5855 objPtr->internalRep.wideValue = wideValue;
5856 return JIM_OK;
5859 #ifdef JIM_OPTIMIZATION
5860 static int JimIsWide(Jim_Obj *objPtr)
5862 return objPtr->typePtr == &intObjType;
5864 #endif
5866 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5868 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5869 return JIM_ERR;
5870 *widePtr = JimWideValue(objPtr);
5871 return JIM_OK;
5874 /* Get a wide but does not set an error if the format is bad. */
5875 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5877 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5878 return JIM_ERR;
5879 *widePtr = JimWideValue(objPtr);
5880 return JIM_OK;
5883 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5885 jim_wide wideValue;
5886 int retval;
5888 retval = Jim_GetWide(interp, objPtr, &wideValue);
5889 if (retval == JIM_OK) {
5890 *longPtr = (long)wideValue;
5891 return JIM_OK;
5893 return JIM_ERR;
5896 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5898 Jim_Obj *objPtr;
5900 objPtr = Jim_NewObj(interp);
5901 objPtr->typePtr = &intObjType;
5902 objPtr->bytes = NULL;
5903 objPtr->internalRep.wideValue = wideValue;
5904 return objPtr;
5907 /* -----------------------------------------------------------------------------
5908 * Double object
5909 * ---------------------------------------------------------------------------*/
5910 #define JIM_DOUBLE_SPACE 30
5912 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5913 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5915 static const Jim_ObjType doubleObjType = {
5916 "double",
5917 NULL,
5918 NULL,
5919 UpdateStringOfDouble,
5920 JIM_TYPE_NONE,
5923 #ifndef HAVE_ISNAN
5924 #undef isnan
5925 #define isnan(X) ((X) != (X))
5926 #endif
5927 #ifndef HAVE_ISINF
5928 #undef isinf
5929 #define isinf(X) (1.0 / (X) == 0.0)
5930 #endif
5932 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5934 double value = objPtr->internalRep.doubleValue;
5936 if (isnan(value)) {
5937 JimSetStringBytes(objPtr, "NaN");
5938 return;
5940 if (isinf(value)) {
5941 if (value < 0) {
5942 JimSetStringBytes(objPtr, "-Inf");
5944 else {
5945 JimSetStringBytes(objPtr, "Inf");
5947 return;
5950 char buf[JIM_DOUBLE_SPACE + 1];
5951 int i;
5952 int len = sprintf(buf, "%.12g", value);
5954 /* Add a final ".0" if necessary */
5955 for (i = 0; i < len; i++) {
5956 if (buf[i] == '.' || buf[i] == 'e') {
5957 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5958 /* If 'buf' ends in e-0nn or e+0nn, remove
5959 * the 0 after the + or - and reduce the length by 1
5961 char *e = strchr(buf, 'e');
5962 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5963 /* Move it up */
5964 e += 2;
5965 memmove(e, e + 1, len - (e - buf));
5967 #endif
5968 break;
5971 if (buf[i] == '\0') {
5972 buf[i++] = '.';
5973 buf[i++] = '0';
5974 buf[i] = '\0';
5976 JimSetStringBytes(objPtr, buf);
5980 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5982 double doubleValue;
5983 jim_wide wideValue;
5984 const char *str;
5986 /* Preserve the string representation.
5987 * Needed so we can convert back to int without loss
5989 str = Jim_String(objPtr);
5991 #ifdef HAVE_LONG_LONG
5992 /* Assume a 53 bit mantissa */
5993 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5994 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5996 if (objPtr->typePtr == &intObjType
5997 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5998 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6000 /* Direct conversion to coerced double */
6001 objPtr->typePtr = &coercedDoubleObjType;
6002 return JIM_OK;
6004 else
6005 #endif
6006 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6007 /* Managed to convert to an int, so we can use this as a cooerced double */
6008 Jim_FreeIntRep(interp, objPtr);
6009 objPtr->typePtr = &coercedDoubleObjType;
6010 objPtr->internalRep.wideValue = wideValue;
6011 return JIM_OK;
6013 else {
6014 /* Try to convert into a double */
6015 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6016 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6017 return JIM_ERR;
6019 /* Free the old internal repr and set the new one. */
6020 Jim_FreeIntRep(interp, objPtr);
6022 objPtr->typePtr = &doubleObjType;
6023 objPtr->internalRep.doubleValue = doubleValue;
6024 return JIM_OK;
6027 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6029 if (objPtr->typePtr == &coercedDoubleObjType) {
6030 *doublePtr = JimWideValue(objPtr);
6031 return JIM_OK;
6033 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6034 return JIM_ERR;
6036 if (objPtr->typePtr == &coercedDoubleObjType) {
6037 *doublePtr = JimWideValue(objPtr);
6039 else {
6040 *doublePtr = objPtr->internalRep.doubleValue;
6042 return JIM_OK;
6045 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6047 Jim_Obj *objPtr;
6049 objPtr = Jim_NewObj(interp);
6050 objPtr->typePtr = &doubleObjType;
6051 objPtr->bytes = NULL;
6052 objPtr->internalRep.doubleValue = doubleValue;
6053 return objPtr;
6056 /* -----------------------------------------------------------------------------
6057 * Boolean conversion
6058 * ---------------------------------------------------------------------------*/
6059 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6061 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6063 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6064 return JIM_ERR;
6065 *booleanPtr = (int) JimWideValue(objPtr);
6066 return JIM_OK;
6069 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6071 static const char * const falses[] = {
6072 "0", "false", "no", "off", NULL
6074 static const char * const trues[] = {
6075 "1", "true", "yes", "on", NULL
6078 int boolean;
6080 int index;
6081 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6082 boolean = 0;
6083 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6084 boolean = 1;
6085 } else {
6086 if (flags & JIM_ERRMSG) {
6087 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6089 return JIM_ERR;
6092 /* Free the old internal repr and set the new one. */
6093 Jim_FreeIntRep(interp, objPtr);
6094 objPtr->typePtr = &intObjType;
6095 objPtr->internalRep.wideValue = boolean;
6096 return JIM_OK;
6099 /* -----------------------------------------------------------------------------
6100 * List object
6101 * ---------------------------------------------------------------------------*/
6102 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6103 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6104 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6105 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6106 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6107 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6109 /* Note that while the elements of the list may contain references,
6110 * the list object itself can't. This basically means that the
6111 * list object string representation as a whole can't contain references
6112 * that are not presents in the single elements. */
6113 static const Jim_ObjType listObjType = {
6114 "list",
6115 FreeListInternalRep,
6116 DupListInternalRep,
6117 UpdateStringOfList,
6118 JIM_TYPE_NONE,
6121 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6123 int i;
6125 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6126 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6128 Jim_Free(objPtr->internalRep.listValue.ele);
6131 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6133 int i;
6135 JIM_NOTUSED(interp);
6137 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6138 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6139 dupPtr->internalRep.listValue.ele =
6140 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6141 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6142 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6143 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6144 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6146 dupPtr->typePtr = &listObjType;
6149 /* The following function checks if a given string can be encoded
6150 * into a list element without any kind of quoting, surrounded by braces,
6151 * or using escapes to quote. */
6152 #define JIM_ELESTR_SIMPLE 0
6153 #define JIM_ELESTR_BRACE 1
6154 #define JIM_ELESTR_QUOTE 2
6155 static unsigned char ListElementQuotingType(const char *s, int len)
6157 int i, level, blevel, trySimple = 1;
6159 /* Try with the SIMPLE case */
6160 if (len == 0)
6161 return JIM_ELESTR_BRACE;
6162 if (s[0] == '"' || s[0] == '{') {
6163 trySimple = 0;
6164 goto testbrace;
6166 for (i = 0; i < len; i++) {
6167 switch (s[i]) {
6168 case ' ':
6169 case '$':
6170 case '"':
6171 case '[':
6172 case ']':
6173 case ';':
6174 case '\\':
6175 case '\r':
6176 case '\n':
6177 case '\t':
6178 case '\f':
6179 case '\v':
6180 trySimple = 0;
6181 /* fall through */
6182 case '{':
6183 case '}':
6184 goto testbrace;
6187 return JIM_ELESTR_SIMPLE;
6189 testbrace:
6190 /* Test if it's possible to do with braces */
6191 if (s[len - 1] == '\\')
6192 return JIM_ELESTR_QUOTE;
6193 level = 0;
6194 blevel = 0;
6195 for (i = 0; i < len; i++) {
6196 switch (s[i]) {
6197 case '{':
6198 level++;
6199 break;
6200 case '}':
6201 level--;
6202 if (level < 0)
6203 return JIM_ELESTR_QUOTE;
6204 break;
6205 case '[':
6206 blevel++;
6207 break;
6208 case ']':
6209 blevel--;
6210 break;
6211 case '\\':
6212 if (s[i + 1] == '\n')
6213 return JIM_ELESTR_QUOTE;
6214 else if (s[i + 1] != '\0')
6215 i++;
6216 break;
6219 if (blevel < 0) {
6220 return JIM_ELESTR_QUOTE;
6223 if (level == 0) {
6224 if (!trySimple)
6225 return JIM_ELESTR_BRACE;
6226 for (i = 0; i < len; i++) {
6227 switch (s[i]) {
6228 case ' ':
6229 case '$':
6230 case '"':
6231 case '[':
6232 case ']':
6233 case ';':
6234 case '\\':
6235 case '\r':
6236 case '\n':
6237 case '\t':
6238 case '\f':
6239 case '\v':
6240 return JIM_ELESTR_BRACE;
6241 break;
6244 return JIM_ELESTR_SIMPLE;
6246 return JIM_ELESTR_QUOTE;
6249 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6250 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6251 * scenario.
6252 * Returns the length of the result.
6254 static int BackslashQuoteString(const char *s, int len, char *q)
6256 char *p = q;
6258 while (len--) {
6259 switch (*s) {
6260 case ' ':
6261 case '$':
6262 case '"':
6263 case '[':
6264 case ']':
6265 case '{':
6266 case '}':
6267 case ';':
6268 case '\\':
6269 *p++ = '\\';
6270 *p++ = *s++;
6271 break;
6272 case '\n':
6273 *p++ = '\\';
6274 *p++ = 'n';
6275 s++;
6276 break;
6277 case '\r':
6278 *p++ = '\\';
6279 *p++ = 'r';
6280 s++;
6281 break;
6282 case '\t':
6283 *p++ = '\\';
6284 *p++ = 't';
6285 s++;
6286 break;
6287 case '\f':
6288 *p++ = '\\';
6289 *p++ = 'f';
6290 s++;
6291 break;
6292 case '\v':
6293 *p++ = '\\';
6294 *p++ = 'v';
6295 s++;
6296 break;
6297 default:
6298 *p++ = *s++;
6299 break;
6302 *p = '\0';
6304 return p - q;
6307 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6309 #define STATIC_QUOTING_LEN 32
6310 int i, bufLen, realLength;
6311 const char *strRep;
6312 char *p;
6313 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6315 /* Estimate the space needed. */
6316 if (objc > STATIC_QUOTING_LEN) {
6317 quotingType = Jim_Alloc(objc);
6319 else {
6320 quotingType = staticQuoting;
6322 bufLen = 0;
6323 for (i = 0; i < objc; i++) {
6324 int len;
6326 strRep = Jim_GetString(objv[i], &len);
6327 quotingType[i] = ListElementQuotingType(strRep, len);
6328 switch (quotingType[i]) {
6329 case JIM_ELESTR_SIMPLE:
6330 if (i != 0 || strRep[0] != '#') {
6331 bufLen += len;
6332 break;
6334 /* Special case '#' on first element needs braces */
6335 quotingType[i] = JIM_ELESTR_BRACE;
6336 /* fall through */
6337 case JIM_ELESTR_BRACE:
6338 bufLen += len + 2;
6339 break;
6340 case JIM_ELESTR_QUOTE:
6341 bufLen += len * 2;
6342 break;
6344 bufLen++; /* elements separator. */
6346 bufLen++;
6348 /* Generate the string rep. */
6349 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6350 realLength = 0;
6351 for (i = 0; i < objc; i++) {
6352 int len, qlen;
6354 strRep = Jim_GetString(objv[i], &len);
6356 switch (quotingType[i]) {
6357 case JIM_ELESTR_SIMPLE:
6358 memcpy(p, strRep, len);
6359 p += len;
6360 realLength += len;
6361 break;
6362 case JIM_ELESTR_BRACE:
6363 *p++ = '{';
6364 memcpy(p, strRep, len);
6365 p += len;
6366 *p++ = '}';
6367 realLength += len + 2;
6368 break;
6369 case JIM_ELESTR_QUOTE:
6370 if (i == 0 && strRep[0] == '#') {
6371 *p++ = '\\';
6372 realLength++;
6374 qlen = BackslashQuoteString(strRep, len, p);
6375 p += qlen;
6376 realLength += qlen;
6377 break;
6379 /* Add a separating space */
6380 if (i + 1 != objc) {
6381 *p++ = ' ';
6382 realLength++;
6385 *p = '\0'; /* nul term. */
6386 objPtr->length = realLength;
6388 if (quotingType != staticQuoting) {
6389 Jim_Free(quotingType);
6393 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6395 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6398 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6400 struct JimParserCtx parser;
6401 const char *str;
6402 int strLen;
6403 Jim_Obj *fileNameObj;
6404 int linenr;
6406 if (objPtr->typePtr == &listObjType) {
6407 return JIM_OK;
6410 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6411 * it also preserves any source location of the dict elements
6412 * which can be very useful
6414 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6415 Jim_Obj **listObjPtrPtr;
6416 int len;
6417 int i;
6419 listObjPtrPtr = JimDictPairs(objPtr, &len);
6420 for (i = 0; i < len; i++) {
6421 Jim_IncrRefCount(listObjPtrPtr[i]);
6424 /* Now just switch the internal rep */
6425 Jim_FreeIntRep(interp, objPtr);
6426 objPtr->typePtr = &listObjType;
6427 objPtr->internalRep.listValue.len = len;
6428 objPtr->internalRep.listValue.maxLen = len;
6429 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6431 return JIM_OK;
6434 /* Try to preserve information about filename / line number */
6435 if (objPtr->typePtr == &sourceObjType) {
6436 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6437 linenr = objPtr->internalRep.sourceValue.lineNumber;
6439 else {
6440 fileNameObj = interp->emptyObj;
6441 linenr = 1;
6443 Jim_IncrRefCount(fileNameObj);
6445 /* Get the string representation */
6446 str = Jim_GetString(objPtr, &strLen);
6448 /* Free the old internal repr just now and initialize the
6449 * new one just now. The string->list conversion can't fail. */
6450 Jim_FreeIntRep(interp, objPtr);
6451 objPtr->typePtr = &listObjType;
6452 objPtr->internalRep.listValue.len = 0;
6453 objPtr->internalRep.listValue.maxLen = 0;
6454 objPtr->internalRep.listValue.ele = NULL;
6456 /* Convert into a list */
6457 if (strLen) {
6458 JimParserInit(&parser, str, strLen, linenr);
6459 while (!parser.eof) {
6460 Jim_Obj *elementPtr;
6462 JimParseList(&parser);
6463 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6464 continue;
6465 elementPtr = JimParserGetTokenObj(interp, &parser);
6466 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6467 ListAppendElement(objPtr, elementPtr);
6470 Jim_DecrRefCount(interp, fileNameObj);
6471 return JIM_OK;
6474 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6476 Jim_Obj *objPtr;
6478 objPtr = Jim_NewObj(interp);
6479 objPtr->typePtr = &listObjType;
6480 objPtr->bytes = NULL;
6481 objPtr->internalRep.listValue.ele = NULL;
6482 objPtr->internalRep.listValue.len = 0;
6483 objPtr->internalRep.listValue.maxLen = 0;
6485 if (len) {
6486 ListInsertElements(objPtr, 0, len, elements);
6489 return objPtr;
6492 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6493 * length of the vector. Note that the user of this function should make
6494 * sure that the list object can't shimmer while the vector returned
6495 * is in use, this vector is the one stored inside the internal representation
6496 * of the list object. This function is not exported, extensions should
6497 * always access to the List object elements using Jim_ListIndex(). */
6498 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6499 Jim_Obj ***listVec)
6501 *listLen = Jim_ListLength(interp, listObj);
6502 *listVec = listObj->internalRep.listValue.ele;
6505 /* Sorting uses ints, but commands may return wide */
6506 static int JimSign(jim_wide w)
6508 if (w == 0) {
6509 return 0;
6511 else if (w < 0) {
6512 return -1;
6514 return 1;
6517 /* ListSortElements type values */
6518 struct lsort_info {
6519 jmp_buf jmpbuf;
6520 Jim_Obj *command;
6521 Jim_Interp *interp;
6522 enum {
6523 JIM_LSORT_ASCII,
6524 JIM_LSORT_NOCASE,
6525 JIM_LSORT_INTEGER,
6526 JIM_LSORT_REAL,
6527 JIM_LSORT_COMMAND
6528 } type;
6529 int order;
6530 int index;
6531 int indexed;
6532 int unique;
6533 int (*subfn)(Jim_Obj **, Jim_Obj **);
6536 static struct lsort_info *sort_info;
6538 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6540 Jim_Obj *lObj, *rObj;
6542 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6543 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6544 longjmp(sort_info->jmpbuf, JIM_ERR);
6546 return sort_info->subfn(&lObj, &rObj);
6549 /* Sort the internal rep of a list. */
6550 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6552 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6555 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6557 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6560 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6562 jim_wide lhs = 0, rhs = 0;
6564 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6565 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6566 longjmp(sort_info->jmpbuf, JIM_ERR);
6569 return JimSign(lhs - rhs) * sort_info->order;
6572 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6574 double lhs = 0, rhs = 0;
6576 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6577 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6578 longjmp(sort_info->jmpbuf, JIM_ERR);
6580 if (lhs == rhs) {
6581 return 0;
6583 if (lhs > rhs) {
6584 return sort_info->order;
6586 return -sort_info->order;
6589 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6591 Jim_Obj *compare_script;
6592 int rc;
6594 jim_wide ret = 0;
6596 /* This must be a valid list */
6597 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6598 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6599 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6601 rc = Jim_EvalObj(sort_info->interp, compare_script);
6603 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6604 longjmp(sort_info->jmpbuf, rc);
6607 return JimSign(ret) * sort_info->order;
6610 /* Remove duplicate elements from the (sorted) list in-place, according to the
6611 * comparison function, comp.
6613 * Note that the last unique value is kept, not the first
6615 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6617 int src;
6618 int dst = 0;
6619 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6621 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6622 if (comp(&ele[dst], &ele[src]) == 0) {
6623 /* Match, so replace the dest with the current source */
6624 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6626 else {
6627 /* No match, so keep the current source and move to the next destination */
6628 dst++;
6630 ele[dst] = ele[src];
6632 /* At end of list, keep the final element */
6633 ele[++dst] = ele[src];
6635 /* Set the new length */
6636 listObjPtr->internalRep.listValue.len = dst;
6639 /* Sort a list *in place*. MUST be called with a non-shared list. */
6640 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6642 struct lsort_info *prev_info;
6644 typedef int (qsort_comparator) (const void *, const void *);
6645 int (*fn) (Jim_Obj **, Jim_Obj **);
6646 Jim_Obj **vector;
6647 int len;
6648 int rc;
6650 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6651 SetListFromAny(interp, listObjPtr);
6653 /* Allow lsort to be called reentrantly */
6654 prev_info = sort_info;
6655 sort_info = info;
6657 vector = listObjPtr->internalRep.listValue.ele;
6658 len = listObjPtr->internalRep.listValue.len;
6659 switch (info->type) {
6660 case JIM_LSORT_ASCII:
6661 fn = ListSortString;
6662 break;
6663 case JIM_LSORT_NOCASE:
6664 fn = ListSortStringNoCase;
6665 break;
6666 case JIM_LSORT_INTEGER:
6667 fn = ListSortInteger;
6668 break;
6669 case JIM_LSORT_REAL:
6670 fn = ListSortReal;
6671 break;
6672 case JIM_LSORT_COMMAND:
6673 fn = ListSortCommand;
6674 break;
6675 default:
6676 fn = NULL; /* avoid warning */
6677 JimPanic((1, "ListSort called with invalid sort type"));
6678 return -1; /* Should not be run but keeps static analysers happy */
6681 if (info->indexed) {
6682 /* Need to interpose a "list index" function */
6683 info->subfn = fn;
6684 fn = ListSortIndexHelper;
6687 if ((rc = setjmp(info->jmpbuf)) == 0) {
6688 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6690 if (info->unique && len > 1) {
6691 ListRemoveDuplicates(listObjPtr, fn);
6694 Jim_InvalidateStringRep(listObjPtr);
6696 sort_info = prev_info;
6698 return rc;
6701 /* This is the low-level function to insert elements into a list.
6702 * The higher-level Jim_ListInsertElements() performs shared object
6703 * check and invalidates the string repr. This version is used
6704 * in the internals of the List Object and is not exported.
6706 * NOTE: this function can be called only against objects
6707 * with internal type of List.
6709 * An insertion point (idx) of -1 means end-of-list.
6711 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6713 int currentLen = listPtr->internalRep.listValue.len;
6714 int requiredLen = currentLen + elemc;
6715 int i;
6716 Jim_Obj **point;
6718 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6719 if (requiredLen < 2) {
6720 /* Don't do allocations of under 4 pointers. */
6721 requiredLen = 4;
6723 else {
6724 requiredLen *= 2;
6727 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6728 sizeof(Jim_Obj *) * requiredLen);
6730 listPtr->internalRep.listValue.maxLen = requiredLen;
6732 if (idx < 0) {
6733 idx = currentLen;
6735 point = listPtr->internalRep.listValue.ele + idx;
6736 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6737 for (i = 0; i < elemc; ++i) {
6738 point[i] = elemVec[i];
6739 Jim_IncrRefCount(point[i]);
6741 listPtr->internalRep.listValue.len += elemc;
6744 /* Convenience call to ListInsertElements() to append a single element.
6746 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6748 ListInsertElements(listPtr, -1, 1, &objPtr);
6751 /* Appends every element of appendListPtr into listPtr.
6752 * Both have to be of the list type.
6753 * Convenience call to ListInsertElements()
6755 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6757 ListInsertElements(listPtr, -1,
6758 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6761 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6763 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6764 SetListFromAny(interp, listPtr);
6765 Jim_InvalidateStringRep(listPtr);
6766 ListAppendElement(listPtr, objPtr);
6769 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6771 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6772 SetListFromAny(interp, listPtr);
6773 SetListFromAny(interp, appendListPtr);
6774 Jim_InvalidateStringRep(listPtr);
6775 ListAppendList(listPtr, appendListPtr);
6778 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6780 SetListFromAny(interp, objPtr);
6781 return objPtr->internalRep.listValue.len;
6784 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6785 int objc, Jim_Obj *const *objVec)
6787 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6788 SetListFromAny(interp, listPtr);
6789 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6790 idx = listPtr->internalRep.listValue.len;
6791 else if (idx < 0)
6792 idx = 0;
6793 Jim_InvalidateStringRep(listPtr);
6794 ListInsertElements(listPtr, idx, objc, objVec);
6797 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6799 SetListFromAny(interp, listPtr);
6800 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6801 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6802 return NULL;
6804 if (idx < 0)
6805 idx = listPtr->internalRep.listValue.len + idx;
6806 return listPtr->internalRep.listValue.ele[idx];
6809 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6811 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6812 if (*objPtrPtr == NULL) {
6813 if (flags & JIM_ERRMSG) {
6814 Jim_SetResultString(interp, "list index out of range", -1);
6816 return JIM_ERR;
6818 return JIM_OK;
6821 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6822 Jim_Obj *newObjPtr, int flags)
6824 SetListFromAny(interp, listPtr);
6825 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6826 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6827 if (flags & JIM_ERRMSG) {
6828 Jim_SetResultString(interp, "list index out of range", -1);
6830 return JIM_ERR;
6832 if (idx < 0)
6833 idx = listPtr->internalRep.listValue.len + idx;
6834 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6835 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6836 Jim_IncrRefCount(newObjPtr);
6837 return JIM_OK;
6840 /* Modify the list stored in the variable named 'varNamePtr'
6841 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6842 * with the new element 'newObjptr'. (implements the [lset] command) */
6843 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6844 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6846 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6847 int shared, i, idx;
6849 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6850 if (objPtr == NULL)
6851 return JIM_ERR;
6852 if ((shared = Jim_IsShared(objPtr)))
6853 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6854 for (i = 0; i < indexc - 1; i++) {
6855 listObjPtr = objPtr;
6856 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6857 goto err;
6858 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6859 goto err;
6861 if (Jim_IsShared(objPtr)) {
6862 objPtr = Jim_DuplicateObj(interp, objPtr);
6863 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6865 Jim_InvalidateStringRep(listObjPtr);
6867 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6868 goto err;
6869 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6870 goto err;
6871 Jim_InvalidateStringRep(objPtr);
6872 Jim_InvalidateStringRep(varObjPtr);
6873 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6874 goto err;
6875 Jim_SetResult(interp, varObjPtr);
6876 return JIM_OK;
6877 err:
6878 if (shared) {
6879 Jim_FreeNewObj(interp, varObjPtr);
6881 return JIM_ERR;
6884 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6886 int i;
6887 int listLen = Jim_ListLength(interp, listObjPtr);
6888 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6890 for (i = 0; i < listLen; ) {
6891 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6892 if (++i != listLen) {
6893 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6896 return resObjPtr;
6899 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6901 int i;
6903 /* If all the objects in objv are lists,
6904 * it's possible to return a list as result, that's the
6905 * concatenation of all the lists. */
6906 for (i = 0; i < objc; i++) {
6907 if (!Jim_IsList(objv[i]))
6908 break;
6910 if (i == objc) {
6911 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6913 for (i = 0; i < objc; i++)
6914 ListAppendList(objPtr, objv[i]);
6915 return objPtr;
6917 else {
6918 /* Else... we have to glue strings together */
6919 int len = 0, objLen;
6920 char *bytes, *p;
6922 /* Compute the length */
6923 for (i = 0; i < objc; i++) {
6924 len += Jim_Length(objv[i]);
6926 if (objc)
6927 len += objc - 1;
6928 /* Create the string rep, and a string object holding it. */
6929 p = bytes = Jim_Alloc(len + 1);
6930 for (i = 0; i < objc; i++) {
6931 const char *s = Jim_GetString(objv[i], &objLen);
6933 /* Remove leading space */
6934 while (objLen && isspace(UCHAR(*s))) {
6935 s++;
6936 objLen--;
6937 len--;
6939 /* And trailing space */
6940 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6941 /* Handle trailing backslash-space case */
6942 if (objLen > 1 && s[objLen - 2] == '\\') {
6943 break;
6945 objLen--;
6946 len--;
6948 memcpy(p, s, objLen);
6949 p += objLen;
6950 if (i + 1 != objc) {
6951 if (objLen)
6952 *p++ = ' ';
6953 else {
6954 /* Drop the space calculated for this
6955 * element that is instead null. */
6956 len--;
6960 *p = '\0';
6961 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6965 /* Returns a list composed of the elements in the specified range.
6966 * first and start are directly accepted as Jim_Objects and
6967 * processed for the end?-index? case. */
6968 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6969 Jim_Obj *lastObjPtr)
6971 int first, last;
6972 int len, rangeLen;
6974 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6975 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6976 return NULL;
6977 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6978 first = JimRelToAbsIndex(len, first);
6979 last = JimRelToAbsIndex(len, last);
6980 JimRelToAbsRange(len, &first, &last, &rangeLen);
6981 if (first == 0 && last == len) {
6982 return listObjPtr;
6984 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6987 /* -----------------------------------------------------------------------------
6988 * Dict object
6989 * ---------------------------------------------------------------------------*/
6990 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6991 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6992 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6993 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6995 /* Dict HashTable Type.
6997 * Keys and Values are Jim objects. */
6999 static unsigned int JimObjectHTHashFunction(const void *key)
7001 int len;
7002 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7003 return Jim_GenHashFunction((const unsigned char *)str, len);
7006 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7008 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7011 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7013 Jim_IncrRefCount((Jim_Obj *)val);
7014 return (void *)val;
7017 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7019 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7022 static const Jim_HashTableType JimDictHashTableType = {
7023 JimObjectHTHashFunction, /* hash function */
7024 JimObjectHTKeyValDup, /* key dup */
7025 JimObjectHTKeyValDup, /* val dup */
7026 JimObjectHTKeyCompare, /* key compare */
7027 JimObjectHTKeyValDestructor, /* key destructor */
7028 JimObjectHTKeyValDestructor /* val destructor */
7031 /* Note that while the elements of the dict may contain references,
7032 * the list object itself can't. This basically means that the
7033 * dict object string representation as a whole can't contain references
7034 * that are not presents in the single elements. */
7035 static const Jim_ObjType dictObjType = {
7036 "dict",
7037 FreeDictInternalRep,
7038 DupDictInternalRep,
7039 UpdateStringOfDict,
7040 JIM_TYPE_NONE,
7043 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7045 JIM_NOTUSED(interp);
7047 Jim_FreeHashTable(objPtr->internalRep.ptr);
7048 Jim_Free(objPtr->internalRep.ptr);
7051 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7053 Jim_HashTable *ht, *dupHt;
7054 Jim_HashTableIterator htiter;
7055 Jim_HashEntry *he;
7057 /* Create a new hash table */
7058 ht = srcPtr->internalRep.ptr;
7059 dupHt = Jim_Alloc(sizeof(*dupHt));
7060 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7061 if (ht->size != 0)
7062 Jim_ExpandHashTable(dupHt, ht->size);
7063 /* Copy every element from the source to the dup hash table */
7064 JimInitHashTableIterator(ht, &htiter);
7065 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7066 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7069 dupPtr->internalRep.ptr = dupHt;
7070 dupPtr->typePtr = &dictObjType;
7073 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7075 Jim_HashTable *ht;
7076 Jim_HashTableIterator htiter;
7077 Jim_HashEntry *he;
7078 Jim_Obj **objv;
7079 int i;
7081 ht = dictPtr->internalRep.ptr;
7083 /* Turn the hash table into a flat vector of Jim_Objects. */
7084 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7085 JimInitHashTableIterator(ht, &htiter);
7086 i = 0;
7087 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7088 objv[i++] = Jim_GetHashEntryKey(he);
7089 objv[i++] = Jim_GetHashEntryVal(he);
7091 *len = i;
7092 return objv;
7095 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7097 /* Turn the hash table into a flat vector of Jim_Objects. */
7098 int len;
7099 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7101 /* And now generate the string rep as a list */
7102 JimMakeListStringRep(objPtr, objv, len);
7104 Jim_Free(objv);
7107 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7109 int listlen;
7111 if (objPtr->typePtr == &dictObjType) {
7112 return JIM_OK;
7115 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7116 /* A shared list, so get the string representation now to avoid
7117 * changing the order in case of fast conversion to dict.
7119 Jim_String(objPtr);
7122 /* For simplicity, convert a non-list object to a list and then to a dict */
7123 listlen = Jim_ListLength(interp, objPtr);
7124 if (listlen % 2) {
7125 Jim_SetResultString(interp, "missing value to go with key", -1);
7126 return JIM_ERR;
7128 else {
7129 /* Converting from a list to a dict can't fail */
7130 Jim_HashTable *ht;
7131 int i;
7133 ht = Jim_Alloc(sizeof(*ht));
7134 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7136 for (i = 0; i < listlen; i += 2) {
7137 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7138 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7140 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7143 Jim_FreeIntRep(interp, objPtr);
7144 objPtr->typePtr = &dictObjType;
7145 objPtr->internalRep.ptr = ht;
7147 return JIM_OK;
7151 /* Dict object API */
7153 /* Add an element to a dict. objPtr must be of the "dict" type.
7154 * The higher-level exported function is Jim_DictAddElement().
7155 * If an element with the specified key already exists, the value
7156 * associated is replaced with the new one.
7158 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7159 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7160 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7162 Jim_HashTable *ht = objPtr->internalRep.ptr;
7164 if (valueObjPtr == NULL) { /* unset */
7165 return Jim_DeleteHashEntry(ht, keyObjPtr);
7167 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7168 return JIM_OK;
7171 /* Add an element, higher-level interface for DictAddElement().
7172 * If valueObjPtr == NULL, the key is removed if it exists. */
7173 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7174 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7176 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7177 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7178 return JIM_ERR;
7180 Jim_InvalidateStringRep(objPtr);
7181 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7184 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7186 Jim_Obj *objPtr;
7187 int i;
7189 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7191 objPtr = Jim_NewObj(interp);
7192 objPtr->typePtr = &dictObjType;
7193 objPtr->bytes = NULL;
7194 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7195 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7196 for (i = 0; i < len; i += 2)
7197 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7198 return objPtr;
7201 /* Return the value associated to the specified dict key
7202 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7204 * Sets *objPtrPtr to non-NULL only upon success.
7206 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7207 Jim_Obj **objPtrPtr, int flags)
7209 Jim_HashEntry *he;
7210 Jim_HashTable *ht;
7212 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7213 return -1;
7215 ht = dictPtr->internalRep.ptr;
7216 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7217 if (flags & JIM_ERRMSG) {
7218 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7220 return JIM_ERR;
7222 *objPtrPtr = he->u.val;
7223 return JIM_OK;
7226 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7227 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7229 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7230 return JIM_ERR;
7232 *objPtrPtr = JimDictPairs(dictPtr, len);
7234 return JIM_OK;
7238 /* Return the value associated to the specified dict keys */
7239 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7240 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7242 int i;
7244 if (keyc == 0) {
7245 *objPtrPtr = dictPtr;
7246 return JIM_OK;
7249 for (i = 0; i < keyc; i++) {
7250 Jim_Obj *objPtr;
7252 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7253 if (rc != JIM_OK) {
7254 return rc;
7256 dictPtr = objPtr;
7258 *objPtrPtr = dictPtr;
7259 return JIM_OK;
7262 /* Modify the dict stored into the variable named 'varNamePtr'
7263 * setting the element specified by the 'keyc' keys objects in 'keyv',
7264 * with the new value of the element 'newObjPtr'.
7266 * If newObjPtr == NULL the operation is to remove the given key
7267 * from the dictionary.
7269 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7270 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7272 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7273 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7275 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7276 int shared, i;
7278 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7279 if (objPtr == NULL) {
7280 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7281 /* Cannot remove a key from non existing var */
7282 return JIM_ERR;
7284 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7285 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7286 Jim_FreeNewObj(interp, varObjPtr);
7287 return JIM_ERR;
7290 if ((shared = Jim_IsShared(objPtr)))
7291 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7292 for (i = 0; i < keyc; i++) {
7293 dictObjPtr = objPtr;
7295 /* Check if it's a valid dictionary */
7296 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7297 goto err;
7300 if (i == keyc - 1) {
7301 /* Last key: Note that error on unset with missing last key is OK */
7302 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7303 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7304 goto err;
7307 break;
7310 /* Check if the given key exists. */
7311 Jim_InvalidateStringRep(dictObjPtr);
7312 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7313 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7314 /* This key exists at the current level.
7315 * Make sure it's not shared!. */
7316 if (Jim_IsShared(objPtr)) {
7317 objPtr = Jim_DuplicateObj(interp, objPtr);
7318 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7321 else {
7322 /* Key not found. If it's an [unset] operation
7323 * this is an error. Only the last key may not
7324 * exist. */
7325 if (newObjPtr == NULL) {
7326 goto err;
7328 /* Otherwise set an empty dictionary
7329 * as key's value. */
7330 objPtr = Jim_NewDictObj(interp, NULL, 0);
7331 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7334 /* XXX: Is this necessary? */
7335 Jim_InvalidateStringRep(objPtr);
7336 Jim_InvalidateStringRep(varObjPtr);
7337 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7338 goto err;
7340 Jim_SetResult(interp, varObjPtr);
7341 return JIM_OK;
7342 err:
7343 if (shared) {
7344 Jim_FreeNewObj(interp, varObjPtr);
7346 return JIM_ERR;
7349 /* -----------------------------------------------------------------------------
7350 * Index object
7351 * ---------------------------------------------------------------------------*/
7352 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7353 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7355 static const Jim_ObjType indexObjType = {
7356 "index",
7357 NULL,
7358 NULL,
7359 UpdateStringOfIndex,
7360 JIM_TYPE_NONE,
7363 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7365 if (objPtr->internalRep.intValue == -1) {
7366 JimSetStringBytes(objPtr, "end");
7368 else {
7369 char buf[JIM_INTEGER_SPACE + 1];
7370 if (objPtr->internalRep.intValue >= 0) {
7371 sprintf(buf, "%d", objPtr->internalRep.intValue);
7373 else {
7374 /* Must be <= -2 */
7375 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7377 JimSetStringBytes(objPtr, buf);
7381 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7383 int idx, end = 0;
7384 const char *str;
7385 char *endptr;
7387 /* Get the string representation */
7388 str = Jim_String(objPtr);
7390 /* Try to convert into an index */
7391 if (strncmp(str, "end", 3) == 0) {
7392 end = 1;
7393 str += 3;
7394 idx = 0;
7396 else {
7397 idx = jim_strtol(str, &endptr);
7399 if (endptr == str) {
7400 goto badindex;
7402 str = endptr;
7405 /* Now str may include or +<num> or -<num> */
7406 if (*str == '+' || *str == '-') {
7407 int sign = (*str == '+' ? 1 : -1);
7409 idx += sign * jim_strtol(++str, &endptr);
7410 if (str == endptr || *endptr) {
7411 goto badindex;
7413 str = endptr;
7415 /* The only thing left should be spaces */
7416 while (isspace(UCHAR(*str))) {
7417 str++;
7419 if (*str) {
7420 goto badindex;
7422 if (end) {
7423 if (idx > 0) {
7424 idx = INT_MAX;
7426 else {
7427 /* end-1 is repesented as -2 */
7428 idx--;
7431 else if (idx < 0) {
7432 idx = -INT_MAX;
7435 /* Free the old internal repr and set the new one. */
7436 Jim_FreeIntRep(interp, objPtr);
7437 objPtr->typePtr = &indexObjType;
7438 objPtr->internalRep.intValue = idx;
7439 return JIM_OK;
7441 badindex:
7442 Jim_SetResultFormatted(interp,
7443 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7444 return JIM_ERR;
7447 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7449 /* Avoid shimmering if the object is an integer. */
7450 if (objPtr->typePtr == &intObjType) {
7451 jim_wide val = JimWideValue(objPtr);
7453 if (val < 0)
7454 *indexPtr = -INT_MAX;
7455 else if (val > INT_MAX)
7456 *indexPtr = INT_MAX;
7457 else
7458 *indexPtr = (int)val;
7459 return JIM_OK;
7461 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7462 return JIM_ERR;
7463 *indexPtr = objPtr->internalRep.intValue;
7464 return JIM_OK;
7467 /* -----------------------------------------------------------------------------
7468 * Return Code Object.
7469 * ---------------------------------------------------------------------------*/
7471 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7472 static const char * const jimReturnCodes[] = {
7473 "ok",
7474 "error",
7475 "return",
7476 "break",
7477 "continue",
7478 "signal",
7479 "exit",
7480 "eval",
7481 NULL
7484 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7486 static const Jim_ObjType returnCodeObjType = {
7487 "return-code",
7488 NULL,
7489 NULL,
7490 NULL,
7491 JIM_TYPE_NONE,
7494 /* Converts a (standard) return code to a string. Returns "?" for
7495 * non-standard return codes.
7497 const char *Jim_ReturnCode(int code)
7499 if (code < 0 || code >= (int)jimReturnCodesSize) {
7500 return "?";
7502 else {
7503 return jimReturnCodes[code];
7507 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7509 int returnCode;
7510 jim_wide wideValue;
7512 /* Try to convert into an integer */
7513 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7514 returnCode = (int)wideValue;
7515 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7516 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7517 return JIM_ERR;
7519 /* Free the old internal repr and set the new one. */
7520 Jim_FreeIntRep(interp, objPtr);
7521 objPtr->typePtr = &returnCodeObjType;
7522 objPtr->internalRep.intValue = returnCode;
7523 return JIM_OK;
7526 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7528 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7529 return JIM_ERR;
7530 *intPtr = objPtr->internalRep.intValue;
7531 return JIM_OK;
7534 /* -----------------------------------------------------------------------------
7535 * Expression Parsing
7536 * ---------------------------------------------------------------------------*/
7537 static int JimParseExprOperator(struct JimParserCtx *pc);
7538 static int JimParseExprNumber(struct JimParserCtx *pc);
7539 static int JimParseExprIrrational(struct JimParserCtx *pc);
7540 static int JimParseExprBoolean(struct JimParserCtx *pc);
7542 /* Exrp's Stack machine operators opcodes. */
7544 /* Binary operators (numbers) */
7545 enum
7547 /* Continues on from the JIM_TT_ space */
7548 /* Operations */
7549 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7550 JIM_EXPROP_DIV,
7551 JIM_EXPROP_MOD,
7552 JIM_EXPROP_SUB,
7553 JIM_EXPROP_ADD,
7554 JIM_EXPROP_LSHIFT,
7555 JIM_EXPROP_RSHIFT,
7556 JIM_EXPROP_ROTL,
7557 JIM_EXPROP_ROTR,
7558 JIM_EXPROP_LT,
7559 JIM_EXPROP_GT,
7560 JIM_EXPROP_LTE,
7561 JIM_EXPROP_GTE,
7562 JIM_EXPROP_NUMEQ,
7563 JIM_EXPROP_NUMNE,
7564 JIM_EXPROP_BITAND, /* 35 */
7565 JIM_EXPROP_BITXOR,
7566 JIM_EXPROP_BITOR,
7568 /* Note must keep these together */
7569 JIM_EXPROP_LOGICAND, /* 38 */
7570 JIM_EXPROP_LOGICAND_LEFT,
7571 JIM_EXPROP_LOGICAND_RIGHT,
7573 /* and these */
7574 JIM_EXPROP_LOGICOR, /* 41 */
7575 JIM_EXPROP_LOGICOR_LEFT,
7576 JIM_EXPROP_LOGICOR_RIGHT,
7578 /* and these */
7579 /* Ternary operators */
7580 JIM_EXPROP_TERNARY, /* 44 */
7581 JIM_EXPROP_TERNARY_LEFT,
7582 JIM_EXPROP_TERNARY_RIGHT,
7584 /* and these */
7585 JIM_EXPROP_COLON, /* 47 */
7586 JIM_EXPROP_COLON_LEFT,
7587 JIM_EXPROP_COLON_RIGHT,
7589 JIM_EXPROP_POW, /* 50 */
7591 /* Binary operators (strings) */
7592 JIM_EXPROP_STREQ, /* 51 */
7593 JIM_EXPROP_STRNE,
7594 JIM_EXPROP_STRIN,
7595 JIM_EXPROP_STRNI,
7597 /* Unary operators (numbers) */
7598 JIM_EXPROP_NOT, /* 55 */
7599 JIM_EXPROP_BITNOT,
7600 JIM_EXPROP_UNARYMINUS,
7601 JIM_EXPROP_UNARYPLUS,
7603 /* Functions */
7604 JIM_EXPROP_FUNC_FIRST, /* 59 */
7605 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7606 JIM_EXPROP_FUNC_WIDE,
7607 JIM_EXPROP_FUNC_ABS,
7608 JIM_EXPROP_FUNC_DOUBLE,
7609 JIM_EXPROP_FUNC_ROUND,
7610 JIM_EXPROP_FUNC_RAND,
7611 JIM_EXPROP_FUNC_SRAND,
7613 /* math functions from libm */
7614 JIM_EXPROP_FUNC_SIN, /* 65 */
7615 JIM_EXPROP_FUNC_COS,
7616 JIM_EXPROP_FUNC_TAN,
7617 JIM_EXPROP_FUNC_ASIN,
7618 JIM_EXPROP_FUNC_ACOS,
7619 JIM_EXPROP_FUNC_ATAN,
7620 JIM_EXPROP_FUNC_ATAN2,
7621 JIM_EXPROP_FUNC_SINH,
7622 JIM_EXPROP_FUNC_COSH,
7623 JIM_EXPROP_FUNC_TANH,
7624 JIM_EXPROP_FUNC_CEIL,
7625 JIM_EXPROP_FUNC_FLOOR,
7626 JIM_EXPROP_FUNC_EXP,
7627 JIM_EXPROP_FUNC_LOG,
7628 JIM_EXPROP_FUNC_LOG10,
7629 JIM_EXPROP_FUNC_SQRT,
7630 JIM_EXPROP_FUNC_POW,
7631 JIM_EXPROP_FUNC_HYPOT,
7632 JIM_EXPROP_FUNC_FMOD,
7635 struct JimExprState
7637 Jim_Obj **stack;
7638 int stacklen;
7639 int opcode;
7640 int skip;
7643 /* Operators table */
7644 typedef struct Jim_ExprOperator
7646 const char *name;
7647 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7648 unsigned char precedence;
7649 unsigned char arity;
7650 unsigned char lazy;
7651 unsigned char namelen;
7652 } Jim_ExprOperator;
7654 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7656 Jim_IncrRefCount(obj);
7657 e->stack[e->stacklen++] = obj;
7660 static Jim_Obj *ExprPop(struct JimExprState *e)
7662 return e->stack[--e->stacklen];
7665 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7667 int intresult = 1;
7668 int rc = JIM_OK;
7669 Jim_Obj *A = ExprPop(e);
7670 double dA, dC = 0;
7671 jim_wide wA, wC = 0;
7673 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7674 switch (e->opcode) {
7675 case JIM_EXPROP_FUNC_INT:
7676 case JIM_EXPROP_FUNC_WIDE:
7677 case JIM_EXPROP_FUNC_ROUND:
7678 case JIM_EXPROP_UNARYPLUS:
7679 wC = wA;
7680 break;
7681 case JIM_EXPROP_FUNC_DOUBLE:
7682 dC = wA;
7683 intresult = 0;
7684 break;
7685 case JIM_EXPROP_FUNC_ABS:
7686 wC = wA >= 0 ? wA : -wA;
7687 break;
7688 case JIM_EXPROP_UNARYMINUS:
7689 wC = -wA;
7690 break;
7691 case JIM_EXPROP_NOT:
7692 wC = !wA;
7693 break;
7694 default:
7695 abort();
7698 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7699 switch (e->opcode) {
7700 case JIM_EXPROP_FUNC_INT:
7701 case JIM_EXPROP_FUNC_WIDE:
7702 wC = dA;
7703 break;
7704 case JIM_EXPROP_FUNC_ROUND:
7705 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7706 break;
7707 case JIM_EXPROP_FUNC_DOUBLE:
7708 case JIM_EXPROP_UNARYPLUS:
7709 dC = dA;
7710 intresult = 0;
7711 break;
7712 case JIM_EXPROP_FUNC_ABS:
7713 dC = dA >= 0 ? dA : -dA;
7714 intresult = 0;
7715 break;
7716 case JIM_EXPROP_UNARYMINUS:
7717 dC = -dA;
7718 intresult = 0;
7719 break;
7720 case JIM_EXPROP_NOT:
7721 wC = !dA;
7722 break;
7723 default:
7724 abort();
7728 if (rc == JIM_OK) {
7729 if (intresult) {
7730 ExprPush(e, Jim_NewIntObj(interp, wC));
7732 else {
7733 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7737 Jim_DecrRefCount(interp, A);
7739 return rc;
7742 static double JimRandDouble(Jim_Interp *interp)
7744 unsigned long x;
7745 JimRandomBytes(interp, &x, sizeof(x));
7747 return (double)x / (unsigned long)~0;
7750 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7752 Jim_Obj *A = ExprPop(e);
7753 jim_wide wA;
7755 int rc = Jim_GetWide(interp, A, &wA);
7756 if (rc == JIM_OK) {
7757 switch (e->opcode) {
7758 case JIM_EXPROP_BITNOT:
7759 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7760 break;
7761 case JIM_EXPROP_FUNC_SRAND:
7762 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7763 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7764 break;
7765 default:
7766 abort();
7770 Jim_DecrRefCount(interp, A);
7772 return rc;
7775 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7777 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7779 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7781 return JIM_OK;
7784 #ifdef JIM_MATH_FUNCTIONS
7785 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7787 int rc;
7788 Jim_Obj *A = ExprPop(e);
7789 double dA, dC;
7791 rc = Jim_GetDouble(interp, A, &dA);
7792 if (rc == JIM_OK) {
7793 switch (e->opcode) {
7794 case JIM_EXPROP_FUNC_SIN:
7795 dC = sin(dA);
7796 break;
7797 case JIM_EXPROP_FUNC_COS:
7798 dC = cos(dA);
7799 break;
7800 case JIM_EXPROP_FUNC_TAN:
7801 dC = tan(dA);
7802 break;
7803 case JIM_EXPROP_FUNC_ASIN:
7804 dC = asin(dA);
7805 break;
7806 case JIM_EXPROP_FUNC_ACOS:
7807 dC = acos(dA);
7808 break;
7809 case JIM_EXPROP_FUNC_ATAN:
7810 dC = atan(dA);
7811 break;
7812 case JIM_EXPROP_FUNC_SINH:
7813 dC = sinh(dA);
7814 break;
7815 case JIM_EXPROP_FUNC_COSH:
7816 dC = cosh(dA);
7817 break;
7818 case JIM_EXPROP_FUNC_TANH:
7819 dC = tanh(dA);
7820 break;
7821 case JIM_EXPROP_FUNC_CEIL:
7822 dC = ceil(dA);
7823 break;
7824 case JIM_EXPROP_FUNC_FLOOR:
7825 dC = floor(dA);
7826 break;
7827 case JIM_EXPROP_FUNC_EXP:
7828 dC = exp(dA);
7829 break;
7830 case JIM_EXPROP_FUNC_LOG:
7831 dC = log(dA);
7832 break;
7833 case JIM_EXPROP_FUNC_LOG10:
7834 dC = log10(dA);
7835 break;
7836 case JIM_EXPROP_FUNC_SQRT:
7837 dC = sqrt(dA);
7838 break;
7839 default:
7840 abort();
7842 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7845 Jim_DecrRefCount(interp, A);
7847 return rc;
7849 #endif
7851 /* A binary operation on two ints */
7852 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7854 Jim_Obj *B = ExprPop(e);
7855 Jim_Obj *A = ExprPop(e);
7856 jim_wide wA, wB;
7857 int rc = JIM_ERR;
7859 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7860 jim_wide wC;
7862 rc = JIM_OK;
7864 switch (e->opcode) {
7865 case JIM_EXPROP_LSHIFT:
7866 wC = wA << wB;
7867 break;
7868 case JIM_EXPROP_RSHIFT:
7869 wC = wA >> wB;
7870 break;
7871 case JIM_EXPROP_BITAND:
7872 wC = wA & wB;
7873 break;
7874 case JIM_EXPROP_BITXOR:
7875 wC = wA ^ wB;
7876 break;
7877 case JIM_EXPROP_BITOR:
7878 wC = wA | wB;
7879 break;
7880 case JIM_EXPROP_MOD:
7881 if (wB == 0) {
7882 wC = 0;
7883 Jim_SetResultString(interp, "Division by zero", -1);
7884 rc = JIM_ERR;
7886 else {
7888 * From Tcl 8.x
7890 * This code is tricky: C doesn't guarantee much
7891 * about the quotient or remainder, but Tcl does.
7892 * The remainder always has the same sign as the
7893 * divisor and a smaller absolute value.
7895 int negative = 0;
7897 if (wB < 0) {
7898 wB = -wB;
7899 wA = -wA;
7900 negative = 1;
7902 wC = wA % wB;
7903 if (wC < 0) {
7904 wC += wB;
7906 if (negative) {
7907 wC = -wC;
7910 break;
7911 case JIM_EXPROP_ROTL:
7912 case JIM_EXPROP_ROTR:{
7913 /* uint32_t would be better. But not everyone has inttypes.h? */
7914 unsigned long uA = (unsigned long)wA;
7915 unsigned long uB = (unsigned long)wB;
7916 const unsigned int S = sizeof(unsigned long) * 8;
7918 /* Shift left by the word size or more is undefined. */
7919 uB %= S;
7921 if (e->opcode == JIM_EXPROP_ROTR) {
7922 uB = S - uB;
7924 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7925 break;
7927 default:
7928 abort();
7930 ExprPush(e, Jim_NewIntObj(interp, wC));
7934 Jim_DecrRefCount(interp, A);
7935 Jim_DecrRefCount(interp, B);
7937 return rc;
7941 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7942 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7944 int rc = JIM_OK;
7945 double dA, dB, dC = 0;
7946 jim_wide wA, wB, wC = 0;
7948 Jim_Obj *B = ExprPop(e);
7949 Jim_Obj *A = ExprPop(e);
7951 if ((A->typePtr != &doubleObjType || A->bytes) &&
7952 (B->typePtr != &doubleObjType || B->bytes) &&
7953 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7955 /* Both are ints */
7957 switch (e->opcode) {
7958 case JIM_EXPROP_POW:
7959 case JIM_EXPROP_FUNC_POW:
7960 wC = JimPowWide(wA, wB);
7961 goto intresult;
7962 case JIM_EXPROP_ADD:
7963 wC = wA + wB;
7964 goto intresult;
7965 case JIM_EXPROP_SUB:
7966 wC = wA - wB;
7967 goto intresult;
7968 case JIM_EXPROP_MUL:
7969 wC = wA * wB;
7970 goto intresult;
7971 case JIM_EXPROP_DIV:
7972 if (wB == 0) {
7973 Jim_SetResultString(interp, "Division by zero", -1);
7974 rc = JIM_ERR;
7975 goto done;
7977 else {
7979 * From Tcl 8.x
7981 * This code is tricky: C doesn't guarantee much
7982 * about the quotient or remainder, but Tcl does.
7983 * The remainder always has the same sign as the
7984 * divisor and a smaller absolute value.
7986 if (wB < 0) {
7987 wB = -wB;
7988 wA = -wA;
7990 wC = wA / wB;
7991 if (wA % wB < 0) {
7992 wC--;
7994 goto intresult;
7996 case JIM_EXPROP_LT:
7997 wC = wA < wB;
7998 goto intresult;
7999 case JIM_EXPROP_GT:
8000 wC = wA > wB;
8001 goto intresult;
8002 case JIM_EXPROP_LTE:
8003 wC = wA <= wB;
8004 goto intresult;
8005 case JIM_EXPROP_GTE:
8006 wC = wA >= wB;
8007 goto intresult;
8008 case JIM_EXPROP_NUMEQ:
8009 wC = wA == wB;
8010 goto intresult;
8011 case JIM_EXPROP_NUMNE:
8012 wC = wA != wB;
8013 goto intresult;
8016 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8017 switch (e->opcode) {
8018 #ifndef JIM_MATH_FUNCTIONS
8019 case JIM_EXPROP_POW:
8020 case JIM_EXPROP_FUNC_POW:
8021 case JIM_EXPROP_FUNC_ATAN2:
8022 case JIM_EXPROP_FUNC_HYPOT:
8023 case JIM_EXPROP_FUNC_FMOD:
8024 Jim_SetResultString(interp, "unsupported", -1);
8025 rc = JIM_ERR;
8026 goto done;
8027 #else
8028 case JIM_EXPROP_POW:
8029 case JIM_EXPROP_FUNC_POW:
8030 dC = pow(dA, dB);
8031 goto doubleresult;
8032 case JIM_EXPROP_FUNC_ATAN2:
8033 dC = atan2(dA, dB);
8034 goto doubleresult;
8035 case JIM_EXPROP_FUNC_HYPOT:
8036 dC = hypot(dA, dB);
8037 goto doubleresult;
8038 case JIM_EXPROP_FUNC_FMOD:
8039 dC = fmod(dA, dB);
8040 goto doubleresult;
8041 #endif
8042 case JIM_EXPROP_ADD:
8043 dC = dA + dB;
8044 goto doubleresult;
8045 case JIM_EXPROP_SUB:
8046 dC = dA - dB;
8047 goto doubleresult;
8048 case JIM_EXPROP_MUL:
8049 dC = dA * dB;
8050 goto doubleresult;
8051 case JIM_EXPROP_DIV:
8052 if (dB == 0) {
8053 #ifdef INFINITY
8054 dC = dA < 0 ? -INFINITY : INFINITY;
8055 #else
8056 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8057 #endif
8059 else {
8060 dC = dA / dB;
8062 goto doubleresult;
8063 case JIM_EXPROP_LT:
8064 wC = dA < dB;
8065 goto intresult;
8066 case JIM_EXPROP_GT:
8067 wC = dA > dB;
8068 goto intresult;
8069 case JIM_EXPROP_LTE:
8070 wC = dA <= dB;
8071 goto intresult;
8072 case JIM_EXPROP_GTE:
8073 wC = dA >= dB;
8074 goto intresult;
8075 case JIM_EXPROP_NUMEQ:
8076 wC = dA == dB;
8077 goto intresult;
8078 case JIM_EXPROP_NUMNE:
8079 wC = dA != dB;
8080 goto intresult;
8083 else {
8084 /* Handle the string case */
8086 /* XXX: Could optimise the eq/ne case by checking lengths */
8087 int i = Jim_StringCompareObj(interp, A, B, 0);
8089 switch (e->opcode) {
8090 case JIM_EXPROP_LT:
8091 wC = i < 0;
8092 goto intresult;
8093 case JIM_EXPROP_GT:
8094 wC = i > 0;
8095 goto intresult;
8096 case JIM_EXPROP_LTE:
8097 wC = i <= 0;
8098 goto intresult;
8099 case JIM_EXPROP_GTE:
8100 wC = i >= 0;
8101 goto intresult;
8102 case JIM_EXPROP_NUMEQ:
8103 wC = i == 0;
8104 goto intresult;
8105 case JIM_EXPROP_NUMNE:
8106 wC = i != 0;
8107 goto intresult;
8110 /* If we get here, it is an error */
8111 rc = JIM_ERR;
8112 done:
8113 Jim_DecrRefCount(interp, A);
8114 Jim_DecrRefCount(interp, B);
8115 return rc;
8116 intresult:
8117 ExprPush(e, Jim_NewIntObj(interp, wC));
8118 goto done;
8119 doubleresult:
8120 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8121 goto done;
8124 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8126 int listlen;
8127 int i;
8129 listlen = Jim_ListLength(interp, listObjPtr);
8130 for (i = 0; i < listlen; i++) {
8131 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8132 return 1;
8135 return 0;
8138 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8140 Jim_Obj *B = ExprPop(e);
8141 Jim_Obj *A = ExprPop(e);
8143 jim_wide wC;
8145 switch (e->opcode) {
8146 case JIM_EXPROP_STREQ:
8147 case JIM_EXPROP_STRNE:
8148 wC = Jim_StringEqObj(A, B);
8149 if (e->opcode == JIM_EXPROP_STRNE) {
8150 wC = !wC;
8152 break;
8153 case JIM_EXPROP_STRIN:
8154 wC = JimSearchList(interp, B, A);
8155 break;
8156 case JIM_EXPROP_STRNI:
8157 wC = !JimSearchList(interp, B, A);
8158 break;
8159 default:
8160 abort();
8162 ExprPush(e, Jim_NewIntObj(interp, wC));
8164 Jim_DecrRefCount(interp, A);
8165 Jim_DecrRefCount(interp, B);
8167 return JIM_OK;
8170 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8172 long l;
8173 double d;
8174 int b;
8176 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8177 return l != 0;
8179 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8180 return d != 0;
8182 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8183 return b != 0;
8185 return -1;
8188 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8190 Jim_Obj *skip = ExprPop(e);
8191 Jim_Obj *A = ExprPop(e);
8192 int rc = JIM_OK;
8194 switch (ExprBool(interp, A)) {
8195 case 0:
8196 /* false, so skip RHS opcodes with a 0 result */
8197 e->skip = JimWideValue(skip);
8198 ExprPush(e, Jim_NewIntObj(interp, 0));
8199 break;
8201 case 1:
8202 /* true so continue */
8203 break;
8205 case -1:
8206 /* Invalid */
8207 rc = JIM_ERR;
8209 Jim_DecrRefCount(interp, A);
8210 Jim_DecrRefCount(interp, skip);
8212 return rc;
8215 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8217 Jim_Obj *skip = ExprPop(e);
8218 Jim_Obj *A = ExprPop(e);
8219 int rc = JIM_OK;
8221 switch (ExprBool(interp, A)) {
8222 case 0:
8223 /* false, so do nothing */
8224 break;
8226 case 1:
8227 /* true so skip RHS opcodes with a 1 result */
8228 e->skip = JimWideValue(skip);
8229 ExprPush(e, Jim_NewIntObj(interp, 1));
8230 break;
8232 case -1:
8233 /* Invalid */
8234 rc = JIM_ERR;
8235 break;
8237 Jim_DecrRefCount(interp, A);
8238 Jim_DecrRefCount(interp, skip);
8240 return rc;
8243 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8245 Jim_Obj *A = ExprPop(e);
8246 int rc = JIM_OK;
8248 switch (ExprBool(interp, A)) {
8249 case 0:
8250 ExprPush(e, Jim_NewIntObj(interp, 0));
8251 break;
8253 case 1:
8254 ExprPush(e, Jim_NewIntObj(interp, 1));
8255 break;
8257 case -1:
8258 /* Invalid */
8259 rc = JIM_ERR;
8260 break;
8262 Jim_DecrRefCount(interp, A);
8264 return rc;
8267 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8269 Jim_Obj *skip = ExprPop(e);
8270 Jim_Obj *A = ExprPop(e);
8271 int rc = JIM_OK;
8273 /* Repush A */
8274 ExprPush(e, A);
8276 switch (ExprBool(interp, A)) {
8277 case 0:
8278 /* false, skip RHS opcodes */
8279 e->skip = JimWideValue(skip);
8280 /* Push a dummy value */
8281 ExprPush(e, Jim_NewIntObj(interp, 0));
8282 break;
8284 case 1:
8285 /* true so do nothing */
8286 break;
8288 case -1:
8289 /* Invalid */
8290 rc = JIM_ERR;
8291 break;
8293 Jim_DecrRefCount(interp, A);
8294 Jim_DecrRefCount(interp, skip);
8296 return rc;
8299 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8301 Jim_Obj *skip = ExprPop(e);
8302 Jim_Obj *B = ExprPop(e);
8303 Jim_Obj *A = ExprPop(e);
8305 /* No need to check for A as non-boolean */
8306 if (ExprBool(interp, A)) {
8307 /* true, so skip RHS opcodes */
8308 e->skip = JimWideValue(skip);
8309 /* Repush B as the answer */
8310 ExprPush(e, B);
8313 Jim_DecrRefCount(interp, skip);
8314 Jim_DecrRefCount(interp, A);
8315 Jim_DecrRefCount(interp, B);
8316 return JIM_OK;
8319 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8321 return JIM_OK;
8324 enum
8326 LAZY_NONE,
8327 LAZY_OP,
8328 LAZY_LEFT,
8329 LAZY_RIGHT
8332 /* name - precedence - arity - opcode
8334 * This array *must* be kept in sync with the JIM_EXPROP enum.
8336 * The following macros pre-compute the string length at compile time.
8338 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8339 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8341 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8342 OPRINIT("*", 110, 2, JimExprOpBin),
8343 OPRINIT("/", 110, 2, JimExprOpBin),
8344 OPRINIT("%", 110, 2, JimExprOpIntBin),
8346 OPRINIT("-", 100, 2, JimExprOpBin),
8347 OPRINIT("+", 100, 2, JimExprOpBin),
8349 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8350 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8352 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8353 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8355 OPRINIT("<", 80, 2, JimExprOpBin),
8356 OPRINIT(">", 80, 2, JimExprOpBin),
8357 OPRINIT("<=", 80, 2, JimExprOpBin),
8358 OPRINIT(">=", 80, 2, JimExprOpBin),
8360 OPRINIT("==", 70, 2, JimExprOpBin),
8361 OPRINIT("!=", 70, 2, JimExprOpBin),
8363 OPRINIT("&", 50, 2, JimExprOpIntBin),
8364 OPRINIT("^", 49, 2, JimExprOpIntBin),
8365 OPRINIT("|", 48, 2, JimExprOpIntBin),
8367 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8368 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8369 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8371 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8372 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8373 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8375 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8376 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8377 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8379 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8380 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8381 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8383 OPRINIT("**", 250, 2, JimExprOpBin),
8385 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8386 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8388 OPRINIT("in", 55, 2, JimExprOpStrBin),
8389 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8391 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8392 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8393 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8394 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8398 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8399 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8400 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8401 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8402 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8403 OPRINIT("rand", 200, 0, JimExprOpNone),
8404 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8406 #ifdef JIM_MATH_FUNCTIONS
8407 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8408 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8409 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8410 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8411 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8412 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8413 OPRINIT("atan2", 200, 2, JimExprOpBin),
8414 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8415 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8416 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8417 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8418 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8419 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8420 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8421 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8422 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8423 OPRINIT("pow", 200, 2, JimExprOpBin),
8424 OPRINIT("hypot", 200, 2, JimExprOpBin),
8425 OPRINIT("fmod", 200, 2, JimExprOpBin),
8426 #endif
8428 #undef OPRINIT
8429 #undef OPRINIT_LAZY
8431 #define JIM_EXPR_OPERATORS_NUM \
8432 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8434 static int JimParseExpression(struct JimParserCtx *pc)
8436 /* Discard spaces and quoted newline */
8437 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8438 if (*pc->p == '\n') {
8439 pc->linenr++;
8441 pc->p++;
8442 pc->len--;
8445 /* Common case */
8446 pc->tline = pc->linenr;
8447 pc->tstart = pc->p;
8449 if (pc->len == 0) {
8450 pc->tend = pc->p;
8451 pc->tt = JIM_TT_EOL;
8452 pc->eof = 1;
8453 return JIM_OK;
8455 switch (*(pc->p)) {
8456 case '(':
8457 pc->tt = JIM_TT_SUBEXPR_START;
8458 goto singlechar;
8459 case ')':
8460 pc->tt = JIM_TT_SUBEXPR_END;
8461 goto singlechar;
8462 case ',':
8463 pc->tt = JIM_TT_SUBEXPR_COMMA;
8464 singlechar:
8465 pc->tend = pc->p;
8466 pc->p++;
8467 pc->len--;
8468 break;
8469 case '[':
8470 return JimParseCmd(pc);
8471 case '$':
8472 if (JimParseVar(pc) == JIM_ERR)
8473 return JimParseExprOperator(pc);
8474 else {
8475 /* Don't allow expr sugar in expressions */
8476 if (pc->tt == JIM_TT_EXPRSUGAR) {
8477 return JIM_ERR;
8479 return JIM_OK;
8481 break;
8482 case '0':
8483 case '1':
8484 case '2':
8485 case '3':
8486 case '4':
8487 case '5':
8488 case '6':
8489 case '7':
8490 case '8':
8491 case '9':
8492 case '.':
8493 return JimParseExprNumber(pc);
8494 case '"':
8495 return JimParseQuote(pc);
8496 case '{':
8497 return JimParseBrace(pc);
8499 case 'N':
8500 case 'I':
8501 case 'n':
8502 case 'i':
8503 if (JimParseExprIrrational(pc) == JIM_ERR)
8504 if (JimParseExprBoolean(pc) == JIM_ERR)
8505 return JimParseExprOperator(pc);
8506 break;
8507 case 't':
8508 case 'f':
8509 case 'o':
8510 case 'y':
8511 if (JimParseExprBoolean(pc) == JIM_ERR)
8512 return JimParseExprOperator(pc);
8513 break;
8514 default:
8515 return JimParseExprOperator(pc);
8516 break;
8518 return JIM_OK;
8521 static int JimParseExprNumber(struct JimParserCtx *pc)
8523 char *end;
8525 /* Assume an integer for now */
8526 pc->tt = JIM_TT_EXPR_INT;
8528 jim_strtoull(pc->p, (char **)&pc->p);
8529 /* Tried as an integer, but perhaps it parses as a double */
8530 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8531 /* Some stupid compilers insist they are cleverer that
8532 * we are. Even a (void) cast doesn't prevent this warning!
8534 if (strtod(pc->tstart, &end)) { /* nothing */ }
8535 if (end == pc->tstart)
8536 return JIM_ERR;
8537 if (end > pc->p) {
8538 /* Yes, double captured more chars */
8539 pc->tt = JIM_TT_EXPR_DOUBLE;
8540 pc->p = end;
8543 pc->tend = pc->p - 1;
8544 pc->len -= (pc->p - pc->tstart);
8545 return JIM_OK;
8548 static int JimParseExprIrrational(struct JimParserCtx *pc)
8550 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8551 int i;
8553 for (i = 0; irrationals[i]; i++) {
8554 const char *irr = irrationals[i];
8556 if (strncmp(irr, pc->p, 3) == 0) {
8557 pc->p += 3;
8558 pc->len -= 3;
8559 pc->tend = pc->p - 1;
8560 pc->tt = JIM_TT_EXPR_DOUBLE;
8561 return JIM_OK;
8564 return JIM_ERR;
8567 static int JimParseExprBoolean(struct JimParserCtx *pc)
8569 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8570 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8571 int i;
8573 for (i = 0; booleans[i]; i++) {
8574 const char *boolean = booleans[i];
8575 int length = lengths[i];
8577 if (strncmp(boolean, pc->p, length) == 0) {
8578 pc->p += length;
8579 pc->len -= length;
8580 pc->tend = pc->p - 1;
8581 pc->tt = JIM_TT_EXPR_BOOLEAN;
8582 return JIM_OK;
8585 return JIM_ERR;
8588 static int JimParseExprOperator(struct JimParserCtx *pc)
8590 int i;
8591 int bestIdx = -1, bestLen = 0;
8593 /* Try to get the longest match. */
8594 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8595 const char * const opname = Jim_ExprOperators[i].name;
8596 const int oplen = Jim_ExprOperators[i].namelen;
8598 if (opname == NULL || opname[0] != pc->p[0]) {
8599 continue;
8602 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8603 bestIdx = i + JIM_TT_EXPR_OP;
8604 bestLen = oplen;
8607 if (bestIdx == -1) {
8608 return JIM_ERR;
8611 /* Validate paretheses around function arguments */
8612 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8613 const char *p = pc->p + bestLen;
8614 int len = pc->len - bestLen;
8616 while (len && isspace(UCHAR(*p))) {
8617 len--;
8618 p++;
8620 if (*p != '(') {
8621 return JIM_ERR;
8624 pc->tend = pc->p + bestLen - 1;
8625 pc->p += bestLen;
8626 pc->len -= bestLen;
8628 pc->tt = bestIdx;
8629 return JIM_OK;
8632 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8634 static Jim_ExprOperator dummy_op;
8635 if (opcode < JIM_TT_EXPR_OP) {
8636 return &dummy_op;
8638 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8641 const char *jim_tt_name(int type)
8643 static const char * const tt_names[JIM_TT_EXPR_OP] =
8644 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8645 "DBL", "BOO", "$()" };
8646 if (type < JIM_TT_EXPR_OP) {
8647 return tt_names[type];
8649 else {
8650 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8651 static char buf[20];
8653 if (op->name) {
8654 return op->name;
8656 sprintf(buf, "(%d)", type);
8657 return buf;
8661 /* -----------------------------------------------------------------------------
8662 * Expression Object
8663 * ---------------------------------------------------------------------------*/
8664 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8665 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8666 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8668 static const Jim_ObjType exprObjType = {
8669 "expression",
8670 FreeExprInternalRep,
8671 DupExprInternalRep,
8672 NULL,
8673 JIM_TYPE_REFERENCES,
8676 /* Expr bytecode structure */
8677 typedef struct ExprByteCode
8679 ScriptToken *token; /* Tokens array. */
8680 int len; /* Length as number of tokens. */
8681 int inUse; /* Used for sharing. */
8682 } ExprByteCode;
8684 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8686 int i;
8688 for (i = 0; i < expr->len; i++) {
8689 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8691 Jim_Free(expr->token);
8692 Jim_Free(expr);
8695 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8697 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8699 if (expr) {
8700 if (--expr->inUse != 0) {
8701 return;
8704 ExprFreeByteCode(interp, expr);
8708 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8710 JIM_NOTUSED(interp);
8711 JIM_NOTUSED(srcPtr);
8713 /* Just returns an simple string. */
8714 dupPtr->typePtr = NULL;
8717 /* Check if an expr program looks correct. */
8718 static int ExprCheckCorrectness(ExprByteCode * expr)
8720 int i;
8721 int stacklen = 0;
8722 int ternary = 0;
8724 /* Try to check if there are stack underflows,
8725 * and make sure at the end of the program there is
8726 * a single result on the stack. */
8727 for (i = 0; i < expr->len; i++) {
8728 ScriptToken *t = &expr->token[i];
8729 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8731 stacklen -= op->arity;
8732 if (stacklen < 0) {
8733 break;
8735 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8736 ternary++;
8738 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8739 ternary--;
8742 /* All operations and operands add one to the stack */
8743 stacklen++;
8745 if (stacklen != 1 || ternary != 0) {
8746 return JIM_ERR;
8748 return JIM_OK;
8751 /* This procedure converts every occurrence of || and && opereators
8752 * in lazy unary versions.
8754 * a b || is converted into:
8756 * a <offset> |L b |R
8758 * a b && is converted into:
8760 * a <offset> &L b &R
8762 * "|L" checks if 'a' is true:
8763 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8764 * the opcode just after |R.
8765 * 2) if it is false does nothing.
8766 * "|R" checks if 'b' is true:
8767 * 1) if it is true pushes 1, otherwise pushes 0.
8769 * "&L" checks if 'a' is true:
8770 * 1) if it is true does nothing.
8771 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8772 * the opcode just after &R
8773 * "&R" checks if 'a' is true:
8774 * if it is true pushes 1, otherwise pushes 0.
8776 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8778 int i;
8780 int leftindex, arity, offset;
8782 /* Search for the end of the first operator */
8783 leftindex = expr->len - 1;
8785 arity = 1;
8786 while (arity) {
8787 ScriptToken *tt = &expr->token[leftindex];
8789 if (tt->type >= JIM_TT_EXPR_OP) {
8790 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8792 arity--;
8793 if (--leftindex < 0) {
8794 return JIM_ERR;
8797 leftindex++;
8799 /* Move them up */
8800 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8801 sizeof(*expr->token) * (expr->len - leftindex));
8802 expr->len += 2;
8803 offset = (expr->len - leftindex) - 1;
8805 /* Now we rely on the fact that the left and right version have opcodes
8806 * 1 and 2 after the main opcode respectively
8808 expr->token[leftindex + 1].type = t->type + 1;
8809 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8811 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8812 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8814 /* Now add the 'R' operator */
8815 expr->token[expr->len].objPtr = interp->emptyObj;
8816 expr->token[expr->len].type = t->type + 2;
8817 expr->len++;
8819 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8820 for (i = leftindex - 1; i > 0; i--) {
8821 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8822 if (op->lazy == LAZY_LEFT) {
8823 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8824 JimWideValue(expr->token[i - 1].objPtr) += 2;
8828 return JIM_OK;
8831 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8833 struct ScriptToken *token = &expr->token[expr->len];
8834 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8836 if (op->lazy == LAZY_OP) {
8837 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8838 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8839 return JIM_ERR;
8842 else {
8843 token->objPtr = interp->emptyObj;
8844 token->type = t->type;
8845 expr->len++;
8847 return JIM_OK;
8851 * Returns the index of the COLON_LEFT to the left of 'right_index'
8852 * taking into account nesting.
8854 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8856 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8858 int ternary_count = 1;
8860 right_index--;
8862 while (right_index > 1) {
8863 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8864 ternary_count--;
8866 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8867 ternary_count++;
8869 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8870 return right_index;
8872 right_index--;
8875 /*notreached*/
8876 return -1;
8880 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8882 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8883 * Otherwise returns 0.
8885 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8887 int i = right_index - 1;
8888 int ternary_count = 1;
8890 while (i > 1) {
8891 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8892 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8893 *prev_right_index = i - 2;
8894 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8895 return 1;
8898 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8899 if (ternary_count == 0) {
8900 return 0;
8902 ternary_count++;
8904 i--;
8906 return 0;
8910 * ExprTernaryReorderExpression description
8911 * ========================================
8913 * ?: is right-to-left associative which doesn't work with the stack-based
8914 * expression engine. The fix is to reorder the bytecode.
8916 * The expression:
8918 * expr 1?2:0?3:4
8920 * Has initial bytecode:
8922 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8923 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8925 * The fix involves simulating this expression instead:
8927 * expr 1?2:(0?3:4)
8929 * With the following bytecode:
8931 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8932 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8934 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8935 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8936 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8937 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8939 * ExprTernaryReorderExpression works thus as follows :
8940 * - start from the end of the stack
8941 * - while walking towards the beginning of the stack
8942 * if token=JIM_EXPROP_COLON_RIGHT then
8943 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8944 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8945 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8946 * if all found then
8947 * perform the rotation
8948 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8949 * end if
8950 * end if
8952 * Note: care has to be taken for nested ternary constructs!!!
8954 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8956 int i;
8958 for (i = expr->len - 1; i > 1; i--) {
8959 int prev_right_index;
8960 int prev_left_index;
8961 int j;
8962 ScriptToken tmp;
8964 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8965 continue;
8968 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8969 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8970 continue;
8974 ** rotate tokens down
8976 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8977 ** | | |
8978 ** | V V
8979 ** | [...] : ...
8980 ** | | |
8981 ** | V V
8982 ** | [...] : ...
8983 ** | | |
8984 ** | V V
8985 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8987 tmp = expr->token[prev_right_index];
8988 for (j = prev_right_index; j < i; j++) {
8989 expr->token[j] = expr->token[j + 1];
8991 expr->token[i] = tmp;
8993 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8995 * This is 'colon left increment' = i - prev_right_index
8997 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8998 * [prev_left_index-1] : skip_count
9001 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9003 /* Adjust for i-- in the loop */
9004 i++;
9008 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
9010 Jim_Stack stack;
9011 ExprByteCode *expr;
9012 int ok = 1;
9013 int i;
9014 int prevtt = JIM_TT_NONE;
9015 int have_ternary = 0;
9017 /* -1 for EOL */
9018 int count = tokenlist->count - 1;
9020 expr = Jim_Alloc(sizeof(*expr));
9021 expr->inUse = 1;
9022 expr->len = 0;
9024 Jim_InitStack(&stack);
9026 /* Need extra bytecodes for lazy operators.
9027 * Also check for the ternary operator
9029 for (i = 0; i < tokenlist->count; i++) {
9030 ParseToken *t = &tokenlist->list[i];
9031 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9033 if (op->lazy == LAZY_OP) {
9034 count += 2;
9035 /* Ternary is a lazy op but also needs reordering */
9036 if (t->type == JIM_EXPROP_TERNARY) {
9037 have_ternary = 1;
9042 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9044 for (i = 0; i < tokenlist->count && ok; i++) {
9045 ParseToken *t = &tokenlist->list[i];
9047 /* Next token will be stored here */
9048 struct ScriptToken *token = &expr->token[expr->len];
9050 if (t->type == JIM_TT_EOL) {
9051 break;
9054 switch (t->type) {
9055 case JIM_TT_STR:
9056 case JIM_TT_ESC:
9057 case JIM_TT_VAR:
9058 case JIM_TT_DICTSUGAR:
9059 case JIM_TT_EXPRSUGAR:
9060 case JIM_TT_CMD:
9061 case JIM_TT_EXPR_BOOLEAN:
9062 token->type = t->type;
9063 strexpr:
9064 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9065 if (t->type == JIM_TT_CMD) {
9066 /* Only commands need source info */
9067 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9069 expr->len++;
9070 break;
9072 case JIM_TT_EXPR_INT:
9073 case JIM_TT_EXPR_DOUBLE:
9075 char *endptr;
9076 if (t->type == JIM_TT_EXPR_INT) {
9077 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9079 else {
9080 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9082 if (endptr != t->token + t->len) {
9083 /* Conversion failed, so just store it as a string */
9084 Jim_FreeNewObj(interp, token->objPtr);
9085 token->type = JIM_TT_STR;
9086 goto strexpr;
9088 token->type = t->type;
9089 expr->len++;
9091 break;
9093 case JIM_TT_SUBEXPR_START:
9094 Jim_StackPush(&stack, t);
9095 prevtt = JIM_TT_NONE;
9096 continue;
9098 case JIM_TT_SUBEXPR_COMMA:
9099 /* Simple approach. Comma is simply ignored */
9100 continue;
9102 case JIM_TT_SUBEXPR_END:
9103 ok = 0;
9104 while (Jim_StackLen(&stack)) {
9105 ParseToken *tt = Jim_StackPop(&stack);
9107 if (tt->type == JIM_TT_SUBEXPR_START) {
9108 ok = 1;
9109 break;
9112 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9113 goto err;
9116 if (!ok) {
9117 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9118 goto err;
9120 break;
9123 default:{
9124 /* Must be an operator */
9125 const struct Jim_ExprOperator *op;
9126 ParseToken *tt;
9128 /* Convert -/+ to unary minus or unary plus if necessary */
9129 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9130 if (t->type == JIM_EXPROP_SUB) {
9131 t->type = JIM_EXPROP_UNARYMINUS;
9133 else if (t->type == JIM_EXPROP_ADD) {
9134 t->type = JIM_EXPROP_UNARYPLUS;
9138 op = JimExprOperatorInfoByOpcode(t->type);
9140 /* Now handle precedence */
9141 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9142 const struct Jim_ExprOperator *tt_op =
9143 JimExprOperatorInfoByOpcode(tt->type);
9145 /* Note that right-to-left associativity of ?: operator is handled later */
9147 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9148 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9149 ok = 0;
9150 goto err;
9152 Jim_StackPop(&stack);
9154 else {
9155 break;
9158 Jim_StackPush(&stack, t);
9159 break;
9162 prevtt = t->type;
9165 /* Reduce any remaining subexpr */
9166 while (Jim_StackLen(&stack)) {
9167 ParseToken *tt = Jim_StackPop(&stack);
9169 if (tt->type == JIM_TT_SUBEXPR_START) {
9170 ok = 0;
9171 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9172 goto err;
9174 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9175 ok = 0;
9176 goto err;
9180 if (have_ternary) {
9181 ExprTernaryReorderExpression(interp, expr);
9184 err:
9185 /* Free the stack used for the compilation. */
9186 Jim_FreeStack(&stack);
9188 for (i = 0; i < expr->len; i++) {
9189 Jim_IncrRefCount(expr->token[i].objPtr);
9192 if (!ok) {
9193 ExprFreeByteCode(interp, expr);
9194 return NULL;
9197 return expr;
9201 /* This method takes the string representation of an expression
9202 * and generates a program for the Expr's stack-based VM. */
9203 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9205 int exprTextLen;
9206 const char *exprText;
9207 struct JimParserCtx parser;
9208 struct ExprByteCode *expr;
9209 ParseTokenList tokenlist;
9210 int line;
9211 Jim_Obj *fileNameObj;
9212 int rc = JIM_ERR;
9214 /* Try to get information about filename / line number */
9215 if (objPtr->typePtr == &sourceObjType) {
9216 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9217 line = objPtr->internalRep.sourceValue.lineNumber;
9219 else {
9220 fileNameObj = interp->emptyObj;
9221 line = 1;
9223 Jim_IncrRefCount(fileNameObj);
9225 exprText = Jim_GetString(objPtr, &exprTextLen);
9227 /* Initially tokenise the expression into tokenlist */
9228 ScriptTokenListInit(&tokenlist);
9230 JimParserInit(&parser, exprText, exprTextLen, line);
9231 while (!parser.eof) {
9232 if (JimParseExpression(&parser) != JIM_OK) {
9233 ScriptTokenListFree(&tokenlist);
9234 invalidexpr:
9235 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9236 expr = NULL;
9237 goto err;
9240 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9241 parser.tline);
9244 #ifdef DEBUG_SHOW_EXPR_TOKENS
9246 int i;
9247 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9248 for (i = 0; i < tokenlist.count; i++) {
9249 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9250 tokenlist.list[i].len, tokenlist.list[i].token);
9253 #endif
9255 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9256 ScriptTokenListFree(&tokenlist);
9257 Jim_DecrRefCount(interp, fileNameObj);
9258 return JIM_ERR;
9261 /* Now create the expression bytecode from the tokenlist */
9262 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9264 /* No longer need the token list */
9265 ScriptTokenListFree(&tokenlist);
9267 if (!expr) {
9268 goto err;
9271 #ifdef DEBUG_SHOW_EXPR
9273 int i;
9275 printf("==== Expr ====\n");
9276 for (i = 0; i < expr->len; i++) {
9277 ScriptToken *t = &expr->token[i];
9279 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9282 #endif
9284 /* Check program correctness. */
9285 if (ExprCheckCorrectness(expr) != JIM_OK) {
9286 ExprFreeByteCode(interp, expr);
9287 goto invalidexpr;
9290 rc = JIM_OK;
9292 err:
9293 /* Free the old internal rep and set the new one. */
9294 Jim_DecrRefCount(interp, fileNameObj);
9295 Jim_FreeIntRep(interp, objPtr);
9296 Jim_SetIntRepPtr(objPtr, expr);
9297 objPtr->typePtr = &exprObjType;
9298 return rc;
9301 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9303 if (objPtr->typePtr != &exprObjType) {
9304 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9305 return NULL;
9308 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9311 #ifdef JIM_OPTIMIZATION
9312 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9314 if (token->type == JIM_TT_EXPR_INT)
9315 return token->objPtr;
9316 else if (token->type == JIM_TT_VAR)
9317 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9318 else if (token->type == JIM_TT_DICTSUGAR)
9319 return JimExpandDictSugar(interp, token->objPtr);
9320 else
9321 return NULL;
9323 #endif
9325 /* -----------------------------------------------------------------------------
9326 * Expressions evaluation.
9327 * Jim uses a specialized stack-based virtual machine for expressions,
9328 * that takes advantage of the fact that expr's operators
9329 * can't be redefined.
9331 * Jim_EvalExpression() uses the bytecode compiled by
9332 * SetExprFromAny() method of the "expression" object.
9334 * On success a Tcl Object containing the result of the evaluation
9335 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9336 * returned.
9337 * On error the function returns a retcode != to JIM_OK and set a suitable
9338 * error on the interp.
9339 * ---------------------------------------------------------------------------*/
9340 #define JIM_EE_STATICSTACK_LEN 10
9342 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9344 ExprByteCode *expr;
9345 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9346 int i;
9347 int retcode = JIM_OK;
9348 struct JimExprState e;
9350 expr = JimGetExpression(interp, exprObjPtr);
9351 if (!expr) {
9352 return JIM_ERR; /* error in expression. */
9355 #ifdef JIM_OPTIMIZATION
9356 /* Check for one of the following common expressions used by while/for
9358 * CONST
9359 * $a
9360 * !$a
9361 * $a < CONST, $a < $b
9362 * $a <= CONST, $a <= $b
9363 * $a > CONST, $a > $b
9364 * $a >= CONST, $a >= $b
9365 * $a != CONST, $a != $b
9366 * $a == CONST, $a == $b
9369 Jim_Obj *objPtr;
9371 /* STEP 1 -- Check if there are the conditions to run the specialized
9372 * version of while */
9374 switch (expr->len) {
9375 case 1:
9376 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9377 if (objPtr) {
9378 Jim_IncrRefCount(objPtr);
9379 *exprResultPtrPtr = objPtr;
9380 return JIM_OK;
9382 break;
9384 case 2:
9385 if (expr->token[1].type == JIM_EXPROP_NOT) {
9386 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9388 if (objPtr && JimIsWide(objPtr)) {
9389 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9390 Jim_IncrRefCount(*exprResultPtrPtr);
9391 return JIM_OK;
9394 break;
9396 case 3:
9397 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9398 if (objPtr && JimIsWide(objPtr)) {
9399 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9400 if (objPtr2 && JimIsWide(objPtr2)) {
9401 jim_wide wideValueA = JimWideValue(objPtr);
9402 jim_wide wideValueB = JimWideValue(objPtr2);
9403 int cmpRes;
9404 switch (expr->token[2].type) {
9405 case JIM_EXPROP_LT:
9406 cmpRes = wideValueA < wideValueB;
9407 break;
9408 case JIM_EXPROP_LTE:
9409 cmpRes = wideValueA <= wideValueB;
9410 break;
9411 case JIM_EXPROP_GT:
9412 cmpRes = wideValueA > wideValueB;
9413 break;
9414 case JIM_EXPROP_GTE:
9415 cmpRes = wideValueA >= wideValueB;
9416 break;
9417 case JIM_EXPROP_NUMEQ:
9418 cmpRes = wideValueA == wideValueB;
9419 break;
9420 case JIM_EXPROP_NUMNE:
9421 cmpRes = wideValueA != wideValueB;
9422 break;
9423 default:
9424 goto noopt;
9426 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9427 Jim_IncrRefCount(*exprResultPtrPtr);
9428 return JIM_OK;
9431 break;
9434 noopt:
9435 #endif
9437 /* In order to avoid that the internal repr gets freed due to
9438 * shimmering of the exprObjPtr's object, we make the internal rep
9439 * shared. */
9440 expr->inUse++;
9442 /* The stack-based expr VM itself */
9444 /* Stack allocation. Expr programs have the feature that
9445 * a program of length N can't require a stack longer than
9446 * N. */
9447 if (expr->len > JIM_EE_STATICSTACK_LEN)
9448 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9449 else
9450 e.stack = staticStack;
9452 e.stacklen = 0;
9454 /* Execute every instruction */
9455 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9456 Jim_Obj *objPtr;
9458 switch (expr->token[i].type) {
9459 case JIM_TT_EXPR_INT:
9460 case JIM_TT_EXPR_DOUBLE:
9461 case JIM_TT_EXPR_BOOLEAN:
9462 case JIM_TT_STR:
9463 ExprPush(&e, expr->token[i].objPtr);
9464 break;
9466 case JIM_TT_VAR:
9467 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9468 if (objPtr) {
9469 ExprPush(&e, objPtr);
9471 else {
9472 retcode = JIM_ERR;
9474 break;
9476 case JIM_TT_DICTSUGAR:
9477 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9478 if (objPtr) {
9479 ExprPush(&e, objPtr);
9481 else {
9482 retcode = JIM_ERR;
9484 break;
9486 case JIM_TT_ESC:
9487 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9488 if (retcode == JIM_OK) {
9489 ExprPush(&e, objPtr);
9491 break;
9493 case JIM_TT_CMD:
9494 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9495 if (retcode == JIM_OK) {
9496 ExprPush(&e, Jim_GetResult(interp));
9498 break;
9500 default:{
9501 /* Find and execute the operation */
9502 e.skip = 0;
9503 e.opcode = expr->token[i].type;
9505 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9506 /* Skip some opcodes if necessary */
9507 i += e.skip;
9508 continue;
9513 expr->inUse--;
9515 if (retcode == JIM_OK) {
9516 *exprResultPtrPtr = ExprPop(&e);
9518 else {
9519 for (i = 0; i < e.stacklen; i++) {
9520 Jim_DecrRefCount(interp, e.stack[i]);
9523 if (e.stack != staticStack) {
9524 Jim_Free(e.stack);
9526 return retcode;
9529 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9531 int retcode;
9532 jim_wide wideValue;
9533 double doubleValue;
9534 int booleanValue;
9535 Jim_Obj *exprResultPtr;
9537 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9538 if (retcode != JIM_OK)
9539 return retcode;
9541 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9542 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9543 if (Jim_GetBoolean(interp, exprResultPtr, &booleanValue) != JIM_OK) {
9544 Jim_DecrRefCount(interp, exprResultPtr);
9545 return JIM_ERR;
9546 } else {
9547 Jim_DecrRefCount(interp, exprResultPtr);
9548 *boolPtr = booleanValue;
9549 return JIM_OK;
9552 else {
9553 Jim_DecrRefCount(interp, exprResultPtr);
9554 *boolPtr = doubleValue != 0;
9555 return JIM_OK;
9558 *boolPtr = wideValue != 0;
9560 Jim_DecrRefCount(interp, exprResultPtr);
9561 return JIM_OK;
9564 /* -----------------------------------------------------------------------------
9565 * ScanFormat String Object
9566 * ---------------------------------------------------------------------------*/
9568 /* This Jim_Obj will held a parsed representation of a format string passed to
9569 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9570 * to be parsed in its entirely first and then, if correct, can be used for
9571 * scanning. To avoid endless re-parsing, the parsed representation will be
9572 * stored in an internal representation and re-used for performance reason. */
9574 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9575 * scanformat string. This part will later be used to extract information
9576 * out from the string to be parsed by Jim_ScanString */
9578 typedef struct ScanFmtPartDescr
9580 char *arg; /* Specification of a CHARSET conversion */
9581 char *prefix; /* Prefix to be scanned literally before conversion */
9582 size_t width; /* Maximal width of input to be converted */
9583 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9584 char type; /* Type of conversion (e.g. c, d, f) */
9585 char modifier; /* Modify type (e.g. l - long, h - short */
9586 } ScanFmtPartDescr;
9588 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9589 * string parsed and separated in part descriptions. Furthermore it contains
9590 * the original string representation of the scanformat string to allow for
9591 * fast update of the Jim_Obj's string representation part.
9593 * As an add-on the internal object representation adds some scratch pad area
9594 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9595 * memory for purpose of string scanning.
9597 * The error member points to a static allocated string in case of a mal-
9598 * formed scanformat string or it contains '0' (NULL) in case of a valid
9599 * parse representation.
9601 * The whole memory of the internal representation is allocated as a single
9602 * area of memory that will be internally separated. So freeing and duplicating
9603 * of such an object is cheap */
9605 typedef struct ScanFmtStringObj
9607 jim_wide size; /* Size of internal repr in bytes */
9608 char *stringRep; /* Original string representation */
9609 size_t count; /* Number of ScanFmtPartDescr contained */
9610 size_t convCount; /* Number of conversions that will assign */
9611 size_t maxPos; /* Max position index if XPG3 is used */
9612 const char *error; /* Ptr to error text (NULL if no error */
9613 char *scratch; /* Some scratch pad used by Jim_ScanString */
9614 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9615 } ScanFmtStringObj;
9618 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9619 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9620 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9622 static const Jim_ObjType scanFmtStringObjType = {
9623 "scanformatstring",
9624 FreeScanFmtInternalRep,
9625 DupScanFmtInternalRep,
9626 UpdateStringOfScanFmt,
9627 JIM_TYPE_NONE,
9630 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9632 JIM_NOTUSED(interp);
9633 Jim_Free((char *)objPtr->internalRep.ptr);
9634 objPtr->internalRep.ptr = 0;
9637 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9639 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9640 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9642 JIM_NOTUSED(interp);
9643 memcpy(newVec, srcPtr->internalRep.ptr, size);
9644 dupPtr->internalRep.ptr = newVec;
9645 dupPtr->typePtr = &scanFmtStringObjType;
9648 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9650 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9653 /* SetScanFmtFromAny will parse a given string and create the internal
9654 * representation of the format specification. In case of an error
9655 * the error data member of the internal representation will be set
9656 * to an descriptive error text and the function will be left with
9657 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9658 * specification */
9660 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9662 ScanFmtStringObj *fmtObj;
9663 char *buffer;
9664 int maxCount, i, approxSize, lastPos = -1;
9665 const char *fmt = objPtr->bytes;
9666 int maxFmtLen = objPtr->length;
9667 const char *fmtEnd = fmt + maxFmtLen;
9668 int curr;
9670 Jim_FreeIntRep(interp, objPtr);
9671 /* Count how many conversions could take place maximally */
9672 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9673 if (fmt[i] == '%')
9674 ++maxCount;
9675 /* Calculate an approximation of the memory necessary */
9676 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9677 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9678 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9679 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9680 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9681 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9682 +1; /* safety byte */
9683 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9684 memset(fmtObj, 0, approxSize);
9685 fmtObj->size = approxSize;
9686 fmtObj->maxPos = 0;
9687 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9688 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9689 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9690 buffer = fmtObj->stringRep + maxFmtLen + 1;
9691 objPtr->internalRep.ptr = fmtObj;
9692 objPtr->typePtr = &scanFmtStringObjType;
9693 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9694 int width = 0, skip;
9695 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9697 fmtObj->count++;
9698 descr->width = 0; /* Assume width unspecified */
9699 /* Overread and store any "literal" prefix */
9700 if (*fmt != '%' || fmt[1] == '%') {
9701 descr->type = 0;
9702 descr->prefix = &buffer[i];
9703 for (; fmt < fmtEnd; ++fmt) {
9704 if (*fmt == '%') {
9705 if (fmt[1] != '%')
9706 break;
9707 ++fmt;
9709 buffer[i++] = *fmt;
9711 buffer[i++] = 0;
9713 /* Skip the conversion introducing '%' sign */
9714 ++fmt;
9715 /* End reached due to non-conversion literal only? */
9716 if (fmt >= fmtEnd)
9717 goto done;
9718 descr->pos = 0; /* Assume "natural" positioning */
9719 if (*fmt == '*') {
9720 descr->pos = -1; /* Okay, conversion will not be assigned */
9721 ++fmt;
9723 else
9724 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9725 /* Check if next token is a number (could be width or pos */
9726 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9727 fmt += skip;
9728 /* Was the number a XPG3 position specifier? */
9729 if (descr->pos != -1 && *fmt == '$') {
9730 int prev;
9732 ++fmt;
9733 descr->pos = width;
9734 width = 0;
9735 /* Look if "natural" postioning and XPG3 one was mixed */
9736 if ((lastPos == 0 && descr->pos > 0)
9737 || (lastPos > 0 && descr->pos == 0)) {
9738 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9739 return JIM_ERR;
9741 /* Look if this position was already used */
9742 for (prev = 0; prev < curr; ++prev) {
9743 if (fmtObj->descr[prev].pos == -1)
9744 continue;
9745 if (fmtObj->descr[prev].pos == descr->pos) {
9746 fmtObj->error =
9747 "variable is assigned by multiple \"%n$\" conversion specifiers";
9748 return JIM_ERR;
9751 /* Try to find a width after the XPG3 specifier */
9752 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9753 descr->width = width;
9754 fmt += skip;
9756 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9757 fmtObj->maxPos = descr->pos;
9759 else {
9760 /* Number was not a XPG3, so it has to be a width */
9761 descr->width = width;
9764 /* If positioning mode was undetermined yet, fix this */
9765 if (lastPos == -1)
9766 lastPos = descr->pos;
9767 /* Handle CHARSET conversion type ... */
9768 if (*fmt == '[') {
9769 int swapped = 1, beg = i, end, j;
9771 descr->type = '[';
9772 descr->arg = &buffer[i];
9773 ++fmt;
9774 if (*fmt == '^')
9775 buffer[i++] = *fmt++;
9776 if (*fmt == ']')
9777 buffer[i++] = *fmt++;
9778 while (*fmt && *fmt != ']')
9779 buffer[i++] = *fmt++;
9780 if (*fmt != ']') {
9781 fmtObj->error = "unmatched [ in format string";
9782 return JIM_ERR;
9784 end = i;
9785 buffer[i++] = 0;
9786 /* In case a range fence was given "backwards", swap it */
9787 while (swapped) {
9788 swapped = 0;
9789 for (j = beg + 1; j < end - 1; ++j) {
9790 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9791 char tmp = buffer[j - 1];
9793 buffer[j - 1] = buffer[j + 1];
9794 buffer[j + 1] = tmp;
9795 swapped = 1;
9800 else {
9801 /* Remember any valid modifier if given */
9802 if (strchr("hlL", *fmt) != 0)
9803 descr->modifier = tolower((int)*fmt++);
9805 descr->type = *fmt;
9806 if (strchr("efgcsndoxui", *fmt) == 0) {
9807 fmtObj->error = "bad scan conversion character";
9808 return JIM_ERR;
9810 else if (*fmt == 'c' && descr->width != 0) {
9811 fmtObj->error = "field width may not be specified in %c " "conversion";
9812 return JIM_ERR;
9814 else if (*fmt == 'u' && descr->modifier == 'l') {
9815 fmtObj->error = "unsigned wide not supported";
9816 return JIM_ERR;
9819 curr++;
9821 done:
9822 return JIM_OK;
9825 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9827 #define FormatGetCnvCount(_fo_) \
9828 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9829 #define FormatGetMaxPos(_fo_) \
9830 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9831 #define FormatGetError(_fo_) \
9832 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9834 /* JimScanAString is used to scan an unspecified string that ends with
9835 * next WS, or a string that is specified via a charset.
9838 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9840 char *buffer = Jim_StrDup(str);
9841 char *p = buffer;
9843 while (*str) {
9844 int c;
9845 int n;
9847 if (!sdescr && isspace(UCHAR(*str)))
9848 break; /* EOS via WS if unspecified */
9850 n = utf8_tounicode(str, &c);
9851 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9852 break;
9853 while (n--)
9854 *p++ = *str++;
9856 *p = 0;
9857 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9860 /* ScanOneEntry will scan one entry out of the string passed as argument.
9861 * It use the sscanf() function for this task. After extracting and
9862 * converting of the value, the count of scanned characters will be
9863 * returned of -1 in case of no conversion tool place and string was
9864 * already scanned thru */
9866 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9867 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9869 const char *tok;
9870 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9871 size_t scanned = 0;
9872 size_t anchor = pos;
9873 int i;
9874 Jim_Obj *tmpObj = NULL;
9876 /* First pessimistically assume, we will not scan anything :-) */
9877 *valObjPtr = 0;
9878 if (descr->prefix) {
9879 /* There was a prefix given before the conversion, skip it and adjust
9880 * the string-to-be-parsed accordingly */
9881 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9882 /* If prefix require, skip WS */
9883 if (isspace(UCHAR(descr->prefix[i])))
9884 while (pos < strLen && isspace(UCHAR(str[pos])))
9885 ++pos;
9886 else if (descr->prefix[i] != str[pos])
9887 break; /* Prefix do not match here, leave the loop */
9888 else
9889 ++pos; /* Prefix matched so far, next round */
9891 if (pos >= strLen) {
9892 return -1; /* All of str consumed: EOF condition */
9894 else if (descr->prefix[i] != 0)
9895 return 0; /* Not whole prefix consumed, no conversion possible */
9897 /* For all but following conversion, skip leading WS */
9898 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9899 while (isspace(UCHAR(str[pos])))
9900 ++pos;
9901 /* Determine how much skipped/scanned so far */
9902 scanned = pos - anchor;
9904 /* %c is a special, simple case. no width */
9905 if (descr->type == 'n') {
9906 /* Return pseudo conversion means: how much scanned so far? */
9907 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9909 else if (pos >= strLen) {
9910 /* Cannot scan anything, as str is totally consumed */
9911 return -1;
9913 else if (descr->type == 'c') {
9914 int c;
9915 scanned += utf8_tounicode(&str[pos], &c);
9916 *valObjPtr = Jim_NewIntObj(interp, c);
9917 return scanned;
9919 else {
9920 /* Processing of conversions follows ... */
9921 if (descr->width > 0) {
9922 /* Do not try to scan as fas as possible but only the given width.
9923 * To ensure this, we copy the part that should be scanned. */
9924 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9925 size_t tLen = descr->width > sLen ? sLen : descr->width;
9927 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9928 tok = tmpObj->bytes;
9930 else {
9931 /* As no width was given, simply refer to the original string */
9932 tok = &str[pos];
9934 switch (descr->type) {
9935 case 'd':
9936 case 'o':
9937 case 'x':
9938 case 'u':
9939 case 'i':{
9940 char *endp; /* Position where the number finished */
9941 jim_wide w;
9943 int base = descr->type == 'o' ? 8
9944 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9946 /* Try to scan a number with the given base */
9947 if (base == 0) {
9948 w = jim_strtoull(tok, &endp);
9950 else {
9951 w = strtoull(tok, &endp, base);
9954 if (endp != tok) {
9955 /* There was some number sucessfully scanned! */
9956 *valObjPtr = Jim_NewIntObj(interp, w);
9958 /* Adjust the number-of-chars scanned so far */
9959 scanned += endp - tok;
9961 else {
9962 /* Nothing was scanned. We have to determine if this
9963 * happened due to e.g. prefix mismatch or input str
9964 * exhausted */
9965 scanned = *tok ? 0 : -1;
9967 break;
9969 case 's':
9970 case '[':{
9971 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9972 scanned += Jim_Length(*valObjPtr);
9973 break;
9975 case 'e':
9976 case 'f':
9977 case 'g':{
9978 char *endp;
9979 double value = strtod(tok, &endp);
9981 if (endp != tok) {
9982 /* There was some number sucessfully scanned! */
9983 *valObjPtr = Jim_NewDoubleObj(interp, value);
9984 /* Adjust the number-of-chars scanned so far */
9985 scanned += endp - tok;
9987 else {
9988 /* Nothing was scanned. We have to determine if this
9989 * happened due to e.g. prefix mismatch or input str
9990 * exhausted */
9991 scanned = *tok ? 0 : -1;
9993 break;
9996 /* If a substring was allocated (due to pre-defined width) do not
9997 * forget to free it */
9998 if (tmpObj) {
9999 Jim_FreeNewObj(interp, tmpObj);
10002 return scanned;
10005 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10006 * string and returns all converted (and not ignored) values in a list back
10007 * to the caller. If an error occured, a NULL pointer will be returned */
10009 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10011 size_t i, pos;
10012 int scanned = 1;
10013 const char *str = Jim_String(strObjPtr);
10014 int strLen = Jim_Utf8Length(interp, strObjPtr);
10015 Jim_Obj *resultList = 0;
10016 Jim_Obj **resultVec = 0;
10017 int resultc;
10018 Jim_Obj *emptyStr = 0;
10019 ScanFmtStringObj *fmtObj;
10021 /* This should never happen. The format object should already be of the correct type */
10022 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10024 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10025 /* Check if format specification was valid */
10026 if (fmtObj->error != 0) {
10027 if (flags & JIM_ERRMSG)
10028 Jim_SetResultString(interp, fmtObj->error, -1);
10029 return 0;
10031 /* Allocate a new "shared" empty string for all unassigned conversions */
10032 emptyStr = Jim_NewEmptyStringObj(interp);
10033 Jim_IncrRefCount(emptyStr);
10034 /* Create a list and fill it with empty strings up to max specified XPG3 */
10035 resultList = Jim_NewListObj(interp, NULL, 0);
10036 if (fmtObj->maxPos > 0) {
10037 for (i = 0; i < fmtObj->maxPos; ++i)
10038 Jim_ListAppendElement(interp, resultList, emptyStr);
10039 JimListGetElements(interp, resultList, &resultc, &resultVec);
10041 /* Now handle every partial format description */
10042 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10043 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10044 Jim_Obj *value = 0;
10046 /* Only last type may be "literal" w/o conversion - skip it! */
10047 if (descr->type == 0)
10048 continue;
10049 /* As long as any conversion could be done, we will proceed */
10050 if (scanned > 0)
10051 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10052 /* In case our first try results in EOF, we will leave */
10053 if (scanned == -1 && i == 0)
10054 goto eof;
10055 /* Advance next pos-to-be-scanned for the amount scanned already */
10056 pos += scanned;
10058 /* value == 0 means no conversion took place so take empty string */
10059 if (value == 0)
10060 value = Jim_NewEmptyStringObj(interp);
10061 /* If value is a non-assignable one, skip it */
10062 if (descr->pos == -1) {
10063 Jim_FreeNewObj(interp, value);
10065 else if (descr->pos == 0)
10066 /* Otherwise append it to the result list if no XPG3 was given */
10067 Jim_ListAppendElement(interp, resultList, value);
10068 else if (resultVec[descr->pos - 1] == emptyStr) {
10069 /* But due to given XPG3, put the value into the corr. slot */
10070 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10071 Jim_IncrRefCount(value);
10072 resultVec[descr->pos - 1] = value;
10074 else {
10075 /* Otherwise, the slot was already used - free obj and ERROR */
10076 Jim_FreeNewObj(interp, value);
10077 goto err;
10080 Jim_DecrRefCount(interp, emptyStr);
10081 return resultList;
10082 eof:
10083 Jim_DecrRefCount(interp, emptyStr);
10084 Jim_FreeNewObj(interp, resultList);
10085 return (Jim_Obj *)EOF;
10086 err:
10087 Jim_DecrRefCount(interp, emptyStr);
10088 Jim_FreeNewObj(interp, resultList);
10089 return 0;
10092 /* -----------------------------------------------------------------------------
10093 * Pseudo Random Number Generation
10094 * ---------------------------------------------------------------------------*/
10095 /* Initialize the sbox with the numbers from 0 to 255 */
10096 static void JimPrngInit(Jim_Interp *interp)
10098 #define PRNG_SEED_SIZE 256
10099 int i;
10100 unsigned int *seed;
10101 time_t t = time(NULL);
10103 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10105 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10106 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10107 seed[i] = (rand() ^ t ^ clock());
10109 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10110 Jim_Free(seed);
10113 /* Generates N bytes of random data */
10114 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10116 Jim_PrngState *prng;
10117 unsigned char *destByte = (unsigned char *)dest;
10118 unsigned int si, sj, x;
10120 /* initialization, only needed the first time */
10121 if (interp->prngState == NULL)
10122 JimPrngInit(interp);
10123 prng = interp->prngState;
10124 /* generates 'len' bytes of pseudo-random numbers */
10125 for (x = 0; x < len; x++) {
10126 prng->i = (prng->i + 1) & 0xff;
10127 si = prng->sbox[prng->i];
10128 prng->j = (prng->j + si) & 0xff;
10129 sj = prng->sbox[prng->j];
10130 prng->sbox[prng->i] = sj;
10131 prng->sbox[prng->j] = si;
10132 *destByte++ = prng->sbox[(si + sj) & 0xff];
10136 /* Re-seed the generator with user-provided bytes */
10137 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10139 int i;
10140 Jim_PrngState *prng;
10142 /* initialization, only needed the first time */
10143 if (interp->prngState == NULL)
10144 JimPrngInit(interp);
10145 prng = interp->prngState;
10147 /* Set the sbox[i] with i */
10148 for (i = 0; i < 256; i++)
10149 prng->sbox[i] = i;
10150 /* Now use the seed to perform a random permutation of the sbox */
10151 for (i = 0; i < seedLen; i++) {
10152 unsigned char t;
10154 t = prng->sbox[i & 0xFF];
10155 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10156 prng->sbox[seed[i]] = t;
10158 prng->i = prng->j = 0;
10160 /* discard at least the first 256 bytes of stream.
10161 * borrow the seed buffer for this
10163 for (i = 0; i < 256; i += seedLen) {
10164 JimRandomBytes(interp, seed, seedLen);
10168 /* [incr] */
10169 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10171 jim_wide wideValue, increment = 1;
10172 Jim_Obj *intObjPtr;
10174 if (argc != 2 && argc != 3) {
10175 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10176 return JIM_ERR;
10178 if (argc == 3) {
10179 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10180 return JIM_ERR;
10182 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10183 if (!intObjPtr) {
10184 /* Set missing variable to 0 */
10185 wideValue = 0;
10187 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10188 return JIM_ERR;
10190 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10191 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10192 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10193 Jim_FreeNewObj(interp, intObjPtr);
10194 return JIM_ERR;
10197 else {
10198 /* Can do it the quick way */
10199 Jim_InvalidateStringRep(intObjPtr);
10200 JimWideValue(intObjPtr) = wideValue + increment;
10202 /* The following step is required in order to invalidate the
10203 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10204 if (argv[1]->typePtr != &variableObjType) {
10205 /* Note that this can't fail since GetVariable already succeeded */
10206 Jim_SetVariable(interp, argv[1], intObjPtr);
10209 Jim_SetResult(interp, intObjPtr);
10210 return JIM_OK;
10214 /* -----------------------------------------------------------------------------
10215 * Eval
10216 * ---------------------------------------------------------------------------*/
10217 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10218 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10220 /* Handle calls to the [unknown] command */
10221 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10223 int retcode;
10225 /* If JimUnknown() is recursively called too many times...
10226 * done here
10228 if (interp->unknown_called > 50) {
10229 return JIM_ERR;
10232 /* The object interp->unknown just contains
10233 * the "unknown" string, it is used in order to
10234 * avoid to lookup the unknown command every time
10235 * but instead to cache the result. */
10237 /* If the [unknown] command does not exist ... */
10238 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10239 return JIM_ERR;
10241 interp->unknown_called++;
10242 /* XXX: Are we losing fileNameObj and linenr? */
10243 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10244 interp->unknown_called--;
10246 return retcode;
10249 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10251 int retcode;
10252 Jim_Cmd *cmdPtr;
10254 #if 0
10255 printf("invoke");
10256 int j;
10257 for (j = 0; j < objc; j++) {
10258 printf(" '%s'", Jim_String(objv[j]));
10260 printf("\n");
10261 #endif
10263 if (interp->framePtr->tailcallCmd) {
10264 /* Special tailcall command was pre-resolved */
10265 cmdPtr = interp->framePtr->tailcallCmd;
10266 interp->framePtr->tailcallCmd = NULL;
10268 else {
10269 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10270 if (cmdPtr == NULL) {
10271 return JimUnknown(interp, objc, objv);
10273 JimIncrCmdRefCount(cmdPtr);
10276 if (interp->evalDepth == interp->maxEvalDepth) {
10277 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10278 retcode = JIM_ERR;
10279 goto out;
10281 interp->evalDepth++;
10283 /* Call it -- Make sure result is an empty object. */
10284 Jim_SetEmptyResult(interp);
10285 if (cmdPtr->isproc) {
10286 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10288 else {
10289 interp->cmdPrivData = cmdPtr->u.native.privData;
10290 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10292 interp->evalDepth--;
10294 out:
10295 JimDecrCmdRefCount(interp, cmdPtr);
10297 return retcode;
10300 /* Eval the object vector 'objv' composed of 'objc' elements.
10301 * Every element is used as single argument.
10302 * Jim_EvalObj() will call this function every time its object
10303 * argument is of "list" type, with no string representation.
10305 * This is possible because the string representation of a
10306 * list object generated by the UpdateStringOfList is made
10307 * in a way that ensures that every list element is a different
10308 * command argument. */
10309 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10311 int i, retcode;
10313 /* Incr refcount of arguments. */
10314 for (i = 0; i < objc; i++)
10315 Jim_IncrRefCount(objv[i]);
10317 retcode = JimInvokeCommand(interp, objc, objv);
10319 /* Decr refcount of arguments and return the retcode */
10320 for (i = 0; i < objc; i++)
10321 Jim_DecrRefCount(interp, objv[i]);
10323 return retcode;
10327 * Invokes 'prefix' as a command with the objv array as arguments.
10329 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10331 int ret;
10332 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10334 nargv[0] = prefix;
10335 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10336 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10337 Jim_Free(nargv);
10338 return ret;
10341 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10343 if (!interp->errorFlag) {
10344 /* This is the first error, so save the file/line information and reset the stack */
10345 interp->errorFlag = 1;
10346 Jim_IncrRefCount(script->fileNameObj);
10347 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10348 interp->errorFileNameObj = script->fileNameObj;
10349 interp->errorLine = script->linenr;
10351 JimResetStackTrace(interp);
10352 /* Always add a level where the error first occurs */
10353 interp->addStackTrace++;
10356 /* Now if this is an "interesting" level, add it to the stack trace */
10357 if (interp->addStackTrace > 0) {
10358 /* Add the stack info for the current level */
10360 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10362 /* Note: if we didn't have a filename for this level,
10363 * don't clear the addStackTrace flag
10364 * so we can pick it up at the next level
10366 if (Jim_Length(script->fileNameObj)) {
10367 interp->addStackTrace = 0;
10370 Jim_DecrRefCount(interp, interp->errorProc);
10371 interp->errorProc = interp->emptyObj;
10372 Jim_IncrRefCount(interp->errorProc);
10376 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10378 Jim_Obj *objPtr;
10380 switch (token->type) {
10381 case JIM_TT_STR:
10382 case JIM_TT_ESC:
10383 objPtr = token->objPtr;
10384 break;
10385 case JIM_TT_VAR:
10386 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10387 break;
10388 case JIM_TT_DICTSUGAR:
10389 objPtr = JimExpandDictSugar(interp, token->objPtr);
10390 break;
10391 case JIM_TT_EXPRSUGAR:
10392 objPtr = JimExpandExprSugar(interp, token->objPtr);
10393 break;
10394 case JIM_TT_CMD:
10395 switch (Jim_EvalObj(interp, token->objPtr)) {
10396 case JIM_OK:
10397 case JIM_RETURN:
10398 objPtr = interp->result;
10399 break;
10400 case JIM_BREAK:
10401 /* Stop substituting */
10402 return JIM_BREAK;
10403 case JIM_CONTINUE:
10404 /* just skip this one */
10405 return JIM_CONTINUE;
10406 default:
10407 return JIM_ERR;
10409 break;
10410 default:
10411 JimPanic((1,
10412 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10413 objPtr = NULL;
10414 break;
10416 if (objPtr) {
10417 *objPtrPtr = objPtr;
10418 return JIM_OK;
10420 return JIM_ERR;
10423 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10424 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10425 * The returned object has refcount = 0.
10427 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10429 int totlen = 0, i;
10430 Jim_Obj **intv;
10431 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10432 Jim_Obj *objPtr;
10433 char *s;
10435 if (tokens <= JIM_EVAL_SINTV_LEN)
10436 intv = sintv;
10437 else
10438 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10440 /* Compute every token forming the argument
10441 * in the intv objects vector. */
10442 for (i = 0; i < tokens; i++) {
10443 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10444 case JIM_OK:
10445 case JIM_RETURN:
10446 break;
10447 case JIM_BREAK:
10448 if (flags & JIM_SUBST_FLAG) {
10449 /* Stop here */
10450 tokens = i;
10451 continue;
10453 /* XXX: Should probably set an error about break outside loop */
10454 /* fall through to error */
10455 case JIM_CONTINUE:
10456 if (flags & JIM_SUBST_FLAG) {
10457 intv[i] = NULL;
10458 continue;
10460 /* XXX: Ditto continue outside loop */
10461 /* fall through to error */
10462 default:
10463 while (i--) {
10464 Jim_DecrRefCount(interp, intv[i]);
10466 if (intv != sintv) {
10467 Jim_Free(intv);
10469 return NULL;
10471 Jim_IncrRefCount(intv[i]);
10472 Jim_String(intv[i]);
10473 totlen += intv[i]->length;
10476 /* Fast path return for a single token */
10477 if (tokens == 1 && intv[0] && intv == sintv) {
10478 Jim_DecrRefCount(interp, intv[0]);
10479 return intv[0];
10482 /* Concatenate every token in an unique
10483 * object. */
10484 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10486 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10487 && token[2].type == JIM_TT_VAR) {
10488 /* May be able to do fast interpolated object -> dictSubst */
10489 objPtr->typePtr = &interpolatedObjType;
10490 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10491 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10492 Jim_IncrRefCount(intv[2]);
10494 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10495 /* The first interpolated token is source, so preserve the source info */
10496 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10500 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10501 objPtr->length = totlen;
10502 for (i = 0; i < tokens; i++) {
10503 if (intv[i]) {
10504 memcpy(s, intv[i]->bytes, intv[i]->length);
10505 s += intv[i]->length;
10506 Jim_DecrRefCount(interp, intv[i]);
10509 objPtr->bytes[totlen] = '\0';
10510 /* Free the intv vector if not static. */
10511 if (intv != sintv) {
10512 Jim_Free(intv);
10515 return objPtr;
10519 /* listPtr *must* be a list.
10520 * The contents of the list is evaluated with the first element as the command and
10521 * the remaining elements as the arguments.
10523 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10525 int retcode = JIM_OK;
10527 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10529 if (listPtr->internalRep.listValue.len) {
10530 Jim_IncrRefCount(listPtr);
10531 retcode = JimInvokeCommand(interp,
10532 listPtr->internalRep.listValue.len,
10533 listPtr->internalRep.listValue.ele);
10534 Jim_DecrRefCount(interp, listPtr);
10536 return retcode;
10539 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10541 SetListFromAny(interp, listPtr);
10542 return JimEvalObjList(interp, listPtr);
10545 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10547 int i;
10548 ScriptObj *script;
10549 ScriptToken *token;
10550 int retcode = JIM_OK;
10551 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10552 Jim_Obj *prevScriptObj;
10554 /* If the object is of type "list", with no string rep we can call
10555 * a specialized version of Jim_EvalObj() */
10556 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10557 return JimEvalObjList(interp, scriptObjPtr);
10560 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10561 script = JimGetScript(interp, scriptObjPtr);
10562 if (!JimScriptValid(interp, script)) {
10563 Jim_DecrRefCount(interp, scriptObjPtr);
10564 return JIM_ERR;
10567 /* Reset the interpreter result. This is useful to
10568 * return the empty result in the case of empty program. */
10569 Jim_SetEmptyResult(interp);
10571 token = script->token;
10573 #ifdef JIM_OPTIMIZATION
10574 /* Check for one of the following common scripts used by for, while
10576 * {}
10577 * incr a
10579 if (script->len == 0) {
10580 Jim_DecrRefCount(interp, scriptObjPtr);
10581 return JIM_OK;
10583 if (script->len == 3
10584 && token[1].objPtr->typePtr == &commandObjType
10585 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10586 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10587 && token[2].objPtr->typePtr == &variableObjType) {
10589 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10591 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10592 JimWideValue(objPtr)++;
10593 Jim_InvalidateStringRep(objPtr);
10594 Jim_DecrRefCount(interp, scriptObjPtr);
10595 Jim_SetResult(interp, objPtr);
10596 return JIM_OK;
10599 #endif
10601 /* Now we have to make sure the internal repr will not be
10602 * freed on shimmering.
10604 * Think for example to this:
10606 * set x {llength $x; ... some more code ...}; eval $x
10608 * In order to preserve the internal rep, we increment the
10609 * inUse field of the script internal rep structure. */
10610 script->inUse++;
10612 /* Stash the current script */
10613 prevScriptObj = interp->currentScriptObj;
10614 interp->currentScriptObj = scriptObjPtr;
10616 interp->errorFlag = 0;
10617 argv = sargv;
10619 /* Execute every command sequentially until the end of the script
10620 * or an error occurs.
10622 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10623 int argc;
10624 int j;
10626 /* First token of the line is always JIM_TT_LINE */
10627 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10628 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10630 /* Allocate the arguments vector if required */
10631 if (argc > JIM_EVAL_SARGV_LEN)
10632 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10634 /* Skip the JIM_TT_LINE token */
10635 i++;
10637 /* Populate the arguments objects.
10638 * If an error occurs, retcode will be set and
10639 * 'j' will be set to the number of args expanded
10641 for (j = 0; j < argc; j++) {
10642 long wordtokens = 1;
10643 int expand = 0;
10644 Jim_Obj *wordObjPtr = NULL;
10646 if (token[i].type == JIM_TT_WORD) {
10647 wordtokens = JimWideValue(token[i++].objPtr);
10648 if (wordtokens < 0) {
10649 expand = 1;
10650 wordtokens = -wordtokens;
10654 if (wordtokens == 1) {
10655 /* Fast path if the token does not
10656 * need interpolation */
10658 switch (token[i].type) {
10659 case JIM_TT_ESC:
10660 case JIM_TT_STR:
10661 wordObjPtr = token[i].objPtr;
10662 break;
10663 case JIM_TT_VAR:
10664 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10665 break;
10666 case JIM_TT_EXPRSUGAR:
10667 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10668 break;
10669 case JIM_TT_DICTSUGAR:
10670 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10671 break;
10672 case JIM_TT_CMD:
10673 retcode = Jim_EvalObj(interp, token[i].objPtr);
10674 if (retcode == JIM_OK) {
10675 wordObjPtr = Jim_GetResult(interp);
10677 break;
10678 default:
10679 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10682 else {
10683 /* For interpolation we call a helper
10684 * function to do the work for us. */
10685 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10688 if (!wordObjPtr) {
10689 if (retcode == JIM_OK) {
10690 retcode = JIM_ERR;
10692 break;
10695 Jim_IncrRefCount(wordObjPtr);
10696 i += wordtokens;
10698 if (!expand) {
10699 argv[j] = wordObjPtr;
10701 else {
10702 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10703 int len = Jim_ListLength(interp, wordObjPtr);
10704 int newargc = argc + len - 1;
10705 int k;
10707 if (len > 1) {
10708 if (argv == sargv) {
10709 if (newargc > JIM_EVAL_SARGV_LEN) {
10710 argv = Jim_Alloc(sizeof(*argv) * newargc);
10711 memcpy(argv, sargv, sizeof(*argv) * j);
10714 else {
10715 /* Need to realloc to make room for (len - 1) more entries */
10716 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10720 /* Now copy in the expanded version */
10721 for (k = 0; k < len; k++) {
10722 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10723 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10726 /* The original object reference is no longer needed,
10727 * after the expansion it is no longer present on
10728 * the argument vector, but the single elements are
10729 * in its place. */
10730 Jim_DecrRefCount(interp, wordObjPtr);
10732 /* And update the indexes */
10733 j--;
10734 argc += len - 1;
10738 if (retcode == JIM_OK && argc) {
10739 /* Invoke the command */
10740 retcode = JimInvokeCommand(interp, argc, argv);
10741 /* Check for a signal after each command */
10742 if (Jim_CheckSignal(interp)) {
10743 retcode = JIM_SIGNAL;
10747 /* Finished with the command, so decrement ref counts of each argument */
10748 while (j-- > 0) {
10749 Jim_DecrRefCount(interp, argv[j]);
10752 if (argv != sargv) {
10753 Jim_Free(argv);
10754 argv = sargv;
10758 /* Possibly add to the error stack trace */
10759 if (retcode == JIM_ERR) {
10760 JimAddErrorToStack(interp, script);
10762 /* Propagate the addStackTrace value through 'return -code error' */
10763 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10764 /* No need to add stack trace */
10765 interp->addStackTrace = 0;
10768 /* Restore the current script */
10769 interp->currentScriptObj = prevScriptObj;
10771 /* Note that we don't have to decrement inUse, because the
10772 * following code transfers our use of the reference again to
10773 * the script object. */
10774 Jim_FreeIntRep(interp, scriptObjPtr);
10775 scriptObjPtr->typePtr = &scriptObjType;
10776 Jim_SetIntRepPtr(scriptObjPtr, script);
10777 Jim_DecrRefCount(interp, scriptObjPtr);
10779 return retcode;
10782 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10784 int retcode;
10785 /* If argObjPtr begins with '&', do an automatic upvar */
10786 const char *varname = Jim_String(argNameObj);
10787 if (*varname == '&') {
10788 /* First check that the target variable exists */
10789 Jim_Obj *objPtr;
10790 Jim_CallFrame *savedCallFrame = interp->framePtr;
10792 interp->framePtr = interp->framePtr->parent;
10793 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10794 interp->framePtr = savedCallFrame;
10795 if (!objPtr) {
10796 return JIM_ERR;
10799 /* It exists, so perform the binding. */
10800 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10801 Jim_IncrRefCount(objPtr);
10802 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10803 Jim_DecrRefCount(interp, objPtr);
10805 else {
10806 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10808 return retcode;
10812 * Sets the interp result to be an error message indicating the required proc args.
10814 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10816 /* Create a nice error message, consistent with Tcl 8.5 */
10817 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10818 int i;
10820 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10821 Jim_AppendString(interp, argmsg, " ", 1);
10823 if (i == cmd->u.proc.argsPos) {
10824 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10825 /* Renamed args */
10826 Jim_AppendString(interp, argmsg, "?", 1);
10827 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10828 Jim_AppendString(interp, argmsg, " ...?", -1);
10830 else {
10831 /* We have plain args */
10832 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10835 else {
10836 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10837 Jim_AppendString(interp, argmsg, "?", 1);
10838 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10839 Jim_AppendString(interp, argmsg, "?", 1);
10841 else {
10842 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10843 if (*arg == '&') {
10844 arg++;
10846 Jim_AppendString(interp, argmsg, arg, -1);
10850 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10851 Jim_FreeNewObj(interp, argmsg);
10854 #ifdef jim_ext_namespace
10856 * [namespace eval]
10858 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10860 Jim_CallFrame *callFramePtr;
10861 int retcode;
10863 /* Create a new callframe */
10864 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10865 callFramePtr->argv = &interp->emptyObj;
10866 callFramePtr->argc = 0;
10867 callFramePtr->procArgsObjPtr = NULL;
10868 callFramePtr->procBodyObjPtr = scriptObj;
10869 callFramePtr->staticVars = NULL;
10870 callFramePtr->fileNameObj = interp->emptyObj;
10871 callFramePtr->line = 0;
10872 Jim_IncrRefCount(scriptObj);
10873 interp->framePtr = callFramePtr;
10875 /* Check if there are too nested calls */
10876 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10877 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10878 retcode = JIM_ERR;
10880 else {
10881 /* Eval the body */
10882 retcode = Jim_EvalObj(interp, scriptObj);
10885 /* Destroy the callframe */
10886 interp->framePtr = interp->framePtr->parent;
10887 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10889 return retcode;
10891 #endif
10893 /* Call a procedure implemented in Tcl.
10894 * It's possible to speed-up a lot this function, currently
10895 * the callframes are not cached, but allocated and
10896 * destroied every time. What is expecially costly is
10897 * to create/destroy the local vars hash table every time.
10899 * This can be fixed just implementing callframes caching
10900 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10901 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10903 Jim_CallFrame *callFramePtr;
10904 int i, d, retcode, optargs;
10905 ScriptObj *script;
10907 /* Check arity */
10908 if (argc - 1 < cmd->u.proc.reqArity ||
10909 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10910 JimSetProcWrongArgs(interp, argv[0], cmd);
10911 return JIM_ERR;
10914 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10915 /* Optimise for procedure with no body - useful for optional debugging */
10916 return JIM_OK;
10919 /* Check if there are too nested calls */
10920 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10921 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10922 return JIM_ERR;
10925 /* Create a new callframe */
10926 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10927 callFramePtr->argv = argv;
10928 callFramePtr->argc = argc;
10929 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10930 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10931 callFramePtr->staticVars = cmd->u.proc.staticVars;
10933 /* Remember where we were called from. */
10934 script = JimGetScript(interp, interp->currentScriptObj);
10935 callFramePtr->fileNameObj = script->fileNameObj;
10936 callFramePtr->line = script->linenr;
10938 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10939 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10940 interp->framePtr = callFramePtr;
10942 /* How many optional args are available */
10943 optargs = (argc - 1 - cmd->u.proc.reqArity);
10945 /* Step 'i' along the actual args, and step 'd' along the formal args */
10946 i = 1;
10947 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10948 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10949 if (d == cmd->u.proc.argsPos) {
10950 /* assign $args */
10951 Jim_Obj *listObjPtr;
10952 int argsLen = 0;
10953 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10954 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10956 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10958 /* It is possible to rename args. */
10959 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10960 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10962 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10963 if (retcode != JIM_OK) {
10964 goto badargset;
10967 i += argsLen;
10968 continue;
10971 /* Optional or required? */
10972 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10973 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10975 else {
10976 /* Ran out, so use the default */
10977 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10979 if (retcode != JIM_OK) {
10980 goto badargset;
10984 /* Eval the body */
10985 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10987 badargset:
10989 /* Free the callframe */
10990 interp->framePtr = interp->framePtr->parent;
10991 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10993 /* Now chain any tailcalls in the parent frame */
10994 if (interp->framePtr->tailcallObj) {
10995 do {
10996 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10998 interp->framePtr->tailcallObj = NULL;
11000 if (retcode == JIM_EVAL) {
11001 retcode = Jim_EvalObjList(interp, tailcallObj);
11002 if (retcode == JIM_RETURN) {
11003 /* If the result of the tailcall is 'return', push
11004 * it up to the caller
11006 interp->returnLevel++;
11009 Jim_DecrRefCount(interp, tailcallObj);
11010 } while (interp->framePtr->tailcallObj);
11012 /* If the tailcall chain finished early, may need to manually discard the command */
11013 if (interp->framePtr->tailcallCmd) {
11014 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11015 interp->framePtr->tailcallCmd = NULL;
11019 /* Handle the JIM_RETURN return code */
11020 if (retcode == JIM_RETURN) {
11021 if (--interp->returnLevel <= 0) {
11022 retcode = interp->returnCode;
11023 interp->returnCode = JIM_OK;
11024 interp->returnLevel = 0;
11027 else if (retcode == JIM_ERR) {
11028 interp->addStackTrace++;
11029 Jim_DecrRefCount(interp, interp->errorProc);
11030 interp->errorProc = argv[0];
11031 Jim_IncrRefCount(interp->errorProc);
11034 return retcode;
11037 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11039 int retval;
11040 Jim_Obj *scriptObjPtr;
11042 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11043 Jim_IncrRefCount(scriptObjPtr);
11045 if (filename) {
11046 Jim_Obj *prevScriptObj;
11048 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11050 prevScriptObj = interp->currentScriptObj;
11051 interp->currentScriptObj = scriptObjPtr;
11053 retval = Jim_EvalObj(interp, scriptObjPtr);
11055 interp->currentScriptObj = prevScriptObj;
11057 else {
11058 retval = Jim_EvalObj(interp, scriptObjPtr);
11060 Jim_DecrRefCount(interp, scriptObjPtr);
11061 return retval;
11064 int Jim_Eval(Jim_Interp *interp, const char *script)
11066 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11069 /* Execute script in the scope of the global level */
11070 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11072 int retval;
11073 Jim_CallFrame *savedFramePtr = interp->framePtr;
11075 interp->framePtr = interp->topFramePtr;
11076 retval = Jim_Eval(interp, script);
11077 interp->framePtr = savedFramePtr;
11079 return retval;
11082 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11084 int retval;
11085 Jim_CallFrame *savedFramePtr = interp->framePtr;
11087 interp->framePtr = interp->topFramePtr;
11088 retval = Jim_EvalFile(interp, filename);
11089 interp->framePtr = savedFramePtr;
11091 return retval;
11094 #include <sys/stat.h>
11096 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11098 FILE *fp;
11099 char *buf;
11100 Jim_Obj *scriptObjPtr;
11101 Jim_Obj *prevScriptObj;
11102 struct stat sb;
11103 int retcode;
11104 int readlen;
11106 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11107 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11108 return JIM_ERR;
11110 if (sb.st_size == 0) {
11111 fclose(fp);
11112 return JIM_OK;
11115 buf = Jim_Alloc(sb.st_size + 1);
11116 readlen = fread(buf, 1, sb.st_size, fp);
11117 if (ferror(fp)) {
11118 fclose(fp);
11119 Jim_Free(buf);
11120 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11121 return JIM_ERR;
11123 fclose(fp);
11124 buf[readlen] = 0;
11126 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11127 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11128 Jim_IncrRefCount(scriptObjPtr);
11130 prevScriptObj = interp->currentScriptObj;
11131 interp->currentScriptObj = scriptObjPtr;
11133 retcode = Jim_EvalObj(interp, scriptObjPtr);
11135 /* Handle the JIM_RETURN return code */
11136 if (retcode == JIM_RETURN) {
11137 if (--interp->returnLevel <= 0) {
11138 retcode = interp->returnCode;
11139 interp->returnCode = JIM_OK;
11140 interp->returnLevel = 0;
11143 if (retcode == JIM_ERR) {
11144 /* EvalFile changes context, so add a stack frame here */
11145 interp->addStackTrace++;
11148 interp->currentScriptObj = prevScriptObj;
11150 Jim_DecrRefCount(interp, scriptObjPtr);
11152 return retcode;
11155 /* -----------------------------------------------------------------------------
11156 * Subst
11157 * ---------------------------------------------------------------------------*/
11158 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11160 pc->tstart = pc->p;
11161 pc->tline = pc->linenr;
11163 if (pc->len == 0) {
11164 pc->tend = pc->p;
11165 pc->tt = JIM_TT_EOL;
11166 pc->eof = 1;
11167 return;
11169 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11170 JimParseCmd(pc);
11171 return;
11173 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11174 if (JimParseVar(pc) == JIM_OK) {
11175 return;
11177 /* Not a var, so treat as a string */
11178 pc->tstart = pc->p;
11179 flags |= JIM_SUBST_NOVAR;
11181 while (pc->len) {
11182 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11183 break;
11185 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11186 break;
11188 if (*pc->p == '\\' && pc->len > 1) {
11189 pc->p++;
11190 pc->len--;
11192 pc->p++;
11193 pc->len--;
11195 pc->tend = pc->p - 1;
11196 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11199 /* The subst object type reuses most of the data structures and functions
11200 * of the script object. Script's data structures are a bit more complex
11201 * for what is needed for [subst]itution tasks, but the reuse helps to
11202 * deal with a single data structure at the cost of some more memory
11203 * usage for substitutions. */
11205 /* This method takes the string representation of an object
11206 * as a Tcl string where to perform [subst]itution, and generates
11207 * the pre-parsed internal representation. */
11208 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11210 int scriptTextLen;
11211 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11212 struct JimParserCtx parser;
11213 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11214 ParseTokenList tokenlist;
11216 /* Initially parse the subst into tokens (in tokenlist) */
11217 ScriptTokenListInit(&tokenlist);
11219 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11220 while (1) {
11221 JimParseSubst(&parser, flags);
11222 if (parser.eof) {
11223 /* Note that subst doesn't need the EOL token */
11224 break;
11226 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11227 parser.tline);
11230 /* Create the "real" subst/script tokens from the initial token list */
11231 script->inUse = 1;
11232 script->substFlags = flags;
11233 script->fileNameObj = interp->emptyObj;
11234 Jim_IncrRefCount(script->fileNameObj);
11235 SubstObjAddTokens(interp, script, &tokenlist);
11237 /* No longer need the token list */
11238 ScriptTokenListFree(&tokenlist);
11240 #ifdef DEBUG_SHOW_SUBST
11242 int i;
11244 printf("==== Subst ====\n");
11245 for (i = 0; i < script->len; i++) {
11246 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11247 Jim_String(script->token[i].objPtr));
11250 #endif
11252 /* Free the old internal rep and set the new one. */
11253 Jim_FreeIntRep(interp, objPtr);
11254 Jim_SetIntRepPtr(objPtr, script);
11255 objPtr->typePtr = &scriptObjType;
11256 return JIM_OK;
11259 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11261 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11262 SetSubstFromAny(interp, objPtr, flags);
11263 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11266 /* Performs commands,variables,blackslashes substitution,
11267 * storing the result object (with refcount 0) into
11268 * resObjPtrPtr. */
11269 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11271 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11273 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11274 /* In order to preserve the internal rep, we increment the
11275 * inUse field of the script internal rep structure. */
11276 script->inUse++;
11278 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11280 script->inUse--;
11281 Jim_DecrRefCount(interp, substObjPtr);
11282 if (*resObjPtrPtr == NULL) {
11283 return JIM_ERR;
11285 return JIM_OK;
11288 /* -----------------------------------------------------------------------------
11289 * Core commands utility functions
11290 * ---------------------------------------------------------------------------*/
11291 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11293 Jim_Obj *objPtr;
11294 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11296 if (*msg) {
11297 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11299 Jim_IncrRefCount(listObjPtr);
11300 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11301 Jim_DecrRefCount(interp, listObjPtr);
11303 Jim_IncrRefCount(objPtr);
11304 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11305 Jim_DecrRefCount(interp, objPtr);
11309 * May add the key and/or value to the list.
11311 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11312 Jim_HashEntry *he, int type);
11314 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11317 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11318 * invoke the callback to add entries to a list.
11319 * Returns the list.
11321 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11322 JimHashtableIteratorCallbackType *callback, int type)
11324 Jim_HashEntry *he;
11325 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11327 /* Check for the non-pattern case. We can do this much more efficiently. */
11328 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11329 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11330 if (he) {
11331 callback(interp, listObjPtr, he, type);
11334 else {
11335 Jim_HashTableIterator htiter;
11336 JimInitHashTableIterator(ht, &htiter);
11337 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11338 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11339 callback(interp, listObjPtr, he, type);
11343 return listObjPtr;
11346 /* Keep these in order */
11347 #define JIM_CMDLIST_COMMANDS 0
11348 #define JIM_CMDLIST_PROCS 1
11349 #define JIM_CMDLIST_CHANNELS 2
11352 * Adds matching command names (procs, channels) to the list.
11354 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11355 Jim_HashEntry *he, int type)
11357 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11358 Jim_Obj *objPtr;
11360 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11361 /* not a proc */
11362 return;
11365 objPtr = Jim_NewStringObj(interp, he->key, -1);
11366 Jim_IncrRefCount(objPtr);
11368 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11369 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11371 Jim_DecrRefCount(interp, objPtr);
11374 /* type is JIM_CMDLIST_xxx */
11375 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11377 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11380 /* Keep these in order */
11381 #define JIM_VARLIST_GLOBALS 0
11382 #define JIM_VARLIST_LOCALS 1
11383 #define JIM_VARLIST_VARS 2
11385 #define JIM_VARLIST_VALUES 0x1000
11388 * Adds matching variable names to the list.
11390 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11391 Jim_HashEntry *he, int type)
11393 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11395 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11396 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11397 if (type & JIM_VARLIST_VALUES) {
11398 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11403 /* mode is JIM_VARLIST_xxx */
11404 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11406 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11407 /* For [info locals], if we are at top level an emtpy list
11408 * is returned. I don't agree, but we aim at compatibility (SS) */
11409 return interp->emptyObj;
11411 else {
11412 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11413 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11417 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11418 Jim_Obj **objPtrPtr, int info_level_cmd)
11420 Jim_CallFrame *targetCallFrame;
11422 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11423 if (targetCallFrame == NULL) {
11424 return JIM_ERR;
11426 /* No proc call at toplevel callframe */
11427 if (targetCallFrame == interp->topFramePtr) {
11428 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11429 return JIM_ERR;
11431 if (info_level_cmd) {
11432 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11434 else {
11435 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11437 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11438 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11439 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11440 *objPtrPtr = listObj;
11442 return JIM_OK;
11445 /* -----------------------------------------------------------------------------
11446 * Core commands
11447 * ---------------------------------------------------------------------------*/
11449 /* fake [puts] -- not the real puts, just for debugging. */
11450 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11452 if (argc != 2 && argc != 3) {
11453 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11454 return JIM_ERR;
11456 if (argc == 3) {
11457 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11458 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11459 return JIM_ERR;
11461 else {
11462 fputs(Jim_String(argv[2]), stdout);
11465 else {
11466 puts(Jim_String(argv[1]));
11468 return JIM_OK;
11471 /* Helper for [+] and [*] */
11472 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11474 jim_wide wideValue, res;
11475 double doubleValue, doubleRes;
11476 int i;
11478 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11480 for (i = 1; i < argc; i++) {
11481 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11482 goto trydouble;
11483 if (op == JIM_EXPROP_ADD)
11484 res += wideValue;
11485 else
11486 res *= wideValue;
11488 Jim_SetResultInt(interp, res);
11489 return JIM_OK;
11490 trydouble:
11491 doubleRes = (double)res;
11492 for (; i < argc; i++) {
11493 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11494 return JIM_ERR;
11495 if (op == JIM_EXPROP_ADD)
11496 doubleRes += doubleValue;
11497 else
11498 doubleRes *= doubleValue;
11500 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11501 return JIM_OK;
11504 /* Helper for [-] and [/] */
11505 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11507 jim_wide wideValue, res = 0;
11508 double doubleValue, doubleRes = 0;
11509 int i = 2;
11511 if (argc < 2) {
11512 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11513 return JIM_ERR;
11515 else if (argc == 2) {
11516 /* The arity = 2 case is different. For [- x] returns -x,
11517 * while [/ x] returns 1/x. */
11518 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11519 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11520 return JIM_ERR;
11522 else {
11523 if (op == JIM_EXPROP_SUB)
11524 doubleRes = -doubleValue;
11525 else
11526 doubleRes = 1.0 / doubleValue;
11527 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11528 return JIM_OK;
11531 if (op == JIM_EXPROP_SUB) {
11532 res = -wideValue;
11533 Jim_SetResultInt(interp, res);
11535 else {
11536 doubleRes = 1.0 / wideValue;
11537 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11539 return JIM_OK;
11541 else {
11542 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11543 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11544 != JIM_OK) {
11545 return JIM_ERR;
11547 else {
11548 goto trydouble;
11552 for (i = 2; i < argc; i++) {
11553 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11554 doubleRes = (double)res;
11555 goto trydouble;
11557 if (op == JIM_EXPROP_SUB)
11558 res -= wideValue;
11559 else
11560 res /= wideValue;
11562 Jim_SetResultInt(interp, res);
11563 return JIM_OK;
11564 trydouble:
11565 for (; i < argc; i++) {
11566 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11567 return JIM_ERR;
11568 if (op == JIM_EXPROP_SUB)
11569 doubleRes -= doubleValue;
11570 else
11571 doubleRes /= doubleValue;
11573 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11574 return JIM_OK;
11578 /* [+] */
11579 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11581 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11584 /* [*] */
11585 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11587 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11590 /* [-] */
11591 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11593 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11596 /* [/] */
11597 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11599 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11602 /* [set] */
11603 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11605 if (argc != 2 && argc != 3) {
11606 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11607 return JIM_ERR;
11609 if (argc == 2) {
11610 Jim_Obj *objPtr;
11612 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11613 if (!objPtr)
11614 return JIM_ERR;
11615 Jim_SetResult(interp, objPtr);
11616 return JIM_OK;
11618 /* argc == 3 case. */
11619 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11620 return JIM_ERR;
11621 Jim_SetResult(interp, argv[2]);
11622 return JIM_OK;
11625 /* [unset]
11627 * unset ?-nocomplain? ?--? ?varName ...?
11629 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11631 int i = 1;
11632 int complain = 1;
11634 while (i < argc) {
11635 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11636 i++;
11637 break;
11639 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11640 complain = 0;
11641 i++;
11642 continue;
11644 break;
11647 while (i < argc) {
11648 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11649 && complain) {
11650 return JIM_ERR;
11652 i++;
11654 return JIM_OK;
11657 /* [while] */
11658 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11660 if (argc != 3) {
11661 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11662 return JIM_ERR;
11665 /* The general purpose implementation of while starts here */
11666 while (1) {
11667 int boolean, retval;
11669 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11670 return retval;
11671 if (!boolean)
11672 break;
11674 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11675 switch (retval) {
11676 case JIM_BREAK:
11677 goto out;
11678 break;
11679 case JIM_CONTINUE:
11680 continue;
11681 break;
11682 default:
11683 return retval;
11687 out:
11688 Jim_SetEmptyResult(interp);
11689 return JIM_OK;
11692 /* [for] */
11693 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11695 int retval;
11696 int boolean = 1;
11697 Jim_Obj *varNamePtr = NULL;
11698 Jim_Obj *stopVarNamePtr = NULL;
11700 if (argc != 5) {
11701 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11702 return JIM_ERR;
11705 /* Do the initialisation */
11706 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11707 return retval;
11710 /* And do the first test now. Better for optimisation
11711 * if we can do next/test at the bottom of the loop
11713 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11715 /* Ready to do the body as follows:
11716 * while (1) {
11717 * body // check retcode
11718 * next // check retcode
11719 * test // check retcode/test bool
11723 #ifdef JIM_OPTIMIZATION
11724 /* Check if the for is on the form:
11725 * for ... {$i < CONST} {incr i}
11726 * for ... {$i < $j} {incr i}
11728 if (retval == JIM_OK && boolean) {
11729 ScriptObj *incrScript;
11730 ExprByteCode *expr;
11731 jim_wide stop, currentVal;
11732 Jim_Obj *objPtr;
11733 int cmpOffset;
11735 /* Do it only if there aren't shared arguments */
11736 expr = JimGetExpression(interp, argv[2]);
11737 incrScript = JimGetScript(interp, argv[3]);
11739 /* Ensure proper lengths to start */
11740 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11741 goto evalstart;
11743 /* Ensure proper token types. */
11744 if (incrScript->token[1].type != JIM_TT_ESC ||
11745 expr->token[0].type != JIM_TT_VAR ||
11746 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11747 goto evalstart;
11750 if (expr->token[2].type == JIM_EXPROP_LT) {
11751 cmpOffset = 0;
11753 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11754 cmpOffset = 1;
11756 else {
11757 goto evalstart;
11760 /* Update command must be incr */
11761 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11762 goto evalstart;
11765 /* incr, expression must be about the same variable */
11766 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11767 goto evalstart;
11770 /* Get the stop condition (must be a variable or integer) */
11771 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11772 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11773 goto evalstart;
11776 else {
11777 stopVarNamePtr = expr->token[1].objPtr;
11778 Jim_IncrRefCount(stopVarNamePtr);
11779 /* Keep the compiler happy */
11780 stop = 0;
11783 /* Initialization */
11784 varNamePtr = expr->token[0].objPtr;
11785 Jim_IncrRefCount(varNamePtr);
11787 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11788 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11789 goto testcond;
11792 /* --- OPTIMIZED FOR --- */
11793 while (retval == JIM_OK) {
11794 /* === Check condition === */
11795 /* Note that currentVal is already set here */
11797 /* Immediate or Variable? get the 'stop' value if the latter. */
11798 if (stopVarNamePtr) {
11799 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11800 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11801 goto testcond;
11805 if (currentVal >= stop + cmpOffset) {
11806 break;
11809 /* Eval body */
11810 retval = Jim_EvalObj(interp, argv[4]);
11811 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11812 retval = JIM_OK;
11814 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11816 /* Increment */
11817 if (objPtr == NULL) {
11818 retval = JIM_ERR;
11819 goto out;
11821 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11822 currentVal = ++JimWideValue(objPtr);
11823 Jim_InvalidateStringRep(objPtr);
11825 else {
11826 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11827 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11828 ++currentVal)) != JIM_OK) {
11829 goto evalnext;
11834 goto out;
11836 evalstart:
11837 #endif
11839 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11840 /* Body */
11841 retval = Jim_EvalObj(interp, argv[4]);
11843 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11844 /* increment */
11845 evalnext:
11846 retval = Jim_EvalObj(interp, argv[3]);
11847 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11848 /* test */
11849 testcond:
11850 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11854 out:
11855 if (stopVarNamePtr) {
11856 Jim_DecrRefCount(interp, stopVarNamePtr);
11858 if (varNamePtr) {
11859 Jim_DecrRefCount(interp, varNamePtr);
11862 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11863 Jim_SetEmptyResult(interp);
11864 return JIM_OK;
11867 return retval;
11870 /* [loop] */
11871 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11873 int retval;
11874 jim_wide i;
11875 jim_wide limit;
11876 jim_wide incr = 1;
11877 Jim_Obj *bodyObjPtr;
11879 if (argc != 5 && argc != 6) {
11880 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11881 return JIM_ERR;
11884 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11885 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11886 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11887 return JIM_ERR;
11889 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11891 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11893 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11894 retval = Jim_EvalObj(interp, bodyObjPtr);
11895 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11896 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11898 retval = JIM_OK;
11900 /* Increment */
11901 i += incr;
11903 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11904 if (argv[1]->typePtr != &variableObjType) {
11905 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11906 return JIM_ERR;
11909 JimWideValue(objPtr) = i;
11910 Jim_InvalidateStringRep(objPtr);
11912 /* The following step is required in order to invalidate the
11913 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11914 if (argv[1]->typePtr != &variableObjType) {
11915 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11916 retval = JIM_ERR;
11917 break;
11921 else {
11922 objPtr = Jim_NewIntObj(interp, i);
11923 retval = Jim_SetVariable(interp, argv[1], objPtr);
11924 if (retval != JIM_OK) {
11925 Jim_FreeNewObj(interp, objPtr);
11931 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11932 Jim_SetEmptyResult(interp);
11933 return JIM_OK;
11935 return retval;
11938 /* List iterators make it easy to iterate over a list.
11939 * At some point iterators will be expanded to support generators.
11941 typedef struct {
11942 Jim_Obj *objPtr;
11943 int idx;
11944 } Jim_ListIter;
11947 * Initialise the iterator at the start of the list.
11949 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11951 iter->objPtr = objPtr;
11952 iter->idx = 0;
11956 * Returns the next object from the list, or NULL on end-of-list.
11958 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11960 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11961 return NULL;
11963 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11967 * Returns 1 if end-of-list has been reached.
11969 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11971 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11974 /* foreach + lmap implementation. */
11975 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11977 int result = JIM_OK;
11978 int i, numargs;
11979 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11980 Jim_ListIter *iters;
11981 Jim_Obj *script;
11982 Jim_Obj *resultObj;
11984 if (argc < 4 || argc % 2 != 0) {
11985 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11986 return JIM_ERR;
11988 script = argv[argc - 1]; /* Last argument is a script */
11989 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11991 if (numargs == 2) {
11992 iters = twoiters;
11994 else {
11995 iters = Jim_Alloc(numargs * sizeof(*iters));
11997 for (i = 0; i < numargs; i++) {
11998 JimListIterInit(&iters[i], argv[i + 1]);
11999 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12000 result = JIM_ERR;
12003 if (result != JIM_OK) {
12004 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12005 return result;
12008 if (doMap) {
12009 resultObj = Jim_NewListObj(interp, NULL, 0);
12011 else {
12012 resultObj = interp->emptyObj;
12014 Jim_IncrRefCount(resultObj);
12016 while (1) {
12017 /* Have we expired all lists? */
12018 for (i = 0; i < numargs; i += 2) {
12019 if (!JimListIterDone(interp, &iters[i + 1])) {
12020 break;
12023 if (i == numargs) {
12024 /* All done */
12025 break;
12028 /* For each list */
12029 for (i = 0; i < numargs; i += 2) {
12030 Jim_Obj *varName;
12032 /* foreach var */
12033 JimListIterInit(&iters[i], argv[i + 1]);
12034 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12035 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12036 if (!valObj) {
12037 /* Ran out, so store the empty string */
12038 valObj = interp->emptyObj;
12040 /* Avoid shimmering */
12041 Jim_IncrRefCount(valObj);
12042 result = Jim_SetVariable(interp, varName, valObj);
12043 Jim_DecrRefCount(interp, valObj);
12044 if (result != JIM_OK) {
12045 goto err;
12049 switch (result = Jim_EvalObj(interp, script)) {
12050 case JIM_OK:
12051 if (doMap) {
12052 Jim_ListAppendElement(interp, resultObj, interp->result);
12054 break;
12055 case JIM_CONTINUE:
12056 break;
12057 case JIM_BREAK:
12058 goto out;
12059 default:
12060 goto err;
12063 out:
12064 result = JIM_OK;
12065 Jim_SetResult(interp, resultObj);
12066 err:
12067 Jim_DecrRefCount(interp, resultObj);
12068 if (numargs > 2) {
12069 Jim_Free(iters);
12071 return result;
12074 /* [foreach] */
12075 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12077 return JimForeachMapHelper(interp, argc, argv, 0);
12080 /* [lmap] */
12081 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12083 return JimForeachMapHelper(interp, argc, argv, 1);
12086 /* [lassign] */
12087 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12089 int result = JIM_ERR;
12090 int i;
12091 Jim_ListIter iter;
12092 Jim_Obj *resultObj;
12094 if (argc < 2) {
12095 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12096 return JIM_ERR;
12099 JimListIterInit(&iter, argv[1]);
12101 for (i = 2; i < argc; i++) {
12102 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12103 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12104 if (result != JIM_OK) {
12105 return result;
12109 resultObj = Jim_NewListObj(interp, NULL, 0);
12110 while (!JimListIterDone(interp, &iter)) {
12111 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12114 Jim_SetResult(interp, resultObj);
12116 return JIM_OK;
12119 /* [if] */
12120 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12122 int boolean, retval, current = 1, falsebody = 0;
12124 if (argc >= 3) {
12125 while (1) {
12126 /* Far not enough arguments given! */
12127 if (current >= argc)
12128 goto err;
12129 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12130 != JIM_OK)
12131 return retval;
12132 /* There lacks something, isn't it? */
12133 if (current >= argc)
12134 goto err;
12135 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12136 current++;
12137 /* Tsk tsk, no then-clause? */
12138 if (current >= argc)
12139 goto err;
12140 if (boolean)
12141 return Jim_EvalObj(interp, argv[current]);
12142 /* Ok: no else-clause follows */
12143 if (++current >= argc) {
12144 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12145 return JIM_OK;
12147 falsebody = current++;
12148 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12149 /* IIICKS - else-clause isn't last cmd? */
12150 if (current != argc - 1)
12151 goto err;
12152 return Jim_EvalObj(interp, argv[current]);
12154 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12155 /* Ok: elseif follows meaning all the stuff
12156 * again (how boring...) */
12157 continue;
12158 /* OOPS - else-clause is not last cmd? */
12159 else if (falsebody != argc - 1)
12160 goto err;
12161 return Jim_EvalObj(interp, argv[falsebody]);
12163 return JIM_OK;
12165 err:
12166 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12167 return JIM_ERR;
12171 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12172 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12173 Jim_Obj *stringObj, int nocase)
12175 Jim_Obj *parms[4];
12176 int argc = 0;
12177 long eq;
12178 int rc;
12180 parms[argc++] = commandObj;
12181 if (nocase) {
12182 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12184 parms[argc++] = patternObj;
12185 parms[argc++] = stringObj;
12187 rc = Jim_EvalObjVector(interp, argc, parms);
12189 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12190 eq = -rc;
12193 return eq;
12196 enum
12197 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12199 /* [switch] */
12200 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12202 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12203 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12204 Jim_Obj *script = 0;
12206 if (argc < 3) {
12207 wrongnumargs:
12208 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12209 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12210 return JIM_ERR;
12212 for (opt = 1; opt < argc; ++opt) {
12213 const char *option = Jim_String(argv[opt]);
12215 if (*option != '-')
12216 break;
12217 else if (strncmp(option, "--", 2) == 0) {
12218 ++opt;
12219 break;
12221 else if (strncmp(option, "-exact", 2) == 0)
12222 matchOpt = SWITCH_EXACT;
12223 else if (strncmp(option, "-glob", 2) == 0)
12224 matchOpt = SWITCH_GLOB;
12225 else if (strncmp(option, "-regexp", 2) == 0)
12226 matchOpt = SWITCH_RE;
12227 else if (strncmp(option, "-command", 2) == 0) {
12228 matchOpt = SWITCH_CMD;
12229 if ((argc - opt) < 2)
12230 goto wrongnumargs;
12231 command = argv[++opt];
12233 else {
12234 Jim_SetResultFormatted(interp,
12235 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12236 argv[opt]);
12237 return JIM_ERR;
12239 if ((argc - opt) < 2)
12240 goto wrongnumargs;
12242 strObj = argv[opt++];
12243 patCount = argc - opt;
12244 if (patCount == 1) {
12245 Jim_Obj **vector;
12247 JimListGetElements(interp, argv[opt], &patCount, &vector);
12248 caseList = vector;
12250 else
12251 caseList = &argv[opt];
12252 if (patCount == 0 || patCount % 2 != 0)
12253 goto wrongnumargs;
12254 for (i = 0; script == 0 && i < patCount; i += 2) {
12255 Jim_Obj *patObj = caseList[i];
12257 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12258 || i < (patCount - 2)) {
12259 switch (matchOpt) {
12260 case SWITCH_EXACT:
12261 if (Jim_StringEqObj(strObj, patObj))
12262 script = caseList[i + 1];
12263 break;
12264 case SWITCH_GLOB:
12265 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12266 script = caseList[i + 1];
12267 break;
12268 case SWITCH_RE:
12269 command = Jim_NewStringObj(interp, "regexp", -1);
12270 /* Fall thru intentionally */
12271 case SWITCH_CMD:{
12272 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12274 /* After the execution of a command we need to
12275 * make sure to reconvert the object into a list
12276 * again. Only for the single-list style [switch]. */
12277 if (argc - opt == 1) {
12278 Jim_Obj **vector;
12280 JimListGetElements(interp, argv[opt], &patCount, &vector);
12281 caseList = vector;
12283 /* command is here already decref'd */
12284 if (rc < 0) {
12285 return -rc;
12287 if (rc)
12288 script = caseList[i + 1];
12289 break;
12293 else {
12294 script = caseList[i + 1];
12297 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12298 script = caseList[i + 1];
12299 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12300 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12301 return JIM_ERR;
12303 Jim_SetEmptyResult(interp);
12304 if (script) {
12305 return Jim_EvalObj(interp, script);
12307 return JIM_OK;
12310 /* [list] */
12311 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12313 Jim_Obj *listObjPtr;
12315 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12316 Jim_SetResult(interp, listObjPtr);
12317 return JIM_OK;
12320 /* [lindex] */
12321 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12323 Jim_Obj *objPtr, *listObjPtr;
12324 int i;
12325 int idx;
12327 if (argc < 2) {
12328 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12329 return JIM_ERR;
12331 objPtr = argv[1];
12332 Jim_IncrRefCount(objPtr);
12333 for (i = 2; i < argc; i++) {
12334 listObjPtr = objPtr;
12335 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12336 Jim_DecrRefCount(interp, listObjPtr);
12337 return JIM_ERR;
12339 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12340 /* Returns an empty object if the index
12341 * is out of range. */
12342 Jim_DecrRefCount(interp, listObjPtr);
12343 Jim_SetEmptyResult(interp);
12344 return JIM_OK;
12346 Jim_IncrRefCount(objPtr);
12347 Jim_DecrRefCount(interp, listObjPtr);
12349 Jim_SetResult(interp, objPtr);
12350 Jim_DecrRefCount(interp, objPtr);
12351 return JIM_OK;
12354 /* [llength] */
12355 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12357 if (argc != 2) {
12358 Jim_WrongNumArgs(interp, 1, argv, "list");
12359 return JIM_ERR;
12361 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12362 return JIM_OK;
12365 /* [lsearch] */
12366 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12368 static const char * const options[] = {
12369 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12370 NULL
12372 enum
12373 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12374 OPT_COMMAND };
12375 int i;
12376 int opt_bool = 0;
12377 int opt_not = 0;
12378 int opt_nocase = 0;
12379 int opt_all = 0;
12380 int opt_inline = 0;
12381 int opt_match = OPT_EXACT;
12382 int listlen;
12383 int rc = JIM_OK;
12384 Jim_Obj *listObjPtr = NULL;
12385 Jim_Obj *commandObj = NULL;
12387 if (argc < 3) {
12388 wrongargs:
12389 Jim_WrongNumArgs(interp, 1, argv,
12390 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12391 return JIM_ERR;
12394 for (i = 1; i < argc - 2; i++) {
12395 int option;
12397 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12398 return JIM_ERR;
12400 switch (option) {
12401 case OPT_BOOL:
12402 opt_bool = 1;
12403 opt_inline = 0;
12404 break;
12405 case OPT_NOT:
12406 opt_not = 1;
12407 break;
12408 case OPT_NOCASE:
12409 opt_nocase = 1;
12410 break;
12411 case OPT_INLINE:
12412 opt_inline = 1;
12413 opt_bool = 0;
12414 break;
12415 case OPT_ALL:
12416 opt_all = 1;
12417 break;
12418 case OPT_COMMAND:
12419 if (i >= argc - 2) {
12420 goto wrongargs;
12422 commandObj = argv[++i];
12423 /* fallthru */
12424 case OPT_EXACT:
12425 case OPT_GLOB:
12426 case OPT_REGEXP:
12427 opt_match = option;
12428 break;
12432 argv += i;
12434 if (opt_all) {
12435 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12437 if (opt_match == OPT_REGEXP) {
12438 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12440 if (commandObj) {
12441 Jim_IncrRefCount(commandObj);
12444 listlen = Jim_ListLength(interp, argv[0]);
12445 for (i = 0; i < listlen; i++) {
12446 int eq = 0;
12447 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12449 switch (opt_match) {
12450 case OPT_EXACT:
12451 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12452 break;
12454 case OPT_GLOB:
12455 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12456 break;
12458 case OPT_REGEXP:
12459 case OPT_COMMAND:
12460 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12461 if (eq < 0) {
12462 if (listObjPtr) {
12463 Jim_FreeNewObj(interp, listObjPtr);
12465 rc = JIM_ERR;
12466 goto done;
12468 break;
12471 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12472 if (!eq && opt_bool && opt_not && !opt_all) {
12473 continue;
12476 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12477 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12478 Jim_Obj *resultObj;
12480 if (opt_bool) {
12481 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12483 else if (!opt_inline) {
12484 resultObj = Jim_NewIntObj(interp, i);
12486 else {
12487 resultObj = objPtr;
12490 if (opt_all) {
12491 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12493 else {
12494 Jim_SetResult(interp, resultObj);
12495 goto done;
12500 if (opt_all) {
12501 Jim_SetResult(interp, listObjPtr);
12503 else {
12504 /* No match */
12505 if (opt_bool) {
12506 Jim_SetResultBool(interp, opt_not);
12508 else if (!opt_inline) {
12509 Jim_SetResultInt(interp, -1);
12513 done:
12514 if (commandObj) {
12515 Jim_DecrRefCount(interp, commandObj);
12517 return rc;
12520 /* [lappend] */
12521 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12523 Jim_Obj *listObjPtr;
12524 int new_obj = 0;
12525 int i;
12527 if (argc < 2) {
12528 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12529 return JIM_ERR;
12531 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12532 if (!listObjPtr) {
12533 /* Create the list if it does not exist */
12534 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12535 new_obj = 1;
12537 else if (Jim_IsShared(listObjPtr)) {
12538 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12539 new_obj = 1;
12541 for (i = 2; i < argc; i++)
12542 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12543 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12544 if (new_obj)
12545 Jim_FreeNewObj(interp, listObjPtr);
12546 return JIM_ERR;
12548 Jim_SetResult(interp, listObjPtr);
12549 return JIM_OK;
12552 /* [linsert] */
12553 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12555 int idx, len;
12556 Jim_Obj *listPtr;
12558 if (argc < 3) {
12559 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12560 return JIM_ERR;
12562 listPtr = argv[1];
12563 if (Jim_IsShared(listPtr))
12564 listPtr = Jim_DuplicateObj(interp, listPtr);
12565 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12566 goto err;
12567 len = Jim_ListLength(interp, listPtr);
12568 if (idx >= len)
12569 idx = len;
12570 else if (idx < 0)
12571 idx = len + idx + 1;
12572 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12573 Jim_SetResult(interp, listPtr);
12574 return JIM_OK;
12575 err:
12576 if (listPtr != argv[1]) {
12577 Jim_FreeNewObj(interp, listPtr);
12579 return JIM_ERR;
12582 /* [lreplace] */
12583 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12585 int first, last, len, rangeLen;
12586 Jim_Obj *listObj;
12587 Jim_Obj *newListObj;
12589 if (argc < 4) {
12590 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12591 return JIM_ERR;
12593 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12594 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12595 return JIM_ERR;
12598 listObj = argv[1];
12599 len = Jim_ListLength(interp, listObj);
12601 first = JimRelToAbsIndex(len, first);
12602 last = JimRelToAbsIndex(len, last);
12603 JimRelToAbsRange(len, &first, &last, &rangeLen);
12605 /* Now construct a new list which consists of:
12606 * <elements before first> <supplied elements> <elements after last>
12609 /* Check to see if trying to replace past the end of the list */
12610 if (first < len) {
12611 /* OK. Not past the end */
12613 else if (len == 0) {
12614 /* Special for empty list, adjust first to 0 */
12615 first = 0;
12617 else {
12618 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12619 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12620 return JIM_ERR;
12623 /* Add the first set of elements */
12624 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12626 /* Add supplied elements */
12627 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12629 /* Add the remaining elements */
12630 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12632 Jim_SetResult(interp, newListObj);
12633 return JIM_OK;
12636 /* [lset] */
12637 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12639 if (argc < 3) {
12640 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12641 return JIM_ERR;
12643 else if (argc == 3) {
12644 /* With no indexes, simply implements [set] */
12645 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12646 return JIM_ERR;
12647 Jim_SetResult(interp, argv[2]);
12648 return JIM_OK;
12650 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12653 /* [lsort] */
12654 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12656 static const char * const options[] = {
12657 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12659 enum
12660 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12661 Jim_Obj *resObj;
12662 int i;
12663 int retCode;
12665 struct lsort_info info;
12667 if (argc < 2) {
12668 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12669 return JIM_ERR;
12672 info.type = JIM_LSORT_ASCII;
12673 info.order = 1;
12674 info.indexed = 0;
12675 info.unique = 0;
12676 info.command = NULL;
12677 info.interp = interp;
12679 for (i = 1; i < (argc - 1); i++) {
12680 int option;
12682 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12683 != JIM_OK)
12684 return JIM_ERR;
12685 switch (option) {
12686 case OPT_ASCII:
12687 info.type = JIM_LSORT_ASCII;
12688 break;
12689 case OPT_NOCASE:
12690 info.type = JIM_LSORT_NOCASE;
12691 break;
12692 case OPT_INTEGER:
12693 info.type = JIM_LSORT_INTEGER;
12694 break;
12695 case OPT_REAL:
12696 info.type = JIM_LSORT_REAL;
12697 break;
12698 case OPT_INCREASING:
12699 info.order = 1;
12700 break;
12701 case OPT_DECREASING:
12702 info.order = -1;
12703 break;
12704 case OPT_UNIQUE:
12705 info.unique = 1;
12706 break;
12707 case OPT_COMMAND:
12708 if (i >= (argc - 2)) {
12709 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12710 return JIM_ERR;
12712 info.type = JIM_LSORT_COMMAND;
12713 info.command = argv[i + 1];
12714 i++;
12715 break;
12716 case OPT_INDEX:
12717 if (i >= (argc - 2)) {
12718 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12719 return JIM_ERR;
12721 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12722 return JIM_ERR;
12724 info.indexed = 1;
12725 i++;
12726 break;
12729 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12730 retCode = ListSortElements(interp, resObj, &info);
12731 if (retCode == JIM_OK) {
12732 Jim_SetResult(interp, resObj);
12734 else {
12735 Jim_FreeNewObj(interp, resObj);
12737 return retCode;
12740 /* [append] */
12741 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12743 Jim_Obj *stringObjPtr;
12744 int i;
12746 if (argc < 2) {
12747 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12748 return JIM_ERR;
12750 if (argc == 2) {
12751 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12752 if (!stringObjPtr)
12753 return JIM_ERR;
12755 else {
12756 int new_obj = 0;
12757 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12758 if (!stringObjPtr) {
12759 /* Create the string if it doesn't exist */
12760 stringObjPtr = Jim_NewEmptyStringObj(interp);
12761 new_obj = 1;
12763 else if (Jim_IsShared(stringObjPtr)) {
12764 new_obj = 1;
12765 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12767 for (i = 2; i < argc; i++) {
12768 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12770 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12771 if (new_obj) {
12772 Jim_FreeNewObj(interp, stringObjPtr);
12774 return JIM_ERR;
12777 Jim_SetResult(interp, stringObjPtr);
12778 return JIM_OK;
12781 /* [debug] */
12782 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12784 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12785 static const char * const options[] = {
12786 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12787 "exprbc", "show",
12788 NULL
12790 enum
12792 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12793 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12795 int option;
12797 if (argc < 2) {
12798 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12799 return JIM_ERR;
12801 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12802 return JIM_ERR;
12803 if (option == OPT_REFCOUNT) {
12804 if (argc != 3) {
12805 Jim_WrongNumArgs(interp, 2, argv, "object");
12806 return JIM_ERR;
12808 Jim_SetResultInt(interp, argv[2]->refCount);
12809 return JIM_OK;
12811 else if (option == OPT_OBJCOUNT) {
12812 int freeobj = 0, liveobj = 0;
12813 char buf[256];
12814 Jim_Obj *objPtr;
12816 if (argc != 2) {
12817 Jim_WrongNumArgs(interp, 2, argv, "");
12818 return JIM_ERR;
12820 /* Count the number of free objects. */
12821 objPtr = interp->freeList;
12822 while (objPtr) {
12823 freeobj++;
12824 objPtr = objPtr->nextObjPtr;
12826 /* Count the number of live objects. */
12827 objPtr = interp->liveList;
12828 while (objPtr) {
12829 liveobj++;
12830 objPtr = objPtr->nextObjPtr;
12832 /* Set the result string and return. */
12833 sprintf(buf, "free %d used %d", freeobj, liveobj);
12834 Jim_SetResultString(interp, buf, -1);
12835 return JIM_OK;
12837 else if (option == OPT_OBJECTS) {
12838 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12840 /* Count the number of live objects. */
12841 objPtr = interp->liveList;
12842 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12843 while (objPtr) {
12844 char buf[128];
12845 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12847 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12848 sprintf(buf, "%p", objPtr);
12849 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12850 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12851 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12852 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12853 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12854 objPtr = objPtr->nextObjPtr;
12856 Jim_SetResult(interp, listObjPtr);
12857 return JIM_OK;
12859 else if (option == OPT_INVSTR) {
12860 Jim_Obj *objPtr;
12862 if (argc != 3) {
12863 Jim_WrongNumArgs(interp, 2, argv, "object");
12864 return JIM_ERR;
12866 objPtr = argv[2];
12867 if (objPtr->typePtr != NULL)
12868 Jim_InvalidateStringRep(objPtr);
12869 Jim_SetEmptyResult(interp);
12870 return JIM_OK;
12872 else if (option == OPT_SHOW) {
12873 const char *s;
12874 int len, charlen;
12876 if (argc != 3) {
12877 Jim_WrongNumArgs(interp, 2, argv, "object");
12878 return JIM_ERR;
12880 s = Jim_GetString(argv[2], &len);
12881 #ifdef JIM_UTF8
12882 charlen = utf8_strlen(s, len);
12883 #else
12884 charlen = len;
12885 #endif
12886 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12887 printf("chars (%d): <<%s>>\n", charlen, s);
12888 printf("bytes (%d):", len);
12889 while (len--) {
12890 printf(" %02x", (unsigned char)*s++);
12892 printf("\n");
12893 return JIM_OK;
12895 else if (option == OPT_SCRIPTLEN) {
12896 ScriptObj *script;
12898 if (argc != 3) {
12899 Jim_WrongNumArgs(interp, 2, argv, "script");
12900 return JIM_ERR;
12902 script = JimGetScript(interp, argv[2]);
12903 if (script == NULL)
12904 return JIM_ERR;
12905 Jim_SetResultInt(interp, script->len);
12906 return JIM_OK;
12908 else if (option == OPT_EXPRLEN) {
12909 ExprByteCode *expr;
12911 if (argc != 3) {
12912 Jim_WrongNumArgs(interp, 2, argv, "expression");
12913 return JIM_ERR;
12915 expr = JimGetExpression(interp, argv[2]);
12916 if (expr == NULL)
12917 return JIM_ERR;
12918 Jim_SetResultInt(interp, expr->len);
12919 return JIM_OK;
12921 else if (option == OPT_EXPRBC) {
12922 Jim_Obj *objPtr;
12923 ExprByteCode *expr;
12924 int i;
12926 if (argc != 3) {
12927 Jim_WrongNumArgs(interp, 2, argv, "expression");
12928 return JIM_ERR;
12930 expr = JimGetExpression(interp, argv[2]);
12931 if (expr == NULL)
12932 return JIM_ERR;
12933 objPtr = Jim_NewListObj(interp, NULL, 0);
12934 for (i = 0; i < expr->len; i++) {
12935 const char *type;
12936 const Jim_ExprOperator *op;
12937 Jim_Obj *obj = expr->token[i].objPtr;
12939 switch (expr->token[i].type) {
12940 case JIM_TT_EXPR_INT:
12941 type = "int";
12942 break;
12943 case JIM_TT_EXPR_DOUBLE:
12944 type = "double";
12945 break;
12946 case JIM_TT_EXPR_BOOLEAN:
12947 type = "boolean";
12948 break;
12949 case JIM_TT_CMD:
12950 type = "command";
12951 break;
12952 case JIM_TT_VAR:
12953 type = "variable";
12954 break;
12955 case JIM_TT_DICTSUGAR:
12956 type = "dictsugar";
12957 break;
12958 case JIM_TT_EXPRSUGAR:
12959 type = "exprsugar";
12960 break;
12961 case JIM_TT_ESC:
12962 type = "subst";
12963 break;
12964 case JIM_TT_STR:
12965 type = "string";
12966 break;
12967 default:
12968 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12969 if (op == NULL) {
12970 type = "private";
12972 else {
12973 type = "operator";
12975 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12976 break;
12978 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12979 Jim_ListAppendElement(interp, objPtr, obj);
12981 Jim_SetResult(interp, objPtr);
12982 return JIM_OK;
12984 else {
12985 Jim_SetResultString(interp,
12986 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12987 return JIM_ERR;
12989 /* unreached */
12990 #endif /* JIM_BOOTSTRAP */
12991 #if !defined(JIM_DEBUG_COMMAND)
12992 Jim_SetResultString(interp, "unsupported", -1);
12993 return JIM_ERR;
12994 #endif
12997 /* [eval] */
12998 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13000 int rc;
13002 if (argc < 2) {
13003 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13004 return JIM_ERR;
13007 if (argc == 2) {
13008 rc = Jim_EvalObj(interp, argv[1]);
13010 else {
13011 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13014 if (rc == JIM_ERR) {
13015 /* eval is "interesting", so add a stack frame here */
13016 interp->addStackTrace++;
13018 return rc;
13021 /* [uplevel] */
13022 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13024 if (argc >= 2) {
13025 int retcode;
13026 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13027 const char *str;
13029 /* Save the old callframe pointer */
13030 savedCallFrame = interp->framePtr;
13032 /* Lookup the target frame pointer */
13033 str = Jim_String(argv[1]);
13034 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13035 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13036 argc--;
13037 argv++;
13039 else {
13040 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13042 if (targetCallFrame == NULL) {
13043 return JIM_ERR;
13045 if (argc < 2) {
13046 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13047 return JIM_ERR;
13049 /* Eval the code in the target callframe. */
13050 interp->framePtr = targetCallFrame;
13051 if (argc == 2) {
13052 retcode = Jim_EvalObj(interp, argv[1]);
13054 else {
13055 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13057 interp->framePtr = savedCallFrame;
13058 return retcode;
13060 else {
13061 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13062 return JIM_ERR;
13066 /* [expr] */
13067 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13069 Jim_Obj *exprResultPtr;
13070 int retcode;
13072 if (argc == 2) {
13073 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13075 else if (argc > 2) {
13076 Jim_Obj *objPtr;
13078 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13079 Jim_IncrRefCount(objPtr);
13080 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13081 Jim_DecrRefCount(interp, objPtr);
13083 else {
13084 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13085 return JIM_ERR;
13087 if (retcode != JIM_OK)
13088 return retcode;
13089 Jim_SetResult(interp, exprResultPtr);
13090 Jim_DecrRefCount(interp, exprResultPtr);
13091 return JIM_OK;
13094 /* [break] */
13095 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13097 if (argc != 1) {
13098 Jim_WrongNumArgs(interp, 1, argv, "");
13099 return JIM_ERR;
13101 return JIM_BREAK;
13104 /* [continue] */
13105 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13107 if (argc != 1) {
13108 Jim_WrongNumArgs(interp, 1, argv, "");
13109 return JIM_ERR;
13111 return JIM_CONTINUE;
13114 /* [return] */
13115 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13117 int i;
13118 Jim_Obj *stackTraceObj = NULL;
13119 Jim_Obj *errorCodeObj = NULL;
13120 int returnCode = JIM_OK;
13121 long level = 1;
13123 for (i = 1; i < argc - 1; i += 2) {
13124 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13125 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13126 return JIM_ERR;
13129 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13130 stackTraceObj = argv[i + 1];
13132 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13133 errorCodeObj = argv[i + 1];
13135 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13136 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13137 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13138 return JIM_ERR;
13141 else {
13142 break;
13146 if (i != argc - 1 && i != argc) {
13147 Jim_WrongNumArgs(interp, 1, argv,
13148 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13151 /* If a stack trace is supplied and code is error, set the stack trace */
13152 if (stackTraceObj && returnCode == JIM_ERR) {
13153 JimSetStackTrace(interp, stackTraceObj);
13155 /* If an error code list is supplied, set the global $errorCode */
13156 if (errorCodeObj && returnCode == JIM_ERR) {
13157 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13159 interp->returnCode = returnCode;
13160 interp->returnLevel = level;
13162 if (i == argc - 1) {
13163 Jim_SetResult(interp, argv[i]);
13165 return JIM_RETURN;
13168 /* [tailcall] */
13169 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13171 if (interp->framePtr->level == 0) {
13172 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13173 return JIM_ERR;
13175 else if (argc >= 2) {
13176 /* Need to resolve the tailcall command in the current context */
13177 Jim_CallFrame *cf = interp->framePtr->parent;
13179 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13180 if (cmdPtr == NULL) {
13181 return JIM_ERR;
13184 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13186 /* And stash this pre-resolved command */
13187 JimIncrCmdRefCount(cmdPtr);
13188 cf->tailcallCmd = cmdPtr;
13190 /* And stash the command list */
13191 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13193 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13194 Jim_IncrRefCount(cf->tailcallObj);
13196 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13197 return JIM_EVAL;
13199 return JIM_OK;
13202 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13204 Jim_Obj *cmdList;
13205 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13207 /* prefixListObj is a list to which the args need to be appended */
13208 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13209 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13211 return JimEvalObjList(interp, cmdList);
13214 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13216 Jim_Obj *prefixListObj = privData;
13217 Jim_DecrRefCount(interp, prefixListObj);
13220 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13222 Jim_Obj *prefixListObj;
13223 const char *newname;
13225 if (argc < 3) {
13226 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13227 return JIM_ERR;
13230 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13231 Jim_IncrRefCount(prefixListObj);
13232 newname = Jim_String(argv[1]);
13233 if (newname[0] == ':' && newname[1] == ':') {
13234 while (*++newname == ':') {
13238 Jim_SetResult(interp, argv[1]);
13240 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13243 /* [proc] */
13244 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13246 Jim_Cmd *cmd;
13248 if (argc != 4 && argc != 5) {
13249 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13250 return JIM_ERR;
13253 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13254 return JIM_ERR;
13257 if (argc == 4) {
13258 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13260 else {
13261 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13264 if (cmd) {
13265 /* Add the new command */
13266 Jim_Obj *qualifiedCmdNameObj;
13267 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13269 JimCreateCommand(interp, cmdname, cmd);
13271 /* Calculate and set the namespace for this proc */
13272 JimUpdateProcNamespace(interp, cmd, cmdname);
13274 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13276 /* Unlike Tcl, set the name of the proc as the result */
13277 Jim_SetResult(interp, argv[1]);
13278 return JIM_OK;
13280 return JIM_ERR;
13283 /* [local] */
13284 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13286 int retcode;
13288 if (argc < 2) {
13289 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13290 return JIM_ERR;
13293 /* Evaluate the arguments with 'local' in force */
13294 interp->local++;
13295 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13296 interp->local--;
13299 /* If OK, and the result is a proc, add it to the list of local procs */
13300 if (retcode == 0) {
13301 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13303 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13304 return JIM_ERR;
13306 if (interp->framePtr->localCommands == NULL) {
13307 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13308 Jim_InitStack(interp->framePtr->localCommands);
13310 Jim_IncrRefCount(cmdNameObj);
13311 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13314 return retcode;
13317 /* [upcall] */
13318 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13320 if (argc < 2) {
13321 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13322 return JIM_ERR;
13324 else {
13325 int retcode;
13327 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13328 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13329 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13330 return JIM_ERR;
13332 /* OK. Mark this command as being in an upcall */
13333 cmdPtr->u.proc.upcall++;
13334 JimIncrCmdRefCount(cmdPtr);
13336 /* Invoke the command as normal */
13337 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13339 /* No longer in an upcall */
13340 cmdPtr->u.proc.upcall--;
13341 JimDecrCmdRefCount(interp, cmdPtr);
13343 return retcode;
13347 /* [apply] */
13348 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13350 if (argc < 2) {
13351 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13352 return JIM_ERR;
13354 else {
13355 int ret;
13356 Jim_Cmd *cmd;
13357 Jim_Obj *argListObjPtr;
13358 Jim_Obj *bodyObjPtr;
13359 Jim_Obj *nsObj = NULL;
13360 Jim_Obj **nargv;
13362 int len = Jim_ListLength(interp, argv[1]);
13363 if (len != 2 && len != 3) {
13364 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13365 return JIM_ERR;
13368 if (len == 3) {
13369 #ifdef jim_ext_namespace
13370 /* Need to canonicalise the given namespace. */
13371 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13372 #else
13373 Jim_SetResultString(interp, "namespaces not enabled", -1);
13374 return JIM_ERR;
13375 #endif
13377 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13378 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13380 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13382 if (cmd) {
13383 /* Create a new argv array with a dummy argv[0], for error messages */
13384 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13385 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13386 Jim_IncrRefCount(nargv[0]);
13387 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13388 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13389 Jim_DecrRefCount(interp, nargv[0]);
13390 Jim_Free(nargv);
13392 JimDecrCmdRefCount(interp, cmd);
13393 return ret;
13395 return JIM_ERR;
13400 /* [concat] */
13401 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13403 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13404 return JIM_OK;
13407 /* [upvar] */
13408 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13410 int i;
13411 Jim_CallFrame *targetCallFrame;
13413 /* Lookup the target frame pointer */
13414 if (argc > 3 && (argc % 2 == 0)) {
13415 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13416 argc--;
13417 argv++;
13419 else {
13420 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13422 if (targetCallFrame == NULL) {
13423 return JIM_ERR;
13426 /* Check for arity */
13427 if (argc < 3) {
13428 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13429 return JIM_ERR;
13432 /* Now... for every other/local couple: */
13433 for (i = 1; i < argc; i += 2) {
13434 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13435 return JIM_ERR;
13437 return JIM_OK;
13440 /* [global] */
13441 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13443 int i;
13445 if (argc < 2) {
13446 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13447 return JIM_ERR;
13449 /* Link every var to the toplevel having the same name */
13450 if (interp->framePtr->level == 0)
13451 return JIM_OK; /* global at toplevel... */
13452 for (i = 1; i < argc; i++) {
13453 /* global ::blah does nothing */
13454 const char *name = Jim_String(argv[i]);
13455 if (name[0] != ':' || name[1] != ':') {
13456 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13457 return JIM_ERR;
13460 return JIM_OK;
13463 /* does the [string map] operation. On error NULL is returned,
13464 * otherwise a new string object with the result, having refcount = 0,
13465 * is returned. */
13466 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13467 Jim_Obj *objPtr, int nocase)
13469 int numMaps;
13470 const char *str, *noMatchStart = NULL;
13471 int strLen, i;
13472 Jim_Obj *resultObjPtr;
13474 numMaps = Jim_ListLength(interp, mapListObjPtr);
13475 if (numMaps % 2) {
13476 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13477 return NULL;
13480 str = Jim_String(objPtr);
13481 strLen = Jim_Utf8Length(interp, objPtr);
13483 /* Map it */
13484 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13485 while (strLen) {
13486 for (i = 0; i < numMaps; i += 2) {
13487 Jim_Obj *objPtr;
13488 const char *k;
13489 int kl;
13491 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13492 k = Jim_String(objPtr);
13493 kl = Jim_Utf8Length(interp, objPtr);
13495 if (strLen >= kl && kl) {
13496 int rc;
13497 rc = JimStringCompareLen(str, k, kl, nocase);
13498 if (rc == 0) {
13499 if (noMatchStart) {
13500 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13501 noMatchStart = NULL;
13503 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13504 str += utf8_index(str, kl);
13505 strLen -= kl;
13506 break;
13510 if (i == numMaps) { /* no match */
13511 int c;
13512 if (noMatchStart == NULL)
13513 noMatchStart = str;
13514 str += utf8_tounicode(str, &c);
13515 strLen--;
13518 if (noMatchStart) {
13519 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13521 return resultObjPtr;
13524 /* [string] */
13525 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13527 int len;
13528 int opt_case = 1;
13529 int option;
13530 static const char * const options[] = {
13531 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13532 "map", "repeat", "reverse", "index", "first", "last", "cat",
13533 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13535 enum
13537 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13538 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13539 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13541 static const char * const nocase_options[] = {
13542 "-nocase", NULL
13544 static const char * const nocase_length_options[] = {
13545 "-nocase", "-length", NULL
13548 if (argc < 2) {
13549 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13550 return JIM_ERR;
13552 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13553 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13554 return JIM_ERR;
13556 switch (option) {
13557 case OPT_LENGTH:
13558 case OPT_BYTELENGTH:
13559 if (argc != 3) {
13560 Jim_WrongNumArgs(interp, 2, argv, "string");
13561 return JIM_ERR;
13563 if (option == OPT_LENGTH) {
13564 len = Jim_Utf8Length(interp, argv[2]);
13566 else {
13567 len = Jim_Length(argv[2]);
13569 Jim_SetResultInt(interp, len);
13570 return JIM_OK;
13572 case OPT_CAT:{
13573 Jim_Obj *objPtr;
13574 if (argc == 3) {
13575 /* optimise the one-arg case */
13576 objPtr = argv[2];
13578 else {
13579 int i;
13581 objPtr = Jim_NewStringObj(interp, "", 0);
13583 for (i = 2; i < argc; i++) {
13584 Jim_AppendObj(interp, objPtr, argv[i]);
13587 Jim_SetResult(interp, objPtr);
13588 return JIM_OK;
13591 case OPT_COMPARE:
13592 case OPT_EQUAL:
13594 /* n is the number of remaining option args */
13595 long opt_length = -1;
13596 int n = argc - 4;
13597 int i = 2;
13598 while (n > 0) {
13599 int subopt;
13600 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13601 JIM_ENUM_ABBREV) != JIM_OK) {
13602 badcompareargs:
13603 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13604 return JIM_ERR;
13606 if (subopt == 0) {
13607 /* -nocase */
13608 opt_case = 0;
13609 n--;
13611 else {
13612 /* -length */
13613 if (n < 2) {
13614 goto badcompareargs;
13616 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13617 return JIM_ERR;
13619 n -= 2;
13622 if (n) {
13623 goto badcompareargs;
13625 argv += argc - 2;
13626 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13627 /* Fast version - [string equal], case sensitive, no length */
13628 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13630 else {
13631 if (opt_length >= 0) {
13632 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13634 else {
13635 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13637 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13639 return JIM_OK;
13642 case OPT_MATCH:
13643 if (argc != 4 &&
13644 (argc != 5 ||
13645 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13646 JIM_ENUM_ABBREV) != JIM_OK)) {
13647 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13648 return JIM_ERR;
13650 if (opt_case == 0) {
13651 argv++;
13653 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13654 return JIM_OK;
13656 case OPT_MAP:{
13657 Jim_Obj *objPtr;
13659 if (argc != 4 &&
13660 (argc != 5 ||
13661 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13662 JIM_ENUM_ABBREV) != JIM_OK)) {
13663 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13664 return JIM_ERR;
13667 if (opt_case == 0) {
13668 argv++;
13670 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13671 if (objPtr == NULL) {
13672 return JIM_ERR;
13674 Jim_SetResult(interp, objPtr);
13675 return JIM_OK;
13678 case OPT_RANGE:
13679 case OPT_BYTERANGE:{
13680 Jim_Obj *objPtr;
13682 if (argc != 5) {
13683 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13684 return JIM_ERR;
13686 if (option == OPT_RANGE) {
13687 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13689 else
13691 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13694 if (objPtr == NULL) {
13695 return JIM_ERR;
13697 Jim_SetResult(interp, objPtr);
13698 return JIM_OK;
13701 case OPT_REPLACE:{
13702 Jim_Obj *objPtr;
13704 if (argc != 5 && argc != 6) {
13705 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13706 return JIM_ERR;
13708 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13709 if (objPtr == NULL) {
13710 return JIM_ERR;
13712 Jim_SetResult(interp, objPtr);
13713 return JIM_OK;
13717 case OPT_REPEAT:{
13718 Jim_Obj *objPtr;
13719 jim_wide count;
13721 if (argc != 4) {
13722 Jim_WrongNumArgs(interp, 2, argv, "string count");
13723 return JIM_ERR;
13725 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13726 return JIM_ERR;
13728 objPtr = Jim_NewStringObj(interp, "", 0);
13729 if (count > 0) {
13730 while (count--) {
13731 Jim_AppendObj(interp, objPtr, argv[2]);
13734 Jim_SetResult(interp, objPtr);
13735 return JIM_OK;
13738 case OPT_REVERSE:{
13739 char *buf, *p;
13740 const char *str;
13741 int len;
13742 int i;
13744 if (argc != 3) {
13745 Jim_WrongNumArgs(interp, 2, argv, "string");
13746 return JIM_ERR;
13749 str = Jim_GetString(argv[2], &len);
13750 buf = Jim_Alloc(len + 1);
13751 p = buf + len;
13752 *p = 0;
13753 for (i = 0; i < len; ) {
13754 int c;
13755 int l = utf8_tounicode(str, &c);
13756 memcpy(p - l, str, l);
13757 p -= l;
13758 i += l;
13759 str += l;
13761 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13762 return JIM_OK;
13765 case OPT_INDEX:{
13766 int idx;
13767 const char *str;
13769 if (argc != 4) {
13770 Jim_WrongNumArgs(interp, 2, argv, "string index");
13771 return JIM_ERR;
13773 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13774 return JIM_ERR;
13776 str = Jim_String(argv[2]);
13777 len = Jim_Utf8Length(interp, argv[2]);
13778 if (idx != INT_MIN && idx != INT_MAX) {
13779 idx = JimRelToAbsIndex(len, idx);
13781 if (idx < 0 || idx >= len || str == NULL) {
13782 Jim_SetResultString(interp, "", 0);
13784 else if (len == Jim_Length(argv[2])) {
13785 /* ASCII optimisation */
13786 Jim_SetResultString(interp, str + idx, 1);
13788 else {
13789 int c;
13790 int i = utf8_index(str, idx);
13791 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13793 return JIM_OK;
13796 case OPT_FIRST:
13797 case OPT_LAST:{
13798 int idx = 0, l1, l2;
13799 const char *s1, *s2;
13801 if (argc != 4 && argc != 5) {
13802 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13803 return JIM_ERR;
13805 s1 = Jim_String(argv[2]);
13806 s2 = Jim_String(argv[3]);
13807 l1 = Jim_Utf8Length(interp, argv[2]);
13808 l2 = Jim_Utf8Length(interp, argv[3]);
13809 if (argc == 5) {
13810 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13811 return JIM_ERR;
13813 idx = JimRelToAbsIndex(l2, idx);
13815 else if (option == OPT_LAST) {
13816 idx = l2;
13818 if (option == OPT_FIRST) {
13819 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13821 else {
13822 #ifdef JIM_UTF8
13823 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13824 #else
13825 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13826 #endif
13828 return JIM_OK;
13831 case OPT_TRIM:
13832 case OPT_TRIMLEFT:
13833 case OPT_TRIMRIGHT:{
13834 Jim_Obj *trimchars;
13836 if (argc != 3 && argc != 4) {
13837 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13838 return JIM_ERR;
13840 trimchars = (argc == 4 ? argv[3] : NULL);
13841 if (option == OPT_TRIM) {
13842 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13844 else if (option == OPT_TRIMLEFT) {
13845 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13847 else if (option == OPT_TRIMRIGHT) {
13848 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13850 return JIM_OK;
13853 case OPT_TOLOWER:
13854 case OPT_TOUPPER:
13855 case OPT_TOTITLE:
13856 if (argc != 3) {
13857 Jim_WrongNumArgs(interp, 2, argv, "string");
13858 return JIM_ERR;
13860 if (option == OPT_TOLOWER) {
13861 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13863 else if (option == OPT_TOUPPER) {
13864 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13866 else {
13867 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13869 return JIM_OK;
13871 case OPT_IS:
13872 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13873 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13875 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13876 return JIM_ERR;
13878 return JIM_OK;
13881 /* [time] */
13882 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13884 long i, count = 1;
13885 jim_wide start, elapsed;
13886 char buf[60];
13887 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13889 if (argc < 2) {
13890 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13891 return JIM_ERR;
13893 if (argc == 3) {
13894 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13895 return JIM_ERR;
13897 if (count < 0)
13898 return JIM_OK;
13899 i = count;
13900 start = JimClock();
13901 while (i-- > 0) {
13902 int retval;
13904 retval = Jim_EvalObj(interp, argv[1]);
13905 if (retval != JIM_OK) {
13906 return retval;
13909 elapsed = JimClock() - start;
13910 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13911 Jim_SetResultString(interp, buf, -1);
13912 return JIM_OK;
13915 /* [exit] */
13916 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13918 long exitCode = 0;
13920 if (argc > 2) {
13921 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13922 return JIM_ERR;
13924 if (argc == 2) {
13925 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13926 return JIM_ERR;
13928 interp->exitCode = exitCode;
13929 return JIM_EXIT;
13932 /* [catch] */
13933 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13935 int exitCode = 0;
13936 int i;
13937 int sig = 0;
13939 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13940 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13941 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13943 /* Reset the error code before catch.
13944 * Note that this is not strictly correct.
13946 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13948 for (i = 1; i < argc - 1; i++) {
13949 const char *arg = Jim_String(argv[i]);
13950 jim_wide option;
13951 int ignore;
13953 /* It's a pity we can't use Jim_GetEnum here :-( */
13954 if (strcmp(arg, "--") == 0) {
13955 i++;
13956 break;
13958 if (*arg != '-') {
13959 break;
13962 if (strncmp(arg, "-no", 3) == 0) {
13963 arg += 3;
13964 ignore = 1;
13966 else {
13967 arg++;
13968 ignore = 0;
13971 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13972 option = -1;
13974 if (option < 0) {
13975 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13977 if (option < 0) {
13978 goto wrongargs;
13981 if (ignore) {
13982 ignore_mask |= ((jim_wide)1 << option);
13984 else {
13985 ignore_mask &= (~((jim_wide)1 << option));
13989 argc -= i;
13990 if (argc < 1 || argc > 3) {
13991 wrongargs:
13992 Jim_WrongNumArgs(interp, 1, argv,
13993 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13994 return JIM_ERR;
13996 argv += i;
13998 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13999 sig++;
14002 interp->signal_level += sig;
14003 if (Jim_CheckSignal(interp)) {
14004 /* If a signal is set, don't even try to execute the body */
14005 exitCode = JIM_SIGNAL;
14007 else {
14008 exitCode = Jim_EvalObj(interp, argv[0]);
14009 /* Don't want any caught error included in a later stack trace */
14010 interp->errorFlag = 0;
14012 interp->signal_level -= sig;
14014 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14015 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14016 /* Not caught, pass it up */
14017 return exitCode;
14020 if (sig && exitCode == JIM_SIGNAL) {
14021 /* Catch the signal at this level */
14022 if (interp->signal_set_result) {
14023 interp->signal_set_result(interp, interp->sigmask);
14025 else {
14026 Jim_SetResultInt(interp, interp->sigmask);
14028 interp->sigmask = 0;
14031 if (argc >= 2) {
14032 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14033 return JIM_ERR;
14035 if (argc == 3) {
14036 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14038 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14039 Jim_ListAppendElement(interp, optListObj,
14040 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14041 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14042 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14043 if (exitCode == JIM_ERR) {
14044 Jim_Obj *errorCode;
14045 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14046 -1));
14047 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14049 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14050 if (errorCode) {
14051 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14052 Jim_ListAppendElement(interp, optListObj, errorCode);
14055 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14056 return JIM_ERR;
14060 Jim_SetResultInt(interp, exitCode);
14061 return JIM_OK;
14064 #ifdef JIM_REFERENCES
14066 /* [ref] */
14067 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14069 if (argc != 3 && argc != 4) {
14070 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14071 return JIM_ERR;
14073 if (argc == 3) {
14074 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14076 else {
14077 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14079 return JIM_OK;
14082 /* [getref] */
14083 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14085 Jim_Reference *refPtr;
14087 if (argc != 2) {
14088 Jim_WrongNumArgs(interp, 1, argv, "reference");
14089 return JIM_ERR;
14091 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14092 return JIM_ERR;
14093 Jim_SetResult(interp, refPtr->objPtr);
14094 return JIM_OK;
14097 /* [setref] */
14098 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14100 Jim_Reference *refPtr;
14102 if (argc != 3) {
14103 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14104 return JIM_ERR;
14106 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14107 return JIM_ERR;
14108 Jim_IncrRefCount(argv[2]);
14109 Jim_DecrRefCount(interp, refPtr->objPtr);
14110 refPtr->objPtr = argv[2];
14111 Jim_SetResult(interp, argv[2]);
14112 return JIM_OK;
14115 /* [collect] */
14116 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14118 if (argc != 1) {
14119 Jim_WrongNumArgs(interp, 1, argv, "");
14120 return JIM_ERR;
14122 Jim_SetResultInt(interp, Jim_Collect(interp));
14124 /* Free all the freed objects. */
14125 while (interp->freeList) {
14126 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14127 Jim_Free(interp->freeList);
14128 interp->freeList = nextObjPtr;
14131 return JIM_OK;
14134 /* [finalize] reference ?newValue? */
14135 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14137 if (argc != 2 && argc != 3) {
14138 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14139 return JIM_ERR;
14141 if (argc == 2) {
14142 Jim_Obj *cmdNamePtr;
14144 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14145 return JIM_ERR;
14146 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14147 Jim_SetResult(interp, cmdNamePtr);
14149 else {
14150 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14151 return JIM_ERR;
14152 Jim_SetResult(interp, argv[2]);
14154 return JIM_OK;
14157 /* [info references] */
14158 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14160 Jim_Obj *listObjPtr;
14161 Jim_HashTableIterator htiter;
14162 Jim_HashEntry *he;
14164 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14166 JimInitHashTableIterator(&interp->references, &htiter);
14167 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14168 char buf[JIM_REFERENCE_SPACE + 1];
14169 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14170 const unsigned long *refId = he->key;
14172 JimFormatReference(buf, refPtr, *refId);
14173 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14175 Jim_SetResult(interp, listObjPtr);
14176 return JIM_OK;
14178 #endif
14180 /* [rename] */
14181 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14183 if (argc != 3) {
14184 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14185 return JIM_ERR;
14188 if (JimValidName(interp, "new procedure", argv[2])) {
14189 return JIM_ERR;
14192 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14195 #define JIM_DICTMATCH_VALUES 0x0001
14197 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14199 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14201 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14202 if (type & JIM_DICTMATCH_VALUES) {
14203 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14208 * Like JimHashtablePatternMatch, but for dictionaries.
14210 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14211 JimDictMatchCallbackType *callback, int type)
14213 Jim_HashEntry *he;
14214 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14216 /* Check for the non-pattern case. We can do this much more efficiently. */
14217 Jim_HashTableIterator htiter;
14218 JimInitHashTableIterator(ht, &htiter);
14219 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14220 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14221 callback(interp, listObjPtr, he, type);
14225 return listObjPtr;
14229 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14231 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14232 return JIM_ERR;
14234 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14235 return JIM_OK;
14238 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14240 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14241 return JIM_ERR;
14243 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14244 return JIM_OK;
14247 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14249 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14250 return -1;
14252 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14255 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14257 Jim_HashTable *ht;
14258 unsigned int i;
14260 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14261 return JIM_ERR;
14264 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14266 /* Note that this uses internal knowledge of the hash table */
14267 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14269 for (i = 0; i < ht->size; i++) {
14270 Jim_HashEntry *he = ht->table[i];
14272 if (he) {
14273 printf("%d: ", i);
14275 while (he) {
14276 printf(" %s", Jim_String(he->key));
14277 he = he->next;
14279 printf("\n");
14282 return JIM_OK;
14285 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14287 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14289 Jim_AppendString(interp, prefixObj, " ", 1);
14290 Jim_AppendString(interp, prefixObj, subcmd, -1);
14292 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14295 /* [dict] */
14296 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14298 Jim_Obj *objPtr;
14299 int option;
14300 static const char * const options[] = {
14301 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14302 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14303 "replace", "update", NULL
14305 enum
14307 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14308 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14309 OPT_REPLACE, OPT_UPDATE,
14312 if (argc < 2) {
14313 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14314 return JIM_ERR;
14317 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14318 return JIM_ERR;
14321 switch (option) {
14322 case OPT_GET:
14323 if (argc < 3) {
14324 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14325 return JIM_ERR;
14327 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14328 JIM_ERRMSG) != JIM_OK) {
14329 return JIM_ERR;
14331 Jim_SetResult(interp, objPtr);
14332 return JIM_OK;
14334 case OPT_SET:
14335 if (argc < 5) {
14336 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14337 return JIM_ERR;
14339 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14341 case OPT_EXISTS:
14342 if (argc < 4) {
14343 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14344 return JIM_ERR;
14346 else {
14347 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14348 if (rc < 0) {
14349 return JIM_ERR;
14351 Jim_SetResultBool(interp, rc == JIM_OK);
14352 return JIM_OK;
14355 case OPT_UNSET:
14356 if (argc < 4) {
14357 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14358 return JIM_ERR;
14360 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14361 return JIM_ERR;
14363 return JIM_OK;
14365 case OPT_KEYS:
14366 if (argc != 3 && argc != 4) {
14367 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14368 return JIM_ERR;
14370 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14372 case OPT_SIZE:
14373 if (argc != 3) {
14374 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14375 return JIM_ERR;
14377 else if (Jim_DictSize(interp, argv[2]) < 0) {
14378 return JIM_ERR;
14380 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14381 return JIM_OK;
14383 case OPT_MERGE:
14384 if (argc == 2) {
14385 return JIM_OK;
14387 if (Jim_DictSize(interp, argv[2]) < 0) {
14388 return JIM_ERR;
14390 /* Handle as ensemble */
14391 break;
14393 case OPT_UPDATE:
14394 if (argc < 6 || argc % 2) {
14395 /* Better error message */
14396 argc = 2;
14398 break;
14400 case OPT_CREATE:
14401 if (argc % 2) {
14402 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14403 return JIM_ERR;
14405 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14406 Jim_SetResult(interp, objPtr);
14407 return JIM_OK;
14409 case OPT_INFO:
14410 if (argc != 3) {
14411 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14412 return JIM_ERR;
14414 return Jim_DictInfo(interp, argv[2]);
14416 /* Handle command as an ensemble */
14417 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14420 /* [subst] */
14421 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14423 static const char * const options[] = {
14424 "-nobackslashes", "-nocommands", "-novariables", NULL
14426 enum
14427 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14428 int i;
14429 int flags = JIM_SUBST_FLAG;
14430 Jim_Obj *objPtr;
14432 if (argc < 2) {
14433 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14434 return JIM_ERR;
14436 for (i = 1; i < (argc - 1); i++) {
14437 int option;
14439 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14440 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14441 return JIM_ERR;
14443 switch (option) {
14444 case OPT_NOBACKSLASHES:
14445 flags |= JIM_SUBST_NOESC;
14446 break;
14447 case OPT_NOCOMMANDS:
14448 flags |= JIM_SUBST_NOCMD;
14449 break;
14450 case OPT_NOVARIABLES:
14451 flags |= JIM_SUBST_NOVAR;
14452 break;
14455 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14456 return JIM_ERR;
14458 Jim_SetResult(interp, objPtr);
14459 return JIM_OK;
14462 /* [info] */
14463 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14465 int cmd;
14466 Jim_Obj *objPtr;
14467 int mode = 0;
14469 static const char * const commands[] = {
14470 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14471 "vars", "version", "patchlevel", "complete", "args", "hostname",
14472 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14473 "references", "alias", NULL
14475 enum
14476 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14477 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14478 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14479 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14482 #ifdef jim_ext_namespace
14483 int nons = 0;
14485 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14486 /* This is for internal use only */
14487 argc--;
14488 argv++;
14489 nons = 1;
14491 #endif
14493 if (argc < 2) {
14494 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14495 return JIM_ERR;
14497 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14498 != JIM_OK) {
14499 return JIM_ERR;
14502 /* Test for the most common commands first, just in case it makes a difference */
14503 switch (cmd) {
14504 case INFO_EXISTS:
14505 if (argc != 3) {
14506 Jim_WrongNumArgs(interp, 2, argv, "varName");
14507 return JIM_ERR;
14509 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14510 break;
14512 case INFO_ALIAS:{
14513 Jim_Cmd *cmdPtr;
14515 if (argc != 3) {
14516 Jim_WrongNumArgs(interp, 2, argv, "command");
14517 return JIM_ERR;
14519 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14520 return JIM_ERR;
14522 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14523 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14524 return JIM_ERR;
14526 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14527 return JIM_OK;
14530 case INFO_CHANNELS:
14531 mode++; /* JIM_CMDLIST_CHANNELS */
14532 #ifndef jim_ext_aio
14533 Jim_SetResultString(interp, "aio not enabled", -1);
14534 return JIM_ERR;
14535 #endif
14536 /* fall through */
14537 case INFO_PROCS:
14538 mode++; /* JIM_CMDLIST_PROCS */
14539 /* fall through */
14540 case INFO_COMMANDS:
14541 /* mode 0 => JIM_CMDLIST_COMMANDS */
14542 if (argc != 2 && argc != 3) {
14543 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14544 return JIM_ERR;
14546 #ifdef jim_ext_namespace
14547 if (!nons) {
14548 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14549 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14552 #endif
14553 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14554 break;
14556 case INFO_VARS:
14557 mode++; /* JIM_VARLIST_VARS */
14558 /* fall through */
14559 case INFO_LOCALS:
14560 mode++; /* JIM_VARLIST_LOCALS */
14561 /* fall through */
14562 case INFO_GLOBALS:
14563 /* mode 0 => JIM_VARLIST_GLOBALS */
14564 if (argc != 2 && argc != 3) {
14565 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14566 return JIM_ERR;
14568 #ifdef jim_ext_namespace
14569 if (!nons) {
14570 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14571 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14574 #endif
14575 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14576 break;
14578 case INFO_SCRIPT:
14579 if (argc != 2) {
14580 Jim_WrongNumArgs(interp, 2, argv, "");
14581 return JIM_ERR;
14583 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14584 break;
14586 case INFO_SOURCE:{
14587 jim_wide line;
14588 Jim_Obj *resObjPtr;
14589 Jim_Obj *fileNameObj;
14591 if (argc != 3 && argc != 5) {
14592 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14593 return JIM_ERR;
14595 if (argc == 5) {
14596 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14597 return JIM_ERR;
14599 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14600 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14602 else {
14603 if (argv[2]->typePtr == &sourceObjType) {
14604 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14605 line = argv[2]->internalRep.sourceValue.lineNumber;
14607 else if (argv[2]->typePtr == &scriptObjType) {
14608 ScriptObj *script = JimGetScript(interp, argv[2]);
14609 fileNameObj = script->fileNameObj;
14610 line = script->firstline;
14612 else {
14613 fileNameObj = interp->emptyObj;
14614 line = 1;
14616 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14617 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14618 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14620 Jim_SetResult(interp, resObjPtr);
14621 break;
14624 case INFO_STACKTRACE:
14625 Jim_SetResult(interp, interp->stackTrace);
14626 break;
14628 case INFO_LEVEL:
14629 case INFO_FRAME:
14630 switch (argc) {
14631 case 2:
14632 Jim_SetResultInt(interp, interp->framePtr->level);
14633 break;
14635 case 3:
14636 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14637 return JIM_ERR;
14639 Jim_SetResult(interp, objPtr);
14640 break;
14642 default:
14643 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14644 return JIM_ERR;
14646 break;
14648 case INFO_BODY:
14649 case INFO_STATICS:
14650 case INFO_ARGS:{
14651 Jim_Cmd *cmdPtr;
14653 if (argc != 3) {
14654 Jim_WrongNumArgs(interp, 2, argv, "procname");
14655 return JIM_ERR;
14657 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14658 return JIM_ERR;
14660 if (!cmdPtr->isproc) {
14661 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14662 return JIM_ERR;
14664 switch (cmd) {
14665 case INFO_BODY:
14666 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14667 break;
14668 case INFO_ARGS:
14669 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14670 break;
14671 case INFO_STATICS:
14672 if (cmdPtr->u.proc.staticVars) {
14673 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14674 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14675 NULL, JimVariablesMatch, mode));
14677 break;
14679 break;
14682 case INFO_VERSION:
14683 case INFO_PATCHLEVEL:{
14684 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14686 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14687 Jim_SetResultString(interp, buf, -1);
14688 break;
14691 case INFO_COMPLETE:
14692 if (argc != 3 && argc != 4) {
14693 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14694 return JIM_ERR;
14696 else {
14697 char missing;
14699 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14700 if (missing != ' ' && argc == 4) {
14701 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14704 break;
14706 case INFO_HOSTNAME:
14707 /* Redirect to os.gethostname if it exists */
14708 return Jim_Eval(interp, "os.gethostname");
14710 case INFO_NAMEOFEXECUTABLE:
14711 /* Redirect to Tcl proc */
14712 return Jim_Eval(interp, "{info nameofexecutable}");
14714 case INFO_RETURNCODES:
14715 if (argc == 2) {
14716 int i;
14717 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14719 for (i = 0; jimReturnCodes[i]; i++) {
14720 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14721 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14722 jimReturnCodes[i], -1));
14725 Jim_SetResult(interp, listObjPtr);
14727 else if (argc == 3) {
14728 long code;
14729 const char *name;
14731 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14732 return JIM_ERR;
14734 name = Jim_ReturnCode(code);
14735 if (*name == '?') {
14736 Jim_SetResultInt(interp, code);
14738 else {
14739 Jim_SetResultString(interp, name, -1);
14742 else {
14743 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14744 return JIM_ERR;
14746 break;
14747 case INFO_REFERENCES:
14748 #ifdef JIM_REFERENCES
14749 return JimInfoReferences(interp, argc, argv);
14750 #else
14751 Jim_SetResultString(interp, "not supported", -1);
14752 return JIM_ERR;
14753 #endif
14755 return JIM_OK;
14758 /* [exists] */
14759 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14761 Jim_Obj *objPtr;
14762 int result = 0;
14764 static const char * const options[] = {
14765 "-command", "-proc", "-alias", "-var", NULL
14767 enum
14769 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14771 int option;
14773 if (argc == 2) {
14774 option = OPT_VAR;
14775 objPtr = argv[1];
14777 else if (argc == 3) {
14778 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14779 return JIM_ERR;
14781 objPtr = argv[2];
14783 else {
14784 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14785 return JIM_ERR;
14788 if (option == OPT_VAR) {
14789 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14791 else {
14792 /* Now different kinds of commands */
14793 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14795 if (cmd) {
14796 switch (option) {
14797 case OPT_COMMAND:
14798 result = 1;
14799 break;
14801 case OPT_ALIAS:
14802 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14803 break;
14805 case OPT_PROC:
14806 result = cmd->isproc;
14807 break;
14811 Jim_SetResultBool(interp, result);
14812 return JIM_OK;
14815 /* [split] */
14816 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14818 const char *str, *splitChars, *noMatchStart;
14819 int splitLen, strLen;
14820 Jim_Obj *resObjPtr;
14821 int c;
14822 int len;
14824 if (argc != 2 && argc != 3) {
14825 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14826 return JIM_ERR;
14829 str = Jim_GetString(argv[1], &len);
14830 if (len == 0) {
14831 return JIM_OK;
14833 strLen = Jim_Utf8Length(interp, argv[1]);
14835 /* Init */
14836 if (argc == 2) {
14837 splitChars = " \n\t\r";
14838 splitLen = 4;
14840 else {
14841 splitChars = Jim_String(argv[2]);
14842 splitLen = Jim_Utf8Length(interp, argv[2]);
14845 noMatchStart = str;
14846 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14848 /* Split */
14849 if (splitLen) {
14850 Jim_Obj *objPtr;
14851 while (strLen--) {
14852 const char *sc = splitChars;
14853 int scLen = splitLen;
14854 int sl = utf8_tounicode(str, &c);
14855 while (scLen--) {
14856 int pc;
14857 sc += utf8_tounicode(sc, &pc);
14858 if (c == pc) {
14859 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14860 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14861 noMatchStart = str + sl;
14862 break;
14865 str += sl;
14867 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14868 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14870 else {
14871 /* This handles the special case of splitchars eq {}
14872 * Optimise by sharing common (ASCII) characters
14874 Jim_Obj **commonObj = NULL;
14875 #define NUM_COMMON (128 - 9)
14876 while (strLen--) {
14877 int n = utf8_tounicode(str, &c);
14878 #ifdef JIM_OPTIMIZATION
14879 if (c >= 9 && c < 128) {
14880 /* Common ASCII char. Note that 9 is the tab character */
14881 c -= 9;
14882 if (!commonObj) {
14883 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14884 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14886 if (!commonObj[c]) {
14887 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14889 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14890 str++;
14891 continue;
14893 #endif
14894 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14895 str += n;
14897 Jim_Free(commonObj);
14900 Jim_SetResult(interp, resObjPtr);
14901 return JIM_OK;
14904 /* [join] */
14905 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14907 const char *joinStr;
14908 int joinStrLen;
14910 if (argc != 2 && argc != 3) {
14911 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14912 return JIM_ERR;
14914 /* Init */
14915 if (argc == 2) {
14916 joinStr = " ";
14917 joinStrLen = 1;
14919 else {
14920 joinStr = Jim_GetString(argv[2], &joinStrLen);
14922 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14923 return JIM_OK;
14926 /* [format] */
14927 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14929 Jim_Obj *objPtr;
14931 if (argc < 2) {
14932 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14933 return JIM_ERR;
14935 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14936 if (objPtr == NULL)
14937 return JIM_ERR;
14938 Jim_SetResult(interp, objPtr);
14939 return JIM_OK;
14942 /* [scan] */
14943 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14945 Jim_Obj *listPtr, **outVec;
14946 int outc, i;
14948 if (argc < 3) {
14949 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14950 return JIM_ERR;
14952 if (argv[2]->typePtr != &scanFmtStringObjType)
14953 SetScanFmtFromAny(interp, argv[2]);
14954 if (FormatGetError(argv[2]) != 0) {
14955 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14956 return JIM_ERR;
14958 if (argc > 3) {
14959 int maxPos = FormatGetMaxPos(argv[2]);
14960 int count = FormatGetCnvCount(argv[2]);
14962 if (maxPos > argc - 3) {
14963 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14964 return JIM_ERR;
14966 else if (count > argc - 3) {
14967 Jim_SetResultString(interp, "different numbers of variable names and "
14968 "field specifiers", -1);
14969 return JIM_ERR;
14971 else if (count < argc - 3) {
14972 Jim_SetResultString(interp, "variable is not assigned by any "
14973 "conversion specifiers", -1);
14974 return JIM_ERR;
14977 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14978 if (listPtr == 0)
14979 return JIM_ERR;
14980 if (argc > 3) {
14981 int rc = JIM_OK;
14982 int count = 0;
14984 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14985 int len = Jim_ListLength(interp, listPtr);
14987 if (len != 0) {
14988 JimListGetElements(interp, listPtr, &outc, &outVec);
14989 for (i = 0; i < outc; ++i) {
14990 if (Jim_Length(outVec[i]) > 0) {
14991 ++count;
14992 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14993 rc = JIM_ERR;
14998 Jim_FreeNewObj(interp, listPtr);
15000 else {
15001 count = -1;
15003 if (rc == JIM_OK) {
15004 Jim_SetResultInt(interp, count);
15006 return rc;
15008 else {
15009 if (listPtr == (Jim_Obj *)EOF) {
15010 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15011 return JIM_OK;
15013 Jim_SetResult(interp, listPtr);
15015 return JIM_OK;
15018 /* [error] */
15019 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15021 if (argc != 2 && argc != 3) {
15022 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15023 return JIM_ERR;
15025 Jim_SetResult(interp, argv[1]);
15026 if (argc == 3) {
15027 JimSetStackTrace(interp, argv[2]);
15028 return JIM_ERR;
15030 interp->addStackTrace++;
15031 return JIM_ERR;
15034 /* [lrange] */
15035 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15037 Jim_Obj *objPtr;
15039 if (argc != 4) {
15040 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15041 return JIM_ERR;
15043 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15044 return JIM_ERR;
15045 Jim_SetResult(interp, objPtr);
15046 return JIM_OK;
15049 /* [lrepeat] */
15050 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15052 Jim_Obj *objPtr;
15053 long count;
15055 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15056 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15057 return JIM_ERR;
15060 if (count == 0 || argc == 2) {
15061 return JIM_OK;
15064 argc -= 2;
15065 argv += 2;
15067 objPtr = Jim_NewListObj(interp, argv, argc);
15068 while (--count) {
15069 ListInsertElements(objPtr, -1, argc, argv);
15072 Jim_SetResult(interp, objPtr);
15073 return JIM_OK;
15076 char **Jim_GetEnviron(void)
15078 #if defined(HAVE__NSGETENVIRON)
15079 return *_NSGetEnviron();
15080 #else
15081 #if !defined(NO_ENVIRON_EXTERN)
15082 extern char **environ;
15083 #endif
15085 return environ;
15086 #endif
15089 void Jim_SetEnviron(char **env)
15091 #if defined(HAVE__NSGETENVIRON)
15092 *_NSGetEnviron() = env;
15093 #else
15094 #if !defined(NO_ENVIRON_EXTERN)
15095 extern char **environ;
15096 #endif
15098 environ = env;
15099 #endif
15102 /* [env] */
15103 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15105 const char *key;
15106 const char *val;
15108 if (argc == 1) {
15109 char **e = Jim_GetEnviron();
15111 int i;
15112 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15114 for (i = 0; e[i]; i++) {
15115 const char *equals = strchr(e[i], '=');
15117 if (equals) {
15118 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15119 equals - e[i]));
15120 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15124 Jim_SetResult(interp, listObjPtr);
15125 return JIM_OK;
15128 if (argc < 2) {
15129 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15130 return JIM_ERR;
15132 key = Jim_String(argv[1]);
15133 val = getenv(key);
15134 if (val == NULL) {
15135 if (argc < 3) {
15136 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15137 return JIM_ERR;
15139 val = Jim_String(argv[2]);
15141 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15142 return JIM_OK;
15145 /* [source] */
15146 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15148 int retval;
15150 if (argc != 2) {
15151 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15152 return JIM_ERR;
15154 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15155 if (retval == JIM_RETURN)
15156 return JIM_OK;
15157 return retval;
15160 /* [lreverse] */
15161 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15163 Jim_Obj *revObjPtr, **ele;
15164 int len;
15166 if (argc != 2) {
15167 Jim_WrongNumArgs(interp, 1, argv, "list");
15168 return JIM_ERR;
15170 JimListGetElements(interp, argv[1], &len, &ele);
15171 len--;
15172 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15173 while (len >= 0)
15174 ListAppendElement(revObjPtr, ele[len--]);
15175 Jim_SetResult(interp, revObjPtr);
15176 return JIM_OK;
15179 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15181 jim_wide len;
15183 if (step == 0)
15184 return -1;
15185 if (start == end)
15186 return 0;
15187 else if (step > 0 && start > end)
15188 return -1;
15189 else if (step < 0 && end > start)
15190 return -1;
15191 len = end - start;
15192 if (len < 0)
15193 len = -len; /* abs(len) */
15194 if (step < 0)
15195 step = -step; /* abs(step) */
15196 len = 1 + ((len - 1) / step);
15197 /* We can truncate safely to INT_MAX, the range command
15198 * will always return an error for a such long range
15199 * because Tcl lists can't be so long. */
15200 if (len > INT_MAX)
15201 len = INT_MAX;
15202 return (int)((len < 0) ? -1 : len);
15205 /* [range] */
15206 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15208 jim_wide start = 0, end, step = 1;
15209 int len, i;
15210 Jim_Obj *objPtr;
15212 if (argc < 2 || argc > 4) {
15213 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15214 return JIM_ERR;
15216 if (argc == 2) {
15217 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15218 return JIM_ERR;
15220 else {
15221 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15222 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15223 return JIM_ERR;
15224 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15225 return JIM_ERR;
15227 if ((len = JimRangeLen(start, end, step)) == -1) {
15228 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15229 return JIM_ERR;
15231 objPtr = Jim_NewListObj(interp, NULL, 0);
15232 for (i = 0; i < len; i++)
15233 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15234 Jim_SetResult(interp, objPtr);
15235 return JIM_OK;
15238 /* [rand] */
15239 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15241 jim_wide min = 0, max = 0, len, maxMul;
15243 if (argc < 1 || argc > 3) {
15244 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15245 return JIM_ERR;
15247 if (argc == 1) {
15248 max = JIM_WIDE_MAX;
15249 } else if (argc == 2) {
15250 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15251 return JIM_ERR;
15252 } else if (argc == 3) {
15253 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15254 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15255 return JIM_ERR;
15257 len = max-min;
15258 if (len < 0) {
15259 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15260 return JIM_ERR;
15262 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15263 while (1) {
15264 jim_wide r;
15266 JimRandomBytes(interp, &r, sizeof(jim_wide));
15267 if (r < 0 || r >= maxMul) continue;
15268 r = (len == 0) ? 0 : r%len;
15269 Jim_SetResultInt(interp, min+r);
15270 return JIM_OK;
15274 static const struct {
15275 const char *name;
15276 Jim_CmdProc *cmdProc;
15277 } Jim_CoreCommandsTable[] = {
15278 {"alias", Jim_AliasCoreCommand},
15279 {"set", Jim_SetCoreCommand},
15280 {"unset", Jim_UnsetCoreCommand},
15281 {"puts", Jim_PutsCoreCommand},
15282 {"+", Jim_AddCoreCommand},
15283 {"*", Jim_MulCoreCommand},
15284 {"-", Jim_SubCoreCommand},
15285 {"/", Jim_DivCoreCommand},
15286 {"incr", Jim_IncrCoreCommand},
15287 {"while", Jim_WhileCoreCommand},
15288 {"loop", Jim_LoopCoreCommand},
15289 {"for", Jim_ForCoreCommand},
15290 {"foreach", Jim_ForeachCoreCommand},
15291 {"lmap", Jim_LmapCoreCommand},
15292 {"lassign", Jim_LassignCoreCommand},
15293 {"if", Jim_IfCoreCommand},
15294 {"switch", Jim_SwitchCoreCommand},
15295 {"list", Jim_ListCoreCommand},
15296 {"lindex", Jim_LindexCoreCommand},
15297 {"lset", Jim_LsetCoreCommand},
15298 {"lsearch", Jim_LsearchCoreCommand},
15299 {"llength", Jim_LlengthCoreCommand},
15300 {"lappend", Jim_LappendCoreCommand},
15301 {"linsert", Jim_LinsertCoreCommand},
15302 {"lreplace", Jim_LreplaceCoreCommand},
15303 {"lsort", Jim_LsortCoreCommand},
15304 {"append", Jim_AppendCoreCommand},
15305 {"debug", Jim_DebugCoreCommand},
15306 {"eval", Jim_EvalCoreCommand},
15307 {"uplevel", Jim_UplevelCoreCommand},
15308 {"expr", Jim_ExprCoreCommand},
15309 {"break", Jim_BreakCoreCommand},
15310 {"continue", Jim_ContinueCoreCommand},
15311 {"proc", Jim_ProcCoreCommand},
15312 {"concat", Jim_ConcatCoreCommand},
15313 {"return", Jim_ReturnCoreCommand},
15314 {"upvar", Jim_UpvarCoreCommand},
15315 {"global", Jim_GlobalCoreCommand},
15316 {"string", Jim_StringCoreCommand},
15317 {"time", Jim_TimeCoreCommand},
15318 {"exit", Jim_ExitCoreCommand},
15319 {"catch", Jim_CatchCoreCommand},
15320 #ifdef JIM_REFERENCES
15321 {"ref", Jim_RefCoreCommand},
15322 {"getref", Jim_GetrefCoreCommand},
15323 {"setref", Jim_SetrefCoreCommand},
15324 {"finalize", Jim_FinalizeCoreCommand},
15325 {"collect", Jim_CollectCoreCommand},
15326 #endif
15327 {"rename", Jim_RenameCoreCommand},
15328 {"dict", Jim_DictCoreCommand},
15329 {"subst", Jim_SubstCoreCommand},
15330 {"info", Jim_InfoCoreCommand},
15331 {"exists", Jim_ExistsCoreCommand},
15332 {"split", Jim_SplitCoreCommand},
15333 {"join", Jim_JoinCoreCommand},
15334 {"format", Jim_FormatCoreCommand},
15335 {"scan", Jim_ScanCoreCommand},
15336 {"error", Jim_ErrorCoreCommand},
15337 {"lrange", Jim_LrangeCoreCommand},
15338 {"lrepeat", Jim_LrepeatCoreCommand},
15339 {"env", Jim_EnvCoreCommand},
15340 {"source", Jim_SourceCoreCommand},
15341 {"lreverse", Jim_LreverseCoreCommand},
15342 {"range", Jim_RangeCoreCommand},
15343 {"rand", Jim_RandCoreCommand},
15344 {"tailcall", Jim_TailcallCoreCommand},
15345 {"local", Jim_LocalCoreCommand},
15346 {"upcall", Jim_UpcallCoreCommand},
15347 {"apply", Jim_ApplyCoreCommand},
15348 {NULL, NULL},
15351 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15353 int i = 0;
15355 while (Jim_CoreCommandsTable[i].name != NULL) {
15356 Jim_CreateCommand(interp,
15357 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15358 i++;
15362 /* -----------------------------------------------------------------------------
15363 * Interactive prompt
15364 * ---------------------------------------------------------------------------*/
15365 void Jim_MakeErrorMessage(Jim_Interp *interp)
15367 Jim_Obj *argv[2];
15369 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15370 argv[1] = interp->result;
15372 Jim_EvalObjVector(interp, 2, argv);
15375 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15376 const char *prefix, const char *const *tablePtr, const char *name)
15378 int count;
15379 char **tablePtrSorted;
15380 int i;
15382 for (count = 0; tablePtr[count]; count++) {
15385 if (name == NULL) {
15386 name = "option";
15389 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15390 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15391 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15392 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15393 for (i = 0; i < count; i++) {
15394 if (i + 1 == count && count > 1) {
15395 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15397 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15398 if (i + 1 != count) {
15399 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15402 Jim_Free(tablePtrSorted);
15405 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15406 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15408 const char *bad = "bad ";
15409 const char *const *entryPtr = NULL;
15410 int i;
15411 int match = -1;
15412 int arglen;
15413 const char *arg = Jim_GetString(objPtr, &arglen);
15415 *indexPtr = -1;
15417 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15418 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15419 /* Found an exact match */
15420 *indexPtr = i;
15421 return JIM_OK;
15423 if (flags & JIM_ENUM_ABBREV) {
15424 /* Accept an unambiguous abbreviation.
15425 * Note that '-' doesnt' consitute a valid abbreviation
15427 if (strncmp(arg, *entryPtr, arglen) == 0) {
15428 if (*arg == '-' && arglen == 1) {
15429 break;
15431 if (match >= 0) {
15432 bad = "ambiguous ";
15433 goto ambiguous;
15435 match = i;
15440 /* If we had an unambiguous partial match */
15441 if (match >= 0) {
15442 *indexPtr = match;
15443 return JIM_OK;
15446 ambiguous:
15447 if (flags & JIM_ERRMSG) {
15448 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15450 return JIM_ERR;
15453 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15455 int i;
15457 for (i = 0; i < (int)len; i++) {
15458 if (array[i] && strcmp(array[i], name) == 0) {
15459 return i;
15462 return -1;
15465 int Jim_IsDict(Jim_Obj *objPtr)
15467 return objPtr->typePtr == &dictObjType;
15470 int Jim_IsList(Jim_Obj *objPtr)
15472 return objPtr->typePtr == &listObjType;
15476 * Very simple printf-like formatting, designed for error messages.
15478 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15479 * The resulting string is created and set as the result.
15481 * Each '%s' should correspond to a regular string parameter.
15482 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15483 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15485 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15487 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15489 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15491 /* Initial space needed */
15492 int len = strlen(format);
15493 int extra = 0;
15494 int n = 0;
15495 const char *params[5];
15496 char *buf;
15497 va_list args;
15498 int i;
15500 va_start(args, format);
15502 for (i = 0; i < len && n < 5; i++) {
15503 int l;
15505 if (strncmp(format + i, "%s", 2) == 0) {
15506 params[n] = va_arg(args, char *);
15508 l = strlen(params[n]);
15510 else if (strncmp(format + i, "%#s", 3) == 0) {
15511 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15513 params[n] = Jim_GetString(objPtr, &l);
15515 else {
15516 if (format[i] == '%') {
15517 i++;
15519 continue;
15521 n++;
15522 extra += l;
15525 len += extra;
15526 buf = Jim_Alloc(len + 1);
15527 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15529 va_end(args);
15531 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15534 /* stubs */
15535 #ifndef jim_ext_package
15536 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15538 return JIM_OK;
15540 #endif
15541 #ifndef jim_ext_aio
15542 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15544 Jim_SetResultString(interp, "aio not enabled", -1);
15545 return NULL;
15547 #endif
15551 * Local Variables: ***
15552 * c-basic-offset: 4 ***
15553 * tab-width: 4 ***
15554 * End: ***