jimregexp: remove dead code
[jimtcl.git] / jim.c
blob74a042100076d4d9cfe5a7d68201de33cd7f6f13
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
130 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
131 int flags);
132 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
133 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
134 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
135 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
136 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
137 const char *prefix, const char *const *tablePtr, const char *name);
138 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
139 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
140 static int JimSign(jim_wide w);
141 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
142 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
143 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s, int *uc, int upper)
153 int l = utf8_tounicode(s, uc);
154 if (upper) {
155 *uc = utf8_upper(*uc);
157 return l;
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
182 int not = 0;
183 int pchar;
184 int match = 0;
185 int nocase = 0;
187 if (flags & JIM_NOCASE) {
188 nocase++;
189 c = utf8_upper(c);
192 if (flags & JIM_CHARSET_SCAN) {
193 if (*pattern == '^') {
194 not++;
195 pattern++;
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern == ']') {
200 goto first;
204 while (*pattern && *pattern != ']') {
205 /* Exact match */
206 if (pattern[0] == '\\') {
207 first:
208 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
210 else {
211 /* Is this a range? a-z */
212 int start;
213 int end;
215 pattern += utf8_tounicode_case(pattern, &start, nocase);
216 if (pattern[0] == '-' && pattern[1]) {
217 /* skip '-' */
218 pattern += utf8_tounicode(pattern, &pchar);
219 pattern += utf8_tounicode_case(pattern, &end, nocase);
221 /* Handle reversed range too */
222 if ((c >= start && c <= end) || (c >= end && c <= start)) {
223 match = 1;
225 continue;
227 pchar = start;
230 if (pchar == c) {
231 match = 1;
234 if (not) {
235 match = !match;
238 return match ? pattern : NULL;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
311 * string comparison. Works on binary data.
313 * Returns -1, 0 or 1
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
319 if (l1 < l2) {
320 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
322 else if (l2 < l1) {
323 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
325 else {
326 return JimSign(memcmp(s1, s2, l1));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
340 while (*s1 && *s2 && maxchars) {
341 int c1, c2;
342 s1 += utf8_tounicode_case(s1, &c1, nocase);
343 s2 += utf8_tounicode_case(s2, &c2, nocase);
344 if (c1 != c2) {
345 return JimSign(c1 - c2);
347 maxchars--;
349 if (!maxchars) {
350 return 0;
352 /* One string or both terminated */
353 if (*s1) {
354 return 1;
356 if (*s2) {
357 return -1;
359 return 0;
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
367 int i;
368 int l1bytelen;
370 if (!l1 || !l2 || l1 > l2) {
371 return -1;
373 if (idx < 0)
374 idx = 0;
375 s2 += utf8_index(s2, idx);
377 l1bytelen = utf8_index(s1, l1);
379 for (i = idx; i <= l2 - l1; i++) {
380 int c;
381 if (memcmp(s2, s1, l1bytelen) == 0) {
382 return i;
384 s2 += utf8_tounicode(s2, &c);
386 return -1;
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
394 const char *p;
396 if (!l1 || !l2 || l1 > l2)
397 return -1;
399 /* Now search for the needle */
400 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
401 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
402 return p - s2;
405 return -1;
408 #ifdef JIM_UTF8
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
414 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
415 if (n > 0) {
416 n = utf8_strlen(s2, n);
418 return n;
420 #endif
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str, const char *endptr)
431 if (str[0] == '\0' || str == endptr) {
432 return JIM_ERR;
435 if (endptr[0] != '\0') {
436 while (*endptr) {
437 if (!isspace(UCHAR(*endptr))) {
438 return JIM_ERR;
440 endptr++;
443 return JIM_OK;
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str, int *base, int *sign)
451 int i = 0;
453 *base = 10;
455 while (isspace(UCHAR(str[i]))) {
456 i++;
459 if (str[i] == '-') {
460 *sign = -1;
461 i++;
463 else {
464 if (str[i] == '+') {
465 i++;
467 *sign = 1;
470 if (str[i] != '0') {
471 /* base 10 */
472 return 0;
475 /* We have 0<x>, so see if we can convert it */
476 switch (str[i + 1]) {
477 case 'x': case 'X': *base = 16; break;
478 case 'o': case 'O': *base = 8; break;
479 case 'b': case 'B': *base = 2; break;
480 default: return 0;
482 i += 2;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
485 /* Parse according to this base */
486 return i;
488 /* Parse as base 10 */
489 *base = 10;
490 return 0;
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str, char **endptr)
498 int sign;
499 int base;
500 int i = JimNumberBase(str, &base, &sign);
502 if (base != 10) {
503 long value = strtol(str + i, endptr, base);
504 if (endptr == NULL || *endptr != str + i) {
505 return value * sign;
509 /* Can just do a regular base-10 conversion */
510 return strtol(str, endptr, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide jim_strtoull(const char *str, char **endptr)
519 #ifdef HAVE_LONG_LONG
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 jim_wide value = strtoull(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str, endptr, 10);
533 #else
534 return (unsigned long)jim_strtol(str, endptr);
535 #endif
538 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
540 char *endptr;
542 if (base) {
543 *widePtr = strtoull(str, &endptr, base);
545 else {
546 *widePtr = jim_strtoull(str, &endptr);
549 return JimCheckConversion(str, endptr);
552 int Jim_StringToDouble(const char *str, double *doublePtr)
554 char *endptr;
556 /* Callers can check for underflow via ERANGE */
557 errno = 0;
559 *doublePtr = strtod(str, &endptr);
561 return JimCheckConversion(str, endptr);
564 static jim_wide JimPowWide(jim_wide b, jim_wide e)
566 jim_wide i, res = 1;
568 if ((b == 0 && e != 0) || (e < 0))
569 return 0;
570 for (i = 0; i < e; i++) {
571 res *= b;
573 return res;
576 /* -----------------------------------------------------------------------------
577 * Special functions
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition, const char *fmt, ...)
582 va_list ap;
584 if (!condition) {
585 return;
588 va_start(ap, fmt);
590 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr, fmt, ap);
592 fprintf(stderr, "\n\n");
593 va_end(ap);
595 #ifdef HAVE_BACKTRACE
597 void *array[40];
598 int size, i;
599 char **strings;
601 size = backtrace(array, 40);
602 strings = backtrace_symbols(array, size);
603 for (i = 0; i < size; i++)
604 fprintf(stderr, "[backtrace] %s\n", strings[i]);
605 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
608 #endif
610 exit(1);
612 #endif
614 /* -----------------------------------------------------------------------------
615 * Memory allocation
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size)
620 return size ? malloc(size) : NULL;
623 void Jim_Free(void *ptr)
625 free(ptr);
628 void *Jim_Realloc(void *ptr, int size)
630 return realloc(ptr, size);
633 char *Jim_StrDup(const char *s)
635 return strdup(s);
638 char *Jim_StrDupLen(const char *s, int l)
640 char *copy = Jim_Alloc(l + 1);
642 memcpy(copy, s, l + 1);
643 copy[l] = 0; /* Just to be sure, original could be substring */
644 return copy;
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide JimClock(void)
654 struct timeval tv;
656 gettimeofday(&tv, NULL);
657 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
660 /* -----------------------------------------------------------------------------
661 * Hash Tables
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
666 static unsigned int JimHashTableNextPower(unsigned int size);
667 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key)
674 key += ~(key << 15);
675 key ^= (key >> 10);
676 key += (key << 3);
677 key ^= (key >> 6);
678 key += ~(key << 11);
679 key ^= (key >> 16);
680 return key;
683 /* Generic hash function (we are using to multiply by 9 and add the byte
684 * as Tcl) */
685 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
687 unsigned int h = 0;
689 while (len--)
690 h += (h << 3) + *buf++;
691 return h;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable *ht)
699 ht->table = NULL;
700 ht->size = 0;
701 ht->sizemask = 0;
702 ht->used = 0;
703 ht->collisions = 0;
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht->uniq = (rand() ^ time(NULL) ^ clock());
709 #else
710 ht->uniq = 0;
711 #endif
714 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
716 iter->ht = ht;
717 iter->index = -1;
718 iter->entry = NULL;
719 iter->nextEntry = NULL;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
725 JimResetHashTable(ht);
726 ht->type = type;
727 ht->privdata = privDataPtr;
728 return JIM_OK;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable *ht)
735 int minimal = ht->used;
737 if (minimal < JIM_HT_INITIAL_SIZE)
738 minimal = JIM_HT_INITIAL_SIZE;
739 Jim_ExpandHashTable(ht, minimal);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
745 Jim_HashTable n; /* the new hashtable */
746 unsigned int realsize = JimHashTableNextPower(size), i;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size <= ht->used)
751 return;
753 Jim_InitHashTable(&n, ht->type, ht->privdata);
754 n.size = realsize;
755 n.sizemask = realsize - 1;
756 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
757 /* Keep the same 'uniq' as the original */
758 n.uniq = ht->uniq;
760 /* Initialize all the pointers to NULL */
761 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
766 n.used = ht->used;
767 for (i = 0; ht->used > 0; i++) {
768 Jim_HashEntry *he, *nextHe;
770 if (ht->table[i] == NULL)
771 continue;
773 /* For each hash entry on this slot... */
774 he = ht->table[i];
775 while (he) {
776 unsigned int h;
778 nextHe = he->next;
779 /* Get the new element index */
780 h = Jim_HashKey(ht, he->key) & n.sizemask;
781 he->next = n.table[h];
782 n.table[h] = he;
783 ht->used--;
784 /* Pass to the next element */
785 he = nextHe;
788 assert(ht->used == 0);
789 Jim_Free(ht->table);
791 /* Remap the new hashtable in the old */
792 *ht = n;
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
798 Jim_HashEntry *entry;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry = JimInsertHashEntry(ht, key, 0);
803 if (entry == NULL)
804 return JIM_ERR;
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht, entry, key);
808 Jim_SetHashVal(ht, entry, val);
809 return JIM_OK;
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
815 int existed;
816 Jim_HashEntry *entry;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry = JimInsertHashEntry(ht, key, 1);
821 if (entry->key) {
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht->type->valDestructor && ht->type->valDup) {
828 void *newval = ht->type->valDup(ht->privdata, val);
829 ht->type->valDestructor(ht->privdata, entry->u.val);
830 entry->u.val = newval;
832 else {
833 Jim_FreeEntryVal(ht, entry);
834 Jim_SetHashVal(ht, entry, val);
836 existed = 1;
838 else {
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht, entry, key);
841 Jim_SetHashVal(ht, entry, val);
842 existed = 0;
845 return existed;
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
851 unsigned int h;
852 Jim_HashEntry *he, *prevHe;
854 if (ht->used == 0)
855 return JIM_ERR;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
859 prevHe = NULL;
860 while (he) {
861 if (Jim_CompareHashKeys(ht, key, he->key)) {
862 /* Unlink the element from the list */
863 if (prevHe)
864 prevHe->next = he->next;
865 else
866 ht->table[h] = he->next;
867 Jim_FreeEntryKey(ht, he);
868 Jim_FreeEntryVal(ht, he);
869 Jim_Free(he);
870 ht->used--;
871 return JIM_OK;
873 prevHe = he;
874 he = he->next;
876 return JIM_ERR; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable *ht)
882 unsigned int i;
884 /* Free all the elements */
885 for (i = 0; ht->used > 0; i++) {
886 Jim_HashEntry *he, *nextHe;
888 if ((he = ht->table[i]) == NULL)
889 continue;
890 while (he) {
891 nextHe = he->next;
892 Jim_FreeEntryKey(ht, he);
893 Jim_FreeEntryVal(ht, he);
894 Jim_Free(he);
895 ht->used--;
896 he = nextHe;
899 /* Free the table and the allocated cache structure */
900 Jim_Free(ht->table);
901 /* Re-initialize the table */
902 JimResetHashTable(ht);
903 return JIM_OK; /* never fails */
906 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
908 Jim_HashEntry *he;
909 unsigned int h;
911 if (ht->used == 0)
912 return NULL;
913 h = Jim_HashKey(ht, key) & ht->sizemask;
914 he = ht->table[h];
915 while (he) {
916 if (Jim_CompareHashKeys(ht, key, he->key))
917 return he;
918 he = he->next;
920 return NULL;
923 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
925 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
926 JimInitHashTableIterator(ht, iter);
927 return iter;
930 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
932 while (1) {
933 if (iter->entry == NULL) {
934 iter->index++;
935 if (iter->index >= (signed)iter->ht->size)
936 break;
937 iter->entry = iter->ht->table[iter->index];
939 else {
940 iter->entry = iter->nextEntry;
942 if (iter->entry) {
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter->nextEntry = iter->entry->next;
946 return iter->entry;
949 return NULL;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
959 if (ht->size == 0)
960 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
961 if (ht->size == ht->used)
962 Jim_ExpandHashTable(ht, ht->size * 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size)
968 unsigned int i = JIM_HT_INITIAL_SIZE;
970 if (size >= 2147483648U)
971 return 2147483648U;
972 while (1) {
973 if (i >= size)
974 return i;
975 i *= 2;
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
984 unsigned int h;
985 Jim_HashEntry *he;
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht);
990 /* Compute the key hash value */
991 h = Jim_HashKey(ht, key) & ht->sizemask;
992 /* Search if this slot does not already contain the given key */
993 he = ht->table[h];
994 while (he) {
995 if (Jim_CompareHashKeys(ht, key, he->key))
996 return replace ? he : NULL;
997 he = he->next;
1000 /* Allocates the memory and stores key */
1001 he = Jim_Alloc(sizeof(*he));
1002 he->next = ht->table[h];
1003 ht->table[h] = he;
1004 ht->used++;
1005 he->key = NULL;
1007 return he;
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key)
1014 return Jim_GenHashFunction(key, strlen(key));
1017 static void *JimStringCopyHTDup(void *privdata, const void *key)
1019 return Jim_StrDup(key);
1022 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1024 return strcmp(key1, key2) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1029 Jim_Free(key);
1032 static const Jim_HashTableType JimPackageHashTableType = {
1033 JimStringCopyHTHashFunction, /* hash function */
1034 JimStringCopyHTDup, /* key dup */
1035 NULL, /* val dup */
1036 JimStringCopyHTKeyCompare, /* key compare */
1037 JimStringCopyHTKeyDestructor, /* key destructor */
1038 NULL /* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc *delProc;
1044 void *data;
1045 } AssocDataValue;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1049 AssocDataValue *assocPtr = (AssocDataValue *) data;
1051 if (assocPtr->delProc != NULL)
1052 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1053 Jim_Free(data);
1056 static const Jim_HashTableType JimAssocDataHashTableType = {
1057 JimStringCopyHTHashFunction, /* hash function */
1058 JimStringCopyHTDup, /* key dup */
1059 NULL, /* val dup */
1060 JimStringCopyHTKeyCompare, /* key compare */
1061 JimStringCopyHTKeyDestructor, /* key destructor */
1062 JimAssocDataHashTableValueDestructor /* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack *stack)
1071 stack->len = 0;
1072 stack->maxlen = 0;
1073 stack->vector = NULL;
1076 void Jim_FreeStack(Jim_Stack *stack)
1078 Jim_Free(stack->vector);
1081 int Jim_StackLen(Jim_Stack *stack)
1083 return stack->len;
1086 void Jim_StackPush(Jim_Stack *stack, void *element)
1088 int neededLen = stack->len + 1;
1090 if (neededLen > stack->maxlen) {
1091 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1092 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1094 stack->vector[stack->len] = element;
1095 stack->len++;
1098 void *Jim_StackPop(Jim_Stack *stack)
1100 if (stack->len == 0)
1101 return NULL;
1102 stack->len--;
1103 return stack->vector[stack->len];
1106 void *Jim_StackPeek(Jim_Stack *stack)
1108 if (stack->len == 0)
1109 return NULL;
1110 return stack->vector[stack->len - 1];
1113 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1115 int i;
1117 for (i = 0; i < stack->len; i++)
1118 freeFunc(stack->vector[i]);
1121 /* -----------------------------------------------------------------------------
1122 * Tcl Parser
1123 * ---------------------------------------------------------------------------*/
1125 /* Token types */
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1154 /* Parser states */
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing {
1163 int ch; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1164 int line; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1169 struct JimParserCtx
1171 const char *p; /* Pointer to the point of the program we are parsing */
1172 int len; /* Remaining length */
1173 int linenr; /* Current line number */
1174 const char *tstart;
1175 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline; /* Line number of the returned token */
1177 int tt; /* Token type */
1178 int eof; /* Non zero if EOF condition is true. */
1179 int state; /* Parser state */
1180 int comment; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx *pc);
1185 static int JimParseSep(struct JimParserCtx *pc);
1186 static int JimParseEol(struct JimParserCtx *pc);
1187 static int JimParseCmd(struct JimParserCtx *pc);
1188 static int JimParseQuote(struct JimParserCtx *pc);
1189 static int JimParseVar(struct JimParserCtx *pc);
1190 static int JimParseBrace(struct JimParserCtx *pc);
1191 static int JimParseStr(struct JimParserCtx *pc);
1192 static int JimParseComment(struct JimParserCtx *pc);
1193 static void JimParseSubCmd(struct JimParserCtx *pc);
1194 static int JimParseSubQuote(struct JimParserCtx *pc);
1195 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1202 pc->p = prg;
1203 pc->len = len;
1204 pc->tstart = NULL;
1205 pc->tend = NULL;
1206 pc->tline = 0;
1207 pc->tt = JIM_TT_NONE;
1208 pc->eof = 0;
1209 pc->state = JIM_PS_DEF;
1210 pc->linenr = linenr;
1211 pc->comment = 1;
1212 pc->missing.ch = ' ';
1213 pc->missing.line = linenr;
1216 static int JimParseScript(struct JimParserCtx *pc)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1219 if (!pc->len) {
1220 pc->tstart = pc->p;
1221 pc->tend = pc->p - 1;
1222 pc->tline = pc->linenr;
1223 pc->tt = JIM_TT_EOL;
1224 pc->eof = 1;
1225 return JIM_OK;
1227 switch (*(pc->p)) {
1228 case '\\':
1229 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1230 return JimParseSep(pc);
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 case ' ':
1235 case '\t':
1236 case '\r':
1237 case '\f':
1238 if (pc->state == JIM_PS_DEF)
1239 return JimParseSep(pc);
1240 pc->comment = 0;
1241 return JimParseStr(pc);
1242 case '\n':
1243 case ';':
1244 pc->comment = 1;
1245 if (pc->state == JIM_PS_DEF)
1246 return JimParseEol(pc);
1247 return JimParseStr(pc);
1248 case '[':
1249 pc->comment = 0;
1250 return JimParseCmd(pc);
1251 case '$':
1252 pc->comment = 0;
1253 if (JimParseVar(pc) == JIM_ERR) {
1254 /* An orphan $. Create as a separate token */
1255 pc->tstart = pc->tend = pc->p++;
1256 pc->len--;
1257 pc->tt = JIM_TT_ESC;
1259 return JIM_OK;
1260 case '#':
1261 if (pc->comment) {
1262 JimParseComment(pc);
1263 continue;
1265 return JimParseStr(pc);
1266 default:
1267 pc->comment = 0;
1268 return JimParseStr(pc);
1270 return JIM_OK;
1274 static int JimParseSep(struct JimParserCtx *pc)
1276 pc->tstart = pc->p;
1277 pc->tline = pc->linenr;
1278 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1279 if (*pc->p == '\n') {
1280 break;
1282 if (*pc->p == '\\') {
1283 pc->p++;
1284 pc->len--;
1285 pc->linenr++;
1287 pc->p++;
1288 pc->len--;
1290 pc->tend = pc->p - 1;
1291 pc->tt = JIM_TT_SEP;
1292 return JIM_OK;
1295 static int JimParseEol(struct JimParserCtx *pc)
1297 pc->tstart = pc->p;
1298 pc->tline = pc->linenr;
1299 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1300 if (*pc->p == '\n')
1301 pc->linenr++;
1302 pc->p++;
1303 pc->len--;
1305 pc->tend = pc->p - 1;
1306 pc->tt = JIM_TT_EOL;
1307 return JIM_OK;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx *pc)
1340 int level = 1;
1342 /* Skip the brace */
1343 pc->p++;
1344 pc->len--;
1345 while (pc->len) {
1346 switch (*pc->p) {
1347 case '\\':
1348 if (pc->len > 1) {
1349 if (*++pc->p == '\n') {
1350 pc->linenr++;
1352 pc->len--;
1354 break;
1356 case '{':
1357 level++;
1358 break;
1360 case '}':
1361 if (--level == 0) {
1362 pc->tend = pc->p - 1;
1363 pc->p++;
1364 pc->len--;
1365 return;
1367 break;
1369 case '\n':
1370 pc->linenr++;
1371 break;
1373 pc->p++;
1374 pc->len--;
1376 pc->missing.ch = '{';
1377 pc->missing.line = pc->tline;
1378 pc->tend = pc->p - 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1389 * or JIM_TT_STR.
1391 static int JimParseSubQuote(struct JimParserCtx *pc)
1393 int tt = JIM_TT_STR;
1394 int line = pc->tline;
1396 /* Skip the quote */
1397 pc->p++;
1398 pc->len--;
1399 while (pc->len) {
1400 switch (*pc->p) {
1401 case '\\':
1402 if (pc->len > 1) {
1403 if (*++pc->p == '\n') {
1404 pc->linenr++;
1406 pc->len--;
1407 tt = JIM_TT_ESC;
1409 break;
1411 case '"':
1412 pc->tend = pc->p - 1;
1413 pc->p++;
1414 pc->len--;
1415 return tt;
1417 case '[':
1418 JimParseSubCmd(pc);
1419 tt = JIM_TT_ESC;
1420 continue;
1422 case '\n':
1423 pc->linenr++;
1424 break;
1426 case '$':
1427 tt = JIM_TT_ESC;
1428 break;
1430 pc->p++;
1431 pc->len--;
1433 pc->missing.ch = '"';
1434 pc->missing.line = line;
1435 pc->tend = pc->p - 1;
1436 return tt;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx *pc)
1447 int level = 1;
1448 int startofword = 1;
1449 int line = pc->tline;
1451 /* Skip the bracket */
1452 pc->p++;
1453 pc->len--;
1454 while (pc->len) {
1455 switch (*pc->p) {
1456 case '\\':
1457 if (pc->len > 1) {
1458 if (*++pc->p == '\n') {
1459 pc->linenr++;
1461 pc->len--;
1463 break;
1465 case '[':
1466 level++;
1467 break;
1469 case ']':
1470 if (--level == 0) {
1471 pc->tend = pc->p - 1;
1472 pc->p++;
1473 pc->len--;
1474 return;
1476 break;
1478 case '"':
1479 if (startofword) {
1480 JimParseSubQuote(pc);
1481 continue;
1483 break;
1485 case '{':
1486 JimParseSubBrace(pc);
1487 startofword = 0;
1488 continue;
1490 case '\n':
1491 pc->linenr++;
1492 break;
1494 startofword = isspace(UCHAR(*pc->p));
1495 pc->p++;
1496 pc->len--;
1498 pc->missing.ch = '[';
1499 pc->missing.line = line;
1500 pc->tend = pc->p - 1;
1503 static int JimParseBrace(struct JimParserCtx *pc)
1505 pc->tstart = pc->p + 1;
1506 pc->tline = pc->linenr;
1507 pc->tt = JIM_TT_STR;
1508 JimParseSubBrace(pc);
1509 return JIM_OK;
1512 static int JimParseCmd(struct JimParserCtx *pc)
1514 pc->tstart = pc->p + 1;
1515 pc->tline = pc->linenr;
1516 pc->tt = JIM_TT_CMD;
1517 JimParseSubCmd(pc);
1518 return JIM_OK;
1521 static int JimParseQuote(struct JimParserCtx *pc)
1523 pc->tstart = pc->p + 1;
1524 pc->tline = pc->linenr;
1525 pc->tt = JimParseSubQuote(pc);
1526 return JIM_OK;
1529 static int JimParseVar(struct JimParserCtx *pc)
1531 /* skip the $ */
1532 pc->p++;
1533 pc->len--;
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc->p == '[') {
1537 /* Parse $[...] expr shorthand syntax */
1538 JimParseCmd(pc);
1539 pc->tt = JIM_TT_EXPRSUGAR;
1540 return JIM_OK;
1542 #endif
1544 pc->tstart = pc->p;
1545 pc->tt = JIM_TT_VAR;
1546 pc->tline = pc->linenr;
1548 if (*pc->p == '{') {
1549 pc->tstart = ++pc->p;
1550 pc->len--;
1552 while (pc->len && *pc->p != '}') {
1553 if (*pc->p == '\n') {
1554 pc->linenr++;
1556 pc->p++;
1557 pc->len--;
1559 pc->tend = pc->p - 1;
1560 if (pc->len) {
1561 pc->p++;
1562 pc->len--;
1565 else {
1566 while (1) {
1567 /* Skip double colon, but not single colon! */
1568 if (pc->p[0] == ':' && pc->p[1] == ':') {
1569 while (*pc->p == ':') {
1570 pc->p++;
1571 pc->len--;
1573 continue;
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1579 pc->p++;
1580 pc->len--;
1581 continue;
1583 break;
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc->p == '(') {
1587 int count = 1;
1588 const char *paren = NULL;
1590 pc->tt = JIM_TT_DICTSUGAR;
1592 while (count && pc->len) {
1593 pc->p++;
1594 pc->len--;
1595 if (*pc->p == '\\' && pc->len >= 1) {
1596 pc->p++;
1597 pc->len--;
1599 else if (*pc->p == '(') {
1600 count++;
1602 else if (*pc->p == ')') {
1603 paren = pc->p;
1604 count--;
1607 if (count == 0) {
1608 pc->p++;
1609 pc->len--;
1611 else if (paren) {
1612 /* Did not find a matching paren. Back up */
1613 paren++;
1614 pc->len += (pc->p - paren);
1615 pc->p = paren;
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc->tstart == '(') {
1619 pc->tt = JIM_TT_EXPRSUGAR;
1621 #endif
1623 pc->tend = pc->p - 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1628 * a string. */
1629 if (pc->tstart == pc->p) {
1630 pc->p--;
1631 pc->len++;
1632 return JIM_ERR;
1634 return JIM_OK;
1637 static int JimParseStr(struct JimParserCtx *pc)
1639 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1640 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1641 /* Starting a new word */
1642 if (*pc->p == '{') {
1643 return JimParseBrace(pc);
1645 if (*pc->p == '"') {
1646 pc->state = JIM_PS_QUOTE;
1647 pc->p++;
1648 pc->len--;
1649 /* In case the end quote is missing */
1650 pc->missing.line = pc->tline;
1653 pc->tstart = pc->p;
1654 pc->tline = pc->linenr;
1655 while (1) {
1656 if (pc->len == 0) {
1657 if (pc->state == JIM_PS_QUOTE) {
1658 pc->missing.ch = '"';
1660 pc->tend = pc->p - 1;
1661 pc->tt = JIM_TT_ESC;
1662 return JIM_OK;
1664 switch (*pc->p) {
1665 case '\\':
1666 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1667 pc->tend = pc->p - 1;
1668 pc->tt = JIM_TT_ESC;
1669 return JIM_OK;
1671 if (pc->len >= 2) {
1672 if (*(pc->p + 1) == '\n') {
1673 pc->linenr++;
1675 pc->p++;
1676 pc->len--;
1678 else if (pc->len == 1) {
1679 /* End of script with trailing backslash */
1680 pc->missing.ch = '\\';
1682 break;
1683 case '(':
1684 /* If the following token is not '$' just keep going */
1685 if (pc->len > 1 && pc->p[1] != '$') {
1686 break;
1688 case ')':
1689 /* Only need a separate ')' token if the previous was a var */
1690 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1691 if (pc->p == pc->tstart) {
1692 /* At the start of the token, so just return this char */
1693 pc->p++;
1694 pc->len--;
1696 pc->tend = pc->p - 1;
1697 pc->tt = JIM_TT_ESC;
1698 return JIM_OK;
1700 break;
1702 case '$':
1703 case '[':
1704 pc->tend = pc->p - 1;
1705 pc->tt = JIM_TT_ESC;
1706 return JIM_OK;
1707 case ' ':
1708 case '\t':
1709 case '\n':
1710 case '\r':
1711 case '\f':
1712 case ';':
1713 if (pc->state == JIM_PS_DEF) {
1714 pc->tend = pc->p - 1;
1715 pc->tt = JIM_TT_ESC;
1716 return JIM_OK;
1718 else if (*pc->p == '\n') {
1719 pc->linenr++;
1721 break;
1722 case '"':
1723 if (pc->state == JIM_PS_QUOTE) {
1724 pc->tend = pc->p - 1;
1725 pc->tt = JIM_TT_ESC;
1726 pc->p++;
1727 pc->len--;
1728 pc->state = JIM_PS_DEF;
1729 return JIM_OK;
1731 break;
1733 pc->p++;
1734 pc->len--;
1736 return JIM_OK; /* unreached */
1739 static int JimParseComment(struct JimParserCtx *pc)
1741 while (*pc->p) {
1742 if (*pc->p == '\\') {
1743 pc->p++;
1744 pc->len--;
1745 if (pc->len == 0) {
1746 pc->missing.ch = '\\';
1747 return JIM_OK;
1749 if (*pc->p == '\n') {
1750 pc->linenr++;
1753 else if (*pc->p == '\n') {
1754 pc->p++;
1755 pc->len--;
1756 pc->linenr++;
1757 break;
1759 pc->p++;
1760 pc->len--;
1762 return JIM_OK;
1765 /* xdigitval and odigitval are helper functions for JimEscape() */
1766 static int xdigitval(int c)
1768 if (c >= '0' && c <= '9')
1769 return c - '0';
1770 if (c >= 'a' && c <= 'f')
1771 return c - 'a' + 10;
1772 if (c >= 'A' && c <= 'F')
1773 return c - 'A' + 10;
1774 return -1;
1777 static int odigitval(int c)
1779 if (c >= '0' && c <= '7')
1780 return c - '0';
1781 return -1;
1784 /* Perform Tcl escape substitution of 's', storing the result
1785 * string into 'dest'. The escaped string is guaranteed to
1786 * be the same length or shorted than the source string.
1787 * Slen is the length of the string at 's', if it's -1 the string
1788 * length will be calculated by the function.
1790 * The function returns the length of the resulting string. */
1791 static int JimEscape(char *dest, const char *s, int slen)
1793 char *p = dest;
1794 int i, len;
1796 if (slen == -1)
1797 slen = strlen(s);
1799 for (i = 0; i < slen; i++) {
1800 switch (s[i]) {
1801 case '\\':
1802 switch (s[i + 1]) {
1803 case 'a':
1804 *p++ = 0x7;
1805 i++;
1806 break;
1807 case 'b':
1808 *p++ = 0x8;
1809 i++;
1810 break;
1811 case 'f':
1812 *p++ = 0xc;
1813 i++;
1814 break;
1815 case 'n':
1816 *p++ = 0xa;
1817 i++;
1818 break;
1819 case 'r':
1820 *p++ = 0xd;
1821 i++;
1822 break;
1823 case 't':
1824 *p++ = 0x9;
1825 i++;
1826 break;
1827 case 'u':
1828 case 'U':
1829 case 'x':
1830 /* A unicode or hex sequence.
1831 * \x Expect 1-2 hex chars and convert to hex.
1832 * \u Expect 1-4 hex chars and convert to utf-8.
1833 * \U Expect 1-8 hex chars and convert to utf-8.
1834 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1835 * An invalid sequence means simply the escaped char.
1838 unsigned val = 0;
1839 int k;
1840 int maxchars = 2;
1842 i++;
1844 if (s[i] == 'U') {
1845 maxchars = 8;
1847 else if (s[i] == 'u') {
1848 if (s[i + 1] == '{') {
1849 maxchars = 6;
1850 i++;
1852 else {
1853 maxchars = 4;
1857 for (k = 0; k < maxchars; k++) {
1858 int c = xdigitval(s[i + k + 1]);
1859 if (c == -1) {
1860 break;
1862 val = (val << 4) | c;
1864 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1865 if (s[i] == '{') {
1866 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1867 /* Back up */
1868 i--;
1869 k = 0;
1871 else {
1872 /* Skip the closing brace */
1873 k++;
1876 if (k) {
1877 /* Got a valid sequence, so convert */
1878 if (s[i] == 'x') {
1879 *p++ = val;
1881 else {
1882 p += utf8_fromunicode(p, val);
1884 i += k;
1885 break;
1887 /* Not a valid codepoint, just an escaped char */
1888 *p++ = s[i];
1890 break;
1891 case 'v':
1892 *p++ = 0xb;
1893 i++;
1894 break;
1895 case '\0':
1896 *p++ = '\\';
1897 i++;
1898 break;
1899 case '\n':
1900 /* Replace all spaces and tabs after backslash newline with a single space*/
1901 *p++ = ' ';
1902 do {
1903 i++;
1904 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1905 break;
1906 case '0':
1907 case '1':
1908 case '2':
1909 case '3':
1910 case '4':
1911 case '5':
1912 case '6':
1913 case '7':
1914 /* octal escape */
1916 int val = 0;
1917 int c = odigitval(s[i + 1]);
1919 val = c;
1920 c = odigitval(s[i + 2]);
1921 if (c == -1) {
1922 *p++ = val;
1923 i++;
1924 break;
1926 val = (val * 8) + c;
1927 c = odigitval(s[i + 3]);
1928 if (c == -1) {
1929 *p++ = val;
1930 i += 2;
1931 break;
1933 val = (val * 8) + c;
1934 *p++ = val;
1935 i += 3;
1937 break;
1938 default:
1939 *p++ = s[i + 1];
1940 i++;
1941 break;
1943 break;
1944 default:
1945 *p++ = s[i];
1946 break;
1949 len = p - dest;
1950 *p = '\0';
1951 return len;
1954 /* Returns a dynamically allocated copy of the current token in the
1955 * parser context. The function performs conversion of escapes if
1956 * the token is of type JIM_TT_ESC.
1958 * Note that after the conversion, tokens that are grouped with
1959 * braces in the source code, are always recognizable from the
1960 * identical string obtained in a different way from the type.
1962 * For example the string:
1964 * {*}$a
1966 * will return as first token "*", of type JIM_TT_STR
1968 * While the string:
1970 * *$a
1972 * will return as first token "*", of type JIM_TT_ESC
1974 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1976 const char *start, *end;
1977 char *token;
1978 int len;
1980 start = pc->tstart;
1981 end = pc->tend;
1982 if (start > end) {
1983 len = 0;
1984 token = Jim_Alloc(1);
1985 token[0] = '\0';
1987 else {
1988 len = (end - start) + 1;
1989 token = Jim_Alloc(len + 1);
1990 if (pc->tt != JIM_TT_ESC) {
1991 /* No escape conversion needed? Just copy it. */
1992 memcpy(token, start, len);
1993 token[len] = '\0';
1995 else {
1996 /* Else convert the escape chars. */
1997 len = JimEscape(token, start, len);
2001 return Jim_NewStringObjNoAlloc(interp, token, len);
2004 /* Parses the given string to determine if it represents a complete script.
2006 * This is useful for interactive shells implementation, for [info complete].
2008 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2009 * '{' on scripts incomplete missing one or more '}' to be balanced.
2010 * '[' on scripts incomplete missing one or more ']' to be balanced.
2011 * '"' on scripts incomplete missing a '"' char.
2012 * '\\' on scripts with a trailing backslash.
2014 * If the script is complete, 1 is returned, otherwise 0.
2016 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2018 struct JimParserCtx parser;
2020 JimParserInit(&parser, s, len, 1);
2021 while (!parser.eof) {
2022 JimParseScript(&parser);
2024 if (stateCharPtr) {
2025 *stateCharPtr = parser.missing.ch;
2027 return parser.missing.ch == ' ';
2030 /* -----------------------------------------------------------------------------
2031 * Tcl Lists parsing
2032 * ---------------------------------------------------------------------------*/
2033 static int JimParseListSep(struct JimParserCtx *pc);
2034 static int JimParseListStr(struct JimParserCtx *pc);
2035 static int JimParseListQuote(struct JimParserCtx *pc);
2037 static int JimParseList(struct JimParserCtx *pc)
2039 if (isspace(UCHAR(*pc->p))) {
2040 return JimParseListSep(pc);
2042 switch (*pc->p) {
2043 case '"':
2044 return JimParseListQuote(pc);
2046 case '{':
2047 return JimParseBrace(pc);
2049 default:
2050 if (pc->len) {
2051 return JimParseListStr(pc);
2053 break;
2056 pc->tstart = pc->tend = pc->p;
2057 pc->tline = pc->linenr;
2058 pc->tt = JIM_TT_EOL;
2059 pc->eof = 1;
2060 return JIM_OK;
2063 static int JimParseListSep(struct JimParserCtx *pc)
2065 pc->tstart = pc->p;
2066 pc->tline = pc->linenr;
2067 while (isspace(UCHAR(*pc->p))) {
2068 if (*pc->p == '\n') {
2069 pc->linenr++;
2071 pc->p++;
2072 pc->len--;
2074 pc->tend = pc->p - 1;
2075 pc->tt = JIM_TT_SEP;
2076 return JIM_OK;
2079 static int JimParseListQuote(struct JimParserCtx *pc)
2081 pc->p++;
2082 pc->len--;
2084 pc->tstart = pc->p;
2085 pc->tline = pc->linenr;
2086 pc->tt = JIM_TT_STR;
2088 while (pc->len) {
2089 switch (*pc->p) {
2090 case '\\':
2091 pc->tt = JIM_TT_ESC;
2092 if (--pc->len == 0) {
2093 /* Trailing backslash */
2094 pc->tend = pc->p;
2095 return JIM_OK;
2097 pc->p++;
2098 break;
2099 case '\n':
2100 pc->linenr++;
2101 break;
2102 case '"':
2103 pc->tend = pc->p - 1;
2104 pc->p++;
2105 pc->len--;
2106 return JIM_OK;
2108 pc->p++;
2109 pc->len--;
2112 pc->tend = pc->p - 1;
2113 return JIM_OK;
2116 static int JimParseListStr(struct JimParserCtx *pc)
2118 pc->tstart = pc->p;
2119 pc->tline = pc->linenr;
2120 pc->tt = JIM_TT_STR;
2122 while (pc->len) {
2123 if (isspace(UCHAR(*pc->p))) {
2124 pc->tend = pc->p - 1;
2125 return JIM_OK;
2127 if (*pc->p == '\\') {
2128 if (--pc->len == 0) {
2129 /* Trailing backslash */
2130 pc->tend = pc->p;
2131 return JIM_OK;
2133 pc->tt = JIM_TT_ESC;
2134 pc->p++;
2136 pc->p++;
2137 pc->len--;
2139 pc->tend = pc->p - 1;
2140 return JIM_OK;
2143 /* -----------------------------------------------------------------------------
2144 * Jim_Obj related functions
2145 * ---------------------------------------------------------------------------*/
2147 /* Return a new initialized object. */
2148 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2150 Jim_Obj *objPtr;
2152 /* -- Check if there are objects in the free list -- */
2153 if (interp->freeList != NULL) {
2154 /* -- Unlink the object from the free list -- */
2155 objPtr = interp->freeList;
2156 interp->freeList = objPtr->nextObjPtr;
2158 else {
2159 /* -- No ready to use objects: allocate a new one -- */
2160 objPtr = Jim_Alloc(sizeof(*objPtr));
2163 /* Object is returned with refCount of 0. Every
2164 * kind of GC implemented should take care to don't try
2165 * to scan objects with refCount == 0. */
2166 objPtr->refCount = 0;
2167 /* All the other fields are left not initialized to save time.
2168 * The caller will probably want to set them to the right
2169 * value anyway. */
2171 /* -- Put the object into the live list -- */
2172 objPtr->prevObjPtr = NULL;
2173 objPtr->nextObjPtr = interp->liveList;
2174 if (interp->liveList)
2175 interp->liveList->prevObjPtr = objPtr;
2176 interp->liveList = objPtr;
2178 return objPtr;
2181 /* Free an object. Actually objects are never freed, but
2182 * just moved to the free objects list, where they will be
2183 * reused by Jim_NewObj(). */
2184 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2186 /* Check if the object was already freed, panic. */
2187 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2188 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2190 /* Free the internal representation */
2191 Jim_FreeIntRep(interp, objPtr);
2192 /* Free the string representation */
2193 if (objPtr->bytes != NULL) {
2194 if (objPtr->bytes != JimEmptyStringRep)
2195 Jim_Free(objPtr->bytes);
2197 /* Unlink the object from the live objects list */
2198 if (objPtr->prevObjPtr)
2199 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2200 if (objPtr->nextObjPtr)
2201 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2202 if (interp->liveList == objPtr)
2203 interp->liveList = objPtr->nextObjPtr;
2204 #ifdef JIM_DISABLE_OBJECT_POOL
2205 Jim_Free(objPtr);
2206 #else
2207 /* Link the object into the free objects list */
2208 objPtr->prevObjPtr = NULL;
2209 objPtr->nextObjPtr = interp->freeList;
2210 if (interp->freeList)
2211 interp->freeList->prevObjPtr = objPtr;
2212 interp->freeList = objPtr;
2213 objPtr->refCount = -1;
2214 #endif
2217 /* Invalidate the string representation of an object. */
2218 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2220 if (objPtr->bytes != NULL) {
2221 if (objPtr->bytes != JimEmptyStringRep)
2222 Jim_Free(objPtr->bytes);
2224 objPtr->bytes = NULL;
2227 /* Duplicate an object. The returned object has refcount = 0. */
2228 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2230 Jim_Obj *dupPtr;
2232 dupPtr = Jim_NewObj(interp);
2233 if (objPtr->bytes == NULL) {
2234 /* Object does not have a valid string representation. */
2235 dupPtr->bytes = NULL;
2237 else if (objPtr->length == 0) {
2238 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2239 dupPtr->bytes = JimEmptyStringRep;
2240 dupPtr->length = 0;
2241 dupPtr->typePtr = NULL;
2242 return dupPtr;
2244 else {
2245 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2246 dupPtr->length = objPtr->length;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr->typePtr = objPtr->typePtr;
2253 if (objPtr->typePtr != NULL) {
2254 if (objPtr->typePtr->dupIntRepProc == NULL) {
2255 dupPtr->internalRep = objPtr->internalRep;
2257 else {
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2262 return dupPtr;
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2271 if (objPtr->bytes == NULL) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2274 objPtr->typePtr->updateStringProc(objPtr);
2276 if (lenPtr)
2277 *lenPtr = objPtr->length;
2278 return objPtr->bytes;
2281 /* Just returns the length of the object's string rep */
2282 int Jim_Length(Jim_Obj *objPtr)
2284 if (objPtr->bytes == NULL) {
2285 /* Invalid string repr. Generate it. */
2286 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2287 objPtr->typePtr->updateStringProc(objPtr);
2289 return objPtr->length;
2292 /* Just returns the length of the object's string rep */
2293 const char *Jim_String(Jim_Obj *objPtr)
2295 if (objPtr->bytes == NULL) {
2296 /* Invalid string repr. Generate it. */
2297 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2298 objPtr->typePtr->updateStringProc(objPtr);
2300 return objPtr->bytes;
2303 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2305 objPtr->bytes = Jim_StrDup(str);
2306 objPtr->length = strlen(str);
2309 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2310 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2312 static const Jim_ObjType dictSubstObjType = {
2313 "dict-substitution",
2314 FreeDictSubstInternalRep,
2315 DupDictSubstInternalRep,
2316 NULL,
2317 JIM_TYPE_NONE,
2320 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2322 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2325 static const Jim_ObjType interpolatedObjType = {
2326 "interpolated",
2327 FreeInterpolatedInternalRep,
2328 NULL,
2329 NULL,
2330 JIM_TYPE_NONE,
2333 /* -----------------------------------------------------------------------------
2334 * String Object
2335 * ---------------------------------------------------------------------------*/
2336 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2337 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2339 static const Jim_ObjType stringObjType = {
2340 "string",
2341 NULL,
2342 DupStringInternalRep,
2343 NULL,
2344 JIM_TYPE_REFERENCES,
2347 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2349 JIM_NOTUSED(interp);
2351 /* This is a bit subtle: the only caller of this function
2352 * should be Jim_DuplicateObj(), that will copy the
2353 * string representaion. After the copy, the duplicated
2354 * object will not have more room in the buffer than
2355 * srcPtr->length bytes. So we just set it to length. */
2356 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2357 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2360 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2362 if (objPtr->typePtr != &stringObjType) {
2363 /* Get a fresh string representation. */
2364 if (objPtr->bytes == NULL) {
2365 /* Invalid string repr. Generate it. */
2366 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2367 objPtr->typePtr->updateStringProc(objPtr);
2369 /* Free any other internal representation. */
2370 Jim_FreeIntRep(interp, objPtr);
2371 /* Set it as string, i.e. just set the maxLength field. */
2372 objPtr->typePtr = &stringObjType;
2373 objPtr->internalRep.strValue.maxLength = objPtr->length;
2374 /* Don't know the utf-8 length yet */
2375 objPtr->internalRep.strValue.charLength = -1;
2377 return JIM_OK;
2381 * Returns the length of the object string in chars, not bytes.
2383 * These may be different for a utf-8 string.
2385 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2387 #ifdef JIM_UTF8
2388 SetStringFromAny(interp, objPtr);
2390 if (objPtr->internalRep.strValue.charLength < 0) {
2391 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2393 return objPtr->internalRep.strValue.charLength;
2394 #else
2395 return Jim_Length(objPtr);
2396 #endif
2399 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2400 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2402 Jim_Obj *objPtr = Jim_NewObj(interp);
2404 /* Need to find out how many bytes the string requires */
2405 if (len == -1)
2406 len = strlen(s);
2407 /* Alloc/Set the string rep. */
2408 if (len == 0) {
2409 objPtr->bytes = JimEmptyStringRep;
2411 else {
2412 objPtr->bytes = Jim_Alloc(len + 1);
2413 memcpy(objPtr->bytes, s, len);
2414 objPtr->bytes[len] = '\0';
2416 objPtr->length = len;
2418 /* No typePtr field for the vanilla string object. */
2419 objPtr->typePtr = NULL;
2420 return objPtr;
2423 /* charlen is in characters -- see also Jim_NewStringObj() */
2424 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2426 #ifdef JIM_UTF8
2427 /* Need to find out how many bytes the string requires */
2428 int bytelen = utf8_index(s, charlen);
2430 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2432 /* Remember the utf8 length, so set the type */
2433 objPtr->typePtr = &stringObjType;
2434 objPtr->internalRep.strValue.maxLength = bytelen;
2435 objPtr->internalRep.strValue.charLength = charlen;
2437 return objPtr;
2438 #else
2439 return Jim_NewStringObj(interp, s, charlen);
2440 #endif
2443 /* This version does not try to duplicate the 's' pointer, but
2444 * use it directly. */
2445 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2447 Jim_Obj *objPtr = Jim_NewObj(interp);
2449 objPtr->bytes = s;
2450 objPtr->length = (len == -1) ? strlen(s) : len;
2451 objPtr->typePtr = NULL;
2452 return objPtr;
2455 /* Low-level string append. Use it only against unshared objects
2456 * of type "string". */
2457 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2459 int needlen;
2461 if (len == -1)
2462 len = strlen(str);
2463 needlen = objPtr->length + len;
2464 if (objPtr->internalRep.strValue.maxLength < needlen ||
2465 objPtr->internalRep.strValue.maxLength == 0) {
2466 needlen *= 2;
2467 /* Inefficient to malloc() for less than 8 bytes */
2468 if (needlen < 7) {
2469 needlen = 7;
2471 if (objPtr->bytes == JimEmptyStringRep) {
2472 objPtr->bytes = Jim_Alloc(needlen + 1);
2474 else {
2475 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2477 objPtr->internalRep.strValue.maxLength = needlen;
2479 memcpy(objPtr->bytes + objPtr->length, str, len);
2480 objPtr->bytes[objPtr->length + len] = '\0';
2482 if (objPtr->internalRep.strValue.charLength >= 0) {
2483 /* Update the utf-8 char length */
2484 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2486 objPtr->length += len;
2489 /* Higher level API to append strings to objects.
2490 * Object must not be unshared for each of these.
2492 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2494 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2495 SetStringFromAny(interp, objPtr);
2496 StringAppendString(objPtr, str, len);
2499 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2501 int len;
2502 const char *str = Jim_GetString(appendObjPtr, &len);
2503 Jim_AppendString(interp, objPtr, str, len);
2506 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2508 va_list ap;
2510 SetStringFromAny(interp, objPtr);
2511 va_start(ap, objPtr);
2512 while (1) {
2513 const char *s = va_arg(ap, const char *);
2515 if (s == NULL)
2516 break;
2517 Jim_AppendString(interp, objPtr, s, -1);
2519 va_end(ap);
2522 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2524 if (aObjPtr == bObjPtr) {
2525 return 1;
2527 else {
2528 int Alen, Blen;
2529 const char *sA = Jim_GetString(aObjPtr, &Alen);
2530 const char *sB = Jim_GetString(bObjPtr, &Blen);
2532 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2537 * Note. Does not support embedded nulls in either the pattern or the object.
2539 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2541 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2545 * Note: does not support embedded nulls for the nocase option.
2547 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2549 int l1, l2;
2550 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2551 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2553 if (nocase) {
2554 /* Do a character compare for nocase */
2555 return JimStringCompareLen(s1, s2, -1, nocase);
2557 return JimStringCompare(s1, l1, s2, l2);
2561 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2563 * Note: does not support embedded nulls
2565 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2567 const char *s1 = Jim_String(firstObjPtr);
2568 const char *s2 = Jim_String(secondObjPtr);
2570 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2573 /* Convert a range, as returned by Jim_GetRange(), into
2574 * an absolute index into an object of the specified length.
2575 * This function may return negative values, or values
2576 * greater than or equal to the length of the list if the index
2577 * is out of range. */
2578 static int JimRelToAbsIndex(int len, int idx)
2580 if (idx < 0)
2581 return len + idx;
2582 return idx;
2585 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2586 * into a form suitable for implementation of commands like [string range] and [lrange].
2588 * The resulting range is guaranteed to address valid elements of
2589 * the structure.
2591 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2593 int rangeLen;
2595 if (*firstPtr > *lastPtr) {
2596 rangeLen = 0;
2598 else {
2599 rangeLen = *lastPtr - *firstPtr + 1;
2600 if (rangeLen) {
2601 if (*firstPtr < 0) {
2602 rangeLen += *firstPtr;
2603 *firstPtr = 0;
2605 if (*lastPtr >= len) {
2606 rangeLen -= (*lastPtr - (len - 1));
2607 *lastPtr = len - 1;
2611 if (rangeLen < 0)
2612 rangeLen = 0;
2614 *rangeLenPtr = rangeLen;
2617 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2618 int len, int *first, int *last, int *range)
2620 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2621 return JIM_ERR;
2623 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2624 return JIM_ERR;
2626 *first = JimRelToAbsIndex(len, *first);
2627 *last = JimRelToAbsIndex(len, *last);
2628 JimRelToAbsRange(len, first, last, range);
2629 return JIM_OK;
2632 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2633 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2635 int first, last;
2636 const char *str;
2637 int rangeLen;
2638 int bytelen;
2640 str = Jim_GetString(strObjPtr, &bytelen);
2642 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2643 return NULL;
2646 if (first == 0 && rangeLen == bytelen) {
2647 return strObjPtr;
2649 return Jim_NewStringObj(interp, str + first, rangeLen);
2652 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2653 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2655 #ifdef JIM_UTF8
2656 int first, last;
2657 const char *str;
2658 int len, rangeLen;
2659 int bytelen;
2661 str = Jim_GetString(strObjPtr, &bytelen);
2662 len = Jim_Utf8Length(interp, strObjPtr);
2664 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2665 return NULL;
2668 if (first == 0 && rangeLen == len) {
2669 return strObjPtr;
2671 if (len == bytelen) {
2672 /* ASCII optimisation */
2673 return Jim_NewStringObj(interp, str + first, rangeLen);
2675 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2676 #else
2677 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2678 #endif
2681 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2682 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2684 int first, last;
2685 const char *str;
2686 int len, rangeLen;
2687 Jim_Obj *objPtr;
2689 len = Jim_Utf8Length(interp, strObjPtr);
2691 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2692 return NULL;
2695 if (last < first) {
2696 return strObjPtr;
2699 str = Jim_String(strObjPtr);
2701 /* Before part */
2702 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2704 /* Replacement */
2705 if (newStrObj) {
2706 Jim_AppendObj(interp, objPtr, newStrObj);
2709 /* After part */
2710 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2712 return objPtr;
2716 * Note: does not support embedded nulls.
2718 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2720 while (*str) {
2721 int c;
2722 str += utf8_tounicode(str, &c);
2723 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2725 *dest = 0;
2729 * Note: does not support embedded nulls.
2731 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2733 char *buf;
2734 int len;
2735 const char *str;
2737 SetStringFromAny(interp, strObjPtr);
2739 str = Jim_GetString(strObjPtr, &len);
2741 #ifdef JIM_UTF8
2742 /* Case mapping can change the utf-8 length of the string.
2743 * But at worst it will be by one extra byte per char
2745 len *= 2;
2746 #endif
2747 buf = Jim_Alloc(len + 1);
2748 JimStrCopyUpperLower(buf, str, 0);
2749 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2753 * Note: does not support embedded nulls.
2755 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2757 char *buf;
2758 const char *str;
2759 int len;
2761 if (strObjPtr->typePtr != &stringObjType) {
2762 SetStringFromAny(interp, strObjPtr);
2765 str = Jim_GetString(strObjPtr, &len);
2767 #ifdef JIM_UTF8
2768 /* Case mapping can change the utf-8 length of the string.
2769 * But at worst it will be by one extra byte per char
2771 len *= 2;
2772 #endif
2773 buf = Jim_Alloc(len + 1);
2774 JimStrCopyUpperLower(buf, str, 1);
2775 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2779 * Note: does not support embedded nulls.
2781 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2783 char *buf, *p;
2784 int len;
2785 int c;
2786 const char *str;
2788 str = Jim_GetString(strObjPtr, &len);
2789 if (len == 0) {
2790 return strObjPtr;
2792 #ifdef JIM_UTF8
2793 /* Case mapping can change the utf-8 length of the string.
2794 * But at worst it will be by one extra byte per char
2796 len *= 2;
2797 #endif
2798 buf = p = Jim_Alloc(len + 1);
2800 str += utf8_tounicode(str, &c);
2801 p += utf8_getchars(p, utf8_title(c));
2803 JimStrCopyUpperLower(p, str, 0);
2805 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2808 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2809 * for unicode character 'c'.
2810 * Returns the position if found or NULL if not
2812 static const char *utf8_memchr(const char *str, int len, int c)
2814 #ifdef JIM_UTF8
2815 while (len) {
2816 int sc;
2817 int n = utf8_tounicode(str, &sc);
2818 if (sc == c) {
2819 return str;
2821 str += n;
2822 len -= n;
2824 return NULL;
2825 #else
2826 return memchr(str, c, len);
2827 #endif
2831 * Searches for the first non-trim char in string (str, len)
2833 * If none is found, returns just past the last char.
2835 * Lengths are in bytes.
2837 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2839 while (len) {
2840 int c;
2841 int n = utf8_tounicode(str, &c);
2843 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2844 /* Not a trim char, so stop */
2845 break;
2847 str += n;
2848 len -= n;
2850 return str;
2854 * Searches backwards for a non-trim char in string (str, len).
2856 * Returns a pointer to just after the non-trim char, or NULL if not found.
2858 * Lengths are in bytes.
2860 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2862 str += len;
2864 while (len) {
2865 int c;
2866 int n = utf8_prev_len(str, len);
2868 len -= n;
2869 str -= n;
2871 n = utf8_tounicode(str, &c);
2873 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2874 return str + n;
2878 return NULL;
2881 static const char default_trim_chars[] = " \t\n\r";
2882 /* sizeof() here includes the null byte */
2883 static int default_trim_chars_len = sizeof(default_trim_chars);
2885 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2887 int len;
2888 const char *str = Jim_GetString(strObjPtr, &len);
2889 const char *trimchars = default_trim_chars;
2890 int trimcharslen = default_trim_chars_len;
2891 const char *newstr;
2893 if (trimcharsObjPtr) {
2894 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2897 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2898 if (newstr == str) {
2899 return strObjPtr;
2902 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2905 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2907 int len;
2908 const char *trimchars = default_trim_chars;
2909 int trimcharslen = default_trim_chars_len;
2910 const char *nontrim;
2912 if (trimcharsObjPtr) {
2913 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2916 SetStringFromAny(interp, strObjPtr);
2918 len = Jim_Length(strObjPtr);
2919 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2921 if (nontrim == NULL) {
2922 /* All trim, so return a zero-length string */
2923 return Jim_NewEmptyStringObj(interp);
2925 if (nontrim == strObjPtr->bytes + len) {
2926 /* All non-trim, so return the original object */
2927 return strObjPtr;
2930 if (Jim_IsShared(strObjPtr)) {
2931 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2933 else {
2934 /* Can modify this string in place */
2935 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2936 strObjPtr->length = (nontrim - strObjPtr->bytes);
2939 return strObjPtr;
2942 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2944 /* First trim left. */
2945 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2947 /* Now trim right */
2948 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2950 /* Note: refCount check is needed since objPtr may be emptyObj */
2951 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2952 /* We don't want this object to be leaked */
2953 Jim_FreeNewObj(interp, objPtr);
2956 return strObjPtr;
2959 /* Some platforms don't have isascii - need a non-macro version */
2960 #ifdef HAVE_ISASCII
2961 #define jim_isascii isascii
2962 #else
2963 static int jim_isascii(int c)
2965 return !(c & ~0x7f);
2967 #endif
2969 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2971 static const char * const strclassnames[] = {
2972 "integer", "alpha", "alnum", "ascii", "digit",
2973 "double", "lower", "upper", "space", "xdigit",
2974 "control", "print", "graph", "punct",
2975 NULL
2977 enum {
2978 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2979 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2980 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2982 int strclass;
2983 int len;
2984 int i;
2985 const char *str;
2986 int (*isclassfunc)(int c) = NULL;
2988 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2989 return JIM_ERR;
2992 str = Jim_GetString(strObjPtr, &len);
2993 if (len == 0) {
2994 Jim_SetResultBool(interp, !strict);
2995 return JIM_OK;
2998 switch (strclass) {
2999 case STR_IS_INTEGER:
3001 jim_wide w;
3002 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3003 return JIM_OK;
3006 case STR_IS_DOUBLE:
3008 double d;
3009 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3010 return JIM_OK;
3013 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3014 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3015 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3016 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3017 case STR_IS_LOWER: isclassfunc = islower; break;
3018 case STR_IS_UPPER: isclassfunc = isupper; break;
3019 case STR_IS_SPACE: isclassfunc = isspace; break;
3020 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3021 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3022 case STR_IS_PRINT: isclassfunc = isprint; break;
3023 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3024 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3025 default:
3026 return JIM_ERR;
3029 for (i = 0; i < len; i++) {
3030 if (!isclassfunc(str[i])) {
3031 Jim_SetResultBool(interp, 0);
3032 return JIM_OK;
3035 Jim_SetResultBool(interp, 1);
3036 return JIM_OK;
3039 /* -----------------------------------------------------------------------------
3040 * Compared String Object
3041 * ---------------------------------------------------------------------------*/
3043 /* This is strange object that allows comparison of a C literal string
3044 * with a Jim object in a very short time if the same comparison is done
3045 * multiple times. For example every time the [if] command is executed,
3046 * Jim has to check if a given argument is "else".
3047 * If the code has no errors, this comparison is true most of the time,
3048 * so we can cache the pointer of the string of the last matching
3049 * comparison inside the object. Because most C compilers perform literal sharing,
3050 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3051 * this works pretty well even if comparisons are at different places
3052 * inside the C code. */
3054 static const Jim_ObjType comparedStringObjType = {
3055 "compared-string",
3056 NULL,
3057 NULL,
3058 NULL,
3059 JIM_TYPE_REFERENCES,
3062 /* The only way this object is exposed to the API is via the following
3063 * function. Returns true if the string and the object string repr.
3064 * are the same, otherwise zero is returned.
3066 * Note: this isn't binary safe, but it hardly needs to be.*/
3067 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3069 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3070 return 1;
3072 else {
3073 const char *objStr = Jim_String(objPtr);
3075 if (strcmp(str, objStr) != 0)
3076 return 0;
3078 if (objPtr->typePtr != &comparedStringObjType) {
3079 Jim_FreeIntRep(interp, objPtr);
3080 objPtr->typePtr = &comparedStringObjType;
3082 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3083 return 1;
3087 static int qsortCompareStringPointers(const void *a, const void *b)
3089 char *const *sa = (char *const *)a;
3090 char *const *sb = (char *const *)b;
3092 return strcmp(*sa, *sb);
3096 /* -----------------------------------------------------------------------------
3097 * Source Object
3099 * This object is just a string from the language point of view, but
3100 * the internal representation contains the filename and line number
3101 * where this token was read. This information is used by
3102 * Jim_EvalObj() if the object passed happens to be of type "source".
3104 * This allows propagation of the information about line numbers and file
3105 * names and gives error messages with absolute line numbers.
3107 * Note that this object uses the internal representation of the Jim_Object,
3108 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3110 * Also the object will be converted to something else if the given
3111 * token it represents in the source file is not something to be
3112 * evaluated (not a script), and will be specialized in some other way,
3113 * so the time overhead is also almost zero.
3114 * ---------------------------------------------------------------------------*/
3116 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3117 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3119 static const Jim_ObjType sourceObjType = {
3120 "source",
3121 FreeSourceInternalRep,
3122 DupSourceInternalRep,
3123 NULL,
3124 JIM_TYPE_REFERENCES,
3127 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3129 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3132 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3134 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3135 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3138 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3139 Jim_Obj *fileNameObj, int lineNumber)
3141 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3142 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3143 Jim_IncrRefCount(fileNameObj);
3144 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3145 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3146 objPtr->typePtr = &sourceObjType;
3149 /* -----------------------------------------------------------------------------
3150 * ScriptLine Object
3152 * This object is used only in the Script internal represenation.
3153 * For each line of the script, it holds the number of tokens on the line
3154 * and the source line number.
3156 static const Jim_ObjType scriptLineObjType = {
3157 "scriptline",
3158 NULL,
3159 NULL,
3160 NULL,
3161 JIM_NONE,
3164 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3166 Jim_Obj *objPtr;
3168 #ifdef DEBUG_SHOW_SCRIPT
3169 char buf[100];
3170 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3171 objPtr = Jim_NewStringObj(interp, buf, -1);
3172 #else
3173 objPtr = Jim_NewEmptyStringObj(interp);
3174 #endif
3175 objPtr->typePtr = &scriptLineObjType;
3176 objPtr->internalRep.scriptLineValue.argc = argc;
3177 objPtr->internalRep.scriptLineValue.line = line;
3179 return objPtr;
3182 /* -----------------------------------------------------------------------------
3183 * Script Object
3185 * This object holds the parsed internal representation of a script.
3186 * This representation is help within an allocated ScriptObj (see below)
3188 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3189 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3190 static int JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3191 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3193 static const Jim_ObjType scriptObjType = {
3194 "script",
3195 FreeScriptInternalRep,
3196 DupScriptInternalRep,
3197 NULL,
3198 JIM_TYPE_REFERENCES,
3201 /* Each token of a script is represented by a ScriptToken.
3202 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3203 * can be specialized by commands operating on it.
3205 typedef struct ScriptToken
3207 Jim_Obj *objPtr;
3208 int type;
3209 } ScriptToken;
3211 /* This is the script object internal representation. An array of
3212 * ScriptToken structures, including a pre-computed representation of the
3213 * command length and arguments.
3215 * For example the script:
3217 * puts hello
3218 * set $i $x$y [foo]BAR
3220 * will produce a ScriptObj with the following ScriptToken's:
3222 * LIN 2
3223 * ESC puts
3224 * ESC hello
3225 * LIN 4
3226 * ESC set
3227 * VAR i
3228 * WRD 2
3229 * VAR x
3230 * VAR y
3231 * WRD 2
3232 * CMD foo
3233 * ESC BAR
3235 * "puts hello" has two args (LIN 2), composed of single tokens.
3236 * (Note that the WRD token is omitted for the common case of a single token.)
3238 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3239 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3241 * The precomputation of the command structure makes Jim_Eval() faster,
3242 * and simpler because there aren't dynamic lengths / allocations.
3244 * -- {expand}/{*} handling --
3246 * Expand is handled in a special way.
3248 * If a "word" begins with {*}, the word token count is -ve.
3250 * For example the command:
3252 * list {*}{a b}
3254 * Will produce the following cmdstruct array:
3256 * LIN 2
3257 * ESC list
3258 * WRD -1
3259 * STR a b
3261 * Note that the 'LIN' token also contains the source information for the
3262 * first word of the line for error reporting purposes
3264 * -- the substFlags field of the structure --
3266 * The scriptObj structure is used to represent both "script" objects
3267 * and "subst" objects. In the second case, the there are no LIN and WRD
3268 * tokens. Instead SEP and EOL tokens are added as-is.
3269 * In addition, the field 'substFlags' is used to represent the flags used to turn
3270 * the string into the internal representation.
3271 * If these flags do not match what the application requires,
3272 * the scriptObj is created again. For example the script:
3274 * subst -nocommands $string
3275 * subst -novariables $string
3277 * Will (re)create the internal representation of the $string object
3278 * two times.
3280 typedef struct ScriptObj
3282 ScriptToken *token; /* Tokens array. */
3283 Jim_Obj *fileNameObj; /* Filename */
3284 int len; /* Length of token[] */
3285 int substFlags; /* flags used for the compilation of "subst" objects */
3286 int inUse; /* Used to share a ScriptObj. Currently
3287 only used by Jim_EvalObj() as protection against
3288 shimmering of the currently evaluated object. */
3289 int firstline; /* Line number of the first line */
3290 int linenr; /* Line number of the current line */
3291 } ScriptObj;
3293 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3295 int i;
3296 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3298 if (--script->inUse != 0)
3299 return;
3300 for (i = 0; i < script->len; i++) {
3301 Jim_DecrRefCount(interp, script->token[i].objPtr);
3303 Jim_Free(script->token);
3304 Jim_DecrRefCount(interp, script->fileNameObj);
3305 Jim_Free(script);
3308 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3310 JIM_NOTUSED(interp);
3311 JIM_NOTUSED(srcPtr);
3313 /* Just return a simple string. We don't try to preserve the source info
3314 * since in practice scripts are never duplicated
3316 dupPtr->typePtr = NULL;
3319 /* A simple parse token.
3320 * As the script is parsed, the created tokens point into the script string rep.
3322 typedef struct
3324 const char *token; /* Pointer to the start of the token */
3325 int len; /* Length of this token */
3326 int type; /* Token type */
3327 int line; /* Line number */
3328 } ParseToken;
3330 /* A list of parsed tokens representing a script.
3331 * Tokens are added to this list as the script is parsed.
3332 * It grows as needed.
3334 typedef struct
3336 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3337 ParseToken *list; /* Array of tokens */
3338 int size; /* Current size of the list */
3339 int count; /* Number of entries used */
3340 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3341 } ParseTokenList;
3343 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3345 tokenlist->list = tokenlist->static_list;
3346 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3347 tokenlist->count = 0;
3350 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3352 if (tokenlist->list != tokenlist->static_list) {
3353 Jim_Free(tokenlist->list);
3358 * Adds the new token to the tokenlist.
3359 * The token has the given length, type and line number.
3360 * The token list is resized as necessary.
3362 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3363 int line)
3365 ParseToken *t;
3367 if (tokenlist->count == tokenlist->size) {
3368 /* Resize the list */
3369 tokenlist->size *= 2;
3370 if (tokenlist->list != tokenlist->static_list) {
3371 tokenlist->list =
3372 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3374 else {
3375 /* The list needs to become allocated */
3376 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3377 memcpy(tokenlist->list, tokenlist->static_list,
3378 tokenlist->count * sizeof(*tokenlist->list));
3381 t = &tokenlist->list[tokenlist->count++];
3382 t->token = token;
3383 t->len = len;
3384 t->type = type;
3385 t->line = line;
3388 /* Counts the number of adjoining non-separator tokens.
3390 * Returns -ve if the first token is the expansion
3391 * operator (in which case the count doesn't include
3392 * that token).
3394 static int JimCountWordTokens(ParseToken *t)
3396 int expand = 1;
3397 int count = 0;
3399 /* Is the first word {*} or {expand}? */
3400 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3401 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3402 /* Create an expand token */
3403 expand = -1;
3404 t++;
3408 /* Now count non-separator words */
3409 while (!TOKEN_IS_SEP(t->type)) {
3410 t++;
3411 count++;
3414 return count * expand;
3418 * Create a script/subst object from the given token.
3420 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3422 Jim_Obj *objPtr;
3424 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3425 /* Convert backlash escapes. The result will never be longer than the original */
3426 int len = t->len;
3427 char *str = Jim_Alloc(len + 1);
3428 len = JimEscape(str, t->token, len);
3429 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3431 else {
3432 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3433 * with a single space.
3435 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3437 return objPtr;
3441 * Takes a tokenlist and creates the allocated list of script tokens
3442 * in script->token, of length script->len.
3444 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3445 * as required.
3447 * Also sets script->line to the line number of the first token
3449 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3450 ParseTokenList *tokenlist)
3452 int i;
3453 struct ScriptToken *token;
3454 /* Number of tokens so far for the current command */
3455 int lineargs = 0;
3456 /* This is the first token for the current command */
3457 ScriptToken *linefirst;
3458 int count;
3459 int linenr;
3461 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3462 printf("==== Tokens ====\n");
3463 for (i = 0; i < tokenlist->count; i++) {
3464 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3465 tokenlist->list[i].len, tokenlist->list[i].token);
3467 #endif
3469 /* May need up to one extra script token for each EOL in the worst case */
3470 count = tokenlist->count;
3471 for (i = 0; i < tokenlist->count; i++) {
3472 if (tokenlist->list[i].type == JIM_TT_EOL) {
3473 count++;
3476 linenr = script->firstline = tokenlist->list[0].line;
3478 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3480 /* This is the first token for the current command */
3481 linefirst = token++;
3483 for (i = 0; i < tokenlist->count; ) {
3484 /* Look ahead to find out how many tokens make up the next word */
3485 int wordtokens;
3487 /* Skip any leading separators */
3488 while (tokenlist->list[i].type == JIM_TT_SEP) {
3489 i++;
3492 wordtokens = JimCountWordTokens(tokenlist->list + i);
3494 if (wordtokens == 0) {
3495 /* None, so at end of line */
3496 if (lineargs) {
3497 linefirst->type = JIM_TT_LINE;
3498 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3499 Jim_IncrRefCount(linefirst->objPtr);
3501 /* Reset for new line */
3502 lineargs = 0;
3503 linefirst = token++;
3505 i++;
3506 continue;
3508 else if (wordtokens != 1) {
3509 /* More than 1, or {*}, so insert a WORD token */
3510 token->type = JIM_TT_WORD;
3511 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3512 Jim_IncrRefCount(token->objPtr);
3513 token++;
3514 if (wordtokens < 0) {
3515 /* Skip the expand token */
3516 i++;
3517 wordtokens = -wordtokens - 1;
3518 lineargs--;
3522 if (lineargs == 0) {
3523 /* First real token on the line, so record the line number */
3524 linenr = tokenlist->list[i].line;
3526 lineargs++;
3528 /* Add each non-separator word token to the line */
3529 while (wordtokens--) {
3530 const ParseToken *t = &tokenlist->list[i++];
3532 token->type = t->type;
3533 token->objPtr = JimMakeScriptObj(interp, t);
3534 Jim_IncrRefCount(token->objPtr);
3536 /* Every object is initially a string of type 'source', but the
3537 * internal type may be specialized during execution of the
3538 * script. */
3539 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3540 token++;
3544 if (lineargs == 0) {
3545 token--;
3548 script->len = token - script->token;
3550 JimPanic((script->len >= count, "allocated script array is too short"));
3552 #ifdef DEBUG_SHOW_SCRIPT
3553 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3554 for (i = 0; i < script->len; i++) {
3555 const ScriptToken *t = &script->token[i];
3556 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3558 #endif
3563 * Sets an appropriate error message for a missing script/expression terminator.
3565 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3567 * Note that a trailing backslash is not considered to be an error.
3569 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3571 const char *msg;
3573 switch (ch) {
3574 case '\\':
3575 case ' ':
3576 return JIM_OK;
3578 case '[':
3579 msg = "unmatched \"[\"";
3580 break;
3581 case '{':
3582 msg = "missing close-brace";
3583 break;
3584 case '"':
3585 default:
3586 msg = "missing quote";
3587 break;
3590 Jim_SetResultString(interp, msg, -1);
3591 return JIM_ERR;
3595 * Similar to ScriptObjAddTokens(), but for subst objects.
3597 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3598 ParseTokenList *tokenlist)
3600 int i;
3601 struct ScriptToken *token;
3603 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3605 for (i = 0; i < tokenlist->count; i++) {
3606 const ParseToken *t = &tokenlist->list[i];
3608 /* Create a token for 't' */
3609 token->type = t->type;
3610 token->objPtr = JimMakeScriptObj(interp, t);
3611 Jim_IncrRefCount(token->objPtr);
3612 token++;
3615 script->len = i;
3618 /* This method takes the string representation of an object
3619 * as a Tcl script, and generates the pre-parsed internal representation
3620 * of the script.
3622 * On parse error, sets an error message and returns JIM_ERR
3623 * (Note: the object is still converted to a script, even if an error occurs)
3625 static int JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3627 int scriptTextLen;
3628 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3629 struct JimParserCtx parser;
3630 struct ScriptObj *script;
3631 ParseTokenList tokenlist;
3632 int line = 1;
3633 int retcode = JIM_OK;
3635 /* Try to get information about filename / line number */
3636 if (objPtr->typePtr == &sourceObjType) {
3637 line = objPtr->internalRep.sourceValue.lineNumber;
3640 /* Initially parse the script into tokens (in tokenlist) */
3641 ScriptTokenListInit(&tokenlist);
3643 JimParserInit(&parser, scriptText, scriptTextLen, line);
3644 while (!parser.eof) {
3645 JimParseScript(&parser);
3646 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3647 parser.tline);
3650 retcode = JimParseCheckMissing(interp, parser.missing.ch);
3652 /* Add a final EOF token */
3653 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3655 /* Create the "real" script tokens from the parsed tokens */
3656 script = Jim_Alloc(sizeof(*script));
3657 memset(script, 0, sizeof(*script));
3658 script->inUse = 1;
3659 if (objPtr->typePtr == &sourceObjType) {
3660 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3662 else {
3663 script->fileNameObj = interp->emptyObj;
3665 script->linenr = parser.missing.line;
3666 Jim_IncrRefCount(script->fileNameObj);
3668 ScriptObjAddTokens(interp, script, &tokenlist);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp, objPtr);
3675 Jim_SetIntRepPtr(objPtr, script);
3676 objPtr->typePtr = &scriptObjType;
3678 return retcode;
3682 * Returns NULL if the script failed to parse and leaves
3683 * an error message in the interp result.
3685 * Otherwise returns a parsed script object.
3686 * (Note: the object is still converted to a script, even if an error occurs)
3688 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3690 if (objPtr == interp->emptyObj) {
3691 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3692 objPtr = interp->nullScriptObj;
3695 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3696 if (JimSetScriptFromAny(interp, objPtr) == JIM_ERR) {
3697 return NULL;
3700 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3703 /* -----------------------------------------------------------------------------
3704 * Commands
3705 * ---------------------------------------------------------------------------*/
3706 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3708 cmdPtr->inUse++;
3711 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3713 if (--cmdPtr->inUse == 0) {
3714 if (cmdPtr->isproc) {
3715 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3716 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3717 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3718 if (cmdPtr->u.proc.staticVars) {
3719 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3720 Jim_Free(cmdPtr->u.proc.staticVars);
3723 else {
3724 /* native (C) */
3725 if (cmdPtr->u.native.delProc) {
3726 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3729 if (cmdPtr->prevCmd) {
3730 /* Delete any pushed command too */
3731 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3733 Jim_Free(cmdPtr);
3737 /* Variables HashTable Type.
3739 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3742 /* Variables HashTable Type.
3744 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3745 static void JimVariablesHTValDestructor(void *interp, void *val)
3747 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3748 Jim_Free(val);
3751 static const Jim_HashTableType JimVariablesHashTableType = {
3752 JimStringCopyHTHashFunction, /* hash function */
3753 JimStringCopyHTDup, /* key dup */
3754 NULL, /* val dup */
3755 JimStringCopyHTKeyCompare, /* key compare */
3756 JimStringCopyHTKeyDestructor, /* key destructor */
3757 JimVariablesHTValDestructor /* val destructor */
3760 /* Commands HashTable Type.
3762 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3764 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3766 JimDecrCmdRefCount(interp, val);
3769 static const Jim_HashTableType JimCommandsHashTableType = {
3770 JimStringCopyHTHashFunction, /* hash function */
3771 JimStringCopyHTDup, /* key dup */
3772 NULL, /* val dup */
3773 JimStringCopyHTKeyCompare, /* key compare */
3774 JimStringCopyHTKeyDestructor, /* key destructor */
3775 JimCommandsHT_ValDestructor /* val destructor */
3778 /* ------------------------- Commands related functions --------------------- */
3780 #ifdef jim_ext_namespace
3782 * Returns the "unscoped" version of the given namespace.
3783 * That is, the fully qualfied name without the leading ::
3784 * The returned value is either nsObj, or an object with a zero ref count.
3786 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3788 const char *name = Jim_String(nsObj);
3789 if (name[0] == ':' && name[1] == ':') {
3790 /* This command is being defined in the global namespace */
3791 while (*++name == ':') {
3793 nsObj = Jim_NewStringObj(interp, name, -1);
3795 else if (Jim_Length(interp->framePtr->nsObj)) {
3796 /* This command is being defined in a non-global namespace */
3797 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3798 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3800 return nsObj;
3803 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3805 Jim_Obj *resultObj;
3807 const char *name = Jim_String(nameObjPtr);
3808 if (name[0] == ':' && name[1] == ':') {
3809 return nameObjPtr;
3811 Jim_IncrRefCount(nameObjPtr);
3812 resultObj = Jim_NewStringObj(interp, "::", -1);
3813 Jim_AppendObj(interp, resultObj, nameObjPtr);
3814 Jim_DecrRefCount(interp, nameObjPtr);
3816 return resultObj;
3820 * An efficient version of JimQualifyNameObj() where the name is
3821 * available (and needed) as a 'const char *'.
3822 * Avoids creating an object if not necessary.
3823 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3825 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3827 Jim_Obj *objPtr = interp->emptyObj;
3829 if (name[0] == ':' && name[1] == ':') {
3830 /* This command is being defined in the global namespace */
3831 while (*++name == ':') {
3834 else if (Jim_Length(interp->framePtr->nsObj)) {
3835 /* This command is being defined in a non-global namespace */
3836 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3837 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3838 name = Jim_String(objPtr);
3840 Jim_IncrRefCount(objPtr);
3841 *objPtrPtr = objPtr;
3842 return name;
3845 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3847 #else
3848 /* We can be more efficient in the no-namespace case */
3849 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3850 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3852 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3854 return nameObjPtr;
3856 #endif
3858 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3860 /* It may already exist, so we try to delete the old one.
3861 * Note that reference count means that it won't be deleted yet if
3862 * it exists in the call stack.
3864 * BUT, if 'local' is in force, instead of deleting the existing
3865 * proc, we stash a reference to the old proc here.
3867 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3868 if (he) {
3869 /* There was an old cmd with the same name,
3870 * so this requires a 'proc epoch' update. */
3872 /* If a procedure with the same name didn't exist there is no need
3873 * to increment the 'proc epoch' because creation of a new procedure
3874 * can never affect existing cached commands. We don't do
3875 * negative caching. */
3876 Jim_InterpIncrProcEpoch(interp);
3879 if (he && interp->local) {
3880 /* Push this command over the top of the previous one */
3881 cmd->prevCmd = Jim_GetHashEntryVal(he);
3882 Jim_SetHashVal(&interp->commands, he, cmd);
3884 else {
3885 if (he) {
3886 /* Replace the existing command */
3887 Jim_DeleteHashEntry(&interp->commands, name);
3890 Jim_AddHashEntry(&interp->commands, name, cmd);
3892 return JIM_OK;
3896 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3897 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3899 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3901 /* Store the new details for this command */
3902 memset(cmdPtr, 0, sizeof(*cmdPtr));
3903 cmdPtr->inUse = 1;
3904 cmdPtr->u.native.delProc = delProc;
3905 cmdPtr->u.native.cmdProc = cmdProc;
3906 cmdPtr->u.native.privData = privData;
3908 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3910 return JIM_OK;
3913 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3915 int len, i;
3917 len = Jim_ListLength(interp, staticsListObjPtr);
3918 if (len == 0) {
3919 return JIM_OK;
3922 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3923 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3924 for (i = 0; i < len; i++) {
3925 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3926 Jim_Var *varPtr;
3927 int subLen;
3929 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3930 /* Check if it's composed of two elements. */
3931 subLen = Jim_ListLength(interp, objPtr);
3932 if (subLen == 1 || subLen == 2) {
3933 /* Try to get the variable value from the current
3934 * environment. */
3935 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3936 if (subLen == 1) {
3937 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3938 if (initObjPtr == NULL) {
3939 Jim_SetResultFormatted(interp,
3940 "variable for initialization of static \"%#s\" not found in the local context",
3941 nameObjPtr);
3942 return JIM_ERR;
3945 else {
3946 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3948 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3949 return JIM_ERR;
3952 varPtr = Jim_Alloc(sizeof(*varPtr));
3953 varPtr->objPtr = initObjPtr;
3954 Jim_IncrRefCount(initObjPtr);
3955 varPtr->linkFramePtr = NULL;
3956 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3957 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3958 Jim_SetResultFormatted(interp,
3959 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3960 Jim_DecrRefCount(interp, initObjPtr);
3961 Jim_Free(varPtr);
3962 return JIM_ERR;
3965 else {
3966 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3967 objPtr);
3968 return JIM_ERR;
3971 return JIM_OK;
3974 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3976 #ifdef jim_ext_namespace
3977 if (cmdPtr->isproc) {
3978 /* XXX: Really need JimNamespaceSplit() */
3979 const char *pt = strrchr(cmdname, ':');
3980 if (pt && pt != cmdname && pt[-1] == ':') {
3981 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3982 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3983 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3985 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3986 /* This commands shadows a global command, so a proc epoch update is required */
3987 Jim_InterpIncrProcEpoch(interp);
3991 #endif
3994 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3995 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3997 Jim_Cmd *cmdPtr;
3998 int argListLen;
3999 int i;
4001 argListLen = Jim_ListLength(interp, argListObjPtr);
4003 /* Allocate space for both the command pointer and the arg list */
4004 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4005 memset(cmdPtr, 0, sizeof(*cmdPtr));
4006 cmdPtr->inUse = 1;
4007 cmdPtr->isproc = 1;
4008 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4009 cmdPtr->u.proc.argListLen = argListLen;
4010 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4011 cmdPtr->u.proc.argsPos = -1;
4012 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4013 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4014 Jim_IncrRefCount(argListObjPtr);
4015 Jim_IncrRefCount(bodyObjPtr);
4016 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4018 /* Create the statics hash table. */
4019 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4020 goto err;
4023 /* Parse the args out into arglist, validating as we go */
4024 /* Examine the argument list for default parameters and 'args' */
4025 for (i = 0; i < argListLen; i++) {
4026 Jim_Obj *argPtr;
4027 Jim_Obj *nameObjPtr;
4028 Jim_Obj *defaultObjPtr;
4029 int len;
4031 /* Examine a parameter */
4032 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4033 len = Jim_ListLength(interp, argPtr);
4034 if (len == 0) {
4035 Jim_SetResultString(interp, "argument with no name", -1);
4036 err:
4037 JimDecrCmdRefCount(interp, cmdPtr);
4038 return NULL;
4040 if (len > 2) {
4041 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4042 goto err;
4045 if (len == 2) {
4046 /* Optional parameter */
4047 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4048 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4050 else {
4051 /* Required parameter */
4052 nameObjPtr = argPtr;
4053 defaultObjPtr = NULL;
4057 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4058 if (cmdPtr->u.proc.argsPos >= 0) {
4059 Jim_SetResultString(interp, "'args' specified more than once", -1);
4060 goto err;
4062 cmdPtr->u.proc.argsPos = i;
4064 else {
4065 if (len == 2) {
4066 cmdPtr->u.proc.optArity++;
4068 else {
4069 cmdPtr->u.proc.reqArity++;
4073 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4074 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4077 return cmdPtr;
4080 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4082 int ret = JIM_OK;
4083 Jim_Obj *qualifiedNameObj;
4084 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4086 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4087 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4088 ret = JIM_ERR;
4090 else {
4091 Jim_InterpIncrProcEpoch(interp);
4094 JimFreeQualifiedName(interp, qualifiedNameObj);
4096 return ret;
4099 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4101 int ret = JIM_ERR;
4102 Jim_HashEntry *he;
4103 Jim_Cmd *cmdPtr;
4104 Jim_Obj *qualifiedOldNameObj;
4105 Jim_Obj *qualifiedNewNameObj;
4106 const char *fqold;
4107 const char *fqnew;
4109 if (newName[0] == 0) {
4110 return Jim_DeleteCommand(interp, oldName);
4113 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4114 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4116 /* Does it exist? */
4117 he = Jim_FindHashEntry(&interp->commands, fqold);
4118 if (he == NULL) {
4119 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4121 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4122 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4124 else {
4125 /* Add the new name first */
4126 cmdPtr = Jim_GetHashEntryVal(he);
4127 JimIncrCmdRefCount(cmdPtr);
4128 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4129 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4131 /* Now remove the old name */
4132 Jim_DeleteHashEntry(&interp->commands, fqold);
4134 /* Increment the epoch */
4135 Jim_InterpIncrProcEpoch(interp);
4137 ret = JIM_OK;
4140 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4141 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4143 return ret;
4146 /* -----------------------------------------------------------------------------
4147 * Command object
4148 * ---------------------------------------------------------------------------*/
4150 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4152 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4155 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4157 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4158 dupPtr->typePtr = srcPtr->typePtr;
4159 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4162 static const Jim_ObjType commandObjType = {
4163 "command",
4164 FreeCommandInternalRep,
4165 DupCommandInternalRep,
4166 NULL,
4167 JIM_TYPE_REFERENCES,
4170 /* This function returns the command structure for the command name
4171 * stored in objPtr. It tries to specialize the objPtr to contain
4172 * a cached info instead to perform the lookup into the hash table
4173 * every time. The information cached may not be uptodate, in such
4174 * a case the lookup is performed and the cache updated.
4176 * Respects the 'upcall' setting
4178 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4180 Jim_Cmd *cmd;
4182 /* In order to be valid, the proc epoch must match and
4183 * the lookup must have occurred in the same namespace
4185 if (objPtr->typePtr != &commandObjType ||
4186 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4187 #ifdef jim_ext_namespace
4188 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4189 #endif
4191 /* Not cached or out of date, so lookup */
4193 /* Do we need to try the local namespace? */
4194 const char *name = Jim_String(objPtr);
4195 Jim_HashEntry *he;
4197 if (name[0] == ':' && name[1] == ':') {
4198 while (*++name == ':') {
4201 #ifdef jim_ext_namespace
4202 else if (Jim_Length(interp->framePtr->nsObj)) {
4203 /* This command is being defined in a non-global namespace */
4204 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4205 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4206 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4207 Jim_FreeNewObj(interp, nameObj);
4208 if (he) {
4209 goto found;
4212 #endif
4214 /* Lookup in the global namespace */
4215 he = Jim_FindHashEntry(&interp->commands, name);
4216 if (he == NULL) {
4217 if (flags & JIM_ERRMSG) {
4218 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4220 return NULL;
4222 #ifdef jim_ext_namespace
4223 found:
4224 #endif
4225 cmd = Jim_GetHashEntryVal(he);
4227 /* Free the old internal repr and set the new one. */
4228 Jim_FreeIntRep(interp, objPtr);
4229 objPtr->typePtr = &commandObjType;
4230 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4231 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4232 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4233 Jim_IncrRefCount(interp->framePtr->nsObj);
4235 else {
4236 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4238 while (cmd->u.proc.upcall) {
4239 cmd = cmd->prevCmd;
4241 return cmd;
4244 /* -----------------------------------------------------------------------------
4245 * Variables
4246 * ---------------------------------------------------------------------------*/
4248 /* -----------------------------------------------------------------------------
4249 * Variable object
4250 * ---------------------------------------------------------------------------*/
4252 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4254 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4256 static const Jim_ObjType variableObjType = {
4257 "variable",
4258 NULL,
4259 NULL,
4260 NULL,
4261 JIM_TYPE_REFERENCES,
4265 * Check that the name does not contain embedded nulls.
4267 * Variable and procedure names are maniplated as null terminated strings, so
4268 * don't allow names with embedded nulls.
4270 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4272 /* Variable names and proc names can't contain embedded nulls */
4273 if (nameObjPtr->typePtr != &variableObjType) {
4274 int len;
4275 const char *str = Jim_GetString(nameObjPtr, &len);
4276 if (memchr(str, '\0', len)) {
4277 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4278 return JIM_ERR;
4281 return JIM_OK;
4284 /* This method should be called only by the variable API.
4285 * It returns JIM_OK on success (variable already exists),
4286 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4287 * a variable name, but syntax glue for [dict] i.e. the last
4288 * character is ')' */
4289 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4291 const char *varName;
4292 Jim_CallFrame *framePtr;
4293 Jim_HashEntry *he;
4294 int global;
4295 int len;
4297 /* Check if the object is already an uptodate variable */
4298 if (objPtr->typePtr == &variableObjType) {
4299 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4300 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4301 /* nothing to do */
4302 return JIM_OK;
4304 /* Need to re-resolve the variable in the updated callframe */
4306 else if (objPtr->typePtr == &dictSubstObjType) {
4307 return JIM_DICT_SUGAR;
4309 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4310 return JIM_ERR;
4314 varName = Jim_GetString(objPtr, &len);
4316 /* Make sure it's not syntax glue to get/set dict. */
4317 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4318 return JIM_DICT_SUGAR;
4321 if (varName[0] == ':' && varName[1] == ':') {
4322 while (*++varName == ':') {
4324 global = 1;
4325 framePtr = interp->topFramePtr;
4327 else {
4328 global = 0;
4329 framePtr = interp->framePtr;
4332 /* Resolve this name in the variables hash table */
4333 he = Jim_FindHashEntry(&framePtr->vars, varName);
4334 if (he == NULL) {
4335 if (!global && framePtr->staticVars) {
4336 /* Try with static vars. */
4337 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4339 if (he == NULL) {
4340 return JIM_ERR;
4344 /* Free the old internal repr and set the new one. */
4345 Jim_FreeIntRep(interp, objPtr);
4346 objPtr->typePtr = &variableObjType;
4347 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4348 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4349 objPtr->internalRep.varValue.global = global;
4350 return JIM_OK;
4353 /* -------------------- Variables related functions ------------------------- */
4354 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4355 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4357 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4359 const char *name;
4360 Jim_CallFrame *framePtr;
4361 int global;
4363 /* New variable to create */
4364 Jim_Var *var = Jim_Alloc(sizeof(*var));
4366 var->objPtr = valObjPtr;
4367 Jim_IncrRefCount(valObjPtr);
4368 var->linkFramePtr = NULL;
4370 name = Jim_String(nameObjPtr);
4371 if (name[0] == ':' && name[1] == ':') {
4372 while (*++name == ':') {
4374 framePtr = interp->topFramePtr;
4375 global = 1;
4377 else {
4378 framePtr = interp->framePtr;
4379 global = 0;
4382 /* Insert the new variable */
4383 Jim_AddHashEntry(&framePtr->vars, name, var);
4385 /* Make the object int rep a variable */
4386 Jim_FreeIntRep(interp, nameObjPtr);
4387 nameObjPtr->typePtr = &variableObjType;
4388 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4389 nameObjPtr->internalRep.varValue.varPtr = var;
4390 nameObjPtr->internalRep.varValue.global = global;
4392 return var;
4395 /* For now that's dummy. Variables lookup should be optimized
4396 * in many ways, with caching of lookups, and possibly with
4397 * a table of pre-allocated vars in every CallFrame for local vars.
4398 * All the caching should also have an 'epoch' mechanism similar
4399 * to the one used by Tcl for procedures lookup caching. */
4401 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4403 int err;
4404 Jim_Var *var;
4406 switch (SetVariableFromAny(interp, nameObjPtr)) {
4407 case JIM_DICT_SUGAR:
4408 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4410 case JIM_ERR:
4411 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4412 return JIM_ERR;
4414 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4415 break;
4417 case JIM_OK:
4418 var = nameObjPtr->internalRep.varValue.varPtr;
4419 if (var->linkFramePtr == NULL) {
4420 Jim_IncrRefCount(valObjPtr);
4421 Jim_DecrRefCount(interp, var->objPtr);
4422 var->objPtr = valObjPtr;
4424 else { /* Else handle the link */
4425 Jim_CallFrame *savedCallFrame;
4427 savedCallFrame = interp->framePtr;
4428 interp->framePtr = var->linkFramePtr;
4429 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4430 interp->framePtr = savedCallFrame;
4431 if (err != JIM_OK)
4432 return err;
4435 return JIM_OK;
4438 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4440 Jim_Obj *nameObjPtr;
4441 int result;
4443 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4444 Jim_IncrRefCount(nameObjPtr);
4445 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4446 Jim_DecrRefCount(interp, nameObjPtr);
4447 return result;
4450 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4452 Jim_CallFrame *savedFramePtr;
4453 int result;
4455 savedFramePtr = interp->framePtr;
4456 interp->framePtr = interp->topFramePtr;
4457 result = Jim_SetVariableStr(interp, name, objPtr);
4458 interp->framePtr = savedFramePtr;
4459 return result;
4462 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4464 Jim_Obj *nameObjPtr, *valObjPtr;
4465 int result;
4467 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4468 valObjPtr = Jim_NewStringObj(interp, val, -1);
4469 Jim_IncrRefCount(nameObjPtr);
4470 Jim_IncrRefCount(valObjPtr);
4471 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4472 Jim_DecrRefCount(interp, nameObjPtr);
4473 Jim_DecrRefCount(interp, valObjPtr);
4474 return result;
4477 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4478 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4480 const char *varName;
4481 const char *targetName;
4482 Jim_CallFrame *framePtr;
4483 Jim_Var *varPtr;
4485 /* Check for an existing variable or link */
4486 switch (SetVariableFromAny(interp, nameObjPtr)) {
4487 case JIM_DICT_SUGAR:
4488 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4489 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4490 return JIM_ERR;
4492 case JIM_OK:
4493 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4495 if (varPtr->linkFramePtr == NULL) {
4496 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4497 return JIM_ERR;
4500 /* It exists, but is a link, so first delete the link */
4501 varPtr->linkFramePtr = NULL;
4502 break;
4505 /* Resolve the call frames for both variables */
4506 /* XXX: SetVariableFromAny() already did this! */
4507 varName = Jim_String(nameObjPtr);
4509 if (varName[0] == ':' && varName[1] == ':') {
4510 while (*++varName == ':') {
4512 /* Linking a global var does nothing */
4513 framePtr = interp->topFramePtr;
4515 else {
4516 framePtr = interp->framePtr;
4519 targetName = Jim_String(targetNameObjPtr);
4520 if (targetName[0] == ':' && targetName[1] == ':') {
4521 while (*++targetName == ':') {
4523 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4524 targetCallFrame = interp->topFramePtr;
4526 Jim_IncrRefCount(targetNameObjPtr);
4528 if (framePtr->level < targetCallFrame->level) {
4529 Jim_SetResultFormatted(interp,
4530 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4531 nameObjPtr);
4532 Jim_DecrRefCount(interp, targetNameObjPtr);
4533 return JIM_ERR;
4536 /* Check for cycles. */
4537 if (framePtr == targetCallFrame) {
4538 Jim_Obj *objPtr = targetNameObjPtr;
4540 /* Cycles are only possible with 'uplevel 0' */
4541 while (1) {
4542 if (strcmp(Jim_String(objPtr), varName) == 0) {
4543 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4544 Jim_DecrRefCount(interp, targetNameObjPtr);
4545 return JIM_ERR;
4547 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4548 break;
4549 varPtr = objPtr->internalRep.varValue.varPtr;
4550 if (varPtr->linkFramePtr != targetCallFrame)
4551 break;
4552 objPtr = varPtr->objPtr;
4556 /* Perform the binding */
4557 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4558 /* We are now sure 'nameObjPtr' type is variableObjType */
4559 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4560 Jim_DecrRefCount(interp, targetNameObjPtr);
4561 return JIM_OK;
4564 /* Return the Jim_Obj pointer associated with a variable name,
4565 * or NULL if the variable was not found in the current context.
4566 * The same optimization discussed in the comment to the
4567 * 'SetVariable' function should apply here.
4569 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4570 * in a dictionary which is shared, the array variable value is duplicated first.
4571 * This allows the array element to be updated (e.g. append, lappend) without
4572 * affecting other references to the dictionary.
4574 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4576 switch (SetVariableFromAny(interp, nameObjPtr)) {
4577 case JIM_OK:{
4578 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4580 if (varPtr->linkFramePtr == NULL) {
4581 return varPtr->objPtr;
4583 else {
4584 Jim_Obj *objPtr;
4586 /* The variable is a link? Resolve it. */
4587 Jim_CallFrame *savedCallFrame = interp->framePtr;
4589 interp->framePtr = varPtr->linkFramePtr;
4590 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4591 interp->framePtr = savedCallFrame;
4592 if (objPtr) {
4593 return objPtr;
4595 /* Error, so fall through to the error message */
4598 break;
4600 case JIM_DICT_SUGAR:
4601 /* [dict] syntax sugar. */
4602 return JimDictSugarGet(interp, nameObjPtr, flags);
4604 if (flags & JIM_ERRMSG) {
4605 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4607 return NULL;
4610 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4612 Jim_CallFrame *savedFramePtr;
4613 Jim_Obj *objPtr;
4615 savedFramePtr = interp->framePtr;
4616 interp->framePtr = interp->topFramePtr;
4617 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4618 interp->framePtr = savedFramePtr;
4620 return objPtr;
4623 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4625 Jim_Obj *nameObjPtr, *varObjPtr;
4627 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4628 Jim_IncrRefCount(nameObjPtr);
4629 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4630 Jim_DecrRefCount(interp, nameObjPtr);
4631 return varObjPtr;
4634 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4636 Jim_CallFrame *savedFramePtr;
4637 Jim_Obj *objPtr;
4639 savedFramePtr = interp->framePtr;
4640 interp->framePtr = interp->topFramePtr;
4641 objPtr = Jim_GetVariableStr(interp, name, flags);
4642 interp->framePtr = savedFramePtr;
4644 return objPtr;
4647 /* Unset a variable.
4648 * Note: On success unset invalidates all the variable objects created
4649 * in the current call frame incrementing. */
4650 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4652 Jim_Var *varPtr;
4653 int retval;
4654 Jim_CallFrame *framePtr;
4656 retval = SetVariableFromAny(interp, nameObjPtr);
4657 if (retval == JIM_DICT_SUGAR) {
4658 /* [dict] syntax sugar. */
4659 return JimDictSugarSet(interp, nameObjPtr, NULL);
4661 else if (retval == JIM_OK) {
4662 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4664 /* If it's a link call UnsetVariable recursively */
4665 if (varPtr->linkFramePtr) {
4666 framePtr = interp->framePtr;
4667 interp->framePtr = varPtr->linkFramePtr;
4668 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4669 interp->framePtr = framePtr;
4671 else {
4672 const char *name = Jim_String(nameObjPtr);
4673 if (nameObjPtr->internalRep.varValue.global) {
4674 name += 2;
4675 framePtr = interp->topFramePtr;
4677 else {
4678 framePtr = interp->framePtr;
4681 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4682 if (retval == JIM_OK) {
4683 /* Change the callframe id, invalidating var lookup caching */
4684 framePtr->id = interp->callFrameEpoch++;
4688 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4689 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4691 return retval;
4694 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4696 /* Given a variable name for [dict] operation syntax sugar,
4697 * this function returns two objects, the first with the name
4698 * of the variable to set, and the second with the rispective key.
4699 * For example "foo(bar)" will return objects with string repr. of
4700 * "foo" and "bar".
4702 * The returned objects have refcount = 1. The function can't fail. */
4703 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4704 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4706 const char *str, *p;
4707 int len, keyLen;
4708 Jim_Obj *varObjPtr, *keyObjPtr;
4710 str = Jim_GetString(objPtr, &len);
4712 p = strchr(str, '(');
4713 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4715 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4717 p++;
4718 keyLen = (str + len) - p;
4719 if (str[len - 1] == ')') {
4720 keyLen--;
4723 /* Create the objects with the variable name and key. */
4724 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4726 Jim_IncrRefCount(varObjPtr);
4727 Jim_IncrRefCount(keyObjPtr);
4728 *varPtrPtr = varObjPtr;
4729 *keyPtrPtr = keyObjPtr;
4732 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4733 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4734 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4736 int err;
4738 SetDictSubstFromAny(interp, objPtr);
4740 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4741 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4743 if (err == JIM_OK) {
4744 /* Don't keep an extra ref to the result */
4745 Jim_SetEmptyResult(interp);
4747 else {
4748 if (!valObjPtr) {
4749 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4750 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4751 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4752 objPtr);
4753 return err;
4756 /* Make the error more informative and Tcl-compatible */
4757 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4758 (valObjPtr ? "set" : "unset"), objPtr);
4760 return err;
4764 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4766 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4767 * and stored back to the variable before expansion.
4769 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4770 Jim_Obj *keyObjPtr, int flags)
4772 Jim_Obj *dictObjPtr;
4773 Jim_Obj *resObjPtr = NULL;
4774 int ret;
4776 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4777 if (!dictObjPtr) {
4778 return NULL;
4781 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4782 if (ret != JIM_OK) {
4783 Jim_SetResultFormatted(interp,
4784 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4785 ret < 0 ? "variable isn't" : "no such element in");
4787 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4788 /* Update the variable to have an unshared copy */
4789 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4792 return resObjPtr;
4795 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4796 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4798 SetDictSubstFromAny(interp, objPtr);
4800 return JimDictExpandArrayVariable(interp,
4801 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4802 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4805 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4807 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4809 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4810 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4813 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4815 JIM_NOTUSED(interp);
4817 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4818 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4819 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4820 dupPtr->typePtr = &dictSubstObjType;
4823 /* Note: The object *must* be in dict-sugar format */
4824 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4826 if (objPtr->typePtr != &dictSubstObjType) {
4827 Jim_Obj *varObjPtr, *keyObjPtr;
4829 if (objPtr->typePtr == &interpolatedObjType) {
4830 /* An interpolated object in dict-sugar form */
4832 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4833 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4835 Jim_IncrRefCount(varObjPtr);
4836 Jim_IncrRefCount(keyObjPtr);
4838 else {
4839 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4842 Jim_FreeIntRep(interp, objPtr);
4843 objPtr->typePtr = &dictSubstObjType;
4844 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4845 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4849 /* This function is used to expand [dict get] sugar in the form
4850 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4851 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4852 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4853 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4854 * the [dict]ionary contained in variable VARNAME. */
4855 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4857 Jim_Obj *resObjPtr = NULL;
4858 Jim_Obj *substKeyObjPtr = NULL;
4860 SetDictSubstFromAny(interp, objPtr);
4862 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4863 &substKeyObjPtr, JIM_NONE)
4864 != JIM_OK) {
4865 return NULL;
4867 Jim_IncrRefCount(substKeyObjPtr);
4868 resObjPtr =
4869 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4870 substKeyObjPtr, 0);
4871 Jim_DecrRefCount(interp, substKeyObjPtr);
4873 return resObjPtr;
4876 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4878 Jim_Obj *resultObjPtr;
4880 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4881 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4882 resultObjPtr->refCount--;
4883 return resultObjPtr;
4885 return NULL;
4888 /* -----------------------------------------------------------------------------
4889 * CallFrame
4890 * ---------------------------------------------------------------------------*/
4892 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4894 Jim_CallFrame *cf;
4896 if (interp->freeFramesList) {
4897 cf = interp->freeFramesList;
4898 interp->freeFramesList = cf->next;
4900 cf->argv = NULL;
4901 cf->argc = 0;
4902 cf->procArgsObjPtr = NULL;
4903 cf->procBodyObjPtr = NULL;
4904 cf->next = NULL;
4905 cf->staticVars = NULL;
4906 cf->localCommands = NULL;
4907 cf->tailcall = 0;
4908 cf->tailcallObj = NULL;
4909 cf->tailcallCmd = NULL;
4911 else {
4912 cf = Jim_Alloc(sizeof(*cf));
4913 memset(cf, 0, sizeof(*cf));
4915 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4918 cf->id = interp->callFrameEpoch++;
4919 cf->parent = parent;
4920 cf->level = parent ? parent->level + 1 : 0;
4921 cf->nsObj = nsObj;
4922 Jim_IncrRefCount(nsObj);
4924 return cf;
4927 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4929 /* Delete any local procs */
4930 if (localCommands) {
4931 Jim_Obj *cmdNameObj;
4933 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4934 Jim_HashEntry *he;
4935 Jim_Obj *fqObjName;
4936 Jim_HashTable *ht = &interp->commands;
4938 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4940 he = Jim_FindHashEntry(ht, fqname);
4942 if (he) {
4943 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4944 if (cmd->prevCmd) {
4945 Jim_Cmd *prevCmd = cmd->prevCmd;
4946 cmd->prevCmd = NULL;
4948 /* Delete the old command */
4949 JimDecrCmdRefCount(interp, cmd);
4951 /* And restore the original */
4952 Jim_SetHashVal(ht, he, prevCmd);
4954 else {
4955 Jim_DeleteHashEntry(ht, fqname);
4956 Jim_InterpIncrProcEpoch(interp);
4959 Jim_DecrRefCount(interp, cmdNameObj);
4960 JimFreeQualifiedName(interp, fqObjName);
4962 Jim_FreeStack(localCommands);
4963 Jim_Free(localCommands);
4965 return JIM_OK;
4969 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4970 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4971 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4973 JimDeleteLocalProcs(interp, cf->localCommands);
4975 if (cf->procArgsObjPtr)
4976 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4977 if (cf->procBodyObjPtr)
4978 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4979 Jim_DecrRefCount(interp, cf->nsObj);
4980 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4981 Jim_FreeHashTable(&cf->vars);
4982 else {
4983 int i;
4984 Jim_HashEntry **table = cf->vars.table, *he;
4986 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4987 he = table[i];
4988 while (he != NULL) {
4989 Jim_HashEntry *nextEntry = he->next;
4990 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
4992 Jim_DecrRefCount(interp, varPtr->objPtr);
4993 Jim_Free(Jim_GetHashEntryKey(he));
4994 Jim_Free(varPtr);
4995 Jim_Free(he);
4996 table[i] = NULL;
4997 he = nextEntry;
5000 cf->vars.used = 0;
5002 cf->next = interp->freeFramesList;
5003 interp->freeFramesList = cf;
5007 /* -----------------------------------------------------------------------------
5008 * References
5009 * ---------------------------------------------------------------------------*/
5010 #ifdef JIM_REFERENCES
5012 /* References HashTable Type.
5014 * Keys are unsigned long integers, dynamically allocated for now but in the
5015 * future it's worth to cache this 4 bytes objects. Values are pointers
5016 * to Jim_References. */
5017 static void JimReferencesHTValDestructor(void *interp, void *val)
5019 Jim_Reference *refPtr = (void *)val;
5021 Jim_DecrRefCount(interp, refPtr->objPtr);
5022 if (refPtr->finalizerCmdNamePtr != NULL) {
5023 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5025 Jim_Free(val);
5028 static unsigned int JimReferencesHTHashFunction(const void *key)
5030 /* Only the least significant bits are used. */
5031 const unsigned long *widePtr = key;
5032 unsigned int intValue = (unsigned int)*widePtr;
5034 return Jim_IntHashFunction(intValue);
5037 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5039 void *copy = Jim_Alloc(sizeof(unsigned long));
5041 JIM_NOTUSED(privdata);
5043 memcpy(copy, key, sizeof(unsigned long));
5044 return copy;
5047 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5049 JIM_NOTUSED(privdata);
5051 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5054 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5056 JIM_NOTUSED(privdata);
5058 Jim_Free(key);
5061 static const Jim_HashTableType JimReferencesHashTableType = {
5062 JimReferencesHTHashFunction, /* hash function */
5063 JimReferencesHTKeyDup, /* key dup */
5064 NULL, /* val dup */
5065 JimReferencesHTKeyCompare, /* key compare */
5066 JimReferencesHTKeyDestructor, /* key destructor */
5067 JimReferencesHTValDestructor /* val destructor */
5070 /* -----------------------------------------------------------------------------
5071 * Reference object type and References API
5072 * ---------------------------------------------------------------------------*/
5074 /* The string representation of references has two features in order
5075 * to make the GC faster. The first is that every reference starts
5076 * with a non common character '<', in order to make the string matching
5077 * faster. The second is that the reference string rep is 42 characters
5078 * in length, this means that it is not necessary to check any object with a string
5079 * repr < 42, and usually there aren't many of these objects. */
5081 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5083 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5085 const char *fmt = "<reference.<%s>.%020lu>";
5087 sprintf(buf, fmt, refPtr->tag, id);
5088 return JIM_REFERENCE_SPACE;
5091 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5093 static const Jim_ObjType referenceObjType = {
5094 "reference",
5095 NULL,
5096 NULL,
5097 UpdateStringOfReference,
5098 JIM_TYPE_REFERENCES,
5101 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5103 char buf[JIM_REFERENCE_SPACE + 1];
5105 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5106 JimSetStringBytes(objPtr, buf);
5109 /* returns true if 'c' is a valid reference tag character.
5110 * i.e. inside the range [_a-zA-Z0-9] */
5111 static int isrefchar(int c)
5113 return (c == '_' || isalnum(c));
5116 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5118 unsigned long value;
5119 int i, len;
5120 const char *str, *start, *end;
5121 char refId[21];
5122 Jim_Reference *refPtr;
5123 Jim_HashEntry *he;
5124 char *endptr;
5126 /* Get the string representation */
5127 str = Jim_GetString(objPtr, &len);
5128 /* Check if it looks like a reference */
5129 if (len < JIM_REFERENCE_SPACE)
5130 goto badformat;
5131 /* Trim spaces */
5132 start = str;
5133 end = str + len - 1;
5134 while (*start == ' ')
5135 start++;
5136 while (*end == ' ' && end > start)
5137 end--;
5138 if (end - start + 1 != JIM_REFERENCE_SPACE)
5139 goto badformat;
5140 /* <reference.<1234567>.%020> */
5141 if (memcmp(start, "<reference.<", 12) != 0)
5142 goto badformat;
5143 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5144 goto badformat;
5145 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5146 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5147 if (!isrefchar(start[12 + i]))
5148 goto badformat;
5150 /* Extract info from the reference. */
5151 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5152 refId[20] = '\0';
5153 /* Try to convert the ID into an unsigned long */
5154 value = strtoul(refId, &endptr, 10);
5155 if (JimCheckConversion(refId, endptr) != JIM_OK)
5156 goto badformat;
5157 /* Check if the reference really exists! */
5158 he = Jim_FindHashEntry(&interp->references, &value);
5159 if (he == NULL) {
5160 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5161 return JIM_ERR;
5163 refPtr = Jim_GetHashEntryVal(he);
5164 /* Free the old internal repr and set the new one. */
5165 Jim_FreeIntRep(interp, objPtr);
5166 objPtr->typePtr = &referenceObjType;
5167 objPtr->internalRep.refValue.id = value;
5168 objPtr->internalRep.refValue.refPtr = refPtr;
5169 return JIM_OK;
5171 badformat:
5172 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5173 return JIM_ERR;
5176 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5177 * as finalizer command (or NULL if there is no finalizer).
5178 * The returned reference object has refcount = 0. */
5179 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5181 struct Jim_Reference *refPtr;
5182 unsigned long id;
5183 Jim_Obj *refObjPtr;
5184 const char *tag;
5185 int tagLen, i;
5187 /* Perform the Garbage Collection if needed. */
5188 Jim_CollectIfNeeded(interp);
5190 refPtr = Jim_Alloc(sizeof(*refPtr));
5191 refPtr->objPtr = objPtr;
5192 Jim_IncrRefCount(objPtr);
5193 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5194 if (cmdNamePtr)
5195 Jim_IncrRefCount(cmdNamePtr);
5196 id = interp->referenceNextId++;
5197 Jim_AddHashEntry(&interp->references, &id, refPtr);
5198 refObjPtr = Jim_NewObj(interp);
5199 refObjPtr->typePtr = &referenceObjType;
5200 refObjPtr->bytes = NULL;
5201 refObjPtr->internalRep.refValue.id = id;
5202 refObjPtr->internalRep.refValue.refPtr = refPtr;
5203 interp->referenceNextId++;
5204 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5205 * that does not pass the 'isrefchar' test is replaced with '_' */
5206 tag = Jim_GetString(tagPtr, &tagLen);
5207 if (tagLen > JIM_REFERENCE_TAGLEN)
5208 tagLen = JIM_REFERENCE_TAGLEN;
5209 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5210 if (i < tagLen && isrefchar(tag[i]))
5211 refPtr->tag[i] = tag[i];
5212 else
5213 refPtr->tag[i] = '_';
5215 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5216 return refObjPtr;
5219 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5221 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5222 return NULL;
5223 return objPtr->internalRep.refValue.refPtr;
5226 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5228 Jim_Reference *refPtr;
5230 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5231 return JIM_ERR;
5232 Jim_IncrRefCount(cmdNamePtr);
5233 if (refPtr->finalizerCmdNamePtr)
5234 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5235 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5236 return JIM_OK;
5239 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5241 Jim_Reference *refPtr;
5243 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5244 return JIM_ERR;
5245 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5246 return JIM_OK;
5249 /* -----------------------------------------------------------------------------
5250 * References Garbage Collection
5251 * ---------------------------------------------------------------------------*/
5253 /* This the hash table type for the "MARK" phase of the GC */
5254 static const Jim_HashTableType JimRefMarkHashTableType = {
5255 JimReferencesHTHashFunction, /* hash function */
5256 JimReferencesHTKeyDup, /* key dup */
5257 NULL, /* val dup */
5258 JimReferencesHTKeyCompare, /* key compare */
5259 JimReferencesHTKeyDestructor, /* key destructor */
5260 NULL /* val destructor */
5263 /* Performs the garbage collection. */
5264 int Jim_Collect(Jim_Interp *interp)
5266 int collected = 0;
5267 #ifndef JIM_BOOTSTRAP
5268 Jim_HashTable marks;
5269 Jim_HashTableIterator htiter;
5270 Jim_HashEntry *he;
5271 Jim_Obj *objPtr;
5273 /* Avoid recursive calls */
5274 if (interp->lastCollectId == -1) {
5275 /* Jim_Collect() already running. Return just now. */
5276 return 0;
5278 interp->lastCollectId = -1;
5280 /* Mark all the references found into the 'mark' hash table.
5281 * The references are searched in every live object that
5282 * is of a type that can contain references. */
5283 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5284 objPtr = interp->liveList;
5285 while (objPtr) {
5286 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5287 const char *str, *p;
5288 int len;
5290 /* If the object is of type reference, to get the
5291 * Id is simple... */
5292 if (objPtr->typePtr == &referenceObjType) {
5293 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5294 #ifdef JIM_DEBUG_GC
5295 printf("MARK (reference): %d refcount: %d\n",
5296 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5297 #endif
5298 objPtr = objPtr->nextObjPtr;
5299 continue;
5301 /* Get the string repr of the object we want
5302 * to scan for references. */
5303 p = str = Jim_GetString(objPtr, &len);
5304 /* Skip objects too little to contain references. */
5305 if (len < JIM_REFERENCE_SPACE) {
5306 objPtr = objPtr->nextObjPtr;
5307 continue;
5309 /* Extract references from the object string repr. */
5310 while (1) {
5311 int i;
5312 unsigned long id;
5314 if ((p = strstr(p, "<reference.<")) == NULL)
5315 break;
5316 /* Check if it's a valid reference. */
5317 if (len - (p - str) < JIM_REFERENCE_SPACE)
5318 break;
5319 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5320 break;
5321 for (i = 21; i <= 40; i++)
5322 if (!isdigit(UCHAR(p[i])))
5323 break;
5324 /* Get the ID */
5325 id = strtoul(p + 21, NULL, 10);
5327 /* Ok, a reference for the given ID
5328 * was found. Mark it. */
5329 Jim_AddHashEntry(&marks, &id, NULL);
5330 #ifdef JIM_DEBUG_GC
5331 printf("MARK: %d\n", (int)id);
5332 #endif
5333 p += JIM_REFERENCE_SPACE;
5336 objPtr = objPtr->nextObjPtr;
5339 /* Run the references hash table to destroy every reference that
5340 * is not referenced outside (not present in the mark HT). */
5341 JimInitHashTableIterator(&interp->references, &htiter);
5342 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5343 const unsigned long *refId;
5344 Jim_Reference *refPtr;
5346 refId = he->key;
5347 /* Check if in the mark phase we encountered
5348 * this reference. */
5349 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5350 #ifdef JIM_DEBUG_GC
5351 printf("COLLECTING %d\n", (int)*refId);
5352 #endif
5353 collected++;
5354 /* Drop the reference, but call the
5355 * finalizer first if registered. */
5356 refPtr = Jim_GetHashEntryVal(he);
5357 if (refPtr->finalizerCmdNamePtr) {
5358 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5359 Jim_Obj *objv[3], *oldResult;
5361 JimFormatReference(refstr, refPtr, *refId);
5363 objv[0] = refPtr->finalizerCmdNamePtr;
5364 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5365 objv[2] = refPtr->objPtr;
5367 /* Drop the reference itself */
5368 /* Avoid the finaliser being freed here */
5369 Jim_IncrRefCount(objv[0]);
5370 /* Don't remove the reference from the hash table just yet
5371 * since that will free refPtr, and hence refPtr->objPtr
5374 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5375 oldResult = interp->result;
5376 Jim_IncrRefCount(oldResult);
5377 Jim_EvalObjVector(interp, 3, objv);
5378 Jim_SetResult(interp, oldResult);
5379 Jim_DecrRefCount(interp, oldResult);
5381 Jim_DecrRefCount(interp, objv[0]);
5383 Jim_DeleteHashEntry(&interp->references, refId);
5386 Jim_FreeHashTable(&marks);
5387 interp->lastCollectId = interp->referenceNextId;
5388 interp->lastCollectTime = time(NULL);
5389 #endif /* JIM_BOOTSTRAP */
5390 return collected;
5393 #define JIM_COLLECT_ID_PERIOD 5000
5394 #define JIM_COLLECT_TIME_PERIOD 300
5396 void Jim_CollectIfNeeded(Jim_Interp *interp)
5398 unsigned long elapsedId;
5399 int elapsedTime;
5401 elapsedId = interp->referenceNextId - interp->lastCollectId;
5402 elapsedTime = time(NULL) - interp->lastCollectTime;
5405 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5406 Jim_Collect(interp);
5409 #endif
5411 int Jim_IsBigEndian(void)
5413 union {
5414 unsigned short s;
5415 unsigned char c[2];
5416 } uval = {0x0102};
5418 return uval.c[0] == 1;
5421 /* -----------------------------------------------------------------------------
5422 * Interpreter related functions
5423 * ---------------------------------------------------------------------------*/
5425 Jim_Interp *Jim_CreateInterp(void)
5427 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5429 memset(i, 0, sizeof(*i));
5431 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5432 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5433 i->lastCollectTime = time(NULL);
5435 /* Note that we can create objects only after the
5436 * interpreter liveList and freeList pointers are
5437 * initialized to NULL. */
5438 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5439 #ifdef JIM_REFERENCES
5440 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5441 #endif
5442 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5443 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5444 i->emptyObj = Jim_NewEmptyStringObj(i);
5445 i->trueObj = Jim_NewIntObj(i, 1);
5446 i->falseObj = Jim_NewIntObj(i, 0);
5447 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5448 i->errorFileNameObj = i->emptyObj;
5449 i->result = i->emptyObj;
5450 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5451 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5452 i->errorProc = i->emptyObj;
5453 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5454 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5455 Jim_IncrRefCount(i->emptyObj);
5456 Jim_IncrRefCount(i->errorFileNameObj);
5457 Jim_IncrRefCount(i->result);
5458 Jim_IncrRefCount(i->stackTrace);
5459 Jim_IncrRefCount(i->unknown);
5460 Jim_IncrRefCount(i->currentScriptObj);
5461 Jim_IncrRefCount(i->nullScriptObj);
5462 Jim_IncrRefCount(i->errorProc);
5463 Jim_IncrRefCount(i->trueObj);
5464 Jim_IncrRefCount(i->falseObj);
5466 /* Initialize key variables every interpreter should contain */
5467 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5468 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5470 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5471 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5472 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5473 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5474 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5475 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5476 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5478 return i;
5481 void Jim_FreeInterp(Jim_Interp *i)
5483 Jim_CallFrame *cf, *cfx;
5485 Jim_Obj *objPtr, *nextObjPtr;
5487 /* Free the active call frames list - must be done before i->commands is destroyed */
5488 for (cf = i->framePtr; cf; cf = cfx) {
5489 cfx = cf->parent;
5490 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5493 Jim_DecrRefCount(i, i->emptyObj);
5494 Jim_DecrRefCount(i, i->trueObj);
5495 Jim_DecrRefCount(i, i->falseObj);
5496 Jim_DecrRefCount(i, i->result);
5497 Jim_DecrRefCount(i, i->stackTrace);
5498 Jim_DecrRefCount(i, i->errorProc);
5499 Jim_DecrRefCount(i, i->unknown);
5500 Jim_DecrRefCount(i, i->errorFileNameObj);
5501 Jim_DecrRefCount(i, i->currentScriptObj);
5502 Jim_DecrRefCount(i, i->nullScriptObj);
5503 Jim_FreeHashTable(&i->commands);
5504 #ifdef JIM_REFERENCES
5505 Jim_FreeHashTable(&i->references);
5506 #endif
5507 Jim_FreeHashTable(&i->packages);
5508 Jim_Free(i->prngState);
5509 Jim_FreeHashTable(&i->assocData);
5511 /* Check that the live object list is empty, otherwise
5512 * there is a memory leak. */
5513 #ifdef JIM_MAINTAINER
5514 if (i->liveList != NULL) {
5515 objPtr = i->liveList;
5517 printf("\n-------------------------------------\n");
5518 printf("Objects still in the free list:\n");
5519 while (objPtr) {
5520 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5522 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5523 printf("%p (%d) %-10s: '%.20s...'\n",
5524 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5526 else {
5527 printf("%p (%d) %-10s: '%s'\n",
5528 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5530 if (objPtr->typePtr == &sourceObjType) {
5531 printf("FILE %s LINE %d\n",
5532 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5533 objPtr->internalRep.sourceValue.lineNumber);
5535 objPtr = objPtr->nextObjPtr;
5537 printf("-------------------------------------\n\n");
5538 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5540 #endif
5542 /* Free all the freed objects. */
5543 objPtr = i->freeList;
5544 while (objPtr) {
5545 nextObjPtr = objPtr->nextObjPtr;
5546 Jim_Free(objPtr);
5547 objPtr = nextObjPtr;
5550 /* Free the free call frames list */
5551 for (cf = i->freeFramesList; cf; cf = cfx) {
5552 cfx = cf->next;
5553 if (cf->vars.table)
5554 Jim_FreeHashTable(&cf->vars);
5555 Jim_Free(cf);
5558 /* Free the interpreter structure. */
5559 Jim_Free(i);
5562 /* Returns the call frame relative to the level represented by
5563 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5565 * This function accepts the 'level' argument in the form
5566 * of the commands [uplevel] and [upvar].
5568 * Returns NULL on error.
5570 * Note: for a function accepting a relative integer as level suitable
5571 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5573 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5575 long level;
5576 const char *str;
5577 Jim_CallFrame *framePtr;
5579 if (levelObjPtr) {
5580 str = Jim_String(levelObjPtr);
5581 if (str[0] == '#') {
5582 char *endptr;
5584 level = jim_strtol(str + 1, &endptr);
5585 if (str[1] == '\0' || endptr[0] != '\0') {
5586 level = -1;
5589 else {
5590 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5591 level = -1;
5593 else {
5594 /* Convert from a relative to an absolute level */
5595 level = interp->framePtr->level - level;
5599 else {
5600 str = "1"; /* Needed to format the error message. */
5601 level = interp->framePtr->level - 1;
5604 if (level == 0) {
5605 return interp->topFramePtr;
5607 if (level > 0) {
5608 /* Lookup */
5609 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5610 if (framePtr->level == level) {
5611 return framePtr;
5616 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5617 return NULL;
5620 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5621 * as a relative integer like in the [info level ?level?] command.
5623 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5625 long level;
5626 Jim_CallFrame *framePtr;
5628 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5629 if (level <= 0) {
5630 /* Convert from a relative to an absolute level */
5631 level = interp->framePtr->level + level;
5634 if (level == 0) {
5635 return interp->topFramePtr;
5638 /* Lookup */
5639 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5640 if (framePtr->level == level) {
5641 return framePtr;
5646 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5647 return NULL;
5650 static void JimResetStackTrace(Jim_Interp *interp)
5652 Jim_DecrRefCount(interp, interp->stackTrace);
5653 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5654 Jim_IncrRefCount(interp->stackTrace);
5657 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5659 int len;
5661 /* Increment reference first in case these are the same object */
5662 Jim_IncrRefCount(stackTraceObj);
5663 Jim_DecrRefCount(interp, interp->stackTrace);
5664 interp->stackTrace = stackTraceObj;
5665 interp->errorFlag = 1;
5667 /* This is a bit ugly.
5668 * If the filename of the last entry of the stack trace is empty,
5669 * the next stack level should be added.
5671 len = Jim_ListLength(interp, interp->stackTrace);
5672 if (len >= 3) {
5673 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5674 interp->addStackTrace = 1;
5679 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5680 Jim_Obj *fileNameObj, int linenr)
5682 if (strcmp(procname, "unknown") == 0) {
5683 procname = "";
5685 if (!*procname && !Jim_Length(fileNameObj)) {
5686 /* No useful info here */
5687 return;
5690 if (Jim_IsShared(interp->stackTrace)) {
5691 Jim_DecrRefCount(interp, interp->stackTrace);
5692 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5693 Jim_IncrRefCount(interp->stackTrace);
5696 /* If we have no procname but the previous element did, merge with that frame */
5697 if (!*procname && Jim_Length(fileNameObj)) {
5698 /* Just a filename. Check the previous entry */
5699 int len = Jim_ListLength(interp, interp->stackTrace);
5701 if (len >= 3) {
5702 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5703 if (Jim_Length(objPtr)) {
5704 /* Yes, the previous level had procname */
5705 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5706 if (Jim_Length(objPtr) == 0) {
5707 /* But no filename, so merge the new info with that frame */
5708 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5709 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5710 return;
5716 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5717 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5718 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5721 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5722 void *data)
5724 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5726 assocEntryPtr->delProc = delProc;
5727 assocEntryPtr->data = data;
5728 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5731 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5733 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5735 if (entryPtr != NULL) {
5736 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5737 return assocEntryPtr->data;
5739 return NULL;
5742 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5744 return Jim_DeleteHashEntry(&interp->assocData, key);
5747 int Jim_GetExitCode(Jim_Interp *interp)
5749 return interp->exitCode;
5752 /* -----------------------------------------------------------------------------
5753 * Integer object
5754 * ---------------------------------------------------------------------------*/
5755 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5756 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5758 static const Jim_ObjType intObjType = {
5759 "int",
5760 NULL,
5761 NULL,
5762 UpdateStringOfInt,
5763 JIM_TYPE_NONE,
5766 /* A coerced double is closer to an int than a double.
5767 * It is an int value temporarily masquerading as a double value.
5768 * i.e. it has the same string value as an int and Jim_GetWide()
5769 * succeeds, but also Jim_GetDouble() returns the value directly.
5771 static const Jim_ObjType coercedDoubleObjType = {
5772 "coerced-double",
5773 NULL,
5774 NULL,
5775 UpdateStringOfInt,
5776 JIM_TYPE_NONE,
5780 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5782 char buf[JIM_INTEGER_SPACE + 1];
5783 jim_wide wideValue = JimWideValue(objPtr);
5784 int pos = 0;
5786 if (wideValue == 0) {
5787 buf[pos++] = '0';
5789 else {
5790 char tmp[JIM_INTEGER_SPACE];
5791 int num = 0;
5792 int i;
5794 if (wideValue < 0) {
5795 buf[pos++] = '-';
5796 /* -106 % 10 may be -6 or 4! */
5797 i = wideValue % 10;
5798 tmp[num++] = (i > 0) ? (10 - i) : -i;
5799 wideValue /= -10;
5802 while (wideValue) {
5803 tmp[num++] = wideValue % 10;
5804 wideValue /= 10;
5807 for (i = 0; i < num; i++) {
5808 buf[pos++] = '0' + tmp[num - i - 1];
5811 buf[pos] = 0;
5813 JimSetStringBytes(objPtr, buf);
5816 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5818 jim_wide wideValue;
5819 const char *str;
5821 if (objPtr->typePtr == &coercedDoubleObjType) {
5822 /* Simple switcheroo */
5823 objPtr->typePtr = &intObjType;
5824 return JIM_OK;
5827 /* Get the string representation */
5828 str = Jim_String(objPtr);
5829 /* Try to convert into a jim_wide */
5830 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5831 if (flags & JIM_ERRMSG) {
5832 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5834 return JIM_ERR;
5836 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5837 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5838 return JIM_ERR;
5840 /* Free the old internal repr and set the new one. */
5841 Jim_FreeIntRep(interp, objPtr);
5842 objPtr->typePtr = &intObjType;
5843 objPtr->internalRep.wideValue = wideValue;
5844 return JIM_OK;
5847 #ifdef JIM_OPTIMIZATION
5848 static int JimIsWide(Jim_Obj *objPtr)
5850 return objPtr->typePtr == &intObjType;
5852 #endif
5854 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5856 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5857 return JIM_ERR;
5858 *widePtr = JimWideValue(objPtr);
5859 return JIM_OK;
5862 /* Get a wide but does not set an error if the format is bad. */
5863 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5865 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5866 return JIM_ERR;
5867 *widePtr = JimWideValue(objPtr);
5868 return JIM_OK;
5871 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5873 jim_wide wideValue;
5874 int retval;
5876 retval = Jim_GetWide(interp, objPtr, &wideValue);
5877 if (retval == JIM_OK) {
5878 *longPtr = (long)wideValue;
5879 return JIM_OK;
5881 return JIM_ERR;
5884 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5886 Jim_Obj *objPtr;
5888 objPtr = Jim_NewObj(interp);
5889 objPtr->typePtr = &intObjType;
5890 objPtr->bytes = NULL;
5891 objPtr->internalRep.wideValue = wideValue;
5892 return objPtr;
5895 /* -----------------------------------------------------------------------------
5896 * Double object
5897 * ---------------------------------------------------------------------------*/
5898 #define JIM_DOUBLE_SPACE 30
5900 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5901 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5903 static const Jim_ObjType doubleObjType = {
5904 "double",
5905 NULL,
5906 NULL,
5907 UpdateStringOfDouble,
5908 JIM_TYPE_NONE,
5911 #ifndef HAVE_ISNAN
5912 #undef isnan
5913 #define isnan(X) ((X) != (X))
5914 #endif
5915 #ifndef HAVE_ISINF
5916 #undef isinf
5917 #define isinf(X) (1.0 / (X) == 0.0)
5918 #endif
5920 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5922 double value = objPtr->internalRep.doubleValue;
5924 if (isnan(value)) {
5925 JimSetStringBytes(objPtr, "NaN");
5926 return;
5928 if (isinf(value)) {
5929 if (value < 0) {
5930 JimSetStringBytes(objPtr, "-Inf");
5932 else {
5933 JimSetStringBytes(objPtr, "Inf");
5935 return;
5938 char buf[JIM_DOUBLE_SPACE + 1];
5939 int i;
5940 int len = sprintf(buf, "%.12g", value);
5942 /* Add a final ".0" if necessary */
5943 for (i = 0; i < len; i++) {
5944 if (buf[i] == '.' || buf[i] == 'e') {
5945 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5946 /* If 'buf' ends in e-0nn or e+0nn, remove
5947 * the 0 after the + or - and reduce the length by 1
5949 char *e = strchr(buf, 'e');
5950 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5951 /* Move it up */
5952 e += 2;
5953 memmove(e, e + 1, len - (e - buf));
5955 #endif
5956 break;
5959 if (buf[i] == '\0') {
5960 buf[i++] = '.';
5961 buf[i++] = '0';
5962 buf[i] = '\0';
5964 JimSetStringBytes(objPtr, buf);
5968 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5970 double doubleValue;
5971 jim_wide wideValue;
5972 const char *str;
5974 /* Preserve the string representation.
5975 * Needed so we can convert back to int without loss
5977 str = Jim_String(objPtr);
5979 #ifdef HAVE_LONG_LONG
5980 /* Assume a 53 bit mantissa */
5981 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5982 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5984 if (objPtr->typePtr == &intObjType
5985 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5986 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5988 /* Direct conversion to coerced double */
5989 objPtr->typePtr = &coercedDoubleObjType;
5990 return JIM_OK;
5992 else
5993 #endif
5994 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5995 /* Managed to convert to an int, so we can use this as a cooerced double */
5996 Jim_FreeIntRep(interp, objPtr);
5997 objPtr->typePtr = &coercedDoubleObjType;
5998 objPtr->internalRep.wideValue = wideValue;
5999 return JIM_OK;
6001 else {
6002 /* Try to convert into a double */
6003 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6004 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
6005 return JIM_ERR;
6007 /* Free the old internal repr and set the new one. */
6008 Jim_FreeIntRep(interp, objPtr);
6010 objPtr->typePtr = &doubleObjType;
6011 objPtr->internalRep.doubleValue = doubleValue;
6012 return JIM_OK;
6015 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6017 if (objPtr->typePtr == &coercedDoubleObjType) {
6018 *doublePtr = JimWideValue(objPtr);
6019 return JIM_OK;
6021 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6022 return JIM_ERR;
6024 if (objPtr->typePtr == &coercedDoubleObjType) {
6025 *doublePtr = JimWideValue(objPtr);
6027 else {
6028 *doublePtr = objPtr->internalRep.doubleValue;
6030 return JIM_OK;
6033 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6035 Jim_Obj *objPtr;
6037 objPtr = Jim_NewObj(interp);
6038 objPtr->typePtr = &doubleObjType;
6039 objPtr->bytes = NULL;
6040 objPtr->internalRep.doubleValue = doubleValue;
6041 return objPtr;
6044 /* -----------------------------------------------------------------------------
6045 * List object
6046 * ---------------------------------------------------------------------------*/
6047 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6048 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6049 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6050 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6051 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6052 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6054 /* Note that while the elements of the list may contain references,
6055 * the list object itself can't. This basically means that the
6056 * list object string representation as a whole can't contain references
6057 * that are not presents in the single elements. */
6058 static const Jim_ObjType listObjType = {
6059 "list",
6060 FreeListInternalRep,
6061 DupListInternalRep,
6062 UpdateStringOfList,
6063 JIM_TYPE_NONE,
6066 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6068 int i;
6070 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6071 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6073 Jim_Free(objPtr->internalRep.listValue.ele);
6076 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6078 int i;
6080 JIM_NOTUSED(interp);
6082 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6083 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6084 dupPtr->internalRep.listValue.ele =
6085 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6086 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6087 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6088 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6089 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6091 dupPtr->typePtr = &listObjType;
6094 /* The following function checks if a given string can be encoded
6095 * into a list element without any kind of quoting, surrounded by braces,
6096 * or using escapes to quote. */
6097 #define JIM_ELESTR_SIMPLE 0
6098 #define JIM_ELESTR_BRACE 1
6099 #define JIM_ELESTR_QUOTE 2
6100 static unsigned char ListElementQuotingType(const char *s, int len)
6102 int i, level, blevel, trySimple = 1;
6104 /* Try with the SIMPLE case */
6105 if (len == 0)
6106 return JIM_ELESTR_BRACE;
6107 if (s[0] == '"' || s[0] == '{') {
6108 trySimple = 0;
6109 goto testbrace;
6111 for (i = 0; i < len; i++) {
6112 switch (s[i]) {
6113 case ' ':
6114 case '$':
6115 case '"':
6116 case '[':
6117 case ']':
6118 case ';':
6119 case '\\':
6120 case '\r':
6121 case '\n':
6122 case '\t':
6123 case '\f':
6124 case '\v':
6125 trySimple = 0;
6126 case '{':
6127 case '}':
6128 goto testbrace;
6131 return JIM_ELESTR_SIMPLE;
6133 testbrace:
6134 /* Test if it's possible to do with braces */
6135 if (s[len - 1] == '\\')
6136 return JIM_ELESTR_QUOTE;
6137 level = 0;
6138 blevel = 0;
6139 for (i = 0; i < len; i++) {
6140 switch (s[i]) {
6141 case '{':
6142 level++;
6143 break;
6144 case '}':
6145 level--;
6146 if (level < 0)
6147 return JIM_ELESTR_QUOTE;
6148 break;
6149 case '[':
6150 blevel++;
6151 break;
6152 case ']':
6153 blevel--;
6154 break;
6155 case '\\':
6156 if (s[i + 1] == '\n')
6157 return JIM_ELESTR_QUOTE;
6158 else if (s[i + 1] != '\0')
6159 i++;
6160 break;
6163 if (blevel < 0) {
6164 return JIM_ELESTR_QUOTE;
6167 if (level == 0) {
6168 if (!trySimple)
6169 return JIM_ELESTR_BRACE;
6170 for (i = 0; i < len; i++) {
6171 switch (s[i]) {
6172 case ' ':
6173 case '$':
6174 case '"':
6175 case '[':
6176 case ']':
6177 case ';':
6178 case '\\':
6179 case '\r':
6180 case '\n':
6181 case '\t':
6182 case '\f':
6183 case '\v':
6184 return JIM_ELESTR_BRACE;
6185 break;
6188 return JIM_ELESTR_SIMPLE;
6190 return JIM_ELESTR_QUOTE;
6193 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6194 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6195 * scenario.
6196 * Returns the length of the result.
6198 static int BackslashQuoteString(const char *s, int len, char *q)
6200 char *p = q;
6202 while (len--) {
6203 switch (*s) {
6204 case ' ':
6205 case '$':
6206 case '"':
6207 case '[':
6208 case ']':
6209 case '{':
6210 case '}':
6211 case ';':
6212 case '\\':
6213 *p++ = '\\';
6214 *p++ = *s++;
6215 break;
6216 case '\n':
6217 *p++ = '\\';
6218 *p++ = 'n';
6219 s++;
6220 break;
6221 case '\r':
6222 *p++ = '\\';
6223 *p++ = 'r';
6224 s++;
6225 break;
6226 case '\t':
6227 *p++ = '\\';
6228 *p++ = 't';
6229 s++;
6230 break;
6231 case '\f':
6232 *p++ = '\\';
6233 *p++ = 'f';
6234 s++;
6235 break;
6236 case '\v':
6237 *p++ = '\\';
6238 *p++ = 'v';
6239 s++;
6240 break;
6241 default:
6242 *p++ = *s++;
6243 break;
6246 *p = '\0';
6248 return p - q;
6251 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6253 #define STATIC_QUOTING_LEN 32
6254 int i, bufLen, realLength;
6255 const char *strRep;
6256 char *p;
6257 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6259 /* Estimate the space needed. */
6260 if (objc > STATIC_QUOTING_LEN) {
6261 quotingType = Jim_Alloc(objc);
6263 else {
6264 quotingType = staticQuoting;
6266 bufLen = 0;
6267 for (i = 0; i < objc; i++) {
6268 int len;
6270 strRep = Jim_GetString(objv[i], &len);
6271 quotingType[i] = ListElementQuotingType(strRep, len);
6272 switch (quotingType[i]) {
6273 case JIM_ELESTR_SIMPLE:
6274 if (i != 0 || strRep[0] != '#') {
6275 bufLen += len;
6276 break;
6278 /* Special case '#' on first element needs braces */
6279 quotingType[i] = JIM_ELESTR_BRACE;
6280 /* fall through */
6281 case JIM_ELESTR_BRACE:
6282 bufLen += len + 2;
6283 break;
6284 case JIM_ELESTR_QUOTE:
6285 bufLen += len * 2;
6286 break;
6288 bufLen++; /* elements separator. */
6290 bufLen++;
6292 /* Generate the string rep. */
6293 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6294 realLength = 0;
6295 for (i = 0; i < objc; i++) {
6296 int len, qlen;
6298 strRep = Jim_GetString(objv[i], &len);
6300 switch (quotingType[i]) {
6301 case JIM_ELESTR_SIMPLE:
6302 memcpy(p, strRep, len);
6303 p += len;
6304 realLength += len;
6305 break;
6306 case JIM_ELESTR_BRACE:
6307 *p++ = '{';
6308 memcpy(p, strRep, len);
6309 p += len;
6310 *p++ = '}';
6311 realLength += len + 2;
6312 break;
6313 case JIM_ELESTR_QUOTE:
6314 if (i == 0 && strRep[0] == '#') {
6315 *p++ = '\\';
6316 realLength++;
6318 qlen = BackslashQuoteString(strRep, len, p);
6319 p += qlen;
6320 realLength += qlen;
6321 break;
6323 /* Add a separating space */
6324 if (i + 1 != objc) {
6325 *p++ = ' ';
6326 realLength++;
6329 *p = '\0'; /* nul term. */
6330 objPtr->length = realLength;
6332 if (quotingType != staticQuoting) {
6333 Jim_Free(quotingType);
6337 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6339 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6342 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6344 struct JimParserCtx parser;
6345 const char *str;
6346 int strLen;
6347 Jim_Obj *fileNameObj;
6348 int linenr;
6350 if (objPtr->typePtr == &listObjType) {
6351 return JIM_OK;
6354 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6355 * it also preserves any source location of the dict elements
6356 * which can be very useful
6358 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6359 Jim_Obj **listObjPtrPtr;
6360 int len;
6361 int i;
6363 listObjPtrPtr = JimDictPairs(objPtr, &len);
6364 for (i = 0; i < len; i++) {
6365 Jim_IncrRefCount(listObjPtrPtr[i]);
6368 /* Now just switch the internal rep */
6369 Jim_FreeIntRep(interp, objPtr);
6370 objPtr->typePtr = &listObjType;
6371 objPtr->internalRep.listValue.len = len;
6372 objPtr->internalRep.listValue.maxLen = len;
6373 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6375 return JIM_OK;
6378 /* Try to preserve information about filename / line number */
6379 if (objPtr->typePtr == &sourceObjType) {
6380 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6381 linenr = objPtr->internalRep.sourceValue.lineNumber;
6383 else {
6384 fileNameObj = interp->emptyObj;
6385 linenr = 1;
6387 Jim_IncrRefCount(fileNameObj);
6389 /* Get the string representation */
6390 str = Jim_GetString(objPtr, &strLen);
6392 /* Free the old internal repr just now and initialize the
6393 * new one just now. The string->list conversion can't fail. */
6394 Jim_FreeIntRep(interp, objPtr);
6395 objPtr->typePtr = &listObjType;
6396 objPtr->internalRep.listValue.len = 0;
6397 objPtr->internalRep.listValue.maxLen = 0;
6398 objPtr->internalRep.listValue.ele = NULL;
6400 /* Convert into a list */
6401 if (strLen) {
6402 JimParserInit(&parser, str, strLen, linenr);
6403 while (!parser.eof) {
6404 Jim_Obj *elementPtr;
6406 JimParseList(&parser);
6407 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6408 continue;
6409 elementPtr = JimParserGetTokenObj(interp, &parser);
6410 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6411 ListAppendElement(objPtr, elementPtr);
6414 Jim_DecrRefCount(interp, fileNameObj);
6415 return JIM_OK;
6418 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6420 Jim_Obj *objPtr;
6422 objPtr = Jim_NewObj(interp);
6423 objPtr->typePtr = &listObjType;
6424 objPtr->bytes = NULL;
6425 objPtr->internalRep.listValue.ele = NULL;
6426 objPtr->internalRep.listValue.len = 0;
6427 objPtr->internalRep.listValue.maxLen = 0;
6429 if (len) {
6430 ListInsertElements(objPtr, 0, len, elements);
6433 return objPtr;
6436 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6437 * length of the vector. Note that the user of this function should make
6438 * sure that the list object can't shimmer while the vector returned
6439 * is in use, this vector is the one stored inside the internal representation
6440 * of the list object. This function is not exported, extensions should
6441 * always access to the List object elements using Jim_ListIndex(). */
6442 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6443 Jim_Obj ***listVec)
6445 *listLen = Jim_ListLength(interp, listObj);
6446 *listVec = listObj->internalRep.listValue.ele;
6449 /* Sorting uses ints, but commands may return wide */
6450 static int JimSign(jim_wide w)
6452 if (w == 0) {
6453 return 0;
6455 else if (w < 0) {
6456 return -1;
6458 return 1;
6461 /* ListSortElements type values */
6462 struct lsort_info {
6463 jmp_buf jmpbuf;
6464 Jim_Obj *command;
6465 Jim_Interp *interp;
6466 enum {
6467 JIM_LSORT_ASCII,
6468 JIM_LSORT_NOCASE,
6469 JIM_LSORT_INTEGER,
6470 JIM_LSORT_REAL,
6471 JIM_LSORT_COMMAND
6472 } type;
6473 int order;
6474 int index;
6475 int indexed;
6476 int unique;
6477 int (*subfn)(Jim_Obj **, Jim_Obj **);
6480 static struct lsort_info *sort_info;
6482 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6484 Jim_Obj *lObj, *rObj;
6486 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6487 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6488 longjmp(sort_info->jmpbuf, JIM_ERR);
6490 return sort_info->subfn(&lObj, &rObj);
6493 /* Sort the internal rep of a list. */
6494 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6496 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6499 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6501 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6504 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6506 jim_wide lhs = 0, rhs = 0;
6508 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6509 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6510 longjmp(sort_info->jmpbuf, JIM_ERR);
6513 return JimSign(lhs - rhs) * sort_info->order;
6516 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6518 double lhs = 0, rhs = 0;
6520 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6521 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6522 longjmp(sort_info->jmpbuf, JIM_ERR);
6524 if (lhs == rhs) {
6525 return 0;
6527 if (lhs > rhs) {
6528 return sort_info->order;
6530 return -sort_info->order;
6533 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6535 Jim_Obj *compare_script;
6536 int rc;
6538 jim_wide ret = 0;
6540 /* This must be a valid list */
6541 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6542 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6543 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6545 rc = Jim_EvalObj(sort_info->interp, compare_script);
6547 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6548 longjmp(sort_info->jmpbuf, rc);
6551 return JimSign(ret) * sort_info->order;
6554 /* Remove duplicate elements from the (sorted) list in-place, according to the
6555 * comparison function, comp.
6557 * Note that the last unique value is kept, not the first
6559 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6561 int src;
6562 int dst = 0;
6563 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6565 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6566 if (comp(&ele[dst], &ele[src]) == 0) {
6567 /* Match, so replace the dest with the current source */
6568 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6570 else {
6571 /* No match, so keep the current source and move to the next destination */
6572 dst++;
6574 ele[dst] = ele[src];
6576 /* At end of list, keep the final element */
6577 ele[++dst] = ele[src];
6579 /* Set the new length */
6580 listObjPtr->internalRep.listValue.len = dst;
6583 /* Sort a list *in place*. MUST be called with a non-shared list. */
6584 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6586 struct lsort_info *prev_info;
6588 typedef int (qsort_comparator) (const void *, const void *);
6589 int (*fn) (Jim_Obj **, Jim_Obj **);
6590 Jim_Obj **vector;
6591 int len;
6592 int rc;
6594 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6595 SetListFromAny(interp, listObjPtr);
6597 /* Allow lsort to be called reentrantly */
6598 prev_info = sort_info;
6599 sort_info = info;
6601 vector = listObjPtr->internalRep.listValue.ele;
6602 len = listObjPtr->internalRep.listValue.len;
6603 switch (info->type) {
6604 case JIM_LSORT_ASCII:
6605 fn = ListSortString;
6606 break;
6607 case JIM_LSORT_NOCASE:
6608 fn = ListSortStringNoCase;
6609 break;
6610 case JIM_LSORT_INTEGER:
6611 fn = ListSortInteger;
6612 break;
6613 case JIM_LSORT_REAL:
6614 fn = ListSortReal;
6615 break;
6616 case JIM_LSORT_COMMAND:
6617 fn = ListSortCommand;
6618 break;
6619 default:
6620 fn = NULL; /* avoid warning */
6621 JimPanic((1, "ListSort called with invalid sort type"));
6624 if (info->indexed) {
6625 /* Need to interpose a "list index" function */
6626 info->subfn = fn;
6627 fn = ListSortIndexHelper;
6630 if ((rc = setjmp(info->jmpbuf)) == 0) {
6631 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6633 if (info->unique && len > 1) {
6634 ListRemoveDuplicates(listObjPtr, fn);
6637 Jim_InvalidateStringRep(listObjPtr);
6639 sort_info = prev_info;
6641 return rc;
6644 /* This is the low-level function to insert elements into a list.
6645 * The higher-level Jim_ListInsertElements() performs shared object
6646 * check and invalidates the string repr. This version is used
6647 * in the internals of the List Object and is not exported.
6649 * NOTE: this function can be called only against objects
6650 * with internal type of List.
6652 * An insertion point (idx) of -1 means end-of-list.
6654 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6656 int currentLen = listPtr->internalRep.listValue.len;
6657 int requiredLen = currentLen + elemc;
6658 int i;
6659 Jim_Obj **point;
6661 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6662 if (requiredLen < 2) {
6663 /* Don't do allocations of under 4 pointers. */
6664 requiredLen = 4;
6666 else {
6667 requiredLen *= 2;
6670 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6671 sizeof(Jim_Obj *) * requiredLen);
6673 listPtr->internalRep.listValue.maxLen = requiredLen;
6675 if (idx < 0) {
6676 idx = currentLen;
6678 point = listPtr->internalRep.listValue.ele + idx;
6679 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6680 for (i = 0; i < elemc; ++i) {
6681 point[i] = elemVec[i];
6682 Jim_IncrRefCount(point[i]);
6684 listPtr->internalRep.listValue.len += elemc;
6687 /* Convenience call to ListInsertElements() to append a single element.
6689 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6691 ListInsertElements(listPtr, -1, 1, &objPtr);
6694 /* Appends every element of appendListPtr into listPtr.
6695 * Both have to be of the list type.
6696 * Convenience call to ListInsertElements()
6698 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6700 ListInsertElements(listPtr, -1,
6701 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6704 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6706 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6707 SetListFromAny(interp, listPtr);
6708 Jim_InvalidateStringRep(listPtr);
6709 ListAppendElement(listPtr, objPtr);
6712 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6714 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6715 SetListFromAny(interp, listPtr);
6716 SetListFromAny(interp, appendListPtr);
6717 Jim_InvalidateStringRep(listPtr);
6718 ListAppendList(listPtr, appendListPtr);
6721 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6723 SetListFromAny(interp, objPtr);
6724 return objPtr->internalRep.listValue.len;
6727 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6728 int objc, Jim_Obj *const *objVec)
6730 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6731 SetListFromAny(interp, listPtr);
6732 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6733 idx = listPtr->internalRep.listValue.len;
6734 else if (idx < 0)
6735 idx = 0;
6736 Jim_InvalidateStringRep(listPtr);
6737 ListInsertElements(listPtr, idx, objc, objVec);
6740 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6742 SetListFromAny(interp, listPtr);
6743 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6744 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6745 return NULL;
6747 if (idx < 0)
6748 idx = listPtr->internalRep.listValue.len + idx;
6749 return listPtr->internalRep.listValue.ele[idx];
6752 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6754 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6755 if (*objPtrPtr == NULL) {
6756 if (flags & JIM_ERRMSG) {
6757 Jim_SetResultString(interp, "list index out of range", -1);
6759 return JIM_ERR;
6761 return JIM_OK;
6764 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6765 Jim_Obj *newObjPtr, int flags)
6767 SetListFromAny(interp, listPtr);
6768 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6769 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6770 if (flags & JIM_ERRMSG) {
6771 Jim_SetResultString(interp, "list index out of range", -1);
6773 return JIM_ERR;
6775 if (idx < 0)
6776 idx = listPtr->internalRep.listValue.len + idx;
6777 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6778 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6779 Jim_IncrRefCount(newObjPtr);
6780 return JIM_OK;
6783 /* Modify the list stored in the variable named 'varNamePtr'
6784 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6785 * with the new element 'newObjptr'. (implements the [lset] command) */
6786 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6787 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6789 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6790 int shared, i, idx;
6792 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6793 if (objPtr == NULL)
6794 return JIM_ERR;
6795 if ((shared = Jim_IsShared(objPtr)))
6796 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6797 for (i = 0; i < indexc - 1; i++) {
6798 listObjPtr = objPtr;
6799 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6800 goto err;
6801 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6802 goto err;
6804 if (Jim_IsShared(objPtr)) {
6805 objPtr = Jim_DuplicateObj(interp, objPtr);
6806 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6808 Jim_InvalidateStringRep(listObjPtr);
6810 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6811 goto err;
6812 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6813 goto err;
6814 Jim_InvalidateStringRep(objPtr);
6815 Jim_InvalidateStringRep(varObjPtr);
6816 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6817 goto err;
6818 Jim_SetResult(interp, varObjPtr);
6819 return JIM_OK;
6820 err:
6821 if (shared) {
6822 Jim_FreeNewObj(interp, varObjPtr);
6824 return JIM_ERR;
6827 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6829 int i;
6830 int listLen = Jim_ListLength(interp, listObjPtr);
6831 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6833 for (i = 0; i < listLen; ) {
6834 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6835 if (++i != listLen) {
6836 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6839 return resObjPtr;
6842 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6844 int i;
6846 /* If all the objects in objv are lists,
6847 * it's possible to return a list as result, that's the
6848 * concatenation of all the lists. */
6849 for (i = 0; i < objc; i++) {
6850 if (!Jim_IsList(objv[i]))
6851 break;
6853 if (i == objc) {
6854 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6856 for (i = 0; i < objc; i++)
6857 ListAppendList(objPtr, objv[i]);
6858 return objPtr;
6860 else {
6861 /* Else... we have to glue strings together */
6862 int len = 0, objLen;
6863 char *bytes, *p;
6865 /* Compute the length */
6866 for (i = 0; i < objc; i++) {
6867 len += Jim_Length(objv[i]);
6869 if (objc)
6870 len += objc - 1;
6871 /* Create the string rep, and a string object holding it. */
6872 p = bytes = Jim_Alloc(len + 1);
6873 for (i = 0; i < objc; i++) {
6874 const char *s = Jim_GetString(objv[i], &objLen);
6876 /* Remove leading space */
6877 while (objLen && isspace(UCHAR(*s))) {
6878 s++;
6879 objLen--;
6880 len--;
6882 /* And trailing space */
6883 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6884 /* Handle trailing backslash-space case */
6885 if (objLen > 1 && s[objLen - 2] == '\\') {
6886 break;
6888 objLen--;
6889 len--;
6891 memcpy(p, s, objLen);
6892 p += objLen;
6893 if (i + 1 != objc) {
6894 if (objLen)
6895 *p++ = ' ';
6896 else {
6897 /* Drop the space calcuated for this
6898 * element that is instead null. */
6899 len--;
6903 *p = '\0';
6904 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6908 /* Returns a list composed of the elements in the specified range.
6909 * first and start are directly accepted as Jim_Objects and
6910 * processed for the end?-index? case. */
6911 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6912 Jim_Obj *lastObjPtr)
6914 int first, last;
6915 int len, rangeLen;
6917 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6918 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6919 return NULL;
6920 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6921 first = JimRelToAbsIndex(len, first);
6922 last = JimRelToAbsIndex(len, last);
6923 JimRelToAbsRange(len, &first, &last, &rangeLen);
6924 if (first == 0 && last == len) {
6925 return listObjPtr;
6927 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6930 /* -----------------------------------------------------------------------------
6931 * Dict object
6932 * ---------------------------------------------------------------------------*/
6933 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6934 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6935 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6936 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6938 /* Dict HashTable Type.
6940 * Keys and Values are Jim objects. */
6942 static unsigned int JimObjectHTHashFunction(const void *key)
6944 int len;
6945 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6946 return Jim_GenHashFunction((const unsigned char *)str, len);
6949 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6951 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6954 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6956 Jim_IncrRefCount((Jim_Obj *)val);
6957 return (void *)val;
6960 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6962 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6965 static const Jim_HashTableType JimDictHashTableType = {
6966 JimObjectHTHashFunction, /* hash function */
6967 JimObjectHTKeyValDup, /* key dup */
6968 JimObjectHTKeyValDup, /* val dup */
6969 JimObjectHTKeyCompare, /* key compare */
6970 JimObjectHTKeyValDestructor, /* key destructor */
6971 JimObjectHTKeyValDestructor /* val destructor */
6974 /* Note that while the elements of the dict may contain references,
6975 * the list object itself can't. This basically means that the
6976 * dict object string representation as a whole can't contain references
6977 * that are not presents in the single elements. */
6978 static const Jim_ObjType dictObjType = {
6979 "dict",
6980 FreeDictInternalRep,
6981 DupDictInternalRep,
6982 UpdateStringOfDict,
6983 JIM_TYPE_NONE,
6986 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6988 JIM_NOTUSED(interp);
6990 Jim_FreeHashTable(objPtr->internalRep.ptr);
6991 Jim_Free(objPtr->internalRep.ptr);
6994 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6996 Jim_HashTable *ht, *dupHt;
6997 Jim_HashTableIterator htiter;
6998 Jim_HashEntry *he;
7000 /* Create a new hash table */
7001 ht = srcPtr->internalRep.ptr;
7002 dupHt = Jim_Alloc(sizeof(*dupHt));
7003 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7004 if (ht->size != 0)
7005 Jim_ExpandHashTable(dupHt, ht->size);
7006 /* Copy every element from the source to the dup hash table */
7007 JimInitHashTableIterator(ht, &htiter);
7008 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7009 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7012 dupPtr->internalRep.ptr = dupHt;
7013 dupPtr->typePtr = &dictObjType;
7016 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7018 Jim_HashTable *ht;
7019 Jim_HashTableIterator htiter;
7020 Jim_HashEntry *he;
7021 Jim_Obj **objv;
7022 int i;
7024 ht = dictPtr->internalRep.ptr;
7026 /* Turn the hash table into a flat vector of Jim_Objects. */
7027 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7028 JimInitHashTableIterator(ht, &htiter);
7029 i = 0;
7030 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7031 objv[i++] = Jim_GetHashEntryKey(he);
7032 objv[i++] = Jim_GetHashEntryVal(he);
7034 *len = i;
7035 return objv;
7038 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7040 /* Turn the hash table into a flat vector of Jim_Objects. */
7041 int len;
7042 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7044 /* And now generate the string rep as a list */
7045 JimMakeListStringRep(objPtr, objv, len);
7047 Jim_Free(objv);
7050 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7052 int listlen;
7054 if (objPtr->typePtr == &dictObjType) {
7055 return JIM_OK;
7058 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7059 /* A shared list, so get the string representation now to avoid
7060 * changing the order in case of fast conversion to dict.
7062 Jim_String(objPtr);
7065 /* For simplicity, convert a non-list object to a list and then to a dict */
7066 listlen = Jim_ListLength(interp, objPtr);
7067 if (listlen % 2) {
7068 Jim_SetResultString(interp, "missing value to go with key", -1);
7069 return JIM_ERR;
7071 else {
7072 /* Converting from a list to a dict can't fail */
7073 Jim_HashTable *ht;
7074 int i;
7076 ht = Jim_Alloc(sizeof(*ht));
7077 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7079 for (i = 0; i < listlen; i += 2) {
7080 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7081 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7083 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7086 Jim_FreeIntRep(interp, objPtr);
7087 objPtr->typePtr = &dictObjType;
7088 objPtr->internalRep.ptr = ht;
7090 return JIM_OK;
7094 /* Dict object API */
7096 /* Add an element to a dict. objPtr must be of the "dict" type.
7097 * The higer-level exported function is Jim_DictAddElement().
7098 * If an element with the specified key already exists, the value
7099 * associated is replaced with the new one.
7101 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7102 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7103 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7105 Jim_HashTable *ht = objPtr->internalRep.ptr;
7107 if (valueObjPtr == NULL) { /* unset */
7108 return Jim_DeleteHashEntry(ht, keyObjPtr);
7110 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7111 return JIM_OK;
7114 /* Add an element, higher-level interface for DictAddElement().
7115 * If valueObjPtr == NULL, the key is removed if it exists. */
7116 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7117 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7119 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7120 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7121 return JIM_ERR;
7123 Jim_InvalidateStringRep(objPtr);
7124 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7127 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7129 Jim_Obj *objPtr;
7130 int i;
7132 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7134 objPtr = Jim_NewObj(interp);
7135 objPtr->typePtr = &dictObjType;
7136 objPtr->bytes = NULL;
7137 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7138 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7139 for (i = 0; i < len; i += 2)
7140 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7141 return objPtr;
7144 /* Return the value associated to the specified dict key
7145 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7147 * Sets *objPtrPtr to non-NULL only upon success.
7149 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7150 Jim_Obj **objPtrPtr, int flags)
7152 Jim_HashEntry *he;
7153 Jim_HashTable *ht;
7155 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7156 return -1;
7158 ht = dictPtr->internalRep.ptr;
7159 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7160 if (flags & JIM_ERRMSG) {
7161 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7163 return JIM_ERR;
7165 *objPtrPtr = he->u.val;
7166 return JIM_OK;
7169 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7170 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7172 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7173 return JIM_ERR;
7175 *objPtrPtr = JimDictPairs(dictPtr, len);
7177 return JIM_OK;
7181 /* Return the value associated to the specified dict keys */
7182 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7183 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7185 int i;
7187 if (keyc == 0) {
7188 *objPtrPtr = dictPtr;
7189 return JIM_OK;
7192 for (i = 0; i < keyc; i++) {
7193 Jim_Obj *objPtr;
7195 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7196 if (rc != JIM_OK) {
7197 return rc;
7199 dictPtr = objPtr;
7201 *objPtrPtr = dictPtr;
7202 return JIM_OK;
7205 /* Modify the dict stored into the variable named 'varNamePtr'
7206 * setting the element specified by the 'keyc' keys objects in 'keyv',
7207 * with the new value of the element 'newObjPtr'.
7209 * If newObjPtr == NULL the operation is to remove the given key
7210 * from the dictionary.
7212 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7213 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7215 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7216 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7218 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7219 int shared, i;
7221 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7222 if (objPtr == NULL) {
7223 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7224 /* Cannot remove a key from non existing var */
7225 return JIM_ERR;
7227 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7228 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7229 Jim_FreeNewObj(interp, varObjPtr);
7230 return JIM_ERR;
7233 if ((shared = Jim_IsShared(objPtr)))
7234 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7235 for (i = 0; i < keyc; i++) {
7236 dictObjPtr = objPtr;
7238 /* Check if it's a valid dictionary */
7239 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7240 goto err;
7243 if (i == keyc - 1) {
7244 /* Last key: Note that error on unset with missing last key is OK */
7245 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7246 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7247 goto err;
7250 break;
7253 /* Check if the given key exists. */
7254 Jim_InvalidateStringRep(dictObjPtr);
7255 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7256 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7257 /* This key exists at the current level.
7258 * Make sure it's not shared!. */
7259 if (Jim_IsShared(objPtr)) {
7260 objPtr = Jim_DuplicateObj(interp, objPtr);
7261 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7264 else {
7265 /* Key not found. If it's an [unset] operation
7266 * this is an error. Only the last key may not
7267 * exist. */
7268 if (newObjPtr == NULL) {
7269 goto err;
7271 /* Otherwise set an empty dictionary
7272 * as key's value. */
7273 objPtr = Jim_NewDictObj(interp, NULL, 0);
7274 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7277 /* XXX: Is this necessary? */
7278 Jim_InvalidateStringRep(objPtr);
7279 Jim_InvalidateStringRep(varObjPtr);
7280 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7281 goto err;
7283 Jim_SetResult(interp, varObjPtr);
7284 return JIM_OK;
7285 err:
7286 if (shared) {
7287 Jim_FreeNewObj(interp, varObjPtr);
7289 return JIM_ERR;
7292 /* -----------------------------------------------------------------------------
7293 * Index object
7294 * ---------------------------------------------------------------------------*/
7295 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7296 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7298 static const Jim_ObjType indexObjType = {
7299 "index",
7300 NULL,
7301 NULL,
7302 UpdateStringOfIndex,
7303 JIM_TYPE_NONE,
7306 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7308 if (objPtr->internalRep.intValue == -1) {
7309 JimSetStringBytes(objPtr, "end");
7311 else {
7312 char buf[JIM_INTEGER_SPACE + 1];
7313 if (objPtr->internalRep.intValue >= 0) {
7314 sprintf(buf, "%d", objPtr->internalRep.intValue);
7316 else {
7317 /* Must be <= -2 */
7318 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7320 JimSetStringBytes(objPtr, buf);
7324 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7326 int idx, end = 0;
7327 const char *str;
7328 char *endptr;
7330 /* Get the string representation */
7331 str = Jim_String(objPtr);
7333 /* Try to convert into an index */
7334 if (strncmp(str, "end", 3) == 0) {
7335 end = 1;
7336 str += 3;
7337 idx = 0;
7339 else {
7340 idx = jim_strtol(str, &endptr);
7342 if (endptr == str) {
7343 goto badindex;
7345 str = endptr;
7348 /* Now str may include or +<num> or -<num> */
7349 if (*str == '+' || *str == '-') {
7350 int sign = (*str == '+' ? 1 : -1);
7352 idx += sign * jim_strtol(++str, &endptr);
7353 if (str == endptr || *endptr) {
7354 goto badindex;
7356 str = endptr;
7358 /* The only thing left should be spaces */
7359 while (isspace(UCHAR(*str))) {
7360 str++;
7362 if (*str) {
7363 goto badindex;
7365 if (end) {
7366 if (idx > 0) {
7367 idx = INT_MAX;
7369 else {
7370 /* end-1 is repesented as -2 */
7371 idx--;
7374 else if (idx < 0) {
7375 idx = -INT_MAX;
7378 /* Free the old internal repr and set the new one. */
7379 Jim_FreeIntRep(interp, objPtr);
7380 objPtr->typePtr = &indexObjType;
7381 objPtr->internalRep.intValue = idx;
7382 return JIM_OK;
7384 badindex:
7385 Jim_SetResultFormatted(interp,
7386 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7387 return JIM_ERR;
7390 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7392 /* Avoid shimmering if the object is an integer. */
7393 if (objPtr->typePtr == &intObjType) {
7394 jim_wide val = JimWideValue(objPtr);
7396 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7397 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7398 return JIM_OK;
7401 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7402 return JIM_ERR;
7403 *indexPtr = objPtr->internalRep.intValue;
7404 return JIM_OK;
7407 /* -----------------------------------------------------------------------------
7408 * Return Code Object.
7409 * ---------------------------------------------------------------------------*/
7411 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7412 static const char * const jimReturnCodes[] = {
7413 "ok",
7414 "error",
7415 "return",
7416 "break",
7417 "continue",
7418 "signal",
7419 "exit",
7420 "eval",
7421 NULL
7424 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7426 static const Jim_ObjType returnCodeObjType = {
7427 "return-code",
7428 NULL,
7429 NULL,
7430 NULL,
7431 JIM_TYPE_NONE,
7434 /* Converts a (standard) return code to a string. Returns "?" for
7435 * non-standard return codes.
7437 const char *Jim_ReturnCode(int code)
7439 if (code < 0 || code >= (int)jimReturnCodesSize) {
7440 return "?";
7442 else {
7443 return jimReturnCodes[code];
7447 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7449 int returnCode;
7450 jim_wide wideValue;
7452 /* Try to convert into an integer */
7453 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7454 returnCode = (int)wideValue;
7455 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7456 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7457 return JIM_ERR;
7459 /* Free the old internal repr and set the new one. */
7460 Jim_FreeIntRep(interp, objPtr);
7461 objPtr->typePtr = &returnCodeObjType;
7462 objPtr->internalRep.intValue = returnCode;
7463 return JIM_OK;
7466 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7468 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7469 return JIM_ERR;
7470 *intPtr = objPtr->internalRep.intValue;
7471 return JIM_OK;
7474 /* -----------------------------------------------------------------------------
7475 * Expression Parsing
7476 * ---------------------------------------------------------------------------*/
7477 static int JimParseExprOperator(struct JimParserCtx *pc);
7478 static int JimParseExprNumber(struct JimParserCtx *pc);
7479 static int JimParseExprIrrational(struct JimParserCtx *pc);
7481 /* Exrp's Stack machine operators opcodes. */
7483 /* Binary operators (numbers) */
7484 enum
7486 /* Continues on from the JIM_TT_ space */
7487 /* Operations */
7488 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7489 JIM_EXPROP_DIV,
7490 JIM_EXPROP_MOD,
7491 JIM_EXPROP_SUB,
7492 JIM_EXPROP_ADD,
7493 JIM_EXPROP_LSHIFT,
7494 JIM_EXPROP_RSHIFT,
7495 JIM_EXPROP_ROTL,
7496 JIM_EXPROP_ROTR,
7497 JIM_EXPROP_LT,
7498 JIM_EXPROP_GT,
7499 JIM_EXPROP_LTE,
7500 JIM_EXPROP_GTE,
7501 JIM_EXPROP_NUMEQ,
7502 JIM_EXPROP_NUMNE,
7503 JIM_EXPROP_BITAND, /* 35 */
7504 JIM_EXPROP_BITXOR,
7505 JIM_EXPROP_BITOR,
7507 /* Note must keep these together */
7508 JIM_EXPROP_LOGICAND, /* 38 */
7509 JIM_EXPROP_LOGICAND_LEFT,
7510 JIM_EXPROP_LOGICAND_RIGHT,
7512 /* and these */
7513 JIM_EXPROP_LOGICOR, /* 41 */
7514 JIM_EXPROP_LOGICOR_LEFT,
7515 JIM_EXPROP_LOGICOR_RIGHT,
7517 /* and these */
7518 /* Ternary operators */
7519 JIM_EXPROP_TERNARY, /* 44 */
7520 JIM_EXPROP_TERNARY_LEFT,
7521 JIM_EXPROP_TERNARY_RIGHT,
7523 /* and these */
7524 JIM_EXPROP_COLON, /* 47 */
7525 JIM_EXPROP_COLON_LEFT,
7526 JIM_EXPROP_COLON_RIGHT,
7528 JIM_EXPROP_POW, /* 50 */
7530 /* Binary operators (strings) */
7531 JIM_EXPROP_STREQ, /* 51 */
7532 JIM_EXPROP_STRNE,
7533 JIM_EXPROP_STRIN,
7534 JIM_EXPROP_STRNI,
7536 /* Unary operators (numbers) */
7537 JIM_EXPROP_NOT, /* 55 */
7538 JIM_EXPROP_BITNOT,
7539 JIM_EXPROP_UNARYMINUS,
7540 JIM_EXPROP_UNARYPLUS,
7542 /* Functions */
7543 JIM_EXPROP_FUNC_FIRST, /* 59 */
7544 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7545 JIM_EXPROP_FUNC_ABS,
7546 JIM_EXPROP_FUNC_DOUBLE,
7547 JIM_EXPROP_FUNC_ROUND,
7548 JIM_EXPROP_FUNC_RAND,
7549 JIM_EXPROP_FUNC_SRAND,
7551 /* math functions from libm */
7552 JIM_EXPROP_FUNC_SIN, /* 64 */
7553 JIM_EXPROP_FUNC_COS,
7554 JIM_EXPROP_FUNC_TAN,
7555 JIM_EXPROP_FUNC_ASIN,
7556 JIM_EXPROP_FUNC_ACOS,
7557 JIM_EXPROP_FUNC_ATAN,
7558 JIM_EXPROP_FUNC_SINH,
7559 JIM_EXPROP_FUNC_COSH,
7560 JIM_EXPROP_FUNC_TANH,
7561 JIM_EXPROP_FUNC_CEIL,
7562 JIM_EXPROP_FUNC_FLOOR,
7563 JIM_EXPROP_FUNC_EXP,
7564 JIM_EXPROP_FUNC_LOG,
7565 JIM_EXPROP_FUNC_LOG10,
7566 JIM_EXPROP_FUNC_SQRT,
7567 JIM_EXPROP_FUNC_POW,
7570 struct JimExprState
7572 Jim_Obj **stack;
7573 int stacklen;
7574 int opcode;
7575 int skip;
7578 /* Operators table */
7579 typedef struct Jim_ExprOperator
7581 const char *name;
7582 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7583 unsigned char precedence;
7584 unsigned char arity;
7585 unsigned char lazy;
7586 unsigned char namelen;
7587 } Jim_ExprOperator;
7589 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7591 Jim_IncrRefCount(obj);
7592 e->stack[e->stacklen++] = obj;
7595 static Jim_Obj *ExprPop(struct JimExprState *e)
7597 return e->stack[--e->stacklen];
7600 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7602 int intresult = 1;
7603 int rc = JIM_OK;
7604 Jim_Obj *A = ExprPop(e);
7605 double dA, dC = 0;
7606 jim_wide wA, wC = 0;
7608 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7609 switch (e->opcode) {
7610 case JIM_EXPROP_FUNC_INT:
7611 case JIM_EXPROP_FUNC_ROUND:
7612 case JIM_EXPROP_UNARYPLUS:
7613 wC = wA;
7614 break;
7615 case JIM_EXPROP_FUNC_DOUBLE:
7616 dC = wA;
7617 intresult = 0;
7618 break;
7619 case JIM_EXPROP_FUNC_ABS:
7620 wC = wA >= 0 ? wA : -wA;
7621 break;
7622 case JIM_EXPROP_UNARYMINUS:
7623 wC = -wA;
7624 break;
7625 case JIM_EXPROP_NOT:
7626 wC = !wA;
7627 break;
7628 default:
7629 abort();
7632 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7633 switch (e->opcode) {
7634 case JIM_EXPROP_FUNC_INT:
7635 wC = dA;
7636 break;
7637 case JIM_EXPROP_FUNC_ROUND:
7638 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7639 break;
7640 case JIM_EXPROP_FUNC_DOUBLE:
7641 case JIM_EXPROP_UNARYPLUS:
7642 dC = dA;
7643 intresult = 0;
7644 break;
7645 case JIM_EXPROP_FUNC_ABS:
7646 dC = dA >= 0 ? dA : -dA;
7647 intresult = 0;
7648 break;
7649 case JIM_EXPROP_UNARYMINUS:
7650 dC = -dA;
7651 intresult = 0;
7652 break;
7653 case JIM_EXPROP_NOT:
7654 wC = !dA;
7655 break;
7656 default:
7657 abort();
7661 if (rc == JIM_OK) {
7662 if (intresult) {
7663 ExprPush(e, Jim_NewIntObj(interp, wC));
7665 else {
7666 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7670 Jim_DecrRefCount(interp, A);
7672 return rc;
7675 static double JimRandDouble(Jim_Interp *interp)
7677 unsigned long x;
7678 JimRandomBytes(interp, &x, sizeof(x));
7680 return (double)x / (unsigned long)~0;
7683 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7685 Jim_Obj *A = ExprPop(e);
7686 jim_wide wA;
7688 int rc = Jim_GetWide(interp, A, &wA);
7689 if (rc == JIM_OK) {
7690 switch (e->opcode) {
7691 case JIM_EXPROP_BITNOT:
7692 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7693 break;
7694 case JIM_EXPROP_FUNC_SRAND:
7695 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7696 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7697 break;
7698 default:
7699 abort();
7703 Jim_DecrRefCount(interp, A);
7705 return rc;
7708 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7710 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7712 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7714 return JIM_OK;
7717 #ifdef JIM_MATH_FUNCTIONS
7718 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7720 int rc;
7721 Jim_Obj *A = ExprPop(e);
7722 double dA, dC;
7724 rc = Jim_GetDouble(interp, A, &dA);
7725 if (rc == JIM_OK) {
7726 switch (e->opcode) {
7727 case JIM_EXPROP_FUNC_SIN:
7728 dC = sin(dA);
7729 break;
7730 case JIM_EXPROP_FUNC_COS:
7731 dC = cos(dA);
7732 break;
7733 case JIM_EXPROP_FUNC_TAN:
7734 dC = tan(dA);
7735 break;
7736 case JIM_EXPROP_FUNC_ASIN:
7737 dC = asin(dA);
7738 break;
7739 case JIM_EXPROP_FUNC_ACOS:
7740 dC = acos(dA);
7741 break;
7742 case JIM_EXPROP_FUNC_ATAN:
7743 dC = atan(dA);
7744 break;
7745 case JIM_EXPROP_FUNC_SINH:
7746 dC = sinh(dA);
7747 break;
7748 case JIM_EXPROP_FUNC_COSH:
7749 dC = cosh(dA);
7750 break;
7751 case JIM_EXPROP_FUNC_TANH:
7752 dC = tanh(dA);
7753 break;
7754 case JIM_EXPROP_FUNC_CEIL:
7755 dC = ceil(dA);
7756 break;
7757 case JIM_EXPROP_FUNC_FLOOR:
7758 dC = floor(dA);
7759 break;
7760 case JIM_EXPROP_FUNC_EXP:
7761 dC = exp(dA);
7762 break;
7763 case JIM_EXPROP_FUNC_LOG:
7764 dC = log(dA);
7765 break;
7766 case JIM_EXPROP_FUNC_LOG10:
7767 dC = log10(dA);
7768 break;
7769 case JIM_EXPROP_FUNC_SQRT:
7770 dC = sqrt(dA);
7771 break;
7772 default:
7773 abort();
7775 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7778 Jim_DecrRefCount(interp, A);
7780 return rc;
7782 #endif
7784 /* A binary operation on two ints */
7785 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7787 Jim_Obj *B = ExprPop(e);
7788 Jim_Obj *A = ExprPop(e);
7789 jim_wide wA, wB;
7790 int rc = JIM_ERR;
7792 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7793 jim_wide wC;
7795 rc = JIM_OK;
7797 switch (e->opcode) {
7798 case JIM_EXPROP_LSHIFT:
7799 wC = wA << wB;
7800 break;
7801 case JIM_EXPROP_RSHIFT:
7802 wC = wA >> wB;
7803 break;
7804 case JIM_EXPROP_BITAND:
7805 wC = wA & wB;
7806 break;
7807 case JIM_EXPROP_BITXOR:
7808 wC = wA ^ wB;
7809 break;
7810 case JIM_EXPROP_BITOR:
7811 wC = wA | wB;
7812 break;
7813 case JIM_EXPROP_MOD:
7814 if (wB == 0) {
7815 wC = 0;
7816 Jim_SetResultString(interp, "Division by zero", -1);
7817 rc = JIM_ERR;
7819 else {
7821 * From Tcl 8.x
7823 * This code is tricky: C doesn't guarantee much
7824 * about the quotient or remainder, but Tcl does.
7825 * The remainder always has the same sign as the
7826 * divisor and a smaller absolute value.
7828 int negative = 0;
7830 if (wB < 0) {
7831 wB = -wB;
7832 wA = -wA;
7833 negative = 1;
7835 wC = wA % wB;
7836 if (wC < 0) {
7837 wC += wB;
7839 if (negative) {
7840 wC = -wC;
7843 break;
7844 case JIM_EXPROP_ROTL:
7845 case JIM_EXPROP_ROTR:{
7846 /* uint32_t would be better. But not everyone has inttypes.h? */
7847 unsigned long uA = (unsigned long)wA;
7848 unsigned long uB = (unsigned long)wB;
7849 const unsigned int S = sizeof(unsigned long) * 8;
7851 /* Shift left by the word size or more is undefined. */
7852 uB %= S;
7854 if (e->opcode == JIM_EXPROP_ROTR) {
7855 uB = S - uB;
7857 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7858 break;
7860 default:
7861 abort();
7863 ExprPush(e, Jim_NewIntObj(interp, wC));
7867 Jim_DecrRefCount(interp, A);
7868 Jim_DecrRefCount(interp, B);
7870 return rc;
7874 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7875 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7877 int intresult = 1;
7878 int rc = JIM_OK;
7879 double dA, dB, dC = 0;
7880 jim_wide wA, wB, wC = 0;
7882 Jim_Obj *B = ExprPop(e);
7883 Jim_Obj *A = ExprPop(e);
7885 if ((A->typePtr != &doubleObjType || A->bytes) &&
7886 (B->typePtr != &doubleObjType || B->bytes) &&
7887 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7889 /* Both are ints */
7891 switch (e->opcode) {
7892 case JIM_EXPROP_POW:
7893 case JIM_EXPROP_FUNC_POW:
7894 wC = JimPowWide(wA, wB);
7895 break;
7896 case JIM_EXPROP_ADD:
7897 wC = wA + wB;
7898 break;
7899 case JIM_EXPROP_SUB:
7900 wC = wA - wB;
7901 break;
7902 case JIM_EXPROP_MUL:
7903 wC = wA * wB;
7904 break;
7905 case JIM_EXPROP_DIV:
7906 if (wB == 0) {
7907 Jim_SetResultString(interp, "Division by zero", -1);
7908 rc = JIM_ERR;
7910 else {
7912 * From Tcl 8.x
7914 * This code is tricky: C doesn't guarantee much
7915 * about the quotient or remainder, but Tcl does.
7916 * The remainder always has the same sign as the
7917 * divisor and a smaller absolute value.
7919 if (wB < 0) {
7920 wB = -wB;
7921 wA = -wA;
7923 wC = wA / wB;
7924 if (wA % wB < 0) {
7925 wC--;
7928 break;
7929 case JIM_EXPROP_LT:
7930 wC = wA < wB;
7931 break;
7932 case JIM_EXPROP_GT:
7933 wC = wA > wB;
7934 break;
7935 case JIM_EXPROP_LTE:
7936 wC = wA <= wB;
7937 break;
7938 case JIM_EXPROP_GTE:
7939 wC = wA >= wB;
7940 break;
7941 case JIM_EXPROP_NUMEQ:
7942 wC = wA == wB;
7943 break;
7944 case JIM_EXPROP_NUMNE:
7945 wC = wA != wB;
7946 break;
7947 default:
7948 abort();
7951 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7952 intresult = 0;
7953 switch (e->opcode) {
7954 case JIM_EXPROP_POW:
7955 case JIM_EXPROP_FUNC_POW:
7956 #ifdef JIM_MATH_FUNCTIONS
7957 dC = pow(dA, dB);
7958 #else
7959 Jim_SetResultString(interp, "unsupported", -1);
7960 rc = JIM_ERR;
7961 #endif
7962 break;
7963 case JIM_EXPROP_ADD:
7964 dC = dA + dB;
7965 break;
7966 case JIM_EXPROP_SUB:
7967 dC = dA - dB;
7968 break;
7969 case JIM_EXPROP_MUL:
7970 dC = dA * dB;
7971 break;
7972 case JIM_EXPROP_DIV:
7973 if (dB == 0) {
7974 #ifdef INFINITY
7975 dC = dA < 0 ? -INFINITY : INFINITY;
7976 #else
7977 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7978 #endif
7980 else {
7981 dC = dA / dB;
7983 break;
7984 case JIM_EXPROP_LT:
7985 wC = dA < dB;
7986 intresult = 1;
7987 break;
7988 case JIM_EXPROP_GT:
7989 wC = dA > dB;
7990 intresult = 1;
7991 break;
7992 case JIM_EXPROP_LTE:
7993 wC = dA <= dB;
7994 intresult = 1;
7995 break;
7996 case JIM_EXPROP_GTE:
7997 wC = dA >= dB;
7998 intresult = 1;
7999 break;
8000 case JIM_EXPROP_NUMEQ:
8001 wC = dA == dB;
8002 intresult = 1;
8003 break;
8004 case JIM_EXPROP_NUMNE:
8005 wC = dA != dB;
8006 intresult = 1;
8007 break;
8008 default:
8009 abort();
8012 else {
8013 /* Handle the string case */
8015 /* XXX: Could optimise the eq/ne case by checking lengths */
8016 int i = Jim_StringCompareObj(interp, A, B, 0);
8018 switch (e->opcode) {
8019 case JIM_EXPROP_LT:
8020 wC = i < 0;
8021 break;
8022 case JIM_EXPROP_GT:
8023 wC = i > 0;
8024 break;
8025 case JIM_EXPROP_LTE:
8026 wC = i <= 0;
8027 break;
8028 case JIM_EXPROP_GTE:
8029 wC = i >= 0;
8030 break;
8031 case JIM_EXPROP_NUMEQ:
8032 wC = i == 0;
8033 break;
8034 case JIM_EXPROP_NUMNE:
8035 wC = i != 0;
8036 break;
8037 default:
8038 rc = JIM_ERR;
8039 break;
8043 if (rc == JIM_OK) {
8044 if (intresult) {
8045 ExprPush(e, Jim_NewIntObj(interp, wC));
8047 else {
8048 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8052 Jim_DecrRefCount(interp, A);
8053 Jim_DecrRefCount(interp, B);
8055 return rc;
8058 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8060 int listlen;
8061 int i;
8063 listlen = Jim_ListLength(interp, listObjPtr);
8064 for (i = 0; i < listlen; i++) {
8065 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8066 return 1;
8069 return 0;
8072 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8074 Jim_Obj *B = ExprPop(e);
8075 Jim_Obj *A = ExprPop(e);
8077 jim_wide wC;
8079 switch (e->opcode) {
8080 case JIM_EXPROP_STREQ:
8081 case JIM_EXPROP_STRNE:
8082 wC = Jim_StringEqObj(A, B);
8083 if (e->opcode == JIM_EXPROP_STRNE) {
8084 wC = !wC;
8086 break;
8087 case JIM_EXPROP_STRIN:
8088 wC = JimSearchList(interp, B, A);
8089 break;
8090 case JIM_EXPROP_STRNI:
8091 wC = !JimSearchList(interp, B, A);
8092 break;
8093 default:
8094 abort();
8096 ExprPush(e, Jim_NewIntObj(interp, wC));
8098 Jim_DecrRefCount(interp, A);
8099 Jim_DecrRefCount(interp, B);
8101 return JIM_OK;
8104 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8106 long l;
8107 double d;
8109 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8110 return l != 0;
8112 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8113 return d != 0;
8115 return -1;
8118 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8120 Jim_Obj *skip = ExprPop(e);
8121 Jim_Obj *A = ExprPop(e);
8122 int rc = JIM_OK;
8124 switch (ExprBool(interp, A)) {
8125 case 0:
8126 /* false, so skip RHS opcodes with a 0 result */
8127 e->skip = JimWideValue(skip);
8128 ExprPush(e, Jim_NewIntObj(interp, 0));
8129 break;
8131 case 1:
8132 /* true so continue */
8133 break;
8135 case -1:
8136 /* Invalid */
8137 rc = JIM_ERR;
8139 Jim_DecrRefCount(interp, A);
8140 Jim_DecrRefCount(interp, skip);
8142 return rc;
8145 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8147 Jim_Obj *skip = ExprPop(e);
8148 Jim_Obj *A = ExprPop(e);
8149 int rc = JIM_OK;
8151 switch (ExprBool(interp, A)) {
8152 case 0:
8153 /* false, so do nothing */
8154 break;
8156 case 1:
8157 /* true so skip RHS opcodes with a 1 result */
8158 e->skip = JimWideValue(skip);
8159 ExprPush(e, Jim_NewIntObj(interp, 1));
8160 break;
8162 case -1:
8163 /* Invalid */
8164 rc = JIM_ERR;
8165 break;
8167 Jim_DecrRefCount(interp, A);
8168 Jim_DecrRefCount(interp, skip);
8170 return rc;
8173 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8175 Jim_Obj *A = ExprPop(e);
8176 int rc = JIM_OK;
8178 switch (ExprBool(interp, A)) {
8179 case 0:
8180 ExprPush(e, Jim_NewIntObj(interp, 0));
8181 break;
8183 case 1:
8184 ExprPush(e, Jim_NewIntObj(interp, 1));
8185 break;
8187 case -1:
8188 /* Invalid */
8189 rc = JIM_ERR;
8190 break;
8192 Jim_DecrRefCount(interp, A);
8194 return rc;
8197 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8199 Jim_Obj *skip = ExprPop(e);
8200 Jim_Obj *A = ExprPop(e);
8201 int rc = JIM_OK;
8203 /* Repush A */
8204 ExprPush(e, A);
8206 switch (ExprBool(interp, A)) {
8207 case 0:
8208 /* false, skip RHS opcodes */
8209 e->skip = JimWideValue(skip);
8210 /* Push a dummy value */
8211 ExprPush(e, Jim_NewIntObj(interp, 0));
8212 break;
8214 case 1:
8215 /* true so do nothing */
8216 break;
8218 case -1:
8219 /* Invalid */
8220 rc = JIM_ERR;
8221 break;
8223 Jim_DecrRefCount(interp, A);
8224 Jim_DecrRefCount(interp, skip);
8226 return rc;
8229 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8231 Jim_Obj *skip = ExprPop(e);
8232 Jim_Obj *B = ExprPop(e);
8233 Jim_Obj *A = ExprPop(e);
8235 /* No need to check for A as non-boolean */
8236 if (ExprBool(interp, A)) {
8237 /* true, so skip RHS opcodes */
8238 e->skip = JimWideValue(skip);
8239 /* Repush B as the answer */
8240 ExprPush(e, B);
8243 Jim_DecrRefCount(interp, skip);
8244 Jim_DecrRefCount(interp, A);
8245 Jim_DecrRefCount(interp, B);
8246 return JIM_OK;
8249 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8251 return JIM_OK;
8254 enum
8256 LAZY_NONE,
8257 LAZY_OP,
8258 LAZY_LEFT,
8259 LAZY_RIGHT
8262 /* name - precedence - arity - opcode
8264 * This array *must* be kept in sync with the JIM_EXPROP enum.
8266 * The following macros pre-compute the string length at compile time.
8268 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8269 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8271 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8272 OPRINIT("*", 110, 2, JimExprOpBin),
8273 OPRINIT("/", 110, 2, JimExprOpBin),
8274 OPRINIT("%", 110, 2, JimExprOpIntBin),
8276 OPRINIT("-", 100, 2, JimExprOpBin),
8277 OPRINIT("+", 100, 2, JimExprOpBin),
8279 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8280 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8282 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8283 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8285 OPRINIT("<", 80, 2, JimExprOpBin),
8286 OPRINIT(">", 80, 2, JimExprOpBin),
8287 OPRINIT("<=", 80, 2, JimExprOpBin),
8288 OPRINIT(">=", 80, 2, JimExprOpBin),
8290 OPRINIT("==", 70, 2, JimExprOpBin),
8291 OPRINIT("!=", 70, 2, JimExprOpBin),
8293 OPRINIT("&", 50, 2, JimExprOpIntBin),
8294 OPRINIT("^", 49, 2, JimExprOpIntBin),
8295 OPRINIT("|", 48, 2, JimExprOpIntBin),
8297 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8298 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8299 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8301 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8302 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8303 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8305 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8306 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8307 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8309 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8310 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8311 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8313 OPRINIT("**", 250, 2, JimExprOpBin),
8315 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8316 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8318 OPRINIT("in", 55, 2, JimExprOpStrBin),
8319 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8321 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8322 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8323 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8324 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8328 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8329 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8330 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8331 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8332 OPRINIT("rand", 200, 0, JimExprOpNone),
8333 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8335 #ifdef JIM_MATH_FUNCTIONS
8336 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8337 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8338 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8339 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8340 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8341 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8342 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8343 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8344 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8345 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8346 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8347 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8348 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8349 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8350 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8351 OPRINIT("pow", 200, 2, JimExprOpBin),
8352 #endif
8354 #undef OPRINIT
8355 #undef OPRINIT_LAZY
8357 #define JIM_EXPR_OPERATORS_NUM \
8358 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8360 static int JimParseExpression(struct JimParserCtx *pc)
8362 /* Discard spaces and quoted newline */
8363 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8364 if (*pc->p == '\n') {
8365 pc->linenr++;
8367 pc->p++;
8368 pc->len--;
8371 /* Common case */
8372 pc->tline = pc->linenr;
8373 pc->tstart = pc->p;
8375 if (pc->len == 0) {
8376 pc->tend = pc->p;
8377 pc->tt = JIM_TT_EOL;
8378 pc->eof = 1;
8379 return JIM_OK;
8381 switch (*(pc->p)) {
8382 case '(':
8383 pc->tt = JIM_TT_SUBEXPR_START;
8384 goto singlechar;
8385 case ')':
8386 pc->tt = JIM_TT_SUBEXPR_END;
8387 goto singlechar;
8388 case ',':
8389 pc->tt = JIM_TT_SUBEXPR_COMMA;
8390 singlechar:
8391 pc->tend = pc->p;
8392 pc->p++;
8393 pc->len--;
8394 break;
8395 case '[':
8396 return JimParseCmd(pc);
8397 case '$':
8398 if (JimParseVar(pc) == JIM_ERR)
8399 return JimParseExprOperator(pc);
8400 else {
8401 /* Don't allow expr sugar in expressions */
8402 if (pc->tt == JIM_TT_EXPRSUGAR) {
8403 return JIM_ERR;
8405 return JIM_OK;
8407 break;
8408 case '0':
8409 case '1':
8410 case '2':
8411 case '3':
8412 case '4':
8413 case '5':
8414 case '6':
8415 case '7':
8416 case '8':
8417 case '9':
8418 case '.':
8419 return JimParseExprNumber(pc);
8420 case '"':
8421 return JimParseQuote(pc);
8422 case '{':
8423 return JimParseBrace(pc);
8425 case 'N':
8426 case 'I':
8427 case 'n':
8428 case 'i':
8429 if (JimParseExprIrrational(pc) == JIM_ERR)
8430 return JimParseExprOperator(pc);
8431 break;
8432 default:
8433 return JimParseExprOperator(pc);
8434 break;
8436 return JIM_OK;
8439 static int JimParseExprNumber(struct JimParserCtx *pc)
8441 char *end;
8443 /* Assume an integer for now */
8444 pc->tt = JIM_TT_EXPR_INT;
8446 jim_strtoull(pc->p, (char **)&pc->p);
8447 /* Tried as an integer, but perhaps it parses as a double */
8448 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8449 /* Some stupid compilers insist they are cleverer that
8450 * we are. Even a (void) cast doesn't prevent this warning!
8452 if (strtod(pc->tstart, &end)) { /* nothing */ }
8453 if (end == pc->tstart)
8454 return JIM_ERR;
8455 if (end > pc->p) {
8456 /* Yes, double captured more chars */
8457 pc->tt = JIM_TT_EXPR_DOUBLE;
8458 pc->p = end;
8461 pc->tend = pc->p - 1;
8462 pc->len -= (pc->p - pc->tstart);
8463 return JIM_OK;
8466 static int JimParseExprIrrational(struct JimParserCtx *pc)
8468 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8469 int i;
8471 for (i = 0; irrationals[i]; i++) {
8472 const char *irr = irrationals[i];
8474 if (strncmp(irr, pc->p, 3) == 0) {
8475 pc->p += 3;
8476 pc->len -= 3;
8477 pc->tend = pc->p - 1;
8478 pc->tt = JIM_TT_EXPR_DOUBLE;
8479 return JIM_OK;
8482 return JIM_ERR;
8485 static int JimParseExprOperator(struct JimParserCtx *pc)
8487 int i;
8488 int bestIdx = -1, bestLen = 0;
8490 /* Try to get the longest match. */
8491 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8492 const char * const opname = Jim_ExprOperators[i].name;
8493 const int oplen = Jim_ExprOperators[i].namelen;
8495 if (opname == NULL || opname[0] != pc->p[0]) {
8496 continue;
8499 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8500 bestIdx = i + JIM_TT_EXPR_OP;
8501 bestLen = oplen;
8504 if (bestIdx == -1) {
8505 return JIM_ERR;
8508 /* Validate paretheses around function arguments */
8509 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8510 const char *p = pc->p + bestLen;
8511 int len = pc->len - bestLen;
8513 while (len && isspace(UCHAR(*p))) {
8514 len--;
8515 p++;
8517 if (*p != '(') {
8518 return JIM_ERR;
8521 pc->tend = pc->p + bestLen - 1;
8522 pc->p += bestLen;
8523 pc->len -= bestLen;
8525 pc->tt = bestIdx;
8526 return JIM_OK;
8529 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8531 static Jim_ExprOperator dummy_op;
8532 if (opcode < JIM_TT_EXPR_OP) {
8533 return &dummy_op;
8535 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8538 const char *jim_tt_name(int type)
8540 static const char * const tt_names[JIM_TT_EXPR_OP] =
8541 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8542 "DBL", "$()" };
8543 if (type < JIM_TT_EXPR_OP) {
8544 return tt_names[type];
8546 else {
8547 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8548 static char buf[20];
8550 if (op->name) {
8551 return op->name;
8553 sprintf(buf, "(%d)", type);
8554 return buf;
8558 /* -----------------------------------------------------------------------------
8559 * Expression Object
8560 * ---------------------------------------------------------------------------*/
8561 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8562 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8563 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8565 static const Jim_ObjType exprObjType = {
8566 "expression",
8567 FreeExprInternalRep,
8568 DupExprInternalRep,
8569 NULL,
8570 JIM_TYPE_REFERENCES,
8573 /* Expr bytecode structure */
8574 typedef struct ExprByteCode
8576 ScriptToken *token; /* Tokens array. */
8577 int len; /* Length as number of tokens. */
8578 int inUse; /* Used for sharing. */
8579 } ExprByteCode;
8581 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8583 int i;
8585 for (i = 0; i < expr->len; i++) {
8586 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8588 Jim_Free(expr->token);
8589 Jim_Free(expr);
8592 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8594 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8596 if (expr) {
8597 if (--expr->inUse != 0) {
8598 return;
8601 ExprFreeByteCode(interp, expr);
8605 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8607 JIM_NOTUSED(interp);
8608 JIM_NOTUSED(srcPtr);
8610 /* Just returns an simple string. */
8611 dupPtr->typePtr = NULL;
8614 /* Check if an expr program looks correct. */
8615 static int ExprCheckCorrectness(ExprByteCode * expr)
8617 int i;
8618 int stacklen = 0;
8619 int ternary = 0;
8621 /* Try to check if there are stack underflows,
8622 * and make sure at the end of the program there is
8623 * a single result on the stack. */
8624 for (i = 0; i < expr->len; i++) {
8625 ScriptToken *t = &expr->token[i];
8626 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8628 stacklen -= op->arity;
8629 if (stacklen < 0) {
8630 break;
8632 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8633 ternary++;
8635 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8636 ternary--;
8639 /* All operations and operands add one to the stack */
8640 stacklen++;
8642 if (stacklen != 1 || ternary != 0) {
8643 return JIM_ERR;
8645 return JIM_OK;
8648 /* This procedure converts every occurrence of || and && opereators
8649 * in lazy unary versions.
8651 * a b || is converted into:
8653 * a <offset> |L b |R
8655 * a b && is converted into:
8657 * a <offset> &L b &R
8659 * "|L" checks if 'a' is true:
8660 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8661 * the opcode just after |R.
8662 * 2) if it is false does nothing.
8663 * "|R" checks if 'b' is true:
8664 * 1) if it is true pushes 1, otherwise pushes 0.
8666 * "&L" checks if 'a' is true:
8667 * 1) if it is true does nothing.
8668 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8669 * the opcode just after &R
8670 * "&R" checks if 'a' is true:
8671 * if it is true pushes 1, otherwise pushes 0.
8673 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8675 int i;
8677 int leftindex, arity, offset;
8679 /* Search for the end of the first operator */
8680 leftindex = expr->len - 1;
8682 arity = 1;
8683 while (arity) {
8684 ScriptToken *tt = &expr->token[leftindex];
8686 if (tt->type >= JIM_TT_EXPR_OP) {
8687 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8689 arity--;
8690 if (--leftindex < 0) {
8691 return JIM_ERR;
8694 leftindex++;
8696 /* Move them up */
8697 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8698 sizeof(*expr->token) * (expr->len - leftindex));
8699 expr->len += 2;
8700 offset = (expr->len - leftindex) - 1;
8702 /* Now we rely on the fact the the left and right version have opcodes
8703 * 1 and 2 after the main opcode respectively
8705 expr->token[leftindex + 1].type = t->type + 1;
8706 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8708 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8709 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8711 /* Now add the 'R' operator */
8712 expr->token[expr->len].objPtr = interp->emptyObj;
8713 expr->token[expr->len].type = t->type + 2;
8714 expr->len++;
8716 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8717 for (i = leftindex - 1; i > 0; i--) {
8718 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8719 if (op->lazy == LAZY_LEFT) {
8720 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8721 JimWideValue(expr->token[i - 1].objPtr) += 2;
8725 return JIM_OK;
8728 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8730 struct ScriptToken *token = &expr->token[expr->len];
8731 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8733 if (op->lazy == LAZY_OP) {
8734 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8735 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8736 return JIM_ERR;
8739 else {
8740 token->objPtr = interp->emptyObj;
8741 token->type = t->type;
8742 expr->len++;
8744 return JIM_OK;
8748 * Returns the index of the COLON_LEFT to the left of 'right_index'
8749 * taking into account nesting.
8751 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8753 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8755 int ternary_count = 1;
8757 right_index--;
8759 while (right_index > 1) {
8760 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8761 ternary_count--;
8763 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8764 ternary_count++;
8766 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8767 return right_index;
8769 right_index--;
8772 /*notreached*/
8773 return -1;
8777 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8779 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8780 * Otherwise returns 0.
8782 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8784 int i = right_index - 1;
8785 int ternary_count = 1;
8787 while (i > 1) {
8788 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8789 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8790 *prev_right_index = i - 2;
8791 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8792 return 1;
8795 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8796 if (ternary_count == 0) {
8797 return 0;
8799 ternary_count++;
8801 i--;
8803 return 0;
8807 * ExprTernaryReorderExpression description
8808 * ========================================
8810 * ?: is right-to-left associative which doesn't work with the stack-based
8811 * expression engine. The fix is to reorder the bytecode.
8813 * The expression:
8815 * expr 1?2:0?3:4
8817 * Has initial bytecode:
8819 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8820 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8822 * The fix involves simulating this expression instead:
8824 * expr 1?2:(0?3:4)
8826 * With the following bytecode:
8828 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8829 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8831 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8832 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8833 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8834 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8836 * ExprTernaryReorderExpression works thus as follows :
8837 * - start from the end of the stack
8838 * - while walking towards the beginning of the stack
8839 * if token=JIM_EXPROP_COLON_RIGHT then
8840 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8841 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8842 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8843 * if all found then
8844 * perform the rotation
8845 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8846 * end if
8847 * end if
8849 * Note: care has to be taken for nested ternary constructs!!!
8851 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8853 int i;
8855 for (i = expr->len - 1; i > 1; i--) {
8856 int prev_right_index;
8857 int prev_left_index;
8858 int j;
8859 ScriptToken tmp;
8861 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8862 continue;
8865 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8866 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8867 continue;
8871 ** rotate tokens down
8873 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8874 ** | | |
8875 ** | V V
8876 ** | [...] : ...
8877 ** | | |
8878 ** | V V
8879 ** | [...] : ...
8880 ** | | |
8881 ** | V V
8882 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8884 tmp = expr->token[prev_right_index];
8885 for (j = prev_right_index; j < i; j++) {
8886 expr->token[j] = expr->token[j + 1];
8888 expr->token[i] = tmp;
8890 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8892 * This is 'colon left increment' = i - prev_right_index
8894 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8895 * [prev_left_index-1] : skip_count
8898 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8900 /* Adjust for i-- in the loop */
8901 i++;
8905 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8907 Jim_Stack stack;
8908 ExprByteCode *expr;
8909 int ok = 1;
8910 int i;
8911 int prevtt = JIM_TT_NONE;
8912 int have_ternary = 0;
8914 /* -1 for EOL */
8915 int count = tokenlist->count - 1;
8917 expr = Jim_Alloc(sizeof(*expr));
8918 expr->inUse = 1;
8919 expr->len = 0;
8921 Jim_InitStack(&stack);
8923 /* Need extra bytecodes for lazy operators.
8924 * Also check for the ternary operator
8926 for (i = 0; i < tokenlist->count; i++) {
8927 ParseToken *t = &tokenlist->list[i];
8928 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8930 if (op->lazy == LAZY_OP) {
8931 count += 2;
8932 /* Ternary is a lazy op but also needs reordering */
8933 if (t->type == JIM_EXPROP_TERNARY) {
8934 have_ternary = 1;
8939 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8941 for (i = 0; i < tokenlist->count && ok; i++) {
8942 ParseToken *t = &tokenlist->list[i];
8944 /* Next token will be stored here */
8945 struct ScriptToken *token = &expr->token[expr->len];
8947 if (t->type == JIM_TT_EOL) {
8948 break;
8951 switch (t->type) {
8952 case JIM_TT_STR:
8953 case JIM_TT_ESC:
8954 case JIM_TT_VAR:
8955 case JIM_TT_DICTSUGAR:
8956 case JIM_TT_EXPRSUGAR:
8957 case JIM_TT_CMD:
8958 token->type = t->type;
8959 strexpr:
8960 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8961 if (t->type == JIM_TT_CMD) {
8962 /* Only commands need source info */
8963 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8965 expr->len++;
8966 break;
8968 case JIM_TT_EXPR_INT:
8969 case JIM_TT_EXPR_DOUBLE:
8971 char *endptr;
8972 if (t->type == JIM_TT_EXPR_INT) {
8973 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8975 else {
8976 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8978 if (endptr != t->token + t->len) {
8979 /* Conversion failed, so just store it as a string */
8980 Jim_FreeNewObj(interp, token->objPtr);
8981 token->type = JIM_TT_STR;
8982 goto strexpr;
8984 token->type = t->type;
8985 expr->len++;
8987 break;
8989 case JIM_TT_SUBEXPR_START:
8990 Jim_StackPush(&stack, t);
8991 prevtt = JIM_TT_NONE;
8992 continue;
8994 case JIM_TT_SUBEXPR_COMMA:
8995 /* Simple approach. Comma is simply ignored */
8996 continue;
8998 case JIM_TT_SUBEXPR_END:
8999 ok = 0;
9000 while (Jim_StackLen(&stack)) {
9001 ParseToken *tt = Jim_StackPop(&stack);
9003 if (tt->type == JIM_TT_SUBEXPR_START) {
9004 ok = 1;
9005 break;
9008 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9009 goto err;
9012 if (!ok) {
9013 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9014 goto err;
9016 break;
9019 default:{
9020 /* Must be an operator */
9021 const struct Jim_ExprOperator *op;
9022 ParseToken *tt;
9024 /* Convert -/+ to unary minus or unary plus if necessary */
9025 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9026 if (t->type == JIM_EXPROP_SUB) {
9027 t->type = JIM_EXPROP_UNARYMINUS;
9029 else if (t->type == JIM_EXPROP_ADD) {
9030 t->type = JIM_EXPROP_UNARYPLUS;
9034 op = JimExprOperatorInfoByOpcode(t->type);
9036 /* Now handle precedence */
9037 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9038 const struct Jim_ExprOperator *tt_op =
9039 JimExprOperatorInfoByOpcode(tt->type);
9041 /* Note that right-to-left associativity of ?: operator is handled later */
9043 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9044 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9045 ok = 0;
9046 goto err;
9048 Jim_StackPop(&stack);
9050 else {
9051 break;
9054 Jim_StackPush(&stack, t);
9055 break;
9058 prevtt = t->type;
9061 /* Reduce any remaining subexpr */
9062 while (Jim_StackLen(&stack)) {
9063 ParseToken *tt = Jim_StackPop(&stack);
9065 if (tt->type == JIM_TT_SUBEXPR_START) {
9066 ok = 0;
9067 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9068 goto err;
9070 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9071 ok = 0;
9072 goto err;
9076 if (have_ternary) {
9077 ExprTernaryReorderExpression(interp, expr);
9080 err:
9081 /* Free the stack used for the compilation. */
9082 Jim_FreeStack(&stack);
9084 for (i = 0; i < expr->len; i++) {
9085 Jim_IncrRefCount(expr->token[i].objPtr);
9088 if (!ok) {
9089 ExprFreeByteCode(interp, expr);
9090 return NULL;
9093 return expr;
9097 /* This method takes the string representation of an expression
9098 * and generates a program for the Expr's stack-based VM. */
9099 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9101 int exprTextLen;
9102 const char *exprText;
9103 struct JimParserCtx parser;
9104 struct ExprByteCode *expr;
9105 ParseTokenList tokenlist;
9106 int line;
9107 Jim_Obj *fileNameObj;
9108 int rc = JIM_ERR;
9110 /* Try to get information about filename / line number */
9111 if (objPtr->typePtr == &sourceObjType) {
9112 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9113 line = objPtr->internalRep.sourceValue.lineNumber;
9115 else {
9116 fileNameObj = interp->emptyObj;
9117 line = 1;
9119 Jim_IncrRefCount(fileNameObj);
9121 exprText = Jim_GetString(objPtr, &exprTextLen);
9123 /* Initially tokenise the expression into tokenlist */
9124 ScriptTokenListInit(&tokenlist);
9126 JimParserInit(&parser, exprText, exprTextLen, line);
9127 while (!parser.eof) {
9128 if (JimParseExpression(&parser) != JIM_OK) {
9129 ScriptTokenListFree(&tokenlist);
9130 invalidexpr:
9131 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9132 expr = NULL;
9133 goto err;
9136 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9137 parser.tline);
9140 #ifdef DEBUG_SHOW_EXPR_TOKENS
9142 int i;
9143 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9144 for (i = 0; i < tokenlist.count; i++) {
9145 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9146 tokenlist.list[i].len, tokenlist.list[i].token);
9149 #endif
9151 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9152 ScriptTokenListFree(&tokenlist);
9153 Jim_DecrRefCount(interp, fileNameObj);
9154 return JIM_ERR;
9157 /* Now create the expression bytecode from the tokenlist */
9158 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9160 /* No longer need the token list */
9161 ScriptTokenListFree(&tokenlist);
9163 if (!expr) {
9164 goto err;
9167 #ifdef DEBUG_SHOW_EXPR
9169 int i;
9171 printf("==== Expr ====\n");
9172 for (i = 0; i < expr->len; i++) {
9173 ScriptToken *t = &expr->token[i];
9175 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9178 #endif
9180 /* Check program correctness. */
9181 if (ExprCheckCorrectness(expr) != JIM_OK) {
9182 ExprFreeByteCode(interp, expr);
9183 goto invalidexpr;
9186 rc = JIM_OK;
9188 err:
9189 /* Free the old internal rep and set the new one. */
9190 Jim_DecrRefCount(interp, fileNameObj);
9191 Jim_FreeIntRep(interp, objPtr);
9192 Jim_SetIntRepPtr(objPtr, expr);
9193 objPtr->typePtr = &exprObjType;
9194 return rc;
9197 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9199 if (objPtr->typePtr != &exprObjType) {
9200 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9201 return NULL;
9204 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9207 #ifdef JIM_OPTIMIZATION
9208 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9210 if (token->type == JIM_TT_EXPR_INT)
9211 return token->objPtr;
9212 else if (token->type == JIM_TT_VAR)
9213 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9214 else if (token->type == JIM_TT_DICTSUGAR)
9215 return JimExpandDictSugar(interp, token->objPtr);
9216 else
9217 return NULL;
9219 #endif
9221 /* -----------------------------------------------------------------------------
9222 * Expressions evaluation.
9223 * Jim uses a specialized stack-based virtual machine for expressions,
9224 * that takes advantage of the fact that expr's operators
9225 * can't be redefined.
9227 * Jim_EvalExpression() uses the bytecode compiled by
9228 * SetExprFromAny() method of the "expression" object.
9230 * On success a Tcl Object containing the result of the evaluation
9231 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9232 * returned.
9233 * On error the function returns a retcode != to JIM_OK and set a suitable
9234 * error on the interp.
9235 * ---------------------------------------------------------------------------*/
9236 #define JIM_EE_STATICSTACK_LEN 10
9238 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9240 ExprByteCode *expr;
9241 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9242 int i;
9243 int retcode = JIM_OK;
9244 struct JimExprState e;
9246 expr = JimGetExpression(interp, exprObjPtr);
9247 if (!expr) {
9248 return JIM_ERR; /* error in expression. */
9251 #ifdef JIM_OPTIMIZATION
9252 /* Check for one of the following common expressions used by while/for
9254 * CONST
9255 * $a
9256 * !$a
9257 * $a < CONST, $a < $b
9258 * $a <= CONST, $a <= $b
9259 * $a > CONST, $a > $b
9260 * $a >= CONST, $a >= $b
9261 * $a != CONST, $a != $b
9262 * $a == CONST, $a == $b
9265 Jim_Obj *objPtr;
9267 /* STEP 1 -- Check if there are the conditions to run the specialized
9268 * version of while */
9270 switch (expr->len) {
9271 case 1:
9272 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9273 if (objPtr) {
9274 Jim_IncrRefCount(objPtr);
9275 *exprResultPtrPtr = objPtr;
9276 return JIM_OK;
9278 break;
9280 case 2:
9281 if (expr->token[1].type == JIM_EXPROP_NOT) {
9282 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9284 if (objPtr && JimIsWide(objPtr)) {
9285 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9286 Jim_IncrRefCount(*exprResultPtrPtr);
9287 return JIM_OK;
9290 break;
9292 case 3:
9293 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9294 if (objPtr && JimIsWide(objPtr)) {
9295 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9296 if (objPtr2 && JimIsWide(objPtr2)) {
9297 jim_wide wideValueA = JimWideValue(objPtr);
9298 jim_wide wideValueB = JimWideValue(objPtr2);
9299 int cmpRes;
9300 switch (expr->token[2].type) {
9301 case JIM_EXPROP_LT:
9302 cmpRes = wideValueA < wideValueB;
9303 break;
9304 case JIM_EXPROP_LTE:
9305 cmpRes = wideValueA <= wideValueB;
9306 break;
9307 case JIM_EXPROP_GT:
9308 cmpRes = wideValueA > wideValueB;
9309 break;
9310 case JIM_EXPROP_GTE:
9311 cmpRes = wideValueA >= wideValueB;
9312 break;
9313 case JIM_EXPROP_NUMEQ:
9314 cmpRes = wideValueA == wideValueB;
9315 break;
9316 case JIM_EXPROP_NUMNE:
9317 cmpRes = wideValueA != wideValueB;
9318 break;
9319 default:
9320 goto noopt;
9322 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9323 Jim_IncrRefCount(*exprResultPtrPtr);
9324 return JIM_OK;
9327 break;
9330 noopt:
9331 #endif
9333 /* In order to avoid that the internal repr gets freed due to
9334 * shimmering of the exprObjPtr's object, we make the internal rep
9335 * shared. */
9336 expr->inUse++;
9338 /* The stack-based expr VM itself */
9340 /* Stack allocation. Expr programs have the feature that
9341 * a program of length N can't require a stack longer than
9342 * N. */
9343 if (expr->len > JIM_EE_STATICSTACK_LEN)
9344 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9345 else
9346 e.stack = staticStack;
9348 e.stacklen = 0;
9350 /* Execute every instruction */
9351 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9352 Jim_Obj *objPtr;
9354 switch (expr->token[i].type) {
9355 case JIM_TT_EXPR_INT:
9356 case JIM_TT_EXPR_DOUBLE:
9357 case JIM_TT_STR:
9358 ExprPush(&e, expr->token[i].objPtr);
9359 break;
9361 case JIM_TT_VAR:
9362 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9363 if (objPtr) {
9364 ExprPush(&e, objPtr);
9366 else {
9367 retcode = JIM_ERR;
9369 break;
9371 case JIM_TT_DICTSUGAR:
9372 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9373 if (objPtr) {
9374 ExprPush(&e, objPtr);
9376 else {
9377 retcode = JIM_ERR;
9379 break;
9381 case JIM_TT_ESC:
9382 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9383 if (retcode == JIM_OK) {
9384 ExprPush(&e, objPtr);
9386 break;
9388 case JIM_TT_CMD:
9389 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9390 if (retcode == JIM_OK) {
9391 ExprPush(&e, Jim_GetResult(interp));
9393 break;
9395 default:{
9396 /* Find and execute the operation */
9397 e.skip = 0;
9398 e.opcode = expr->token[i].type;
9400 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9401 /* Skip some opcodes if necessary */
9402 i += e.skip;
9403 continue;
9408 expr->inUse--;
9410 if (retcode == JIM_OK) {
9411 *exprResultPtrPtr = ExprPop(&e);
9413 else {
9414 for (i = 0; i < e.stacklen; i++) {
9415 Jim_DecrRefCount(interp, e.stack[i]);
9418 if (e.stack != staticStack) {
9419 Jim_Free(e.stack);
9421 return retcode;
9424 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9426 int retcode;
9427 jim_wide wideValue;
9428 double doubleValue;
9429 Jim_Obj *exprResultPtr;
9431 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9432 if (retcode != JIM_OK)
9433 return retcode;
9435 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9436 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9437 Jim_DecrRefCount(interp, exprResultPtr);
9438 return JIM_ERR;
9440 else {
9441 Jim_DecrRefCount(interp, exprResultPtr);
9442 *boolPtr = doubleValue != 0;
9443 return JIM_OK;
9446 *boolPtr = wideValue != 0;
9448 Jim_DecrRefCount(interp, exprResultPtr);
9449 return JIM_OK;
9452 /* -----------------------------------------------------------------------------
9453 * ScanFormat String Object
9454 * ---------------------------------------------------------------------------*/
9456 /* This Jim_Obj will held a parsed representation of a format string passed to
9457 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9458 * to be parsed in its entirely first and then, if correct, can be used for
9459 * scanning. To avoid endless re-parsing, the parsed representation will be
9460 * stored in an internal representation and re-used for performance reason. */
9462 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9463 * scanformat string. This part will later be used to extract information
9464 * out from the string to be parsed by Jim_ScanString */
9466 typedef struct ScanFmtPartDescr
9468 char *arg; /* Specification of a CHARSET conversion */
9469 char *prefix; /* Prefix to be scanned literally before conversion */
9470 size_t width; /* Maximal width of input to be converted */
9471 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9472 char type; /* Type of conversion (e.g. c, d, f) */
9473 char modifier; /* Modify type (e.g. l - long, h - short */
9474 } ScanFmtPartDescr;
9476 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9477 * string parsed and separated in part descriptions. Furthermore it contains
9478 * the original string representation of the scanformat string to allow for
9479 * fast update of the Jim_Obj's string representation part.
9481 * As an add-on the internal object representation adds some scratch pad area
9482 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9483 * memory for purpose of string scanning.
9485 * The error member points to a static allocated string in case of a mal-
9486 * formed scanformat string or it contains '0' (NULL) in case of a valid
9487 * parse representation.
9489 * The whole memory of the internal representation is allocated as a single
9490 * area of memory that will be internally separated. So freeing and duplicating
9491 * of such an object is cheap */
9493 typedef struct ScanFmtStringObj
9495 jim_wide size; /* Size of internal repr in bytes */
9496 char *stringRep; /* Original string representation */
9497 size_t count; /* Number of ScanFmtPartDescr contained */
9498 size_t convCount; /* Number of conversions that will assign */
9499 size_t maxPos; /* Max position index if XPG3 is used */
9500 const char *error; /* Ptr to error text (NULL if no error */
9501 char *scratch; /* Some scratch pad used by Jim_ScanString */
9502 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9503 } ScanFmtStringObj;
9506 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9507 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9508 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9510 static const Jim_ObjType scanFmtStringObjType = {
9511 "scanformatstring",
9512 FreeScanFmtInternalRep,
9513 DupScanFmtInternalRep,
9514 UpdateStringOfScanFmt,
9515 JIM_TYPE_NONE,
9518 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9520 JIM_NOTUSED(interp);
9521 Jim_Free((char *)objPtr->internalRep.ptr);
9522 objPtr->internalRep.ptr = 0;
9525 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9527 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9528 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9530 JIM_NOTUSED(interp);
9531 memcpy(newVec, srcPtr->internalRep.ptr, size);
9532 dupPtr->internalRep.ptr = newVec;
9533 dupPtr->typePtr = &scanFmtStringObjType;
9536 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9538 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9541 /* SetScanFmtFromAny will parse a given string and create the internal
9542 * representation of the format specification. In case of an error
9543 * the error data member of the internal representation will be set
9544 * to an descriptive error text and the function will be left with
9545 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9546 * specification */
9548 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9550 ScanFmtStringObj *fmtObj;
9551 char *buffer;
9552 int maxCount, i, approxSize, lastPos = -1;
9553 const char *fmt = objPtr->bytes;
9554 int maxFmtLen = objPtr->length;
9555 const char *fmtEnd = fmt + maxFmtLen;
9556 int curr;
9558 Jim_FreeIntRep(interp, objPtr);
9559 /* Count how many conversions could take place maximally */
9560 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9561 if (fmt[i] == '%')
9562 ++maxCount;
9563 /* Calculate an approximation of the memory necessary */
9564 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9565 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9566 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9567 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9568 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9569 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9570 +1; /* safety byte */
9571 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9572 memset(fmtObj, 0, approxSize);
9573 fmtObj->size = approxSize;
9574 fmtObj->maxPos = 0;
9575 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9576 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9577 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9578 buffer = fmtObj->stringRep + maxFmtLen + 1;
9579 objPtr->internalRep.ptr = fmtObj;
9580 objPtr->typePtr = &scanFmtStringObjType;
9581 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9582 int width = 0, skip;
9583 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9585 fmtObj->count++;
9586 descr->width = 0; /* Assume width unspecified */
9587 /* Overread and store any "literal" prefix */
9588 if (*fmt != '%' || fmt[1] == '%') {
9589 descr->type = 0;
9590 descr->prefix = &buffer[i];
9591 for (; fmt < fmtEnd; ++fmt) {
9592 if (*fmt == '%') {
9593 if (fmt[1] != '%')
9594 break;
9595 ++fmt;
9597 buffer[i++] = *fmt;
9599 buffer[i++] = 0;
9601 /* Skip the conversion introducing '%' sign */
9602 ++fmt;
9603 /* End reached due to non-conversion literal only? */
9604 if (fmt >= fmtEnd)
9605 goto done;
9606 descr->pos = 0; /* Assume "natural" positioning */
9607 if (*fmt == '*') {
9608 descr->pos = -1; /* Okay, conversion will not be assigned */
9609 ++fmt;
9611 else
9612 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9613 /* Check if next token is a number (could be width or pos */
9614 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9615 fmt += skip;
9616 /* Was the number a XPG3 position specifier? */
9617 if (descr->pos != -1 && *fmt == '$') {
9618 int prev;
9620 ++fmt;
9621 descr->pos = width;
9622 width = 0;
9623 /* Look if "natural" postioning and XPG3 one was mixed */
9624 if ((lastPos == 0 && descr->pos > 0)
9625 || (lastPos > 0 && descr->pos == 0)) {
9626 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9627 return JIM_ERR;
9629 /* Look if this position was already used */
9630 for (prev = 0; prev < curr; ++prev) {
9631 if (fmtObj->descr[prev].pos == -1)
9632 continue;
9633 if (fmtObj->descr[prev].pos == descr->pos) {
9634 fmtObj->error =
9635 "variable is assigned by multiple \"%n$\" conversion specifiers";
9636 return JIM_ERR;
9639 /* Try to find a width after the XPG3 specifier */
9640 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9641 descr->width = width;
9642 fmt += skip;
9644 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9645 fmtObj->maxPos = descr->pos;
9647 else {
9648 /* Number was not a XPG3, so it has to be a width */
9649 descr->width = width;
9652 /* If positioning mode was undetermined yet, fix this */
9653 if (lastPos == -1)
9654 lastPos = descr->pos;
9655 /* Handle CHARSET conversion type ... */
9656 if (*fmt == '[') {
9657 int swapped = 1, beg = i, end, j;
9659 descr->type = '[';
9660 descr->arg = &buffer[i];
9661 ++fmt;
9662 if (*fmt == '^')
9663 buffer[i++] = *fmt++;
9664 if (*fmt == ']')
9665 buffer[i++] = *fmt++;
9666 while (*fmt && *fmt != ']')
9667 buffer[i++] = *fmt++;
9668 if (*fmt != ']') {
9669 fmtObj->error = "unmatched [ in format string";
9670 return JIM_ERR;
9672 end = i;
9673 buffer[i++] = 0;
9674 /* In case a range fence was given "backwards", swap it */
9675 while (swapped) {
9676 swapped = 0;
9677 for (j = beg + 1; j < end - 1; ++j) {
9678 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9679 char tmp = buffer[j - 1];
9681 buffer[j - 1] = buffer[j + 1];
9682 buffer[j + 1] = tmp;
9683 swapped = 1;
9688 else {
9689 /* Remember any valid modifier if given */
9690 if (strchr("hlL", *fmt) != 0)
9691 descr->modifier = tolower((int)*fmt++);
9693 descr->type = *fmt;
9694 if (strchr("efgcsndoxui", *fmt) == 0) {
9695 fmtObj->error = "bad scan conversion character";
9696 return JIM_ERR;
9698 else if (*fmt == 'c' && descr->width != 0) {
9699 fmtObj->error = "field width may not be specified in %c " "conversion";
9700 return JIM_ERR;
9702 else if (*fmt == 'u' && descr->modifier == 'l') {
9703 fmtObj->error = "unsigned wide not supported";
9704 return JIM_ERR;
9707 curr++;
9709 done:
9710 return JIM_OK;
9713 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9715 #define FormatGetCnvCount(_fo_) \
9716 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9717 #define FormatGetMaxPos(_fo_) \
9718 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9719 #define FormatGetError(_fo_) \
9720 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9722 /* JimScanAString is used to scan an unspecified string that ends with
9723 * next WS, or a string that is specified via a charset.
9726 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9728 char *buffer = Jim_StrDup(str);
9729 char *p = buffer;
9731 while (*str) {
9732 int c;
9733 int n;
9735 if (!sdescr && isspace(UCHAR(*str)))
9736 break; /* EOS via WS if unspecified */
9738 n = utf8_tounicode(str, &c);
9739 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9740 break;
9741 while (n--)
9742 *p++ = *str++;
9744 *p = 0;
9745 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9748 /* ScanOneEntry will scan one entry out of the string passed as argument.
9749 * It use the sscanf() function for this task. After extracting and
9750 * converting of the value, the count of scanned characters will be
9751 * returned of -1 in case of no conversion tool place and string was
9752 * already scanned thru */
9754 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9755 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9757 const char *tok;
9758 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9759 size_t scanned = 0;
9760 size_t anchor = pos;
9761 int i;
9762 Jim_Obj *tmpObj = NULL;
9764 /* First pessimistically assume, we will not scan anything :-) */
9765 *valObjPtr = 0;
9766 if (descr->prefix) {
9767 /* There was a prefix given before the conversion, skip it and adjust
9768 * the string-to-be-parsed accordingly */
9769 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9770 /* If prefix require, skip WS */
9771 if (isspace(UCHAR(descr->prefix[i])))
9772 while (pos < strLen && isspace(UCHAR(str[pos])))
9773 ++pos;
9774 else if (descr->prefix[i] != str[pos])
9775 break; /* Prefix do not match here, leave the loop */
9776 else
9777 ++pos; /* Prefix matched so far, next round */
9779 if (pos >= strLen) {
9780 return -1; /* All of str consumed: EOF condition */
9782 else if (descr->prefix[i] != 0)
9783 return 0; /* Not whole prefix consumed, no conversion possible */
9785 /* For all but following conversion, skip leading WS */
9786 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9787 while (isspace(UCHAR(str[pos])))
9788 ++pos;
9789 /* Determine how much skipped/scanned so far */
9790 scanned = pos - anchor;
9792 /* %c is a special, simple case. no width */
9793 if (descr->type == 'n') {
9794 /* Return pseudo conversion means: how much scanned so far? */
9795 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9797 else if (pos >= strLen) {
9798 /* Cannot scan anything, as str is totally consumed */
9799 return -1;
9801 else if (descr->type == 'c') {
9802 int c;
9803 scanned += utf8_tounicode(&str[pos], &c);
9804 *valObjPtr = Jim_NewIntObj(interp, c);
9805 return scanned;
9807 else {
9808 /* Processing of conversions follows ... */
9809 if (descr->width > 0) {
9810 /* Do not try to scan as fas as possible but only the given width.
9811 * To ensure this, we copy the part that should be scanned. */
9812 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9813 size_t tLen = descr->width > sLen ? sLen : descr->width;
9815 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9816 tok = tmpObj->bytes;
9818 else {
9819 /* As no width was given, simply refer to the original string */
9820 tok = &str[pos];
9822 switch (descr->type) {
9823 case 'd':
9824 case 'o':
9825 case 'x':
9826 case 'u':
9827 case 'i':{
9828 char *endp; /* Position where the number finished */
9829 jim_wide w;
9831 int base = descr->type == 'o' ? 8
9832 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9834 /* Try to scan a number with the given base */
9835 if (base == 0) {
9836 w = jim_strtoull(tok, &endp);
9838 else {
9839 w = strtoull(tok, &endp, base);
9842 if (endp != tok) {
9843 /* There was some number sucessfully scanned! */
9844 *valObjPtr = Jim_NewIntObj(interp, w);
9846 /* Adjust the number-of-chars scanned so far */
9847 scanned += endp - tok;
9849 else {
9850 /* Nothing was scanned. We have to determine if this
9851 * happened due to e.g. prefix mismatch or input str
9852 * exhausted */
9853 scanned = *tok ? 0 : -1;
9855 break;
9857 case 's':
9858 case '[':{
9859 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9860 scanned += Jim_Length(*valObjPtr);
9861 break;
9863 case 'e':
9864 case 'f':
9865 case 'g':{
9866 char *endp;
9867 double value = strtod(tok, &endp);
9869 if (endp != tok) {
9870 /* There was some number sucessfully scanned! */
9871 *valObjPtr = Jim_NewDoubleObj(interp, value);
9872 /* Adjust the number-of-chars scanned so far */
9873 scanned += endp - tok;
9875 else {
9876 /* Nothing was scanned. We have to determine if this
9877 * happened due to e.g. prefix mismatch or input str
9878 * exhausted */
9879 scanned = *tok ? 0 : -1;
9881 break;
9884 /* If a substring was allocated (due to pre-defined width) do not
9885 * forget to free it */
9886 if (tmpObj) {
9887 Jim_FreeNewObj(interp, tmpObj);
9890 return scanned;
9893 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9894 * string and returns all converted (and not ignored) values in a list back
9895 * to the caller. If an error occured, a NULL pointer will be returned */
9897 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9899 size_t i, pos;
9900 int scanned = 1;
9901 const char *str = Jim_String(strObjPtr);
9902 int strLen = Jim_Utf8Length(interp, strObjPtr);
9903 Jim_Obj *resultList = 0;
9904 Jim_Obj **resultVec = 0;
9905 int resultc;
9906 Jim_Obj *emptyStr = 0;
9907 ScanFmtStringObj *fmtObj;
9909 /* This should never happen. The format object should already be of the correct type */
9910 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9912 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9913 /* Check if format specification was valid */
9914 if (fmtObj->error != 0) {
9915 if (flags & JIM_ERRMSG)
9916 Jim_SetResultString(interp, fmtObj->error, -1);
9917 return 0;
9919 /* Allocate a new "shared" empty string for all unassigned conversions */
9920 emptyStr = Jim_NewEmptyStringObj(interp);
9921 Jim_IncrRefCount(emptyStr);
9922 /* Create a list and fill it with empty strings up to max specified XPG3 */
9923 resultList = Jim_NewListObj(interp, NULL, 0);
9924 if (fmtObj->maxPos > 0) {
9925 for (i = 0; i < fmtObj->maxPos; ++i)
9926 Jim_ListAppendElement(interp, resultList, emptyStr);
9927 JimListGetElements(interp, resultList, &resultc, &resultVec);
9929 /* Now handle every partial format description */
9930 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9931 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9932 Jim_Obj *value = 0;
9934 /* Only last type may be "literal" w/o conversion - skip it! */
9935 if (descr->type == 0)
9936 continue;
9937 /* As long as any conversion could be done, we will proceed */
9938 if (scanned > 0)
9939 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9940 /* In case our first try results in EOF, we will leave */
9941 if (scanned == -1 && i == 0)
9942 goto eof;
9943 /* Advance next pos-to-be-scanned for the amount scanned already */
9944 pos += scanned;
9946 /* value == 0 means no conversion took place so take empty string */
9947 if (value == 0)
9948 value = Jim_NewEmptyStringObj(interp);
9949 /* If value is a non-assignable one, skip it */
9950 if (descr->pos == -1) {
9951 Jim_FreeNewObj(interp, value);
9953 else if (descr->pos == 0)
9954 /* Otherwise append it to the result list if no XPG3 was given */
9955 Jim_ListAppendElement(interp, resultList, value);
9956 else if (resultVec[descr->pos - 1] == emptyStr) {
9957 /* But due to given XPG3, put the value into the corr. slot */
9958 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9959 Jim_IncrRefCount(value);
9960 resultVec[descr->pos - 1] = value;
9962 else {
9963 /* Otherwise, the slot was already used - free obj and ERROR */
9964 Jim_FreeNewObj(interp, value);
9965 goto err;
9968 Jim_DecrRefCount(interp, emptyStr);
9969 return resultList;
9970 eof:
9971 Jim_DecrRefCount(interp, emptyStr);
9972 Jim_FreeNewObj(interp, resultList);
9973 return (Jim_Obj *)EOF;
9974 err:
9975 Jim_DecrRefCount(interp, emptyStr);
9976 Jim_FreeNewObj(interp, resultList);
9977 return 0;
9980 /* -----------------------------------------------------------------------------
9981 * Pseudo Random Number Generation
9982 * ---------------------------------------------------------------------------*/
9983 /* Initialize the sbox with the numbers from 0 to 255 */
9984 static void JimPrngInit(Jim_Interp *interp)
9986 #define PRNG_SEED_SIZE 256
9987 int i;
9988 unsigned int *seed;
9989 time_t t = time(NULL);
9991 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9993 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9994 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9995 seed[i] = (rand() ^ t ^ clock());
9997 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9998 Jim_Free(seed);
10001 /* Generates N bytes of random data */
10002 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10004 Jim_PrngState *prng;
10005 unsigned char *destByte = (unsigned char *)dest;
10006 unsigned int si, sj, x;
10008 /* initialization, only needed the first time */
10009 if (interp->prngState == NULL)
10010 JimPrngInit(interp);
10011 prng = interp->prngState;
10012 /* generates 'len' bytes of pseudo-random numbers */
10013 for (x = 0; x < len; x++) {
10014 prng->i = (prng->i + 1) & 0xff;
10015 si = prng->sbox[prng->i];
10016 prng->j = (prng->j + si) & 0xff;
10017 sj = prng->sbox[prng->j];
10018 prng->sbox[prng->i] = sj;
10019 prng->sbox[prng->j] = si;
10020 *destByte++ = prng->sbox[(si + sj) & 0xff];
10024 /* Re-seed the generator with user-provided bytes */
10025 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10027 int i;
10028 Jim_PrngState *prng;
10030 /* initialization, only needed the first time */
10031 if (interp->prngState == NULL)
10032 JimPrngInit(interp);
10033 prng = interp->prngState;
10035 /* Set the sbox[i] with i */
10036 for (i = 0; i < 256; i++)
10037 prng->sbox[i] = i;
10038 /* Now use the seed to perform a random permutation of the sbox */
10039 for (i = 0; i < seedLen; i++) {
10040 unsigned char t;
10042 t = prng->sbox[i & 0xFF];
10043 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10044 prng->sbox[seed[i]] = t;
10046 prng->i = prng->j = 0;
10048 /* discard at least the first 256 bytes of stream.
10049 * borrow the seed buffer for this
10051 for (i = 0; i < 256; i += seedLen) {
10052 JimRandomBytes(interp, seed, seedLen);
10056 /* [incr] */
10057 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10059 jim_wide wideValue, increment = 1;
10060 Jim_Obj *intObjPtr;
10062 if (argc != 2 && argc != 3) {
10063 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10064 return JIM_ERR;
10066 if (argc == 3) {
10067 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10068 return JIM_ERR;
10070 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10071 if (!intObjPtr) {
10072 /* Set missing variable to 0 */
10073 wideValue = 0;
10075 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10076 return JIM_ERR;
10078 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10079 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10080 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10081 Jim_FreeNewObj(interp, intObjPtr);
10082 return JIM_ERR;
10085 else {
10086 /* Can do it the quick way */
10087 Jim_InvalidateStringRep(intObjPtr);
10088 JimWideValue(intObjPtr) = wideValue + increment;
10090 /* The following step is required in order to invalidate the
10091 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10092 if (argv[1]->typePtr != &variableObjType) {
10093 /* Note that this can't fail since GetVariable already succeeded */
10094 Jim_SetVariable(interp, argv[1], intObjPtr);
10097 Jim_SetResult(interp, intObjPtr);
10098 return JIM_OK;
10102 /* -----------------------------------------------------------------------------
10103 * Eval
10104 * ---------------------------------------------------------------------------*/
10105 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10106 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10108 /* Handle calls to the [unknown] command */
10109 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10111 int retcode;
10113 /* If JimUnknown() is recursively called too many times...
10114 * done here
10116 if (interp->unknown_called > 50) {
10117 return JIM_ERR;
10120 /* The object interp->unknown just contains
10121 * the "unknown" string, it is used in order to
10122 * avoid to lookup the unknown command every time
10123 * but instead to cache the result. */
10125 /* If the [unknown] command does not exist ... */
10126 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10127 return JIM_ERR;
10129 interp->unknown_called++;
10130 /* XXX: Are we losing fileNameObj and linenr? */
10131 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10132 interp->unknown_called--;
10134 return retcode;
10137 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10139 int retcode;
10140 Jim_Cmd *cmdPtr;
10142 #if 0
10143 printf("invoke");
10144 int j;
10145 for (j = 0; j < objc; j++) {
10146 printf(" '%s'", Jim_String(objv[j]));
10148 printf("\n");
10149 #endif
10151 if (interp->framePtr->tailcallCmd) {
10152 /* Special tailcall command was pre-resolved */
10153 cmdPtr = interp->framePtr->tailcallCmd;
10154 interp->framePtr->tailcallCmd = NULL;
10156 else {
10157 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10158 if (cmdPtr == NULL) {
10159 return JimUnknown(interp, objc, objv);
10161 JimIncrCmdRefCount(cmdPtr);
10164 if (interp->evalDepth == interp->maxEvalDepth) {
10165 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10166 retcode = JIM_ERR;
10167 goto out;
10169 interp->evalDepth++;
10171 /* Call it -- Make sure result is an empty object. */
10172 Jim_SetEmptyResult(interp);
10173 if (cmdPtr->isproc) {
10174 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10176 else {
10177 interp->cmdPrivData = cmdPtr->u.native.privData;
10178 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10180 interp->evalDepth--;
10182 out:
10183 JimDecrCmdRefCount(interp, cmdPtr);
10185 return retcode;
10188 /* Eval the object vector 'objv' composed of 'objc' elements.
10189 * Every element is used as single argument.
10190 * Jim_EvalObj() will call this function every time its object
10191 * argument is of "list" type, with no string representation.
10193 * This is possible because the string representation of a
10194 * list object generated by the UpdateStringOfList is made
10195 * in a way that ensures that every list element is a different
10196 * command argument. */
10197 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10199 int i, retcode;
10201 /* Incr refcount of arguments. */
10202 for (i = 0; i < objc; i++)
10203 Jim_IncrRefCount(objv[i]);
10205 retcode = JimInvokeCommand(interp, objc, objv);
10207 /* Decr refcount of arguments and return the retcode */
10208 for (i = 0; i < objc; i++)
10209 Jim_DecrRefCount(interp, objv[i]);
10211 return retcode;
10215 * Invokes 'prefix' as a command with the objv array as arguments.
10217 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10219 int ret;
10220 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10222 nargv[0] = prefix;
10223 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10224 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10225 Jim_Free(nargv);
10226 return ret;
10229 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10231 int rc = retcode;
10233 if (rc == JIM_ERR && !interp->errorFlag) {
10234 /* This is the first error, so save the file/line information and reset the stack */
10235 interp->errorFlag = 1;
10236 Jim_IncrRefCount(script->fileNameObj);
10237 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10238 interp->errorFileNameObj = script->fileNameObj;
10239 interp->errorLine = script->linenr;
10241 JimResetStackTrace(interp);
10242 /* Always add a level where the error first occurs */
10243 interp->addStackTrace++;
10246 /* Now if this is an "interesting" level, add it to the stack trace */
10247 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10248 /* Add the stack info for the current level */
10250 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10252 /* Note: if we didn't have a filename for this level,
10253 * don't clear the addStackTrace flag
10254 * so we can pick it up at the next level
10256 if (Jim_Length(script->fileNameObj)) {
10257 interp->addStackTrace = 0;
10260 Jim_DecrRefCount(interp, interp->errorProc);
10261 interp->errorProc = interp->emptyObj;
10262 Jim_IncrRefCount(interp->errorProc);
10264 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10265 /* Propagate the addStackTrace value through 'return -code error' */
10267 else {
10268 interp->addStackTrace = 0;
10272 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10274 Jim_Obj *objPtr;
10276 switch (token->type) {
10277 case JIM_TT_STR:
10278 case JIM_TT_ESC:
10279 objPtr = token->objPtr;
10280 break;
10281 case JIM_TT_VAR:
10282 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10283 break;
10284 case JIM_TT_DICTSUGAR:
10285 objPtr = JimExpandDictSugar(interp, token->objPtr);
10286 break;
10287 case JIM_TT_EXPRSUGAR:
10288 objPtr = JimExpandExprSugar(interp, token->objPtr);
10289 break;
10290 case JIM_TT_CMD:
10291 switch (Jim_EvalObj(interp, token->objPtr)) {
10292 case JIM_OK:
10293 case JIM_RETURN:
10294 objPtr = interp->result;
10295 break;
10296 case JIM_BREAK:
10297 /* Stop substituting */
10298 return JIM_BREAK;
10299 case JIM_CONTINUE:
10300 /* just skip this one */
10301 return JIM_CONTINUE;
10302 default:
10303 return JIM_ERR;
10305 break;
10306 default:
10307 JimPanic((1,
10308 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10309 objPtr = NULL;
10310 break;
10312 if (objPtr) {
10313 *objPtrPtr = objPtr;
10314 return JIM_OK;
10316 return JIM_ERR;
10319 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10320 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10321 * The returned object has refcount = 0.
10323 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10325 int totlen = 0, i;
10326 Jim_Obj **intv;
10327 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10328 Jim_Obj *objPtr;
10329 char *s;
10331 if (tokens <= JIM_EVAL_SINTV_LEN)
10332 intv = sintv;
10333 else
10334 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10336 /* Compute every token forming the argument
10337 * in the intv objects vector. */
10338 for (i = 0; i < tokens; i++) {
10339 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10340 case JIM_OK:
10341 case JIM_RETURN:
10342 break;
10343 case JIM_BREAK:
10344 if (flags & JIM_SUBST_FLAG) {
10345 /* Stop here */
10346 tokens = i;
10347 continue;
10349 /* XXX: Should probably set an error about break outside loop */
10350 /* fall through to error */
10351 case JIM_CONTINUE:
10352 if (flags & JIM_SUBST_FLAG) {
10353 intv[i] = NULL;
10354 continue;
10356 /* XXX: Ditto continue outside loop */
10357 /* fall through to error */
10358 default:
10359 while (i--) {
10360 Jim_DecrRefCount(interp, intv[i]);
10362 if (intv != sintv) {
10363 Jim_Free(intv);
10365 return NULL;
10367 Jim_IncrRefCount(intv[i]);
10368 Jim_String(intv[i]);
10369 totlen += intv[i]->length;
10372 /* Fast path return for a single token */
10373 if (tokens == 1 && intv[0] && intv == sintv) {
10374 Jim_DecrRefCount(interp, intv[0]);
10375 return intv[0];
10378 /* Concatenate every token in an unique
10379 * object. */
10380 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10382 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10383 && token[2].type == JIM_TT_VAR) {
10384 /* May be able to do fast interpolated object -> dictSubst */
10385 objPtr->typePtr = &interpolatedObjType;
10386 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10387 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10388 Jim_IncrRefCount(intv[2]);
10390 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10391 /* The first interpolated token is source, so preserve the source info */
10392 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10396 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10397 objPtr->length = totlen;
10398 for (i = 0; i < tokens; i++) {
10399 if (intv[i]) {
10400 memcpy(s, intv[i]->bytes, intv[i]->length);
10401 s += intv[i]->length;
10402 Jim_DecrRefCount(interp, intv[i]);
10405 objPtr->bytes[totlen] = '\0';
10406 /* Free the intv vector if not static. */
10407 if (intv != sintv) {
10408 Jim_Free(intv);
10411 return objPtr;
10415 /* listPtr *must* be a list.
10416 * The contents of the list is evaluated with the first element as the command and
10417 * the remaining elements as the arguments.
10419 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10421 int retcode = JIM_OK;
10423 if (listPtr->internalRep.listValue.len) {
10424 Jim_IncrRefCount(listPtr);
10425 retcode = JimInvokeCommand(interp,
10426 listPtr->internalRep.listValue.len,
10427 listPtr->internalRep.listValue.ele);
10428 Jim_DecrRefCount(interp, listPtr);
10430 return retcode;
10433 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10435 SetListFromAny(interp, listPtr);
10436 return JimEvalObjList(interp, listPtr);
10439 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10441 int i;
10442 ScriptObj *script;
10443 ScriptToken *token;
10444 int retcode = JIM_OK;
10445 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10446 Jim_Obj *prevScriptObj;
10448 /* If the object is of type "list", with no string rep we can call
10449 * a specialized version of Jim_EvalObj() */
10450 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10451 return JimEvalObjList(interp, scriptObjPtr);
10454 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10455 script = Jim_GetScript(interp, scriptObjPtr);
10456 if (script == NULL) {
10457 Jim_DecrRefCount(interp, scriptObjPtr);
10458 return JIM_ERR;
10461 /* Reset the interpreter result. This is useful to
10462 * return the empty result in the case of empty program. */
10463 Jim_SetEmptyResult(interp);
10465 token = script->token;
10467 #ifdef JIM_OPTIMIZATION
10468 /* Check for one of the following common scripts used by for, while
10470 * {}
10471 * incr a
10473 if (script->len == 0) {
10474 Jim_DecrRefCount(interp, scriptObjPtr);
10475 return JIM_OK;
10477 if (script->len == 3
10478 && token[1].objPtr->typePtr == &commandObjType
10479 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10480 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10481 && token[2].objPtr->typePtr == &variableObjType) {
10483 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10485 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10486 JimWideValue(objPtr)++;
10487 Jim_InvalidateStringRep(objPtr);
10488 Jim_DecrRefCount(interp, scriptObjPtr);
10489 Jim_SetResult(interp, objPtr);
10490 return JIM_OK;
10493 #endif
10495 /* Now we have to make sure the internal repr will not be
10496 * freed on shimmering.
10498 * Think for example to this:
10500 * set x {llength $x; ... some more code ...}; eval $x
10502 * In order to preserve the internal rep, we increment the
10503 * inUse field of the script internal rep structure. */
10504 script->inUse++;
10506 /* Stash the current script */
10507 prevScriptObj = interp->currentScriptObj;
10508 interp->currentScriptObj = scriptObjPtr;
10510 interp->errorFlag = 0;
10511 argv = sargv;
10513 /* Execute every command sequentially until the end of the script
10514 * or an error occurs.
10516 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10517 int argc;
10518 int j;
10520 /* First token of the line is always JIM_TT_LINE */
10521 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10522 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10524 /* Allocate the arguments vector if required */
10525 if (argc > JIM_EVAL_SARGV_LEN)
10526 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10528 /* Skip the JIM_TT_LINE token */
10529 i++;
10531 /* Populate the arguments objects.
10532 * If an error occurs, retcode will be set and
10533 * 'j' will be set to the number of args expanded
10535 for (j = 0; j < argc; j++) {
10536 long wordtokens = 1;
10537 int expand = 0;
10538 Jim_Obj *wordObjPtr = NULL;
10540 if (token[i].type == JIM_TT_WORD) {
10541 wordtokens = JimWideValue(token[i++].objPtr);
10542 if (wordtokens < 0) {
10543 expand = 1;
10544 wordtokens = -wordtokens;
10548 if (wordtokens == 1) {
10549 /* Fast path if the token does not
10550 * need interpolation */
10552 switch (token[i].type) {
10553 case JIM_TT_ESC:
10554 case JIM_TT_STR:
10555 wordObjPtr = token[i].objPtr;
10556 break;
10557 case JIM_TT_VAR:
10558 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10559 break;
10560 case JIM_TT_EXPRSUGAR:
10561 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10562 break;
10563 case JIM_TT_DICTSUGAR:
10564 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10565 break;
10566 case JIM_TT_CMD:
10567 retcode = Jim_EvalObj(interp, token[i].objPtr);
10568 if (retcode == JIM_OK) {
10569 wordObjPtr = Jim_GetResult(interp);
10571 break;
10572 default:
10573 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10576 else {
10577 /* For interpolation we call a helper
10578 * function to do the work for us. */
10579 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10582 if (!wordObjPtr) {
10583 if (retcode == JIM_OK) {
10584 retcode = JIM_ERR;
10586 break;
10589 Jim_IncrRefCount(wordObjPtr);
10590 i += wordtokens;
10592 if (!expand) {
10593 argv[j] = wordObjPtr;
10595 else {
10596 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10597 int len = Jim_ListLength(interp, wordObjPtr);
10598 int newargc = argc + len - 1;
10599 int k;
10601 if (len > 1) {
10602 if (argv == sargv) {
10603 if (newargc > JIM_EVAL_SARGV_LEN) {
10604 argv = Jim_Alloc(sizeof(*argv) * newargc);
10605 memcpy(argv, sargv, sizeof(*argv) * j);
10608 else {
10609 /* Need to realloc to make room for (len - 1) more entries */
10610 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10614 /* Now copy in the expanded version */
10615 for (k = 0; k < len; k++) {
10616 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10617 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10620 /* The original object reference is no longer needed,
10621 * after the expansion it is no longer present on
10622 * the argument vector, but the single elements are
10623 * in its place. */
10624 Jim_DecrRefCount(interp, wordObjPtr);
10626 /* And update the indexes */
10627 j--;
10628 argc += len - 1;
10632 if (retcode == JIM_OK && argc) {
10633 /* Invoke the command */
10634 retcode = JimInvokeCommand(interp, argc, argv);
10635 /* Check for a signal after each command */
10636 if (Jim_CheckSignal(interp)) {
10637 retcode = JIM_SIGNAL;
10641 /* Finished with the command, so decrement ref counts of each argument */
10642 while (j-- > 0) {
10643 Jim_DecrRefCount(interp, argv[j]);
10646 if (argv != sargv) {
10647 Jim_Free(argv);
10648 argv = sargv;
10652 /* Possibly add to the error stack trace */
10653 JimAddErrorToStack(interp, retcode, script);
10655 /* Restore the current script */
10656 interp->currentScriptObj = prevScriptObj;
10658 /* Note that we don't have to decrement inUse, because the
10659 * following code transfers our use of the reference again to
10660 * the script object. */
10661 Jim_FreeIntRep(interp, scriptObjPtr);
10662 scriptObjPtr->typePtr = &scriptObjType;
10663 Jim_SetIntRepPtr(scriptObjPtr, script);
10664 Jim_DecrRefCount(interp, scriptObjPtr);
10666 return retcode;
10669 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10671 int retcode;
10672 /* If argObjPtr begins with '&', do an automatic upvar */
10673 const char *varname = Jim_String(argNameObj);
10674 if (*varname == '&') {
10675 /* First check that the target variable exists */
10676 Jim_Obj *objPtr;
10677 Jim_CallFrame *savedCallFrame = interp->framePtr;
10679 interp->framePtr = interp->framePtr->parent;
10680 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10681 interp->framePtr = savedCallFrame;
10682 if (!objPtr) {
10683 return JIM_ERR;
10686 /* It exists, so perform the binding. */
10687 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10688 Jim_IncrRefCount(objPtr);
10689 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10690 Jim_DecrRefCount(interp, objPtr);
10692 else {
10693 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10695 return retcode;
10699 * Sets the interp result to be an error message indicating the required proc args.
10701 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10703 /* Create a nice error message, consistent with Tcl 8.5 */
10704 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10705 int i;
10707 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10708 Jim_AppendString(interp, argmsg, " ", 1);
10710 if (i == cmd->u.proc.argsPos) {
10711 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10712 /* Renamed args */
10713 Jim_AppendString(interp, argmsg, "?", 1);
10714 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10715 Jim_AppendString(interp, argmsg, " ...?", -1);
10717 else {
10718 /* We have plain args */
10719 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10722 else {
10723 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10724 Jim_AppendString(interp, argmsg, "?", 1);
10725 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10726 Jim_AppendString(interp, argmsg, "?", 1);
10728 else {
10729 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10730 if (*arg == '&') {
10731 arg++;
10733 Jim_AppendString(interp, argmsg, arg, -1);
10737 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10738 Jim_FreeNewObj(interp, argmsg);
10741 #ifdef jim_ext_namespace
10743 * [namespace eval]
10745 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10747 Jim_CallFrame *callFramePtr;
10748 int retcode;
10750 /* Create a new callframe */
10751 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10752 callFramePtr->argv = &interp->emptyObj;
10753 callFramePtr->argc = 0;
10754 callFramePtr->procArgsObjPtr = NULL;
10755 callFramePtr->procBodyObjPtr = scriptObj;
10756 callFramePtr->staticVars = NULL;
10757 callFramePtr->fileNameObj = interp->emptyObj;
10758 callFramePtr->line = 0;
10759 Jim_IncrRefCount(scriptObj);
10760 interp->framePtr = callFramePtr;
10762 /* Check if there are too nested calls */
10763 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10764 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10765 retcode = JIM_ERR;
10767 else {
10768 /* Eval the body */
10769 retcode = Jim_EvalObj(interp, scriptObj);
10772 /* Destroy the callframe */
10773 interp->framePtr = interp->framePtr->parent;
10774 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10776 return retcode;
10778 #endif
10780 /* Call a procedure implemented in Tcl.
10781 * It's possible to speed-up a lot this function, currently
10782 * the callframes are not cached, but allocated and
10783 * destroied every time. What is expecially costly is
10784 * to create/destroy the local vars hash table every time.
10786 * This can be fixed just implementing callframes caching
10787 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10788 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10790 Jim_CallFrame *callFramePtr;
10791 int i, d, retcode, optargs;
10792 ScriptObj *script;
10794 /* Check arity */
10795 if (argc - 1 < cmd->u.proc.reqArity ||
10796 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10797 JimSetProcWrongArgs(interp, argv[0], cmd);
10798 return JIM_ERR;
10801 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10802 /* Optimise for procedure with no body - useful for optional debugging */
10803 return JIM_OK;
10806 /* Check if there are too nested calls */
10807 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10808 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10809 return JIM_ERR;
10812 /* Create a new callframe */
10813 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10814 callFramePtr->argv = argv;
10815 callFramePtr->argc = argc;
10816 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10817 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10818 callFramePtr->staticVars = cmd->u.proc.staticVars;
10820 /* Remember where we were called from. */
10821 script = Jim_GetScript(interp, interp->currentScriptObj);
10822 callFramePtr->fileNameObj = script->fileNameObj;
10823 callFramePtr->line = script->linenr;
10825 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10826 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10827 interp->framePtr = callFramePtr;
10829 /* How many optional args are available */
10830 optargs = (argc - 1 - cmd->u.proc.reqArity);
10832 /* Step 'i' along the actual args, and step 'd' along the formal args */
10833 i = 1;
10834 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10835 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10836 if (d == cmd->u.proc.argsPos) {
10837 /* assign $args */
10838 Jim_Obj *listObjPtr;
10839 int argsLen = 0;
10840 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10841 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10843 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10845 /* It is possible to rename args. */
10846 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10847 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10849 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10850 if (retcode != JIM_OK) {
10851 goto badargset;
10854 i += argsLen;
10855 continue;
10858 /* Optional or required? */
10859 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10860 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10862 else {
10863 /* Ran out, so use the default */
10864 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10866 if (retcode != JIM_OK) {
10867 goto badargset;
10871 /* Eval the body */
10872 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10874 badargset:
10876 /* Free the callframe */
10877 interp->framePtr = interp->framePtr->parent;
10878 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10880 if (interp->framePtr->tailcallObj) {
10881 /* If a tailcall is already being executed, merge this tailcall with that one */
10882 if (interp->framePtr->tailcall++ == 0) {
10883 /* No current tailcall in this frame, so invoke the tailcall command */
10884 do {
10885 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10887 interp->framePtr->tailcallObj = NULL;
10889 if (retcode == JIM_EVAL) {
10890 retcode = Jim_EvalObjList(interp, tailcallObj);
10891 if (retcode == JIM_RETURN) {
10892 /* If the result of the tailcall is 'return', push
10893 * it up to the caller
10895 interp->returnLevel++;
10898 Jim_DecrRefCount(interp, tailcallObj);
10899 } while (interp->framePtr->tailcallObj);
10901 /* If the tailcall chain finished early, may need to manually discard the command */
10902 if (interp->framePtr->tailcallCmd) {
10903 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10904 interp->framePtr->tailcallCmd = NULL;
10907 interp->framePtr->tailcall--;
10910 /* Handle the JIM_RETURN return code */
10911 if (retcode == JIM_RETURN) {
10912 if (--interp->returnLevel <= 0) {
10913 retcode = interp->returnCode;
10914 interp->returnCode = JIM_OK;
10915 interp->returnLevel = 0;
10918 else if (retcode == JIM_ERR) {
10919 interp->addStackTrace++;
10920 Jim_DecrRefCount(interp, interp->errorProc);
10921 interp->errorProc = argv[0];
10922 Jim_IncrRefCount(interp->errorProc);
10925 return retcode;
10928 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10930 int retval;
10931 Jim_Obj *scriptObjPtr;
10933 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10934 Jim_IncrRefCount(scriptObjPtr);
10936 if (filename) {
10937 Jim_Obj *prevScriptObj;
10939 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10941 prevScriptObj = interp->currentScriptObj;
10942 interp->currentScriptObj = scriptObjPtr;
10944 retval = Jim_EvalObj(interp, scriptObjPtr);
10946 interp->currentScriptObj = prevScriptObj;
10948 else {
10949 retval = Jim_EvalObj(interp, scriptObjPtr);
10951 Jim_DecrRefCount(interp, scriptObjPtr);
10952 return retval;
10955 int Jim_Eval(Jim_Interp *interp, const char *script)
10957 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10960 /* Execute script in the scope of the global level */
10961 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10963 int retval;
10964 Jim_CallFrame *savedFramePtr = interp->framePtr;
10966 interp->framePtr = interp->topFramePtr;
10967 retval = Jim_Eval(interp, script);
10968 interp->framePtr = savedFramePtr;
10970 return retval;
10973 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10975 int retval;
10976 Jim_CallFrame *savedFramePtr = interp->framePtr;
10978 interp->framePtr = interp->topFramePtr;
10979 retval = Jim_EvalFile(interp, filename);
10980 interp->framePtr = savedFramePtr;
10982 return retval;
10985 #include <sys/stat.h>
10987 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10989 FILE *fp;
10990 char *buf;
10991 Jim_Obj *scriptObjPtr;
10992 Jim_Obj *prevScriptObj;
10993 struct stat sb;
10994 int retcode;
10995 int readlen;
10997 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10998 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10999 return JIM_ERR;
11001 if (sb.st_size == 0) {
11002 fclose(fp);
11003 return JIM_OK;
11006 buf = Jim_Alloc(sb.st_size + 1);
11007 readlen = fread(buf, 1, sb.st_size, fp);
11008 if (ferror(fp)) {
11009 fclose(fp);
11010 Jim_Free(buf);
11011 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11012 return JIM_ERR;
11014 fclose(fp);
11015 buf[readlen] = 0;
11017 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11018 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11019 Jim_IncrRefCount(scriptObjPtr);
11021 /* Now check the script for unmatched braces, etc. */
11022 if (Jim_GetScript(interp, scriptObjPtr) == NULL) {
11023 /* EvalFile changes context, so add a stack frame here */
11024 JimAddErrorToStack(interp, JIM_ERR, (ScriptObj *)Jim_GetIntRepPtr(scriptObjPtr));
11025 Jim_DecrRefCount(interp, scriptObjPtr);
11026 return JIM_ERR;
11029 prevScriptObj = interp->currentScriptObj;
11030 interp->currentScriptObj = scriptObjPtr;
11032 retcode = Jim_EvalObj(interp, scriptObjPtr);
11034 /* Handle the JIM_RETURN return code */
11035 if (retcode == JIM_RETURN) {
11036 if (--interp->returnLevel <= 0) {
11037 retcode = interp->returnCode;
11038 interp->returnCode = JIM_OK;
11039 interp->returnLevel = 0;
11042 if (retcode == JIM_ERR) {
11043 /* EvalFile changes context, so add a stack frame here */
11044 interp->addStackTrace++;
11047 interp->currentScriptObj = prevScriptObj;
11049 Jim_DecrRefCount(interp, scriptObjPtr);
11051 return retcode;
11054 /* -----------------------------------------------------------------------------
11055 * Subst
11056 * ---------------------------------------------------------------------------*/
11057 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11059 pc->tstart = pc->p;
11060 pc->tline = pc->linenr;
11062 if (pc->len == 0) {
11063 pc->tend = pc->p;
11064 pc->tt = JIM_TT_EOL;
11065 pc->eof = 1;
11066 return;
11068 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11069 JimParseCmd(pc);
11070 return;
11072 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11073 if (JimParseVar(pc) == JIM_OK) {
11074 return;
11076 /* Not a var, so treat as a string */
11077 pc->tstart = pc->p;
11078 flags |= JIM_SUBST_NOVAR;
11080 while (pc->len) {
11081 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11082 break;
11084 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11085 break;
11087 if (*pc->p == '\\' && pc->len > 1) {
11088 pc->p++;
11089 pc->len--;
11091 pc->p++;
11092 pc->len--;
11094 pc->tend = pc->p - 1;
11095 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11098 /* The subst object type reuses most of the data structures and functions
11099 * of the script object. Script's data structures are a bit more complex
11100 * for what is needed for [subst]itution tasks, but the reuse helps to
11101 * deal with a single data structure at the cost of some more memory
11102 * usage for substitutions. */
11104 /* This method takes the string representation of an object
11105 * as a Tcl string where to perform [subst]itution, and generates
11106 * the pre-parsed internal representation. */
11107 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11109 int scriptTextLen;
11110 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11111 struct JimParserCtx parser;
11112 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11113 ParseTokenList tokenlist;
11115 /* Initially parse the subst into tokens (in tokenlist) */
11116 ScriptTokenListInit(&tokenlist);
11118 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11119 while (1) {
11120 JimParseSubst(&parser, flags);
11121 if (parser.eof) {
11122 /* Note that subst doesn't need the EOL token */
11123 break;
11125 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11126 parser.tline);
11129 /* Create the "real" subst/script tokens from the initial token list */
11130 script->inUse = 1;
11131 script->substFlags = flags;
11132 script->fileNameObj = interp->emptyObj;
11133 Jim_IncrRefCount(script->fileNameObj);
11134 SubstObjAddTokens(interp, script, &tokenlist);
11136 /* No longer need the token list */
11137 ScriptTokenListFree(&tokenlist);
11139 #ifdef DEBUG_SHOW_SUBST
11141 int i;
11143 printf("==== Subst ====\n");
11144 for (i = 0; i < script->len; i++) {
11145 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11146 Jim_String(script->token[i].objPtr));
11149 #endif
11151 /* Free the old internal rep and set the new one. */
11152 Jim_FreeIntRep(interp, objPtr);
11153 Jim_SetIntRepPtr(objPtr, script);
11154 objPtr->typePtr = &scriptObjType;
11155 return JIM_OK;
11158 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11160 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11161 SetSubstFromAny(interp, objPtr, flags);
11162 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11165 /* Performs commands,variables,blackslashes substitution,
11166 * storing the result object (with refcount 0) into
11167 * resObjPtrPtr. */
11168 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11170 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11172 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11173 /* In order to preserve the internal rep, we increment the
11174 * inUse field of the script internal rep structure. */
11175 script->inUse++;
11177 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11179 script->inUse--;
11180 Jim_DecrRefCount(interp, substObjPtr);
11181 if (*resObjPtrPtr == NULL) {
11182 return JIM_ERR;
11184 return JIM_OK;
11187 /* -----------------------------------------------------------------------------
11188 * Core commands utility functions
11189 * ---------------------------------------------------------------------------*/
11190 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11192 Jim_Obj *objPtr;
11193 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11195 if (*msg) {
11196 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11198 Jim_IncrRefCount(listObjPtr);
11199 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11200 Jim_DecrRefCount(interp, listObjPtr);
11202 Jim_IncrRefCount(objPtr);
11203 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11204 Jim_DecrRefCount(interp, objPtr);
11208 * May add the key and/or value to the list.
11210 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11211 Jim_HashEntry *he, int type);
11213 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11216 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11217 * invoke the callback to add entries to a list.
11218 * Returns the list.
11220 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11221 JimHashtableIteratorCallbackType *callback, int type)
11223 Jim_HashEntry *he;
11224 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11226 /* Check for the non-pattern case. We can do this much more efficiently. */
11227 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11228 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11229 if (he) {
11230 callback(interp, listObjPtr, he, type);
11233 else {
11234 Jim_HashTableIterator htiter;
11235 JimInitHashTableIterator(ht, &htiter);
11236 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11237 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11238 callback(interp, listObjPtr, he, type);
11242 return listObjPtr;
11245 /* Keep these in order */
11246 #define JIM_CMDLIST_COMMANDS 0
11247 #define JIM_CMDLIST_PROCS 1
11248 #define JIM_CMDLIST_CHANNELS 2
11251 * Adds matching command names (procs, channels) to the list.
11253 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11254 Jim_HashEntry *he, int type)
11256 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11257 Jim_Obj *objPtr;
11259 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11260 /* not a proc */
11261 return;
11264 objPtr = Jim_NewStringObj(interp, he->key, -1);
11265 Jim_IncrRefCount(objPtr);
11267 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11268 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11270 Jim_DecrRefCount(interp, objPtr);
11273 /* type is JIM_CMDLIST_xxx */
11274 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11276 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11279 /* Keep these in order */
11280 #define JIM_VARLIST_GLOBALS 0
11281 #define JIM_VARLIST_LOCALS 1
11282 #define JIM_VARLIST_VARS 2
11284 #define JIM_VARLIST_VALUES 0x1000
11287 * Adds matching variable names to the list.
11289 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11290 Jim_HashEntry *he, int type)
11292 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11294 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11295 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11296 if (type & JIM_VARLIST_VALUES) {
11297 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11302 /* mode is JIM_VARLIST_xxx */
11303 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11305 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11306 /* For [info locals], if we are at top level an emtpy list
11307 * is returned. I don't agree, but we aim at compatibility (SS) */
11308 return interp->emptyObj;
11310 else {
11311 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11312 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11316 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11317 Jim_Obj **objPtrPtr, int info_level_cmd)
11319 Jim_CallFrame *targetCallFrame;
11321 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11322 if (targetCallFrame == NULL) {
11323 return JIM_ERR;
11325 /* No proc call at toplevel callframe */
11326 if (targetCallFrame == interp->topFramePtr) {
11327 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11328 return JIM_ERR;
11330 if (info_level_cmd) {
11331 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11333 else {
11334 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11336 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11337 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11338 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11339 *objPtrPtr = listObj;
11341 return JIM_OK;
11344 /* -----------------------------------------------------------------------------
11345 * Core commands
11346 * ---------------------------------------------------------------------------*/
11348 /* fake [puts] -- not the real puts, just for debugging. */
11349 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11351 if (argc != 2 && argc != 3) {
11352 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11353 return JIM_ERR;
11355 if (argc == 3) {
11356 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11357 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11358 return JIM_ERR;
11360 else {
11361 fputs(Jim_String(argv[2]), stdout);
11364 else {
11365 puts(Jim_String(argv[1]));
11367 return JIM_OK;
11370 /* Helper for [+] and [*] */
11371 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11373 jim_wide wideValue, res;
11374 double doubleValue, doubleRes;
11375 int i;
11377 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11379 for (i = 1; i < argc; i++) {
11380 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11381 goto trydouble;
11382 if (op == JIM_EXPROP_ADD)
11383 res += wideValue;
11384 else
11385 res *= wideValue;
11387 Jim_SetResultInt(interp, res);
11388 return JIM_OK;
11389 trydouble:
11390 doubleRes = (double)res;
11391 for (; i < argc; i++) {
11392 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11393 return JIM_ERR;
11394 if (op == JIM_EXPROP_ADD)
11395 doubleRes += doubleValue;
11396 else
11397 doubleRes *= doubleValue;
11399 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11400 return JIM_OK;
11403 /* Helper for [-] and [/] */
11404 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11406 jim_wide wideValue, res = 0;
11407 double doubleValue, doubleRes = 0;
11408 int i = 2;
11410 if (argc < 2) {
11411 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11412 return JIM_ERR;
11414 else if (argc == 2) {
11415 /* The arity = 2 case is different. For [- x] returns -x,
11416 * while [/ x] returns 1/x. */
11417 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11418 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11419 return JIM_ERR;
11421 else {
11422 if (op == JIM_EXPROP_SUB)
11423 doubleRes = -doubleValue;
11424 else
11425 doubleRes = 1.0 / doubleValue;
11426 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11427 return JIM_OK;
11430 if (op == JIM_EXPROP_SUB) {
11431 res = -wideValue;
11432 Jim_SetResultInt(interp, res);
11434 else {
11435 doubleRes = 1.0 / wideValue;
11436 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11438 return JIM_OK;
11440 else {
11441 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11442 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11443 != JIM_OK) {
11444 return JIM_ERR;
11446 else {
11447 goto trydouble;
11451 for (i = 2; i < argc; i++) {
11452 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11453 doubleRes = (double)res;
11454 goto trydouble;
11456 if (op == JIM_EXPROP_SUB)
11457 res -= wideValue;
11458 else
11459 res /= wideValue;
11461 Jim_SetResultInt(interp, res);
11462 return JIM_OK;
11463 trydouble:
11464 for (; i < argc; i++) {
11465 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11466 return JIM_ERR;
11467 if (op == JIM_EXPROP_SUB)
11468 doubleRes -= doubleValue;
11469 else
11470 doubleRes /= doubleValue;
11472 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11473 return JIM_OK;
11477 /* [+] */
11478 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11480 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11483 /* [*] */
11484 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11486 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11489 /* [-] */
11490 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11492 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11495 /* [/] */
11496 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11498 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11501 /* [set] */
11502 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11504 if (argc != 2 && argc != 3) {
11505 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11506 return JIM_ERR;
11508 if (argc == 2) {
11509 Jim_Obj *objPtr;
11511 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11512 if (!objPtr)
11513 return JIM_ERR;
11514 Jim_SetResult(interp, objPtr);
11515 return JIM_OK;
11517 /* argc == 3 case. */
11518 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11519 return JIM_ERR;
11520 Jim_SetResult(interp, argv[2]);
11521 return JIM_OK;
11524 /* [unset]
11526 * unset ?-nocomplain? ?--? ?varName ...?
11528 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11530 int i = 1;
11531 int complain = 1;
11533 while (i < argc) {
11534 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11535 i++;
11536 break;
11538 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11539 complain = 0;
11540 i++;
11541 continue;
11543 break;
11546 while (i < argc) {
11547 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11548 && complain) {
11549 return JIM_ERR;
11551 i++;
11553 return JIM_OK;
11556 /* [while] */
11557 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11559 if (argc != 3) {
11560 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11561 return JIM_ERR;
11564 /* The general purpose implementation of while starts here */
11565 while (1) {
11566 int boolean, retval;
11568 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11569 return retval;
11570 if (!boolean)
11571 break;
11573 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11574 switch (retval) {
11575 case JIM_BREAK:
11576 goto out;
11577 break;
11578 case JIM_CONTINUE:
11579 continue;
11580 break;
11581 default:
11582 return retval;
11586 out:
11587 Jim_SetEmptyResult(interp);
11588 return JIM_OK;
11591 /* [for] */
11592 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11594 int retval;
11595 int boolean = 1;
11596 Jim_Obj *varNamePtr = NULL;
11597 Jim_Obj *stopVarNamePtr = NULL;
11599 if (argc != 5) {
11600 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11601 return JIM_ERR;
11604 /* Do the initialisation */
11605 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11606 return retval;
11609 /* And do the first test now. Better for optimisation
11610 * if we can do next/test at the bottom of the loop
11612 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11614 /* Ready to do the body as follows:
11615 * while (1) {
11616 * body // check retcode
11617 * next // check retcode
11618 * test // check retcode/test bool
11622 #ifdef JIM_OPTIMIZATION
11623 /* Check if the for is on the form:
11624 * for ... {$i < CONST} {incr i}
11625 * for ... {$i < $j} {incr i}
11627 if (retval == JIM_OK && boolean) {
11628 ScriptObj *incrScript;
11629 ExprByteCode *expr;
11630 jim_wide stop, currentVal;
11631 Jim_Obj *objPtr;
11632 int cmpOffset;
11634 /* Do it only if there aren't shared arguments */
11635 expr = JimGetExpression(interp, argv[2]);
11636 incrScript = Jim_GetScript(interp, argv[3]);
11638 /* Ensure proper lengths to start */
11639 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11640 goto evalstart;
11642 /* Ensure proper token types. */
11643 if (incrScript->token[1].type != JIM_TT_ESC ||
11644 expr->token[0].type != JIM_TT_VAR ||
11645 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11646 goto evalstart;
11649 if (expr->token[2].type == JIM_EXPROP_LT) {
11650 cmpOffset = 0;
11652 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11653 cmpOffset = 1;
11655 else {
11656 goto evalstart;
11659 /* Update command must be incr */
11660 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11661 goto evalstart;
11664 /* incr, expression must be about the same variable */
11665 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11666 goto evalstart;
11669 /* Get the stop condition (must be a variable or integer) */
11670 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11671 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11672 goto evalstart;
11675 else {
11676 stopVarNamePtr = expr->token[1].objPtr;
11677 Jim_IncrRefCount(stopVarNamePtr);
11678 /* Keep the compiler happy */
11679 stop = 0;
11682 /* Initialization */
11683 varNamePtr = expr->token[0].objPtr;
11684 Jim_IncrRefCount(varNamePtr);
11686 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11687 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11688 goto testcond;
11691 /* --- OPTIMIZED FOR --- */
11692 while (retval == JIM_OK) {
11693 /* === Check condition === */
11694 /* Note that currentVal is already set here */
11696 /* Immediate or Variable? get the 'stop' value if the latter. */
11697 if (stopVarNamePtr) {
11698 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11699 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11700 goto testcond;
11704 if (currentVal >= stop + cmpOffset) {
11705 break;
11708 /* Eval body */
11709 retval = Jim_EvalObj(interp, argv[4]);
11710 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11711 retval = JIM_OK;
11713 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11715 /* Increment */
11716 if (objPtr == NULL) {
11717 retval = JIM_ERR;
11718 goto out;
11720 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11721 currentVal = ++JimWideValue(objPtr);
11722 Jim_InvalidateStringRep(objPtr);
11724 else {
11725 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11726 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11727 ++currentVal)) != JIM_OK) {
11728 goto evalnext;
11733 goto out;
11735 evalstart:
11736 #endif
11738 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11739 /* Body */
11740 retval = Jim_EvalObj(interp, argv[4]);
11742 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11743 /* increment */
11744 evalnext:
11745 retval = Jim_EvalObj(interp, argv[3]);
11746 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11747 /* test */
11748 testcond:
11749 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11753 out:
11754 if (stopVarNamePtr) {
11755 Jim_DecrRefCount(interp, stopVarNamePtr);
11757 if (varNamePtr) {
11758 Jim_DecrRefCount(interp, varNamePtr);
11761 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11762 Jim_SetEmptyResult(interp);
11763 return JIM_OK;
11766 return retval;
11769 /* [loop] */
11770 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11772 int retval;
11773 jim_wide i;
11774 jim_wide limit;
11775 jim_wide incr = 1;
11776 Jim_Obj *bodyObjPtr;
11778 if (argc != 5 && argc != 6) {
11779 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11780 return JIM_ERR;
11783 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11784 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11785 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11786 return JIM_ERR;
11788 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11790 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11792 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11793 retval = Jim_EvalObj(interp, bodyObjPtr);
11794 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11795 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11797 retval = JIM_OK;
11799 /* Increment */
11800 i += incr;
11802 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11803 if (argv[1]->typePtr != &variableObjType) {
11804 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11805 return JIM_ERR;
11808 JimWideValue(objPtr) = i;
11809 Jim_InvalidateStringRep(objPtr);
11811 /* The following step is required in order to invalidate the
11812 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11813 if (argv[1]->typePtr != &variableObjType) {
11814 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11815 retval = JIM_ERR;
11816 break;
11820 else {
11821 objPtr = Jim_NewIntObj(interp, i);
11822 retval = Jim_SetVariable(interp, argv[1], objPtr);
11823 if (retval != JIM_OK) {
11824 Jim_FreeNewObj(interp, objPtr);
11830 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11831 Jim_SetEmptyResult(interp);
11832 return JIM_OK;
11834 return retval;
11837 /* List iterators make it easy to iterate over a list.
11838 * At some point iterators will be expanded to support generators.
11840 typedef struct {
11841 Jim_Obj *objPtr;
11842 int idx;
11843 } Jim_ListIter;
11846 * Initialise the iterator at the start of the list.
11848 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11850 iter->objPtr = objPtr;
11851 iter->idx = 0;
11855 * Returns the next object from the list, or NULL on end-of-list.
11857 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11859 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11860 return NULL;
11862 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11866 * Returns 1 if end-of-list has been reached.
11868 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11870 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11873 /* foreach + lmap implementation. */
11874 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11876 int result = JIM_ERR;
11877 int i, numargs;
11878 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11879 Jim_ListIter *iters;
11880 Jim_Obj *script;
11881 Jim_Obj *resultObj;
11883 if (argc < 4 || argc % 2 != 0) {
11884 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11885 return JIM_ERR;
11887 script = argv[argc - 1]; /* Last argument is a script */
11888 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11890 if (numargs == 2) {
11891 iters = twoiters;
11893 else {
11894 iters = Jim_Alloc(numargs * sizeof(*iters));
11896 for (i = 0; i < numargs; i++) {
11897 JimListIterInit(&iters[i], argv[i + 1]);
11898 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11899 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11900 return JIM_ERR;
11904 if (doMap) {
11905 resultObj = Jim_NewListObj(interp, NULL, 0);
11907 else {
11908 resultObj = interp->emptyObj;
11910 Jim_IncrRefCount(resultObj);
11912 while (1) {
11913 /* Have we expired all lists? */
11914 for (i = 0; i < numargs; i += 2) {
11915 if (!JimListIterDone(interp, &iters[i + 1])) {
11916 break;
11919 if (i == numargs) {
11920 /* All done */
11921 break;
11924 /* For each list */
11925 for (i = 0; i < numargs; i += 2) {
11926 Jim_Obj *varName;
11928 /* foreach var */
11929 JimListIterInit(&iters[i], argv[i + 1]);
11930 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11931 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11932 if (!valObj) {
11933 /* Ran out, so store the empty string */
11934 valObj = interp->emptyObj;
11936 /* Avoid shimmering */
11937 Jim_IncrRefCount(valObj);
11938 result = Jim_SetVariable(interp, varName, valObj);
11939 Jim_DecrRefCount(interp, valObj);
11940 if (result != JIM_OK) {
11941 goto err;
11945 switch (result = Jim_EvalObj(interp, script)) {
11946 case JIM_OK:
11947 if (doMap) {
11948 Jim_ListAppendElement(interp, resultObj, interp->result);
11950 break;
11951 case JIM_CONTINUE:
11952 break;
11953 case JIM_BREAK:
11954 goto out;
11955 default:
11956 goto err;
11959 out:
11960 result = JIM_OK;
11961 Jim_SetResult(interp, resultObj);
11962 err:
11963 Jim_DecrRefCount(interp, resultObj);
11964 if (numargs > 2) {
11965 Jim_Free(iters);
11967 return result;
11970 /* [foreach] */
11971 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11973 return JimForeachMapHelper(interp, argc, argv, 0);
11976 /* [lmap] */
11977 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11979 return JimForeachMapHelper(interp, argc, argv, 1);
11982 /* [lassign] */
11983 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11985 int result = JIM_ERR;
11986 int i;
11987 Jim_ListIter iter;
11988 Jim_Obj *resultObj;
11990 if (argc < 2) {
11991 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11992 return JIM_ERR;
11995 JimListIterInit(&iter, argv[1]);
11997 for (i = 2; i < argc; i++) {
11998 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11999 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12000 if (result != JIM_OK) {
12001 return result;
12005 resultObj = Jim_NewListObj(interp, NULL, 0);
12006 while (!JimListIterDone(interp, &iter)) {
12007 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12010 Jim_SetResult(interp, resultObj);
12012 return JIM_OK;
12015 /* [if] */
12016 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12018 int boolean, retval, current = 1, falsebody = 0;
12020 if (argc >= 3) {
12021 while (1) {
12022 /* Far not enough arguments given! */
12023 if (current >= argc)
12024 goto err;
12025 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12026 != JIM_OK)
12027 return retval;
12028 /* There lacks something, isn't it? */
12029 if (current >= argc)
12030 goto err;
12031 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12032 current++;
12033 /* Tsk tsk, no then-clause? */
12034 if (current >= argc)
12035 goto err;
12036 if (boolean)
12037 return Jim_EvalObj(interp, argv[current]);
12038 /* Ok: no else-clause follows */
12039 if (++current >= argc) {
12040 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12041 return JIM_OK;
12043 falsebody = current++;
12044 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12045 /* IIICKS - else-clause isn't last cmd? */
12046 if (current != argc - 1)
12047 goto err;
12048 return Jim_EvalObj(interp, argv[current]);
12050 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12051 /* Ok: elseif follows meaning all the stuff
12052 * again (how boring...) */
12053 continue;
12054 /* OOPS - else-clause is not last cmd? */
12055 else if (falsebody != argc - 1)
12056 goto err;
12057 return Jim_EvalObj(interp, argv[falsebody]);
12059 return JIM_OK;
12061 err:
12062 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12063 return JIM_ERR;
12067 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12068 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12069 Jim_Obj *stringObj, int nocase)
12071 Jim_Obj *parms[4];
12072 int argc = 0;
12073 long eq;
12074 int rc;
12076 parms[argc++] = commandObj;
12077 if (nocase) {
12078 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12080 parms[argc++] = patternObj;
12081 parms[argc++] = stringObj;
12083 rc = Jim_EvalObjVector(interp, argc, parms);
12085 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12086 eq = -rc;
12089 return eq;
12092 enum
12093 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12095 /* [switch] */
12096 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12098 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12099 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12100 Jim_Obj *script = 0;
12102 if (argc < 3) {
12103 wrongnumargs:
12104 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12105 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12106 return JIM_ERR;
12108 for (opt = 1; opt < argc; ++opt) {
12109 const char *option = Jim_String(argv[opt]);
12111 if (*option != '-')
12112 break;
12113 else if (strncmp(option, "--", 2) == 0) {
12114 ++opt;
12115 break;
12117 else if (strncmp(option, "-exact", 2) == 0)
12118 matchOpt = SWITCH_EXACT;
12119 else if (strncmp(option, "-glob", 2) == 0)
12120 matchOpt = SWITCH_GLOB;
12121 else if (strncmp(option, "-regexp", 2) == 0)
12122 matchOpt = SWITCH_RE;
12123 else if (strncmp(option, "-command", 2) == 0) {
12124 matchOpt = SWITCH_CMD;
12125 if ((argc - opt) < 2)
12126 goto wrongnumargs;
12127 command = argv[++opt];
12129 else {
12130 Jim_SetResultFormatted(interp,
12131 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12132 argv[opt]);
12133 return JIM_ERR;
12135 if ((argc - opt) < 2)
12136 goto wrongnumargs;
12138 strObj = argv[opt++];
12139 patCount = argc - opt;
12140 if (patCount == 1) {
12141 Jim_Obj **vector;
12143 JimListGetElements(interp, argv[opt], &patCount, &vector);
12144 caseList = vector;
12146 else
12147 caseList = &argv[opt];
12148 if (patCount == 0 || patCount % 2 != 0)
12149 goto wrongnumargs;
12150 for (i = 0; script == 0 && i < patCount; i += 2) {
12151 Jim_Obj *patObj = caseList[i];
12153 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12154 || i < (patCount - 2)) {
12155 switch (matchOpt) {
12156 case SWITCH_EXACT:
12157 if (Jim_StringEqObj(strObj, patObj))
12158 script = caseList[i + 1];
12159 break;
12160 case SWITCH_GLOB:
12161 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12162 script = caseList[i + 1];
12163 break;
12164 case SWITCH_RE:
12165 command = Jim_NewStringObj(interp, "regexp", -1);
12166 /* Fall thru intentionally */
12167 case SWITCH_CMD:{
12168 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12170 /* After the execution of a command we need to
12171 * make sure to reconvert the object into a list
12172 * again. Only for the single-list style [switch]. */
12173 if (argc - opt == 1) {
12174 Jim_Obj **vector;
12176 JimListGetElements(interp, argv[opt], &patCount, &vector);
12177 caseList = vector;
12179 /* command is here already decref'd */
12180 if (rc < 0) {
12181 return -rc;
12183 if (rc)
12184 script = caseList[i + 1];
12185 break;
12189 else {
12190 script = caseList[i + 1];
12193 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12194 script = caseList[i + 1];
12195 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12196 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12197 return JIM_ERR;
12199 Jim_SetEmptyResult(interp);
12200 if (script) {
12201 return Jim_EvalObj(interp, script);
12203 return JIM_OK;
12206 /* [list] */
12207 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12209 Jim_Obj *listObjPtr;
12211 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12212 Jim_SetResult(interp, listObjPtr);
12213 return JIM_OK;
12216 /* [lindex] */
12217 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12219 Jim_Obj *objPtr, *listObjPtr;
12220 int i;
12221 int idx;
12223 if (argc < 3) {
12224 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12225 return JIM_ERR;
12227 objPtr = argv[1];
12228 Jim_IncrRefCount(objPtr);
12229 for (i = 2; i < argc; i++) {
12230 listObjPtr = objPtr;
12231 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12232 Jim_DecrRefCount(interp, listObjPtr);
12233 return JIM_ERR;
12235 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12236 /* Returns an empty object if the index
12237 * is out of range. */
12238 Jim_DecrRefCount(interp, listObjPtr);
12239 Jim_SetEmptyResult(interp);
12240 return JIM_OK;
12242 Jim_IncrRefCount(objPtr);
12243 Jim_DecrRefCount(interp, listObjPtr);
12245 Jim_SetResult(interp, objPtr);
12246 Jim_DecrRefCount(interp, objPtr);
12247 return JIM_OK;
12250 /* [llength] */
12251 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12253 if (argc != 2) {
12254 Jim_WrongNumArgs(interp, 1, argv, "list");
12255 return JIM_ERR;
12257 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12258 return JIM_OK;
12261 /* [lsearch] */
12262 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12264 static const char * const options[] = {
12265 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12266 NULL
12268 enum
12269 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12270 OPT_COMMAND };
12271 int i;
12272 int opt_bool = 0;
12273 int opt_not = 0;
12274 int opt_nocase = 0;
12275 int opt_all = 0;
12276 int opt_inline = 0;
12277 int opt_match = OPT_EXACT;
12278 int listlen;
12279 int rc = JIM_OK;
12280 Jim_Obj *listObjPtr = NULL;
12281 Jim_Obj *commandObj = NULL;
12283 if (argc < 3) {
12284 wrongargs:
12285 Jim_WrongNumArgs(interp, 1, argv,
12286 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12287 return JIM_ERR;
12290 for (i = 1; i < argc - 2; i++) {
12291 int option;
12293 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12294 return JIM_ERR;
12296 switch (option) {
12297 case OPT_BOOL:
12298 opt_bool = 1;
12299 opt_inline = 0;
12300 break;
12301 case OPT_NOT:
12302 opt_not = 1;
12303 break;
12304 case OPT_NOCASE:
12305 opt_nocase = 1;
12306 break;
12307 case OPT_INLINE:
12308 opt_inline = 1;
12309 opt_bool = 0;
12310 break;
12311 case OPT_ALL:
12312 opt_all = 1;
12313 break;
12314 case OPT_COMMAND:
12315 if (i >= argc - 2) {
12316 goto wrongargs;
12318 commandObj = argv[++i];
12319 /* fallthru */
12320 case OPT_EXACT:
12321 case OPT_GLOB:
12322 case OPT_REGEXP:
12323 opt_match = option;
12324 break;
12328 argv += i;
12330 if (opt_all) {
12331 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12333 if (opt_match == OPT_REGEXP) {
12334 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12336 if (commandObj) {
12337 Jim_IncrRefCount(commandObj);
12340 listlen = Jim_ListLength(interp, argv[0]);
12341 for (i = 0; i < listlen; i++) {
12342 int eq = 0;
12343 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12345 switch (opt_match) {
12346 case OPT_EXACT:
12347 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12348 break;
12350 case OPT_GLOB:
12351 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12352 break;
12354 case OPT_REGEXP:
12355 case OPT_COMMAND:
12356 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12357 if (eq < 0) {
12358 if (listObjPtr) {
12359 Jim_FreeNewObj(interp, listObjPtr);
12361 rc = JIM_ERR;
12362 goto done;
12364 break;
12367 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12368 if (!eq && opt_bool && opt_not && !opt_all) {
12369 continue;
12372 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12373 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12374 Jim_Obj *resultObj;
12376 if (opt_bool) {
12377 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12379 else if (!opt_inline) {
12380 resultObj = Jim_NewIntObj(interp, i);
12382 else {
12383 resultObj = objPtr;
12386 if (opt_all) {
12387 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12389 else {
12390 Jim_SetResult(interp, resultObj);
12391 goto done;
12396 if (opt_all) {
12397 Jim_SetResult(interp, listObjPtr);
12399 else {
12400 /* No match */
12401 if (opt_bool) {
12402 Jim_SetResultBool(interp, opt_not);
12404 else if (!opt_inline) {
12405 Jim_SetResultInt(interp, -1);
12409 done:
12410 if (commandObj) {
12411 Jim_DecrRefCount(interp, commandObj);
12413 return rc;
12416 /* [lappend] */
12417 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12419 Jim_Obj *listObjPtr;
12420 int shared, i;
12422 if (argc < 2) {
12423 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12424 return JIM_ERR;
12426 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12427 if (!listObjPtr) {
12428 /* Create the list if it does not exists */
12429 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12430 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12431 Jim_FreeNewObj(interp, listObjPtr);
12432 return JIM_ERR;
12435 shared = Jim_IsShared(listObjPtr);
12436 if (shared)
12437 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12438 for (i = 2; i < argc; i++)
12439 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12440 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12441 if (shared)
12442 Jim_FreeNewObj(interp, listObjPtr);
12443 return JIM_ERR;
12445 Jim_SetResult(interp, listObjPtr);
12446 return JIM_OK;
12449 /* [linsert] */
12450 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12452 int idx, len;
12453 Jim_Obj *listPtr;
12455 if (argc < 3) {
12456 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12457 return JIM_ERR;
12459 listPtr = argv[1];
12460 if (Jim_IsShared(listPtr))
12461 listPtr = Jim_DuplicateObj(interp, listPtr);
12462 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12463 goto err;
12464 len = Jim_ListLength(interp, listPtr);
12465 if (idx >= len)
12466 idx = len;
12467 else if (idx < 0)
12468 idx = len + idx + 1;
12469 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12470 Jim_SetResult(interp, listPtr);
12471 return JIM_OK;
12472 err:
12473 if (listPtr != argv[1]) {
12474 Jim_FreeNewObj(interp, listPtr);
12476 return JIM_ERR;
12479 /* [lreplace] */
12480 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12482 int first, last, len, rangeLen;
12483 Jim_Obj *listObj;
12484 Jim_Obj *newListObj;
12486 if (argc < 4) {
12487 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12488 return JIM_ERR;
12490 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12491 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12492 return JIM_ERR;
12495 listObj = argv[1];
12496 len = Jim_ListLength(interp, listObj);
12498 first = JimRelToAbsIndex(len, first);
12499 last = JimRelToAbsIndex(len, last);
12500 JimRelToAbsRange(len, &first, &last, &rangeLen);
12502 /* Now construct a new list which consists of:
12503 * <elements before first> <supplied elements> <elements after last>
12506 /* Check to see if trying to replace past the end of the list */
12507 if (first < len) {
12508 /* OK. Not past the end */
12510 else if (len == 0) {
12511 /* Special for empty list, adjust first to 0 */
12512 first = 0;
12514 else {
12515 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12516 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12517 return JIM_ERR;
12520 /* Add the first set of elements */
12521 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12523 /* Add supplied elements */
12524 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12526 /* Add the remaining elements */
12527 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12529 Jim_SetResult(interp, newListObj);
12530 return JIM_OK;
12533 /* [lset] */
12534 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12536 if (argc < 3) {
12537 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12538 return JIM_ERR;
12540 else if (argc == 3) {
12541 /* With no indexes, simply implements [set] */
12542 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12543 return JIM_ERR;
12544 Jim_SetResult(interp, argv[2]);
12545 return JIM_OK;
12547 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12550 /* [lsort] */
12551 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12553 static const char * const options[] = {
12554 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12556 enum
12557 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12558 Jim_Obj *resObj;
12559 int i;
12560 int retCode;
12562 struct lsort_info info;
12564 if (argc < 2) {
12565 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12566 return JIM_ERR;
12569 info.type = JIM_LSORT_ASCII;
12570 info.order = 1;
12571 info.indexed = 0;
12572 info.unique = 0;
12573 info.command = NULL;
12574 info.interp = interp;
12576 for (i = 1; i < (argc - 1); i++) {
12577 int option;
12579 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12580 != JIM_OK)
12581 return JIM_ERR;
12582 switch (option) {
12583 case OPT_ASCII:
12584 info.type = JIM_LSORT_ASCII;
12585 break;
12586 case OPT_NOCASE:
12587 info.type = JIM_LSORT_NOCASE;
12588 break;
12589 case OPT_INTEGER:
12590 info.type = JIM_LSORT_INTEGER;
12591 break;
12592 case OPT_REAL:
12593 info.type = JIM_LSORT_REAL;
12594 break;
12595 case OPT_INCREASING:
12596 info.order = 1;
12597 break;
12598 case OPT_DECREASING:
12599 info.order = -1;
12600 break;
12601 case OPT_UNIQUE:
12602 info.unique = 1;
12603 break;
12604 case OPT_COMMAND:
12605 if (i >= (argc - 2)) {
12606 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12607 return JIM_ERR;
12609 info.type = JIM_LSORT_COMMAND;
12610 info.command = argv[i + 1];
12611 i++;
12612 break;
12613 case OPT_INDEX:
12614 if (i >= (argc - 2)) {
12615 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12616 return JIM_ERR;
12618 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12619 return JIM_ERR;
12621 info.indexed = 1;
12622 i++;
12623 break;
12626 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12627 retCode = ListSortElements(interp, resObj, &info);
12628 if (retCode == JIM_OK) {
12629 Jim_SetResult(interp, resObj);
12631 else {
12632 Jim_FreeNewObj(interp, resObj);
12634 return retCode;
12637 /* [append] */
12638 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12640 Jim_Obj *stringObjPtr;
12641 int i;
12643 if (argc < 2) {
12644 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12645 return JIM_ERR;
12647 if (argc == 2) {
12648 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12649 if (!stringObjPtr)
12650 return JIM_ERR;
12652 else {
12653 int freeobj = 0;
12654 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12655 if (!stringObjPtr) {
12656 /* Create the string if it doesn't exist */
12657 stringObjPtr = Jim_NewEmptyStringObj(interp);
12658 freeobj = 1;
12660 else if (Jim_IsShared(stringObjPtr)) {
12661 freeobj = 1;
12662 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12664 for (i = 2; i < argc; i++) {
12665 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12667 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12668 if (freeobj) {
12669 Jim_FreeNewObj(interp, stringObjPtr);
12671 return JIM_ERR;
12674 Jim_SetResult(interp, stringObjPtr);
12675 return JIM_OK;
12678 /* [debug] */
12679 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12681 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12682 static const char * const options[] = {
12683 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12684 "exprbc", "show",
12685 NULL
12687 enum
12689 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12690 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12692 int option;
12694 if (argc < 2) {
12695 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12696 return JIM_ERR;
12698 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12699 return JIM_ERR;
12700 if (option == OPT_REFCOUNT) {
12701 if (argc != 3) {
12702 Jim_WrongNumArgs(interp, 2, argv, "object");
12703 return JIM_ERR;
12705 Jim_SetResultInt(interp, argv[2]->refCount);
12706 return JIM_OK;
12708 else if (option == OPT_OBJCOUNT) {
12709 int freeobj = 0, liveobj = 0;
12710 char buf[256];
12711 Jim_Obj *objPtr;
12713 if (argc != 2) {
12714 Jim_WrongNumArgs(interp, 2, argv, "");
12715 return JIM_ERR;
12717 /* Count the number of free objects. */
12718 objPtr = interp->freeList;
12719 while (objPtr) {
12720 freeobj++;
12721 objPtr = objPtr->nextObjPtr;
12723 /* Count the number of live objects. */
12724 objPtr = interp->liveList;
12725 while (objPtr) {
12726 liveobj++;
12727 objPtr = objPtr->nextObjPtr;
12729 /* Set the result string and return. */
12730 sprintf(buf, "free %d used %d", freeobj, liveobj);
12731 Jim_SetResultString(interp, buf, -1);
12732 return JIM_OK;
12734 else if (option == OPT_OBJECTS) {
12735 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12737 /* Count the number of live objects. */
12738 objPtr = interp->liveList;
12739 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12740 while (objPtr) {
12741 char buf[128];
12742 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12744 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12745 sprintf(buf, "%p", objPtr);
12746 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12747 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12748 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12749 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12750 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12751 objPtr = objPtr->nextObjPtr;
12753 Jim_SetResult(interp, listObjPtr);
12754 return JIM_OK;
12756 else if (option == OPT_INVSTR) {
12757 Jim_Obj *objPtr;
12759 if (argc != 3) {
12760 Jim_WrongNumArgs(interp, 2, argv, "object");
12761 return JIM_ERR;
12763 objPtr = argv[2];
12764 if (objPtr->typePtr != NULL)
12765 Jim_InvalidateStringRep(objPtr);
12766 Jim_SetEmptyResult(interp);
12767 return JIM_OK;
12769 else if (option == OPT_SHOW) {
12770 const char *s;
12771 int len, charlen;
12773 if (argc != 3) {
12774 Jim_WrongNumArgs(interp, 2, argv, "object");
12775 return JIM_ERR;
12777 s = Jim_GetString(argv[2], &len);
12778 #ifdef JIM_UTF8
12779 charlen = utf8_strlen(s, len);
12780 #else
12781 charlen = len;
12782 #endif
12783 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12784 printf("chars (%d): <<%s>>\n", charlen, s);
12785 printf("bytes (%d):", len);
12786 while (len--) {
12787 printf(" %02x", (unsigned char)*s++);
12789 printf("\n");
12790 return JIM_OK;
12792 else if (option == OPT_SCRIPTLEN) {
12793 ScriptObj *script;
12795 if (argc != 3) {
12796 Jim_WrongNumArgs(interp, 2, argv, "script");
12797 return JIM_ERR;
12799 script = Jim_GetScript(interp, argv[2]);
12800 if (script == NULL)
12801 return JIM_ERR;
12802 Jim_SetResultInt(interp, script->len);
12803 return JIM_OK;
12805 else if (option == OPT_EXPRLEN) {
12806 ExprByteCode *expr;
12808 if (argc != 3) {
12809 Jim_WrongNumArgs(interp, 2, argv, "expression");
12810 return JIM_ERR;
12812 expr = JimGetExpression(interp, argv[2]);
12813 if (expr == NULL)
12814 return JIM_ERR;
12815 Jim_SetResultInt(interp, expr->len);
12816 return JIM_OK;
12818 else if (option == OPT_EXPRBC) {
12819 Jim_Obj *objPtr;
12820 ExprByteCode *expr;
12821 int i;
12823 if (argc != 3) {
12824 Jim_WrongNumArgs(interp, 2, argv, "expression");
12825 return JIM_ERR;
12827 expr = JimGetExpression(interp, argv[2]);
12828 if (expr == NULL)
12829 return JIM_ERR;
12830 objPtr = Jim_NewListObj(interp, NULL, 0);
12831 for (i = 0; i < expr->len; i++) {
12832 const char *type;
12833 const Jim_ExprOperator *op;
12834 Jim_Obj *obj = expr->token[i].objPtr;
12836 switch (expr->token[i].type) {
12837 case JIM_TT_EXPR_INT:
12838 type = "int";
12839 break;
12840 case JIM_TT_EXPR_DOUBLE:
12841 type = "double";
12842 break;
12843 case JIM_TT_CMD:
12844 type = "command";
12845 break;
12846 case JIM_TT_VAR:
12847 type = "variable";
12848 break;
12849 case JIM_TT_DICTSUGAR:
12850 type = "dictsugar";
12851 break;
12852 case JIM_TT_EXPRSUGAR:
12853 type = "exprsugar";
12854 break;
12855 case JIM_TT_ESC:
12856 type = "subst";
12857 break;
12858 case JIM_TT_STR:
12859 type = "string";
12860 break;
12861 default:
12862 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12863 if (op == NULL) {
12864 type = "private";
12866 else {
12867 type = "operator";
12869 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12870 break;
12872 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12873 Jim_ListAppendElement(interp, objPtr, obj);
12875 Jim_SetResult(interp, objPtr);
12876 return JIM_OK;
12878 else {
12879 Jim_SetResultString(interp,
12880 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12881 return JIM_ERR;
12883 /* unreached */
12884 #endif /* JIM_BOOTSTRAP */
12885 #if !defined(JIM_DEBUG_COMMAND)
12886 Jim_SetResultString(interp, "unsupported", -1);
12887 return JIM_ERR;
12888 #endif
12891 /* [eval] */
12892 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12894 int rc;
12896 if (argc < 2) {
12897 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12898 return JIM_ERR;
12901 if (argc == 2) {
12902 rc = Jim_EvalObj(interp, argv[1]);
12904 else {
12905 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12908 if (rc == JIM_ERR) {
12909 /* eval is "interesting", so add a stack frame here */
12910 interp->addStackTrace++;
12912 return rc;
12915 /* [uplevel] */
12916 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12918 if (argc >= 2) {
12919 int retcode;
12920 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12921 int savedTailcall;
12922 const char *str;
12924 /* Save the old callframe pointer */
12925 savedCallFrame = interp->framePtr;
12927 /* Lookup the target frame pointer */
12928 str = Jim_String(argv[1]);
12929 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12930 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12931 argc--;
12932 argv++;
12934 else {
12935 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12937 if (targetCallFrame == NULL) {
12938 return JIM_ERR;
12940 if (argc < 2) {
12941 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12942 return JIM_ERR;
12944 /* Eval the code in the target callframe. */
12945 interp->framePtr = targetCallFrame;
12946 /* Can't merge tailcalls across upcall */
12947 savedTailcall = interp->framePtr->tailcall;
12948 interp->framePtr->tailcall = 0;
12949 if (argc == 2) {
12950 retcode = Jim_EvalObj(interp, argv[1]);
12952 else {
12953 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12955 interp->framePtr->tailcall = savedTailcall;
12956 interp->framePtr = savedCallFrame;
12957 return retcode;
12959 else {
12960 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12961 return JIM_ERR;
12965 /* [expr] */
12966 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12968 Jim_Obj *exprResultPtr;
12969 int retcode;
12971 if (argc == 2) {
12972 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12974 else if (argc > 2) {
12975 Jim_Obj *objPtr;
12977 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12978 Jim_IncrRefCount(objPtr);
12979 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12980 Jim_DecrRefCount(interp, objPtr);
12982 else {
12983 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12984 return JIM_ERR;
12986 if (retcode != JIM_OK)
12987 return retcode;
12988 Jim_SetResult(interp, exprResultPtr);
12989 Jim_DecrRefCount(interp, exprResultPtr);
12990 return JIM_OK;
12993 /* [break] */
12994 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12996 if (argc != 1) {
12997 Jim_WrongNumArgs(interp, 1, argv, "");
12998 return JIM_ERR;
13000 return JIM_BREAK;
13003 /* [continue] */
13004 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13006 if (argc != 1) {
13007 Jim_WrongNumArgs(interp, 1, argv, "");
13008 return JIM_ERR;
13010 return JIM_CONTINUE;
13013 /* [return] */
13014 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13016 int i;
13017 Jim_Obj *stackTraceObj = NULL;
13018 Jim_Obj *errorCodeObj = NULL;
13019 int returnCode = JIM_OK;
13020 long level = 1;
13022 for (i = 1; i < argc - 1; i += 2) {
13023 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13024 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13025 return JIM_ERR;
13028 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13029 stackTraceObj = argv[i + 1];
13031 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13032 errorCodeObj = argv[i + 1];
13034 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13035 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13036 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13037 return JIM_ERR;
13040 else {
13041 break;
13045 if (i != argc - 1 && i != argc) {
13046 Jim_WrongNumArgs(interp, 1, argv,
13047 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13050 /* If a stack trace is supplied and code is error, set the stack trace */
13051 if (stackTraceObj && returnCode == JIM_ERR) {
13052 JimSetStackTrace(interp, stackTraceObj);
13054 /* If an error code list is supplied, set the global $errorCode */
13055 if (errorCodeObj && returnCode == JIM_ERR) {
13056 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13058 interp->returnCode = returnCode;
13059 interp->returnLevel = level;
13061 if (i == argc - 1) {
13062 Jim_SetResult(interp, argv[i]);
13064 return JIM_RETURN;
13067 /* [tailcall] */
13068 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13070 if (interp->framePtr->level == 0) {
13071 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13072 return JIM_ERR;
13074 else if (argc >= 2) {
13075 /* Need to resolve the tailcall command in the current context */
13076 Jim_CallFrame *cf = interp->framePtr->parent;
13078 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13079 if (cmdPtr == NULL) {
13080 return JIM_ERR;
13083 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13085 /* And stash this pre-resolved command */
13086 JimIncrCmdRefCount(cmdPtr);
13087 cf->tailcallCmd = cmdPtr;
13089 /* And stash the command list */
13090 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13092 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13093 Jim_IncrRefCount(cf->tailcallObj);
13095 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13096 return JIM_EVAL;
13098 return JIM_OK;
13101 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13103 Jim_Obj *cmdList;
13104 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13106 /* prefixListObj is a list to which the args need to be appended */
13107 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13108 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13110 return JimEvalObjList(interp, cmdList);
13113 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13115 Jim_Obj *prefixListObj = privData;
13116 Jim_DecrRefCount(interp, prefixListObj);
13119 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13121 Jim_Obj *prefixListObj;
13122 const char *newname;
13124 if (argc < 3) {
13125 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13126 return JIM_ERR;
13129 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13130 Jim_IncrRefCount(prefixListObj);
13131 newname = Jim_String(argv[1]);
13132 if (newname[0] == ':' && newname[1] == ':') {
13133 while (*++newname == ':') {
13137 Jim_SetResult(interp, argv[1]);
13139 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13142 /* [proc] */
13143 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13145 Jim_Cmd *cmd;
13147 if (argc != 4 && argc != 5) {
13148 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13149 return JIM_ERR;
13152 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13153 return JIM_ERR;
13156 if (argc == 4) {
13157 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13159 else {
13160 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13163 if (cmd) {
13164 /* Add the new command */
13165 Jim_Obj *qualifiedCmdNameObj;
13166 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13168 JimCreateCommand(interp, cmdname, cmd);
13170 /* Calculate and set the namespace for this proc */
13171 JimUpdateProcNamespace(interp, cmd, cmdname);
13173 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13175 /* Unlike Tcl, set the name of the proc as the result */
13176 Jim_SetResult(interp, argv[1]);
13177 return JIM_OK;
13179 return JIM_ERR;
13182 /* [local] */
13183 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 int retcode;
13187 if (argc < 2) {
13188 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13189 return JIM_ERR;
13192 /* Evaluate the arguments with 'local' in force */
13193 interp->local++;
13194 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13195 interp->local--;
13198 /* If OK, and the result is a proc, add it to the list of local procs */
13199 if (retcode == 0) {
13200 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13202 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13203 return JIM_ERR;
13205 if (interp->framePtr->localCommands == NULL) {
13206 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13207 Jim_InitStack(interp->framePtr->localCommands);
13209 Jim_IncrRefCount(cmdNameObj);
13210 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13213 return retcode;
13216 /* [upcall] */
13217 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13219 if (argc < 2) {
13220 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13221 return JIM_ERR;
13223 else {
13224 int retcode;
13226 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13227 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13228 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13229 return JIM_ERR;
13231 /* OK. Mark this command as being in an upcall */
13232 cmdPtr->u.proc.upcall++;
13233 JimIncrCmdRefCount(cmdPtr);
13235 /* Invoke the command as normal */
13236 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13238 /* No longer in an upcall */
13239 cmdPtr->u.proc.upcall--;
13240 JimDecrCmdRefCount(interp, cmdPtr);
13242 return retcode;
13246 /* [apply] */
13247 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13249 if (argc < 2) {
13250 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13251 return JIM_ERR;
13253 else {
13254 int ret;
13255 Jim_Cmd *cmd;
13256 Jim_Obj *argListObjPtr;
13257 Jim_Obj *bodyObjPtr;
13258 Jim_Obj *nsObj = NULL;
13259 Jim_Obj **nargv;
13261 int len = Jim_ListLength(interp, argv[1]);
13262 if (len != 2 && len != 3) {
13263 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13264 return JIM_ERR;
13267 if (len == 3) {
13268 #ifdef jim_ext_namespace
13269 /* Need to canonicalise the given namespace. */
13270 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13271 #else
13272 Jim_SetResultString(interp, "namespaces not enabled", -1);
13273 return JIM_ERR;
13274 #endif
13276 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13277 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13279 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13281 if (cmd) {
13282 /* Create a new argv array with a dummy argv[0], for error messages */
13283 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13284 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13285 Jim_IncrRefCount(nargv[0]);
13286 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13287 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13288 Jim_DecrRefCount(interp, nargv[0]);
13289 Jim_Free(nargv);
13291 JimDecrCmdRefCount(interp, cmd);
13292 return ret;
13294 return JIM_ERR;
13299 /* [concat] */
13300 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13302 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13303 return JIM_OK;
13306 /* [upvar] */
13307 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13309 int i;
13310 Jim_CallFrame *targetCallFrame;
13312 /* Lookup the target frame pointer */
13313 if (argc > 3 && (argc % 2 == 0)) {
13314 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13315 argc--;
13316 argv++;
13318 else {
13319 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13321 if (targetCallFrame == NULL) {
13322 return JIM_ERR;
13325 /* Check for arity */
13326 if (argc < 3) {
13327 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13328 return JIM_ERR;
13331 /* Now... for every other/local couple: */
13332 for (i = 1; i < argc; i += 2) {
13333 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13334 return JIM_ERR;
13336 return JIM_OK;
13339 /* [global] */
13340 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13342 int i;
13344 if (argc < 2) {
13345 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13346 return JIM_ERR;
13348 /* Link every var to the toplevel having the same name */
13349 if (interp->framePtr->level == 0)
13350 return JIM_OK; /* global at toplevel... */
13351 for (i = 1; i < argc; i++) {
13352 /* global ::blah does nothing */
13353 const char *name = Jim_String(argv[i]);
13354 if (name[0] != ':' || name[1] != ':') {
13355 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13356 return JIM_ERR;
13359 return JIM_OK;
13362 /* does the [string map] operation. On error NULL is returned,
13363 * otherwise a new string object with the result, having refcount = 0,
13364 * is returned. */
13365 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13366 Jim_Obj *objPtr, int nocase)
13368 int numMaps;
13369 const char *str, *noMatchStart = NULL;
13370 int strLen, i;
13371 Jim_Obj *resultObjPtr;
13373 numMaps = Jim_ListLength(interp, mapListObjPtr);
13374 if (numMaps % 2) {
13375 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13376 return NULL;
13379 str = Jim_String(objPtr);
13380 strLen = Jim_Utf8Length(interp, objPtr);
13382 /* Map it */
13383 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13384 while (strLen) {
13385 for (i = 0; i < numMaps; i += 2) {
13386 Jim_Obj *objPtr;
13387 const char *k;
13388 int kl;
13390 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13391 k = Jim_String(objPtr);
13392 kl = Jim_Utf8Length(interp, objPtr);
13394 if (strLen >= kl && kl) {
13395 int rc;
13396 rc = JimStringCompareLen(str, k, kl, nocase);
13397 if (rc == 0) {
13398 if (noMatchStart) {
13399 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13400 noMatchStart = NULL;
13402 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13403 str += utf8_index(str, kl);
13404 strLen -= kl;
13405 break;
13409 if (i == numMaps) { /* no match */
13410 int c;
13411 if (noMatchStart == NULL)
13412 noMatchStart = str;
13413 str += utf8_tounicode(str, &c);
13414 strLen--;
13417 if (noMatchStart) {
13418 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13420 return resultObjPtr;
13423 /* [string] */
13424 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13426 int len;
13427 int opt_case = 1;
13428 int option;
13429 static const char * const options[] = {
13430 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13431 "map", "repeat", "reverse", "index", "first", "last",
13432 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13434 enum
13436 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13437 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13438 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13440 static const char * const nocase_options[] = {
13441 "-nocase", NULL
13443 static const char * const nocase_length_options[] = {
13444 "-nocase", "-length", NULL
13447 if (argc < 2) {
13448 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13449 return JIM_ERR;
13451 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13452 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13453 return JIM_ERR;
13455 switch (option) {
13456 case OPT_LENGTH:
13457 case OPT_BYTELENGTH:
13458 if (argc != 3) {
13459 Jim_WrongNumArgs(interp, 2, argv, "string");
13460 return JIM_ERR;
13462 if (option == OPT_LENGTH) {
13463 len = Jim_Utf8Length(interp, argv[2]);
13465 else {
13466 len = Jim_Length(argv[2]);
13468 Jim_SetResultInt(interp, len);
13469 return JIM_OK;
13471 case OPT_COMPARE:
13472 case OPT_EQUAL:
13474 /* n is the number of remaining option args */
13475 long opt_length = -1;
13476 int n = argc - 4;
13477 int i = 2;
13478 while (n > 0) {
13479 int subopt;
13480 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13481 JIM_ENUM_ABBREV) != JIM_OK) {
13482 badcompareargs:
13483 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13484 return JIM_ERR;
13486 if (subopt == 0) {
13487 /* -nocase */
13488 opt_case = 0;
13489 n--;
13491 else {
13492 /* -length */
13493 if (n < 2) {
13494 goto badcompareargs;
13496 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13497 return JIM_ERR;
13499 n -= 2;
13502 if (n) {
13503 goto badcompareargs;
13505 argv += argc - 2;
13506 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13507 /* Fast version - [string equal], case sensitive, no length */
13508 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13510 else {
13511 if (opt_length >= 0) {
13512 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13514 else {
13515 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13517 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13519 return JIM_OK;
13522 case OPT_MATCH:
13523 if (argc != 4 &&
13524 (argc != 5 ||
13525 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13526 JIM_ENUM_ABBREV) != JIM_OK)) {
13527 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13528 return JIM_ERR;
13530 if (opt_case == 0) {
13531 argv++;
13533 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13534 return JIM_OK;
13536 case OPT_MAP:{
13537 Jim_Obj *objPtr;
13539 if (argc != 4 &&
13540 (argc != 5 ||
13541 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13542 JIM_ENUM_ABBREV) != JIM_OK)) {
13543 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13544 return JIM_ERR;
13547 if (opt_case == 0) {
13548 argv++;
13550 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13551 if (objPtr == NULL) {
13552 return JIM_ERR;
13554 Jim_SetResult(interp, objPtr);
13555 return JIM_OK;
13558 case OPT_RANGE:
13559 case OPT_BYTERANGE:{
13560 Jim_Obj *objPtr;
13562 if (argc != 5) {
13563 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13564 return JIM_ERR;
13566 if (option == OPT_RANGE) {
13567 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13569 else
13571 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13574 if (objPtr == NULL) {
13575 return JIM_ERR;
13577 Jim_SetResult(interp, objPtr);
13578 return JIM_OK;
13581 case OPT_REPLACE:{
13582 Jim_Obj *objPtr;
13584 if (argc != 5 && argc != 6) {
13585 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13586 return JIM_ERR;
13588 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13589 if (objPtr == NULL) {
13590 return JIM_ERR;
13592 Jim_SetResult(interp, objPtr);
13593 return JIM_OK;
13597 case OPT_REPEAT:{
13598 Jim_Obj *objPtr;
13599 jim_wide count;
13601 if (argc != 4) {
13602 Jim_WrongNumArgs(interp, 2, argv, "string count");
13603 return JIM_ERR;
13605 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13606 return JIM_ERR;
13608 objPtr = Jim_NewStringObj(interp, "", 0);
13609 if (count > 0) {
13610 while (count--) {
13611 Jim_AppendObj(interp, objPtr, argv[2]);
13614 Jim_SetResult(interp, objPtr);
13615 return JIM_OK;
13618 case OPT_REVERSE:{
13619 char *buf, *p;
13620 const char *str;
13621 int len;
13622 int i;
13624 if (argc != 3) {
13625 Jim_WrongNumArgs(interp, 2, argv, "string");
13626 return JIM_ERR;
13629 str = Jim_GetString(argv[2], &len);
13630 buf = Jim_Alloc(len + 1);
13631 p = buf + len;
13632 *p = 0;
13633 for (i = 0; i < len; ) {
13634 int c;
13635 int l = utf8_tounicode(str, &c);
13636 memcpy(p - l, str, l);
13637 p -= l;
13638 i += l;
13639 str += l;
13641 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13642 return JIM_OK;
13645 case OPT_INDEX:{
13646 int idx;
13647 const char *str;
13649 if (argc != 4) {
13650 Jim_WrongNumArgs(interp, 2, argv, "string index");
13651 return JIM_ERR;
13653 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13654 return JIM_ERR;
13656 str = Jim_String(argv[2]);
13657 len = Jim_Utf8Length(interp, argv[2]);
13658 if (idx != INT_MIN && idx != INT_MAX) {
13659 idx = JimRelToAbsIndex(len, idx);
13661 if (idx < 0 || idx >= len || str == NULL) {
13662 Jim_SetResultString(interp, "", 0);
13664 else if (len == Jim_Length(argv[2])) {
13665 /* ASCII optimisation */
13666 Jim_SetResultString(interp, str + idx, 1);
13668 else {
13669 int c;
13670 int i = utf8_index(str, idx);
13671 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13673 return JIM_OK;
13676 case OPT_FIRST:
13677 case OPT_LAST:{
13678 int idx = 0, l1, l2;
13679 const char *s1, *s2;
13681 if (argc != 4 && argc != 5) {
13682 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13683 return JIM_ERR;
13685 s1 = Jim_String(argv[2]);
13686 s2 = Jim_String(argv[3]);
13687 l1 = Jim_Utf8Length(interp, argv[2]);
13688 l2 = Jim_Utf8Length(interp, argv[3]);
13689 if (argc == 5) {
13690 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13691 return JIM_ERR;
13693 idx = JimRelToAbsIndex(l2, idx);
13695 else if (option == OPT_LAST) {
13696 idx = l2;
13698 if (option == OPT_FIRST) {
13699 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13701 else {
13702 #ifdef JIM_UTF8
13703 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13704 #else
13705 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13706 #endif
13708 return JIM_OK;
13711 case OPT_TRIM:
13712 case OPT_TRIMLEFT:
13713 case OPT_TRIMRIGHT:{
13714 Jim_Obj *trimchars;
13716 if (argc != 3 && argc != 4) {
13717 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13718 return JIM_ERR;
13720 trimchars = (argc == 4 ? argv[3] : NULL);
13721 if (option == OPT_TRIM) {
13722 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13724 else if (option == OPT_TRIMLEFT) {
13725 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13727 else if (option == OPT_TRIMRIGHT) {
13728 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13730 return JIM_OK;
13733 case OPT_TOLOWER:
13734 case OPT_TOUPPER:
13735 case OPT_TOTITLE:
13736 if (argc != 3) {
13737 Jim_WrongNumArgs(interp, 2, argv, "string");
13738 return JIM_ERR;
13740 if (option == OPT_TOLOWER) {
13741 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13743 else if (option == OPT_TOUPPER) {
13744 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13746 else {
13747 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13749 return JIM_OK;
13751 case OPT_IS:
13752 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13753 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13755 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13756 return JIM_ERR;
13758 return JIM_OK;
13761 /* [time] */
13762 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13764 long i, count = 1;
13765 jim_wide start, elapsed;
13766 char buf[60];
13767 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13769 if (argc < 2) {
13770 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13771 return JIM_ERR;
13773 if (argc == 3) {
13774 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13775 return JIM_ERR;
13777 if (count < 0)
13778 return JIM_OK;
13779 i = count;
13780 start = JimClock();
13781 while (i-- > 0) {
13782 int retval;
13784 retval = Jim_EvalObj(interp, argv[1]);
13785 if (retval != JIM_OK) {
13786 return retval;
13789 elapsed = JimClock() - start;
13790 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13791 Jim_SetResultString(interp, buf, -1);
13792 return JIM_OK;
13795 /* [exit] */
13796 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13798 long exitCode = 0;
13800 if (argc > 2) {
13801 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13802 return JIM_ERR;
13804 if (argc == 2) {
13805 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13806 return JIM_ERR;
13808 interp->exitCode = exitCode;
13809 return JIM_EXIT;
13812 /* [catch] */
13813 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13815 int exitCode = 0;
13816 int i;
13817 int sig = 0;
13819 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13820 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13821 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13823 /* Reset the error code before catch.
13824 * Note that this is not strictly correct.
13826 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13828 for (i = 1; i < argc - 1; i++) {
13829 const char *arg = Jim_String(argv[i]);
13830 jim_wide option;
13831 int ignore;
13833 /* It's a pity we can't use Jim_GetEnum here :-( */
13834 if (strcmp(arg, "--") == 0) {
13835 i++;
13836 break;
13838 if (*arg != '-') {
13839 break;
13842 if (strncmp(arg, "-no", 3) == 0) {
13843 arg += 3;
13844 ignore = 1;
13846 else {
13847 arg++;
13848 ignore = 0;
13851 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13852 option = -1;
13854 if (option < 0) {
13855 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13857 if (option < 0) {
13858 goto wrongargs;
13861 if (ignore) {
13862 ignore_mask |= (1 << option);
13864 else {
13865 ignore_mask &= ~(1 << option);
13869 argc -= i;
13870 if (argc < 1 || argc > 3) {
13871 wrongargs:
13872 Jim_WrongNumArgs(interp, 1, argv,
13873 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13874 return JIM_ERR;
13876 argv += i;
13878 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13879 sig++;
13882 interp->signal_level += sig;
13883 if (Jim_CheckSignal(interp)) {
13884 /* If a signal is set, don't even try to execute the body */
13885 exitCode = JIM_SIGNAL;
13887 else {
13888 exitCode = Jim_EvalObj(interp, argv[0]);
13889 /* Don't want any caught error included in a later stack trace */
13890 interp->errorFlag = 0;
13892 interp->signal_level -= sig;
13894 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13895 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13896 /* Not caught, pass it up */
13897 return exitCode;
13900 if (sig && exitCode == JIM_SIGNAL) {
13901 /* Catch the signal at this level */
13902 if (interp->signal_set_result) {
13903 interp->signal_set_result(interp, interp->sigmask);
13905 else {
13906 Jim_SetResultInt(interp, interp->sigmask);
13908 interp->sigmask = 0;
13911 if (argc >= 2) {
13912 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13913 return JIM_ERR;
13915 if (argc == 3) {
13916 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13918 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13919 Jim_ListAppendElement(interp, optListObj,
13920 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13921 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13922 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13923 if (exitCode == JIM_ERR) {
13924 Jim_Obj *errorCode;
13925 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13926 -1));
13927 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13929 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13930 if (errorCode) {
13931 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13932 Jim_ListAppendElement(interp, optListObj, errorCode);
13935 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13936 return JIM_ERR;
13940 Jim_SetResultInt(interp, exitCode);
13941 return JIM_OK;
13944 #ifdef JIM_REFERENCES
13946 /* [ref] */
13947 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13949 if (argc != 3 && argc != 4) {
13950 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13951 return JIM_ERR;
13953 if (argc == 3) {
13954 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13956 else {
13957 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13959 return JIM_OK;
13962 /* [getref] */
13963 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13965 Jim_Reference *refPtr;
13967 if (argc != 2) {
13968 Jim_WrongNumArgs(interp, 1, argv, "reference");
13969 return JIM_ERR;
13971 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13972 return JIM_ERR;
13973 Jim_SetResult(interp, refPtr->objPtr);
13974 return JIM_OK;
13977 /* [setref] */
13978 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13980 Jim_Reference *refPtr;
13982 if (argc != 3) {
13983 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13984 return JIM_ERR;
13986 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13987 return JIM_ERR;
13988 Jim_IncrRefCount(argv[2]);
13989 Jim_DecrRefCount(interp, refPtr->objPtr);
13990 refPtr->objPtr = argv[2];
13991 Jim_SetResult(interp, argv[2]);
13992 return JIM_OK;
13995 /* [collect] */
13996 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13998 if (argc != 1) {
13999 Jim_WrongNumArgs(interp, 1, argv, "");
14000 return JIM_ERR;
14002 Jim_SetResultInt(interp, Jim_Collect(interp));
14004 /* Free all the freed objects. */
14005 while (interp->freeList) {
14006 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14007 Jim_Free(interp->freeList);
14008 interp->freeList = nextObjPtr;
14011 return JIM_OK;
14014 /* [finalize] reference ?newValue? */
14015 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14017 if (argc != 2 && argc != 3) {
14018 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14019 return JIM_ERR;
14021 if (argc == 2) {
14022 Jim_Obj *cmdNamePtr;
14024 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14025 return JIM_ERR;
14026 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14027 Jim_SetResult(interp, cmdNamePtr);
14029 else {
14030 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14031 return JIM_ERR;
14032 Jim_SetResult(interp, argv[2]);
14034 return JIM_OK;
14037 /* [info references] */
14038 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14040 Jim_Obj *listObjPtr;
14041 Jim_HashTableIterator htiter;
14042 Jim_HashEntry *he;
14044 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14046 JimInitHashTableIterator(&interp->references, &htiter);
14047 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14048 char buf[JIM_REFERENCE_SPACE + 1];
14049 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14050 const unsigned long *refId = he->key;
14052 JimFormatReference(buf, refPtr, *refId);
14053 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14055 Jim_SetResult(interp, listObjPtr);
14056 return JIM_OK;
14058 #endif
14060 /* [rename] */
14061 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14063 if (argc != 3) {
14064 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14065 return JIM_ERR;
14068 if (JimValidName(interp, "new procedure", argv[2])) {
14069 return JIM_ERR;
14072 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14075 #define JIM_DICTMATCH_VALUES 0x0001
14077 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14079 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14081 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14082 if (type & JIM_DICTMATCH_VALUES) {
14083 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14088 * Like JimHashtablePatternMatch, but for dictionaries.
14090 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14091 JimDictMatchCallbackType *callback, int type)
14093 Jim_HashEntry *he;
14094 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14096 /* Check for the non-pattern case. We can do this much more efficiently. */
14097 Jim_HashTableIterator htiter;
14098 JimInitHashTableIterator(ht, &htiter);
14099 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14100 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14101 callback(interp, listObjPtr, he, type);
14105 return listObjPtr;
14109 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14111 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14112 return JIM_ERR;
14114 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14115 return JIM_OK;
14118 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14120 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14121 return JIM_ERR;
14123 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14124 return JIM_OK;
14127 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14129 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14130 return -1;
14132 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14135 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14137 Jim_HashTable *ht;
14138 unsigned int i;
14140 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14141 return JIM_ERR;
14144 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14146 /* Note that this uses internal knowledge of the hash table */
14147 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14149 for (i = 0; i < ht->size; i++) {
14150 Jim_HashEntry *he = ht->table[i];
14152 if (he) {
14153 printf("%d: ", i);
14155 while (he) {
14156 printf(" %s", Jim_String(he->key));
14157 he = he->next;
14159 printf("\n");
14162 return JIM_OK;
14165 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14167 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14169 Jim_AppendString(interp, prefixObj, " ", 1);
14170 Jim_AppendString(interp, prefixObj, subcmd, -1);
14172 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14175 /* [dict] */
14176 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14178 Jim_Obj *objPtr;
14179 int option;
14180 static const char * const options[] = {
14181 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14182 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14183 "replace", "update", NULL
14185 enum
14187 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14188 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14189 OPT_REPLACE, OPT_UPDATE,
14192 if (argc < 2) {
14193 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14194 return JIM_ERR;
14197 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14198 return JIM_ERR;
14201 switch (option) {
14202 case OPT_GET:
14203 if (argc < 3) {
14204 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14205 return JIM_ERR;
14207 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14208 JIM_ERRMSG) != JIM_OK) {
14209 return JIM_ERR;
14211 Jim_SetResult(interp, objPtr);
14212 return JIM_OK;
14214 case OPT_SET:
14215 if (argc < 5) {
14216 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14217 return JIM_ERR;
14219 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14221 case OPT_EXISTS:
14222 if (argc < 4) {
14223 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14224 return JIM_ERR;
14226 else {
14227 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14228 if (rc < 0) {
14229 return JIM_ERR;
14231 Jim_SetResultBool(interp, rc == JIM_OK);
14232 return JIM_OK;
14235 case OPT_UNSET:
14236 if (argc < 4) {
14237 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14238 return JIM_ERR;
14240 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14241 return JIM_ERR;
14243 return JIM_OK;
14245 case OPT_KEYS:
14246 if (argc != 3 && argc != 4) {
14247 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14248 return JIM_ERR;
14250 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14252 case OPT_SIZE:
14253 if (argc != 3) {
14254 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14255 return JIM_ERR;
14257 else if (Jim_DictSize(interp, argv[2]) < 0) {
14258 return JIM_ERR;
14260 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14261 return JIM_OK;
14263 case OPT_MERGE:
14264 if (argc == 2) {
14265 return JIM_OK;
14267 if (Jim_DictSize(interp, argv[2]) < 0) {
14268 return JIM_ERR;
14270 /* Handle as ensemble */
14271 break;
14273 case OPT_UPDATE:
14274 if (argc < 6 || argc % 2) {
14275 /* Better error message */
14276 argc = 2;
14278 break;
14280 case OPT_CREATE:
14281 if (argc % 2) {
14282 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14283 return JIM_ERR;
14285 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14286 Jim_SetResult(interp, objPtr);
14287 return JIM_OK;
14289 case OPT_INFO:
14290 if (argc != 3) {
14291 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14292 return JIM_ERR;
14294 return Jim_DictInfo(interp, argv[2]);
14296 /* Handle command as an ensemble */
14297 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14300 /* [subst] */
14301 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14303 static const char * const options[] = {
14304 "-nobackslashes", "-nocommands", "-novariables", NULL
14306 enum
14307 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14308 int i;
14309 int flags = JIM_SUBST_FLAG;
14310 Jim_Obj *objPtr;
14312 if (argc < 2) {
14313 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14314 return JIM_ERR;
14316 for (i = 1; i < (argc - 1); i++) {
14317 int option;
14319 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14320 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14321 return JIM_ERR;
14323 switch (option) {
14324 case OPT_NOBACKSLASHES:
14325 flags |= JIM_SUBST_NOESC;
14326 break;
14327 case OPT_NOCOMMANDS:
14328 flags |= JIM_SUBST_NOCMD;
14329 break;
14330 case OPT_NOVARIABLES:
14331 flags |= JIM_SUBST_NOVAR;
14332 break;
14335 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14336 return JIM_ERR;
14338 Jim_SetResult(interp, objPtr);
14339 return JIM_OK;
14342 /* [info] */
14343 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14345 int cmd;
14346 Jim_Obj *objPtr;
14347 int mode = 0;
14349 static const char * const commands[] = {
14350 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14351 "vars", "version", "patchlevel", "complete", "args", "hostname",
14352 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14353 "references", "alias", NULL
14355 enum
14356 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14357 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14358 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14359 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14362 #ifdef jim_ext_namespace
14363 int nons = 0;
14365 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14366 /* This is for internal use only */
14367 argc--;
14368 argv++;
14369 nons = 1;
14371 #endif
14373 if (argc < 2) {
14374 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14375 return JIM_ERR;
14377 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14378 != JIM_OK) {
14379 return JIM_ERR;
14382 /* Test for the the most common commands first, just in case it makes a difference */
14383 switch (cmd) {
14384 case INFO_EXISTS:
14385 if (argc != 3) {
14386 Jim_WrongNumArgs(interp, 2, argv, "varName");
14387 return JIM_ERR;
14389 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14390 break;
14392 case INFO_ALIAS:{
14393 Jim_Cmd *cmdPtr;
14395 if (argc != 3) {
14396 Jim_WrongNumArgs(interp, 2, argv, "command");
14397 return JIM_ERR;
14399 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14400 return JIM_ERR;
14402 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14403 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14404 return JIM_ERR;
14406 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14407 return JIM_OK;
14410 case INFO_CHANNELS:
14411 mode++; /* JIM_CMDLIST_CHANNELS */
14412 #ifndef jim_ext_aio
14413 Jim_SetResultString(interp, "aio not enabled", -1);
14414 return JIM_ERR;
14415 #endif
14416 case INFO_PROCS:
14417 mode++; /* JIM_CMDLIST_PROCS */
14418 case INFO_COMMANDS:
14419 /* mode 0 => JIM_CMDLIST_COMMANDS */
14420 if (argc != 2 && argc != 3) {
14421 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14422 return JIM_ERR;
14424 #ifdef jim_ext_namespace
14425 if (!nons) {
14426 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14427 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14430 #endif
14431 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14432 break;
14434 case INFO_VARS:
14435 mode++; /* JIM_VARLIST_VARS */
14436 case INFO_LOCALS:
14437 mode++; /* JIM_VARLIST_LOCALS */
14438 case INFO_GLOBALS:
14439 /* mode 0 => JIM_VARLIST_GLOBALS */
14440 if (argc != 2 && argc != 3) {
14441 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14442 return JIM_ERR;
14444 #ifdef jim_ext_namespace
14445 if (!nons) {
14446 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14447 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14450 #endif
14451 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14452 break;
14454 case INFO_SCRIPT:
14455 if (argc != 2) {
14456 Jim_WrongNumArgs(interp, 2, argv, "");
14457 return JIM_ERR;
14459 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14460 break;
14462 case INFO_SOURCE:{
14463 int line;
14464 Jim_Obj *resObjPtr;
14465 Jim_Obj *fileNameObj;
14467 if (argc != 3) {
14468 Jim_WrongNumArgs(interp, 2, argv, "source");
14469 return JIM_ERR;
14471 if (argv[2]->typePtr == &sourceObjType) {
14472 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14473 line = argv[2]->internalRep.sourceValue.lineNumber;
14475 else if (argv[2]->typePtr == &scriptObjType) {
14476 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14477 fileNameObj = script->fileNameObj;
14478 line = script->firstline;
14480 else {
14481 fileNameObj = interp->emptyObj;
14482 line = 1;
14484 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14485 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14486 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14487 Jim_SetResult(interp, resObjPtr);
14488 break;
14491 case INFO_STACKTRACE:
14492 Jim_SetResult(interp, interp->stackTrace);
14493 break;
14495 case INFO_LEVEL:
14496 case INFO_FRAME:
14497 switch (argc) {
14498 case 2:
14499 Jim_SetResultInt(interp, interp->framePtr->level);
14500 break;
14502 case 3:
14503 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14504 return JIM_ERR;
14506 Jim_SetResult(interp, objPtr);
14507 break;
14509 default:
14510 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14511 return JIM_ERR;
14513 break;
14515 case INFO_BODY:
14516 case INFO_STATICS:
14517 case INFO_ARGS:{
14518 Jim_Cmd *cmdPtr;
14520 if (argc != 3) {
14521 Jim_WrongNumArgs(interp, 2, argv, "procname");
14522 return JIM_ERR;
14524 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14525 return JIM_ERR;
14527 if (!cmdPtr->isproc) {
14528 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14529 return JIM_ERR;
14531 switch (cmd) {
14532 case INFO_BODY:
14533 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14534 break;
14535 case INFO_ARGS:
14536 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14537 break;
14538 case INFO_STATICS:
14539 if (cmdPtr->u.proc.staticVars) {
14540 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14541 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14542 NULL, JimVariablesMatch, mode));
14544 break;
14546 break;
14549 case INFO_VERSION:
14550 case INFO_PATCHLEVEL:{
14551 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14553 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14554 Jim_SetResultString(interp, buf, -1);
14555 break;
14558 case INFO_COMPLETE:
14559 if (argc != 3 && argc != 4) {
14560 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14561 return JIM_ERR;
14563 else {
14564 int len;
14565 const char *s = Jim_GetString(argv[2], &len);
14566 char missing;
14568 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14569 if (missing != ' ' && argc == 4) {
14570 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14573 break;
14575 case INFO_HOSTNAME:
14576 /* Redirect to os.gethostname if it exists */
14577 return Jim_Eval(interp, "os.gethostname");
14579 case INFO_NAMEOFEXECUTABLE:
14580 /* Redirect to Tcl proc */
14581 return Jim_Eval(interp, "{info nameofexecutable}");
14583 case INFO_RETURNCODES:
14584 if (argc == 2) {
14585 int i;
14586 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14588 for (i = 0; jimReturnCodes[i]; i++) {
14589 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14590 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14591 jimReturnCodes[i], -1));
14594 Jim_SetResult(interp, listObjPtr);
14596 else if (argc == 3) {
14597 long code;
14598 const char *name;
14600 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14601 return JIM_ERR;
14603 name = Jim_ReturnCode(code);
14604 if (*name == '?') {
14605 Jim_SetResultInt(interp, code);
14607 else {
14608 Jim_SetResultString(interp, name, -1);
14611 else {
14612 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14613 return JIM_ERR;
14615 break;
14616 case INFO_REFERENCES:
14617 #ifdef JIM_REFERENCES
14618 return JimInfoReferences(interp, argc, argv);
14619 #else
14620 Jim_SetResultString(interp, "not supported", -1);
14621 return JIM_ERR;
14622 #endif
14624 return JIM_OK;
14627 /* [exists] */
14628 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14630 Jim_Obj *objPtr;
14631 int result = 0;
14633 static const char * const options[] = {
14634 "-command", "-proc", "-alias", "-var", NULL
14636 enum
14638 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14640 int option;
14642 if (argc == 2) {
14643 option = OPT_VAR;
14644 objPtr = argv[1];
14646 else if (argc == 3) {
14647 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14648 return JIM_ERR;
14650 objPtr = argv[2];
14652 else {
14653 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14654 return JIM_ERR;
14657 if (option == OPT_VAR) {
14658 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14660 else {
14661 /* Now different kinds of commands */
14662 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14664 if (cmd) {
14665 switch (option) {
14666 case OPT_COMMAND:
14667 result = 1;
14668 break;
14670 case OPT_ALIAS:
14671 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14672 break;
14674 case OPT_PROC:
14675 result = cmd->isproc;
14676 break;
14680 Jim_SetResultBool(interp, result);
14681 return JIM_OK;
14684 /* [split] */
14685 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14687 const char *str, *splitChars, *noMatchStart;
14688 int splitLen, strLen;
14689 Jim_Obj *resObjPtr;
14690 int c;
14691 int len;
14693 if (argc != 2 && argc != 3) {
14694 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14695 return JIM_ERR;
14698 str = Jim_GetString(argv[1], &len);
14699 if (len == 0) {
14700 return JIM_OK;
14702 strLen = Jim_Utf8Length(interp, argv[1]);
14704 /* Init */
14705 if (argc == 2) {
14706 splitChars = " \n\t\r";
14707 splitLen = 4;
14709 else {
14710 splitChars = Jim_String(argv[2]);
14711 splitLen = Jim_Utf8Length(interp, argv[2]);
14714 noMatchStart = str;
14715 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14717 /* Split */
14718 if (splitLen) {
14719 Jim_Obj *objPtr;
14720 while (strLen--) {
14721 const char *sc = splitChars;
14722 int scLen = splitLen;
14723 int sl = utf8_tounicode(str, &c);
14724 while (scLen--) {
14725 int pc;
14726 sc += utf8_tounicode(sc, &pc);
14727 if (c == pc) {
14728 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14729 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14730 noMatchStart = str + sl;
14731 break;
14734 str += sl;
14736 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14737 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14739 else {
14740 /* This handles the special case of splitchars eq {}
14741 * Optimise by sharing common (ASCII) characters
14743 Jim_Obj **commonObj = NULL;
14744 #define NUM_COMMON (128 - 9)
14745 while (strLen--) {
14746 int n = utf8_tounicode(str, &c);
14747 #ifdef JIM_OPTIMIZATION
14748 if (c >= 9 && c < 128) {
14749 /* Common ASCII char. Note that 9 is the tab character */
14750 c -= 9;
14751 if (!commonObj) {
14752 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14753 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14755 if (!commonObj[c]) {
14756 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14758 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14759 str++;
14760 continue;
14762 #endif
14763 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14764 str += n;
14766 Jim_Free(commonObj);
14769 Jim_SetResult(interp, resObjPtr);
14770 return JIM_OK;
14773 /* [join] */
14774 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14776 const char *joinStr;
14777 int joinStrLen;
14779 if (argc != 2 && argc != 3) {
14780 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14781 return JIM_ERR;
14783 /* Init */
14784 if (argc == 2) {
14785 joinStr = " ";
14786 joinStrLen = 1;
14788 else {
14789 joinStr = Jim_GetString(argv[2], &joinStrLen);
14791 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14792 return JIM_OK;
14795 /* [format] */
14796 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14798 Jim_Obj *objPtr;
14800 if (argc < 2) {
14801 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14802 return JIM_ERR;
14804 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14805 if (objPtr == NULL)
14806 return JIM_ERR;
14807 Jim_SetResult(interp, objPtr);
14808 return JIM_OK;
14811 /* [scan] */
14812 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14814 Jim_Obj *listPtr, **outVec;
14815 int outc, i;
14817 if (argc < 3) {
14818 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14819 return JIM_ERR;
14821 if (argv[2]->typePtr != &scanFmtStringObjType)
14822 SetScanFmtFromAny(interp, argv[2]);
14823 if (FormatGetError(argv[2]) != 0) {
14824 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14825 return JIM_ERR;
14827 if (argc > 3) {
14828 int maxPos = FormatGetMaxPos(argv[2]);
14829 int count = FormatGetCnvCount(argv[2]);
14831 if (maxPos > argc - 3) {
14832 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14833 return JIM_ERR;
14835 else if (count > argc - 3) {
14836 Jim_SetResultString(interp, "different numbers of variable names and "
14837 "field specifiers", -1);
14838 return JIM_ERR;
14840 else if (count < argc - 3) {
14841 Jim_SetResultString(interp, "variable is not assigned by any "
14842 "conversion specifiers", -1);
14843 return JIM_ERR;
14846 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14847 if (listPtr == 0)
14848 return JIM_ERR;
14849 if (argc > 3) {
14850 int rc = JIM_OK;
14851 int count = 0;
14853 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14854 int len = Jim_ListLength(interp, listPtr);
14856 if (len != 0) {
14857 JimListGetElements(interp, listPtr, &outc, &outVec);
14858 for (i = 0; i < outc; ++i) {
14859 if (Jim_Length(outVec[i]) > 0) {
14860 ++count;
14861 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14862 rc = JIM_ERR;
14867 Jim_FreeNewObj(interp, listPtr);
14869 else {
14870 count = -1;
14872 if (rc == JIM_OK) {
14873 Jim_SetResultInt(interp, count);
14875 return rc;
14877 else {
14878 if (listPtr == (Jim_Obj *)EOF) {
14879 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14880 return JIM_OK;
14882 Jim_SetResult(interp, listPtr);
14884 return JIM_OK;
14887 /* [error] */
14888 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14890 if (argc != 2 && argc != 3) {
14891 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14892 return JIM_ERR;
14894 Jim_SetResult(interp, argv[1]);
14895 if (argc == 3) {
14896 JimSetStackTrace(interp, argv[2]);
14897 return JIM_ERR;
14899 interp->addStackTrace++;
14900 return JIM_ERR;
14903 /* [lrange] */
14904 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14906 Jim_Obj *objPtr;
14908 if (argc != 4) {
14909 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14910 return JIM_ERR;
14912 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14913 return JIM_ERR;
14914 Jim_SetResult(interp, objPtr);
14915 return JIM_OK;
14918 /* [lrepeat] */
14919 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14921 Jim_Obj *objPtr;
14922 long count;
14924 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14925 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14926 return JIM_ERR;
14929 if (count == 0 || argc == 2) {
14930 return JIM_OK;
14933 argc -= 2;
14934 argv += 2;
14936 objPtr = Jim_NewListObj(interp, argv, argc);
14937 while (--count) {
14938 ListInsertElements(objPtr, -1, argc, argv);
14941 Jim_SetResult(interp, objPtr);
14942 return JIM_OK;
14945 char **Jim_GetEnviron(void)
14947 #if defined(HAVE__NSGETENVIRON)
14948 return *_NSGetEnviron();
14949 #else
14950 #if !defined(NO_ENVIRON_EXTERN)
14951 extern char **environ;
14952 #endif
14954 return environ;
14955 #endif
14958 void Jim_SetEnviron(char **env)
14960 #if defined(HAVE__NSGETENVIRON)
14961 *_NSGetEnviron() = env;
14962 #else
14963 #if !defined(NO_ENVIRON_EXTERN)
14964 extern char **environ;
14965 #endif
14967 environ = env;
14968 #endif
14971 /* [env] */
14972 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14974 const char *key;
14975 const char *val;
14977 if (argc == 1) {
14978 char **e = Jim_GetEnviron();
14980 int i;
14981 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14983 for (i = 0; e[i]; i++) {
14984 const char *equals = strchr(e[i], '=');
14986 if (equals) {
14987 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14988 equals - e[i]));
14989 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14993 Jim_SetResult(interp, listObjPtr);
14994 return JIM_OK;
14997 if (argc < 2) {
14998 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14999 return JIM_ERR;
15001 key = Jim_String(argv[1]);
15002 val = getenv(key);
15003 if (val == NULL) {
15004 if (argc < 3) {
15005 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15006 return JIM_ERR;
15008 val = Jim_String(argv[2]);
15010 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15011 return JIM_OK;
15014 /* [source] */
15015 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15017 int retval;
15019 if (argc != 2) {
15020 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15021 return JIM_ERR;
15023 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15024 if (retval == JIM_RETURN)
15025 return JIM_OK;
15026 return retval;
15029 /* [lreverse] */
15030 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15032 Jim_Obj *revObjPtr, **ele;
15033 int len;
15035 if (argc != 2) {
15036 Jim_WrongNumArgs(interp, 1, argv, "list");
15037 return JIM_ERR;
15039 JimListGetElements(interp, argv[1], &len, &ele);
15040 len--;
15041 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15042 while (len >= 0)
15043 ListAppendElement(revObjPtr, ele[len--]);
15044 Jim_SetResult(interp, revObjPtr);
15045 return JIM_OK;
15048 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15050 jim_wide len;
15052 if (step == 0)
15053 return -1;
15054 if (start == end)
15055 return 0;
15056 else if (step > 0 && start > end)
15057 return -1;
15058 else if (step < 0 && end > start)
15059 return -1;
15060 len = end - start;
15061 if (len < 0)
15062 len = -len; /* abs(len) */
15063 if (step < 0)
15064 step = -step; /* abs(step) */
15065 len = 1 + ((len - 1) / step);
15066 /* We can truncate safely to INT_MAX, the range command
15067 * will always return an error for a such long range
15068 * because Tcl lists can't be so long. */
15069 if (len > INT_MAX)
15070 len = INT_MAX;
15071 return (int)((len < 0) ? -1 : len);
15074 /* [range] */
15075 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15077 jim_wide start = 0, end, step = 1;
15078 int len, i;
15079 Jim_Obj *objPtr;
15081 if (argc < 2 || argc > 4) {
15082 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15083 return JIM_ERR;
15085 if (argc == 2) {
15086 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15087 return JIM_ERR;
15089 else {
15090 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15091 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15092 return JIM_ERR;
15093 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15094 return JIM_ERR;
15096 if ((len = JimRangeLen(start, end, step)) == -1) {
15097 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15098 return JIM_ERR;
15100 objPtr = Jim_NewListObj(interp, NULL, 0);
15101 for (i = 0; i < len; i++)
15102 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15103 Jim_SetResult(interp, objPtr);
15104 return JIM_OK;
15107 /* [rand] */
15108 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15110 jim_wide min = 0, max = 0, len, maxMul;
15112 if (argc < 1 || argc > 3) {
15113 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15114 return JIM_ERR;
15116 if (argc == 1) {
15117 max = JIM_WIDE_MAX;
15118 } else if (argc == 2) {
15119 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15120 return JIM_ERR;
15121 } else if (argc == 3) {
15122 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15123 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15124 return JIM_ERR;
15126 len = max-min;
15127 if (len < 0) {
15128 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15129 return JIM_ERR;
15131 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15132 while (1) {
15133 jim_wide r;
15135 JimRandomBytes(interp, &r, sizeof(jim_wide));
15136 if (r < 0 || r >= maxMul) continue;
15137 r = (len == 0) ? 0 : r%len;
15138 Jim_SetResultInt(interp, min+r);
15139 return JIM_OK;
15143 static const struct {
15144 const char *name;
15145 Jim_CmdProc *cmdProc;
15146 } Jim_CoreCommandsTable[] = {
15147 {"alias", Jim_AliasCoreCommand},
15148 {"set", Jim_SetCoreCommand},
15149 {"unset", Jim_UnsetCoreCommand},
15150 {"puts", Jim_PutsCoreCommand},
15151 {"+", Jim_AddCoreCommand},
15152 {"*", Jim_MulCoreCommand},
15153 {"-", Jim_SubCoreCommand},
15154 {"/", Jim_DivCoreCommand},
15155 {"incr", Jim_IncrCoreCommand},
15156 {"while", Jim_WhileCoreCommand},
15157 {"loop", Jim_LoopCoreCommand},
15158 {"for", Jim_ForCoreCommand},
15159 {"foreach", Jim_ForeachCoreCommand},
15160 {"lmap", Jim_LmapCoreCommand},
15161 {"lassign", Jim_LassignCoreCommand},
15162 {"if", Jim_IfCoreCommand},
15163 {"switch", Jim_SwitchCoreCommand},
15164 {"list", Jim_ListCoreCommand},
15165 {"lindex", Jim_LindexCoreCommand},
15166 {"lset", Jim_LsetCoreCommand},
15167 {"lsearch", Jim_LsearchCoreCommand},
15168 {"llength", Jim_LlengthCoreCommand},
15169 {"lappend", Jim_LappendCoreCommand},
15170 {"linsert", Jim_LinsertCoreCommand},
15171 {"lreplace", Jim_LreplaceCoreCommand},
15172 {"lsort", Jim_LsortCoreCommand},
15173 {"append", Jim_AppendCoreCommand},
15174 {"debug", Jim_DebugCoreCommand},
15175 {"eval", Jim_EvalCoreCommand},
15176 {"uplevel", Jim_UplevelCoreCommand},
15177 {"expr", Jim_ExprCoreCommand},
15178 {"break", Jim_BreakCoreCommand},
15179 {"continue", Jim_ContinueCoreCommand},
15180 {"proc", Jim_ProcCoreCommand},
15181 {"concat", Jim_ConcatCoreCommand},
15182 {"return", Jim_ReturnCoreCommand},
15183 {"upvar", Jim_UpvarCoreCommand},
15184 {"global", Jim_GlobalCoreCommand},
15185 {"string", Jim_StringCoreCommand},
15186 {"time", Jim_TimeCoreCommand},
15187 {"exit", Jim_ExitCoreCommand},
15188 {"catch", Jim_CatchCoreCommand},
15189 #ifdef JIM_REFERENCES
15190 {"ref", Jim_RefCoreCommand},
15191 {"getref", Jim_GetrefCoreCommand},
15192 {"setref", Jim_SetrefCoreCommand},
15193 {"finalize", Jim_FinalizeCoreCommand},
15194 {"collect", Jim_CollectCoreCommand},
15195 #endif
15196 {"rename", Jim_RenameCoreCommand},
15197 {"dict", Jim_DictCoreCommand},
15198 {"subst", Jim_SubstCoreCommand},
15199 {"info", Jim_InfoCoreCommand},
15200 {"exists", Jim_ExistsCoreCommand},
15201 {"split", Jim_SplitCoreCommand},
15202 {"join", Jim_JoinCoreCommand},
15203 {"format", Jim_FormatCoreCommand},
15204 {"scan", Jim_ScanCoreCommand},
15205 {"error", Jim_ErrorCoreCommand},
15206 {"lrange", Jim_LrangeCoreCommand},
15207 {"lrepeat", Jim_LrepeatCoreCommand},
15208 {"env", Jim_EnvCoreCommand},
15209 {"source", Jim_SourceCoreCommand},
15210 {"lreverse", Jim_LreverseCoreCommand},
15211 {"range", Jim_RangeCoreCommand},
15212 {"rand", Jim_RandCoreCommand},
15213 {"tailcall", Jim_TailcallCoreCommand},
15214 {"local", Jim_LocalCoreCommand},
15215 {"upcall", Jim_UpcallCoreCommand},
15216 {"apply", Jim_ApplyCoreCommand},
15217 {NULL, NULL},
15220 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15222 int i = 0;
15224 while (Jim_CoreCommandsTable[i].name != NULL) {
15225 Jim_CreateCommand(interp,
15226 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15227 i++;
15231 /* -----------------------------------------------------------------------------
15232 * Interactive prompt
15233 * ---------------------------------------------------------------------------*/
15234 void Jim_MakeErrorMessage(Jim_Interp *interp)
15236 Jim_Obj *argv[2];
15238 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15239 argv[1] = interp->result;
15241 Jim_EvalObjVector(interp, 2, argv);
15244 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15245 const char *prefix, const char *const *tablePtr, const char *name)
15247 int count;
15248 char **tablePtrSorted;
15249 int i;
15251 for (count = 0; tablePtr[count]; count++) {
15254 if (name == NULL) {
15255 name = "option";
15258 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15259 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15260 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15261 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15262 for (i = 0; i < count; i++) {
15263 if (i + 1 == count && count > 1) {
15264 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15266 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15267 if (i + 1 != count) {
15268 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15271 Jim_Free(tablePtrSorted);
15274 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15275 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15277 const char *bad = "bad ";
15278 const char *const *entryPtr = NULL;
15279 int i;
15280 int match = -1;
15281 int arglen;
15282 const char *arg = Jim_GetString(objPtr, &arglen);
15284 *indexPtr = -1;
15286 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15287 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15288 /* Found an exact match */
15289 *indexPtr = i;
15290 return JIM_OK;
15292 if (flags & JIM_ENUM_ABBREV) {
15293 /* Accept an unambiguous abbreviation.
15294 * Note that '-' doesnt' consitute a valid abbreviation
15296 if (strncmp(arg, *entryPtr, arglen) == 0) {
15297 if (*arg == '-' && arglen == 1) {
15298 break;
15300 if (match >= 0) {
15301 bad = "ambiguous ";
15302 goto ambiguous;
15304 match = i;
15309 /* If we had an unambiguous partial match */
15310 if (match >= 0) {
15311 *indexPtr = match;
15312 return JIM_OK;
15315 ambiguous:
15316 if (flags & JIM_ERRMSG) {
15317 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15319 return JIM_ERR;
15322 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15324 int i;
15326 for (i = 0; i < (int)len; i++) {
15327 if (array[i] && strcmp(array[i], name) == 0) {
15328 return i;
15331 return -1;
15334 int Jim_IsDict(Jim_Obj *objPtr)
15336 return objPtr->typePtr == &dictObjType;
15339 int Jim_IsList(Jim_Obj *objPtr)
15341 return objPtr->typePtr == &listObjType;
15345 * Very simple printf-like formatting, designed for error messages.
15347 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15348 * The resulting string is created and set as the result.
15350 * Each '%s' should correspond to a regular string parameter.
15351 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15352 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15354 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15356 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15358 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15360 /* Initial space needed */
15361 int len = strlen(format);
15362 int extra = 0;
15363 int n = 0;
15364 const char *params[5];
15365 char *buf;
15366 va_list args;
15367 int i;
15369 va_start(args, format);
15371 for (i = 0; i < len && n < 5; i++) {
15372 int l;
15374 if (strncmp(format + i, "%s", 2) == 0) {
15375 params[n] = va_arg(args, char *);
15377 l = strlen(params[n]);
15379 else if (strncmp(format + i, "%#s", 3) == 0) {
15380 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15382 params[n] = Jim_GetString(objPtr, &l);
15384 else {
15385 if (format[i] == '%') {
15386 i++;
15388 continue;
15390 n++;
15391 extra += l;
15394 len += extra;
15395 buf = Jim_Alloc(len + 1);
15396 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15398 va_end(args);
15400 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15403 /* stubs */
15404 #ifndef jim_ext_package
15405 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15407 return JIM_OK;
15409 #endif
15410 #ifndef jim_ext_aio
15411 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15413 Jim_SetResultString(interp, "aio not enabled", -1);
15414 return NULL;
15416 #endif
15420 * Local Variables: ***
15421 * c-basic-offset: 4 ***
15422 * tab-width: 4 ***
15423 * End: ***