regexp: add partial support for \A \Z matching
[jimtcl.git] / jim.c
blob5be02c58ef60bfb90c776f7fb53e4beeb1064b86
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
130 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
131 int flags);
132 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
133 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
134 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
135 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
136 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
137 const char *prefix, const char *const *tablePtr, const char *name);
138 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
139 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
140 static int JimSign(jim_wide w);
141 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
142 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
143 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s, int *uc, int upper)
153 int l = utf8_tounicode(s, uc);
154 if (upper) {
155 *uc = utf8_upper(*uc);
157 return l;
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
182 int not = 0;
183 int pchar;
184 int match = 0;
185 int nocase = 0;
187 if (flags & JIM_NOCASE) {
188 nocase++;
189 c = utf8_upper(c);
192 if (flags & JIM_CHARSET_SCAN) {
193 if (*pattern == '^') {
194 not++;
195 pattern++;
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern == ']') {
200 goto first;
204 while (*pattern && *pattern != ']') {
205 /* Exact match */
206 if (pattern[0] == '\\') {
207 first:
208 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
210 else {
211 /* Is this a range? a-z */
212 int start;
213 int end;
215 pattern += utf8_tounicode_case(pattern, &start, nocase);
216 if (pattern[0] == '-' && pattern[1]) {
217 /* skip '-' */
218 pattern += utf8_tounicode(pattern, &pchar);
219 pattern += utf8_tounicode_case(pattern, &end, nocase);
221 /* Handle reversed range too */
222 if ((c >= start && c <= end) || (c >= end && c <= start)) {
223 match = 1;
225 continue;
227 pchar = start;
230 if (pchar == c) {
231 match = 1;
234 if (not) {
235 match = !match;
238 return match ? pattern : NULL;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
311 * string comparison. Works on binary data.
313 * Returns -1, 0 or 1
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
319 if (l1 < l2) {
320 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
322 else if (l2 < l1) {
323 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
325 else {
326 return JimSign(memcmp(s1, s2, l1));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
340 while (*s1 && *s2 && maxchars) {
341 int c1, c2;
342 s1 += utf8_tounicode_case(s1, &c1, nocase);
343 s2 += utf8_tounicode_case(s2, &c2, nocase);
344 if (c1 != c2) {
345 return JimSign(c1 - c2);
347 maxchars--;
349 if (!maxchars) {
350 return 0;
352 /* One string or both terminated */
353 if (*s1) {
354 return 1;
356 if (*s2) {
357 return -1;
359 return 0;
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
367 int i;
368 int l1bytelen;
370 if (!l1 || !l2 || l1 > l2) {
371 return -1;
373 if (idx < 0)
374 idx = 0;
375 s2 += utf8_index(s2, idx);
377 l1bytelen = utf8_index(s1, l1);
379 for (i = idx; i <= l2 - l1; i++) {
380 int c;
381 if (memcmp(s2, s1, l1bytelen) == 0) {
382 return i;
384 s2 += utf8_tounicode(s2, &c);
386 return -1;
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
394 const char *p;
396 if (!l1 || !l2 || l1 > l2)
397 return -1;
399 /* Now search for the needle */
400 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
401 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
402 return p - s2;
405 return -1;
408 #ifdef JIM_UTF8
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
414 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
415 if (n > 0) {
416 n = utf8_strlen(s2, n);
418 return n;
420 #endif
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str, const char *endptr)
431 if (str[0] == '\0' || str == endptr) {
432 return JIM_ERR;
435 if (endptr[0] != '\0') {
436 while (*endptr) {
437 if (!isspace(UCHAR(*endptr))) {
438 return JIM_ERR;
440 endptr++;
443 return JIM_OK;
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str, int *base, int *sign)
451 int i = 0;
453 *base = 10;
455 while (isspace(UCHAR(str[i]))) {
456 i++;
459 if (str[i] == '-') {
460 *sign = -1;
461 i++;
463 else {
464 if (str[i] == '+') {
465 i++;
467 *sign = 1;
470 if (str[i] != '0') {
471 /* base 10 */
472 return 0;
475 /* We have 0<x>, so see if we can convert it */
476 switch (str[i + 1]) {
477 case 'x': case 'X': *base = 16; break;
478 case 'o': case 'O': *base = 8; break;
479 case 'b': case 'B': *base = 2; break;
480 default: return 0;
482 i += 2;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
485 /* Parse according to this base */
486 return i;
488 /* Parse as base 10 */
489 *base = 10;
490 return 0;
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str, char **endptr)
498 int sign;
499 int base;
500 int i = JimNumberBase(str, &base, &sign);
502 if (base != 10) {
503 long value = strtol(str + i, endptr, base);
504 if (endptr == NULL || *endptr != str + i) {
505 return value * sign;
509 /* Can just do a regular base-10 conversion */
510 return strtol(str, endptr, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide jim_strtoull(const char *str, char **endptr)
519 #ifdef HAVE_LONG_LONG
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 jim_wide value = strtoull(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str, endptr, 10);
533 #else
534 return (unsigned long)jim_strtol(str, endptr);
535 #endif
538 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
540 char *endptr;
542 if (base) {
543 *widePtr = strtoull(str, &endptr, base);
545 else {
546 *widePtr = jim_strtoull(str, &endptr);
549 return JimCheckConversion(str, endptr);
552 int Jim_StringToDouble(const char *str, double *doublePtr)
554 char *endptr;
556 /* Callers can check for underflow via ERANGE */
557 errno = 0;
559 *doublePtr = strtod(str, &endptr);
561 return JimCheckConversion(str, endptr);
564 static jim_wide JimPowWide(jim_wide b, jim_wide e)
566 jim_wide i, res = 1;
568 if ((b == 0 && e != 0) || (e < 0))
569 return 0;
570 for (i = 0; i < e; i++) {
571 res *= b;
573 return res;
576 /* -----------------------------------------------------------------------------
577 * Special functions
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition, const char *fmt, ...)
582 va_list ap;
584 if (!condition) {
585 return;
588 va_start(ap, fmt);
590 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr, fmt, ap);
592 fprintf(stderr, "\n\n");
593 va_end(ap);
595 #ifdef HAVE_BACKTRACE
597 void *array[40];
598 int size, i;
599 char **strings;
601 size = backtrace(array, 40);
602 strings = backtrace_symbols(array, size);
603 for (i = 0; i < size; i++)
604 fprintf(stderr, "[backtrace] %s\n", strings[i]);
605 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
608 #endif
610 exit(1);
612 #endif
614 /* -----------------------------------------------------------------------------
615 * Memory allocation
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size)
620 return size ? malloc(size) : NULL;
623 void Jim_Free(void *ptr)
625 free(ptr);
628 void *Jim_Realloc(void *ptr, int size)
630 return realloc(ptr, size);
633 char *Jim_StrDup(const char *s)
635 return strdup(s);
638 char *Jim_StrDupLen(const char *s, int l)
640 char *copy = Jim_Alloc(l + 1);
642 memcpy(copy, s, l + 1);
643 copy[l] = 0; /* Just to be sure, original could be substring */
644 return copy;
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide JimClock(void)
654 struct timeval tv;
656 gettimeofday(&tv, NULL);
657 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
660 /* -----------------------------------------------------------------------------
661 * Hash Tables
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
666 static unsigned int JimHashTableNextPower(unsigned int size);
667 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key)
674 key += ~(key << 15);
675 key ^= (key >> 10);
676 key += (key << 3);
677 key ^= (key >> 6);
678 key += ~(key << 11);
679 key ^= (key >> 16);
680 return key;
683 /* Generic hash function (we are using to multiply by 9 and add the byte
684 * as Tcl) */
685 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
687 unsigned int h = 0;
689 while (len--)
690 h += (h << 3) + *buf++;
691 return h;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable *ht)
699 ht->table = NULL;
700 ht->size = 0;
701 ht->sizemask = 0;
702 ht->used = 0;
703 ht->collisions = 0;
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht->uniq = (rand() ^ time(NULL) ^ clock());
709 #else
710 ht->uniq = 0;
711 #endif
714 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
716 iter->ht = ht;
717 iter->index = -1;
718 iter->entry = NULL;
719 iter->nextEntry = NULL;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
725 JimResetHashTable(ht);
726 ht->type = type;
727 ht->privdata = privDataPtr;
728 return JIM_OK;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable *ht)
735 int minimal = ht->used;
737 if (minimal < JIM_HT_INITIAL_SIZE)
738 minimal = JIM_HT_INITIAL_SIZE;
739 Jim_ExpandHashTable(ht, minimal);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
745 Jim_HashTable n; /* the new hashtable */
746 unsigned int realsize = JimHashTableNextPower(size), i;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size <= ht->used)
751 return;
753 Jim_InitHashTable(&n, ht->type, ht->privdata);
754 n.size = realsize;
755 n.sizemask = realsize - 1;
756 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
757 /* Keep the same 'uniq' as the original */
758 n.uniq = ht->uniq;
760 /* Initialize all the pointers to NULL */
761 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
766 n.used = ht->used;
767 for (i = 0; ht->used > 0; i++) {
768 Jim_HashEntry *he, *nextHe;
770 if (ht->table[i] == NULL)
771 continue;
773 /* For each hash entry on this slot... */
774 he = ht->table[i];
775 while (he) {
776 unsigned int h;
778 nextHe = he->next;
779 /* Get the new element index */
780 h = Jim_HashKey(ht, he->key) & n.sizemask;
781 he->next = n.table[h];
782 n.table[h] = he;
783 ht->used--;
784 /* Pass to the next element */
785 he = nextHe;
788 assert(ht->used == 0);
789 Jim_Free(ht->table);
791 /* Remap the new hashtable in the old */
792 *ht = n;
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
798 Jim_HashEntry *entry;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry = JimInsertHashEntry(ht, key, 0);
803 if (entry == NULL)
804 return JIM_ERR;
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht, entry, key);
808 Jim_SetHashVal(ht, entry, val);
809 return JIM_OK;
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
815 int existed;
816 Jim_HashEntry *entry;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry = JimInsertHashEntry(ht, key, 1);
821 if (entry->key) {
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht->type->valDestructor && ht->type->valDup) {
828 void *newval = ht->type->valDup(ht->privdata, val);
829 ht->type->valDestructor(ht->privdata, entry->u.val);
830 entry->u.val = newval;
832 else {
833 Jim_FreeEntryVal(ht, entry);
834 Jim_SetHashVal(ht, entry, val);
836 existed = 1;
838 else {
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht, entry, key);
841 Jim_SetHashVal(ht, entry, val);
842 existed = 0;
845 return existed;
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
851 unsigned int h;
852 Jim_HashEntry *he, *prevHe;
854 if (ht->used == 0)
855 return JIM_ERR;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
859 prevHe = NULL;
860 while (he) {
861 if (Jim_CompareHashKeys(ht, key, he->key)) {
862 /* Unlink the element from the list */
863 if (prevHe)
864 prevHe->next = he->next;
865 else
866 ht->table[h] = he->next;
867 Jim_FreeEntryKey(ht, he);
868 Jim_FreeEntryVal(ht, he);
869 Jim_Free(he);
870 ht->used--;
871 return JIM_OK;
873 prevHe = he;
874 he = he->next;
876 return JIM_ERR; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable *ht)
882 unsigned int i;
884 /* Free all the elements */
885 for (i = 0; ht->used > 0; i++) {
886 Jim_HashEntry *he, *nextHe;
888 if ((he = ht->table[i]) == NULL)
889 continue;
890 while (he) {
891 nextHe = he->next;
892 Jim_FreeEntryKey(ht, he);
893 Jim_FreeEntryVal(ht, he);
894 Jim_Free(he);
895 ht->used--;
896 he = nextHe;
899 /* Free the table and the allocated cache structure */
900 Jim_Free(ht->table);
901 /* Re-initialize the table */
902 JimResetHashTable(ht);
903 return JIM_OK; /* never fails */
906 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
908 Jim_HashEntry *he;
909 unsigned int h;
911 if (ht->used == 0)
912 return NULL;
913 h = Jim_HashKey(ht, key) & ht->sizemask;
914 he = ht->table[h];
915 while (he) {
916 if (Jim_CompareHashKeys(ht, key, he->key))
917 return he;
918 he = he->next;
920 return NULL;
923 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
925 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
926 JimInitHashTableIterator(ht, iter);
927 return iter;
930 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
932 while (1) {
933 if (iter->entry == NULL) {
934 iter->index++;
935 if (iter->index >= (signed)iter->ht->size)
936 break;
937 iter->entry = iter->ht->table[iter->index];
939 else {
940 iter->entry = iter->nextEntry;
942 if (iter->entry) {
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter->nextEntry = iter->entry->next;
946 return iter->entry;
949 return NULL;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
959 if (ht->size == 0)
960 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
961 if (ht->size == ht->used)
962 Jim_ExpandHashTable(ht, ht->size * 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size)
968 unsigned int i = JIM_HT_INITIAL_SIZE;
970 if (size >= 2147483648U)
971 return 2147483648U;
972 while (1) {
973 if (i >= size)
974 return i;
975 i *= 2;
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
984 unsigned int h;
985 Jim_HashEntry *he;
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht);
990 /* Compute the key hash value */
991 h = Jim_HashKey(ht, key) & ht->sizemask;
992 /* Search if this slot does not already contain the given key */
993 he = ht->table[h];
994 while (he) {
995 if (Jim_CompareHashKeys(ht, key, he->key))
996 return replace ? he : NULL;
997 he = he->next;
1000 /* Allocates the memory and stores key */
1001 he = Jim_Alloc(sizeof(*he));
1002 he->next = ht->table[h];
1003 ht->table[h] = he;
1004 ht->used++;
1005 he->key = NULL;
1007 return he;
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key)
1014 return Jim_GenHashFunction(key, strlen(key));
1017 static void *JimStringCopyHTDup(void *privdata, const void *key)
1019 return Jim_StrDup(key);
1022 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1024 return strcmp(key1, key2) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1029 Jim_Free(key);
1032 static const Jim_HashTableType JimPackageHashTableType = {
1033 JimStringCopyHTHashFunction, /* hash function */
1034 JimStringCopyHTDup, /* key dup */
1035 NULL, /* val dup */
1036 JimStringCopyHTKeyCompare, /* key compare */
1037 JimStringCopyHTKeyDestructor, /* key destructor */
1038 NULL /* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc *delProc;
1044 void *data;
1045 } AssocDataValue;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1049 AssocDataValue *assocPtr = (AssocDataValue *) data;
1051 if (assocPtr->delProc != NULL)
1052 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1053 Jim_Free(data);
1056 static const Jim_HashTableType JimAssocDataHashTableType = {
1057 JimStringCopyHTHashFunction, /* hash function */
1058 JimStringCopyHTDup, /* key dup */
1059 NULL, /* val dup */
1060 JimStringCopyHTKeyCompare, /* key compare */
1061 JimStringCopyHTKeyDestructor, /* key destructor */
1062 JimAssocDataHashTableValueDestructor /* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack *stack)
1071 stack->len = 0;
1072 stack->maxlen = 0;
1073 stack->vector = NULL;
1076 void Jim_FreeStack(Jim_Stack *stack)
1078 Jim_Free(stack->vector);
1081 int Jim_StackLen(Jim_Stack *stack)
1083 return stack->len;
1086 void Jim_StackPush(Jim_Stack *stack, void *element)
1088 int neededLen = stack->len + 1;
1090 if (neededLen > stack->maxlen) {
1091 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1092 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1094 stack->vector[stack->len] = element;
1095 stack->len++;
1098 void *Jim_StackPop(Jim_Stack *stack)
1100 if (stack->len == 0)
1101 return NULL;
1102 stack->len--;
1103 return stack->vector[stack->len];
1106 void *Jim_StackPeek(Jim_Stack *stack)
1108 if (stack->len == 0)
1109 return NULL;
1110 return stack->vector[stack->len - 1];
1113 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1115 int i;
1117 for (i = 0; i < stack->len; i++)
1118 freeFunc(stack->vector[i]);
1121 /* -----------------------------------------------------------------------------
1122 * Tcl Parser
1123 * ---------------------------------------------------------------------------*/
1125 /* Token types */
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1154 /* Parser states */
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing {
1163 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1164 int line; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1169 struct JimParserCtx
1171 const char *p; /* Pointer to the point of the program we are parsing */
1172 int len; /* Remaining length */
1173 int linenr; /* Current line number */
1174 const char *tstart;
1175 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline; /* Line number of the returned token */
1177 int tt; /* Token type */
1178 int eof; /* Non zero if EOF condition is true. */
1179 int state; /* Parser state */
1180 int comment; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx *pc);
1185 static int JimParseSep(struct JimParserCtx *pc);
1186 static int JimParseEol(struct JimParserCtx *pc);
1187 static int JimParseCmd(struct JimParserCtx *pc);
1188 static int JimParseQuote(struct JimParserCtx *pc);
1189 static int JimParseVar(struct JimParserCtx *pc);
1190 static int JimParseBrace(struct JimParserCtx *pc);
1191 static int JimParseStr(struct JimParserCtx *pc);
1192 static int JimParseComment(struct JimParserCtx *pc);
1193 static void JimParseSubCmd(struct JimParserCtx *pc);
1194 static int JimParseSubQuote(struct JimParserCtx *pc);
1195 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1202 pc->p = prg;
1203 pc->len = len;
1204 pc->tstart = NULL;
1205 pc->tend = NULL;
1206 pc->tline = 0;
1207 pc->tt = JIM_TT_NONE;
1208 pc->eof = 0;
1209 pc->state = JIM_PS_DEF;
1210 pc->linenr = linenr;
1211 pc->comment = 1;
1212 pc->missing.ch = ' ';
1213 pc->missing.line = linenr;
1216 static int JimParseScript(struct JimParserCtx *pc)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1219 if (!pc->len) {
1220 pc->tstart = pc->p;
1221 pc->tend = pc->p - 1;
1222 pc->tline = pc->linenr;
1223 pc->tt = JIM_TT_EOL;
1224 pc->eof = 1;
1225 return JIM_OK;
1227 switch (*(pc->p)) {
1228 case '\\':
1229 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1230 return JimParseSep(pc);
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 case ' ':
1235 case '\t':
1236 case '\r':
1237 case '\f':
1238 if (pc->state == JIM_PS_DEF)
1239 return JimParseSep(pc);
1240 pc->comment = 0;
1241 return JimParseStr(pc);
1242 case '\n':
1243 case ';':
1244 pc->comment = 1;
1245 if (pc->state == JIM_PS_DEF)
1246 return JimParseEol(pc);
1247 return JimParseStr(pc);
1248 case '[':
1249 pc->comment = 0;
1250 return JimParseCmd(pc);
1251 case '$':
1252 pc->comment = 0;
1253 if (JimParseVar(pc) == JIM_ERR) {
1254 /* An orphan $. Create as a separate token */
1255 pc->tstart = pc->tend = pc->p++;
1256 pc->len--;
1257 pc->tt = JIM_TT_ESC;
1259 return JIM_OK;
1260 case '#':
1261 if (pc->comment) {
1262 JimParseComment(pc);
1263 continue;
1265 return JimParseStr(pc);
1266 default:
1267 pc->comment = 0;
1268 return JimParseStr(pc);
1270 return JIM_OK;
1274 static int JimParseSep(struct JimParserCtx *pc)
1276 pc->tstart = pc->p;
1277 pc->tline = pc->linenr;
1278 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1279 if (*pc->p == '\n') {
1280 break;
1282 if (*pc->p == '\\') {
1283 pc->p++;
1284 pc->len--;
1285 pc->linenr++;
1287 pc->p++;
1288 pc->len--;
1290 pc->tend = pc->p - 1;
1291 pc->tt = JIM_TT_SEP;
1292 return JIM_OK;
1295 static int JimParseEol(struct JimParserCtx *pc)
1297 pc->tstart = pc->p;
1298 pc->tline = pc->linenr;
1299 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1300 if (*pc->p == '\n')
1301 pc->linenr++;
1302 pc->p++;
1303 pc->len--;
1305 pc->tend = pc->p - 1;
1306 pc->tt = JIM_TT_EOL;
1307 return JIM_OK;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx *pc)
1340 int level = 1;
1342 /* Skip the brace */
1343 pc->p++;
1344 pc->len--;
1345 while (pc->len) {
1346 switch (*pc->p) {
1347 case '\\':
1348 if (pc->len > 1) {
1349 if (*++pc->p == '\n') {
1350 pc->linenr++;
1352 pc->len--;
1354 break;
1356 case '{':
1357 level++;
1358 break;
1360 case '}':
1361 if (--level == 0) {
1362 pc->tend = pc->p - 1;
1363 pc->p++;
1364 pc->len--;
1365 return;
1367 break;
1369 case '\n':
1370 pc->linenr++;
1371 break;
1373 pc->p++;
1374 pc->len--;
1376 pc->missing.ch = '{';
1377 pc->missing.line = pc->tline;
1378 pc->tend = pc->p - 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1389 * or JIM_TT_STR.
1391 static int JimParseSubQuote(struct JimParserCtx *pc)
1393 int tt = JIM_TT_STR;
1394 int line = pc->tline;
1396 /* Skip the quote */
1397 pc->p++;
1398 pc->len--;
1399 while (pc->len) {
1400 switch (*pc->p) {
1401 case '\\':
1402 if (pc->len > 1) {
1403 if (*++pc->p == '\n') {
1404 pc->linenr++;
1406 pc->len--;
1407 tt = JIM_TT_ESC;
1409 break;
1411 case '"':
1412 pc->tend = pc->p - 1;
1413 pc->p++;
1414 pc->len--;
1415 return tt;
1417 case '[':
1418 JimParseSubCmd(pc);
1419 tt = JIM_TT_ESC;
1420 continue;
1422 case '\n':
1423 pc->linenr++;
1424 break;
1426 case '$':
1427 tt = JIM_TT_ESC;
1428 break;
1430 pc->p++;
1431 pc->len--;
1433 pc->missing.ch = '"';
1434 pc->missing.line = line;
1435 pc->tend = pc->p - 1;
1436 return tt;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx *pc)
1447 int level = 1;
1448 int startofword = 1;
1449 int line = pc->tline;
1451 /* Skip the bracket */
1452 pc->p++;
1453 pc->len--;
1454 while (pc->len) {
1455 switch (*pc->p) {
1456 case '\\':
1457 if (pc->len > 1) {
1458 if (*++pc->p == '\n') {
1459 pc->linenr++;
1461 pc->len--;
1463 break;
1465 case '[':
1466 level++;
1467 break;
1469 case ']':
1470 if (--level == 0) {
1471 pc->tend = pc->p - 1;
1472 pc->p++;
1473 pc->len--;
1474 return;
1476 break;
1478 case '"':
1479 if (startofword) {
1480 JimParseSubQuote(pc);
1481 continue;
1483 break;
1485 case '{':
1486 JimParseSubBrace(pc);
1487 startofword = 0;
1488 continue;
1490 case '\n':
1491 pc->linenr++;
1492 break;
1494 startofword = isspace(UCHAR(*pc->p));
1495 pc->p++;
1496 pc->len--;
1498 pc->missing.ch = '[';
1499 pc->missing.line = line;
1500 pc->tend = pc->p - 1;
1503 static int JimParseBrace(struct JimParserCtx *pc)
1505 pc->tstart = pc->p + 1;
1506 pc->tline = pc->linenr;
1507 pc->tt = JIM_TT_STR;
1508 JimParseSubBrace(pc);
1509 return JIM_OK;
1512 static int JimParseCmd(struct JimParserCtx *pc)
1514 pc->tstart = pc->p + 1;
1515 pc->tline = pc->linenr;
1516 pc->tt = JIM_TT_CMD;
1517 JimParseSubCmd(pc);
1518 return JIM_OK;
1521 static int JimParseQuote(struct JimParserCtx *pc)
1523 pc->tstart = pc->p + 1;
1524 pc->tline = pc->linenr;
1525 pc->tt = JimParseSubQuote(pc);
1526 return JIM_OK;
1529 static int JimParseVar(struct JimParserCtx *pc)
1531 /* skip the $ */
1532 pc->p++;
1533 pc->len--;
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc->p == '[') {
1537 /* Parse $[...] expr shorthand syntax */
1538 JimParseCmd(pc);
1539 pc->tt = JIM_TT_EXPRSUGAR;
1540 return JIM_OK;
1542 #endif
1544 pc->tstart = pc->p;
1545 pc->tt = JIM_TT_VAR;
1546 pc->tline = pc->linenr;
1548 if (*pc->p == '{') {
1549 pc->tstart = ++pc->p;
1550 pc->len--;
1552 while (pc->len && *pc->p != '}') {
1553 if (*pc->p == '\n') {
1554 pc->linenr++;
1556 pc->p++;
1557 pc->len--;
1559 pc->tend = pc->p - 1;
1560 if (pc->len) {
1561 pc->p++;
1562 pc->len--;
1565 else {
1566 while (1) {
1567 /* Skip double colon, but not single colon! */
1568 if (pc->p[0] == ':' && pc->p[1] == ':') {
1569 while (*pc->p == ':') {
1570 pc->p++;
1571 pc->len--;
1573 continue;
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1579 pc->p++;
1580 pc->len--;
1581 continue;
1583 break;
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc->p == '(') {
1587 int count = 1;
1588 const char *paren = NULL;
1590 pc->tt = JIM_TT_DICTSUGAR;
1592 while (count && pc->len) {
1593 pc->p++;
1594 pc->len--;
1595 if (*pc->p == '\\' && pc->len >= 1) {
1596 pc->p++;
1597 pc->len--;
1599 else if (*pc->p == '(') {
1600 count++;
1602 else if (*pc->p == ')') {
1603 paren = pc->p;
1604 count--;
1607 if (count == 0) {
1608 pc->p++;
1609 pc->len--;
1611 else if (paren) {
1612 /* Did not find a matching paren. Back up */
1613 paren++;
1614 pc->len += (pc->p - paren);
1615 pc->p = paren;
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc->tstart == '(') {
1619 pc->tt = JIM_TT_EXPRSUGAR;
1621 #endif
1623 pc->tend = pc->p - 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1628 * a string. */
1629 if (pc->tstart == pc->p) {
1630 pc->p--;
1631 pc->len++;
1632 return JIM_ERR;
1634 return JIM_OK;
1637 static int JimParseStr(struct JimParserCtx *pc)
1639 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1640 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1641 /* Starting a new word */
1642 if (*pc->p == '{') {
1643 return JimParseBrace(pc);
1645 if (*pc->p == '"') {
1646 pc->state = JIM_PS_QUOTE;
1647 pc->p++;
1648 pc->len--;
1649 /* In case the end quote is missing */
1650 pc->missing.line = pc->tline;
1653 pc->tstart = pc->p;
1654 pc->tline = pc->linenr;
1655 while (1) {
1656 if (pc->len == 0) {
1657 if (pc->state == JIM_PS_QUOTE) {
1658 pc->missing.ch = '"';
1660 pc->tend = pc->p - 1;
1661 pc->tt = JIM_TT_ESC;
1662 return JIM_OK;
1664 switch (*pc->p) {
1665 case '\\':
1666 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1667 pc->tend = pc->p - 1;
1668 pc->tt = JIM_TT_ESC;
1669 return JIM_OK;
1671 if (pc->len >= 2) {
1672 if (*(pc->p + 1) == '\n') {
1673 pc->linenr++;
1675 pc->p++;
1676 pc->len--;
1678 else if (pc->len == 1) {
1679 /* End of script with trailing backslash */
1680 pc->missing.ch = '\\';
1682 break;
1683 case '(':
1684 /* If the following token is not '$' just keep going */
1685 if (pc->len > 1 && pc->p[1] != '$') {
1686 break;
1688 /* fall through */
1689 case ')':
1690 /* Only need a separate ')' token if the previous was a var */
1691 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1692 if (pc->p == pc->tstart) {
1693 /* At the start of the token, so just return this char */
1694 pc->p++;
1695 pc->len--;
1697 pc->tend = pc->p - 1;
1698 pc->tt = JIM_TT_ESC;
1699 return JIM_OK;
1701 break;
1703 case '$':
1704 case '[':
1705 pc->tend = pc->p - 1;
1706 pc->tt = JIM_TT_ESC;
1707 return JIM_OK;
1708 case ' ':
1709 case '\t':
1710 case '\n':
1711 case '\r':
1712 case '\f':
1713 case ';':
1714 if (pc->state == JIM_PS_DEF) {
1715 pc->tend = pc->p - 1;
1716 pc->tt = JIM_TT_ESC;
1717 return JIM_OK;
1719 else if (*pc->p == '\n') {
1720 pc->linenr++;
1722 break;
1723 case '"':
1724 if (pc->state == JIM_PS_QUOTE) {
1725 pc->tend = pc->p - 1;
1726 pc->tt = JIM_TT_ESC;
1727 pc->p++;
1728 pc->len--;
1729 pc->state = JIM_PS_DEF;
1730 return JIM_OK;
1732 break;
1734 pc->p++;
1735 pc->len--;
1737 return JIM_OK; /* unreached */
1740 static int JimParseComment(struct JimParserCtx *pc)
1742 while (*pc->p) {
1743 if (*pc->p == '\\') {
1744 pc->p++;
1745 pc->len--;
1746 if (pc->len == 0) {
1747 pc->missing.ch = '\\';
1748 return JIM_OK;
1750 if (*pc->p == '\n') {
1751 pc->linenr++;
1754 else if (*pc->p == '\n') {
1755 pc->p++;
1756 pc->len--;
1757 pc->linenr++;
1758 break;
1760 pc->p++;
1761 pc->len--;
1763 return JIM_OK;
1766 /* xdigitval and odigitval are helper functions for JimEscape() */
1767 static int xdigitval(int c)
1769 if (c >= '0' && c <= '9')
1770 return c - '0';
1771 if (c >= 'a' && c <= 'f')
1772 return c - 'a' + 10;
1773 if (c >= 'A' && c <= 'F')
1774 return c - 'A' + 10;
1775 return -1;
1778 static int odigitval(int c)
1780 if (c >= '0' && c <= '7')
1781 return c - '0';
1782 return -1;
1785 /* Perform Tcl escape substitution of 's', storing the result
1786 * string into 'dest'. The escaped string is guaranteed to
1787 * be the same length or shorted than the source string.
1788 * Slen is the length of the string at 's', if it's -1 the string
1789 * length will be calculated by the function.
1791 * The function returns the length of the resulting string. */
1792 static int JimEscape(char *dest, const char *s, int slen)
1794 char *p = dest;
1795 int i, len;
1797 if (slen == -1)
1798 slen = strlen(s);
1800 for (i = 0; i < slen; i++) {
1801 switch (s[i]) {
1802 case '\\':
1803 switch (s[i + 1]) {
1804 case 'a':
1805 *p++ = 0x7;
1806 i++;
1807 break;
1808 case 'b':
1809 *p++ = 0x8;
1810 i++;
1811 break;
1812 case 'f':
1813 *p++ = 0xc;
1814 i++;
1815 break;
1816 case 'n':
1817 *p++ = 0xa;
1818 i++;
1819 break;
1820 case 'r':
1821 *p++ = 0xd;
1822 i++;
1823 break;
1824 case 't':
1825 *p++ = 0x9;
1826 i++;
1827 break;
1828 case 'u':
1829 case 'U':
1830 case 'x':
1831 /* A unicode or hex sequence.
1832 * \x Expect 1-2 hex chars and convert to hex.
1833 * \u Expect 1-4 hex chars and convert to utf-8.
1834 * \U Expect 1-8 hex chars and convert to utf-8.
1835 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1836 * An invalid sequence means simply the escaped char.
1839 unsigned val = 0;
1840 int k;
1841 int maxchars = 2;
1843 i++;
1845 if (s[i] == 'U') {
1846 maxchars = 8;
1848 else if (s[i] == 'u') {
1849 if (s[i + 1] == '{') {
1850 maxchars = 6;
1851 i++;
1853 else {
1854 maxchars = 4;
1858 for (k = 0; k < maxchars; k++) {
1859 int c = xdigitval(s[i + k + 1]);
1860 if (c == -1) {
1861 break;
1863 val = (val << 4) | c;
1865 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1866 if (s[i] == '{') {
1867 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1868 /* Back up */
1869 i--;
1870 k = 0;
1872 else {
1873 /* Skip the closing brace */
1874 k++;
1877 if (k) {
1878 /* Got a valid sequence, so convert */
1879 if (s[i] == 'x') {
1880 *p++ = val;
1882 else {
1883 p += utf8_fromunicode(p, val);
1885 i += k;
1886 break;
1888 /* Not a valid codepoint, just an escaped char */
1889 *p++ = s[i];
1891 break;
1892 case 'v':
1893 *p++ = 0xb;
1894 i++;
1895 break;
1896 case '\0':
1897 *p++ = '\\';
1898 i++;
1899 break;
1900 case '\n':
1901 /* Replace all spaces and tabs after backslash newline with a single space*/
1902 *p++ = ' ';
1903 do {
1904 i++;
1905 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1906 break;
1907 case '0':
1908 case '1':
1909 case '2':
1910 case '3':
1911 case '4':
1912 case '5':
1913 case '6':
1914 case '7':
1915 /* octal escape */
1917 int val = 0;
1918 int c = odigitval(s[i + 1]);
1920 val = c;
1921 c = odigitval(s[i + 2]);
1922 if (c == -1) {
1923 *p++ = val;
1924 i++;
1925 break;
1927 val = (val * 8) + c;
1928 c = odigitval(s[i + 3]);
1929 if (c == -1) {
1930 *p++ = val;
1931 i += 2;
1932 break;
1934 val = (val * 8) + c;
1935 *p++ = val;
1936 i += 3;
1938 break;
1939 default:
1940 *p++ = s[i + 1];
1941 i++;
1942 break;
1944 break;
1945 default:
1946 *p++ = s[i];
1947 break;
1950 len = p - dest;
1951 *p = '\0';
1952 return len;
1955 /* Returns a dynamically allocated copy of the current token in the
1956 * parser context. The function performs conversion of escapes if
1957 * the token is of type JIM_TT_ESC.
1959 * Note that after the conversion, tokens that are grouped with
1960 * braces in the source code, are always recognizable from the
1961 * identical string obtained in a different way from the type.
1963 * For example the string:
1965 * {*}$a
1967 * will return as first token "*", of type JIM_TT_STR
1969 * While the string:
1971 * *$a
1973 * will return as first token "*", of type JIM_TT_ESC
1975 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1977 const char *start, *end;
1978 char *token;
1979 int len;
1981 start = pc->tstart;
1982 end = pc->tend;
1983 if (start > end) {
1984 len = 0;
1985 token = Jim_Alloc(1);
1986 token[0] = '\0';
1988 else {
1989 len = (end - start) + 1;
1990 token = Jim_Alloc(len + 1);
1991 if (pc->tt != JIM_TT_ESC) {
1992 /* No escape conversion needed? Just copy it. */
1993 memcpy(token, start, len);
1994 token[len] = '\0';
1996 else {
1997 /* Else convert the escape chars. */
1998 len = JimEscape(token, start, len);
2002 return Jim_NewStringObjNoAlloc(interp, token, len);
2005 /* Parses the given string to determine if it represents a complete script.
2007 * This is useful for interactive shells implementation, for [info complete].
2009 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2010 * '{' on scripts incomplete missing one or more '}' to be balanced.
2011 * '[' on scripts incomplete missing one or more ']' to be balanced.
2012 * '"' on scripts incomplete missing a '"' char.
2013 * '\\' on scripts with a trailing backslash.
2015 * If the script is complete, 1 is returned, otherwise 0.
2017 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2019 struct JimParserCtx parser;
2021 JimParserInit(&parser, s, len, 1);
2022 while (!parser.eof) {
2023 JimParseScript(&parser);
2025 if (stateCharPtr) {
2026 *stateCharPtr = parser.missing.ch;
2028 return parser.missing.ch == ' ';
2031 /* -----------------------------------------------------------------------------
2032 * Tcl Lists parsing
2033 * ---------------------------------------------------------------------------*/
2034 static int JimParseListSep(struct JimParserCtx *pc);
2035 static int JimParseListStr(struct JimParserCtx *pc);
2036 static int JimParseListQuote(struct JimParserCtx *pc);
2038 static int JimParseList(struct JimParserCtx *pc)
2040 if (isspace(UCHAR(*pc->p))) {
2041 return JimParseListSep(pc);
2043 switch (*pc->p) {
2044 case '"':
2045 return JimParseListQuote(pc);
2047 case '{':
2048 return JimParseBrace(pc);
2050 default:
2051 if (pc->len) {
2052 return JimParseListStr(pc);
2054 break;
2057 pc->tstart = pc->tend = pc->p;
2058 pc->tline = pc->linenr;
2059 pc->tt = JIM_TT_EOL;
2060 pc->eof = 1;
2061 return JIM_OK;
2064 static int JimParseListSep(struct JimParserCtx *pc)
2066 pc->tstart = pc->p;
2067 pc->tline = pc->linenr;
2068 while (isspace(UCHAR(*pc->p))) {
2069 if (*pc->p == '\n') {
2070 pc->linenr++;
2072 pc->p++;
2073 pc->len--;
2075 pc->tend = pc->p - 1;
2076 pc->tt = JIM_TT_SEP;
2077 return JIM_OK;
2080 static int JimParseListQuote(struct JimParserCtx *pc)
2082 pc->p++;
2083 pc->len--;
2085 pc->tstart = pc->p;
2086 pc->tline = pc->linenr;
2087 pc->tt = JIM_TT_STR;
2089 while (pc->len) {
2090 switch (*pc->p) {
2091 case '\\':
2092 pc->tt = JIM_TT_ESC;
2093 if (--pc->len == 0) {
2094 /* Trailing backslash */
2095 pc->tend = pc->p;
2096 return JIM_OK;
2098 pc->p++;
2099 break;
2100 case '\n':
2101 pc->linenr++;
2102 break;
2103 case '"':
2104 pc->tend = pc->p - 1;
2105 pc->p++;
2106 pc->len--;
2107 return JIM_OK;
2109 pc->p++;
2110 pc->len--;
2113 pc->tend = pc->p - 1;
2114 return JIM_OK;
2117 static int JimParseListStr(struct JimParserCtx *pc)
2119 pc->tstart = pc->p;
2120 pc->tline = pc->linenr;
2121 pc->tt = JIM_TT_STR;
2123 while (pc->len) {
2124 if (isspace(UCHAR(*pc->p))) {
2125 pc->tend = pc->p - 1;
2126 return JIM_OK;
2128 if (*pc->p == '\\') {
2129 if (--pc->len == 0) {
2130 /* Trailing backslash */
2131 pc->tend = pc->p;
2132 return JIM_OK;
2134 pc->tt = JIM_TT_ESC;
2135 pc->p++;
2137 pc->p++;
2138 pc->len--;
2140 pc->tend = pc->p - 1;
2141 return JIM_OK;
2144 /* -----------------------------------------------------------------------------
2145 * Jim_Obj related functions
2146 * ---------------------------------------------------------------------------*/
2148 /* Return a new initialized object. */
2149 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2151 Jim_Obj *objPtr;
2153 /* -- Check if there are objects in the free list -- */
2154 if (interp->freeList != NULL) {
2155 /* -- Unlink the object from the free list -- */
2156 objPtr = interp->freeList;
2157 interp->freeList = objPtr->nextObjPtr;
2159 else {
2160 /* -- No ready to use objects: allocate a new one -- */
2161 objPtr = Jim_Alloc(sizeof(*objPtr));
2164 /* Object is returned with refCount of 0. Every
2165 * kind of GC implemented should take care to don't try
2166 * to scan objects with refCount == 0. */
2167 objPtr->refCount = 0;
2168 /* All the other fields are left not initialized to save time.
2169 * The caller will probably want to set them to the right
2170 * value anyway. */
2172 /* -- Put the object into the live list -- */
2173 objPtr->prevObjPtr = NULL;
2174 objPtr->nextObjPtr = interp->liveList;
2175 if (interp->liveList)
2176 interp->liveList->prevObjPtr = objPtr;
2177 interp->liveList = objPtr;
2179 return objPtr;
2182 /* Free an object. Actually objects are never freed, but
2183 * just moved to the free objects list, where they will be
2184 * reused by Jim_NewObj(). */
2185 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2187 /* Check if the object was already freed, panic. */
2188 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2189 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2191 /* Free the internal representation */
2192 Jim_FreeIntRep(interp, objPtr);
2193 /* Free the string representation */
2194 if (objPtr->bytes != NULL) {
2195 if (objPtr->bytes != JimEmptyStringRep)
2196 Jim_Free(objPtr->bytes);
2198 /* Unlink the object from the live objects list */
2199 if (objPtr->prevObjPtr)
2200 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2201 if (objPtr->nextObjPtr)
2202 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2203 if (interp->liveList == objPtr)
2204 interp->liveList = objPtr->nextObjPtr;
2205 #ifdef JIM_DISABLE_OBJECT_POOL
2206 Jim_Free(objPtr);
2207 #else
2208 /* Link the object into the free objects list */
2209 objPtr->prevObjPtr = NULL;
2210 objPtr->nextObjPtr = interp->freeList;
2211 if (interp->freeList)
2212 interp->freeList->prevObjPtr = objPtr;
2213 interp->freeList = objPtr;
2214 objPtr->refCount = -1;
2215 #endif
2218 /* Invalidate the string representation of an object. */
2219 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2221 if (objPtr->bytes != NULL) {
2222 if (objPtr->bytes != JimEmptyStringRep)
2223 Jim_Free(objPtr->bytes);
2225 objPtr->bytes = NULL;
2228 /* Duplicate an object. The returned object has refcount = 0. */
2229 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2231 Jim_Obj *dupPtr;
2233 dupPtr = Jim_NewObj(interp);
2234 if (objPtr->bytes == NULL) {
2235 /* Object does not have a valid string representation. */
2236 dupPtr->bytes = NULL;
2238 else if (objPtr->length == 0) {
2239 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2240 dupPtr->bytes = JimEmptyStringRep;
2241 dupPtr->length = 0;
2242 dupPtr->typePtr = NULL;
2243 return dupPtr;
2245 else {
2246 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2247 dupPtr->length = objPtr->length;
2248 /* Copy the null byte too */
2249 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2252 /* By default, the new object has the same type as the old object */
2253 dupPtr->typePtr = objPtr->typePtr;
2254 if (objPtr->typePtr != NULL) {
2255 if (objPtr->typePtr->dupIntRepProc == NULL) {
2256 dupPtr->internalRep = objPtr->internalRep;
2258 else {
2259 /* The dup proc may set a different type, e.g. NULL */
2260 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2263 return dupPtr;
2266 /* Return the string representation for objPtr. If the object's
2267 * string representation is invalid, calls the updateStringProc method to create
2268 * a new one from the internal representation of the object.
2270 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2272 if (objPtr->bytes == NULL) {
2273 /* Invalid string repr. Generate it. */
2274 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2275 objPtr->typePtr->updateStringProc(objPtr);
2277 if (lenPtr)
2278 *lenPtr = objPtr->length;
2279 return objPtr->bytes;
2282 /* Just returns the length of the object's string rep */
2283 int Jim_Length(Jim_Obj *objPtr)
2285 if (objPtr->bytes == NULL) {
2286 /* Invalid string repr. Generate it. */
2287 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2288 objPtr->typePtr->updateStringProc(objPtr);
2290 return objPtr->length;
2293 /* Just returns object's string rep */
2294 const char *Jim_String(Jim_Obj *objPtr)
2296 if (objPtr->bytes == NULL) {
2297 /* Invalid string repr. Generate it. */
2298 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2299 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2300 objPtr->typePtr->updateStringProc(objPtr);
2302 return objPtr->bytes;
2305 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2307 objPtr->bytes = Jim_StrDup(str);
2308 objPtr->length = strlen(str);
2311 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2312 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2314 static const Jim_ObjType dictSubstObjType = {
2315 "dict-substitution",
2316 FreeDictSubstInternalRep,
2317 DupDictSubstInternalRep,
2318 NULL,
2319 JIM_TYPE_NONE,
2322 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2324 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2327 static const Jim_ObjType interpolatedObjType = {
2328 "interpolated",
2329 FreeInterpolatedInternalRep,
2330 NULL,
2331 NULL,
2332 JIM_TYPE_NONE,
2335 /* -----------------------------------------------------------------------------
2336 * String Object
2337 * ---------------------------------------------------------------------------*/
2338 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2339 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2341 static const Jim_ObjType stringObjType = {
2342 "string",
2343 NULL,
2344 DupStringInternalRep,
2345 NULL,
2346 JIM_TYPE_REFERENCES,
2349 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2351 JIM_NOTUSED(interp);
2353 /* This is a bit subtle: the only caller of this function
2354 * should be Jim_DuplicateObj(), that will copy the
2355 * string representaion. After the copy, the duplicated
2356 * object will not have more room in the buffer than
2357 * srcPtr->length bytes. So we just set it to length. */
2358 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2359 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2362 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2364 if (objPtr->typePtr != &stringObjType) {
2365 /* Get a fresh string representation. */
2366 if (objPtr->bytes == NULL) {
2367 /* Invalid string repr. Generate it. */
2368 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2369 objPtr->typePtr->updateStringProc(objPtr);
2371 /* Free any other internal representation. */
2372 Jim_FreeIntRep(interp, objPtr);
2373 /* Set it as string, i.e. just set the maxLength field. */
2374 objPtr->typePtr = &stringObjType;
2375 objPtr->internalRep.strValue.maxLength = objPtr->length;
2376 /* Don't know the utf-8 length yet */
2377 objPtr->internalRep.strValue.charLength = -1;
2379 return JIM_OK;
2383 * Returns the length of the object string in chars, not bytes.
2385 * These may be different for a utf-8 string.
2387 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2389 #ifdef JIM_UTF8
2390 SetStringFromAny(interp, objPtr);
2392 if (objPtr->internalRep.strValue.charLength < 0) {
2393 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2395 return objPtr->internalRep.strValue.charLength;
2396 #else
2397 return Jim_Length(objPtr);
2398 #endif
2401 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2402 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2404 Jim_Obj *objPtr = Jim_NewObj(interp);
2406 /* Need to find out how many bytes the string requires */
2407 if (len == -1)
2408 len = strlen(s);
2409 /* Alloc/Set the string rep. */
2410 if (len == 0) {
2411 objPtr->bytes = JimEmptyStringRep;
2413 else {
2414 objPtr->bytes = Jim_Alloc(len + 1);
2415 memcpy(objPtr->bytes, s, len);
2416 objPtr->bytes[len] = '\0';
2418 objPtr->length = len;
2420 /* No typePtr field for the vanilla string object. */
2421 objPtr->typePtr = NULL;
2422 return objPtr;
2425 /* charlen is in characters -- see also Jim_NewStringObj() */
2426 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2428 #ifdef JIM_UTF8
2429 /* Need to find out how many bytes the string requires */
2430 int bytelen = utf8_index(s, charlen);
2432 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2434 /* Remember the utf8 length, so set the type */
2435 objPtr->typePtr = &stringObjType;
2436 objPtr->internalRep.strValue.maxLength = bytelen;
2437 objPtr->internalRep.strValue.charLength = charlen;
2439 return objPtr;
2440 #else
2441 return Jim_NewStringObj(interp, s, charlen);
2442 #endif
2445 /* This version does not try to duplicate the 's' pointer, but
2446 * use it directly. */
2447 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2449 Jim_Obj *objPtr = Jim_NewObj(interp);
2451 objPtr->bytes = s;
2452 objPtr->length = (len == -1) ? strlen(s) : len;
2453 objPtr->typePtr = NULL;
2454 return objPtr;
2457 /* Low-level string append. Use it only against unshared objects
2458 * of type "string". */
2459 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2461 int needlen;
2463 if (len == -1)
2464 len = strlen(str);
2465 needlen = objPtr->length + len;
2466 if (objPtr->internalRep.strValue.maxLength < needlen ||
2467 objPtr->internalRep.strValue.maxLength == 0) {
2468 needlen *= 2;
2469 /* Inefficient to malloc() for less than 8 bytes */
2470 if (needlen < 7) {
2471 needlen = 7;
2473 if (objPtr->bytes == JimEmptyStringRep) {
2474 objPtr->bytes = Jim_Alloc(needlen + 1);
2476 else {
2477 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2479 objPtr->internalRep.strValue.maxLength = needlen;
2481 memcpy(objPtr->bytes + objPtr->length, str, len);
2482 objPtr->bytes[objPtr->length + len] = '\0';
2484 if (objPtr->internalRep.strValue.charLength >= 0) {
2485 /* Update the utf-8 char length */
2486 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2488 objPtr->length += len;
2491 /* Higher level API to append strings to objects.
2492 * Object must not be unshared for each of these.
2494 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2496 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2497 SetStringFromAny(interp, objPtr);
2498 StringAppendString(objPtr, str, len);
2501 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2503 int len;
2504 const char *str = Jim_GetString(appendObjPtr, &len);
2505 Jim_AppendString(interp, objPtr, str, len);
2508 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2510 va_list ap;
2512 SetStringFromAny(interp, objPtr);
2513 va_start(ap, objPtr);
2514 while (1) {
2515 const char *s = va_arg(ap, const char *);
2517 if (s == NULL)
2518 break;
2519 Jim_AppendString(interp, objPtr, s, -1);
2521 va_end(ap);
2524 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2526 if (aObjPtr == bObjPtr) {
2527 return 1;
2529 else {
2530 int Alen, Blen;
2531 const char *sA = Jim_GetString(aObjPtr, &Alen);
2532 const char *sB = Jim_GetString(bObjPtr, &Blen);
2534 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2539 * Note. Does not support embedded nulls in either the pattern or the object.
2541 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2543 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2547 * Note: does not support embedded nulls for the nocase option.
2549 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2551 int l1, l2;
2552 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2553 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2555 if (nocase) {
2556 /* Do a character compare for nocase */
2557 return JimStringCompareLen(s1, s2, -1, nocase);
2559 return JimStringCompare(s1, l1, s2, l2);
2563 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2565 * Note: does not support embedded nulls
2567 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2569 const char *s1 = Jim_String(firstObjPtr);
2570 const char *s2 = Jim_String(secondObjPtr);
2572 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2575 /* Convert a range, as returned by Jim_GetRange(), into
2576 * an absolute index into an object of the specified length.
2577 * This function may return negative values, or values
2578 * greater than or equal to the length of the list if the index
2579 * is out of range. */
2580 static int JimRelToAbsIndex(int len, int idx)
2582 if (idx < 0)
2583 return len + idx;
2584 return idx;
2587 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2588 * into a form suitable for implementation of commands like [string range] and [lrange].
2590 * The resulting range is guaranteed to address valid elements of
2591 * the structure.
2593 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2595 int rangeLen;
2597 if (*firstPtr > *lastPtr) {
2598 rangeLen = 0;
2600 else {
2601 rangeLen = *lastPtr - *firstPtr + 1;
2602 if (rangeLen) {
2603 if (*firstPtr < 0) {
2604 rangeLen += *firstPtr;
2605 *firstPtr = 0;
2607 if (*lastPtr >= len) {
2608 rangeLen -= (*lastPtr - (len - 1));
2609 *lastPtr = len - 1;
2613 if (rangeLen < 0)
2614 rangeLen = 0;
2616 *rangeLenPtr = rangeLen;
2619 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2620 int len, int *first, int *last, int *range)
2622 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2623 return JIM_ERR;
2625 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2626 return JIM_ERR;
2628 *first = JimRelToAbsIndex(len, *first);
2629 *last = JimRelToAbsIndex(len, *last);
2630 JimRelToAbsRange(len, first, last, range);
2631 return JIM_OK;
2634 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2635 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2637 int first, last;
2638 const char *str;
2639 int rangeLen;
2640 int bytelen;
2642 str = Jim_GetString(strObjPtr, &bytelen);
2644 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2645 return NULL;
2648 if (first == 0 && rangeLen == bytelen) {
2649 return strObjPtr;
2651 return Jim_NewStringObj(interp, str + first, rangeLen);
2654 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2655 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2657 #ifdef JIM_UTF8
2658 int first, last;
2659 const char *str;
2660 int len, rangeLen;
2661 int bytelen;
2663 str = Jim_GetString(strObjPtr, &bytelen);
2664 len = Jim_Utf8Length(interp, strObjPtr);
2666 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2667 return NULL;
2670 if (first == 0 && rangeLen == len) {
2671 return strObjPtr;
2673 if (len == bytelen) {
2674 /* ASCII optimisation */
2675 return Jim_NewStringObj(interp, str + first, rangeLen);
2677 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2678 #else
2679 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2680 #endif
2683 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2684 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2686 int first, last;
2687 const char *str;
2688 int len, rangeLen;
2689 Jim_Obj *objPtr;
2691 len = Jim_Utf8Length(interp, strObjPtr);
2693 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2694 return NULL;
2697 if (last < first) {
2698 return strObjPtr;
2701 str = Jim_String(strObjPtr);
2703 /* Before part */
2704 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2706 /* Replacement */
2707 if (newStrObj) {
2708 Jim_AppendObj(interp, objPtr, newStrObj);
2711 /* After part */
2712 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2714 return objPtr;
2718 * Note: does not support embedded nulls.
2720 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2722 while (*str) {
2723 int c;
2724 str += utf8_tounicode(str, &c);
2725 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2727 *dest = 0;
2731 * Note: does not support embedded nulls.
2733 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2735 char *buf;
2736 int len;
2737 const char *str;
2739 SetStringFromAny(interp, strObjPtr);
2741 str = Jim_GetString(strObjPtr, &len);
2743 #ifdef JIM_UTF8
2744 /* Case mapping can change the utf-8 length of the string.
2745 * But at worst it will be by one extra byte per char
2747 len *= 2;
2748 #endif
2749 buf = Jim_Alloc(len + 1);
2750 JimStrCopyUpperLower(buf, str, 0);
2751 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2755 * Note: does not support embedded nulls.
2757 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2759 char *buf;
2760 const char *str;
2761 int len;
2763 if (strObjPtr->typePtr != &stringObjType) {
2764 SetStringFromAny(interp, strObjPtr);
2767 str = Jim_GetString(strObjPtr, &len);
2769 #ifdef JIM_UTF8
2770 /* Case mapping can change the utf-8 length of the string.
2771 * But at worst it will be by one extra byte per char
2773 len *= 2;
2774 #endif
2775 buf = Jim_Alloc(len + 1);
2776 JimStrCopyUpperLower(buf, str, 1);
2777 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2781 * Note: does not support embedded nulls.
2783 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2785 char *buf, *p;
2786 int len;
2787 int c;
2788 const char *str;
2790 str = Jim_GetString(strObjPtr, &len);
2791 if (len == 0) {
2792 return strObjPtr;
2794 #ifdef JIM_UTF8
2795 /* Case mapping can change the utf-8 length of the string.
2796 * But at worst it will be by one extra byte per char
2798 len *= 2;
2799 #endif
2800 buf = p = Jim_Alloc(len + 1);
2802 str += utf8_tounicode(str, &c);
2803 p += utf8_getchars(p, utf8_title(c));
2805 JimStrCopyUpperLower(p, str, 0);
2807 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2810 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2811 * for unicode character 'c'.
2812 * Returns the position if found or NULL if not
2814 static const char *utf8_memchr(const char *str, int len, int c)
2816 #ifdef JIM_UTF8
2817 while (len) {
2818 int sc;
2819 int n = utf8_tounicode(str, &sc);
2820 if (sc == c) {
2821 return str;
2823 str += n;
2824 len -= n;
2826 return NULL;
2827 #else
2828 return memchr(str, c, len);
2829 #endif
2833 * Searches for the first non-trim char in string (str, len)
2835 * If none is found, returns just past the last char.
2837 * Lengths are in bytes.
2839 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2841 while (len) {
2842 int c;
2843 int n = utf8_tounicode(str, &c);
2845 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2846 /* Not a trim char, so stop */
2847 break;
2849 str += n;
2850 len -= n;
2852 return str;
2856 * Searches backwards for a non-trim char in string (str, len).
2858 * Returns a pointer to just after the non-trim char, or NULL if not found.
2860 * Lengths are in bytes.
2862 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2864 str += len;
2866 while (len) {
2867 int c;
2868 int n = utf8_prev_len(str, len);
2870 len -= n;
2871 str -= n;
2873 n = utf8_tounicode(str, &c);
2875 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2876 return str + n;
2880 return NULL;
2883 static const char default_trim_chars[] = " \t\n\r";
2884 /* sizeof() here includes the null byte */
2885 static int default_trim_chars_len = sizeof(default_trim_chars);
2887 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2889 int len;
2890 const char *str = Jim_GetString(strObjPtr, &len);
2891 const char *trimchars = default_trim_chars;
2892 int trimcharslen = default_trim_chars_len;
2893 const char *newstr;
2895 if (trimcharsObjPtr) {
2896 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2899 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2900 if (newstr == str) {
2901 return strObjPtr;
2904 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2907 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2909 int len;
2910 const char *trimchars = default_trim_chars;
2911 int trimcharslen = default_trim_chars_len;
2912 const char *nontrim;
2914 if (trimcharsObjPtr) {
2915 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2918 SetStringFromAny(interp, strObjPtr);
2920 len = Jim_Length(strObjPtr);
2921 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2923 if (nontrim == NULL) {
2924 /* All trim, so return a zero-length string */
2925 return Jim_NewEmptyStringObj(interp);
2927 if (nontrim == strObjPtr->bytes + len) {
2928 /* All non-trim, so return the original object */
2929 return strObjPtr;
2932 if (Jim_IsShared(strObjPtr)) {
2933 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2935 else {
2936 /* Can modify this string in place */
2937 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2938 strObjPtr->length = (nontrim - strObjPtr->bytes);
2941 return strObjPtr;
2944 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2946 /* First trim left. */
2947 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2949 /* Now trim right */
2950 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2952 /* Note: refCount check is needed since objPtr may be emptyObj */
2953 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2954 /* We don't want this object to be leaked */
2955 Jim_FreeNewObj(interp, objPtr);
2958 return strObjPtr;
2961 /* Some platforms don't have isascii - need a non-macro version */
2962 #ifdef HAVE_ISASCII
2963 #define jim_isascii isascii
2964 #else
2965 static int jim_isascii(int c)
2967 return !(c & ~0x7f);
2969 #endif
2971 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2973 static const char * const strclassnames[] = {
2974 "integer", "alpha", "alnum", "ascii", "digit",
2975 "double", "lower", "upper", "space", "xdigit",
2976 "control", "print", "graph", "punct",
2977 NULL
2979 enum {
2980 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2981 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2982 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2984 int strclass;
2985 int len;
2986 int i;
2987 const char *str;
2988 int (*isclassfunc)(int c) = NULL;
2990 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2991 return JIM_ERR;
2994 str = Jim_GetString(strObjPtr, &len);
2995 if (len == 0) {
2996 Jim_SetResultBool(interp, !strict);
2997 return JIM_OK;
3000 switch (strclass) {
3001 case STR_IS_INTEGER:
3003 jim_wide w;
3004 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3005 return JIM_OK;
3008 case STR_IS_DOUBLE:
3010 double d;
3011 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3012 return JIM_OK;
3015 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3016 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3017 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3018 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3019 case STR_IS_LOWER: isclassfunc = islower; break;
3020 case STR_IS_UPPER: isclassfunc = isupper; break;
3021 case STR_IS_SPACE: isclassfunc = isspace; break;
3022 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3023 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3024 case STR_IS_PRINT: isclassfunc = isprint; break;
3025 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3026 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3027 default:
3028 return JIM_ERR;
3031 for (i = 0; i < len; i++) {
3032 if (!isclassfunc(str[i])) {
3033 Jim_SetResultBool(interp, 0);
3034 return JIM_OK;
3037 Jim_SetResultBool(interp, 1);
3038 return JIM_OK;
3041 /* -----------------------------------------------------------------------------
3042 * Compared String Object
3043 * ---------------------------------------------------------------------------*/
3045 /* This is strange object that allows comparison of a C literal string
3046 * with a Jim object in a very short time if the same comparison is done
3047 * multiple times. For example every time the [if] command is executed,
3048 * Jim has to check if a given argument is "else".
3049 * If the code has no errors, this comparison is true most of the time,
3050 * so we can cache the pointer of the string of the last matching
3051 * comparison inside the object. Because most C compilers perform literal sharing,
3052 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3053 * this works pretty well even if comparisons are at different places
3054 * inside the C code. */
3056 static const Jim_ObjType comparedStringObjType = {
3057 "compared-string",
3058 NULL,
3059 NULL,
3060 NULL,
3061 JIM_TYPE_REFERENCES,
3064 /* The only way this object is exposed to the API is via the following
3065 * function. Returns true if the string and the object string repr.
3066 * are the same, otherwise zero is returned.
3068 * Note: this isn't binary safe, but it hardly needs to be.*/
3069 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3071 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3072 return 1;
3074 else {
3075 const char *objStr = Jim_String(objPtr);
3077 if (strcmp(str, objStr) != 0)
3078 return 0;
3080 if (objPtr->typePtr != &comparedStringObjType) {
3081 Jim_FreeIntRep(interp, objPtr);
3082 objPtr->typePtr = &comparedStringObjType;
3084 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3085 return 1;
3089 static int qsortCompareStringPointers(const void *a, const void *b)
3091 char *const *sa = (char *const *)a;
3092 char *const *sb = (char *const *)b;
3094 return strcmp(*sa, *sb);
3098 /* -----------------------------------------------------------------------------
3099 * Source Object
3101 * This object is just a string from the language point of view, but
3102 * the internal representation contains the filename and line number
3103 * where this token was read. This information is used by
3104 * Jim_EvalObj() if the object passed happens to be of type "source".
3106 * This allows propagation of the information about line numbers and file
3107 * names and gives error messages with absolute line numbers.
3109 * Note that this object uses the internal representation of the Jim_Object,
3110 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3112 * Also the object will be converted to something else if the given
3113 * token it represents in the source file is not something to be
3114 * evaluated (not a script), and will be specialized in some other way,
3115 * so the time overhead is also almost zero.
3116 * ---------------------------------------------------------------------------*/
3118 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3119 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3121 static const Jim_ObjType sourceObjType = {
3122 "source",
3123 FreeSourceInternalRep,
3124 DupSourceInternalRep,
3125 NULL,
3126 JIM_TYPE_REFERENCES,
3129 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3131 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3134 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3136 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3137 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3140 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3141 Jim_Obj *fileNameObj, int lineNumber)
3143 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3144 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3145 Jim_IncrRefCount(fileNameObj);
3146 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3147 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3148 objPtr->typePtr = &sourceObjType;
3151 /* -----------------------------------------------------------------------------
3152 * ScriptLine Object
3154 * This object is used only in the Script internal represenation.
3155 * For each line of the script, it holds the number of tokens on the line
3156 * and the source line number.
3158 static const Jim_ObjType scriptLineObjType = {
3159 "scriptline",
3160 NULL,
3161 NULL,
3162 NULL,
3163 JIM_NONE,
3166 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3168 Jim_Obj *objPtr;
3170 #ifdef DEBUG_SHOW_SCRIPT
3171 char buf[100];
3172 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3173 objPtr = Jim_NewStringObj(interp, buf, -1);
3174 #else
3175 objPtr = Jim_NewEmptyStringObj(interp);
3176 #endif
3177 objPtr->typePtr = &scriptLineObjType;
3178 objPtr->internalRep.scriptLineValue.argc = argc;
3179 objPtr->internalRep.scriptLineValue.line = line;
3181 return objPtr;
3184 /* -----------------------------------------------------------------------------
3185 * Script Object
3187 * This object holds the parsed internal representation of a script.
3188 * This representation is help within an allocated ScriptObj (see below)
3190 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3191 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3192 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3193 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3195 static const Jim_ObjType scriptObjType = {
3196 "script",
3197 FreeScriptInternalRep,
3198 DupScriptInternalRep,
3199 NULL,
3200 JIM_TYPE_REFERENCES,
3203 /* Each token of a script is represented by a ScriptToken.
3204 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3205 * can be specialized by commands operating on it.
3207 typedef struct ScriptToken
3209 Jim_Obj *objPtr;
3210 int type;
3211 } ScriptToken;
3213 /* This is the script object internal representation. An array of
3214 * ScriptToken structures, including a pre-computed representation of the
3215 * command length and arguments.
3217 * For example the script:
3219 * puts hello
3220 * set $i $x$y [foo]BAR
3222 * will produce a ScriptObj with the following ScriptToken's:
3224 * LIN 2
3225 * ESC puts
3226 * ESC hello
3227 * LIN 4
3228 * ESC set
3229 * VAR i
3230 * WRD 2
3231 * VAR x
3232 * VAR y
3233 * WRD 2
3234 * CMD foo
3235 * ESC BAR
3237 * "puts hello" has two args (LIN 2), composed of single tokens.
3238 * (Note that the WRD token is omitted for the common case of a single token.)
3240 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3241 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3243 * The precomputation of the command structure makes Jim_Eval() faster,
3244 * and simpler because there aren't dynamic lengths / allocations.
3246 * -- {expand}/{*} handling --
3248 * Expand is handled in a special way.
3250 * If a "word" begins with {*}, the word token count is -ve.
3252 * For example the command:
3254 * list {*}{a b}
3256 * Will produce the following cmdstruct array:
3258 * LIN 2
3259 * ESC list
3260 * WRD -1
3261 * STR a b
3263 * Note that the 'LIN' token also contains the source information for the
3264 * first word of the line for error reporting purposes
3266 * -- the substFlags field of the structure --
3268 * The scriptObj structure is used to represent both "script" objects
3269 * and "subst" objects. In the second case, there are no LIN and WRD
3270 * tokens. Instead SEP and EOL tokens are added as-is.
3271 * In addition, the field 'substFlags' is used to represent the flags used to turn
3272 * the string into the internal representation.
3273 * If these flags do not match what the application requires,
3274 * the scriptObj is created again. For example the script:
3276 * subst -nocommands $string
3277 * subst -novariables $string
3279 * Will (re)create the internal representation of the $string object
3280 * two times.
3282 typedef struct ScriptObj
3284 ScriptToken *token; /* Tokens array. */
3285 Jim_Obj *fileNameObj; /* Filename */
3286 int len; /* Length of token[] */
3287 int substFlags; /* flags used for the compilation of "subst" objects */
3288 int inUse; /* Used to share a ScriptObj. Currently
3289 only used by Jim_EvalObj() as protection against
3290 shimmering of the currently evaluated object. */
3291 int firstline; /* Line number of the first line */
3292 int linenr; /* Error line number, if any */
3293 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3294 } ScriptObj;
3296 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3298 int i;
3299 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3301 if (--script->inUse != 0)
3302 return;
3303 for (i = 0; i < script->len; i++) {
3304 Jim_DecrRefCount(interp, script->token[i].objPtr);
3306 Jim_Free(script->token);
3307 Jim_DecrRefCount(interp, script->fileNameObj);
3308 Jim_Free(script);
3311 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3313 JIM_NOTUSED(interp);
3314 JIM_NOTUSED(srcPtr);
3316 /* Just return a simple string. We don't try to preserve the source info
3317 * since in practice scripts are never duplicated
3319 dupPtr->typePtr = NULL;
3322 /* A simple parse token.
3323 * As the script is parsed, the created tokens point into the script string rep.
3325 typedef struct
3327 const char *token; /* Pointer to the start of the token */
3328 int len; /* Length of this token */
3329 int type; /* Token type */
3330 int line; /* Line number */
3331 } ParseToken;
3333 /* A list of parsed tokens representing a script.
3334 * Tokens are added to this list as the script is parsed.
3335 * It grows as needed.
3337 typedef struct
3339 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3340 ParseToken *list; /* Array of tokens */
3341 int size; /* Current size of the list */
3342 int count; /* Number of entries used */
3343 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3344 } ParseTokenList;
3346 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3348 tokenlist->list = tokenlist->static_list;
3349 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3350 tokenlist->count = 0;
3353 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3355 if (tokenlist->list != tokenlist->static_list) {
3356 Jim_Free(tokenlist->list);
3361 * Adds the new token to the tokenlist.
3362 * The token has the given length, type and line number.
3363 * The token list is resized as necessary.
3365 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3366 int line)
3368 ParseToken *t;
3370 if (tokenlist->count == tokenlist->size) {
3371 /* Resize the list */
3372 tokenlist->size *= 2;
3373 if (tokenlist->list != tokenlist->static_list) {
3374 tokenlist->list =
3375 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3377 else {
3378 /* The list needs to become allocated */
3379 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3380 memcpy(tokenlist->list, tokenlist->static_list,
3381 tokenlist->count * sizeof(*tokenlist->list));
3384 t = &tokenlist->list[tokenlist->count++];
3385 t->token = token;
3386 t->len = len;
3387 t->type = type;
3388 t->line = line;
3391 /* Counts the number of adjoining non-separator tokens.
3393 * Returns -ve if the first token is the expansion
3394 * operator (in which case the count doesn't include
3395 * that token).
3397 static int JimCountWordTokens(ParseToken *t)
3399 int expand = 1;
3400 int count = 0;
3402 /* Is the first word {*} or {expand}? */
3403 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3404 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3405 /* Create an expand token */
3406 expand = -1;
3407 t++;
3411 /* Now count non-separator words */
3412 while (!TOKEN_IS_SEP(t->type)) {
3413 t++;
3414 count++;
3417 return count * expand;
3421 * Create a script/subst object from the given token.
3423 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3425 Jim_Obj *objPtr;
3427 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3428 /* Convert backlash escapes. The result will never be longer than the original */
3429 int len = t->len;
3430 char *str = Jim_Alloc(len + 1);
3431 len = JimEscape(str, t->token, len);
3432 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3434 else {
3435 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3436 * with a single space.
3438 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3440 return objPtr;
3444 * Takes a tokenlist and creates the allocated list of script tokens
3445 * in script->token, of length script->len.
3447 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3448 * as required.
3450 * Also sets script->line to the line number of the first token
3452 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3453 ParseTokenList *tokenlist)
3455 int i;
3456 struct ScriptToken *token;
3457 /* Number of tokens so far for the current command */
3458 int lineargs = 0;
3459 /* This is the first token for the current command */
3460 ScriptToken *linefirst;
3461 int count;
3462 int linenr;
3464 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3465 printf("==== Tokens ====\n");
3466 for (i = 0; i < tokenlist->count; i++) {
3467 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3468 tokenlist->list[i].len, tokenlist->list[i].token);
3470 #endif
3472 /* May need up to one extra script token for each EOL in the worst case */
3473 count = tokenlist->count;
3474 for (i = 0; i < tokenlist->count; i++) {
3475 if (tokenlist->list[i].type == JIM_TT_EOL) {
3476 count++;
3479 linenr = script->firstline = tokenlist->list[0].line;
3481 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3483 /* This is the first token for the current command */
3484 linefirst = token++;
3486 for (i = 0; i < tokenlist->count; ) {
3487 /* Look ahead to find out how many tokens make up the next word */
3488 int wordtokens;
3490 /* Skip any leading separators */
3491 while (tokenlist->list[i].type == JIM_TT_SEP) {
3492 i++;
3495 wordtokens = JimCountWordTokens(tokenlist->list + i);
3497 if (wordtokens == 0) {
3498 /* None, so at end of line */
3499 if (lineargs) {
3500 linefirst->type = JIM_TT_LINE;
3501 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3502 Jim_IncrRefCount(linefirst->objPtr);
3504 /* Reset for new line */
3505 lineargs = 0;
3506 linefirst = token++;
3508 i++;
3509 continue;
3511 else if (wordtokens != 1) {
3512 /* More than 1, or {*}, so insert a WORD token */
3513 token->type = JIM_TT_WORD;
3514 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3515 Jim_IncrRefCount(token->objPtr);
3516 token++;
3517 if (wordtokens < 0) {
3518 /* Skip the expand token */
3519 i++;
3520 wordtokens = -wordtokens - 1;
3521 lineargs--;
3525 if (lineargs == 0) {
3526 /* First real token on the line, so record the line number */
3527 linenr = tokenlist->list[i].line;
3529 lineargs++;
3531 /* Add each non-separator word token to the line */
3532 while (wordtokens--) {
3533 const ParseToken *t = &tokenlist->list[i++];
3535 token->type = t->type;
3536 token->objPtr = JimMakeScriptObj(interp, t);
3537 Jim_IncrRefCount(token->objPtr);
3539 /* Every object is initially a string of type 'source', but the
3540 * internal type may be specialized during execution of the
3541 * script. */
3542 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3543 token++;
3547 if (lineargs == 0) {
3548 token--;
3551 script->len = token - script->token;
3553 JimPanic((script->len >= count, "allocated script array is too short"));
3555 #ifdef DEBUG_SHOW_SCRIPT
3556 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3557 for (i = 0; i < script->len; i++) {
3558 const ScriptToken *t = &script->token[i];
3559 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3561 #endif
3566 * Sets an appropriate error message for a missing script/expression terminator.
3568 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3570 * Note that a trailing backslash is not considered to be an error.
3572 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3574 const char *msg;
3576 switch (ch) {
3577 case '\\':
3578 case ' ':
3579 return JIM_OK;
3581 case '[':
3582 msg = "unmatched \"[\"";
3583 break;
3584 case '{':
3585 msg = "missing close-brace";
3586 break;
3587 case '"':
3588 default:
3589 msg = "missing quote";
3590 break;
3593 Jim_SetResultString(interp, msg, -1);
3594 return JIM_ERR;
3598 * Similar to ScriptObjAddTokens(), but for subst objects.
3600 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3601 ParseTokenList *tokenlist)
3603 int i;
3604 struct ScriptToken *token;
3606 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3608 for (i = 0; i < tokenlist->count; i++) {
3609 const ParseToken *t = &tokenlist->list[i];
3611 /* Create a token for 't' */
3612 token->type = t->type;
3613 token->objPtr = JimMakeScriptObj(interp, t);
3614 Jim_IncrRefCount(token->objPtr);
3615 token++;
3618 script->len = i;
3621 /* This method takes the string representation of an object
3622 * as a Tcl script, and generates the pre-parsed internal representation
3623 * of the script.
3625 * On parse error, sets an error message and returns JIM_ERR
3626 * (Note: the object is still converted to a script, even if an error occurs)
3628 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3630 int scriptTextLen;
3631 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3632 struct JimParserCtx parser;
3633 struct ScriptObj *script;
3634 ParseTokenList tokenlist;
3635 int line = 1;
3637 /* Try to get information about filename / line number */
3638 if (objPtr->typePtr == &sourceObjType) {
3639 line = objPtr->internalRep.sourceValue.lineNumber;
3642 /* Initially parse the script into tokens (in tokenlist) */
3643 ScriptTokenListInit(&tokenlist);
3645 JimParserInit(&parser, scriptText, scriptTextLen, line);
3646 while (!parser.eof) {
3647 JimParseScript(&parser);
3648 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3649 parser.tline);
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 Jim_IncrRefCount(script->fileNameObj);
3666 script->missing = parser.missing.ch;
3667 script->linenr = parser.missing.line;
3669 ScriptObjAddTokens(interp, script, &tokenlist);
3671 /* No longer need the token list */
3672 ScriptTokenListFree(&tokenlist);
3674 /* Free the old internal rep and set the new one. */
3675 Jim_FreeIntRep(interp, objPtr);
3676 Jim_SetIntRepPtr(objPtr, script);
3677 objPtr->typePtr = &scriptObjType;
3680 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3683 * Returns the parsed script.
3684 * Note that if there is any possibility that the script is not valid,
3685 * call JimScriptValid() to check
3687 ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3689 if (objPtr == interp->emptyObj) {
3690 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3691 objPtr = interp->nullScriptObj;
3694 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3695 JimSetScriptFromAny(interp, objPtr);
3698 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3702 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3703 * and leaves an error message in the interp result.
3706 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3708 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3709 JimAddErrorToStack(interp, script);
3710 return 0;
3712 return 1;
3716 /* -----------------------------------------------------------------------------
3717 * Commands
3718 * ---------------------------------------------------------------------------*/
3719 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3721 cmdPtr->inUse++;
3724 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3726 if (--cmdPtr->inUse == 0) {
3727 if (cmdPtr->isproc) {
3728 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3729 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3730 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3731 if (cmdPtr->u.proc.staticVars) {
3732 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3733 Jim_Free(cmdPtr->u.proc.staticVars);
3736 else {
3737 /* native (C) */
3738 if (cmdPtr->u.native.delProc) {
3739 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3742 if (cmdPtr->prevCmd) {
3743 /* Delete any pushed command too */
3744 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3746 Jim_Free(cmdPtr);
3750 /* Variables HashTable Type.
3752 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3755 /* Variables HashTable Type.
3757 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3758 static void JimVariablesHTValDestructor(void *interp, void *val)
3760 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3761 Jim_Free(val);
3764 static const Jim_HashTableType JimVariablesHashTableType = {
3765 JimStringCopyHTHashFunction, /* hash function */
3766 JimStringCopyHTDup, /* key dup */
3767 NULL, /* val dup */
3768 JimStringCopyHTKeyCompare, /* key compare */
3769 JimStringCopyHTKeyDestructor, /* key destructor */
3770 JimVariablesHTValDestructor /* val destructor */
3773 /* Commands HashTable Type.
3775 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3777 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3779 JimDecrCmdRefCount(interp, val);
3782 static const Jim_HashTableType JimCommandsHashTableType = {
3783 JimStringCopyHTHashFunction, /* hash function */
3784 JimStringCopyHTDup, /* key dup */
3785 NULL, /* val dup */
3786 JimStringCopyHTKeyCompare, /* key compare */
3787 JimStringCopyHTKeyDestructor, /* key destructor */
3788 JimCommandsHT_ValDestructor /* val destructor */
3791 /* ------------------------- Commands related functions --------------------- */
3793 #ifdef jim_ext_namespace
3795 * Returns the "unscoped" version of the given namespace.
3796 * That is, the fully qualified name without the leading ::
3797 * The returned value is either nsObj, or an object with a zero ref count.
3799 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3801 const char *name = Jim_String(nsObj);
3802 if (name[0] == ':' && name[1] == ':') {
3803 /* This command is being defined in the global namespace */
3804 while (*++name == ':') {
3806 nsObj = Jim_NewStringObj(interp, name, -1);
3808 else if (Jim_Length(interp->framePtr->nsObj)) {
3809 /* This command is being defined in a non-global namespace */
3810 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3811 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3813 return nsObj;
3816 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3818 Jim_Obj *resultObj;
3820 const char *name = Jim_String(nameObjPtr);
3821 if (name[0] == ':' && name[1] == ':') {
3822 return nameObjPtr;
3824 Jim_IncrRefCount(nameObjPtr);
3825 resultObj = Jim_NewStringObj(interp, "::", -1);
3826 Jim_AppendObj(interp, resultObj, nameObjPtr);
3827 Jim_DecrRefCount(interp, nameObjPtr);
3829 return resultObj;
3833 * An efficient version of JimQualifyNameObj() where the name is
3834 * available (and needed) as a 'const char *'.
3835 * Avoids creating an object if not necessary.
3836 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3838 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3840 Jim_Obj *objPtr = interp->emptyObj;
3842 if (name[0] == ':' && name[1] == ':') {
3843 /* This command is being defined in the global namespace */
3844 while (*++name == ':') {
3847 else if (Jim_Length(interp->framePtr->nsObj)) {
3848 /* This command is being defined in a non-global namespace */
3849 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3850 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3851 name = Jim_String(objPtr);
3853 Jim_IncrRefCount(objPtr);
3854 *objPtrPtr = objPtr;
3855 return name;
3858 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3860 #else
3861 /* We can be more efficient in the no-namespace case */
3862 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3863 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3865 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3867 return nameObjPtr;
3869 #endif
3871 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3873 /* It may already exist, so we try to delete the old one.
3874 * Note that reference count means that it won't be deleted yet if
3875 * it exists in the call stack.
3877 * BUT, if 'local' is in force, instead of deleting the existing
3878 * proc, we stash a reference to the old proc here.
3880 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3881 if (he) {
3882 /* There was an old cmd with the same name,
3883 * so this requires a 'proc epoch' update. */
3885 /* If a procedure with the same name didn't exist there is no need
3886 * to increment the 'proc epoch' because creation of a new procedure
3887 * can never affect existing cached commands. We don't do
3888 * negative caching. */
3889 Jim_InterpIncrProcEpoch(interp);
3892 if (he && interp->local) {
3893 /* Push this command over the top of the previous one */
3894 cmd->prevCmd = Jim_GetHashEntryVal(he);
3895 Jim_SetHashVal(&interp->commands, he, cmd);
3897 else {
3898 if (he) {
3899 /* Replace the existing command */
3900 Jim_DeleteHashEntry(&interp->commands, name);
3903 Jim_AddHashEntry(&interp->commands, name, cmd);
3905 return JIM_OK;
3909 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3910 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3912 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3914 /* Store the new details for this command */
3915 memset(cmdPtr, 0, sizeof(*cmdPtr));
3916 cmdPtr->inUse = 1;
3917 cmdPtr->u.native.delProc = delProc;
3918 cmdPtr->u.native.cmdProc = cmdProc;
3919 cmdPtr->u.native.privData = privData;
3921 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3923 return JIM_OK;
3926 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3928 int len, i;
3930 len = Jim_ListLength(interp, staticsListObjPtr);
3931 if (len == 0) {
3932 return JIM_OK;
3935 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3936 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3937 for (i = 0; i < len; i++) {
3938 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3939 Jim_Var *varPtr;
3940 int subLen;
3942 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3943 /* Check if it's composed of two elements. */
3944 subLen = Jim_ListLength(interp, objPtr);
3945 if (subLen == 1 || subLen == 2) {
3946 /* Try to get the variable value from the current
3947 * environment. */
3948 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3949 if (subLen == 1) {
3950 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3951 if (initObjPtr == NULL) {
3952 Jim_SetResultFormatted(interp,
3953 "variable for initialization of static \"%#s\" not found in the local context",
3954 nameObjPtr);
3955 return JIM_ERR;
3958 else {
3959 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3961 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3962 return JIM_ERR;
3965 varPtr = Jim_Alloc(sizeof(*varPtr));
3966 varPtr->objPtr = initObjPtr;
3967 Jim_IncrRefCount(initObjPtr);
3968 varPtr->linkFramePtr = NULL;
3969 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3970 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3971 Jim_SetResultFormatted(interp,
3972 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3973 Jim_DecrRefCount(interp, initObjPtr);
3974 Jim_Free(varPtr);
3975 return JIM_ERR;
3978 else {
3979 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3980 objPtr);
3981 return JIM_ERR;
3984 return JIM_OK;
3987 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3989 #ifdef jim_ext_namespace
3990 if (cmdPtr->isproc) {
3991 /* XXX: Really need JimNamespaceSplit() */
3992 const char *pt = strrchr(cmdname, ':');
3993 if (pt && pt != cmdname && pt[-1] == ':') {
3994 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3995 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3996 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3998 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3999 /* This commands shadows a global command, so a proc epoch update is required */
4000 Jim_InterpIncrProcEpoch(interp);
4004 #endif
4007 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4008 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4010 Jim_Cmd *cmdPtr;
4011 int argListLen;
4012 int i;
4014 argListLen = Jim_ListLength(interp, argListObjPtr);
4016 /* Allocate space for both the command pointer and the arg list */
4017 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4018 memset(cmdPtr, 0, sizeof(*cmdPtr));
4019 cmdPtr->inUse = 1;
4020 cmdPtr->isproc = 1;
4021 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4022 cmdPtr->u.proc.argListLen = argListLen;
4023 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4024 cmdPtr->u.proc.argsPos = -1;
4025 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4026 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4027 Jim_IncrRefCount(argListObjPtr);
4028 Jim_IncrRefCount(bodyObjPtr);
4029 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4031 /* Create the statics hash table. */
4032 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4033 goto err;
4036 /* Parse the args out into arglist, validating as we go */
4037 /* Examine the argument list for default parameters and 'args' */
4038 for (i = 0; i < argListLen; i++) {
4039 Jim_Obj *argPtr;
4040 Jim_Obj *nameObjPtr;
4041 Jim_Obj *defaultObjPtr;
4042 int len;
4044 /* Examine a parameter */
4045 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4046 len = Jim_ListLength(interp, argPtr);
4047 if (len == 0) {
4048 Jim_SetResultString(interp, "argument with no name", -1);
4049 err:
4050 JimDecrCmdRefCount(interp, cmdPtr);
4051 return NULL;
4053 if (len > 2) {
4054 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4055 goto err;
4058 if (len == 2) {
4059 /* Optional parameter */
4060 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4061 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4063 else {
4064 /* Required parameter */
4065 nameObjPtr = argPtr;
4066 defaultObjPtr = NULL;
4070 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4071 if (cmdPtr->u.proc.argsPos >= 0) {
4072 Jim_SetResultString(interp, "'args' specified more than once", -1);
4073 goto err;
4075 cmdPtr->u.proc.argsPos = i;
4077 else {
4078 if (len == 2) {
4079 cmdPtr->u.proc.optArity++;
4081 else {
4082 cmdPtr->u.proc.reqArity++;
4086 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4087 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4090 return cmdPtr;
4093 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4095 int ret = JIM_OK;
4096 Jim_Obj *qualifiedNameObj;
4097 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4099 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4100 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4101 ret = JIM_ERR;
4103 else {
4104 Jim_InterpIncrProcEpoch(interp);
4107 JimFreeQualifiedName(interp, qualifiedNameObj);
4109 return ret;
4112 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4114 int ret = JIM_ERR;
4115 Jim_HashEntry *he;
4116 Jim_Cmd *cmdPtr;
4117 Jim_Obj *qualifiedOldNameObj;
4118 Jim_Obj *qualifiedNewNameObj;
4119 const char *fqold;
4120 const char *fqnew;
4122 if (newName[0] == 0) {
4123 return Jim_DeleteCommand(interp, oldName);
4126 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4127 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4129 /* Does it exist? */
4130 he = Jim_FindHashEntry(&interp->commands, fqold);
4131 if (he == NULL) {
4132 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4134 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4135 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4137 else {
4138 /* Add the new name first */
4139 cmdPtr = Jim_GetHashEntryVal(he);
4140 JimIncrCmdRefCount(cmdPtr);
4141 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4142 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4144 /* Now remove the old name */
4145 Jim_DeleteHashEntry(&interp->commands, fqold);
4147 /* Increment the epoch */
4148 Jim_InterpIncrProcEpoch(interp);
4150 ret = JIM_OK;
4153 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4154 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4156 return ret;
4159 /* -----------------------------------------------------------------------------
4160 * Command object
4161 * ---------------------------------------------------------------------------*/
4163 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4165 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4168 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4170 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4171 dupPtr->typePtr = srcPtr->typePtr;
4172 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4175 static const Jim_ObjType commandObjType = {
4176 "command",
4177 FreeCommandInternalRep,
4178 DupCommandInternalRep,
4179 NULL,
4180 JIM_TYPE_REFERENCES,
4183 /* This function returns the command structure for the command name
4184 * stored in objPtr. It tries to specialize the objPtr to contain
4185 * a cached info instead to perform the lookup into the hash table
4186 * every time. The information cached may not be uptodate, in such
4187 * a case the lookup is performed and the cache updated.
4189 * Respects the 'upcall' setting
4191 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4193 Jim_Cmd *cmd;
4195 /* In order to be valid, the proc epoch must match and
4196 * the lookup must have occurred in the same namespace
4198 if (objPtr->typePtr != &commandObjType ||
4199 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4200 #ifdef jim_ext_namespace
4201 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4202 #endif
4204 /* Not cached or out of date, so lookup */
4206 /* Do we need to try the local namespace? */
4207 const char *name = Jim_String(objPtr);
4208 Jim_HashEntry *he;
4210 if (name[0] == ':' && name[1] == ':') {
4211 while (*++name == ':') {
4214 #ifdef jim_ext_namespace
4215 else if (Jim_Length(interp->framePtr->nsObj)) {
4216 /* This command is being defined in a non-global namespace */
4217 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4218 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4219 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4220 Jim_FreeNewObj(interp, nameObj);
4221 if (he) {
4222 goto found;
4225 #endif
4227 /* Lookup in the global namespace */
4228 he = Jim_FindHashEntry(&interp->commands, name);
4229 if (he == NULL) {
4230 if (flags & JIM_ERRMSG) {
4231 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4233 return NULL;
4235 #ifdef jim_ext_namespace
4236 found:
4237 #endif
4238 cmd = Jim_GetHashEntryVal(he);
4240 /* Free the old internal repr and set the new one. */
4241 Jim_FreeIntRep(interp, objPtr);
4242 objPtr->typePtr = &commandObjType;
4243 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4244 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4245 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4246 Jim_IncrRefCount(interp->framePtr->nsObj);
4248 else {
4249 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4251 while (cmd->u.proc.upcall) {
4252 cmd = cmd->prevCmd;
4254 return cmd;
4257 /* -----------------------------------------------------------------------------
4258 * Variables
4259 * ---------------------------------------------------------------------------*/
4261 /* -----------------------------------------------------------------------------
4262 * Variable object
4263 * ---------------------------------------------------------------------------*/
4265 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4267 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4269 static const Jim_ObjType variableObjType = {
4270 "variable",
4271 NULL,
4272 NULL,
4273 NULL,
4274 JIM_TYPE_REFERENCES,
4278 * Check that the name does not contain embedded nulls.
4280 * Variable and procedure names are manipulated as null terminated strings, so
4281 * don't allow names with embedded nulls.
4283 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4285 /* Variable names and proc names can't contain embedded nulls */
4286 if (nameObjPtr->typePtr != &variableObjType) {
4287 int len;
4288 const char *str = Jim_GetString(nameObjPtr, &len);
4289 if (memchr(str, '\0', len)) {
4290 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4291 return JIM_ERR;
4294 return JIM_OK;
4297 /* This method should be called only by the variable API.
4298 * It returns JIM_OK on success (variable already exists),
4299 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4300 * a variable name, but syntax glue for [dict] i.e. the last
4301 * character is ')' */
4302 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4304 const char *varName;
4305 Jim_CallFrame *framePtr;
4306 Jim_HashEntry *he;
4307 int global;
4308 int len;
4310 /* Check if the object is already an uptodate variable */
4311 if (objPtr->typePtr == &variableObjType) {
4312 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4313 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4314 /* nothing to do */
4315 return JIM_OK;
4317 /* Need to re-resolve the variable in the updated callframe */
4319 else if (objPtr->typePtr == &dictSubstObjType) {
4320 return JIM_DICT_SUGAR;
4322 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4323 return JIM_ERR;
4327 varName = Jim_GetString(objPtr, &len);
4329 /* Make sure it's not syntax glue to get/set dict. */
4330 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4331 return JIM_DICT_SUGAR;
4334 if (varName[0] == ':' && varName[1] == ':') {
4335 while (*++varName == ':') {
4337 global = 1;
4338 framePtr = interp->topFramePtr;
4340 else {
4341 global = 0;
4342 framePtr = interp->framePtr;
4345 /* Resolve this name in the variables hash table */
4346 he = Jim_FindHashEntry(&framePtr->vars, varName);
4347 if (he == NULL) {
4348 if (!global && framePtr->staticVars) {
4349 /* Try with static vars. */
4350 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4352 if (he == NULL) {
4353 return JIM_ERR;
4357 /* Free the old internal repr and set the new one. */
4358 Jim_FreeIntRep(interp, objPtr);
4359 objPtr->typePtr = &variableObjType;
4360 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4361 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4362 objPtr->internalRep.varValue.global = global;
4363 return JIM_OK;
4366 /* -------------------- Variables related functions ------------------------- */
4367 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4368 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4370 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4372 const char *name;
4373 Jim_CallFrame *framePtr;
4374 int global;
4376 /* New variable to create */
4377 Jim_Var *var = Jim_Alloc(sizeof(*var));
4379 var->objPtr = valObjPtr;
4380 Jim_IncrRefCount(valObjPtr);
4381 var->linkFramePtr = NULL;
4383 name = Jim_String(nameObjPtr);
4384 if (name[0] == ':' && name[1] == ':') {
4385 while (*++name == ':') {
4387 framePtr = interp->topFramePtr;
4388 global = 1;
4390 else {
4391 framePtr = interp->framePtr;
4392 global = 0;
4395 /* Insert the new variable */
4396 Jim_AddHashEntry(&framePtr->vars, name, var);
4398 /* Make the object int rep a variable */
4399 Jim_FreeIntRep(interp, nameObjPtr);
4400 nameObjPtr->typePtr = &variableObjType;
4401 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4402 nameObjPtr->internalRep.varValue.varPtr = var;
4403 nameObjPtr->internalRep.varValue.global = global;
4405 return var;
4408 /* For now that's dummy. Variables lookup should be optimized
4409 * in many ways, with caching of lookups, and possibly with
4410 * a table of pre-allocated vars in every CallFrame for local vars.
4411 * All the caching should also have an 'epoch' mechanism similar
4412 * to the one used by Tcl for procedures lookup caching. */
4414 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4416 int err;
4417 Jim_Var *var;
4419 switch (SetVariableFromAny(interp, nameObjPtr)) {
4420 case JIM_DICT_SUGAR:
4421 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4423 case JIM_ERR:
4424 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4425 return JIM_ERR;
4427 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4428 break;
4430 case JIM_OK:
4431 var = nameObjPtr->internalRep.varValue.varPtr;
4432 if (var->linkFramePtr == NULL) {
4433 Jim_IncrRefCount(valObjPtr);
4434 Jim_DecrRefCount(interp, var->objPtr);
4435 var->objPtr = valObjPtr;
4437 else { /* Else handle the link */
4438 Jim_CallFrame *savedCallFrame;
4440 savedCallFrame = interp->framePtr;
4441 interp->framePtr = var->linkFramePtr;
4442 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4443 interp->framePtr = savedCallFrame;
4444 if (err != JIM_OK)
4445 return err;
4448 return JIM_OK;
4451 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4453 Jim_Obj *nameObjPtr;
4454 int result;
4456 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4457 Jim_IncrRefCount(nameObjPtr);
4458 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4459 Jim_DecrRefCount(interp, nameObjPtr);
4460 return result;
4463 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4465 Jim_CallFrame *savedFramePtr;
4466 int result;
4468 savedFramePtr = interp->framePtr;
4469 interp->framePtr = interp->topFramePtr;
4470 result = Jim_SetVariableStr(interp, name, objPtr);
4471 interp->framePtr = savedFramePtr;
4472 return result;
4475 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4477 Jim_Obj *nameObjPtr, *valObjPtr;
4478 int result;
4480 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4481 valObjPtr = Jim_NewStringObj(interp, val, -1);
4482 Jim_IncrRefCount(nameObjPtr);
4483 Jim_IncrRefCount(valObjPtr);
4484 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4485 Jim_DecrRefCount(interp, nameObjPtr);
4486 Jim_DecrRefCount(interp, valObjPtr);
4487 return result;
4490 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4491 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4493 const char *varName;
4494 const char *targetName;
4495 Jim_CallFrame *framePtr;
4496 Jim_Var *varPtr;
4498 /* Check for an existing variable or link */
4499 switch (SetVariableFromAny(interp, nameObjPtr)) {
4500 case JIM_DICT_SUGAR:
4501 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4502 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4503 return JIM_ERR;
4505 case JIM_OK:
4506 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4508 if (varPtr->linkFramePtr == NULL) {
4509 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4510 return JIM_ERR;
4513 /* It exists, but is a link, so first delete the link */
4514 varPtr->linkFramePtr = NULL;
4515 break;
4518 /* Resolve the call frames for both variables */
4519 /* XXX: SetVariableFromAny() already did this! */
4520 varName = Jim_String(nameObjPtr);
4522 if (varName[0] == ':' && varName[1] == ':') {
4523 while (*++varName == ':') {
4525 /* Linking a global var does nothing */
4526 framePtr = interp->topFramePtr;
4528 else {
4529 framePtr = interp->framePtr;
4532 targetName = Jim_String(targetNameObjPtr);
4533 if (targetName[0] == ':' && targetName[1] == ':') {
4534 while (*++targetName == ':') {
4536 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4537 targetCallFrame = interp->topFramePtr;
4539 Jim_IncrRefCount(targetNameObjPtr);
4541 if (framePtr->level < targetCallFrame->level) {
4542 Jim_SetResultFormatted(interp,
4543 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4544 nameObjPtr);
4545 Jim_DecrRefCount(interp, targetNameObjPtr);
4546 return JIM_ERR;
4549 /* Check for cycles. */
4550 if (framePtr == targetCallFrame) {
4551 Jim_Obj *objPtr = targetNameObjPtr;
4553 /* Cycles are only possible with 'uplevel 0' */
4554 while (1) {
4555 if (strcmp(Jim_String(objPtr), varName) == 0) {
4556 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4557 Jim_DecrRefCount(interp, targetNameObjPtr);
4558 return JIM_ERR;
4560 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4561 break;
4562 varPtr = objPtr->internalRep.varValue.varPtr;
4563 if (varPtr->linkFramePtr != targetCallFrame)
4564 break;
4565 objPtr = varPtr->objPtr;
4569 /* Perform the binding */
4570 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4571 /* We are now sure 'nameObjPtr' type is variableObjType */
4572 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4573 Jim_DecrRefCount(interp, targetNameObjPtr);
4574 return JIM_OK;
4577 /* Return the Jim_Obj pointer associated with a variable name,
4578 * or NULL if the variable was not found in the current context.
4579 * The same optimization discussed in the comment to the
4580 * 'SetVariable' function should apply here.
4582 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4583 * in a dictionary which is shared, the array variable value is duplicated first.
4584 * This allows the array element to be updated (e.g. append, lappend) without
4585 * affecting other references to the dictionary.
4587 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4589 switch (SetVariableFromAny(interp, nameObjPtr)) {
4590 case JIM_OK:{
4591 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4593 if (varPtr->linkFramePtr == NULL) {
4594 return varPtr->objPtr;
4596 else {
4597 Jim_Obj *objPtr;
4599 /* The variable is a link? Resolve it. */
4600 Jim_CallFrame *savedCallFrame = interp->framePtr;
4602 interp->framePtr = varPtr->linkFramePtr;
4603 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4604 interp->framePtr = savedCallFrame;
4605 if (objPtr) {
4606 return objPtr;
4608 /* Error, so fall through to the error message */
4611 break;
4613 case JIM_DICT_SUGAR:
4614 /* [dict] syntax sugar. */
4615 return JimDictSugarGet(interp, nameObjPtr, flags);
4617 if (flags & JIM_ERRMSG) {
4618 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4620 return NULL;
4623 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4625 Jim_CallFrame *savedFramePtr;
4626 Jim_Obj *objPtr;
4628 savedFramePtr = interp->framePtr;
4629 interp->framePtr = interp->topFramePtr;
4630 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4631 interp->framePtr = savedFramePtr;
4633 return objPtr;
4636 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4638 Jim_Obj *nameObjPtr, *varObjPtr;
4640 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4641 Jim_IncrRefCount(nameObjPtr);
4642 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4643 Jim_DecrRefCount(interp, nameObjPtr);
4644 return varObjPtr;
4647 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4649 Jim_CallFrame *savedFramePtr;
4650 Jim_Obj *objPtr;
4652 savedFramePtr = interp->framePtr;
4653 interp->framePtr = interp->topFramePtr;
4654 objPtr = Jim_GetVariableStr(interp, name, flags);
4655 interp->framePtr = savedFramePtr;
4657 return objPtr;
4660 /* Unset a variable.
4661 * Note: On success unset invalidates all the variable objects created
4662 * in the current call frame incrementing. */
4663 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4665 Jim_Var *varPtr;
4666 int retval;
4667 Jim_CallFrame *framePtr;
4669 retval = SetVariableFromAny(interp, nameObjPtr);
4670 if (retval == JIM_DICT_SUGAR) {
4671 /* [dict] syntax sugar. */
4672 return JimDictSugarSet(interp, nameObjPtr, NULL);
4674 else if (retval == JIM_OK) {
4675 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4677 /* If it's a link call UnsetVariable recursively */
4678 if (varPtr->linkFramePtr) {
4679 framePtr = interp->framePtr;
4680 interp->framePtr = varPtr->linkFramePtr;
4681 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4682 interp->framePtr = framePtr;
4684 else {
4685 const char *name = Jim_String(nameObjPtr);
4686 if (nameObjPtr->internalRep.varValue.global) {
4687 name += 2;
4688 framePtr = interp->topFramePtr;
4690 else {
4691 framePtr = interp->framePtr;
4694 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4695 if (retval == JIM_OK) {
4696 /* Change the callframe id, invalidating var lookup caching */
4697 framePtr->id = interp->callFrameEpoch++;
4701 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4702 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4704 return retval;
4707 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4709 /* Given a variable name for [dict] operation syntax sugar,
4710 * this function returns two objects, the first with the name
4711 * of the variable to set, and the second with the respective key.
4712 * For example "foo(bar)" will return objects with string repr. of
4713 * "foo" and "bar".
4715 * The returned objects have refcount = 1. The function can't fail. */
4716 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4717 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4719 const char *str, *p;
4720 int len, keyLen;
4721 Jim_Obj *varObjPtr, *keyObjPtr;
4723 str = Jim_GetString(objPtr, &len);
4725 p = strchr(str, '(');
4726 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4728 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4730 p++;
4731 keyLen = (str + len) - p;
4732 if (str[len - 1] == ')') {
4733 keyLen--;
4736 /* Create the objects with the variable name and key. */
4737 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4739 Jim_IncrRefCount(varObjPtr);
4740 Jim_IncrRefCount(keyObjPtr);
4741 *varPtrPtr = varObjPtr;
4742 *keyPtrPtr = keyObjPtr;
4745 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4746 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4747 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4749 int err;
4751 SetDictSubstFromAny(interp, objPtr);
4753 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4754 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4756 if (err == JIM_OK) {
4757 /* Don't keep an extra ref to the result */
4758 Jim_SetEmptyResult(interp);
4760 else {
4761 if (!valObjPtr) {
4762 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4763 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4764 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4765 objPtr);
4766 return err;
4769 /* Make the error more informative and Tcl-compatible */
4770 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4771 (valObjPtr ? "set" : "unset"), objPtr);
4773 return err;
4777 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4779 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4780 * and stored back to the variable before expansion.
4782 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4783 Jim_Obj *keyObjPtr, int flags)
4785 Jim_Obj *dictObjPtr;
4786 Jim_Obj *resObjPtr = NULL;
4787 int ret;
4789 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4790 if (!dictObjPtr) {
4791 return NULL;
4794 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4795 if (ret != JIM_OK) {
4796 Jim_SetResultFormatted(interp,
4797 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4798 ret < 0 ? "variable isn't" : "no such element in");
4800 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4801 /* Update the variable to have an unshared copy */
4802 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4805 return resObjPtr;
4808 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4809 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4811 SetDictSubstFromAny(interp, objPtr);
4813 return JimDictExpandArrayVariable(interp,
4814 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4815 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4818 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4820 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4822 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4823 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4826 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4828 JIM_NOTUSED(interp);
4830 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4831 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4832 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4833 dupPtr->typePtr = &dictSubstObjType;
4836 /* Note: The object *must* be in dict-sugar format */
4837 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4839 if (objPtr->typePtr != &dictSubstObjType) {
4840 Jim_Obj *varObjPtr, *keyObjPtr;
4842 if (objPtr->typePtr == &interpolatedObjType) {
4843 /* An interpolated object in dict-sugar form */
4845 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4846 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4848 Jim_IncrRefCount(varObjPtr);
4849 Jim_IncrRefCount(keyObjPtr);
4851 else {
4852 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4855 Jim_FreeIntRep(interp, objPtr);
4856 objPtr->typePtr = &dictSubstObjType;
4857 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4858 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4862 /* This function is used to expand [dict get] sugar in the form
4863 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4864 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4865 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4866 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4867 * the [dict]ionary contained in variable VARNAME. */
4868 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4870 Jim_Obj *resObjPtr = NULL;
4871 Jim_Obj *substKeyObjPtr = NULL;
4873 SetDictSubstFromAny(interp, objPtr);
4875 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4876 &substKeyObjPtr, JIM_NONE)
4877 != JIM_OK) {
4878 return NULL;
4880 Jim_IncrRefCount(substKeyObjPtr);
4881 resObjPtr =
4882 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4883 substKeyObjPtr, 0);
4884 Jim_DecrRefCount(interp, substKeyObjPtr);
4886 return resObjPtr;
4889 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4891 Jim_Obj *resultObjPtr;
4893 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4894 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4895 resultObjPtr->refCount--;
4896 return resultObjPtr;
4898 return NULL;
4901 /* -----------------------------------------------------------------------------
4902 * CallFrame
4903 * ---------------------------------------------------------------------------*/
4905 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4907 Jim_CallFrame *cf;
4909 if (interp->freeFramesList) {
4910 cf = interp->freeFramesList;
4911 interp->freeFramesList = cf->next;
4913 cf->argv = NULL;
4914 cf->argc = 0;
4915 cf->procArgsObjPtr = NULL;
4916 cf->procBodyObjPtr = NULL;
4917 cf->next = NULL;
4918 cf->staticVars = NULL;
4919 cf->localCommands = NULL;
4920 cf->tailcallObj = NULL;
4921 cf->tailcallCmd = NULL;
4923 else {
4924 cf = Jim_Alloc(sizeof(*cf));
4925 memset(cf, 0, sizeof(*cf));
4927 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4930 cf->id = interp->callFrameEpoch++;
4931 cf->parent = parent;
4932 cf->level = parent ? parent->level + 1 : 0;
4933 cf->nsObj = nsObj;
4934 Jim_IncrRefCount(nsObj);
4936 return cf;
4939 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4941 /* Delete any local procs */
4942 if (localCommands) {
4943 Jim_Obj *cmdNameObj;
4945 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4946 Jim_HashEntry *he;
4947 Jim_Obj *fqObjName;
4948 Jim_HashTable *ht = &interp->commands;
4950 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4952 he = Jim_FindHashEntry(ht, fqname);
4954 if (he) {
4955 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4956 if (cmd->prevCmd) {
4957 Jim_Cmd *prevCmd = cmd->prevCmd;
4958 cmd->prevCmd = NULL;
4960 /* Delete the old command */
4961 JimDecrCmdRefCount(interp, cmd);
4963 /* And restore the original */
4964 Jim_SetHashVal(ht, he, prevCmd);
4966 else {
4967 Jim_DeleteHashEntry(ht, fqname);
4968 Jim_InterpIncrProcEpoch(interp);
4971 Jim_DecrRefCount(interp, cmdNameObj);
4972 JimFreeQualifiedName(interp, fqObjName);
4974 Jim_FreeStack(localCommands);
4975 Jim_Free(localCommands);
4977 return JIM_OK;
4981 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4982 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4983 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4985 JimDeleteLocalProcs(interp, cf->localCommands);
4987 if (cf->procArgsObjPtr)
4988 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4989 if (cf->procBodyObjPtr)
4990 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4991 Jim_DecrRefCount(interp, cf->nsObj);
4992 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4993 Jim_FreeHashTable(&cf->vars);
4994 else {
4995 int i;
4996 Jim_HashEntry **table = cf->vars.table, *he;
4998 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4999 he = table[i];
5000 while (he != NULL) {
5001 Jim_HashEntry *nextEntry = he->next;
5002 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5004 Jim_DecrRefCount(interp, varPtr->objPtr);
5005 Jim_Free(Jim_GetHashEntryKey(he));
5006 Jim_Free(varPtr);
5007 Jim_Free(he);
5008 table[i] = NULL;
5009 he = nextEntry;
5012 cf->vars.used = 0;
5014 cf->next = interp->freeFramesList;
5015 interp->freeFramesList = cf;
5019 /* -----------------------------------------------------------------------------
5020 * References
5021 * ---------------------------------------------------------------------------*/
5022 #ifdef JIM_REFERENCES
5024 /* References HashTable Type.
5026 * Keys are unsigned long integers, dynamically allocated for now but in the
5027 * future it's worth to cache this 4 bytes objects. Values are pointers
5028 * to Jim_References. */
5029 static void JimReferencesHTValDestructor(void *interp, void *val)
5031 Jim_Reference *refPtr = (void *)val;
5033 Jim_DecrRefCount(interp, refPtr->objPtr);
5034 if (refPtr->finalizerCmdNamePtr != NULL) {
5035 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5037 Jim_Free(val);
5040 static unsigned int JimReferencesHTHashFunction(const void *key)
5042 /* Only the least significant bits are used. */
5043 const unsigned long *widePtr = key;
5044 unsigned int intValue = (unsigned int)*widePtr;
5046 return Jim_IntHashFunction(intValue);
5049 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5051 void *copy = Jim_Alloc(sizeof(unsigned long));
5053 JIM_NOTUSED(privdata);
5055 memcpy(copy, key, sizeof(unsigned long));
5056 return copy;
5059 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5061 JIM_NOTUSED(privdata);
5063 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5066 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5068 JIM_NOTUSED(privdata);
5070 Jim_Free(key);
5073 static const Jim_HashTableType JimReferencesHashTableType = {
5074 JimReferencesHTHashFunction, /* hash function */
5075 JimReferencesHTKeyDup, /* key dup */
5076 NULL, /* val dup */
5077 JimReferencesHTKeyCompare, /* key compare */
5078 JimReferencesHTKeyDestructor, /* key destructor */
5079 JimReferencesHTValDestructor /* val destructor */
5082 /* -----------------------------------------------------------------------------
5083 * Reference object type and References API
5084 * ---------------------------------------------------------------------------*/
5086 /* The string representation of references has two features in order
5087 * to make the GC faster. The first is that every reference starts
5088 * with a non common character '<', in order to make the string matching
5089 * faster. The second is that the reference string rep is 42 characters
5090 * in length, this means that it is not necessary to check any object with a string
5091 * repr < 42, and usually there aren't many of these objects. */
5093 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5095 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5097 const char *fmt = "<reference.<%s>.%020lu>";
5099 sprintf(buf, fmt, refPtr->tag, id);
5100 return JIM_REFERENCE_SPACE;
5103 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5105 static const Jim_ObjType referenceObjType = {
5106 "reference",
5107 NULL,
5108 NULL,
5109 UpdateStringOfReference,
5110 JIM_TYPE_REFERENCES,
5113 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5115 char buf[JIM_REFERENCE_SPACE + 1];
5117 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5118 JimSetStringBytes(objPtr, buf);
5121 /* returns true if 'c' is a valid reference tag character.
5122 * i.e. inside the range [_a-zA-Z0-9] */
5123 static int isrefchar(int c)
5125 return (c == '_' || isalnum(c));
5128 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5130 unsigned long value;
5131 int i, len;
5132 const char *str, *start, *end;
5133 char refId[21];
5134 Jim_Reference *refPtr;
5135 Jim_HashEntry *he;
5136 char *endptr;
5138 /* Get the string representation */
5139 str = Jim_GetString(objPtr, &len);
5140 /* Check if it looks like a reference */
5141 if (len < JIM_REFERENCE_SPACE)
5142 goto badformat;
5143 /* Trim spaces */
5144 start = str;
5145 end = str + len - 1;
5146 while (*start == ' ')
5147 start++;
5148 while (*end == ' ' && end > start)
5149 end--;
5150 if (end - start + 1 != JIM_REFERENCE_SPACE)
5151 goto badformat;
5152 /* <reference.<1234567>.%020> */
5153 if (memcmp(start, "<reference.<", 12) != 0)
5154 goto badformat;
5155 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5156 goto badformat;
5157 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5158 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5159 if (!isrefchar(start[12 + i]))
5160 goto badformat;
5162 /* Extract info from the reference. */
5163 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5164 refId[20] = '\0';
5165 /* Try to convert the ID into an unsigned long */
5166 value = strtoul(refId, &endptr, 10);
5167 if (JimCheckConversion(refId, endptr) != JIM_OK)
5168 goto badformat;
5169 /* Check if the reference really exists! */
5170 he = Jim_FindHashEntry(&interp->references, &value);
5171 if (he == NULL) {
5172 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5173 return JIM_ERR;
5175 refPtr = Jim_GetHashEntryVal(he);
5176 /* Free the old internal repr and set the new one. */
5177 Jim_FreeIntRep(interp, objPtr);
5178 objPtr->typePtr = &referenceObjType;
5179 objPtr->internalRep.refValue.id = value;
5180 objPtr->internalRep.refValue.refPtr = refPtr;
5181 return JIM_OK;
5183 badformat:
5184 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5185 return JIM_ERR;
5188 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5189 * as finalizer command (or NULL if there is no finalizer).
5190 * The returned reference object has refcount = 0. */
5191 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5193 struct Jim_Reference *refPtr;
5194 unsigned long id;
5195 Jim_Obj *refObjPtr;
5196 const char *tag;
5197 int tagLen, i;
5199 /* Perform the Garbage Collection if needed. */
5200 Jim_CollectIfNeeded(interp);
5202 refPtr = Jim_Alloc(sizeof(*refPtr));
5203 refPtr->objPtr = objPtr;
5204 Jim_IncrRefCount(objPtr);
5205 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5206 if (cmdNamePtr)
5207 Jim_IncrRefCount(cmdNamePtr);
5208 id = interp->referenceNextId++;
5209 Jim_AddHashEntry(&interp->references, &id, refPtr);
5210 refObjPtr = Jim_NewObj(interp);
5211 refObjPtr->typePtr = &referenceObjType;
5212 refObjPtr->bytes = NULL;
5213 refObjPtr->internalRep.refValue.id = id;
5214 refObjPtr->internalRep.refValue.refPtr = refPtr;
5215 interp->referenceNextId++;
5216 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5217 * that does not pass the 'isrefchar' test is replaced with '_' */
5218 tag = Jim_GetString(tagPtr, &tagLen);
5219 if (tagLen > JIM_REFERENCE_TAGLEN)
5220 tagLen = JIM_REFERENCE_TAGLEN;
5221 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5222 if (i < tagLen && isrefchar(tag[i]))
5223 refPtr->tag[i] = tag[i];
5224 else
5225 refPtr->tag[i] = '_';
5227 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5228 return refObjPtr;
5231 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5233 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5234 return NULL;
5235 return objPtr->internalRep.refValue.refPtr;
5238 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5240 Jim_Reference *refPtr;
5242 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5243 return JIM_ERR;
5244 Jim_IncrRefCount(cmdNamePtr);
5245 if (refPtr->finalizerCmdNamePtr)
5246 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5247 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5248 return JIM_OK;
5251 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5253 Jim_Reference *refPtr;
5255 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5256 return JIM_ERR;
5257 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5258 return JIM_OK;
5261 /* -----------------------------------------------------------------------------
5262 * References Garbage Collection
5263 * ---------------------------------------------------------------------------*/
5265 /* This the hash table type for the "MARK" phase of the GC */
5266 static const Jim_HashTableType JimRefMarkHashTableType = {
5267 JimReferencesHTHashFunction, /* hash function */
5268 JimReferencesHTKeyDup, /* key dup */
5269 NULL, /* val dup */
5270 JimReferencesHTKeyCompare, /* key compare */
5271 JimReferencesHTKeyDestructor, /* key destructor */
5272 NULL /* val destructor */
5275 /* Performs the garbage collection. */
5276 int Jim_Collect(Jim_Interp *interp)
5278 int collected = 0;
5279 #ifndef JIM_BOOTSTRAP
5280 Jim_HashTable marks;
5281 Jim_HashTableIterator htiter;
5282 Jim_HashEntry *he;
5283 Jim_Obj *objPtr;
5285 /* Avoid recursive calls */
5286 if (interp->lastCollectId == -1) {
5287 /* Jim_Collect() already running. Return just now. */
5288 return 0;
5290 interp->lastCollectId = -1;
5292 /* Mark all the references found into the 'mark' hash table.
5293 * The references are searched in every live object that
5294 * is of a type that can contain references. */
5295 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5296 objPtr = interp->liveList;
5297 while (objPtr) {
5298 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5299 const char *str, *p;
5300 int len;
5302 /* If the object is of type reference, to get the
5303 * Id is simple... */
5304 if (objPtr->typePtr == &referenceObjType) {
5305 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5306 #ifdef JIM_DEBUG_GC
5307 printf("MARK (reference): %d refcount: %d\n",
5308 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5309 #endif
5310 objPtr = objPtr->nextObjPtr;
5311 continue;
5313 /* Get the string repr of the object we want
5314 * to scan for references. */
5315 p = str = Jim_GetString(objPtr, &len);
5316 /* Skip objects too little to contain references. */
5317 if (len < JIM_REFERENCE_SPACE) {
5318 objPtr = objPtr->nextObjPtr;
5319 continue;
5321 /* Extract references from the object string repr. */
5322 while (1) {
5323 int i;
5324 unsigned long id;
5326 if ((p = strstr(p, "<reference.<")) == NULL)
5327 break;
5328 /* Check if it's a valid reference. */
5329 if (len - (p - str) < JIM_REFERENCE_SPACE)
5330 break;
5331 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5332 break;
5333 for (i = 21; i <= 40; i++)
5334 if (!isdigit(UCHAR(p[i])))
5335 break;
5336 /* Get the ID */
5337 id = strtoul(p + 21, NULL, 10);
5339 /* Ok, a reference for the given ID
5340 * was found. Mark it. */
5341 Jim_AddHashEntry(&marks, &id, NULL);
5342 #ifdef JIM_DEBUG_GC
5343 printf("MARK: %d\n", (int)id);
5344 #endif
5345 p += JIM_REFERENCE_SPACE;
5348 objPtr = objPtr->nextObjPtr;
5351 /* Run the references hash table to destroy every reference that
5352 * is not referenced outside (not present in the mark HT). */
5353 JimInitHashTableIterator(&interp->references, &htiter);
5354 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5355 const unsigned long *refId;
5356 Jim_Reference *refPtr;
5358 refId = he->key;
5359 /* Check if in the mark phase we encountered
5360 * this reference. */
5361 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5362 #ifdef JIM_DEBUG_GC
5363 printf("COLLECTING %d\n", (int)*refId);
5364 #endif
5365 collected++;
5366 /* Drop the reference, but call the
5367 * finalizer first if registered. */
5368 refPtr = Jim_GetHashEntryVal(he);
5369 if (refPtr->finalizerCmdNamePtr) {
5370 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5371 Jim_Obj *objv[3], *oldResult;
5373 JimFormatReference(refstr, refPtr, *refId);
5375 objv[0] = refPtr->finalizerCmdNamePtr;
5376 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5377 objv[2] = refPtr->objPtr;
5379 /* Drop the reference itself */
5380 /* Avoid the finaliser being freed here */
5381 Jim_IncrRefCount(objv[0]);
5382 /* Don't remove the reference from the hash table just yet
5383 * since that will free refPtr, and hence refPtr->objPtr
5386 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5387 oldResult = interp->result;
5388 Jim_IncrRefCount(oldResult);
5389 Jim_EvalObjVector(interp, 3, objv);
5390 Jim_SetResult(interp, oldResult);
5391 Jim_DecrRefCount(interp, oldResult);
5393 Jim_DecrRefCount(interp, objv[0]);
5395 Jim_DeleteHashEntry(&interp->references, refId);
5398 Jim_FreeHashTable(&marks);
5399 interp->lastCollectId = interp->referenceNextId;
5400 interp->lastCollectTime = time(NULL);
5401 #endif /* JIM_BOOTSTRAP */
5402 return collected;
5405 #define JIM_COLLECT_ID_PERIOD 5000
5406 #define JIM_COLLECT_TIME_PERIOD 300
5408 void Jim_CollectIfNeeded(Jim_Interp *interp)
5410 unsigned long elapsedId;
5411 int elapsedTime;
5413 elapsedId = interp->referenceNextId - interp->lastCollectId;
5414 elapsedTime = time(NULL) - interp->lastCollectTime;
5417 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5418 Jim_Collect(interp);
5421 #endif
5423 int Jim_IsBigEndian(void)
5425 union {
5426 unsigned short s;
5427 unsigned char c[2];
5428 } uval = {0x0102};
5430 return uval.c[0] == 1;
5433 /* -----------------------------------------------------------------------------
5434 * Interpreter related functions
5435 * ---------------------------------------------------------------------------*/
5437 Jim_Interp *Jim_CreateInterp(void)
5439 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5441 memset(i, 0, sizeof(*i));
5443 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5444 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5445 i->lastCollectTime = time(NULL);
5447 /* Note that we can create objects only after the
5448 * interpreter liveList and freeList pointers are
5449 * initialized to NULL. */
5450 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5451 #ifdef JIM_REFERENCES
5452 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5453 #endif
5454 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5455 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5456 i->emptyObj = Jim_NewEmptyStringObj(i);
5457 i->trueObj = Jim_NewIntObj(i, 1);
5458 i->falseObj = Jim_NewIntObj(i, 0);
5459 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5460 i->errorFileNameObj = i->emptyObj;
5461 i->result = i->emptyObj;
5462 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5463 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5464 i->errorProc = i->emptyObj;
5465 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5466 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5467 Jim_IncrRefCount(i->emptyObj);
5468 Jim_IncrRefCount(i->errorFileNameObj);
5469 Jim_IncrRefCount(i->result);
5470 Jim_IncrRefCount(i->stackTrace);
5471 Jim_IncrRefCount(i->unknown);
5472 Jim_IncrRefCount(i->currentScriptObj);
5473 Jim_IncrRefCount(i->nullScriptObj);
5474 Jim_IncrRefCount(i->errorProc);
5475 Jim_IncrRefCount(i->trueObj);
5476 Jim_IncrRefCount(i->falseObj);
5478 /* Initialize key variables every interpreter should contain */
5479 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5480 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5482 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5483 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5484 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5485 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5486 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5487 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5488 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5489 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5491 return i;
5494 void Jim_FreeInterp(Jim_Interp *i)
5496 Jim_CallFrame *cf, *cfx;
5498 Jim_Obj *objPtr, *nextObjPtr;
5500 /* Free the active call frames list - must be done before i->commands is destroyed */
5501 for (cf = i->framePtr; cf; cf = cfx) {
5502 cfx = cf->parent;
5503 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5506 Jim_DecrRefCount(i, i->emptyObj);
5507 Jim_DecrRefCount(i, i->trueObj);
5508 Jim_DecrRefCount(i, i->falseObj);
5509 Jim_DecrRefCount(i, i->result);
5510 Jim_DecrRefCount(i, i->stackTrace);
5511 Jim_DecrRefCount(i, i->errorProc);
5512 Jim_DecrRefCount(i, i->unknown);
5513 Jim_DecrRefCount(i, i->errorFileNameObj);
5514 Jim_DecrRefCount(i, i->currentScriptObj);
5515 Jim_DecrRefCount(i, i->nullScriptObj);
5516 Jim_FreeHashTable(&i->commands);
5517 #ifdef JIM_REFERENCES
5518 Jim_FreeHashTable(&i->references);
5519 #endif
5520 Jim_FreeHashTable(&i->packages);
5521 Jim_Free(i->prngState);
5522 Jim_FreeHashTable(&i->assocData);
5524 /* Check that the live object list is empty, otherwise
5525 * there is a memory leak. */
5526 #ifdef JIM_MAINTAINER
5527 if (i->liveList != NULL) {
5528 objPtr = i->liveList;
5530 printf("\n-------------------------------------\n");
5531 printf("Objects still in the free list:\n");
5532 while (objPtr) {
5533 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5535 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5536 printf("%p (%d) %-10s: '%.20s...'\n",
5537 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5539 else {
5540 printf("%p (%d) %-10s: '%s'\n",
5541 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5543 if (objPtr->typePtr == &sourceObjType) {
5544 printf("FILE %s LINE %d\n",
5545 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5546 objPtr->internalRep.sourceValue.lineNumber);
5548 objPtr = objPtr->nextObjPtr;
5550 printf("-------------------------------------\n\n");
5551 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5553 #endif
5555 /* Free all the freed objects. */
5556 objPtr = i->freeList;
5557 while (objPtr) {
5558 nextObjPtr = objPtr->nextObjPtr;
5559 Jim_Free(objPtr);
5560 objPtr = nextObjPtr;
5563 /* Free the free call frames list */
5564 for (cf = i->freeFramesList; cf; cf = cfx) {
5565 cfx = cf->next;
5566 if (cf->vars.table)
5567 Jim_FreeHashTable(&cf->vars);
5568 Jim_Free(cf);
5571 /* Free the interpreter structure. */
5572 Jim_Free(i);
5575 /* Returns the call frame relative to the level represented by
5576 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5578 * This function accepts the 'level' argument in the form
5579 * of the commands [uplevel] and [upvar].
5581 * Returns NULL on error.
5583 * Note: for a function accepting a relative integer as level suitable
5584 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5586 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5588 long level;
5589 const char *str;
5590 Jim_CallFrame *framePtr;
5592 if (levelObjPtr) {
5593 str = Jim_String(levelObjPtr);
5594 if (str[0] == '#') {
5595 char *endptr;
5597 level = jim_strtol(str + 1, &endptr);
5598 if (str[1] == '\0' || endptr[0] != '\0') {
5599 level = -1;
5602 else {
5603 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5604 level = -1;
5606 else {
5607 /* Convert from a relative to an absolute level */
5608 level = interp->framePtr->level - level;
5612 else {
5613 str = "1"; /* Needed to format the error message. */
5614 level = interp->framePtr->level - 1;
5617 if (level == 0) {
5618 return interp->topFramePtr;
5620 if (level > 0) {
5621 /* Lookup */
5622 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5623 if (framePtr->level == level) {
5624 return framePtr;
5629 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5630 return NULL;
5633 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5634 * as a relative integer like in the [info level ?level?] command.
5636 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5638 long level;
5639 Jim_CallFrame *framePtr;
5641 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5642 if (level <= 0) {
5643 /* Convert from a relative to an absolute level */
5644 level = interp->framePtr->level + level;
5647 if (level == 0) {
5648 return interp->topFramePtr;
5651 /* Lookup */
5652 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5653 if (framePtr->level == level) {
5654 return framePtr;
5659 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5660 return NULL;
5663 static void JimResetStackTrace(Jim_Interp *interp)
5665 Jim_DecrRefCount(interp, interp->stackTrace);
5666 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5667 Jim_IncrRefCount(interp->stackTrace);
5670 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5672 int len;
5674 /* Increment reference first in case these are the same object */
5675 Jim_IncrRefCount(stackTraceObj);
5676 Jim_DecrRefCount(interp, interp->stackTrace);
5677 interp->stackTrace = stackTraceObj;
5678 interp->errorFlag = 1;
5680 /* This is a bit ugly.
5681 * If the filename of the last entry of the stack trace is empty,
5682 * the next stack level should be added.
5684 len = Jim_ListLength(interp, interp->stackTrace);
5685 if (len >= 3) {
5686 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5687 interp->addStackTrace = 1;
5692 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5693 Jim_Obj *fileNameObj, int linenr)
5695 if (strcmp(procname, "unknown") == 0) {
5696 procname = "";
5698 if (!*procname && !Jim_Length(fileNameObj)) {
5699 /* No useful info here */
5700 return;
5703 if (Jim_IsShared(interp->stackTrace)) {
5704 Jim_DecrRefCount(interp, interp->stackTrace);
5705 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5706 Jim_IncrRefCount(interp->stackTrace);
5709 /* If we have no procname but the previous element did, merge with that frame */
5710 if (!*procname && Jim_Length(fileNameObj)) {
5711 /* Just a filename. Check the previous entry */
5712 int len = Jim_ListLength(interp, interp->stackTrace);
5714 if (len >= 3) {
5715 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5716 if (Jim_Length(objPtr)) {
5717 /* Yes, the previous level had procname */
5718 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5719 if (Jim_Length(objPtr) == 0) {
5720 /* But no filename, so merge the new info with that frame */
5721 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5722 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5723 return;
5729 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5730 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5731 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5734 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5735 void *data)
5737 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5739 assocEntryPtr->delProc = delProc;
5740 assocEntryPtr->data = data;
5741 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5744 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5746 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5748 if (entryPtr != NULL) {
5749 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5750 return assocEntryPtr->data;
5752 return NULL;
5755 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5757 return Jim_DeleteHashEntry(&interp->assocData, key);
5760 int Jim_GetExitCode(Jim_Interp *interp)
5762 return interp->exitCode;
5765 /* -----------------------------------------------------------------------------
5766 * Integer object
5767 * ---------------------------------------------------------------------------*/
5768 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5769 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5771 static const Jim_ObjType intObjType = {
5772 "int",
5773 NULL,
5774 NULL,
5775 UpdateStringOfInt,
5776 JIM_TYPE_NONE,
5779 /* A coerced double is closer to an int than a double.
5780 * It is an int value temporarily masquerading as a double value.
5781 * i.e. it has the same string value as an int and Jim_GetWide()
5782 * succeeds, but also Jim_GetDouble() returns the value directly.
5784 static const Jim_ObjType coercedDoubleObjType = {
5785 "coerced-double",
5786 NULL,
5787 NULL,
5788 UpdateStringOfInt,
5789 JIM_TYPE_NONE,
5793 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5795 char buf[JIM_INTEGER_SPACE + 1];
5796 jim_wide wideValue = JimWideValue(objPtr);
5797 int pos = 0;
5799 if (wideValue == 0) {
5800 buf[pos++] = '0';
5802 else {
5803 char tmp[JIM_INTEGER_SPACE];
5804 int num = 0;
5805 int i;
5807 if (wideValue < 0) {
5808 buf[pos++] = '-';
5809 i = wideValue % 10;
5810 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5811 * whereas C99 is always -6
5812 * coverity[dead_error_line]
5814 tmp[num++] = (i > 0) ? (10 - i) : -i;
5815 wideValue /= -10;
5818 while (wideValue) {
5819 tmp[num++] = wideValue % 10;
5820 wideValue /= 10;
5823 for (i = 0; i < num; i++) {
5824 buf[pos++] = '0' + tmp[num - i - 1];
5827 buf[pos] = 0;
5829 JimSetStringBytes(objPtr, buf);
5832 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5834 jim_wide wideValue;
5835 const char *str;
5837 if (objPtr->typePtr == &coercedDoubleObjType) {
5838 /* Simple switch */
5839 objPtr->typePtr = &intObjType;
5840 return JIM_OK;
5843 /* Get the string representation */
5844 str = Jim_String(objPtr);
5845 /* Try to convert into a jim_wide */
5846 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5847 if (flags & JIM_ERRMSG) {
5848 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5850 return JIM_ERR;
5852 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5853 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5854 return JIM_ERR;
5856 /* Free the old internal repr and set the new one. */
5857 Jim_FreeIntRep(interp, objPtr);
5858 objPtr->typePtr = &intObjType;
5859 objPtr->internalRep.wideValue = wideValue;
5860 return JIM_OK;
5863 #ifdef JIM_OPTIMIZATION
5864 static int JimIsWide(Jim_Obj *objPtr)
5866 return objPtr->typePtr == &intObjType;
5868 #endif
5870 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5872 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5873 return JIM_ERR;
5874 *widePtr = JimWideValue(objPtr);
5875 return JIM_OK;
5878 /* Get a wide but does not set an error if the format is bad. */
5879 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5881 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5882 return JIM_ERR;
5883 *widePtr = JimWideValue(objPtr);
5884 return JIM_OK;
5887 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5889 jim_wide wideValue;
5890 int retval;
5892 retval = Jim_GetWide(interp, objPtr, &wideValue);
5893 if (retval == JIM_OK) {
5894 *longPtr = (long)wideValue;
5895 return JIM_OK;
5897 return JIM_ERR;
5900 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5902 Jim_Obj *objPtr;
5904 objPtr = Jim_NewObj(interp);
5905 objPtr->typePtr = &intObjType;
5906 objPtr->bytes = NULL;
5907 objPtr->internalRep.wideValue = wideValue;
5908 return objPtr;
5911 /* -----------------------------------------------------------------------------
5912 * Double object
5913 * ---------------------------------------------------------------------------*/
5914 #define JIM_DOUBLE_SPACE 30
5916 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5917 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5919 static const Jim_ObjType doubleObjType = {
5920 "double",
5921 NULL,
5922 NULL,
5923 UpdateStringOfDouble,
5924 JIM_TYPE_NONE,
5927 #ifndef HAVE_ISNAN
5928 #undef isnan
5929 #define isnan(X) ((X) != (X))
5930 #endif
5931 #ifndef HAVE_ISINF
5932 #undef isinf
5933 #define isinf(X) (1.0 / (X) == 0.0)
5934 #endif
5936 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5938 double value = objPtr->internalRep.doubleValue;
5940 if (isnan(value)) {
5941 JimSetStringBytes(objPtr, "NaN");
5942 return;
5944 if (isinf(value)) {
5945 if (value < 0) {
5946 JimSetStringBytes(objPtr, "-Inf");
5948 else {
5949 JimSetStringBytes(objPtr, "Inf");
5951 return;
5954 char buf[JIM_DOUBLE_SPACE + 1];
5955 int i;
5956 int len = sprintf(buf, "%.12g", value);
5958 /* Add a final ".0" if necessary */
5959 for (i = 0; i < len; i++) {
5960 if (buf[i] == '.' || buf[i] == 'e') {
5961 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5962 /* If 'buf' ends in e-0nn or e+0nn, remove
5963 * the 0 after the + or - and reduce the length by 1
5965 char *e = strchr(buf, 'e');
5966 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5967 /* Move it up */
5968 e += 2;
5969 memmove(e, e + 1, len - (e - buf));
5971 #endif
5972 break;
5975 if (buf[i] == '\0') {
5976 buf[i++] = '.';
5977 buf[i++] = '0';
5978 buf[i] = '\0';
5980 JimSetStringBytes(objPtr, buf);
5984 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5986 double doubleValue;
5987 jim_wide wideValue;
5988 const char *str;
5990 /* Preserve the string representation.
5991 * Needed so we can convert back to int without loss
5993 str = Jim_String(objPtr);
5995 #ifdef HAVE_LONG_LONG
5996 /* Assume a 53 bit mantissa */
5997 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5998 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6000 if (objPtr->typePtr == &intObjType
6001 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6002 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6004 /* Direct conversion to coerced double */
6005 objPtr->typePtr = &coercedDoubleObjType;
6006 return JIM_OK;
6008 else
6009 #endif
6010 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6011 /* Managed to convert to an int, so we can use this as a cooerced double */
6012 Jim_FreeIntRep(interp, objPtr);
6013 objPtr->typePtr = &coercedDoubleObjType;
6014 objPtr->internalRep.wideValue = wideValue;
6015 return JIM_OK;
6017 else {
6018 /* Try to convert into a double */
6019 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6020 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6021 return JIM_ERR;
6023 /* Free the old internal repr and set the new one. */
6024 Jim_FreeIntRep(interp, objPtr);
6026 objPtr->typePtr = &doubleObjType;
6027 objPtr->internalRep.doubleValue = doubleValue;
6028 return JIM_OK;
6031 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6033 if (objPtr->typePtr == &coercedDoubleObjType) {
6034 *doublePtr = JimWideValue(objPtr);
6035 return JIM_OK;
6037 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6038 return JIM_ERR;
6040 if (objPtr->typePtr == &coercedDoubleObjType) {
6041 *doublePtr = JimWideValue(objPtr);
6043 else {
6044 *doublePtr = objPtr->internalRep.doubleValue;
6046 return JIM_OK;
6049 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6051 Jim_Obj *objPtr;
6053 objPtr = Jim_NewObj(interp);
6054 objPtr->typePtr = &doubleObjType;
6055 objPtr->bytes = NULL;
6056 objPtr->internalRep.doubleValue = doubleValue;
6057 return objPtr;
6060 /* -----------------------------------------------------------------------------
6061 * List object
6062 * ---------------------------------------------------------------------------*/
6063 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6064 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6065 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6066 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6067 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6068 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6070 /* Note that while the elements of the list may contain references,
6071 * the list object itself can't. This basically means that the
6072 * list object string representation as a whole can't contain references
6073 * that are not presents in the single elements. */
6074 static const Jim_ObjType listObjType = {
6075 "list",
6076 FreeListInternalRep,
6077 DupListInternalRep,
6078 UpdateStringOfList,
6079 JIM_TYPE_NONE,
6082 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6084 int i;
6086 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6087 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6089 Jim_Free(objPtr->internalRep.listValue.ele);
6092 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6094 int i;
6096 JIM_NOTUSED(interp);
6098 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6099 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6100 dupPtr->internalRep.listValue.ele =
6101 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6102 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6103 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6104 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6105 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6107 dupPtr->typePtr = &listObjType;
6110 /* The following function checks if a given string can be encoded
6111 * into a list element without any kind of quoting, surrounded by braces,
6112 * or using escapes to quote. */
6113 #define JIM_ELESTR_SIMPLE 0
6114 #define JIM_ELESTR_BRACE 1
6115 #define JIM_ELESTR_QUOTE 2
6116 static unsigned char ListElementQuotingType(const char *s, int len)
6118 int i, level, blevel, trySimple = 1;
6120 /* Try with the SIMPLE case */
6121 if (len == 0)
6122 return JIM_ELESTR_BRACE;
6123 if (s[0] == '"' || s[0] == '{') {
6124 trySimple = 0;
6125 goto testbrace;
6127 for (i = 0; i < len; i++) {
6128 switch (s[i]) {
6129 case ' ':
6130 case '$':
6131 case '"':
6132 case '[':
6133 case ']':
6134 case ';':
6135 case '\\':
6136 case '\r':
6137 case '\n':
6138 case '\t':
6139 case '\f':
6140 case '\v':
6141 trySimple = 0;
6142 /* fall through */
6143 case '{':
6144 case '}':
6145 goto testbrace;
6148 return JIM_ELESTR_SIMPLE;
6150 testbrace:
6151 /* Test if it's possible to do with braces */
6152 if (s[len - 1] == '\\')
6153 return JIM_ELESTR_QUOTE;
6154 level = 0;
6155 blevel = 0;
6156 for (i = 0; i < len; i++) {
6157 switch (s[i]) {
6158 case '{':
6159 level++;
6160 break;
6161 case '}':
6162 level--;
6163 if (level < 0)
6164 return JIM_ELESTR_QUOTE;
6165 break;
6166 case '[':
6167 blevel++;
6168 break;
6169 case ']':
6170 blevel--;
6171 break;
6172 case '\\':
6173 if (s[i + 1] == '\n')
6174 return JIM_ELESTR_QUOTE;
6175 else if (s[i + 1] != '\0')
6176 i++;
6177 break;
6180 if (blevel < 0) {
6181 return JIM_ELESTR_QUOTE;
6184 if (level == 0) {
6185 if (!trySimple)
6186 return JIM_ELESTR_BRACE;
6187 for (i = 0; i < len; i++) {
6188 switch (s[i]) {
6189 case ' ':
6190 case '$':
6191 case '"':
6192 case '[':
6193 case ']':
6194 case ';':
6195 case '\\':
6196 case '\r':
6197 case '\n':
6198 case '\t':
6199 case '\f':
6200 case '\v':
6201 return JIM_ELESTR_BRACE;
6202 break;
6205 return JIM_ELESTR_SIMPLE;
6207 return JIM_ELESTR_QUOTE;
6210 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6211 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6212 * scenario.
6213 * Returns the length of the result.
6215 static int BackslashQuoteString(const char *s, int len, char *q)
6217 char *p = q;
6219 while (len--) {
6220 switch (*s) {
6221 case ' ':
6222 case '$':
6223 case '"':
6224 case '[':
6225 case ']':
6226 case '{':
6227 case '}':
6228 case ';':
6229 case '\\':
6230 *p++ = '\\';
6231 *p++ = *s++;
6232 break;
6233 case '\n':
6234 *p++ = '\\';
6235 *p++ = 'n';
6236 s++;
6237 break;
6238 case '\r':
6239 *p++ = '\\';
6240 *p++ = 'r';
6241 s++;
6242 break;
6243 case '\t':
6244 *p++ = '\\';
6245 *p++ = 't';
6246 s++;
6247 break;
6248 case '\f':
6249 *p++ = '\\';
6250 *p++ = 'f';
6251 s++;
6252 break;
6253 case '\v':
6254 *p++ = '\\';
6255 *p++ = 'v';
6256 s++;
6257 break;
6258 default:
6259 *p++ = *s++;
6260 break;
6263 *p = '\0';
6265 return p - q;
6268 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6270 #define STATIC_QUOTING_LEN 32
6271 int i, bufLen, realLength;
6272 const char *strRep;
6273 char *p;
6274 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6276 /* Estimate the space needed. */
6277 if (objc > STATIC_QUOTING_LEN) {
6278 quotingType = Jim_Alloc(objc);
6280 else {
6281 quotingType = staticQuoting;
6283 bufLen = 0;
6284 for (i = 0; i < objc; i++) {
6285 int len;
6287 strRep = Jim_GetString(objv[i], &len);
6288 quotingType[i] = ListElementQuotingType(strRep, len);
6289 switch (quotingType[i]) {
6290 case JIM_ELESTR_SIMPLE:
6291 if (i != 0 || strRep[0] != '#') {
6292 bufLen += len;
6293 break;
6295 /* Special case '#' on first element needs braces */
6296 quotingType[i] = JIM_ELESTR_BRACE;
6297 /* fall through */
6298 case JIM_ELESTR_BRACE:
6299 bufLen += len + 2;
6300 break;
6301 case JIM_ELESTR_QUOTE:
6302 bufLen += len * 2;
6303 break;
6305 bufLen++; /* elements separator. */
6307 bufLen++;
6309 /* Generate the string rep. */
6310 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6311 realLength = 0;
6312 for (i = 0; i < objc; i++) {
6313 int len, qlen;
6315 strRep = Jim_GetString(objv[i], &len);
6317 switch (quotingType[i]) {
6318 case JIM_ELESTR_SIMPLE:
6319 memcpy(p, strRep, len);
6320 p += len;
6321 realLength += len;
6322 break;
6323 case JIM_ELESTR_BRACE:
6324 *p++ = '{';
6325 memcpy(p, strRep, len);
6326 p += len;
6327 *p++ = '}';
6328 realLength += len + 2;
6329 break;
6330 case JIM_ELESTR_QUOTE:
6331 if (i == 0 && strRep[0] == '#') {
6332 *p++ = '\\';
6333 realLength++;
6335 qlen = BackslashQuoteString(strRep, len, p);
6336 p += qlen;
6337 realLength += qlen;
6338 break;
6340 /* Add a separating space */
6341 if (i + 1 != objc) {
6342 *p++ = ' ';
6343 realLength++;
6346 *p = '\0'; /* nul term. */
6347 objPtr->length = realLength;
6349 if (quotingType != staticQuoting) {
6350 Jim_Free(quotingType);
6354 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6356 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6359 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6361 struct JimParserCtx parser;
6362 const char *str;
6363 int strLen;
6364 Jim_Obj *fileNameObj;
6365 int linenr;
6367 if (objPtr->typePtr == &listObjType) {
6368 return JIM_OK;
6371 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6372 * it also preserves any source location of the dict elements
6373 * which can be very useful
6375 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6376 Jim_Obj **listObjPtrPtr;
6377 int len;
6378 int i;
6380 listObjPtrPtr = JimDictPairs(objPtr, &len);
6381 for (i = 0; i < len; i++) {
6382 Jim_IncrRefCount(listObjPtrPtr[i]);
6385 /* Now just switch the internal rep */
6386 Jim_FreeIntRep(interp, objPtr);
6387 objPtr->typePtr = &listObjType;
6388 objPtr->internalRep.listValue.len = len;
6389 objPtr->internalRep.listValue.maxLen = len;
6390 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6392 return JIM_OK;
6395 /* Try to preserve information about filename / line number */
6396 if (objPtr->typePtr == &sourceObjType) {
6397 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6398 linenr = objPtr->internalRep.sourceValue.lineNumber;
6400 else {
6401 fileNameObj = interp->emptyObj;
6402 linenr = 1;
6404 Jim_IncrRefCount(fileNameObj);
6406 /* Get the string representation */
6407 str = Jim_GetString(objPtr, &strLen);
6409 /* Free the old internal repr just now and initialize the
6410 * new one just now. The string->list conversion can't fail. */
6411 Jim_FreeIntRep(interp, objPtr);
6412 objPtr->typePtr = &listObjType;
6413 objPtr->internalRep.listValue.len = 0;
6414 objPtr->internalRep.listValue.maxLen = 0;
6415 objPtr->internalRep.listValue.ele = NULL;
6417 /* Convert into a list */
6418 if (strLen) {
6419 JimParserInit(&parser, str, strLen, linenr);
6420 while (!parser.eof) {
6421 Jim_Obj *elementPtr;
6423 JimParseList(&parser);
6424 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6425 continue;
6426 elementPtr = JimParserGetTokenObj(interp, &parser);
6427 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6428 ListAppendElement(objPtr, elementPtr);
6431 Jim_DecrRefCount(interp, fileNameObj);
6432 return JIM_OK;
6435 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6437 Jim_Obj *objPtr;
6439 objPtr = Jim_NewObj(interp);
6440 objPtr->typePtr = &listObjType;
6441 objPtr->bytes = NULL;
6442 objPtr->internalRep.listValue.ele = NULL;
6443 objPtr->internalRep.listValue.len = 0;
6444 objPtr->internalRep.listValue.maxLen = 0;
6446 if (len) {
6447 ListInsertElements(objPtr, 0, len, elements);
6450 return objPtr;
6453 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6454 * length of the vector. Note that the user of this function should make
6455 * sure that the list object can't shimmer while the vector returned
6456 * is in use, this vector is the one stored inside the internal representation
6457 * of the list object. This function is not exported, extensions should
6458 * always access to the List object elements using Jim_ListIndex(). */
6459 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6460 Jim_Obj ***listVec)
6462 *listLen = Jim_ListLength(interp, listObj);
6463 *listVec = listObj->internalRep.listValue.ele;
6466 /* Sorting uses ints, but commands may return wide */
6467 static int JimSign(jim_wide w)
6469 if (w == 0) {
6470 return 0;
6472 else if (w < 0) {
6473 return -1;
6475 return 1;
6478 /* ListSortElements type values */
6479 struct lsort_info {
6480 jmp_buf jmpbuf;
6481 Jim_Obj *command;
6482 Jim_Interp *interp;
6483 enum {
6484 JIM_LSORT_ASCII,
6485 JIM_LSORT_NOCASE,
6486 JIM_LSORT_INTEGER,
6487 JIM_LSORT_REAL,
6488 JIM_LSORT_COMMAND
6489 } type;
6490 int order;
6491 int index;
6492 int indexed;
6493 int unique;
6494 int (*subfn)(Jim_Obj **, Jim_Obj **);
6497 static struct lsort_info *sort_info;
6499 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6501 Jim_Obj *lObj, *rObj;
6503 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6504 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6505 longjmp(sort_info->jmpbuf, JIM_ERR);
6507 return sort_info->subfn(&lObj, &rObj);
6510 /* Sort the internal rep of a list. */
6511 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6513 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6516 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6518 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6521 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6523 jim_wide lhs = 0, rhs = 0;
6525 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6526 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6527 longjmp(sort_info->jmpbuf, JIM_ERR);
6530 return JimSign(lhs - rhs) * sort_info->order;
6533 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6535 double lhs = 0, rhs = 0;
6537 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6538 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6539 longjmp(sort_info->jmpbuf, JIM_ERR);
6541 if (lhs == rhs) {
6542 return 0;
6544 if (lhs > rhs) {
6545 return sort_info->order;
6547 return -sort_info->order;
6550 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6552 Jim_Obj *compare_script;
6553 int rc;
6555 jim_wide ret = 0;
6557 /* This must be a valid list */
6558 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6559 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6560 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6562 rc = Jim_EvalObj(sort_info->interp, compare_script);
6564 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6565 longjmp(sort_info->jmpbuf, rc);
6568 return JimSign(ret) * sort_info->order;
6571 /* Remove duplicate elements from the (sorted) list in-place, according to the
6572 * comparison function, comp.
6574 * Note that the last unique value is kept, not the first
6576 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6578 int src;
6579 int dst = 0;
6580 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6582 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6583 if (comp(&ele[dst], &ele[src]) == 0) {
6584 /* Match, so replace the dest with the current source */
6585 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6587 else {
6588 /* No match, so keep the current source and move to the next destination */
6589 dst++;
6591 ele[dst] = ele[src];
6593 /* At end of list, keep the final element */
6594 ele[++dst] = ele[src];
6596 /* Set the new length */
6597 listObjPtr->internalRep.listValue.len = dst;
6600 /* Sort a list *in place*. MUST be called with a non-shared list. */
6601 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6603 struct lsort_info *prev_info;
6605 typedef int (qsort_comparator) (const void *, const void *);
6606 int (*fn) (Jim_Obj **, Jim_Obj **);
6607 Jim_Obj **vector;
6608 int len;
6609 int rc;
6611 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6612 SetListFromAny(interp, listObjPtr);
6614 /* Allow lsort to be called reentrantly */
6615 prev_info = sort_info;
6616 sort_info = info;
6618 vector = listObjPtr->internalRep.listValue.ele;
6619 len = listObjPtr->internalRep.listValue.len;
6620 switch (info->type) {
6621 case JIM_LSORT_ASCII:
6622 fn = ListSortString;
6623 break;
6624 case JIM_LSORT_NOCASE:
6625 fn = ListSortStringNoCase;
6626 break;
6627 case JIM_LSORT_INTEGER:
6628 fn = ListSortInteger;
6629 break;
6630 case JIM_LSORT_REAL:
6631 fn = ListSortReal;
6632 break;
6633 case JIM_LSORT_COMMAND:
6634 fn = ListSortCommand;
6635 break;
6636 default:
6637 fn = NULL; /* avoid warning */
6638 JimPanic((1, "ListSort called with invalid sort type"));
6641 if (info->indexed) {
6642 /* Need to interpose a "list index" function */
6643 info->subfn = fn;
6644 fn = ListSortIndexHelper;
6647 if ((rc = setjmp(info->jmpbuf)) == 0) {
6648 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6650 if (info->unique && len > 1) {
6651 ListRemoveDuplicates(listObjPtr, fn);
6654 Jim_InvalidateStringRep(listObjPtr);
6656 sort_info = prev_info;
6658 return rc;
6661 /* This is the low-level function to insert elements into a list.
6662 * The higher-level Jim_ListInsertElements() performs shared object
6663 * check and invalidates the string repr. This version is used
6664 * in the internals of the List Object and is not exported.
6666 * NOTE: this function can be called only against objects
6667 * with internal type of List.
6669 * An insertion point (idx) of -1 means end-of-list.
6671 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6673 int currentLen = listPtr->internalRep.listValue.len;
6674 int requiredLen = currentLen + elemc;
6675 int i;
6676 Jim_Obj **point;
6678 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6679 if (requiredLen < 2) {
6680 /* Don't do allocations of under 4 pointers. */
6681 requiredLen = 4;
6683 else {
6684 requiredLen *= 2;
6687 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6688 sizeof(Jim_Obj *) * requiredLen);
6690 listPtr->internalRep.listValue.maxLen = requiredLen;
6692 if (idx < 0) {
6693 idx = currentLen;
6695 point = listPtr->internalRep.listValue.ele + idx;
6696 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6697 for (i = 0; i < elemc; ++i) {
6698 point[i] = elemVec[i];
6699 Jim_IncrRefCount(point[i]);
6701 listPtr->internalRep.listValue.len += elemc;
6704 /* Convenience call to ListInsertElements() to append a single element.
6706 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6708 ListInsertElements(listPtr, -1, 1, &objPtr);
6711 /* Appends every element of appendListPtr into listPtr.
6712 * Both have to be of the list type.
6713 * Convenience call to ListInsertElements()
6715 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6717 ListInsertElements(listPtr, -1,
6718 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6721 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6723 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6724 SetListFromAny(interp, listPtr);
6725 Jim_InvalidateStringRep(listPtr);
6726 ListAppendElement(listPtr, objPtr);
6729 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6731 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6732 SetListFromAny(interp, listPtr);
6733 SetListFromAny(interp, appendListPtr);
6734 Jim_InvalidateStringRep(listPtr);
6735 ListAppendList(listPtr, appendListPtr);
6738 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6740 SetListFromAny(interp, objPtr);
6741 return objPtr->internalRep.listValue.len;
6744 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6745 int objc, Jim_Obj *const *objVec)
6747 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6748 SetListFromAny(interp, listPtr);
6749 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6750 idx = listPtr->internalRep.listValue.len;
6751 else if (idx < 0)
6752 idx = 0;
6753 Jim_InvalidateStringRep(listPtr);
6754 ListInsertElements(listPtr, idx, objc, objVec);
6757 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6759 SetListFromAny(interp, listPtr);
6760 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6761 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6762 return NULL;
6764 if (idx < 0)
6765 idx = listPtr->internalRep.listValue.len + idx;
6766 return listPtr->internalRep.listValue.ele[idx];
6769 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6771 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6772 if (*objPtrPtr == NULL) {
6773 if (flags & JIM_ERRMSG) {
6774 Jim_SetResultString(interp, "list index out of range", -1);
6776 return JIM_ERR;
6778 return JIM_OK;
6781 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6782 Jim_Obj *newObjPtr, int flags)
6784 SetListFromAny(interp, listPtr);
6785 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6786 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6787 if (flags & JIM_ERRMSG) {
6788 Jim_SetResultString(interp, "list index out of range", -1);
6790 return JIM_ERR;
6792 if (idx < 0)
6793 idx = listPtr->internalRep.listValue.len + idx;
6794 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6795 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6796 Jim_IncrRefCount(newObjPtr);
6797 return JIM_OK;
6800 /* Modify the list stored in the variable named 'varNamePtr'
6801 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6802 * with the new element 'newObjptr'. (implements the [lset] command) */
6803 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6804 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6806 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6807 int shared, i, idx;
6809 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6810 if (objPtr == NULL)
6811 return JIM_ERR;
6812 if ((shared = Jim_IsShared(objPtr)))
6813 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6814 for (i = 0; i < indexc - 1; i++) {
6815 listObjPtr = objPtr;
6816 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6817 goto err;
6818 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6819 goto err;
6821 if (Jim_IsShared(objPtr)) {
6822 objPtr = Jim_DuplicateObj(interp, objPtr);
6823 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6825 Jim_InvalidateStringRep(listObjPtr);
6827 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6828 goto err;
6829 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6830 goto err;
6831 Jim_InvalidateStringRep(objPtr);
6832 Jim_InvalidateStringRep(varObjPtr);
6833 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6834 goto err;
6835 Jim_SetResult(interp, varObjPtr);
6836 return JIM_OK;
6837 err:
6838 if (shared) {
6839 Jim_FreeNewObj(interp, varObjPtr);
6841 return JIM_ERR;
6844 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6846 int i;
6847 int listLen = Jim_ListLength(interp, listObjPtr);
6848 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6850 for (i = 0; i < listLen; ) {
6851 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6852 if (++i != listLen) {
6853 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6856 return resObjPtr;
6859 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6861 int i;
6863 /* If all the objects in objv are lists,
6864 * it's possible to return a list as result, that's the
6865 * concatenation of all the lists. */
6866 for (i = 0; i < objc; i++) {
6867 if (!Jim_IsList(objv[i]))
6868 break;
6870 if (i == objc) {
6871 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6873 for (i = 0; i < objc; i++)
6874 ListAppendList(objPtr, objv[i]);
6875 return objPtr;
6877 else {
6878 /* Else... we have to glue strings together */
6879 int len = 0, objLen;
6880 char *bytes, *p;
6882 /* Compute the length */
6883 for (i = 0; i < objc; i++) {
6884 len += Jim_Length(objv[i]);
6886 if (objc)
6887 len += objc - 1;
6888 /* Create the string rep, and a string object holding it. */
6889 p = bytes = Jim_Alloc(len + 1);
6890 for (i = 0; i < objc; i++) {
6891 const char *s = Jim_GetString(objv[i], &objLen);
6893 /* Remove leading space */
6894 while (objLen && isspace(UCHAR(*s))) {
6895 s++;
6896 objLen--;
6897 len--;
6899 /* And trailing space */
6900 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6901 /* Handle trailing backslash-space case */
6902 if (objLen > 1 && s[objLen - 2] == '\\') {
6903 break;
6905 objLen--;
6906 len--;
6908 memcpy(p, s, objLen);
6909 p += objLen;
6910 if (i + 1 != objc) {
6911 if (objLen)
6912 *p++ = ' ';
6913 else {
6914 /* Drop the space calculated for this
6915 * element that is instead null. */
6916 len--;
6920 *p = '\0';
6921 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6925 /* Returns a list composed of the elements in the specified range.
6926 * first and start are directly accepted as Jim_Objects and
6927 * processed for the end?-index? case. */
6928 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6929 Jim_Obj *lastObjPtr)
6931 int first, last;
6932 int len, rangeLen;
6934 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6935 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6936 return NULL;
6937 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6938 first = JimRelToAbsIndex(len, first);
6939 last = JimRelToAbsIndex(len, last);
6940 JimRelToAbsRange(len, &first, &last, &rangeLen);
6941 if (first == 0 && last == len) {
6942 return listObjPtr;
6944 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6947 /* -----------------------------------------------------------------------------
6948 * Dict object
6949 * ---------------------------------------------------------------------------*/
6950 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6951 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6952 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6953 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6955 /* Dict HashTable Type.
6957 * Keys and Values are Jim objects. */
6959 static unsigned int JimObjectHTHashFunction(const void *key)
6961 int len;
6962 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6963 return Jim_GenHashFunction((const unsigned char *)str, len);
6966 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6968 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6971 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6973 Jim_IncrRefCount((Jim_Obj *)val);
6974 return (void *)val;
6977 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6979 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6982 static const Jim_HashTableType JimDictHashTableType = {
6983 JimObjectHTHashFunction, /* hash function */
6984 JimObjectHTKeyValDup, /* key dup */
6985 JimObjectHTKeyValDup, /* val dup */
6986 JimObjectHTKeyCompare, /* key compare */
6987 JimObjectHTKeyValDestructor, /* key destructor */
6988 JimObjectHTKeyValDestructor /* val destructor */
6991 /* Note that while the elements of the dict may contain references,
6992 * the list object itself can't. This basically means that the
6993 * dict object string representation as a whole can't contain references
6994 * that are not presents in the single elements. */
6995 static const Jim_ObjType dictObjType = {
6996 "dict",
6997 FreeDictInternalRep,
6998 DupDictInternalRep,
6999 UpdateStringOfDict,
7000 JIM_TYPE_NONE,
7003 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7005 JIM_NOTUSED(interp);
7007 Jim_FreeHashTable(objPtr->internalRep.ptr);
7008 Jim_Free(objPtr->internalRep.ptr);
7011 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7013 Jim_HashTable *ht, *dupHt;
7014 Jim_HashTableIterator htiter;
7015 Jim_HashEntry *he;
7017 /* Create a new hash table */
7018 ht = srcPtr->internalRep.ptr;
7019 dupHt = Jim_Alloc(sizeof(*dupHt));
7020 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7021 if (ht->size != 0)
7022 Jim_ExpandHashTable(dupHt, ht->size);
7023 /* Copy every element from the source to the dup hash table */
7024 JimInitHashTableIterator(ht, &htiter);
7025 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7026 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7029 dupPtr->internalRep.ptr = dupHt;
7030 dupPtr->typePtr = &dictObjType;
7033 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7035 Jim_HashTable *ht;
7036 Jim_HashTableIterator htiter;
7037 Jim_HashEntry *he;
7038 Jim_Obj **objv;
7039 int i;
7041 ht = dictPtr->internalRep.ptr;
7043 /* Turn the hash table into a flat vector of Jim_Objects. */
7044 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7045 JimInitHashTableIterator(ht, &htiter);
7046 i = 0;
7047 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7048 objv[i++] = Jim_GetHashEntryKey(he);
7049 objv[i++] = Jim_GetHashEntryVal(he);
7051 *len = i;
7052 return objv;
7055 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7057 /* Turn the hash table into a flat vector of Jim_Objects. */
7058 int len;
7059 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7061 /* And now generate the string rep as a list */
7062 JimMakeListStringRep(objPtr, objv, len);
7064 Jim_Free(objv);
7067 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7069 int listlen;
7071 if (objPtr->typePtr == &dictObjType) {
7072 return JIM_OK;
7075 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7076 /* A shared list, so get the string representation now to avoid
7077 * changing the order in case of fast conversion to dict.
7079 Jim_String(objPtr);
7082 /* For simplicity, convert a non-list object to a list and then to a dict */
7083 listlen = Jim_ListLength(interp, objPtr);
7084 if (listlen % 2) {
7085 Jim_SetResultString(interp, "missing value to go with key", -1);
7086 return JIM_ERR;
7088 else {
7089 /* Converting from a list to a dict can't fail */
7090 Jim_HashTable *ht;
7091 int i;
7093 ht = Jim_Alloc(sizeof(*ht));
7094 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7096 for (i = 0; i < listlen; i += 2) {
7097 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7098 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7100 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7103 Jim_FreeIntRep(interp, objPtr);
7104 objPtr->typePtr = &dictObjType;
7105 objPtr->internalRep.ptr = ht;
7107 return JIM_OK;
7111 /* Dict object API */
7113 /* Add an element to a dict. objPtr must be of the "dict" type.
7114 * The higher-level exported function is Jim_DictAddElement().
7115 * If an element with the specified key already exists, the value
7116 * associated is replaced with the new one.
7118 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7119 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7120 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7122 Jim_HashTable *ht = objPtr->internalRep.ptr;
7124 if (valueObjPtr == NULL) { /* unset */
7125 return Jim_DeleteHashEntry(ht, keyObjPtr);
7127 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7128 return JIM_OK;
7131 /* Add an element, higher-level interface for DictAddElement().
7132 * If valueObjPtr == NULL, the key is removed if it exists. */
7133 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7134 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7136 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7137 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7138 return JIM_ERR;
7140 Jim_InvalidateStringRep(objPtr);
7141 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7144 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7146 Jim_Obj *objPtr;
7147 int i;
7149 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7151 objPtr = Jim_NewObj(interp);
7152 objPtr->typePtr = &dictObjType;
7153 objPtr->bytes = NULL;
7154 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7155 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7156 for (i = 0; i < len; i += 2)
7157 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7158 return objPtr;
7161 /* Return the value associated to the specified dict key
7162 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7164 * Sets *objPtrPtr to non-NULL only upon success.
7166 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7167 Jim_Obj **objPtrPtr, int flags)
7169 Jim_HashEntry *he;
7170 Jim_HashTable *ht;
7172 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7173 return -1;
7175 ht = dictPtr->internalRep.ptr;
7176 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7177 if (flags & JIM_ERRMSG) {
7178 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7180 return JIM_ERR;
7182 *objPtrPtr = he->u.val;
7183 return JIM_OK;
7186 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7187 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7189 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7190 return JIM_ERR;
7192 *objPtrPtr = JimDictPairs(dictPtr, len);
7194 return JIM_OK;
7198 /* Return the value associated to the specified dict keys */
7199 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7200 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7202 int i;
7204 if (keyc == 0) {
7205 *objPtrPtr = dictPtr;
7206 return JIM_OK;
7209 for (i = 0; i < keyc; i++) {
7210 Jim_Obj *objPtr;
7212 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7213 if (rc != JIM_OK) {
7214 return rc;
7216 dictPtr = objPtr;
7218 *objPtrPtr = dictPtr;
7219 return JIM_OK;
7222 /* Modify the dict stored into the variable named 'varNamePtr'
7223 * setting the element specified by the 'keyc' keys objects in 'keyv',
7224 * with the new value of the element 'newObjPtr'.
7226 * If newObjPtr == NULL the operation is to remove the given key
7227 * from the dictionary.
7229 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7230 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7232 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7233 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7235 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7236 int shared, i;
7238 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7239 if (objPtr == NULL) {
7240 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7241 /* Cannot remove a key from non existing var */
7242 return JIM_ERR;
7244 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7245 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7246 Jim_FreeNewObj(interp, varObjPtr);
7247 return JIM_ERR;
7250 if ((shared = Jim_IsShared(objPtr)))
7251 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7252 for (i = 0; i < keyc; i++) {
7253 dictObjPtr = objPtr;
7255 /* Check if it's a valid dictionary */
7256 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7257 goto err;
7260 if (i == keyc - 1) {
7261 /* Last key: Note that error on unset with missing last key is OK */
7262 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7263 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7264 goto err;
7267 break;
7270 /* Check if the given key exists. */
7271 Jim_InvalidateStringRep(dictObjPtr);
7272 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7273 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7274 /* This key exists at the current level.
7275 * Make sure it's not shared!. */
7276 if (Jim_IsShared(objPtr)) {
7277 objPtr = Jim_DuplicateObj(interp, objPtr);
7278 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7281 else {
7282 /* Key not found. If it's an [unset] operation
7283 * this is an error. Only the last key may not
7284 * exist. */
7285 if (newObjPtr == NULL) {
7286 goto err;
7288 /* Otherwise set an empty dictionary
7289 * as key's value. */
7290 objPtr = Jim_NewDictObj(interp, NULL, 0);
7291 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7294 /* XXX: Is this necessary? */
7295 Jim_InvalidateStringRep(objPtr);
7296 Jim_InvalidateStringRep(varObjPtr);
7297 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7298 goto err;
7300 Jim_SetResult(interp, varObjPtr);
7301 return JIM_OK;
7302 err:
7303 if (shared) {
7304 Jim_FreeNewObj(interp, varObjPtr);
7306 return JIM_ERR;
7309 /* -----------------------------------------------------------------------------
7310 * Index object
7311 * ---------------------------------------------------------------------------*/
7312 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7313 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7315 static const Jim_ObjType indexObjType = {
7316 "index",
7317 NULL,
7318 NULL,
7319 UpdateStringOfIndex,
7320 JIM_TYPE_NONE,
7323 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7325 if (objPtr->internalRep.intValue == -1) {
7326 JimSetStringBytes(objPtr, "end");
7328 else {
7329 char buf[JIM_INTEGER_SPACE + 1];
7330 if (objPtr->internalRep.intValue >= 0) {
7331 sprintf(buf, "%d", objPtr->internalRep.intValue);
7333 else {
7334 /* Must be <= -2 */
7335 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7337 JimSetStringBytes(objPtr, buf);
7341 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7343 int idx, end = 0;
7344 const char *str;
7345 char *endptr;
7347 /* Get the string representation */
7348 str = Jim_String(objPtr);
7350 /* Try to convert into an index */
7351 if (strncmp(str, "end", 3) == 0) {
7352 end = 1;
7353 str += 3;
7354 idx = 0;
7356 else {
7357 idx = jim_strtol(str, &endptr);
7359 if (endptr == str) {
7360 goto badindex;
7362 str = endptr;
7365 /* Now str may include or +<num> or -<num> */
7366 if (*str == '+' || *str == '-') {
7367 int sign = (*str == '+' ? 1 : -1);
7369 idx += sign * jim_strtol(++str, &endptr);
7370 if (str == endptr || *endptr) {
7371 goto badindex;
7373 str = endptr;
7375 /* The only thing left should be spaces */
7376 while (isspace(UCHAR(*str))) {
7377 str++;
7379 if (*str) {
7380 goto badindex;
7382 if (end) {
7383 if (idx > 0) {
7384 idx = INT_MAX;
7386 else {
7387 /* end-1 is repesented as -2 */
7388 idx--;
7391 else if (idx < 0) {
7392 idx = -INT_MAX;
7395 /* Free the old internal repr and set the new one. */
7396 Jim_FreeIntRep(interp, objPtr);
7397 objPtr->typePtr = &indexObjType;
7398 objPtr->internalRep.intValue = idx;
7399 return JIM_OK;
7401 badindex:
7402 Jim_SetResultFormatted(interp,
7403 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7404 return JIM_ERR;
7407 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7409 /* Avoid shimmering if the object is an integer. */
7410 if (objPtr->typePtr == &intObjType) {
7411 jim_wide val = JimWideValue(objPtr);
7413 if (val < 0)
7414 *indexPtr = -INT_MAX;
7415 else if (val > INT_MAX)
7416 *indexPtr = INT_MAX;
7417 else
7418 *indexPtr = (int)val;
7419 return JIM_OK;
7421 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7422 return JIM_ERR;
7423 *indexPtr = objPtr->internalRep.intValue;
7424 return JIM_OK;
7427 /* -----------------------------------------------------------------------------
7428 * Return Code Object.
7429 * ---------------------------------------------------------------------------*/
7431 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7432 static const char * const jimReturnCodes[] = {
7433 "ok",
7434 "error",
7435 "return",
7436 "break",
7437 "continue",
7438 "signal",
7439 "exit",
7440 "eval",
7441 NULL
7444 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7446 static const Jim_ObjType returnCodeObjType = {
7447 "return-code",
7448 NULL,
7449 NULL,
7450 NULL,
7451 JIM_TYPE_NONE,
7454 /* Converts a (standard) return code to a string. Returns "?" for
7455 * non-standard return codes.
7457 const char *Jim_ReturnCode(int code)
7459 if (code < 0 || code >= (int)jimReturnCodesSize) {
7460 return "?";
7462 else {
7463 return jimReturnCodes[code];
7467 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7469 int returnCode;
7470 jim_wide wideValue;
7472 /* Try to convert into an integer */
7473 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7474 returnCode = (int)wideValue;
7475 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7476 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7477 return JIM_ERR;
7479 /* Free the old internal repr and set the new one. */
7480 Jim_FreeIntRep(interp, objPtr);
7481 objPtr->typePtr = &returnCodeObjType;
7482 objPtr->internalRep.intValue = returnCode;
7483 return JIM_OK;
7486 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7488 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7489 return JIM_ERR;
7490 *intPtr = objPtr->internalRep.intValue;
7491 return JIM_OK;
7494 /* -----------------------------------------------------------------------------
7495 * Expression Parsing
7496 * ---------------------------------------------------------------------------*/
7497 static int JimParseExprOperator(struct JimParserCtx *pc);
7498 static int JimParseExprNumber(struct JimParserCtx *pc);
7499 static int JimParseExprIrrational(struct JimParserCtx *pc);
7501 /* Exrp's Stack machine operators opcodes. */
7503 /* Binary operators (numbers) */
7504 enum
7506 /* Continues on from the JIM_TT_ space */
7507 /* Operations */
7508 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7509 JIM_EXPROP_DIV,
7510 JIM_EXPROP_MOD,
7511 JIM_EXPROP_SUB,
7512 JIM_EXPROP_ADD,
7513 JIM_EXPROP_LSHIFT,
7514 JIM_EXPROP_RSHIFT,
7515 JIM_EXPROP_ROTL,
7516 JIM_EXPROP_ROTR,
7517 JIM_EXPROP_LT,
7518 JIM_EXPROP_GT,
7519 JIM_EXPROP_LTE,
7520 JIM_EXPROP_GTE,
7521 JIM_EXPROP_NUMEQ,
7522 JIM_EXPROP_NUMNE,
7523 JIM_EXPROP_BITAND, /* 35 */
7524 JIM_EXPROP_BITXOR,
7525 JIM_EXPROP_BITOR,
7527 /* Note must keep these together */
7528 JIM_EXPROP_LOGICAND, /* 38 */
7529 JIM_EXPROP_LOGICAND_LEFT,
7530 JIM_EXPROP_LOGICAND_RIGHT,
7532 /* and these */
7533 JIM_EXPROP_LOGICOR, /* 41 */
7534 JIM_EXPROP_LOGICOR_LEFT,
7535 JIM_EXPROP_LOGICOR_RIGHT,
7537 /* and these */
7538 /* Ternary operators */
7539 JIM_EXPROP_TERNARY, /* 44 */
7540 JIM_EXPROP_TERNARY_LEFT,
7541 JIM_EXPROP_TERNARY_RIGHT,
7543 /* and these */
7544 JIM_EXPROP_COLON, /* 47 */
7545 JIM_EXPROP_COLON_LEFT,
7546 JIM_EXPROP_COLON_RIGHT,
7548 JIM_EXPROP_POW, /* 50 */
7550 /* Binary operators (strings) */
7551 JIM_EXPROP_STREQ, /* 51 */
7552 JIM_EXPROP_STRNE,
7553 JIM_EXPROP_STRIN,
7554 JIM_EXPROP_STRNI,
7556 /* Unary operators (numbers) */
7557 JIM_EXPROP_NOT, /* 55 */
7558 JIM_EXPROP_BITNOT,
7559 JIM_EXPROP_UNARYMINUS,
7560 JIM_EXPROP_UNARYPLUS,
7562 /* Functions */
7563 JIM_EXPROP_FUNC_FIRST, /* 59 */
7564 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7565 JIM_EXPROP_FUNC_WIDE,
7566 JIM_EXPROP_FUNC_ABS,
7567 JIM_EXPROP_FUNC_DOUBLE,
7568 JIM_EXPROP_FUNC_ROUND,
7569 JIM_EXPROP_FUNC_RAND,
7570 JIM_EXPROP_FUNC_SRAND,
7572 /* math functions from libm */
7573 JIM_EXPROP_FUNC_SIN, /* 65 */
7574 JIM_EXPROP_FUNC_COS,
7575 JIM_EXPROP_FUNC_TAN,
7576 JIM_EXPROP_FUNC_ASIN,
7577 JIM_EXPROP_FUNC_ACOS,
7578 JIM_EXPROP_FUNC_ATAN,
7579 JIM_EXPROP_FUNC_SINH,
7580 JIM_EXPROP_FUNC_COSH,
7581 JIM_EXPROP_FUNC_TANH,
7582 JIM_EXPROP_FUNC_CEIL,
7583 JIM_EXPROP_FUNC_FLOOR,
7584 JIM_EXPROP_FUNC_EXP,
7585 JIM_EXPROP_FUNC_LOG,
7586 JIM_EXPROP_FUNC_LOG10,
7587 JIM_EXPROP_FUNC_SQRT,
7588 JIM_EXPROP_FUNC_POW,
7591 struct JimExprState
7593 Jim_Obj **stack;
7594 int stacklen;
7595 int opcode;
7596 int skip;
7599 /* Operators table */
7600 typedef struct Jim_ExprOperator
7602 const char *name;
7603 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7604 unsigned char precedence;
7605 unsigned char arity;
7606 unsigned char lazy;
7607 unsigned char namelen;
7608 } Jim_ExprOperator;
7610 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7612 Jim_IncrRefCount(obj);
7613 e->stack[e->stacklen++] = obj;
7616 static Jim_Obj *ExprPop(struct JimExprState *e)
7618 return e->stack[--e->stacklen];
7621 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7623 int intresult = 1;
7624 int rc = JIM_OK;
7625 Jim_Obj *A = ExprPop(e);
7626 double dA, dC = 0;
7627 jim_wide wA, wC = 0;
7629 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7630 switch (e->opcode) {
7631 case JIM_EXPROP_FUNC_INT:
7632 case JIM_EXPROP_FUNC_WIDE:
7633 case JIM_EXPROP_FUNC_ROUND:
7634 case JIM_EXPROP_UNARYPLUS:
7635 wC = wA;
7636 break;
7637 case JIM_EXPROP_FUNC_DOUBLE:
7638 dC = wA;
7639 intresult = 0;
7640 break;
7641 case JIM_EXPROP_FUNC_ABS:
7642 wC = wA >= 0 ? wA : -wA;
7643 break;
7644 case JIM_EXPROP_UNARYMINUS:
7645 wC = -wA;
7646 break;
7647 case JIM_EXPROP_NOT:
7648 wC = !wA;
7649 break;
7650 default:
7651 abort();
7654 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7655 switch (e->opcode) {
7656 case JIM_EXPROP_FUNC_INT:
7657 case JIM_EXPROP_FUNC_WIDE:
7658 wC = dA;
7659 break;
7660 case JIM_EXPROP_FUNC_ROUND:
7661 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7662 break;
7663 case JIM_EXPROP_FUNC_DOUBLE:
7664 case JIM_EXPROP_UNARYPLUS:
7665 dC = dA;
7666 intresult = 0;
7667 break;
7668 case JIM_EXPROP_FUNC_ABS:
7669 dC = dA >= 0 ? dA : -dA;
7670 intresult = 0;
7671 break;
7672 case JIM_EXPROP_UNARYMINUS:
7673 dC = -dA;
7674 intresult = 0;
7675 break;
7676 case JIM_EXPROP_NOT:
7677 wC = !dA;
7678 break;
7679 default:
7680 abort();
7684 if (rc == JIM_OK) {
7685 if (intresult) {
7686 ExprPush(e, Jim_NewIntObj(interp, wC));
7688 else {
7689 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7693 Jim_DecrRefCount(interp, A);
7695 return rc;
7698 static double JimRandDouble(Jim_Interp *interp)
7700 unsigned long x;
7701 JimRandomBytes(interp, &x, sizeof(x));
7703 return (double)x / (unsigned long)~0;
7706 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7708 Jim_Obj *A = ExprPop(e);
7709 jim_wide wA;
7711 int rc = Jim_GetWide(interp, A, &wA);
7712 if (rc == JIM_OK) {
7713 switch (e->opcode) {
7714 case JIM_EXPROP_BITNOT:
7715 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7716 break;
7717 case JIM_EXPROP_FUNC_SRAND:
7718 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7719 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7720 break;
7721 default:
7722 abort();
7726 Jim_DecrRefCount(interp, A);
7728 return rc;
7731 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7733 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7735 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7737 return JIM_OK;
7740 #ifdef JIM_MATH_FUNCTIONS
7741 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7743 int rc;
7744 Jim_Obj *A = ExprPop(e);
7745 double dA, dC;
7747 rc = Jim_GetDouble(interp, A, &dA);
7748 if (rc == JIM_OK) {
7749 switch (e->opcode) {
7750 case JIM_EXPROP_FUNC_SIN:
7751 dC = sin(dA);
7752 break;
7753 case JIM_EXPROP_FUNC_COS:
7754 dC = cos(dA);
7755 break;
7756 case JIM_EXPROP_FUNC_TAN:
7757 dC = tan(dA);
7758 break;
7759 case JIM_EXPROP_FUNC_ASIN:
7760 dC = asin(dA);
7761 break;
7762 case JIM_EXPROP_FUNC_ACOS:
7763 dC = acos(dA);
7764 break;
7765 case JIM_EXPROP_FUNC_ATAN:
7766 dC = atan(dA);
7767 break;
7768 case JIM_EXPROP_FUNC_SINH:
7769 dC = sinh(dA);
7770 break;
7771 case JIM_EXPROP_FUNC_COSH:
7772 dC = cosh(dA);
7773 break;
7774 case JIM_EXPROP_FUNC_TANH:
7775 dC = tanh(dA);
7776 break;
7777 case JIM_EXPROP_FUNC_CEIL:
7778 dC = ceil(dA);
7779 break;
7780 case JIM_EXPROP_FUNC_FLOOR:
7781 dC = floor(dA);
7782 break;
7783 case JIM_EXPROP_FUNC_EXP:
7784 dC = exp(dA);
7785 break;
7786 case JIM_EXPROP_FUNC_LOG:
7787 dC = log(dA);
7788 break;
7789 case JIM_EXPROP_FUNC_LOG10:
7790 dC = log10(dA);
7791 break;
7792 case JIM_EXPROP_FUNC_SQRT:
7793 dC = sqrt(dA);
7794 break;
7795 default:
7796 abort();
7798 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7801 Jim_DecrRefCount(interp, A);
7803 return rc;
7805 #endif
7807 /* A binary operation on two ints */
7808 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7810 Jim_Obj *B = ExprPop(e);
7811 Jim_Obj *A = ExprPop(e);
7812 jim_wide wA, wB;
7813 int rc = JIM_ERR;
7815 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7816 jim_wide wC;
7818 rc = JIM_OK;
7820 switch (e->opcode) {
7821 case JIM_EXPROP_LSHIFT:
7822 wC = wA << wB;
7823 break;
7824 case JIM_EXPROP_RSHIFT:
7825 wC = wA >> wB;
7826 break;
7827 case JIM_EXPROP_BITAND:
7828 wC = wA & wB;
7829 break;
7830 case JIM_EXPROP_BITXOR:
7831 wC = wA ^ wB;
7832 break;
7833 case JIM_EXPROP_BITOR:
7834 wC = wA | wB;
7835 break;
7836 case JIM_EXPROP_MOD:
7837 if (wB == 0) {
7838 wC = 0;
7839 Jim_SetResultString(interp, "Division by zero", -1);
7840 rc = JIM_ERR;
7842 else {
7844 * From Tcl 8.x
7846 * This code is tricky: C doesn't guarantee much
7847 * about the quotient or remainder, but Tcl does.
7848 * The remainder always has the same sign as the
7849 * divisor and a smaller absolute value.
7851 int negative = 0;
7853 if (wB < 0) {
7854 wB = -wB;
7855 wA = -wA;
7856 negative = 1;
7858 wC = wA % wB;
7859 if (wC < 0) {
7860 wC += wB;
7862 if (negative) {
7863 wC = -wC;
7866 break;
7867 case JIM_EXPROP_ROTL:
7868 case JIM_EXPROP_ROTR:{
7869 /* uint32_t would be better. But not everyone has inttypes.h? */
7870 unsigned long uA = (unsigned long)wA;
7871 unsigned long uB = (unsigned long)wB;
7872 const unsigned int S = sizeof(unsigned long) * 8;
7874 /* Shift left by the word size or more is undefined. */
7875 uB %= S;
7877 if (e->opcode == JIM_EXPROP_ROTR) {
7878 uB = S - uB;
7880 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7881 break;
7883 default:
7884 abort();
7886 ExprPush(e, Jim_NewIntObj(interp, wC));
7890 Jim_DecrRefCount(interp, A);
7891 Jim_DecrRefCount(interp, B);
7893 return rc;
7897 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7898 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7900 int intresult = 1;
7901 int rc = JIM_OK;
7902 double dA, dB, dC = 0;
7903 jim_wide wA, wB, wC = 0;
7905 Jim_Obj *B = ExprPop(e);
7906 Jim_Obj *A = ExprPop(e);
7908 if ((A->typePtr != &doubleObjType || A->bytes) &&
7909 (B->typePtr != &doubleObjType || B->bytes) &&
7910 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7912 /* Both are ints */
7914 switch (e->opcode) {
7915 case JIM_EXPROP_POW:
7916 case JIM_EXPROP_FUNC_POW:
7917 wC = JimPowWide(wA, wB);
7918 break;
7919 case JIM_EXPROP_ADD:
7920 wC = wA + wB;
7921 break;
7922 case JIM_EXPROP_SUB:
7923 wC = wA - wB;
7924 break;
7925 case JIM_EXPROP_MUL:
7926 wC = wA * wB;
7927 break;
7928 case JIM_EXPROP_DIV:
7929 if (wB == 0) {
7930 Jim_SetResultString(interp, "Division by zero", -1);
7931 rc = JIM_ERR;
7933 else {
7935 * From Tcl 8.x
7937 * This code is tricky: C doesn't guarantee much
7938 * about the quotient or remainder, but Tcl does.
7939 * The remainder always has the same sign as the
7940 * divisor and a smaller absolute value.
7942 if (wB < 0) {
7943 wB = -wB;
7944 wA = -wA;
7946 wC = wA / wB;
7947 if (wA % wB < 0) {
7948 wC--;
7951 break;
7952 case JIM_EXPROP_LT:
7953 wC = wA < wB;
7954 break;
7955 case JIM_EXPROP_GT:
7956 wC = wA > wB;
7957 break;
7958 case JIM_EXPROP_LTE:
7959 wC = wA <= wB;
7960 break;
7961 case JIM_EXPROP_GTE:
7962 wC = wA >= wB;
7963 break;
7964 case JIM_EXPROP_NUMEQ:
7965 wC = wA == wB;
7966 break;
7967 case JIM_EXPROP_NUMNE:
7968 wC = wA != wB;
7969 break;
7970 default:
7971 abort();
7974 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7975 intresult = 0;
7976 switch (e->opcode) {
7977 case JIM_EXPROP_POW:
7978 case JIM_EXPROP_FUNC_POW:
7979 #ifdef JIM_MATH_FUNCTIONS
7980 dC = pow(dA, dB);
7981 #else
7982 Jim_SetResultString(interp, "unsupported", -1);
7983 rc = JIM_ERR;
7984 #endif
7985 break;
7986 case JIM_EXPROP_ADD:
7987 dC = dA + dB;
7988 break;
7989 case JIM_EXPROP_SUB:
7990 dC = dA - dB;
7991 break;
7992 case JIM_EXPROP_MUL:
7993 dC = dA * dB;
7994 break;
7995 case JIM_EXPROP_DIV:
7996 if (dB == 0) {
7997 #ifdef INFINITY
7998 dC = dA < 0 ? -INFINITY : INFINITY;
7999 #else
8000 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8001 #endif
8003 else {
8004 dC = dA / dB;
8006 break;
8007 case JIM_EXPROP_LT:
8008 wC = dA < dB;
8009 intresult = 1;
8010 break;
8011 case JIM_EXPROP_GT:
8012 wC = dA > dB;
8013 intresult = 1;
8014 break;
8015 case JIM_EXPROP_LTE:
8016 wC = dA <= dB;
8017 intresult = 1;
8018 break;
8019 case JIM_EXPROP_GTE:
8020 wC = dA >= dB;
8021 intresult = 1;
8022 break;
8023 case JIM_EXPROP_NUMEQ:
8024 wC = dA == dB;
8025 intresult = 1;
8026 break;
8027 case JIM_EXPROP_NUMNE:
8028 wC = dA != dB;
8029 intresult = 1;
8030 break;
8031 default:
8032 abort();
8035 else {
8036 /* Handle the string case */
8038 /* XXX: Could optimise the eq/ne case by checking lengths */
8039 int i = Jim_StringCompareObj(interp, A, B, 0);
8041 switch (e->opcode) {
8042 case JIM_EXPROP_LT:
8043 wC = i < 0;
8044 break;
8045 case JIM_EXPROP_GT:
8046 wC = i > 0;
8047 break;
8048 case JIM_EXPROP_LTE:
8049 wC = i <= 0;
8050 break;
8051 case JIM_EXPROP_GTE:
8052 wC = i >= 0;
8053 break;
8054 case JIM_EXPROP_NUMEQ:
8055 wC = i == 0;
8056 break;
8057 case JIM_EXPROP_NUMNE:
8058 wC = i != 0;
8059 break;
8060 default:
8061 rc = JIM_ERR;
8062 break;
8066 if (rc == JIM_OK) {
8067 if (intresult) {
8068 ExprPush(e, Jim_NewIntObj(interp, wC));
8070 else {
8071 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8075 Jim_DecrRefCount(interp, A);
8076 Jim_DecrRefCount(interp, B);
8078 return rc;
8081 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8083 int listlen;
8084 int i;
8086 listlen = Jim_ListLength(interp, listObjPtr);
8087 for (i = 0; i < listlen; i++) {
8088 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8089 return 1;
8092 return 0;
8095 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8097 Jim_Obj *B = ExprPop(e);
8098 Jim_Obj *A = ExprPop(e);
8100 jim_wide wC;
8102 switch (e->opcode) {
8103 case JIM_EXPROP_STREQ:
8104 case JIM_EXPROP_STRNE:
8105 wC = Jim_StringEqObj(A, B);
8106 if (e->opcode == JIM_EXPROP_STRNE) {
8107 wC = !wC;
8109 break;
8110 case JIM_EXPROP_STRIN:
8111 wC = JimSearchList(interp, B, A);
8112 break;
8113 case JIM_EXPROP_STRNI:
8114 wC = !JimSearchList(interp, B, A);
8115 break;
8116 default:
8117 abort();
8119 ExprPush(e, Jim_NewIntObj(interp, wC));
8121 Jim_DecrRefCount(interp, A);
8122 Jim_DecrRefCount(interp, B);
8124 return JIM_OK;
8127 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8129 long l;
8130 double d;
8132 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8133 return l != 0;
8135 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8136 return d != 0;
8138 return -1;
8141 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8143 Jim_Obj *skip = ExprPop(e);
8144 Jim_Obj *A = ExprPop(e);
8145 int rc = JIM_OK;
8147 switch (ExprBool(interp, A)) {
8148 case 0:
8149 /* false, so skip RHS opcodes with a 0 result */
8150 e->skip = JimWideValue(skip);
8151 ExprPush(e, Jim_NewIntObj(interp, 0));
8152 break;
8154 case 1:
8155 /* true so continue */
8156 break;
8158 case -1:
8159 /* Invalid */
8160 rc = JIM_ERR;
8162 Jim_DecrRefCount(interp, A);
8163 Jim_DecrRefCount(interp, skip);
8165 return rc;
8168 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8170 Jim_Obj *skip = ExprPop(e);
8171 Jim_Obj *A = ExprPop(e);
8172 int rc = JIM_OK;
8174 switch (ExprBool(interp, A)) {
8175 case 0:
8176 /* false, so do nothing */
8177 break;
8179 case 1:
8180 /* true so skip RHS opcodes with a 1 result */
8181 e->skip = JimWideValue(skip);
8182 ExprPush(e, Jim_NewIntObj(interp, 1));
8183 break;
8185 case -1:
8186 /* Invalid */
8187 rc = JIM_ERR;
8188 break;
8190 Jim_DecrRefCount(interp, A);
8191 Jim_DecrRefCount(interp, skip);
8193 return rc;
8196 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8198 Jim_Obj *A = ExprPop(e);
8199 int rc = JIM_OK;
8201 switch (ExprBool(interp, A)) {
8202 case 0:
8203 ExprPush(e, Jim_NewIntObj(interp, 0));
8204 break;
8206 case 1:
8207 ExprPush(e, Jim_NewIntObj(interp, 1));
8208 break;
8210 case -1:
8211 /* Invalid */
8212 rc = JIM_ERR;
8213 break;
8215 Jim_DecrRefCount(interp, A);
8217 return rc;
8220 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8222 Jim_Obj *skip = ExprPop(e);
8223 Jim_Obj *A = ExprPop(e);
8224 int rc = JIM_OK;
8226 /* Repush A */
8227 ExprPush(e, A);
8229 switch (ExprBool(interp, A)) {
8230 case 0:
8231 /* false, skip RHS opcodes */
8232 e->skip = JimWideValue(skip);
8233 /* Push a dummy value */
8234 ExprPush(e, Jim_NewIntObj(interp, 0));
8235 break;
8237 case 1:
8238 /* true so do nothing */
8239 break;
8241 case -1:
8242 /* Invalid */
8243 rc = JIM_ERR;
8244 break;
8246 Jim_DecrRefCount(interp, A);
8247 Jim_DecrRefCount(interp, skip);
8249 return rc;
8252 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8254 Jim_Obj *skip = ExprPop(e);
8255 Jim_Obj *B = ExprPop(e);
8256 Jim_Obj *A = ExprPop(e);
8258 /* No need to check for A as non-boolean */
8259 if (ExprBool(interp, A)) {
8260 /* true, so skip RHS opcodes */
8261 e->skip = JimWideValue(skip);
8262 /* Repush B as the answer */
8263 ExprPush(e, B);
8266 Jim_DecrRefCount(interp, skip);
8267 Jim_DecrRefCount(interp, A);
8268 Jim_DecrRefCount(interp, B);
8269 return JIM_OK;
8272 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8274 return JIM_OK;
8277 enum
8279 LAZY_NONE,
8280 LAZY_OP,
8281 LAZY_LEFT,
8282 LAZY_RIGHT
8285 /* name - precedence - arity - opcode
8287 * This array *must* be kept in sync with the JIM_EXPROP enum.
8289 * The following macros pre-compute the string length at compile time.
8291 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8292 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8294 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8295 OPRINIT("*", 110, 2, JimExprOpBin),
8296 OPRINIT("/", 110, 2, JimExprOpBin),
8297 OPRINIT("%", 110, 2, JimExprOpIntBin),
8299 OPRINIT("-", 100, 2, JimExprOpBin),
8300 OPRINIT("+", 100, 2, JimExprOpBin),
8302 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8303 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8305 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8306 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8308 OPRINIT("<", 80, 2, JimExprOpBin),
8309 OPRINIT(">", 80, 2, JimExprOpBin),
8310 OPRINIT("<=", 80, 2, JimExprOpBin),
8311 OPRINIT(">=", 80, 2, JimExprOpBin),
8313 OPRINIT("==", 70, 2, JimExprOpBin),
8314 OPRINIT("!=", 70, 2, JimExprOpBin),
8316 OPRINIT("&", 50, 2, JimExprOpIntBin),
8317 OPRINIT("^", 49, 2, JimExprOpIntBin),
8318 OPRINIT("|", 48, 2, JimExprOpIntBin),
8320 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8321 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8322 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8324 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8325 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8326 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8328 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8329 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8330 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8332 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8333 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8334 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8336 OPRINIT("**", 250, 2, JimExprOpBin),
8338 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8339 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8341 OPRINIT("in", 55, 2, JimExprOpStrBin),
8342 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8344 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8345 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8346 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8347 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8351 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8352 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8353 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8354 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8355 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8356 OPRINIT("rand", 200, 0, JimExprOpNone),
8357 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8359 #ifdef JIM_MATH_FUNCTIONS
8360 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8361 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8362 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8363 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8364 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8365 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8366 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8367 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8368 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8369 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8370 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8371 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8372 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8373 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8374 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8375 OPRINIT("pow", 200, 2, JimExprOpBin),
8376 #endif
8378 #undef OPRINIT
8379 #undef OPRINIT_LAZY
8381 #define JIM_EXPR_OPERATORS_NUM \
8382 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8384 static int JimParseExpression(struct JimParserCtx *pc)
8386 /* Discard spaces and quoted newline */
8387 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8388 if (*pc->p == '\n') {
8389 pc->linenr++;
8391 pc->p++;
8392 pc->len--;
8395 /* Common case */
8396 pc->tline = pc->linenr;
8397 pc->tstart = pc->p;
8399 if (pc->len == 0) {
8400 pc->tend = pc->p;
8401 pc->tt = JIM_TT_EOL;
8402 pc->eof = 1;
8403 return JIM_OK;
8405 switch (*(pc->p)) {
8406 case '(':
8407 pc->tt = JIM_TT_SUBEXPR_START;
8408 goto singlechar;
8409 case ')':
8410 pc->tt = JIM_TT_SUBEXPR_END;
8411 goto singlechar;
8412 case ',':
8413 pc->tt = JIM_TT_SUBEXPR_COMMA;
8414 singlechar:
8415 pc->tend = pc->p;
8416 pc->p++;
8417 pc->len--;
8418 break;
8419 case '[':
8420 return JimParseCmd(pc);
8421 case '$':
8422 if (JimParseVar(pc) == JIM_ERR)
8423 return JimParseExprOperator(pc);
8424 else {
8425 /* Don't allow expr sugar in expressions */
8426 if (pc->tt == JIM_TT_EXPRSUGAR) {
8427 return JIM_ERR;
8429 return JIM_OK;
8431 break;
8432 case '0':
8433 case '1':
8434 case '2':
8435 case '3':
8436 case '4':
8437 case '5':
8438 case '6':
8439 case '7':
8440 case '8':
8441 case '9':
8442 case '.':
8443 return JimParseExprNumber(pc);
8444 case '"':
8445 return JimParseQuote(pc);
8446 case '{':
8447 return JimParseBrace(pc);
8449 case 'N':
8450 case 'I':
8451 case 'n':
8452 case 'i':
8453 if (JimParseExprIrrational(pc) == JIM_ERR)
8454 return JimParseExprOperator(pc);
8455 break;
8456 default:
8457 return JimParseExprOperator(pc);
8458 break;
8460 return JIM_OK;
8463 static int JimParseExprNumber(struct JimParserCtx *pc)
8465 char *end;
8467 /* Assume an integer for now */
8468 pc->tt = JIM_TT_EXPR_INT;
8470 jim_strtoull(pc->p, (char **)&pc->p);
8471 /* Tried as an integer, but perhaps it parses as a double */
8472 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8473 /* Some stupid compilers insist they are cleverer that
8474 * we are. Even a (void) cast doesn't prevent this warning!
8476 if (strtod(pc->tstart, &end)) { /* nothing */ }
8477 if (end == pc->tstart)
8478 return JIM_ERR;
8479 if (end > pc->p) {
8480 /* Yes, double captured more chars */
8481 pc->tt = JIM_TT_EXPR_DOUBLE;
8482 pc->p = end;
8485 pc->tend = pc->p - 1;
8486 pc->len -= (pc->p - pc->tstart);
8487 return JIM_OK;
8490 static int JimParseExprIrrational(struct JimParserCtx *pc)
8492 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8493 int i;
8495 for (i = 0; irrationals[i]; i++) {
8496 const char *irr = irrationals[i];
8498 if (strncmp(irr, pc->p, 3) == 0) {
8499 pc->p += 3;
8500 pc->len -= 3;
8501 pc->tend = pc->p - 1;
8502 pc->tt = JIM_TT_EXPR_DOUBLE;
8503 return JIM_OK;
8506 return JIM_ERR;
8509 static int JimParseExprOperator(struct JimParserCtx *pc)
8511 int i;
8512 int bestIdx = -1, bestLen = 0;
8514 /* Try to get the longest match. */
8515 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8516 const char * const opname = Jim_ExprOperators[i].name;
8517 const int oplen = Jim_ExprOperators[i].namelen;
8519 if (opname == NULL || opname[0] != pc->p[0]) {
8520 continue;
8523 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8524 bestIdx = i + JIM_TT_EXPR_OP;
8525 bestLen = oplen;
8528 if (bestIdx == -1) {
8529 return JIM_ERR;
8532 /* Validate paretheses around function arguments */
8533 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8534 const char *p = pc->p + bestLen;
8535 int len = pc->len - bestLen;
8537 while (len && isspace(UCHAR(*p))) {
8538 len--;
8539 p++;
8541 if (*p != '(') {
8542 return JIM_ERR;
8545 pc->tend = pc->p + bestLen - 1;
8546 pc->p += bestLen;
8547 pc->len -= bestLen;
8549 pc->tt = bestIdx;
8550 return JIM_OK;
8553 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8555 static Jim_ExprOperator dummy_op;
8556 if (opcode < JIM_TT_EXPR_OP) {
8557 return &dummy_op;
8559 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8562 const char *jim_tt_name(int type)
8564 static const char * const tt_names[JIM_TT_EXPR_OP] =
8565 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8566 "DBL", "$()" };
8567 if (type < JIM_TT_EXPR_OP) {
8568 return tt_names[type];
8570 else {
8571 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8572 static char buf[20];
8574 if (op->name) {
8575 return op->name;
8577 sprintf(buf, "(%d)", type);
8578 return buf;
8582 /* -----------------------------------------------------------------------------
8583 * Expression Object
8584 * ---------------------------------------------------------------------------*/
8585 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8586 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8587 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8589 static const Jim_ObjType exprObjType = {
8590 "expression",
8591 FreeExprInternalRep,
8592 DupExprInternalRep,
8593 NULL,
8594 JIM_TYPE_REFERENCES,
8597 /* Expr bytecode structure */
8598 typedef struct ExprByteCode
8600 ScriptToken *token; /* Tokens array. */
8601 int len; /* Length as number of tokens. */
8602 int inUse; /* Used for sharing. */
8603 } ExprByteCode;
8605 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8607 int i;
8609 for (i = 0; i < expr->len; i++) {
8610 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8612 Jim_Free(expr->token);
8613 Jim_Free(expr);
8616 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8618 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8620 if (expr) {
8621 if (--expr->inUse != 0) {
8622 return;
8625 ExprFreeByteCode(interp, expr);
8629 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8631 JIM_NOTUSED(interp);
8632 JIM_NOTUSED(srcPtr);
8634 /* Just returns an simple string. */
8635 dupPtr->typePtr = NULL;
8638 /* Check if an expr program looks correct. */
8639 static int ExprCheckCorrectness(ExprByteCode * expr)
8641 int i;
8642 int stacklen = 0;
8643 int ternary = 0;
8645 /* Try to check if there are stack underflows,
8646 * and make sure at the end of the program there is
8647 * a single result on the stack. */
8648 for (i = 0; i < expr->len; i++) {
8649 ScriptToken *t = &expr->token[i];
8650 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8652 stacklen -= op->arity;
8653 if (stacklen < 0) {
8654 break;
8656 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8657 ternary++;
8659 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8660 ternary--;
8663 /* All operations and operands add one to the stack */
8664 stacklen++;
8666 if (stacklen != 1 || ternary != 0) {
8667 return JIM_ERR;
8669 return JIM_OK;
8672 /* This procedure converts every occurrence of || and && opereators
8673 * in lazy unary versions.
8675 * a b || is converted into:
8677 * a <offset> |L b |R
8679 * a b && is converted into:
8681 * a <offset> &L b &R
8683 * "|L" checks if 'a' is true:
8684 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8685 * the opcode just after |R.
8686 * 2) if it is false does nothing.
8687 * "|R" checks if 'b' is true:
8688 * 1) if it is true pushes 1, otherwise pushes 0.
8690 * "&L" checks if 'a' is true:
8691 * 1) if it is true does nothing.
8692 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8693 * the opcode just after &R
8694 * "&R" checks if 'a' is true:
8695 * if it is true pushes 1, otherwise pushes 0.
8697 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8699 int i;
8701 int leftindex, arity, offset;
8703 /* Search for the end of the first operator */
8704 leftindex = expr->len - 1;
8706 arity = 1;
8707 while (arity) {
8708 ScriptToken *tt = &expr->token[leftindex];
8710 if (tt->type >= JIM_TT_EXPR_OP) {
8711 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8713 arity--;
8714 if (--leftindex < 0) {
8715 return JIM_ERR;
8718 leftindex++;
8720 /* Move them up */
8721 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8722 sizeof(*expr->token) * (expr->len - leftindex));
8723 expr->len += 2;
8724 offset = (expr->len - leftindex) - 1;
8726 /* Now we rely on the fact that the left and right version have opcodes
8727 * 1 and 2 after the main opcode respectively
8729 expr->token[leftindex + 1].type = t->type + 1;
8730 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8732 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8733 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8735 /* Now add the 'R' operator */
8736 expr->token[expr->len].objPtr = interp->emptyObj;
8737 expr->token[expr->len].type = t->type + 2;
8738 expr->len++;
8740 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8741 for (i = leftindex - 1; i > 0; i--) {
8742 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8743 if (op->lazy == LAZY_LEFT) {
8744 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8745 JimWideValue(expr->token[i - 1].objPtr) += 2;
8749 return JIM_OK;
8752 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8754 struct ScriptToken *token = &expr->token[expr->len];
8755 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8757 if (op->lazy == LAZY_OP) {
8758 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8759 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8760 return JIM_ERR;
8763 else {
8764 token->objPtr = interp->emptyObj;
8765 token->type = t->type;
8766 expr->len++;
8768 return JIM_OK;
8772 * Returns the index of the COLON_LEFT to the left of 'right_index'
8773 * taking into account nesting.
8775 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8777 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8779 int ternary_count = 1;
8781 right_index--;
8783 while (right_index > 1) {
8784 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8785 ternary_count--;
8787 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8788 ternary_count++;
8790 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8791 return right_index;
8793 right_index--;
8796 /*notreached*/
8797 return -1;
8801 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8803 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8804 * Otherwise returns 0.
8806 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8808 int i = right_index - 1;
8809 int ternary_count = 1;
8811 while (i > 1) {
8812 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8813 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8814 *prev_right_index = i - 2;
8815 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8816 return 1;
8819 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8820 if (ternary_count == 0) {
8821 return 0;
8823 ternary_count++;
8825 i--;
8827 return 0;
8831 * ExprTernaryReorderExpression description
8832 * ========================================
8834 * ?: is right-to-left associative which doesn't work with the stack-based
8835 * expression engine. The fix is to reorder the bytecode.
8837 * The expression:
8839 * expr 1?2:0?3:4
8841 * Has initial bytecode:
8843 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8844 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8846 * The fix involves simulating this expression instead:
8848 * expr 1?2:(0?3:4)
8850 * With the following bytecode:
8852 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8853 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8855 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8856 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8857 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8858 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8860 * ExprTernaryReorderExpression works thus as follows :
8861 * - start from the end of the stack
8862 * - while walking towards the beginning of the stack
8863 * if token=JIM_EXPROP_COLON_RIGHT then
8864 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8865 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8866 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8867 * if all found then
8868 * perform the rotation
8869 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8870 * end if
8871 * end if
8873 * Note: care has to be taken for nested ternary constructs!!!
8875 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8877 int i;
8879 for (i = expr->len - 1; i > 1; i--) {
8880 int prev_right_index;
8881 int prev_left_index;
8882 int j;
8883 ScriptToken tmp;
8885 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8886 continue;
8889 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8890 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8891 continue;
8895 ** rotate tokens down
8897 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8898 ** | | |
8899 ** | V V
8900 ** | [...] : ...
8901 ** | | |
8902 ** | V V
8903 ** | [...] : ...
8904 ** | | |
8905 ** | V V
8906 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8908 tmp = expr->token[prev_right_index];
8909 for (j = prev_right_index; j < i; j++) {
8910 expr->token[j] = expr->token[j + 1];
8912 expr->token[i] = tmp;
8914 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8916 * This is 'colon left increment' = i - prev_right_index
8918 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8919 * [prev_left_index-1] : skip_count
8922 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8924 /* Adjust for i-- in the loop */
8925 i++;
8929 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8931 Jim_Stack stack;
8932 ExprByteCode *expr;
8933 int ok = 1;
8934 int i;
8935 int prevtt = JIM_TT_NONE;
8936 int have_ternary = 0;
8938 /* -1 for EOL */
8939 int count = tokenlist->count - 1;
8941 expr = Jim_Alloc(sizeof(*expr));
8942 expr->inUse = 1;
8943 expr->len = 0;
8945 Jim_InitStack(&stack);
8947 /* Need extra bytecodes for lazy operators.
8948 * Also check for the ternary operator
8950 for (i = 0; i < tokenlist->count; i++) {
8951 ParseToken *t = &tokenlist->list[i];
8952 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8954 if (op->lazy == LAZY_OP) {
8955 count += 2;
8956 /* Ternary is a lazy op but also needs reordering */
8957 if (t->type == JIM_EXPROP_TERNARY) {
8958 have_ternary = 1;
8963 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8965 for (i = 0; i < tokenlist->count && ok; i++) {
8966 ParseToken *t = &tokenlist->list[i];
8968 /* Next token will be stored here */
8969 struct ScriptToken *token = &expr->token[expr->len];
8971 if (t->type == JIM_TT_EOL) {
8972 break;
8975 switch (t->type) {
8976 case JIM_TT_STR:
8977 case JIM_TT_ESC:
8978 case JIM_TT_VAR:
8979 case JIM_TT_DICTSUGAR:
8980 case JIM_TT_EXPRSUGAR:
8981 case JIM_TT_CMD:
8982 token->type = t->type;
8983 strexpr:
8984 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8985 if (t->type == JIM_TT_CMD) {
8986 /* Only commands need source info */
8987 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8989 expr->len++;
8990 break;
8992 case JIM_TT_EXPR_INT:
8993 case JIM_TT_EXPR_DOUBLE:
8995 char *endptr;
8996 if (t->type == JIM_TT_EXPR_INT) {
8997 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8999 else {
9000 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9002 if (endptr != t->token + t->len) {
9003 /* Conversion failed, so just store it as a string */
9004 Jim_FreeNewObj(interp, token->objPtr);
9005 token->type = JIM_TT_STR;
9006 goto strexpr;
9008 token->type = t->type;
9009 expr->len++;
9011 break;
9013 case JIM_TT_SUBEXPR_START:
9014 Jim_StackPush(&stack, t);
9015 prevtt = JIM_TT_NONE;
9016 continue;
9018 case JIM_TT_SUBEXPR_COMMA:
9019 /* Simple approach. Comma is simply ignored */
9020 continue;
9022 case JIM_TT_SUBEXPR_END:
9023 ok = 0;
9024 while (Jim_StackLen(&stack)) {
9025 ParseToken *tt = Jim_StackPop(&stack);
9027 if (tt->type == JIM_TT_SUBEXPR_START) {
9028 ok = 1;
9029 break;
9032 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9033 goto err;
9036 if (!ok) {
9037 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9038 goto err;
9040 break;
9043 default:{
9044 /* Must be an operator */
9045 const struct Jim_ExprOperator *op;
9046 ParseToken *tt;
9048 /* Convert -/+ to unary minus or unary plus if necessary */
9049 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9050 if (t->type == JIM_EXPROP_SUB) {
9051 t->type = JIM_EXPROP_UNARYMINUS;
9053 else if (t->type == JIM_EXPROP_ADD) {
9054 t->type = JIM_EXPROP_UNARYPLUS;
9058 op = JimExprOperatorInfoByOpcode(t->type);
9060 /* Now handle precedence */
9061 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9062 const struct Jim_ExprOperator *tt_op =
9063 JimExprOperatorInfoByOpcode(tt->type);
9065 /* Note that right-to-left associativity of ?: operator is handled later */
9067 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9068 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9069 ok = 0;
9070 goto err;
9072 Jim_StackPop(&stack);
9074 else {
9075 break;
9078 Jim_StackPush(&stack, t);
9079 break;
9082 prevtt = t->type;
9085 /* Reduce any remaining subexpr */
9086 while (Jim_StackLen(&stack)) {
9087 ParseToken *tt = Jim_StackPop(&stack);
9089 if (tt->type == JIM_TT_SUBEXPR_START) {
9090 ok = 0;
9091 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9092 goto err;
9094 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9095 ok = 0;
9096 goto err;
9100 if (have_ternary) {
9101 ExprTernaryReorderExpression(interp, expr);
9104 err:
9105 /* Free the stack used for the compilation. */
9106 Jim_FreeStack(&stack);
9108 for (i = 0; i < expr->len; i++) {
9109 Jim_IncrRefCount(expr->token[i].objPtr);
9112 if (!ok) {
9113 ExprFreeByteCode(interp, expr);
9114 return NULL;
9117 return expr;
9121 /* This method takes the string representation of an expression
9122 * and generates a program for the Expr's stack-based VM. */
9123 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9125 int exprTextLen;
9126 const char *exprText;
9127 struct JimParserCtx parser;
9128 struct ExprByteCode *expr;
9129 ParseTokenList tokenlist;
9130 int line;
9131 Jim_Obj *fileNameObj;
9132 int rc = JIM_ERR;
9134 /* Try to get information about filename / line number */
9135 if (objPtr->typePtr == &sourceObjType) {
9136 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9137 line = objPtr->internalRep.sourceValue.lineNumber;
9139 else {
9140 fileNameObj = interp->emptyObj;
9141 line = 1;
9143 Jim_IncrRefCount(fileNameObj);
9145 exprText = Jim_GetString(objPtr, &exprTextLen);
9147 /* Initially tokenise the expression into tokenlist */
9148 ScriptTokenListInit(&tokenlist);
9150 JimParserInit(&parser, exprText, exprTextLen, line);
9151 while (!parser.eof) {
9152 if (JimParseExpression(&parser) != JIM_OK) {
9153 ScriptTokenListFree(&tokenlist);
9154 invalidexpr:
9155 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9156 expr = NULL;
9157 goto err;
9160 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9161 parser.tline);
9164 #ifdef DEBUG_SHOW_EXPR_TOKENS
9166 int i;
9167 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9168 for (i = 0; i < tokenlist.count; i++) {
9169 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9170 tokenlist.list[i].len, tokenlist.list[i].token);
9173 #endif
9175 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9176 ScriptTokenListFree(&tokenlist);
9177 Jim_DecrRefCount(interp, fileNameObj);
9178 return JIM_ERR;
9181 /* Now create the expression bytecode from the tokenlist */
9182 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9184 /* No longer need the token list */
9185 ScriptTokenListFree(&tokenlist);
9187 if (!expr) {
9188 goto err;
9191 #ifdef DEBUG_SHOW_EXPR
9193 int i;
9195 printf("==== Expr ====\n");
9196 for (i = 0; i < expr->len; i++) {
9197 ScriptToken *t = &expr->token[i];
9199 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9202 #endif
9204 /* Check program correctness. */
9205 if (ExprCheckCorrectness(expr) != JIM_OK) {
9206 ExprFreeByteCode(interp, expr);
9207 goto invalidexpr;
9210 rc = JIM_OK;
9212 err:
9213 /* Free the old internal rep and set the new one. */
9214 Jim_DecrRefCount(interp, fileNameObj);
9215 Jim_FreeIntRep(interp, objPtr);
9216 Jim_SetIntRepPtr(objPtr, expr);
9217 objPtr->typePtr = &exprObjType;
9218 return rc;
9221 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9223 if (objPtr->typePtr != &exprObjType) {
9224 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9225 return NULL;
9228 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9231 #ifdef JIM_OPTIMIZATION
9232 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9234 if (token->type == JIM_TT_EXPR_INT)
9235 return token->objPtr;
9236 else if (token->type == JIM_TT_VAR)
9237 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9238 else if (token->type == JIM_TT_DICTSUGAR)
9239 return JimExpandDictSugar(interp, token->objPtr);
9240 else
9241 return NULL;
9243 #endif
9245 /* -----------------------------------------------------------------------------
9246 * Expressions evaluation.
9247 * Jim uses a specialized stack-based virtual machine for expressions,
9248 * that takes advantage of the fact that expr's operators
9249 * can't be redefined.
9251 * Jim_EvalExpression() uses the bytecode compiled by
9252 * SetExprFromAny() method of the "expression" object.
9254 * On success a Tcl Object containing the result of the evaluation
9255 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9256 * returned.
9257 * On error the function returns a retcode != to JIM_OK and set a suitable
9258 * error on the interp.
9259 * ---------------------------------------------------------------------------*/
9260 #define JIM_EE_STATICSTACK_LEN 10
9262 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9264 ExprByteCode *expr;
9265 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9266 int i;
9267 int retcode = JIM_OK;
9268 struct JimExprState e;
9270 expr = JimGetExpression(interp, exprObjPtr);
9271 if (!expr) {
9272 return JIM_ERR; /* error in expression. */
9275 #ifdef JIM_OPTIMIZATION
9276 /* Check for one of the following common expressions used by while/for
9278 * CONST
9279 * $a
9280 * !$a
9281 * $a < CONST, $a < $b
9282 * $a <= CONST, $a <= $b
9283 * $a > CONST, $a > $b
9284 * $a >= CONST, $a >= $b
9285 * $a != CONST, $a != $b
9286 * $a == CONST, $a == $b
9289 Jim_Obj *objPtr;
9291 /* STEP 1 -- Check if there are the conditions to run the specialized
9292 * version of while */
9294 switch (expr->len) {
9295 case 1:
9296 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9297 if (objPtr) {
9298 Jim_IncrRefCount(objPtr);
9299 *exprResultPtrPtr = objPtr;
9300 return JIM_OK;
9302 break;
9304 case 2:
9305 if (expr->token[1].type == JIM_EXPROP_NOT) {
9306 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9308 if (objPtr && JimIsWide(objPtr)) {
9309 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9310 Jim_IncrRefCount(*exprResultPtrPtr);
9311 return JIM_OK;
9314 break;
9316 case 3:
9317 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9318 if (objPtr && JimIsWide(objPtr)) {
9319 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9320 if (objPtr2 && JimIsWide(objPtr2)) {
9321 jim_wide wideValueA = JimWideValue(objPtr);
9322 jim_wide wideValueB = JimWideValue(objPtr2);
9323 int cmpRes;
9324 switch (expr->token[2].type) {
9325 case JIM_EXPROP_LT:
9326 cmpRes = wideValueA < wideValueB;
9327 break;
9328 case JIM_EXPROP_LTE:
9329 cmpRes = wideValueA <= wideValueB;
9330 break;
9331 case JIM_EXPROP_GT:
9332 cmpRes = wideValueA > wideValueB;
9333 break;
9334 case JIM_EXPROP_GTE:
9335 cmpRes = wideValueA >= wideValueB;
9336 break;
9337 case JIM_EXPROP_NUMEQ:
9338 cmpRes = wideValueA == wideValueB;
9339 break;
9340 case JIM_EXPROP_NUMNE:
9341 cmpRes = wideValueA != wideValueB;
9342 break;
9343 default:
9344 goto noopt;
9346 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9347 Jim_IncrRefCount(*exprResultPtrPtr);
9348 return JIM_OK;
9351 break;
9354 noopt:
9355 #endif
9357 /* In order to avoid that the internal repr gets freed due to
9358 * shimmering of the exprObjPtr's object, we make the internal rep
9359 * shared. */
9360 expr->inUse++;
9362 /* The stack-based expr VM itself */
9364 /* Stack allocation. Expr programs have the feature that
9365 * a program of length N can't require a stack longer than
9366 * N. */
9367 if (expr->len > JIM_EE_STATICSTACK_LEN)
9368 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9369 else
9370 e.stack = staticStack;
9372 e.stacklen = 0;
9374 /* Execute every instruction */
9375 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9376 Jim_Obj *objPtr;
9378 switch (expr->token[i].type) {
9379 case JIM_TT_EXPR_INT:
9380 case JIM_TT_EXPR_DOUBLE:
9381 case JIM_TT_STR:
9382 ExprPush(&e, expr->token[i].objPtr);
9383 break;
9385 case JIM_TT_VAR:
9386 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9387 if (objPtr) {
9388 ExprPush(&e, objPtr);
9390 else {
9391 retcode = JIM_ERR;
9393 break;
9395 case JIM_TT_DICTSUGAR:
9396 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9397 if (objPtr) {
9398 ExprPush(&e, objPtr);
9400 else {
9401 retcode = JIM_ERR;
9403 break;
9405 case JIM_TT_ESC:
9406 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9407 if (retcode == JIM_OK) {
9408 ExprPush(&e, objPtr);
9410 break;
9412 case JIM_TT_CMD:
9413 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9414 if (retcode == JIM_OK) {
9415 ExprPush(&e, Jim_GetResult(interp));
9417 break;
9419 default:{
9420 /* Find and execute the operation */
9421 e.skip = 0;
9422 e.opcode = expr->token[i].type;
9424 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9425 /* Skip some opcodes if necessary */
9426 i += e.skip;
9427 continue;
9432 expr->inUse--;
9434 if (retcode == JIM_OK) {
9435 *exprResultPtrPtr = ExprPop(&e);
9437 else {
9438 for (i = 0; i < e.stacklen; i++) {
9439 Jim_DecrRefCount(interp, e.stack[i]);
9442 if (e.stack != staticStack) {
9443 Jim_Free(e.stack);
9445 return retcode;
9448 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9450 int retcode;
9451 jim_wide wideValue;
9452 double doubleValue;
9453 Jim_Obj *exprResultPtr;
9455 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9456 if (retcode != JIM_OK)
9457 return retcode;
9459 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9460 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9461 Jim_DecrRefCount(interp, exprResultPtr);
9462 return JIM_ERR;
9464 else {
9465 Jim_DecrRefCount(interp, exprResultPtr);
9466 *boolPtr = doubleValue != 0;
9467 return JIM_OK;
9470 *boolPtr = wideValue != 0;
9472 Jim_DecrRefCount(interp, exprResultPtr);
9473 return JIM_OK;
9476 /* -----------------------------------------------------------------------------
9477 * ScanFormat String Object
9478 * ---------------------------------------------------------------------------*/
9480 /* This Jim_Obj will held a parsed representation of a format string passed to
9481 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9482 * to be parsed in its entirely first and then, if correct, can be used for
9483 * scanning. To avoid endless re-parsing, the parsed representation will be
9484 * stored in an internal representation and re-used for performance reason. */
9486 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9487 * scanformat string. This part will later be used to extract information
9488 * out from the string to be parsed by Jim_ScanString */
9490 typedef struct ScanFmtPartDescr
9492 char *arg; /* Specification of a CHARSET conversion */
9493 char *prefix; /* Prefix to be scanned literally before conversion */
9494 size_t width; /* Maximal width of input to be converted */
9495 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9496 char type; /* Type of conversion (e.g. c, d, f) */
9497 char modifier; /* Modify type (e.g. l - long, h - short */
9498 } ScanFmtPartDescr;
9500 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9501 * string parsed and separated in part descriptions. Furthermore it contains
9502 * the original string representation of the scanformat string to allow for
9503 * fast update of the Jim_Obj's string representation part.
9505 * As an add-on the internal object representation adds some scratch pad area
9506 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9507 * memory for purpose of string scanning.
9509 * The error member points to a static allocated string in case of a mal-
9510 * formed scanformat string or it contains '0' (NULL) in case of a valid
9511 * parse representation.
9513 * The whole memory of the internal representation is allocated as a single
9514 * area of memory that will be internally separated. So freeing and duplicating
9515 * of such an object is cheap */
9517 typedef struct ScanFmtStringObj
9519 jim_wide size; /* Size of internal repr in bytes */
9520 char *stringRep; /* Original string representation */
9521 size_t count; /* Number of ScanFmtPartDescr contained */
9522 size_t convCount; /* Number of conversions that will assign */
9523 size_t maxPos; /* Max position index if XPG3 is used */
9524 const char *error; /* Ptr to error text (NULL if no error */
9525 char *scratch; /* Some scratch pad used by Jim_ScanString */
9526 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9527 } ScanFmtStringObj;
9530 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9531 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9532 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9534 static const Jim_ObjType scanFmtStringObjType = {
9535 "scanformatstring",
9536 FreeScanFmtInternalRep,
9537 DupScanFmtInternalRep,
9538 UpdateStringOfScanFmt,
9539 JIM_TYPE_NONE,
9542 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9544 JIM_NOTUSED(interp);
9545 Jim_Free((char *)objPtr->internalRep.ptr);
9546 objPtr->internalRep.ptr = 0;
9549 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9551 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9552 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9554 JIM_NOTUSED(interp);
9555 memcpy(newVec, srcPtr->internalRep.ptr, size);
9556 dupPtr->internalRep.ptr = newVec;
9557 dupPtr->typePtr = &scanFmtStringObjType;
9560 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9562 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9565 /* SetScanFmtFromAny will parse a given string and create the internal
9566 * representation of the format specification. In case of an error
9567 * the error data member of the internal representation will be set
9568 * to an descriptive error text and the function will be left with
9569 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9570 * specification */
9572 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9574 ScanFmtStringObj *fmtObj;
9575 char *buffer;
9576 int maxCount, i, approxSize, lastPos = -1;
9577 const char *fmt = objPtr->bytes;
9578 int maxFmtLen = objPtr->length;
9579 const char *fmtEnd = fmt + maxFmtLen;
9580 int curr;
9582 Jim_FreeIntRep(interp, objPtr);
9583 /* Count how many conversions could take place maximally */
9584 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9585 if (fmt[i] == '%')
9586 ++maxCount;
9587 /* Calculate an approximation of the memory necessary */
9588 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9589 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9590 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9591 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9592 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9593 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9594 +1; /* safety byte */
9595 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9596 memset(fmtObj, 0, approxSize);
9597 fmtObj->size = approxSize;
9598 fmtObj->maxPos = 0;
9599 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9600 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9601 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9602 buffer = fmtObj->stringRep + maxFmtLen + 1;
9603 objPtr->internalRep.ptr = fmtObj;
9604 objPtr->typePtr = &scanFmtStringObjType;
9605 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9606 int width = 0, skip;
9607 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9609 fmtObj->count++;
9610 descr->width = 0; /* Assume width unspecified */
9611 /* Overread and store any "literal" prefix */
9612 if (*fmt != '%' || fmt[1] == '%') {
9613 descr->type = 0;
9614 descr->prefix = &buffer[i];
9615 for (; fmt < fmtEnd; ++fmt) {
9616 if (*fmt == '%') {
9617 if (fmt[1] != '%')
9618 break;
9619 ++fmt;
9621 buffer[i++] = *fmt;
9623 buffer[i++] = 0;
9625 /* Skip the conversion introducing '%' sign */
9626 ++fmt;
9627 /* End reached due to non-conversion literal only? */
9628 if (fmt >= fmtEnd)
9629 goto done;
9630 descr->pos = 0; /* Assume "natural" positioning */
9631 if (*fmt == '*') {
9632 descr->pos = -1; /* Okay, conversion will not be assigned */
9633 ++fmt;
9635 else
9636 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9637 /* Check if next token is a number (could be width or pos */
9638 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9639 fmt += skip;
9640 /* Was the number a XPG3 position specifier? */
9641 if (descr->pos != -1 && *fmt == '$') {
9642 int prev;
9644 ++fmt;
9645 descr->pos = width;
9646 width = 0;
9647 /* Look if "natural" postioning and XPG3 one was mixed */
9648 if ((lastPos == 0 && descr->pos > 0)
9649 || (lastPos > 0 && descr->pos == 0)) {
9650 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9651 return JIM_ERR;
9653 /* Look if this position was already used */
9654 for (prev = 0; prev < curr; ++prev) {
9655 if (fmtObj->descr[prev].pos == -1)
9656 continue;
9657 if (fmtObj->descr[prev].pos == descr->pos) {
9658 fmtObj->error =
9659 "variable is assigned by multiple \"%n$\" conversion specifiers";
9660 return JIM_ERR;
9663 /* Try to find a width after the XPG3 specifier */
9664 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9665 descr->width = width;
9666 fmt += skip;
9668 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9669 fmtObj->maxPos = descr->pos;
9671 else {
9672 /* Number was not a XPG3, so it has to be a width */
9673 descr->width = width;
9676 /* If positioning mode was undetermined yet, fix this */
9677 if (lastPos == -1)
9678 lastPos = descr->pos;
9679 /* Handle CHARSET conversion type ... */
9680 if (*fmt == '[') {
9681 int swapped = 1, beg = i, end, j;
9683 descr->type = '[';
9684 descr->arg = &buffer[i];
9685 ++fmt;
9686 if (*fmt == '^')
9687 buffer[i++] = *fmt++;
9688 if (*fmt == ']')
9689 buffer[i++] = *fmt++;
9690 while (*fmt && *fmt != ']')
9691 buffer[i++] = *fmt++;
9692 if (*fmt != ']') {
9693 fmtObj->error = "unmatched [ in format string";
9694 return JIM_ERR;
9696 end = i;
9697 buffer[i++] = 0;
9698 /* In case a range fence was given "backwards", swap it */
9699 while (swapped) {
9700 swapped = 0;
9701 for (j = beg + 1; j < end - 1; ++j) {
9702 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9703 char tmp = buffer[j - 1];
9705 buffer[j - 1] = buffer[j + 1];
9706 buffer[j + 1] = tmp;
9707 swapped = 1;
9712 else {
9713 /* Remember any valid modifier if given */
9714 if (strchr("hlL", *fmt) != 0)
9715 descr->modifier = tolower((int)*fmt++);
9717 descr->type = *fmt;
9718 if (strchr("efgcsndoxui", *fmt) == 0) {
9719 fmtObj->error = "bad scan conversion character";
9720 return JIM_ERR;
9722 else if (*fmt == 'c' && descr->width != 0) {
9723 fmtObj->error = "field width may not be specified in %c " "conversion";
9724 return JIM_ERR;
9726 else if (*fmt == 'u' && descr->modifier == 'l') {
9727 fmtObj->error = "unsigned wide not supported";
9728 return JIM_ERR;
9731 curr++;
9733 done:
9734 return JIM_OK;
9737 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9739 #define FormatGetCnvCount(_fo_) \
9740 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9741 #define FormatGetMaxPos(_fo_) \
9742 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9743 #define FormatGetError(_fo_) \
9744 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9746 /* JimScanAString is used to scan an unspecified string that ends with
9747 * next WS, or a string that is specified via a charset.
9750 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9752 char *buffer = Jim_StrDup(str);
9753 char *p = buffer;
9755 while (*str) {
9756 int c;
9757 int n;
9759 if (!sdescr && isspace(UCHAR(*str)))
9760 break; /* EOS via WS if unspecified */
9762 n = utf8_tounicode(str, &c);
9763 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9764 break;
9765 while (n--)
9766 *p++ = *str++;
9768 *p = 0;
9769 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9772 /* ScanOneEntry will scan one entry out of the string passed as argument.
9773 * It use the sscanf() function for this task. After extracting and
9774 * converting of the value, the count of scanned characters will be
9775 * returned of -1 in case of no conversion tool place and string was
9776 * already scanned thru */
9778 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9779 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9781 const char *tok;
9782 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9783 size_t scanned = 0;
9784 size_t anchor = pos;
9785 int i;
9786 Jim_Obj *tmpObj = NULL;
9788 /* First pessimistically assume, we will not scan anything :-) */
9789 *valObjPtr = 0;
9790 if (descr->prefix) {
9791 /* There was a prefix given before the conversion, skip it and adjust
9792 * the string-to-be-parsed accordingly */
9793 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9794 /* If prefix require, skip WS */
9795 if (isspace(UCHAR(descr->prefix[i])))
9796 while (pos < strLen && isspace(UCHAR(str[pos])))
9797 ++pos;
9798 else if (descr->prefix[i] != str[pos])
9799 break; /* Prefix do not match here, leave the loop */
9800 else
9801 ++pos; /* Prefix matched so far, next round */
9803 if (pos >= strLen) {
9804 return -1; /* All of str consumed: EOF condition */
9806 else if (descr->prefix[i] != 0)
9807 return 0; /* Not whole prefix consumed, no conversion possible */
9809 /* For all but following conversion, skip leading WS */
9810 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9811 while (isspace(UCHAR(str[pos])))
9812 ++pos;
9813 /* Determine how much skipped/scanned so far */
9814 scanned = pos - anchor;
9816 /* %c is a special, simple case. no width */
9817 if (descr->type == 'n') {
9818 /* Return pseudo conversion means: how much scanned so far? */
9819 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9821 else if (pos >= strLen) {
9822 /* Cannot scan anything, as str is totally consumed */
9823 return -1;
9825 else if (descr->type == 'c') {
9826 int c;
9827 scanned += utf8_tounicode(&str[pos], &c);
9828 *valObjPtr = Jim_NewIntObj(interp, c);
9829 return scanned;
9831 else {
9832 /* Processing of conversions follows ... */
9833 if (descr->width > 0) {
9834 /* Do not try to scan as fas as possible but only the given width.
9835 * To ensure this, we copy the part that should be scanned. */
9836 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9837 size_t tLen = descr->width > sLen ? sLen : descr->width;
9839 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9840 tok = tmpObj->bytes;
9842 else {
9843 /* As no width was given, simply refer to the original string */
9844 tok = &str[pos];
9846 switch (descr->type) {
9847 case 'd':
9848 case 'o':
9849 case 'x':
9850 case 'u':
9851 case 'i':{
9852 char *endp; /* Position where the number finished */
9853 jim_wide w;
9855 int base = descr->type == 'o' ? 8
9856 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9858 /* Try to scan a number with the given base */
9859 if (base == 0) {
9860 w = jim_strtoull(tok, &endp);
9862 else {
9863 w = strtoull(tok, &endp, base);
9866 if (endp != tok) {
9867 /* There was some number sucessfully scanned! */
9868 *valObjPtr = Jim_NewIntObj(interp, w);
9870 /* Adjust the number-of-chars scanned so far */
9871 scanned += endp - tok;
9873 else {
9874 /* Nothing was scanned. We have to determine if this
9875 * happened due to e.g. prefix mismatch or input str
9876 * exhausted */
9877 scanned = *tok ? 0 : -1;
9879 break;
9881 case 's':
9882 case '[':{
9883 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9884 scanned += Jim_Length(*valObjPtr);
9885 break;
9887 case 'e':
9888 case 'f':
9889 case 'g':{
9890 char *endp;
9891 double value = strtod(tok, &endp);
9893 if (endp != tok) {
9894 /* There was some number sucessfully scanned! */
9895 *valObjPtr = Jim_NewDoubleObj(interp, value);
9896 /* Adjust the number-of-chars scanned so far */
9897 scanned += endp - tok;
9899 else {
9900 /* Nothing was scanned. We have to determine if this
9901 * happened due to e.g. prefix mismatch or input str
9902 * exhausted */
9903 scanned = *tok ? 0 : -1;
9905 break;
9908 /* If a substring was allocated (due to pre-defined width) do not
9909 * forget to free it */
9910 if (tmpObj) {
9911 Jim_FreeNewObj(interp, tmpObj);
9914 return scanned;
9917 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9918 * string and returns all converted (and not ignored) values in a list back
9919 * to the caller. If an error occured, a NULL pointer will be returned */
9921 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9923 size_t i, pos;
9924 int scanned = 1;
9925 const char *str = Jim_String(strObjPtr);
9926 int strLen = Jim_Utf8Length(interp, strObjPtr);
9927 Jim_Obj *resultList = 0;
9928 Jim_Obj **resultVec = 0;
9929 int resultc;
9930 Jim_Obj *emptyStr = 0;
9931 ScanFmtStringObj *fmtObj;
9933 /* This should never happen. The format object should already be of the correct type */
9934 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9936 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9937 /* Check if format specification was valid */
9938 if (fmtObj->error != 0) {
9939 if (flags & JIM_ERRMSG)
9940 Jim_SetResultString(interp, fmtObj->error, -1);
9941 return 0;
9943 /* Allocate a new "shared" empty string for all unassigned conversions */
9944 emptyStr = Jim_NewEmptyStringObj(interp);
9945 Jim_IncrRefCount(emptyStr);
9946 /* Create a list and fill it with empty strings up to max specified XPG3 */
9947 resultList = Jim_NewListObj(interp, NULL, 0);
9948 if (fmtObj->maxPos > 0) {
9949 for (i = 0; i < fmtObj->maxPos; ++i)
9950 Jim_ListAppendElement(interp, resultList, emptyStr);
9951 JimListGetElements(interp, resultList, &resultc, &resultVec);
9953 /* Now handle every partial format description */
9954 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9955 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9956 Jim_Obj *value = 0;
9958 /* Only last type may be "literal" w/o conversion - skip it! */
9959 if (descr->type == 0)
9960 continue;
9961 /* As long as any conversion could be done, we will proceed */
9962 if (scanned > 0)
9963 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9964 /* In case our first try results in EOF, we will leave */
9965 if (scanned == -1 && i == 0)
9966 goto eof;
9967 /* Advance next pos-to-be-scanned for the amount scanned already */
9968 pos += scanned;
9970 /* value == 0 means no conversion took place so take empty string */
9971 if (value == 0)
9972 value = Jim_NewEmptyStringObj(interp);
9973 /* If value is a non-assignable one, skip it */
9974 if (descr->pos == -1) {
9975 Jim_FreeNewObj(interp, value);
9977 else if (descr->pos == 0)
9978 /* Otherwise append it to the result list if no XPG3 was given */
9979 Jim_ListAppendElement(interp, resultList, value);
9980 else if (resultVec[descr->pos - 1] == emptyStr) {
9981 /* But due to given XPG3, put the value into the corr. slot */
9982 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9983 Jim_IncrRefCount(value);
9984 resultVec[descr->pos - 1] = value;
9986 else {
9987 /* Otherwise, the slot was already used - free obj and ERROR */
9988 Jim_FreeNewObj(interp, value);
9989 goto err;
9992 Jim_DecrRefCount(interp, emptyStr);
9993 return resultList;
9994 eof:
9995 Jim_DecrRefCount(interp, emptyStr);
9996 Jim_FreeNewObj(interp, resultList);
9997 return (Jim_Obj *)EOF;
9998 err:
9999 Jim_DecrRefCount(interp, emptyStr);
10000 Jim_FreeNewObj(interp, resultList);
10001 return 0;
10004 /* -----------------------------------------------------------------------------
10005 * Pseudo Random Number Generation
10006 * ---------------------------------------------------------------------------*/
10007 /* Initialize the sbox with the numbers from 0 to 255 */
10008 static void JimPrngInit(Jim_Interp *interp)
10010 #define PRNG_SEED_SIZE 256
10011 int i;
10012 unsigned int *seed;
10013 time_t t = time(NULL);
10015 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10017 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10018 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10019 seed[i] = (rand() ^ t ^ clock());
10021 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10022 Jim_Free(seed);
10025 /* Generates N bytes of random data */
10026 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10028 Jim_PrngState *prng;
10029 unsigned char *destByte = (unsigned char *)dest;
10030 unsigned int si, sj, x;
10032 /* initialization, only needed the first time */
10033 if (interp->prngState == NULL)
10034 JimPrngInit(interp);
10035 prng = interp->prngState;
10036 /* generates 'len' bytes of pseudo-random numbers */
10037 for (x = 0; x < len; x++) {
10038 prng->i = (prng->i + 1) & 0xff;
10039 si = prng->sbox[prng->i];
10040 prng->j = (prng->j + si) & 0xff;
10041 sj = prng->sbox[prng->j];
10042 prng->sbox[prng->i] = sj;
10043 prng->sbox[prng->j] = si;
10044 *destByte++ = prng->sbox[(si + sj) & 0xff];
10048 /* Re-seed the generator with user-provided bytes */
10049 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10051 int i;
10052 Jim_PrngState *prng;
10054 /* initialization, only needed the first time */
10055 if (interp->prngState == NULL)
10056 JimPrngInit(interp);
10057 prng = interp->prngState;
10059 /* Set the sbox[i] with i */
10060 for (i = 0; i < 256; i++)
10061 prng->sbox[i] = i;
10062 /* Now use the seed to perform a random permutation of the sbox */
10063 for (i = 0; i < seedLen; i++) {
10064 unsigned char t;
10066 t = prng->sbox[i & 0xFF];
10067 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10068 prng->sbox[seed[i]] = t;
10070 prng->i = prng->j = 0;
10072 /* discard at least the first 256 bytes of stream.
10073 * borrow the seed buffer for this
10075 for (i = 0; i < 256; i += seedLen) {
10076 JimRandomBytes(interp, seed, seedLen);
10080 /* [incr] */
10081 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10083 jim_wide wideValue, increment = 1;
10084 Jim_Obj *intObjPtr;
10086 if (argc != 2 && argc != 3) {
10087 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10088 return JIM_ERR;
10090 if (argc == 3) {
10091 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10092 return JIM_ERR;
10094 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10095 if (!intObjPtr) {
10096 /* Set missing variable to 0 */
10097 wideValue = 0;
10099 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10100 return JIM_ERR;
10102 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10103 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10104 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10105 Jim_FreeNewObj(interp, intObjPtr);
10106 return JIM_ERR;
10109 else {
10110 /* Can do it the quick way */
10111 Jim_InvalidateStringRep(intObjPtr);
10112 JimWideValue(intObjPtr) = wideValue + increment;
10114 /* The following step is required in order to invalidate the
10115 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10116 if (argv[1]->typePtr != &variableObjType) {
10117 /* Note that this can't fail since GetVariable already succeeded */
10118 Jim_SetVariable(interp, argv[1], intObjPtr);
10121 Jim_SetResult(interp, intObjPtr);
10122 return JIM_OK;
10126 /* -----------------------------------------------------------------------------
10127 * Eval
10128 * ---------------------------------------------------------------------------*/
10129 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10130 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10132 /* Handle calls to the [unknown] command */
10133 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10135 int retcode;
10137 /* If JimUnknown() is recursively called too many times...
10138 * done here
10140 if (interp->unknown_called > 50) {
10141 return JIM_ERR;
10144 /* The object interp->unknown just contains
10145 * the "unknown" string, it is used in order to
10146 * avoid to lookup the unknown command every time
10147 * but instead to cache the result. */
10149 /* If the [unknown] command does not exist ... */
10150 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10151 return JIM_ERR;
10153 interp->unknown_called++;
10154 /* XXX: Are we losing fileNameObj and linenr? */
10155 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10156 interp->unknown_called--;
10158 return retcode;
10161 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10163 int retcode;
10164 Jim_Cmd *cmdPtr;
10166 #if 0
10167 printf("invoke");
10168 int j;
10169 for (j = 0; j < objc; j++) {
10170 printf(" '%s'", Jim_String(objv[j]));
10172 printf("\n");
10173 #endif
10175 if (interp->framePtr->tailcallCmd) {
10176 /* Special tailcall command was pre-resolved */
10177 cmdPtr = interp->framePtr->tailcallCmd;
10178 interp->framePtr->tailcallCmd = NULL;
10180 else {
10181 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10182 if (cmdPtr == NULL) {
10183 return JimUnknown(interp, objc, objv);
10185 JimIncrCmdRefCount(cmdPtr);
10188 if (interp->evalDepth == interp->maxEvalDepth) {
10189 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10190 retcode = JIM_ERR;
10191 goto out;
10193 interp->evalDepth++;
10195 /* Call it -- Make sure result is an empty object. */
10196 Jim_SetEmptyResult(interp);
10197 if (cmdPtr->isproc) {
10198 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10200 else {
10201 interp->cmdPrivData = cmdPtr->u.native.privData;
10202 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10204 interp->evalDepth--;
10206 out:
10207 JimDecrCmdRefCount(interp, cmdPtr);
10209 return retcode;
10212 /* Eval the object vector 'objv' composed of 'objc' elements.
10213 * Every element is used as single argument.
10214 * Jim_EvalObj() will call this function every time its object
10215 * argument is of "list" type, with no string representation.
10217 * This is possible because the string representation of a
10218 * list object generated by the UpdateStringOfList is made
10219 * in a way that ensures that every list element is a different
10220 * command argument. */
10221 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10223 int i, retcode;
10225 /* Incr refcount of arguments. */
10226 for (i = 0; i < objc; i++)
10227 Jim_IncrRefCount(objv[i]);
10229 retcode = JimInvokeCommand(interp, objc, objv);
10231 /* Decr refcount of arguments and return the retcode */
10232 for (i = 0; i < objc; i++)
10233 Jim_DecrRefCount(interp, objv[i]);
10235 return retcode;
10239 * Invokes 'prefix' as a command with the objv array as arguments.
10241 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10243 int ret;
10244 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10246 nargv[0] = prefix;
10247 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10248 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10249 Jim_Free(nargv);
10250 return ret;
10253 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10255 if (!interp->errorFlag) {
10256 /* This is the first error, so save the file/line information and reset the stack */
10257 interp->errorFlag = 1;
10258 Jim_IncrRefCount(script->fileNameObj);
10259 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10260 interp->errorFileNameObj = script->fileNameObj;
10261 interp->errorLine = script->linenr;
10263 JimResetStackTrace(interp);
10264 /* Always add a level where the error first occurs */
10265 interp->addStackTrace++;
10268 /* Now if this is an "interesting" level, add it to the stack trace */
10269 if (interp->addStackTrace > 0) {
10270 /* Add the stack info for the current level */
10272 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10274 /* Note: if we didn't have a filename for this level,
10275 * don't clear the addStackTrace flag
10276 * so we can pick it up at the next level
10278 if (Jim_Length(script->fileNameObj)) {
10279 interp->addStackTrace = 0;
10282 Jim_DecrRefCount(interp, interp->errorProc);
10283 interp->errorProc = interp->emptyObj;
10284 Jim_IncrRefCount(interp->errorProc);
10288 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10290 Jim_Obj *objPtr;
10292 switch (token->type) {
10293 case JIM_TT_STR:
10294 case JIM_TT_ESC:
10295 objPtr = token->objPtr;
10296 break;
10297 case JIM_TT_VAR:
10298 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10299 break;
10300 case JIM_TT_DICTSUGAR:
10301 objPtr = JimExpandDictSugar(interp, token->objPtr);
10302 break;
10303 case JIM_TT_EXPRSUGAR:
10304 objPtr = JimExpandExprSugar(interp, token->objPtr);
10305 break;
10306 case JIM_TT_CMD:
10307 switch (Jim_EvalObj(interp, token->objPtr)) {
10308 case JIM_OK:
10309 case JIM_RETURN:
10310 objPtr = interp->result;
10311 break;
10312 case JIM_BREAK:
10313 /* Stop substituting */
10314 return JIM_BREAK;
10315 case JIM_CONTINUE:
10316 /* just skip this one */
10317 return JIM_CONTINUE;
10318 default:
10319 return JIM_ERR;
10321 break;
10322 default:
10323 JimPanic((1,
10324 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10325 objPtr = NULL;
10326 break;
10328 if (objPtr) {
10329 *objPtrPtr = objPtr;
10330 return JIM_OK;
10332 return JIM_ERR;
10335 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10336 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10337 * The returned object has refcount = 0.
10339 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10341 int totlen = 0, i;
10342 Jim_Obj **intv;
10343 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10344 Jim_Obj *objPtr;
10345 char *s;
10347 if (tokens <= JIM_EVAL_SINTV_LEN)
10348 intv = sintv;
10349 else
10350 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10352 /* Compute every token forming the argument
10353 * in the intv objects vector. */
10354 for (i = 0; i < tokens; i++) {
10355 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10356 case JIM_OK:
10357 case JIM_RETURN:
10358 break;
10359 case JIM_BREAK:
10360 if (flags & JIM_SUBST_FLAG) {
10361 /* Stop here */
10362 tokens = i;
10363 continue;
10365 /* XXX: Should probably set an error about break outside loop */
10366 /* fall through to error */
10367 case JIM_CONTINUE:
10368 if (flags & JIM_SUBST_FLAG) {
10369 intv[i] = NULL;
10370 continue;
10372 /* XXX: Ditto continue outside loop */
10373 /* fall through to error */
10374 default:
10375 while (i--) {
10376 Jim_DecrRefCount(interp, intv[i]);
10378 if (intv != sintv) {
10379 Jim_Free(intv);
10381 return NULL;
10383 Jim_IncrRefCount(intv[i]);
10384 Jim_String(intv[i]);
10385 totlen += intv[i]->length;
10388 /* Fast path return for a single token */
10389 if (tokens == 1 && intv[0] && intv == sintv) {
10390 Jim_DecrRefCount(interp, intv[0]);
10391 return intv[0];
10394 /* Concatenate every token in an unique
10395 * object. */
10396 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10398 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10399 && token[2].type == JIM_TT_VAR) {
10400 /* May be able to do fast interpolated object -> dictSubst */
10401 objPtr->typePtr = &interpolatedObjType;
10402 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10403 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10404 Jim_IncrRefCount(intv[2]);
10406 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10407 /* The first interpolated token is source, so preserve the source info */
10408 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10412 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10413 objPtr->length = totlen;
10414 for (i = 0; i < tokens; i++) {
10415 if (intv[i]) {
10416 memcpy(s, intv[i]->bytes, intv[i]->length);
10417 s += intv[i]->length;
10418 Jim_DecrRefCount(interp, intv[i]);
10421 objPtr->bytes[totlen] = '\0';
10422 /* Free the intv vector if not static. */
10423 if (intv != sintv) {
10424 Jim_Free(intv);
10427 return objPtr;
10431 /* listPtr *must* be a list.
10432 * The contents of the list is evaluated with the first element as the command and
10433 * the remaining elements as the arguments.
10435 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10437 int retcode = JIM_OK;
10439 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10441 if (listPtr->internalRep.listValue.len) {
10442 Jim_IncrRefCount(listPtr);
10443 retcode = JimInvokeCommand(interp,
10444 listPtr->internalRep.listValue.len,
10445 listPtr->internalRep.listValue.ele);
10446 Jim_DecrRefCount(interp, listPtr);
10448 return retcode;
10451 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10453 SetListFromAny(interp, listPtr);
10454 return JimEvalObjList(interp, listPtr);
10457 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10459 int i;
10460 ScriptObj *script;
10461 ScriptToken *token;
10462 int retcode = JIM_OK;
10463 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10464 Jim_Obj *prevScriptObj;
10466 /* If the object is of type "list", with no string rep we can call
10467 * a specialized version of Jim_EvalObj() */
10468 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10469 return JimEvalObjList(interp, scriptObjPtr);
10472 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10473 script = JimGetScript(interp, scriptObjPtr);
10474 if (!JimScriptValid(interp, script)) {
10475 Jim_DecrRefCount(interp, scriptObjPtr);
10476 return JIM_ERR;
10479 /* Reset the interpreter result. This is useful to
10480 * return the empty result in the case of empty program. */
10481 Jim_SetEmptyResult(interp);
10483 token = script->token;
10485 #ifdef JIM_OPTIMIZATION
10486 /* Check for one of the following common scripts used by for, while
10488 * {}
10489 * incr a
10491 if (script->len == 0) {
10492 Jim_DecrRefCount(interp, scriptObjPtr);
10493 return JIM_OK;
10495 if (script->len == 3
10496 && token[1].objPtr->typePtr == &commandObjType
10497 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10498 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10499 && token[2].objPtr->typePtr == &variableObjType) {
10501 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10503 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10504 JimWideValue(objPtr)++;
10505 Jim_InvalidateStringRep(objPtr);
10506 Jim_DecrRefCount(interp, scriptObjPtr);
10507 Jim_SetResult(interp, objPtr);
10508 return JIM_OK;
10511 #endif
10513 /* Now we have to make sure the internal repr will not be
10514 * freed on shimmering.
10516 * Think for example to this:
10518 * set x {llength $x; ... some more code ...}; eval $x
10520 * In order to preserve the internal rep, we increment the
10521 * inUse field of the script internal rep structure. */
10522 script->inUse++;
10524 /* Stash the current script */
10525 prevScriptObj = interp->currentScriptObj;
10526 interp->currentScriptObj = scriptObjPtr;
10528 interp->errorFlag = 0;
10529 argv = sargv;
10531 /* Execute every command sequentially until the end of the script
10532 * or an error occurs.
10534 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10535 int argc;
10536 int j;
10538 /* First token of the line is always JIM_TT_LINE */
10539 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10540 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10542 /* Allocate the arguments vector if required */
10543 if (argc > JIM_EVAL_SARGV_LEN)
10544 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10546 /* Skip the JIM_TT_LINE token */
10547 i++;
10549 /* Populate the arguments objects.
10550 * If an error occurs, retcode will be set and
10551 * 'j' will be set to the number of args expanded
10553 for (j = 0; j < argc; j++) {
10554 long wordtokens = 1;
10555 int expand = 0;
10556 Jim_Obj *wordObjPtr = NULL;
10558 if (token[i].type == JIM_TT_WORD) {
10559 wordtokens = JimWideValue(token[i++].objPtr);
10560 if (wordtokens < 0) {
10561 expand = 1;
10562 wordtokens = -wordtokens;
10566 if (wordtokens == 1) {
10567 /* Fast path if the token does not
10568 * need interpolation */
10570 switch (token[i].type) {
10571 case JIM_TT_ESC:
10572 case JIM_TT_STR:
10573 wordObjPtr = token[i].objPtr;
10574 break;
10575 case JIM_TT_VAR:
10576 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10577 break;
10578 case JIM_TT_EXPRSUGAR:
10579 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10580 break;
10581 case JIM_TT_DICTSUGAR:
10582 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10583 break;
10584 case JIM_TT_CMD:
10585 retcode = Jim_EvalObj(interp, token[i].objPtr);
10586 if (retcode == JIM_OK) {
10587 wordObjPtr = Jim_GetResult(interp);
10589 break;
10590 default:
10591 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10594 else {
10595 /* For interpolation we call a helper
10596 * function to do the work for us. */
10597 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10600 if (!wordObjPtr) {
10601 if (retcode == JIM_OK) {
10602 retcode = JIM_ERR;
10604 break;
10607 Jim_IncrRefCount(wordObjPtr);
10608 i += wordtokens;
10610 if (!expand) {
10611 argv[j] = wordObjPtr;
10613 else {
10614 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10615 int len = Jim_ListLength(interp, wordObjPtr);
10616 int newargc = argc + len - 1;
10617 int k;
10619 if (len > 1) {
10620 if (argv == sargv) {
10621 if (newargc > JIM_EVAL_SARGV_LEN) {
10622 argv = Jim_Alloc(sizeof(*argv) * newargc);
10623 memcpy(argv, sargv, sizeof(*argv) * j);
10626 else {
10627 /* Need to realloc to make room for (len - 1) more entries */
10628 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10632 /* Now copy in the expanded version */
10633 for (k = 0; k < len; k++) {
10634 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10635 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10638 /* The original object reference is no longer needed,
10639 * after the expansion it is no longer present on
10640 * the argument vector, but the single elements are
10641 * in its place. */
10642 Jim_DecrRefCount(interp, wordObjPtr);
10644 /* And update the indexes */
10645 j--;
10646 argc += len - 1;
10650 if (retcode == JIM_OK && argc) {
10651 /* Invoke the command */
10652 retcode = JimInvokeCommand(interp, argc, argv);
10653 /* Check for a signal after each command */
10654 if (Jim_CheckSignal(interp)) {
10655 retcode = JIM_SIGNAL;
10659 /* Finished with the command, so decrement ref counts of each argument */
10660 while (j-- > 0) {
10661 Jim_DecrRefCount(interp, argv[j]);
10664 if (argv != sargv) {
10665 Jim_Free(argv);
10666 argv = sargv;
10670 /* Possibly add to the error stack trace */
10671 if (retcode == JIM_ERR) {
10672 JimAddErrorToStack(interp, script);
10674 /* Propagate the addStackTrace value through 'return -code error' */
10675 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10676 /* No need to add stack trace */
10677 interp->addStackTrace = 0;
10680 /* Restore the current script */
10681 interp->currentScriptObj = prevScriptObj;
10683 /* Note that we don't have to decrement inUse, because the
10684 * following code transfers our use of the reference again to
10685 * the script object. */
10686 Jim_FreeIntRep(interp, scriptObjPtr);
10687 scriptObjPtr->typePtr = &scriptObjType;
10688 Jim_SetIntRepPtr(scriptObjPtr, script);
10689 Jim_DecrRefCount(interp, scriptObjPtr);
10691 return retcode;
10694 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10696 int retcode;
10697 /* If argObjPtr begins with '&', do an automatic upvar */
10698 const char *varname = Jim_String(argNameObj);
10699 if (*varname == '&') {
10700 /* First check that the target variable exists */
10701 Jim_Obj *objPtr;
10702 Jim_CallFrame *savedCallFrame = interp->framePtr;
10704 interp->framePtr = interp->framePtr->parent;
10705 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10706 interp->framePtr = savedCallFrame;
10707 if (!objPtr) {
10708 return JIM_ERR;
10711 /* It exists, so perform the binding. */
10712 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10713 Jim_IncrRefCount(objPtr);
10714 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10715 Jim_DecrRefCount(interp, objPtr);
10717 else {
10718 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10720 return retcode;
10724 * Sets the interp result to be an error message indicating the required proc args.
10726 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10728 /* Create a nice error message, consistent with Tcl 8.5 */
10729 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10730 int i;
10732 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10733 Jim_AppendString(interp, argmsg, " ", 1);
10735 if (i == cmd->u.proc.argsPos) {
10736 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10737 /* Renamed args */
10738 Jim_AppendString(interp, argmsg, "?", 1);
10739 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10740 Jim_AppendString(interp, argmsg, " ...?", -1);
10742 else {
10743 /* We have plain args */
10744 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10747 else {
10748 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10749 Jim_AppendString(interp, argmsg, "?", 1);
10750 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10751 Jim_AppendString(interp, argmsg, "?", 1);
10753 else {
10754 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10755 if (*arg == '&') {
10756 arg++;
10758 Jim_AppendString(interp, argmsg, arg, -1);
10762 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10763 Jim_FreeNewObj(interp, argmsg);
10766 #ifdef jim_ext_namespace
10768 * [namespace eval]
10770 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10772 Jim_CallFrame *callFramePtr;
10773 int retcode;
10775 /* Create a new callframe */
10776 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10777 callFramePtr->argv = &interp->emptyObj;
10778 callFramePtr->argc = 0;
10779 callFramePtr->procArgsObjPtr = NULL;
10780 callFramePtr->procBodyObjPtr = scriptObj;
10781 callFramePtr->staticVars = NULL;
10782 callFramePtr->fileNameObj = interp->emptyObj;
10783 callFramePtr->line = 0;
10784 Jim_IncrRefCount(scriptObj);
10785 interp->framePtr = callFramePtr;
10787 /* Check if there are too nested calls */
10788 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10789 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10790 retcode = JIM_ERR;
10792 else {
10793 /* Eval the body */
10794 retcode = Jim_EvalObj(interp, scriptObj);
10797 /* Destroy the callframe */
10798 interp->framePtr = interp->framePtr->parent;
10799 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10801 return retcode;
10803 #endif
10805 /* Call a procedure implemented in Tcl.
10806 * It's possible to speed-up a lot this function, currently
10807 * the callframes are not cached, but allocated and
10808 * destroied every time. What is expecially costly is
10809 * to create/destroy the local vars hash table every time.
10811 * This can be fixed just implementing callframes caching
10812 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10813 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10815 Jim_CallFrame *callFramePtr;
10816 int i, d, retcode, optargs;
10817 ScriptObj *script;
10819 /* Check arity */
10820 if (argc - 1 < cmd->u.proc.reqArity ||
10821 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10822 JimSetProcWrongArgs(interp, argv[0], cmd);
10823 return JIM_ERR;
10826 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10827 /* Optimise for procedure with no body - useful for optional debugging */
10828 return JIM_OK;
10831 /* Check if there are too nested calls */
10832 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10833 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10834 return JIM_ERR;
10837 /* Create a new callframe */
10838 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10839 callFramePtr->argv = argv;
10840 callFramePtr->argc = argc;
10841 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10842 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10843 callFramePtr->staticVars = cmd->u.proc.staticVars;
10845 /* Remember where we were called from. */
10846 script = JimGetScript(interp, interp->currentScriptObj);
10847 callFramePtr->fileNameObj = script->fileNameObj;
10848 callFramePtr->line = script->linenr;
10850 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10851 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10852 interp->framePtr = callFramePtr;
10854 /* How many optional args are available */
10855 optargs = (argc - 1 - cmd->u.proc.reqArity);
10857 /* Step 'i' along the actual args, and step 'd' along the formal args */
10858 i = 1;
10859 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10860 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10861 if (d == cmd->u.proc.argsPos) {
10862 /* assign $args */
10863 Jim_Obj *listObjPtr;
10864 int argsLen = 0;
10865 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10866 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10868 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10870 /* It is possible to rename args. */
10871 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10872 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10874 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10875 if (retcode != JIM_OK) {
10876 goto badargset;
10879 i += argsLen;
10880 continue;
10883 /* Optional or required? */
10884 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10885 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10887 else {
10888 /* Ran out, so use the default */
10889 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10891 if (retcode != JIM_OK) {
10892 goto badargset;
10896 /* Eval the body */
10897 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10899 badargset:
10901 /* Free the callframe */
10902 interp->framePtr = interp->framePtr->parent;
10903 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10905 /* Now chain any tailcalls in the parent frame */
10906 if (interp->framePtr->tailcallObj) {
10907 do {
10908 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10910 interp->framePtr->tailcallObj = NULL;
10912 if (retcode == JIM_EVAL) {
10913 retcode = Jim_EvalObjList(interp, tailcallObj);
10914 if (retcode == JIM_RETURN) {
10915 /* If the result of the tailcall is 'return', push
10916 * it up to the caller
10918 interp->returnLevel++;
10921 Jim_DecrRefCount(interp, tailcallObj);
10922 } while (interp->framePtr->tailcallObj);
10924 /* If the tailcall chain finished early, may need to manually discard the command */
10925 if (interp->framePtr->tailcallCmd) {
10926 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10927 interp->framePtr->tailcallCmd = NULL;
10931 /* Handle the JIM_RETURN return code */
10932 if (retcode == JIM_RETURN) {
10933 if (--interp->returnLevel <= 0) {
10934 retcode = interp->returnCode;
10935 interp->returnCode = JIM_OK;
10936 interp->returnLevel = 0;
10939 else if (retcode == JIM_ERR) {
10940 interp->addStackTrace++;
10941 Jim_DecrRefCount(interp, interp->errorProc);
10942 interp->errorProc = argv[0];
10943 Jim_IncrRefCount(interp->errorProc);
10946 return retcode;
10949 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10951 int retval;
10952 Jim_Obj *scriptObjPtr;
10954 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10955 Jim_IncrRefCount(scriptObjPtr);
10957 if (filename) {
10958 Jim_Obj *prevScriptObj;
10960 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10962 prevScriptObj = interp->currentScriptObj;
10963 interp->currentScriptObj = scriptObjPtr;
10965 retval = Jim_EvalObj(interp, scriptObjPtr);
10967 interp->currentScriptObj = prevScriptObj;
10969 else {
10970 retval = Jim_EvalObj(interp, scriptObjPtr);
10972 Jim_DecrRefCount(interp, scriptObjPtr);
10973 return retval;
10976 int Jim_Eval(Jim_Interp *interp, const char *script)
10978 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10981 /* Execute script in the scope of the global level */
10982 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10984 int retval;
10985 Jim_CallFrame *savedFramePtr = interp->framePtr;
10987 interp->framePtr = interp->topFramePtr;
10988 retval = Jim_Eval(interp, script);
10989 interp->framePtr = savedFramePtr;
10991 return retval;
10994 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10996 int retval;
10997 Jim_CallFrame *savedFramePtr = interp->framePtr;
10999 interp->framePtr = interp->topFramePtr;
11000 retval = Jim_EvalFile(interp, filename);
11001 interp->framePtr = savedFramePtr;
11003 return retval;
11006 #include <sys/stat.h>
11008 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11010 FILE *fp;
11011 char *buf;
11012 Jim_Obj *scriptObjPtr;
11013 Jim_Obj *prevScriptObj;
11014 struct stat sb;
11015 int retcode;
11016 int readlen;
11018 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11019 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11020 return JIM_ERR;
11022 if (sb.st_size == 0) {
11023 fclose(fp);
11024 return JIM_OK;
11027 buf = Jim_Alloc(sb.st_size + 1);
11028 readlen = fread(buf, 1, sb.st_size, fp);
11029 if (ferror(fp)) {
11030 fclose(fp);
11031 Jim_Free(buf);
11032 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11033 return JIM_ERR;
11035 fclose(fp);
11036 buf[readlen] = 0;
11038 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11039 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11040 Jim_IncrRefCount(scriptObjPtr);
11042 prevScriptObj = interp->currentScriptObj;
11043 interp->currentScriptObj = scriptObjPtr;
11045 retcode = Jim_EvalObj(interp, scriptObjPtr);
11047 /* Handle the JIM_RETURN return code */
11048 if (retcode == JIM_RETURN) {
11049 if (--interp->returnLevel <= 0) {
11050 retcode = interp->returnCode;
11051 interp->returnCode = JIM_OK;
11052 interp->returnLevel = 0;
11055 if (retcode == JIM_ERR) {
11056 /* EvalFile changes context, so add a stack frame here */
11057 interp->addStackTrace++;
11060 interp->currentScriptObj = prevScriptObj;
11062 Jim_DecrRefCount(interp, scriptObjPtr);
11064 return retcode;
11067 /* -----------------------------------------------------------------------------
11068 * Subst
11069 * ---------------------------------------------------------------------------*/
11070 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11072 pc->tstart = pc->p;
11073 pc->tline = pc->linenr;
11075 if (pc->len == 0) {
11076 pc->tend = pc->p;
11077 pc->tt = JIM_TT_EOL;
11078 pc->eof = 1;
11079 return;
11081 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11082 JimParseCmd(pc);
11083 return;
11085 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11086 if (JimParseVar(pc) == JIM_OK) {
11087 return;
11089 /* Not a var, so treat as a string */
11090 pc->tstart = pc->p;
11091 flags |= JIM_SUBST_NOVAR;
11093 while (pc->len) {
11094 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11095 break;
11097 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11098 break;
11100 if (*pc->p == '\\' && pc->len > 1) {
11101 pc->p++;
11102 pc->len--;
11104 pc->p++;
11105 pc->len--;
11107 pc->tend = pc->p - 1;
11108 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11111 /* The subst object type reuses most of the data structures and functions
11112 * of the script object. Script's data structures are a bit more complex
11113 * for what is needed for [subst]itution tasks, but the reuse helps to
11114 * deal with a single data structure at the cost of some more memory
11115 * usage for substitutions. */
11117 /* This method takes the string representation of an object
11118 * as a Tcl string where to perform [subst]itution, and generates
11119 * the pre-parsed internal representation. */
11120 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11122 int scriptTextLen;
11123 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11124 struct JimParserCtx parser;
11125 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11126 ParseTokenList tokenlist;
11128 /* Initially parse the subst into tokens (in tokenlist) */
11129 ScriptTokenListInit(&tokenlist);
11131 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11132 while (1) {
11133 JimParseSubst(&parser, flags);
11134 if (parser.eof) {
11135 /* Note that subst doesn't need the EOL token */
11136 break;
11138 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11139 parser.tline);
11142 /* Create the "real" subst/script tokens from the initial token list */
11143 script->inUse = 1;
11144 script->substFlags = flags;
11145 script->fileNameObj = interp->emptyObj;
11146 Jim_IncrRefCount(script->fileNameObj);
11147 SubstObjAddTokens(interp, script, &tokenlist);
11149 /* No longer need the token list */
11150 ScriptTokenListFree(&tokenlist);
11152 #ifdef DEBUG_SHOW_SUBST
11154 int i;
11156 printf("==== Subst ====\n");
11157 for (i = 0; i < script->len; i++) {
11158 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11159 Jim_String(script->token[i].objPtr));
11162 #endif
11164 /* Free the old internal rep and set the new one. */
11165 Jim_FreeIntRep(interp, objPtr);
11166 Jim_SetIntRepPtr(objPtr, script);
11167 objPtr->typePtr = &scriptObjType;
11168 return JIM_OK;
11171 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11173 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11174 SetSubstFromAny(interp, objPtr, flags);
11175 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11178 /* Performs commands,variables,blackslashes substitution,
11179 * storing the result object (with refcount 0) into
11180 * resObjPtrPtr. */
11181 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11183 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11185 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11186 /* In order to preserve the internal rep, we increment the
11187 * inUse field of the script internal rep structure. */
11188 script->inUse++;
11190 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11192 script->inUse--;
11193 Jim_DecrRefCount(interp, substObjPtr);
11194 if (*resObjPtrPtr == NULL) {
11195 return JIM_ERR;
11197 return JIM_OK;
11200 /* -----------------------------------------------------------------------------
11201 * Core commands utility functions
11202 * ---------------------------------------------------------------------------*/
11203 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11205 Jim_Obj *objPtr;
11206 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11208 if (*msg) {
11209 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11211 Jim_IncrRefCount(listObjPtr);
11212 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11213 Jim_DecrRefCount(interp, listObjPtr);
11215 Jim_IncrRefCount(objPtr);
11216 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11217 Jim_DecrRefCount(interp, objPtr);
11221 * May add the key and/or value to the list.
11223 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11224 Jim_HashEntry *he, int type);
11226 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11229 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11230 * invoke the callback to add entries to a list.
11231 * Returns the list.
11233 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11234 JimHashtableIteratorCallbackType *callback, int type)
11236 Jim_HashEntry *he;
11237 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11239 /* Check for the non-pattern case. We can do this much more efficiently. */
11240 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11241 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11242 if (he) {
11243 callback(interp, listObjPtr, he, type);
11246 else {
11247 Jim_HashTableIterator htiter;
11248 JimInitHashTableIterator(ht, &htiter);
11249 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11250 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11251 callback(interp, listObjPtr, he, type);
11255 return listObjPtr;
11258 /* Keep these in order */
11259 #define JIM_CMDLIST_COMMANDS 0
11260 #define JIM_CMDLIST_PROCS 1
11261 #define JIM_CMDLIST_CHANNELS 2
11264 * Adds matching command names (procs, channels) to the list.
11266 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11267 Jim_HashEntry *he, int type)
11269 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11270 Jim_Obj *objPtr;
11272 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11273 /* not a proc */
11274 return;
11277 objPtr = Jim_NewStringObj(interp, he->key, -1);
11278 Jim_IncrRefCount(objPtr);
11280 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11281 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11283 Jim_DecrRefCount(interp, objPtr);
11286 /* type is JIM_CMDLIST_xxx */
11287 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11289 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11292 /* Keep these in order */
11293 #define JIM_VARLIST_GLOBALS 0
11294 #define JIM_VARLIST_LOCALS 1
11295 #define JIM_VARLIST_VARS 2
11297 #define JIM_VARLIST_VALUES 0x1000
11300 * Adds matching variable names to the list.
11302 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11303 Jim_HashEntry *he, int type)
11305 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11307 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11308 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11309 if (type & JIM_VARLIST_VALUES) {
11310 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11315 /* mode is JIM_VARLIST_xxx */
11316 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11318 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11319 /* For [info locals], if we are at top level an emtpy list
11320 * is returned. I don't agree, but we aim at compatibility (SS) */
11321 return interp->emptyObj;
11323 else {
11324 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11325 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11329 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11330 Jim_Obj **objPtrPtr, int info_level_cmd)
11332 Jim_CallFrame *targetCallFrame;
11334 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11335 if (targetCallFrame == NULL) {
11336 return JIM_ERR;
11338 /* No proc call at toplevel callframe */
11339 if (targetCallFrame == interp->topFramePtr) {
11340 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11341 return JIM_ERR;
11343 if (info_level_cmd) {
11344 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11346 else {
11347 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11349 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11350 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11351 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11352 *objPtrPtr = listObj;
11354 return JIM_OK;
11357 /* -----------------------------------------------------------------------------
11358 * Core commands
11359 * ---------------------------------------------------------------------------*/
11361 /* fake [puts] -- not the real puts, just for debugging. */
11362 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11364 if (argc != 2 && argc != 3) {
11365 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11366 return JIM_ERR;
11368 if (argc == 3) {
11369 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11370 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11371 return JIM_ERR;
11373 else {
11374 fputs(Jim_String(argv[2]), stdout);
11377 else {
11378 puts(Jim_String(argv[1]));
11380 return JIM_OK;
11383 /* Helper for [+] and [*] */
11384 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11386 jim_wide wideValue, res;
11387 double doubleValue, doubleRes;
11388 int i;
11390 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11392 for (i = 1; i < argc; i++) {
11393 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11394 goto trydouble;
11395 if (op == JIM_EXPROP_ADD)
11396 res += wideValue;
11397 else
11398 res *= wideValue;
11400 Jim_SetResultInt(interp, res);
11401 return JIM_OK;
11402 trydouble:
11403 doubleRes = (double)res;
11404 for (; i < argc; i++) {
11405 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11406 return JIM_ERR;
11407 if (op == JIM_EXPROP_ADD)
11408 doubleRes += doubleValue;
11409 else
11410 doubleRes *= doubleValue;
11412 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11413 return JIM_OK;
11416 /* Helper for [-] and [/] */
11417 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11419 jim_wide wideValue, res = 0;
11420 double doubleValue, doubleRes = 0;
11421 int i = 2;
11423 if (argc < 2) {
11424 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11425 return JIM_ERR;
11427 else if (argc == 2) {
11428 /* The arity = 2 case is different. For [- x] returns -x,
11429 * while [/ x] returns 1/x. */
11430 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11431 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11432 return JIM_ERR;
11434 else {
11435 if (op == JIM_EXPROP_SUB)
11436 doubleRes = -doubleValue;
11437 else
11438 doubleRes = 1.0 / doubleValue;
11439 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11440 return JIM_OK;
11443 if (op == JIM_EXPROP_SUB) {
11444 res = -wideValue;
11445 Jim_SetResultInt(interp, res);
11447 else {
11448 doubleRes = 1.0 / wideValue;
11449 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11451 return JIM_OK;
11453 else {
11454 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11455 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11456 != JIM_OK) {
11457 return JIM_ERR;
11459 else {
11460 goto trydouble;
11464 for (i = 2; i < argc; i++) {
11465 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11466 doubleRes = (double)res;
11467 goto trydouble;
11469 if (op == JIM_EXPROP_SUB)
11470 res -= wideValue;
11471 else
11472 res /= wideValue;
11474 Jim_SetResultInt(interp, res);
11475 return JIM_OK;
11476 trydouble:
11477 for (; i < argc; i++) {
11478 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11479 return JIM_ERR;
11480 if (op == JIM_EXPROP_SUB)
11481 doubleRes -= doubleValue;
11482 else
11483 doubleRes /= doubleValue;
11485 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11486 return JIM_OK;
11490 /* [+] */
11491 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11493 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11496 /* [*] */
11497 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11499 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11502 /* [-] */
11503 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11505 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11508 /* [/] */
11509 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11511 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11514 /* [set] */
11515 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11517 if (argc != 2 && argc != 3) {
11518 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11519 return JIM_ERR;
11521 if (argc == 2) {
11522 Jim_Obj *objPtr;
11524 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11525 if (!objPtr)
11526 return JIM_ERR;
11527 Jim_SetResult(interp, objPtr);
11528 return JIM_OK;
11530 /* argc == 3 case. */
11531 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11532 return JIM_ERR;
11533 Jim_SetResult(interp, argv[2]);
11534 return JIM_OK;
11537 /* [unset]
11539 * unset ?-nocomplain? ?--? ?varName ...?
11541 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11543 int i = 1;
11544 int complain = 1;
11546 while (i < argc) {
11547 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11548 i++;
11549 break;
11551 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11552 complain = 0;
11553 i++;
11554 continue;
11556 break;
11559 while (i < argc) {
11560 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11561 && complain) {
11562 return JIM_ERR;
11564 i++;
11566 return JIM_OK;
11569 /* [while] */
11570 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11572 if (argc != 3) {
11573 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11574 return JIM_ERR;
11577 /* The general purpose implementation of while starts here */
11578 while (1) {
11579 int boolean, retval;
11581 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11582 return retval;
11583 if (!boolean)
11584 break;
11586 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11587 switch (retval) {
11588 case JIM_BREAK:
11589 goto out;
11590 break;
11591 case JIM_CONTINUE:
11592 continue;
11593 break;
11594 default:
11595 return retval;
11599 out:
11600 Jim_SetEmptyResult(interp);
11601 return JIM_OK;
11604 /* [for] */
11605 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11607 int retval;
11608 int boolean = 1;
11609 Jim_Obj *varNamePtr = NULL;
11610 Jim_Obj *stopVarNamePtr = NULL;
11612 if (argc != 5) {
11613 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11614 return JIM_ERR;
11617 /* Do the initialisation */
11618 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11619 return retval;
11622 /* And do the first test now. Better for optimisation
11623 * if we can do next/test at the bottom of the loop
11625 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11627 /* Ready to do the body as follows:
11628 * while (1) {
11629 * body // check retcode
11630 * next // check retcode
11631 * test // check retcode/test bool
11635 #ifdef JIM_OPTIMIZATION
11636 /* Check if the for is on the form:
11637 * for ... {$i < CONST} {incr i}
11638 * for ... {$i < $j} {incr i}
11640 if (retval == JIM_OK && boolean) {
11641 ScriptObj *incrScript;
11642 ExprByteCode *expr;
11643 jim_wide stop, currentVal;
11644 Jim_Obj *objPtr;
11645 int cmpOffset;
11647 /* Do it only if there aren't shared arguments */
11648 expr = JimGetExpression(interp, argv[2]);
11649 incrScript = JimGetScript(interp, argv[3]);
11651 /* Ensure proper lengths to start */
11652 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11653 goto evalstart;
11655 /* Ensure proper token types. */
11656 if (incrScript->token[1].type != JIM_TT_ESC ||
11657 expr->token[0].type != JIM_TT_VAR ||
11658 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11659 goto evalstart;
11662 if (expr->token[2].type == JIM_EXPROP_LT) {
11663 cmpOffset = 0;
11665 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11666 cmpOffset = 1;
11668 else {
11669 goto evalstart;
11672 /* Update command must be incr */
11673 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11674 goto evalstart;
11677 /* incr, expression must be about the same variable */
11678 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11679 goto evalstart;
11682 /* Get the stop condition (must be a variable or integer) */
11683 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11684 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11685 goto evalstart;
11688 else {
11689 stopVarNamePtr = expr->token[1].objPtr;
11690 Jim_IncrRefCount(stopVarNamePtr);
11691 /* Keep the compiler happy */
11692 stop = 0;
11695 /* Initialization */
11696 varNamePtr = expr->token[0].objPtr;
11697 Jim_IncrRefCount(varNamePtr);
11699 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11700 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11701 goto testcond;
11704 /* --- OPTIMIZED FOR --- */
11705 while (retval == JIM_OK) {
11706 /* === Check condition === */
11707 /* Note that currentVal is already set here */
11709 /* Immediate or Variable? get the 'stop' value if the latter. */
11710 if (stopVarNamePtr) {
11711 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11712 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11713 goto testcond;
11717 if (currentVal >= stop + cmpOffset) {
11718 break;
11721 /* Eval body */
11722 retval = Jim_EvalObj(interp, argv[4]);
11723 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11724 retval = JIM_OK;
11726 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11728 /* Increment */
11729 if (objPtr == NULL) {
11730 retval = JIM_ERR;
11731 goto out;
11733 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11734 currentVal = ++JimWideValue(objPtr);
11735 Jim_InvalidateStringRep(objPtr);
11737 else {
11738 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11739 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11740 ++currentVal)) != JIM_OK) {
11741 goto evalnext;
11746 goto out;
11748 evalstart:
11749 #endif
11751 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11752 /* Body */
11753 retval = Jim_EvalObj(interp, argv[4]);
11755 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11756 /* increment */
11757 evalnext:
11758 retval = Jim_EvalObj(interp, argv[3]);
11759 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11760 /* test */
11761 testcond:
11762 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11766 out:
11767 if (stopVarNamePtr) {
11768 Jim_DecrRefCount(interp, stopVarNamePtr);
11770 if (varNamePtr) {
11771 Jim_DecrRefCount(interp, varNamePtr);
11774 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11775 Jim_SetEmptyResult(interp);
11776 return JIM_OK;
11779 return retval;
11782 /* [loop] */
11783 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11785 int retval;
11786 jim_wide i;
11787 jim_wide limit;
11788 jim_wide incr = 1;
11789 Jim_Obj *bodyObjPtr;
11791 if (argc != 5 && argc != 6) {
11792 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11793 return JIM_ERR;
11796 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11797 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11798 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11799 return JIM_ERR;
11801 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11803 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11805 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11806 retval = Jim_EvalObj(interp, bodyObjPtr);
11807 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11808 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11810 retval = JIM_OK;
11812 /* Increment */
11813 i += incr;
11815 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11816 if (argv[1]->typePtr != &variableObjType) {
11817 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11818 return JIM_ERR;
11821 JimWideValue(objPtr) = i;
11822 Jim_InvalidateStringRep(objPtr);
11824 /* The following step is required in order to invalidate the
11825 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11826 if (argv[1]->typePtr != &variableObjType) {
11827 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11828 retval = JIM_ERR;
11829 break;
11833 else {
11834 objPtr = Jim_NewIntObj(interp, i);
11835 retval = Jim_SetVariable(interp, argv[1], objPtr);
11836 if (retval != JIM_OK) {
11837 Jim_FreeNewObj(interp, objPtr);
11843 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11844 Jim_SetEmptyResult(interp);
11845 return JIM_OK;
11847 return retval;
11850 /* List iterators make it easy to iterate over a list.
11851 * At some point iterators will be expanded to support generators.
11853 typedef struct {
11854 Jim_Obj *objPtr;
11855 int idx;
11856 } Jim_ListIter;
11859 * Initialise the iterator at the start of the list.
11861 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11863 iter->objPtr = objPtr;
11864 iter->idx = 0;
11868 * Returns the next object from the list, or NULL on end-of-list.
11870 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11872 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11873 return NULL;
11875 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11879 * Returns 1 if end-of-list has been reached.
11881 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11883 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11886 /* foreach + lmap implementation. */
11887 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11889 int result = JIM_OK;
11890 int i, numargs;
11891 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11892 Jim_ListIter *iters;
11893 Jim_Obj *script;
11894 Jim_Obj *resultObj;
11896 if (argc < 4 || argc % 2 != 0) {
11897 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11898 return JIM_ERR;
11900 script = argv[argc - 1]; /* Last argument is a script */
11901 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11903 if (numargs == 2) {
11904 iters = twoiters;
11906 else {
11907 iters = Jim_Alloc(numargs * sizeof(*iters));
11909 for (i = 0; i < numargs; i++) {
11910 JimListIterInit(&iters[i], argv[i + 1]);
11911 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11912 result = JIM_ERR;
11915 if (result != JIM_OK) {
11916 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11917 return result;
11920 if (doMap) {
11921 resultObj = Jim_NewListObj(interp, NULL, 0);
11923 else {
11924 resultObj = interp->emptyObj;
11926 Jim_IncrRefCount(resultObj);
11928 while (1) {
11929 /* Have we expired all lists? */
11930 for (i = 0; i < numargs; i += 2) {
11931 if (!JimListIterDone(interp, &iters[i + 1])) {
11932 break;
11935 if (i == numargs) {
11936 /* All done */
11937 break;
11940 /* For each list */
11941 for (i = 0; i < numargs; i += 2) {
11942 Jim_Obj *varName;
11944 /* foreach var */
11945 JimListIterInit(&iters[i], argv[i + 1]);
11946 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11947 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11948 if (!valObj) {
11949 /* Ran out, so store the empty string */
11950 valObj = interp->emptyObj;
11952 /* Avoid shimmering */
11953 Jim_IncrRefCount(valObj);
11954 result = Jim_SetVariable(interp, varName, valObj);
11955 Jim_DecrRefCount(interp, valObj);
11956 if (result != JIM_OK) {
11957 goto err;
11961 switch (result = Jim_EvalObj(interp, script)) {
11962 case JIM_OK:
11963 if (doMap) {
11964 Jim_ListAppendElement(interp, resultObj, interp->result);
11966 break;
11967 case JIM_CONTINUE:
11968 break;
11969 case JIM_BREAK:
11970 goto out;
11971 default:
11972 goto err;
11975 out:
11976 result = JIM_OK;
11977 Jim_SetResult(interp, resultObj);
11978 err:
11979 Jim_DecrRefCount(interp, resultObj);
11980 if (numargs > 2) {
11981 Jim_Free(iters);
11983 return result;
11986 /* [foreach] */
11987 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11989 return JimForeachMapHelper(interp, argc, argv, 0);
11992 /* [lmap] */
11993 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11995 return JimForeachMapHelper(interp, argc, argv, 1);
11998 /* [lassign] */
11999 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12001 int result = JIM_ERR;
12002 int i;
12003 Jim_ListIter iter;
12004 Jim_Obj *resultObj;
12006 if (argc < 2) {
12007 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12008 return JIM_ERR;
12011 JimListIterInit(&iter, argv[1]);
12013 for (i = 2; i < argc; i++) {
12014 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12015 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12016 if (result != JIM_OK) {
12017 return result;
12021 resultObj = Jim_NewListObj(interp, NULL, 0);
12022 while (!JimListIterDone(interp, &iter)) {
12023 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12026 Jim_SetResult(interp, resultObj);
12028 return JIM_OK;
12031 /* [if] */
12032 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12034 int boolean, retval, current = 1, falsebody = 0;
12036 if (argc >= 3) {
12037 while (1) {
12038 /* Far not enough arguments given! */
12039 if (current >= argc)
12040 goto err;
12041 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12042 != JIM_OK)
12043 return retval;
12044 /* There lacks something, isn't it? */
12045 if (current >= argc)
12046 goto err;
12047 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12048 current++;
12049 /* Tsk tsk, no then-clause? */
12050 if (current >= argc)
12051 goto err;
12052 if (boolean)
12053 return Jim_EvalObj(interp, argv[current]);
12054 /* Ok: no else-clause follows */
12055 if (++current >= argc) {
12056 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12057 return JIM_OK;
12059 falsebody = current++;
12060 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12061 /* IIICKS - else-clause isn't last cmd? */
12062 if (current != argc - 1)
12063 goto err;
12064 return Jim_EvalObj(interp, argv[current]);
12066 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12067 /* Ok: elseif follows meaning all the stuff
12068 * again (how boring...) */
12069 continue;
12070 /* OOPS - else-clause is not last cmd? */
12071 else if (falsebody != argc - 1)
12072 goto err;
12073 return Jim_EvalObj(interp, argv[falsebody]);
12075 return JIM_OK;
12077 err:
12078 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12079 return JIM_ERR;
12083 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12084 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12085 Jim_Obj *stringObj, int nocase)
12087 Jim_Obj *parms[4];
12088 int argc = 0;
12089 long eq;
12090 int rc;
12092 parms[argc++] = commandObj;
12093 if (nocase) {
12094 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12096 parms[argc++] = patternObj;
12097 parms[argc++] = stringObj;
12099 rc = Jim_EvalObjVector(interp, argc, parms);
12101 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12102 eq = -rc;
12105 return eq;
12108 enum
12109 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12111 /* [switch] */
12112 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12114 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12115 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12116 Jim_Obj *script = 0;
12118 if (argc < 3) {
12119 wrongnumargs:
12120 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12121 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12122 return JIM_ERR;
12124 for (opt = 1; opt < argc; ++opt) {
12125 const char *option = Jim_String(argv[opt]);
12127 if (*option != '-')
12128 break;
12129 else if (strncmp(option, "--", 2) == 0) {
12130 ++opt;
12131 break;
12133 else if (strncmp(option, "-exact", 2) == 0)
12134 matchOpt = SWITCH_EXACT;
12135 else if (strncmp(option, "-glob", 2) == 0)
12136 matchOpt = SWITCH_GLOB;
12137 else if (strncmp(option, "-regexp", 2) == 0)
12138 matchOpt = SWITCH_RE;
12139 else if (strncmp(option, "-command", 2) == 0) {
12140 matchOpt = SWITCH_CMD;
12141 if ((argc - opt) < 2)
12142 goto wrongnumargs;
12143 command = argv[++opt];
12145 else {
12146 Jim_SetResultFormatted(interp,
12147 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12148 argv[opt]);
12149 return JIM_ERR;
12151 if ((argc - opt) < 2)
12152 goto wrongnumargs;
12154 strObj = argv[opt++];
12155 patCount = argc - opt;
12156 if (patCount == 1) {
12157 Jim_Obj **vector;
12159 JimListGetElements(interp, argv[opt], &patCount, &vector);
12160 caseList = vector;
12162 else
12163 caseList = &argv[opt];
12164 if (patCount == 0 || patCount % 2 != 0)
12165 goto wrongnumargs;
12166 for (i = 0; script == 0 && i < patCount; i += 2) {
12167 Jim_Obj *patObj = caseList[i];
12169 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12170 || i < (patCount - 2)) {
12171 switch (matchOpt) {
12172 case SWITCH_EXACT:
12173 if (Jim_StringEqObj(strObj, patObj))
12174 script = caseList[i + 1];
12175 break;
12176 case SWITCH_GLOB:
12177 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12178 script = caseList[i + 1];
12179 break;
12180 case SWITCH_RE:
12181 command = Jim_NewStringObj(interp, "regexp", -1);
12182 /* Fall thru intentionally */
12183 case SWITCH_CMD:{
12184 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12186 /* After the execution of a command we need to
12187 * make sure to reconvert the object into a list
12188 * again. Only for the single-list style [switch]. */
12189 if (argc - opt == 1) {
12190 Jim_Obj **vector;
12192 JimListGetElements(interp, argv[opt], &patCount, &vector);
12193 caseList = vector;
12195 /* command is here already decref'd */
12196 if (rc < 0) {
12197 return -rc;
12199 if (rc)
12200 script = caseList[i + 1];
12201 break;
12205 else {
12206 script = caseList[i + 1];
12209 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12210 script = caseList[i + 1];
12211 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12212 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12213 return JIM_ERR;
12215 Jim_SetEmptyResult(interp);
12216 if (script) {
12217 return Jim_EvalObj(interp, script);
12219 return JIM_OK;
12222 /* [list] */
12223 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12225 Jim_Obj *listObjPtr;
12227 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12228 Jim_SetResult(interp, listObjPtr);
12229 return JIM_OK;
12232 /* [lindex] */
12233 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12235 Jim_Obj *objPtr, *listObjPtr;
12236 int i;
12237 int idx;
12239 if (argc < 2) {
12240 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12241 return JIM_ERR;
12243 objPtr = argv[1];
12244 Jim_IncrRefCount(objPtr);
12245 for (i = 2; i < argc; i++) {
12246 listObjPtr = objPtr;
12247 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12248 Jim_DecrRefCount(interp, listObjPtr);
12249 return JIM_ERR;
12251 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12252 /* Returns an empty object if the index
12253 * is out of range. */
12254 Jim_DecrRefCount(interp, listObjPtr);
12255 Jim_SetEmptyResult(interp);
12256 return JIM_OK;
12258 Jim_IncrRefCount(objPtr);
12259 Jim_DecrRefCount(interp, listObjPtr);
12261 Jim_SetResult(interp, objPtr);
12262 Jim_DecrRefCount(interp, objPtr);
12263 return JIM_OK;
12266 /* [llength] */
12267 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12269 if (argc != 2) {
12270 Jim_WrongNumArgs(interp, 1, argv, "list");
12271 return JIM_ERR;
12273 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12274 return JIM_OK;
12277 /* [lsearch] */
12278 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12280 static const char * const options[] = {
12281 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12282 NULL
12284 enum
12285 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12286 OPT_COMMAND };
12287 int i;
12288 int opt_bool = 0;
12289 int opt_not = 0;
12290 int opt_nocase = 0;
12291 int opt_all = 0;
12292 int opt_inline = 0;
12293 int opt_match = OPT_EXACT;
12294 int listlen;
12295 int rc = JIM_OK;
12296 Jim_Obj *listObjPtr = NULL;
12297 Jim_Obj *commandObj = NULL;
12299 if (argc < 3) {
12300 wrongargs:
12301 Jim_WrongNumArgs(interp, 1, argv,
12302 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12303 return JIM_ERR;
12306 for (i = 1; i < argc - 2; i++) {
12307 int option;
12309 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12310 return JIM_ERR;
12312 switch (option) {
12313 case OPT_BOOL:
12314 opt_bool = 1;
12315 opt_inline = 0;
12316 break;
12317 case OPT_NOT:
12318 opt_not = 1;
12319 break;
12320 case OPT_NOCASE:
12321 opt_nocase = 1;
12322 break;
12323 case OPT_INLINE:
12324 opt_inline = 1;
12325 opt_bool = 0;
12326 break;
12327 case OPT_ALL:
12328 opt_all = 1;
12329 break;
12330 case OPT_COMMAND:
12331 if (i >= argc - 2) {
12332 goto wrongargs;
12334 commandObj = argv[++i];
12335 /* fallthru */
12336 case OPT_EXACT:
12337 case OPT_GLOB:
12338 case OPT_REGEXP:
12339 opt_match = option;
12340 break;
12344 argv += i;
12346 if (opt_all) {
12347 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12349 if (opt_match == OPT_REGEXP) {
12350 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12352 if (commandObj) {
12353 Jim_IncrRefCount(commandObj);
12356 listlen = Jim_ListLength(interp, argv[0]);
12357 for (i = 0; i < listlen; i++) {
12358 int eq = 0;
12359 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12361 switch (opt_match) {
12362 case OPT_EXACT:
12363 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12364 break;
12366 case OPT_GLOB:
12367 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12368 break;
12370 case OPT_REGEXP:
12371 case OPT_COMMAND:
12372 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12373 if (eq < 0) {
12374 if (listObjPtr) {
12375 Jim_FreeNewObj(interp, listObjPtr);
12377 rc = JIM_ERR;
12378 goto done;
12380 break;
12383 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12384 if (!eq && opt_bool && opt_not && !opt_all) {
12385 continue;
12388 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12389 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12390 Jim_Obj *resultObj;
12392 if (opt_bool) {
12393 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12395 else if (!opt_inline) {
12396 resultObj = Jim_NewIntObj(interp, i);
12398 else {
12399 resultObj = objPtr;
12402 if (opt_all) {
12403 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12405 else {
12406 Jim_SetResult(interp, resultObj);
12407 goto done;
12412 if (opt_all) {
12413 Jim_SetResult(interp, listObjPtr);
12415 else {
12416 /* No match */
12417 if (opt_bool) {
12418 Jim_SetResultBool(interp, opt_not);
12420 else if (!opt_inline) {
12421 Jim_SetResultInt(interp, -1);
12425 done:
12426 if (commandObj) {
12427 Jim_DecrRefCount(interp, commandObj);
12429 return rc;
12432 /* [lappend] */
12433 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12435 Jim_Obj *listObjPtr;
12436 int shared, i;
12438 if (argc < 2) {
12439 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12440 return JIM_ERR;
12442 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12443 if (!listObjPtr) {
12444 /* Create the list if it does not exist */
12445 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12446 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12447 Jim_FreeNewObj(interp, listObjPtr);
12448 return JIM_ERR;
12451 shared = Jim_IsShared(listObjPtr);
12452 if (shared)
12453 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12454 for (i = 2; i < argc; i++)
12455 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12456 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12457 if (shared)
12458 Jim_FreeNewObj(interp, listObjPtr);
12459 return JIM_ERR;
12461 Jim_SetResult(interp, listObjPtr);
12462 return JIM_OK;
12465 /* [linsert] */
12466 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12468 int idx, len;
12469 Jim_Obj *listPtr;
12471 if (argc < 3) {
12472 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12473 return JIM_ERR;
12475 listPtr = argv[1];
12476 if (Jim_IsShared(listPtr))
12477 listPtr = Jim_DuplicateObj(interp, listPtr);
12478 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12479 goto err;
12480 len = Jim_ListLength(interp, listPtr);
12481 if (idx >= len)
12482 idx = len;
12483 else if (idx < 0)
12484 idx = len + idx + 1;
12485 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12486 Jim_SetResult(interp, listPtr);
12487 return JIM_OK;
12488 err:
12489 if (listPtr != argv[1]) {
12490 Jim_FreeNewObj(interp, listPtr);
12492 return JIM_ERR;
12495 /* [lreplace] */
12496 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12498 int first, last, len, rangeLen;
12499 Jim_Obj *listObj;
12500 Jim_Obj *newListObj;
12502 if (argc < 4) {
12503 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12504 return JIM_ERR;
12506 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12507 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12508 return JIM_ERR;
12511 listObj = argv[1];
12512 len = Jim_ListLength(interp, listObj);
12514 first = JimRelToAbsIndex(len, first);
12515 last = JimRelToAbsIndex(len, last);
12516 JimRelToAbsRange(len, &first, &last, &rangeLen);
12518 /* Now construct a new list which consists of:
12519 * <elements before first> <supplied elements> <elements after last>
12522 /* Check to see if trying to replace past the end of the list */
12523 if (first < len) {
12524 /* OK. Not past the end */
12526 else if (len == 0) {
12527 /* Special for empty list, adjust first to 0 */
12528 first = 0;
12530 else {
12531 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12532 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12533 return JIM_ERR;
12536 /* Add the first set of elements */
12537 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12539 /* Add supplied elements */
12540 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12542 /* Add the remaining elements */
12543 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12545 Jim_SetResult(interp, newListObj);
12546 return JIM_OK;
12549 /* [lset] */
12550 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12552 if (argc < 3) {
12553 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12554 return JIM_ERR;
12556 else if (argc == 3) {
12557 /* With no indexes, simply implements [set] */
12558 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12559 return JIM_ERR;
12560 Jim_SetResult(interp, argv[2]);
12561 return JIM_OK;
12563 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12566 /* [lsort] */
12567 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12569 static const char * const options[] = {
12570 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12572 enum
12573 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12574 Jim_Obj *resObj;
12575 int i;
12576 int retCode;
12578 struct lsort_info info;
12580 if (argc < 2) {
12581 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12582 return JIM_ERR;
12585 info.type = JIM_LSORT_ASCII;
12586 info.order = 1;
12587 info.indexed = 0;
12588 info.unique = 0;
12589 info.command = NULL;
12590 info.interp = interp;
12592 for (i = 1; i < (argc - 1); i++) {
12593 int option;
12595 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12596 != JIM_OK)
12597 return JIM_ERR;
12598 switch (option) {
12599 case OPT_ASCII:
12600 info.type = JIM_LSORT_ASCII;
12601 break;
12602 case OPT_NOCASE:
12603 info.type = JIM_LSORT_NOCASE;
12604 break;
12605 case OPT_INTEGER:
12606 info.type = JIM_LSORT_INTEGER;
12607 break;
12608 case OPT_REAL:
12609 info.type = JIM_LSORT_REAL;
12610 break;
12611 case OPT_INCREASING:
12612 info.order = 1;
12613 break;
12614 case OPT_DECREASING:
12615 info.order = -1;
12616 break;
12617 case OPT_UNIQUE:
12618 info.unique = 1;
12619 break;
12620 case OPT_COMMAND:
12621 if (i >= (argc - 2)) {
12622 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12623 return JIM_ERR;
12625 info.type = JIM_LSORT_COMMAND;
12626 info.command = argv[i + 1];
12627 i++;
12628 break;
12629 case OPT_INDEX:
12630 if (i >= (argc - 2)) {
12631 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12632 return JIM_ERR;
12634 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12635 return JIM_ERR;
12637 info.indexed = 1;
12638 i++;
12639 break;
12642 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12643 retCode = ListSortElements(interp, resObj, &info);
12644 if (retCode == JIM_OK) {
12645 Jim_SetResult(interp, resObj);
12647 else {
12648 Jim_FreeNewObj(interp, resObj);
12650 return retCode;
12653 /* [append] */
12654 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12656 Jim_Obj *stringObjPtr;
12657 int i;
12659 if (argc < 2) {
12660 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12661 return JIM_ERR;
12663 if (argc == 2) {
12664 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12665 if (!stringObjPtr)
12666 return JIM_ERR;
12668 else {
12669 int freeobj = 0;
12670 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12671 if (!stringObjPtr) {
12672 /* Create the string if it doesn't exist */
12673 stringObjPtr = Jim_NewEmptyStringObj(interp);
12674 freeobj = 1;
12676 else if (Jim_IsShared(stringObjPtr)) {
12677 freeobj = 1;
12678 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12680 for (i = 2; i < argc; i++) {
12681 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12683 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12684 if (freeobj) {
12685 Jim_FreeNewObj(interp, stringObjPtr);
12687 return JIM_ERR;
12690 Jim_SetResult(interp, stringObjPtr);
12691 return JIM_OK;
12694 /* [debug] */
12695 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12697 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12698 static const char * const options[] = {
12699 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12700 "exprbc", "show",
12701 NULL
12703 enum
12705 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12706 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12708 int option;
12710 if (argc < 2) {
12711 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12712 return JIM_ERR;
12714 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12715 return JIM_ERR;
12716 if (option == OPT_REFCOUNT) {
12717 if (argc != 3) {
12718 Jim_WrongNumArgs(interp, 2, argv, "object");
12719 return JIM_ERR;
12721 Jim_SetResultInt(interp, argv[2]->refCount);
12722 return JIM_OK;
12724 else if (option == OPT_OBJCOUNT) {
12725 int freeobj = 0, liveobj = 0;
12726 char buf[256];
12727 Jim_Obj *objPtr;
12729 if (argc != 2) {
12730 Jim_WrongNumArgs(interp, 2, argv, "");
12731 return JIM_ERR;
12733 /* Count the number of free objects. */
12734 objPtr = interp->freeList;
12735 while (objPtr) {
12736 freeobj++;
12737 objPtr = objPtr->nextObjPtr;
12739 /* Count the number of live objects. */
12740 objPtr = interp->liveList;
12741 while (objPtr) {
12742 liveobj++;
12743 objPtr = objPtr->nextObjPtr;
12745 /* Set the result string and return. */
12746 sprintf(buf, "free %d used %d", freeobj, liveobj);
12747 Jim_SetResultString(interp, buf, -1);
12748 return JIM_OK;
12750 else if (option == OPT_OBJECTS) {
12751 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12753 /* Count the number of live objects. */
12754 objPtr = interp->liveList;
12755 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12756 while (objPtr) {
12757 char buf[128];
12758 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12760 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12761 sprintf(buf, "%p", objPtr);
12762 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12763 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12764 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12765 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12766 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12767 objPtr = objPtr->nextObjPtr;
12769 Jim_SetResult(interp, listObjPtr);
12770 return JIM_OK;
12772 else if (option == OPT_INVSTR) {
12773 Jim_Obj *objPtr;
12775 if (argc != 3) {
12776 Jim_WrongNumArgs(interp, 2, argv, "object");
12777 return JIM_ERR;
12779 objPtr = argv[2];
12780 if (objPtr->typePtr != NULL)
12781 Jim_InvalidateStringRep(objPtr);
12782 Jim_SetEmptyResult(interp);
12783 return JIM_OK;
12785 else if (option == OPT_SHOW) {
12786 const char *s;
12787 int len, charlen;
12789 if (argc != 3) {
12790 Jim_WrongNumArgs(interp, 2, argv, "object");
12791 return JIM_ERR;
12793 s = Jim_GetString(argv[2], &len);
12794 #ifdef JIM_UTF8
12795 charlen = utf8_strlen(s, len);
12796 #else
12797 charlen = len;
12798 #endif
12799 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12800 printf("chars (%d): <<%s>>\n", charlen, s);
12801 printf("bytes (%d):", len);
12802 while (len--) {
12803 printf(" %02x", (unsigned char)*s++);
12805 printf("\n");
12806 return JIM_OK;
12808 else if (option == OPT_SCRIPTLEN) {
12809 ScriptObj *script;
12811 if (argc != 3) {
12812 Jim_WrongNumArgs(interp, 2, argv, "script");
12813 return JIM_ERR;
12815 script = JimGetScript(interp, argv[2]);
12816 if (script == NULL)
12817 return JIM_ERR;
12818 Jim_SetResultInt(interp, script->len);
12819 return JIM_OK;
12821 else if (option == OPT_EXPRLEN) {
12822 ExprByteCode *expr;
12824 if (argc != 3) {
12825 Jim_WrongNumArgs(interp, 2, argv, "expression");
12826 return JIM_ERR;
12828 expr = JimGetExpression(interp, argv[2]);
12829 if (expr == NULL)
12830 return JIM_ERR;
12831 Jim_SetResultInt(interp, expr->len);
12832 return JIM_OK;
12834 else if (option == OPT_EXPRBC) {
12835 Jim_Obj *objPtr;
12836 ExprByteCode *expr;
12837 int i;
12839 if (argc != 3) {
12840 Jim_WrongNumArgs(interp, 2, argv, "expression");
12841 return JIM_ERR;
12843 expr = JimGetExpression(interp, argv[2]);
12844 if (expr == NULL)
12845 return JIM_ERR;
12846 objPtr = Jim_NewListObj(interp, NULL, 0);
12847 for (i = 0; i < expr->len; i++) {
12848 const char *type;
12849 const Jim_ExprOperator *op;
12850 Jim_Obj *obj = expr->token[i].objPtr;
12852 switch (expr->token[i].type) {
12853 case JIM_TT_EXPR_INT:
12854 type = "int";
12855 break;
12856 case JIM_TT_EXPR_DOUBLE:
12857 type = "double";
12858 break;
12859 case JIM_TT_CMD:
12860 type = "command";
12861 break;
12862 case JIM_TT_VAR:
12863 type = "variable";
12864 break;
12865 case JIM_TT_DICTSUGAR:
12866 type = "dictsugar";
12867 break;
12868 case JIM_TT_EXPRSUGAR:
12869 type = "exprsugar";
12870 break;
12871 case JIM_TT_ESC:
12872 type = "subst";
12873 break;
12874 case JIM_TT_STR:
12875 type = "string";
12876 break;
12877 default:
12878 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12879 if (op == NULL) {
12880 type = "private";
12882 else {
12883 type = "operator";
12885 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12886 break;
12888 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12889 Jim_ListAppendElement(interp, objPtr, obj);
12891 Jim_SetResult(interp, objPtr);
12892 return JIM_OK;
12894 else {
12895 Jim_SetResultString(interp,
12896 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12897 return JIM_ERR;
12899 /* unreached */
12900 #endif /* JIM_BOOTSTRAP */
12901 #if !defined(JIM_DEBUG_COMMAND)
12902 Jim_SetResultString(interp, "unsupported", -1);
12903 return JIM_ERR;
12904 #endif
12907 /* [eval] */
12908 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12910 int rc;
12912 if (argc < 2) {
12913 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12914 return JIM_ERR;
12917 if (argc == 2) {
12918 rc = Jim_EvalObj(interp, argv[1]);
12920 else {
12921 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12924 if (rc == JIM_ERR) {
12925 /* eval is "interesting", so add a stack frame here */
12926 interp->addStackTrace++;
12928 return rc;
12931 /* [uplevel] */
12932 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12934 if (argc >= 2) {
12935 int retcode;
12936 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12937 const char *str;
12939 /* Save the old callframe pointer */
12940 savedCallFrame = interp->framePtr;
12942 /* Lookup the target frame pointer */
12943 str = Jim_String(argv[1]);
12944 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12945 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12946 argc--;
12947 argv++;
12949 else {
12950 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12952 if (targetCallFrame == NULL) {
12953 return JIM_ERR;
12955 if (argc < 2) {
12956 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12957 return JIM_ERR;
12959 /* Eval the code in the target callframe. */
12960 interp->framePtr = targetCallFrame;
12961 if (argc == 2) {
12962 retcode = Jim_EvalObj(interp, argv[1]);
12964 else {
12965 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12967 interp->framePtr = savedCallFrame;
12968 return retcode;
12970 else {
12971 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12972 return JIM_ERR;
12976 /* [expr] */
12977 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12979 Jim_Obj *exprResultPtr;
12980 int retcode;
12982 if (argc == 2) {
12983 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12985 else if (argc > 2) {
12986 Jim_Obj *objPtr;
12988 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12989 Jim_IncrRefCount(objPtr);
12990 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12991 Jim_DecrRefCount(interp, objPtr);
12993 else {
12994 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12995 return JIM_ERR;
12997 if (retcode != JIM_OK)
12998 return retcode;
12999 Jim_SetResult(interp, exprResultPtr);
13000 Jim_DecrRefCount(interp, exprResultPtr);
13001 return JIM_OK;
13004 /* [break] */
13005 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13007 if (argc != 1) {
13008 Jim_WrongNumArgs(interp, 1, argv, "");
13009 return JIM_ERR;
13011 return JIM_BREAK;
13014 /* [continue] */
13015 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13017 if (argc != 1) {
13018 Jim_WrongNumArgs(interp, 1, argv, "");
13019 return JIM_ERR;
13021 return JIM_CONTINUE;
13024 /* [return] */
13025 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13027 int i;
13028 Jim_Obj *stackTraceObj = NULL;
13029 Jim_Obj *errorCodeObj = NULL;
13030 int returnCode = JIM_OK;
13031 long level = 1;
13033 for (i = 1; i < argc - 1; i += 2) {
13034 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13035 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13036 return JIM_ERR;
13039 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13040 stackTraceObj = argv[i + 1];
13042 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13043 errorCodeObj = argv[i + 1];
13045 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13046 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13047 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13048 return JIM_ERR;
13051 else {
13052 break;
13056 if (i != argc - 1 && i != argc) {
13057 Jim_WrongNumArgs(interp, 1, argv,
13058 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13061 /* If a stack trace is supplied and code is error, set the stack trace */
13062 if (stackTraceObj && returnCode == JIM_ERR) {
13063 JimSetStackTrace(interp, stackTraceObj);
13065 /* If an error code list is supplied, set the global $errorCode */
13066 if (errorCodeObj && returnCode == JIM_ERR) {
13067 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13069 interp->returnCode = returnCode;
13070 interp->returnLevel = level;
13072 if (i == argc - 1) {
13073 Jim_SetResult(interp, argv[i]);
13075 return JIM_RETURN;
13078 /* [tailcall] */
13079 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13081 if (interp->framePtr->level == 0) {
13082 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13083 return JIM_ERR;
13085 else if (argc >= 2) {
13086 /* Need to resolve the tailcall command in the current context */
13087 Jim_CallFrame *cf = interp->framePtr->parent;
13089 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13090 if (cmdPtr == NULL) {
13091 return JIM_ERR;
13094 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13096 /* And stash this pre-resolved command */
13097 JimIncrCmdRefCount(cmdPtr);
13098 cf->tailcallCmd = cmdPtr;
13100 /* And stash the command list */
13101 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13103 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13104 Jim_IncrRefCount(cf->tailcallObj);
13106 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13107 return JIM_EVAL;
13109 return JIM_OK;
13112 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13114 Jim_Obj *cmdList;
13115 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13117 /* prefixListObj is a list to which the args need to be appended */
13118 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13119 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13121 return JimEvalObjList(interp, cmdList);
13124 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13126 Jim_Obj *prefixListObj = privData;
13127 Jim_DecrRefCount(interp, prefixListObj);
13130 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13132 Jim_Obj *prefixListObj;
13133 const char *newname;
13135 if (argc < 3) {
13136 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13137 return JIM_ERR;
13140 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13141 Jim_IncrRefCount(prefixListObj);
13142 newname = Jim_String(argv[1]);
13143 if (newname[0] == ':' && newname[1] == ':') {
13144 while (*++newname == ':') {
13148 Jim_SetResult(interp, argv[1]);
13150 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13153 /* [proc] */
13154 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13156 Jim_Cmd *cmd;
13158 if (argc != 4 && argc != 5) {
13159 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13160 return JIM_ERR;
13163 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13164 return JIM_ERR;
13167 if (argc == 4) {
13168 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13170 else {
13171 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13174 if (cmd) {
13175 /* Add the new command */
13176 Jim_Obj *qualifiedCmdNameObj;
13177 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13179 JimCreateCommand(interp, cmdname, cmd);
13181 /* Calculate and set the namespace for this proc */
13182 JimUpdateProcNamespace(interp, cmd, cmdname);
13184 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13186 /* Unlike Tcl, set the name of the proc as the result */
13187 Jim_SetResult(interp, argv[1]);
13188 return JIM_OK;
13190 return JIM_ERR;
13193 /* [local] */
13194 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13196 int retcode;
13198 if (argc < 2) {
13199 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13200 return JIM_ERR;
13203 /* Evaluate the arguments with 'local' in force */
13204 interp->local++;
13205 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13206 interp->local--;
13209 /* If OK, and the result is a proc, add it to the list of local procs */
13210 if (retcode == 0) {
13211 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13213 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13214 return JIM_ERR;
13216 if (interp->framePtr->localCommands == NULL) {
13217 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13218 Jim_InitStack(interp->framePtr->localCommands);
13220 Jim_IncrRefCount(cmdNameObj);
13221 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13224 return retcode;
13227 /* [upcall] */
13228 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13230 if (argc < 2) {
13231 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13232 return JIM_ERR;
13234 else {
13235 int retcode;
13237 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13238 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13239 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13240 return JIM_ERR;
13242 /* OK. Mark this command as being in an upcall */
13243 cmdPtr->u.proc.upcall++;
13244 JimIncrCmdRefCount(cmdPtr);
13246 /* Invoke the command as normal */
13247 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13249 /* No longer in an upcall */
13250 cmdPtr->u.proc.upcall--;
13251 JimDecrCmdRefCount(interp, cmdPtr);
13253 return retcode;
13257 /* [apply] */
13258 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13260 if (argc < 2) {
13261 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13262 return JIM_ERR;
13264 else {
13265 int ret;
13266 Jim_Cmd *cmd;
13267 Jim_Obj *argListObjPtr;
13268 Jim_Obj *bodyObjPtr;
13269 Jim_Obj *nsObj = NULL;
13270 Jim_Obj **nargv;
13272 int len = Jim_ListLength(interp, argv[1]);
13273 if (len != 2 && len != 3) {
13274 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13275 return JIM_ERR;
13278 if (len == 3) {
13279 #ifdef jim_ext_namespace
13280 /* Need to canonicalise the given namespace. */
13281 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13282 #else
13283 Jim_SetResultString(interp, "namespaces not enabled", -1);
13284 return JIM_ERR;
13285 #endif
13287 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13288 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13290 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13292 if (cmd) {
13293 /* Create a new argv array with a dummy argv[0], for error messages */
13294 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13295 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13296 Jim_IncrRefCount(nargv[0]);
13297 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13298 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13299 Jim_DecrRefCount(interp, nargv[0]);
13300 Jim_Free(nargv);
13302 JimDecrCmdRefCount(interp, cmd);
13303 return ret;
13305 return JIM_ERR;
13310 /* [concat] */
13311 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13313 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13314 return JIM_OK;
13317 /* [upvar] */
13318 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13320 int i;
13321 Jim_CallFrame *targetCallFrame;
13323 /* Lookup the target frame pointer */
13324 if (argc > 3 && (argc % 2 == 0)) {
13325 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13326 argc--;
13327 argv++;
13329 else {
13330 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13332 if (targetCallFrame == NULL) {
13333 return JIM_ERR;
13336 /* Check for arity */
13337 if (argc < 3) {
13338 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13339 return JIM_ERR;
13342 /* Now... for every other/local couple: */
13343 for (i = 1; i < argc; i += 2) {
13344 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13345 return JIM_ERR;
13347 return JIM_OK;
13350 /* [global] */
13351 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13353 int i;
13355 if (argc < 2) {
13356 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13357 return JIM_ERR;
13359 /* Link every var to the toplevel having the same name */
13360 if (interp->framePtr->level == 0)
13361 return JIM_OK; /* global at toplevel... */
13362 for (i = 1; i < argc; i++) {
13363 /* global ::blah does nothing */
13364 const char *name = Jim_String(argv[i]);
13365 if (name[0] != ':' || name[1] != ':') {
13366 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13367 return JIM_ERR;
13370 return JIM_OK;
13373 /* does the [string map] operation. On error NULL is returned,
13374 * otherwise a new string object with the result, having refcount = 0,
13375 * is returned. */
13376 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13377 Jim_Obj *objPtr, int nocase)
13379 int numMaps;
13380 const char *str, *noMatchStart = NULL;
13381 int strLen, i;
13382 Jim_Obj *resultObjPtr;
13384 numMaps = Jim_ListLength(interp, mapListObjPtr);
13385 if (numMaps % 2) {
13386 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13387 return NULL;
13390 str = Jim_String(objPtr);
13391 strLen = Jim_Utf8Length(interp, objPtr);
13393 /* Map it */
13394 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13395 while (strLen) {
13396 for (i = 0; i < numMaps; i += 2) {
13397 Jim_Obj *objPtr;
13398 const char *k;
13399 int kl;
13401 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13402 k = Jim_String(objPtr);
13403 kl = Jim_Utf8Length(interp, objPtr);
13405 if (strLen >= kl && kl) {
13406 int rc;
13407 rc = JimStringCompareLen(str, k, kl, nocase);
13408 if (rc == 0) {
13409 if (noMatchStart) {
13410 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13411 noMatchStart = NULL;
13413 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13414 str += utf8_index(str, kl);
13415 strLen -= kl;
13416 break;
13420 if (i == numMaps) { /* no match */
13421 int c;
13422 if (noMatchStart == NULL)
13423 noMatchStart = str;
13424 str += utf8_tounicode(str, &c);
13425 strLen--;
13428 if (noMatchStart) {
13429 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13431 return resultObjPtr;
13434 /* [string] */
13435 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13437 int len;
13438 int opt_case = 1;
13439 int option;
13440 static const char * const options[] = {
13441 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13442 "map", "repeat", "reverse", "index", "first", "last", "cat",
13443 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13445 enum
13447 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13448 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13449 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13451 static const char * const nocase_options[] = {
13452 "-nocase", NULL
13454 static const char * const nocase_length_options[] = {
13455 "-nocase", "-length", NULL
13458 if (argc < 2) {
13459 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13460 return JIM_ERR;
13462 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13463 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13464 return JIM_ERR;
13466 switch (option) {
13467 case OPT_LENGTH:
13468 case OPT_BYTELENGTH:
13469 if (argc != 3) {
13470 Jim_WrongNumArgs(interp, 2, argv, "string");
13471 return JIM_ERR;
13473 if (option == OPT_LENGTH) {
13474 len = Jim_Utf8Length(interp, argv[2]);
13476 else {
13477 len = Jim_Length(argv[2]);
13479 Jim_SetResultInt(interp, len);
13480 return JIM_OK;
13482 case OPT_CAT:{
13483 Jim_Obj *objPtr;
13484 if (argc == 3) {
13485 /* optimise the one-arg case */
13486 objPtr = argv[2];
13488 else {
13489 int i;
13491 objPtr = Jim_NewStringObj(interp, "", 0);
13493 for (i = 2; i < argc; i++) {
13494 Jim_AppendObj(interp, objPtr, argv[i]);
13497 Jim_SetResult(interp, objPtr);
13498 return JIM_OK;
13501 case OPT_COMPARE:
13502 case OPT_EQUAL:
13504 /* n is the number of remaining option args */
13505 long opt_length = -1;
13506 int n = argc - 4;
13507 int i = 2;
13508 while (n > 0) {
13509 int subopt;
13510 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13511 JIM_ENUM_ABBREV) != JIM_OK) {
13512 badcompareargs:
13513 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13514 return JIM_ERR;
13516 if (subopt == 0) {
13517 /* -nocase */
13518 opt_case = 0;
13519 n--;
13521 else {
13522 /* -length */
13523 if (n < 2) {
13524 goto badcompareargs;
13526 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13527 return JIM_ERR;
13529 n -= 2;
13532 if (n) {
13533 goto badcompareargs;
13535 argv += argc - 2;
13536 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13537 /* Fast version - [string equal], case sensitive, no length */
13538 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13540 else {
13541 if (opt_length >= 0) {
13542 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13544 else {
13545 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13547 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13549 return JIM_OK;
13552 case OPT_MATCH:
13553 if (argc != 4 &&
13554 (argc != 5 ||
13555 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13556 JIM_ENUM_ABBREV) != JIM_OK)) {
13557 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13558 return JIM_ERR;
13560 if (opt_case == 0) {
13561 argv++;
13563 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13564 return JIM_OK;
13566 case OPT_MAP:{
13567 Jim_Obj *objPtr;
13569 if (argc != 4 &&
13570 (argc != 5 ||
13571 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13572 JIM_ENUM_ABBREV) != JIM_OK)) {
13573 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13574 return JIM_ERR;
13577 if (opt_case == 0) {
13578 argv++;
13580 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13581 if (objPtr == NULL) {
13582 return JIM_ERR;
13584 Jim_SetResult(interp, objPtr);
13585 return JIM_OK;
13588 case OPT_RANGE:
13589 case OPT_BYTERANGE:{
13590 Jim_Obj *objPtr;
13592 if (argc != 5) {
13593 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13594 return JIM_ERR;
13596 if (option == OPT_RANGE) {
13597 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13599 else
13601 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13604 if (objPtr == NULL) {
13605 return JIM_ERR;
13607 Jim_SetResult(interp, objPtr);
13608 return JIM_OK;
13611 case OPT_REPLACE:{
13612 Jim_Obj *objPtr;
13614 if (argc != 5 && argc != 6) {
13615 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13616 return JIM_ERR;
13618 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13619 if (objPtr == NULL) {
13620 return JIM_ERR;
13622 Jim_SetResult(interp, objPtr);
13623 return JIM_OK;
13627 case OPT_REPEAT:{
13628 Jim_Obj *objPtr;
13629 jim_wide count;
13631 if (argc != 4) {
13632 Jim_WrongNumArgs(interp, 2, argv, "string count");
13633 return JIM_ERR;
13635 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13636 return JIM_ERR;
13638 objPtr = Jim_NewStringObj(interp, "", 0);
13639 if (count > 0) {
13640 while (count--) {
13641 Jim_AppendObj(interp, objPtr, argv[2]);
13644 Jim_SetResult(interp, objPtr);
13645 return JIM_OK;
13648 case OPT_REVERSE:{
13649 char *buf, *p;
13650 const char *str;
13651 int len;
13652 int i;
13654 if (argc != 3) {
13655 Jim_WrongNumArgs(interp, 2, argv, "string");
13656 return JIM_ERR;
13659 str = Jim_GetString(argv[2], &len);
13660 buf = Jim_Alloc(len + 1);
13661 p = buf + len;
13662 *p = 0;
13663 for (i = 0; i < len; ) {
13664 int c;
13665 int l = utf8_tounicode(str, &c);
13666 memcpy(p - l, str, l);
13667 p -= l;
13668 i += l;
13669 str += l;
13671 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13672 return JIM_OK;
13675 case OPT_INDEX:{
13676 int idx;
13677 const char *str;
13679 if (argc != 4) {
13680 Jim_WrongNumArgs(interp, 2, argv, "string index");
13681 return JIM_ERR;
13683 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13684 return JIM_ERR;
13686 str = Jim_String(argv[2]);
13687 len = Jim_Utf8Length(interp, argv[2]);
13688 if (idx != INT_MIN && idx != INT_MAX) {
13689 idx = JimRelToAbsIndex(len, idx);
13691 if (idx < 0 || idx >= len || str == NULL) {
13692 Jim_SetResultString(interp, "", 0);
13694 else if (len == Jim_Length(argv[2])) {
13695 /* ASCII optimisation */
13696 Jim_SetResultString(interp, str + idx, 1);
13698 else {
13699 int c;
13700 int i = utf8_index(str, idx);
13701 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13703 return JIM_OK;
13706 case OPT_FIRST:
13707 case OPT_LAST:{
13708 int idx = 0, l1, l2;
13709 const char *s1, *s2;
13711 if (argc != 4 && argc != 5) {
13712 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13713 return JIM_ERR;
13715 s1 = Jim_String(argv[2]);
13716 s2 = Jim_String(argv[3]);
13717 l1 = Jim_Utf8Length(interp, argv[2]);
13718 l2 = Jim_Utf8Length(interp, argv[3]);
13719 if (argc == 5) {
13720 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13721 return JIM_ERR;
13723 idx = JimRelToAbsIndex(l2, idx);
13725 else if (option == OPT_LAST) {
13726 idx = l2;
13728 if (option == OPT_FIRST) {
13729 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13731 else {
13732 #ifdef JIM_UTF8
13733 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13734 #else
13735 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13736 #endif
13738 return JIM_OK;
13741 case OPT_TRIM:
13742 case OPT_TRIMLEFT:
13743 case OPT_TRIMRIGHT:{
13744 Jim_Obj *trimchars;
13746 if (argc != 3 && argc != 4) {
13747 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13748 return JIM_ERR;
13750 trimchars = (argc == 4 ? argv[3] : NULL);
13751 if (option == OPT_TRIM) {
13752 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13754 else if (option == OPT_TRIMLEFT) {
13755 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13757 else if (option == OPT_TRIMRIGHT) {
13758 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13760 return JIM_OK;
13763 case OPT_TOLOWER:
13764 case OPT_TOUPPER:
13765 case OPT_TOTITLE:
13766 if (argc != 3) {
13767 Jim_WrongNumArgs(interp, 2, argv, "string");
13768 return JIM_ERR;
13770 if (option == OPT_TOLOWER) {
13771 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13773 else if (option == OPT_TOUPPER) {
13774 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13776 else {
13777 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13779 return JIM_OK;
13781 case OPT_IS:
13782 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13783 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13785 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13786 return JIM_ERR;
13788 return JIM_OK;
13791 /* [time] */
13792 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13794 long i, count = 1;
13795 jim_wide start, elapsed;
13796 char buf[60];
13797 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13799 if (argc < 2) {
13800 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13801 return JIM_ERR;
13803 if (argc == 3) {
13804 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13805 return JIM_ERR;
13807 if (count < 0)
13808 return JIM_OK;
13809 i = count;
13810 start = JimClock();
13811 while (i-- > 0) {
13812 int retval;
13814 retval = Jim_EvalObj(interp, argv[1]);
13815 if (retval != JIM_OK) {
13816 return retval;
13819 elapsed = JimClock() - start;
13820 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13821 Jim_SetResultString(interp, buf, -1);
13822 return JIM_OK;
13825 /* [exit] */
13826 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13828 long exitCode = 0;
13830 if (argc > 2) {
13831 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13832 return JIM_ERR;
13834 if (argc == 2) {
13835 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13836 return JIM_ERR;
13838 interp->exitCode = exitCode;
13839 return JIM_EXIT;
13842 /* [catch] */
13843 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13845 int exitCode = 0;
13846 int i;
13847 int sig = 0;
13849 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13850 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13851 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13853 /* Reset the error code before catch.
13854 * Note that this is not strictly correct.
13856 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13858 for (i = 1; i < argc - 1; i++) {
13859 const char *arg = Jim_String(argv[i]);
13860 jim_wide option;
13861 int ignore;
13863 /* It's a pity we can't use Jim_GetEnum here :-( */
13864 if (strcmp(arg, "--") == 0) {
13865 i++;
13866 break;
13868 if (*arg != '-') {
13869 break;
13872 if (strncmp(arg, "-no", 3) == 0) {
13873 arg += 3;
13874 ignore = 1;
13876 else {
13877 arg++;
13878 ignore = 0;
13881 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13882 option = -1;
13884 if (option < 0) {
13885 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13887 if (option < 0) {
13888 goto wrongargs;
13891 if (ignore) {
13892 ignore_mask |= (1 << option);
13894 else {
13895 ignore_mask &= ~(1 << option);
13899 argc -= i;
13900 if (argc < 1 || argc > 3) {
13901 wrongargs:
13902 Jim_WrongNumArgs(interp, 1, argv,
13903 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13904 return JIM_ERR;
13906 argv += i;
13908 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13909 sig++;
13912 interp->signal_level += sig;
13913 if (Jim_CheckSignal(interp)) {
13914 /* If a signal is set, don't even try to execute the body */
13915 exitCode = JIM_SIGNAL;
13917 else {
13918 exitCode = Jim_EvalObj(interp, argv[0]);
13919 /* Don't want any caught error included in a later stack trace */
13920 interp->errorFlag = 0;
13922 interp->signal_level -= sig;
13924 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13925 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13926 /* Not caught, pass it up */
13927 return exitCode;
13930 if (sig && exitCode == JIM_SIGNAL) {
13931 /* Catch the signal at this level */
13932 if (interp->signal_set_result) {
13933 interp->signal_set_result(interp, interp->sigmask);
13935 else {
13936 Jim_SetResultInt(interp, interp->sigmask);
13938 interp->sigmask = 0;
13941 if (argc >= 2) {
13942 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13943 return JIM_ERR;
13945 if (argc == 3) {
13946 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13948 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13949 Jim_ListAppendElement(interp, optListObj,
13950 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13951 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13952 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13953 if (exitCode == JIM_ERR) {
13954 Jim_Obj *errorCode;
13955 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13956 -1));
13957 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13959 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13960 if (errorCode) {
13961 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13962 Jim_ListAppendElement(interp, optListObj, errorCode);
13965 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13966 return JIM_ERR;
13970 Jim_SetResultInt(interp, exitCode);
13971 return JIM_OK;
13974 #ifdef JIM_REFERENCES
13976 /* [ref] */
13977 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13979 if (argc != 3 && argc != 4) {
13980 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13981 return JIM_ERR;
13983 if (argc == 3) {
13984 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13986 else {
13987 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13989 return JIM_OK;
13992 /* [getref] */
13993 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13995 Jim_Reference *refPtr;
13997 if (argc != 2) {
13998 Jim_WrongNumArgs(interp, 1, argv, "reference");
13999 return JIM_ERR;
14001 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14002 return JIM_ERR;
14003 Jim_SetResult(interp, refPtr->objPtr);
14004 return JIM_OK;
14007 /* [setref] */
14008 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14010 Jim_Reference *refPtr;
14012 if (argc != 3) {
14013 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14014 return JIM_ERR;
14016 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14017 return JIM_ERR;
14018 Jim_IncrRefCount(argv[2]);
14019 Jim_DecrRefCount(interp, refPtr->objPtr);
14020 refPtr->objPtr = argv[2];
14021 Jim_SetResult(interp, argv[2]);
14022 return JIM_OK;
14025 /* [collect] */
14026 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14028 if (argc != 1) {
14029 Jim_WrongNumArgs(interp, 1, argv, "");
14030 return JIM_ERR;
14032 Jim_SetResultInt(interp, Jim_Collect(interp));
14034 /* Free all the freed objects. */
14035 while (interp->freeList) {
14036 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14037 Jim_Free(interp->freeList);
14038 interp->freeList = nextObjPtr;
14041 return JIM_OK;
14044 /* [finalize] reference ?newValue? */
14045 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14047 if (argc != 2 && argc != 3) {
14048 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14049 return JIM_ERR;
14051 if (argc == 2) {
14052 Jim_Obj *cmdNamePtr;
14054 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14055 return JIM_ERR;
14056 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14057 Jim_SetResult(interp, cmdNamePtr);
14059 else {
14060 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14061 return JIM_ERR;
14062 Jim_SetResult(interp, argv[2]);
14064 return JIM_OK;
14067 /* [info references] */
14068 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14070 Jim_Obj *listObjPtr;
14071 Jim_HashTableIterator htiter;
14072 Jim_HashEntry *he;
14074 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14076 JimInitHashTableIterator(&interp->references, &htiter);
14077 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14078 char buf[JIM_REFERENCE_SPACE + 1];
14079 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14080 const unsigned long *refId = he->key;
14082 JimFormatReference(buf, refPtr, *refId);
14083 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14085 Jim_SetResult(interp, listObjPtr);
14086 return JIM_OK;
14088 #endif
14090 /* [rename] */
14091 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14093 if (argc != 3) {
14094 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14095 return JIM_ERR;
14098 if (JimValidName(interp, "new procedure", argv[2])) {
14099 return JIM_ERR;
14102 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14105 #define JIM_DICTMATCH_VALUES 0x0001
14107 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14109 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14111 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14112 if (type & JIM_DICTMATCH_VALUES) {
14113 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14118 * Like JimHashtablePatternMatch, but for dictionaries.
14120 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14121 JimDictMatchCallbackType *callback, int type)
14123 Jim_HashEntry *he;
14124 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14126 /* Check for the non-pattern case. We can do this much more efficiently. */
14127 Jim_HashTableIterator htiter;
14128 JimInitHashTableIterator(ht, &htiter);
14129 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14130 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14131 callback(interp, listObjPtr, he, type);
14135 return listObjPtr;
14139 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14141 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14142 return JIM_ERR;
14144 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14145 return JIM_OK;
14148 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14150 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14151 return JIM_ERR;
14153 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14154 return JIM_OK;
14157 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14159 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14160 return -1;
14162 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14165 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14167 Jim_HashTable *ht;
14168 unsigned int i;
14170 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14171 return JIM_ERR;
14174 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14176 /* Note that this uses internal knowledge of the hash table */
14177 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14179 for (i = 0; i < ht->size; i++) {
14180 Jim_HashEntry *he = ht->table[i];
14182 if (he) {
14183 printf("%d: ", i);
14185 while (he) {
14186 printf(" %s", Jim_String(he->key));
14187 he = he->next;
14189 printf("\n");
14192 return JIM_OK;
14195 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14197 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14199 Jim_AppendString(interp, prefixObj, " ", 1);
14200 Jim_AppendString(interp, prefixObj, subcmd, -1);
14202 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14205 /* [dict] */
14206 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14208 Jim_Obj *objPtr;
14209 int option;
14210 static const char * const options[] = {
14211 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14212 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14213 "replace", "update", NULL
14215 enum
14217 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14218 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14219 OPT_REPLACE, OPT_UPDATE,
14222 if (argc < 2) {
14223 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14224 return JIM_ERR;
14227 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14228 return JIM_ERR;
14231 switch (option) {
14232 case OPT_GET:
14233 if (argc < 3) {
14234 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14235 return JIM_ERR;
14237 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14238 JIM_ERRMSG) != JIM_OK) {
14239 return JIM_ERR;
14241 Jim_SetResult(interp, objPtr);
14242 return JIM_OK;
14244 case OPT_SET:
14245 if (argc < 5) {
14246 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14247 return JIM_ERR;
14249 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14251 case OPT_EXISTS:
14252 if (argc < 4) {
14253 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14254 return JIM_ERR;
14256 else {
14257 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14258 if (rc < 0) {
14259 return JIM_ERR;
14261 Jim_SetResultBool(interp, rc == JIM_OK);
14262 return JIM_OK;
14265 case OPT_UNSET:
14266 if (argc < 4) {
14267 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14268 return JIM_ERR;
14270 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14271 return JIM_ERR;
14273 return JIM_OK;
14275 case OPT_KEYS:
14276 if (argc != 3 && argc != 4) {
14277 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14278 return JIM_ERR;
14280 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14282 case OPT_SIZE:
14283 if (argc != 3) {
14284 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14285 return JIM_ERR;
14287 else if (Jim_DictSize(interp, argv[2]) < 0) {
14288 return JIM_ERR;
14290 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14291 return JIM_OK;
14293 case OPT_MERGE:
14294 if (argc == 2) {
14295 return JIM_OK;
14297 if (Jim_DictSize(interp, argv[2]) < 0) {
14298 return JIM_ERR;
14300 /* Handle as ensemble */
14301 break;
14303 case OPT_UPDATE:
14304 if (argc < 6 || argc % 2) {
14305 /* Better error message */
14306 argc = 2;
14308 break;
14310 case OPT_CREATE:
14311 if (argc % 2) {
14312 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14313 return JIM_ERR;
14315 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14316 Jim_SetResult(interp, objPtr);
14317 return JIM_OK;
14319 case OPT_INFO:
14320 if (argc != 3) {
14321 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14322 return JIM_ERR;
14324 return Jim_DictInfo(interp, argv[2]);
14326 /* Handle command as an ensemble */
14327 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14330 /* [subst] */
14331 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14333 static const char * const options[] = {
14334 "-nobackslashes", "-nocommands", "-novariables", NULL
14336 enum
14337 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14338 int i;
14339 int flags = JIM_SUBST_FLAG;
14340 Jim_Obj *objPtr;
14342 if (argc < 2) {
14343 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14344 return JIM_ERR;
14346 for (i = 1; i < (argc - 1); i++) {
14347 int option;
14349 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14350 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14351 return JIM_ERR;
14353 switch (option) {
14354 case OPT_NOBACKSLASHES:
14355 flags |= JIM_SUBST_NOESC;
14356 break;
14357 case OPT_NOCOMMANDS:
14358 flags |= JIM_SUBST_NOCMD;
14359 break;
14360 case OPT_NOVARIABLES:
14361 flags |= JIM_SUBST_NOVAR;
14362 break;
14365 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14366 return JIM_ERR;
14368 Jim_SetResult(interp, objPtr);
14369 return JIM_OK;
14372 /* [info] */
14373 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14375 int cmd;
14376 Jim_Obj *objPtr;
14377 int mode = 0;
14379 static const char * const commands[] = {
14380 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14381 "vars", "version", "patchlevel", "complete", "args", "hostname",
14382 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14383 "references", "alias", NULL
14385 enum
14386 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14387 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14388 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14389 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14392 #ifdef jim_ext_namespace
14393 int nons = 0;
14395 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14396 /* This is for internal use only */
14397 argc--;
14398 argv++;
14399 nons = 1;
14401 #endif
14403 if (argc < 2) {
14404 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14405 return JIM_ERR;
14407 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14408 != JIM_OK) {
14409 return JIM_ERR;
14412 /* Test for the most common commands first, just in case it makes a difference */
14413 switch (cmd) {
14414 case INFO_EXISTS:
14415 if (argc != 3) {
14416 Jim_WrongNumArgs(interp, 2, argv, "varName");
14417 return JIM_ERR;
14419 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14420 break;
14422 case INFO_ALIAS:{
14423 Jim_Cmd *cmdPtr;
14425 if (argc != 3) {
14426 Jim_WrongNumArgs(interp, 2, argv, "command");
14427 return JIM_ERR;
14429 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14430 return JIM_ERR;
14432 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14433 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14434 return JIM_ERR;
14436 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14437 return JIM_OK;
14440 case INFO_CHANNELS:
14441 mode++; /* JIM_CMDLIST_CHANNELS */
14442 #ifndef jim_ext_aio
14443 Jim_SetResultString(interp, "aio not enabled", -1);
14444 return JIM_ERR;
14445 #endif
14446 /* fall through */
14447 case INFO_PROCS:
14448 mode++; /* JIM_CMDLIST_PROCS */
14449 /* fall through */
14450 case INFO_COMMANDS:
14451 /* mode 0 => JIM_CMDLIST_COMMANDS */
14452 if (argc != 2 && argc != 3) {
14453 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14454 return JIM_ERR;
14456 #ifdef jim_ext_namespace
14457 if (!nons) {
14458 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14459 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14462 #endif
14463 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14464 break;
14466 case INFO_VARS:
14467 mode++; /* JIM_VARLIST_VARS */
14468 /* fall through */
14469 case INFO_LOCALS:
14470 mode++; /* JIM_VARLIST_LOCALS */
14471 /* fall through */
14472 case INFO_GLOBALS:
14473 /* mode 0 => JIM_VARLIST_GLOBALS */
14474 if (argc != 2 && argc != 3) {
14475 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14476 return JIM_ERR;
14478 #ifdef jim_ext_namespace
14479 if (!nons) {
14480 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14481 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14484 #endif
14485 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14486 break;
14488 case INFO_SCRIPT:
14489 if (argc != 2) {
14490 Jim_WrongNumArgs(interp, 2, argv, "");
14491 return JIM_ERR;
14493 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14494 break;
14496 case INFO_SOURCE:{
14497 jim_wide line;
14498 Jim_Obj *resObjPtr;
14499 Jim_Obj *fileNameObj;
14501 if (argc != 3 && argc != 5) {
14502 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14503 return JIM_ERR;
14505 if (argc == 5) {
14506 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14507 return JIM_ERR;
14509 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14510 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14512 else {
14513 if (argv[2]->typePtr == &sourceObjType) {
14514 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14515 line = argv[2]->internalRep.sourceValue.lineNumber;
14517 else if (argv[2]->typePtr == &scriptObjType) {
14518 ScriptObj *script = JimGetScript(interp, argv[2]);
14519 fileNameObj = script->fileNameObj;
14520 line = script->firstline;
14522 else {
14523 fileNameObj = interp->emptyObj;
14524 line = 1;
14526 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14527 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14528 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14530 Jim_SetResult(interp, resObjPtr);
14531 break;
14534 case INFO_STACKTRACE:
14535 Jim_SetResult(interp, interp->stackTrace);
14536 break;
14538 case INFO_LEVEL:
14539 case INFO_FRAME:
14540 switch (argc) {
14541 case 2:
14542 Jim_SetResultInt(interp, interp->framePtr->level);
14543 break;
14545 case 3:
14546 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14547 return JIM_ERR;
14549 Jim_SetResult(interp, objPtr);
14550 break;
14552 default:
14553 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14554 return JIM_ERR;
14556 break;
14558 case INFO_BODY:
14559 case INFO_STATICS:
14560 case INFO_ARGS:{
14561 Jim_Cmd *cmdPtr;
14563 if (argc != 3) {
14564 Jim_WrongNumArgs(interp, 2, argv, "procname");
14565 return JIM_ERR;
14567 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14568 return JIM_ERR;
14570 if (!cmdPtr->isproc) {
14571 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14572 return JIM_ERR;
14574 switch (cmd) {
14575 case INFO_BODY:
14576 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14577 break;
14578 case INFO_ARGS:
14579 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14580 break;
14581 case INFO_STATICS:
14582 if (cmdPtr->u.proc.staticVars) {
14583 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14584 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14585 NULL, JimVariablesMatch, mode));
14587 break;
14589 break;
14592 case INFO_VERSION:
14593 case INFO_PATCHLEVEL:{
14594 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14596 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14597 Jim_SetResultString(interp, buf, -1);
14598 break;
14601 case INFO_COMPLETE:
14602 if (argc != 3 && argc != 4) {
14603 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14604 return JIM_ERR;
14606 else {
14607 int len;
14608 const char *s = Jim_GetString(argv[2], &len);
14609 char missing;
14611 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14612 if (missing != ' ' && argc == 4) {
14613 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14616 break;
14618 case INFO_HOSTNAME:
14619 /* Redirect to os.gethostname if it exists */
14620 return Jim_Eval(interp, "os.gethostname");
14622 case INFO_NAMEOFEXECUTABLE:
14623 /* Redirect to Tcl proc */
14624 return Jim_Eval(interp, "{info nameofexecutable}");
14626 case INFO_RETURNCODES:
14627 if (argc == 2) {
14628 int i;
14629 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14631 for (i = 0; jimReturnCodes[i]; i++) {
14632 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14633 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14634 jimReturnCodes[i], -1));
14637 Jim_SetResult(interp, listObjPtr);
14639 else if (argc == 3) {
14640 long code;
14641 const char *name;
14643 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14644 return JIM_ERR;
14646 name = Jim_ReturnCode(code);
14647 if (*name == '?') {
14648 Jim_SetResultInt(interp, code);
14650 else {
14651 Jim_SetResultString(interp, name, -1);
14654 else {
14655 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14656 return JIM_ERR;
14658 break;
14659 case INFO_REFERENCES:
14660 #ifdef JIM_REFERENCES
14661 return JimInfoReferences(interp, argc, argv);
14662 #else
14663 Jim_SetResultString(interp, "not supported", -1);
14664 return JIM_ERR;
14665 #endif
14667 return JIM_OK;
14670 /* [exists] */
14671 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14673 Jim_Obj *objPtr;
14674 int result = 0;
14676 static const char * const options[] = {
14677 "-command", "-proc", "-alias", "-var", NULL
14679 enum
14681 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14683 int option;
14685 if (argc == 2) {
14686 option = OPT_VAR;
14687 objPtr = argv[1];
14689 else if (argc == 3) {
14690 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14691 return JIM_ERR;
14693 objPtr = argv[2];
14695 else {
14696 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14697 return JIM_ERR;
14700 if (option == OPT_VAR) {
14701 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14703 else {
14704 /* Now different kinds of commands */
14705 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14707 if (cmd) {
14708 switch (option) {
14709 case OPT_COMMAND:
14710 result = 1;
14711 break;
14713 case OPT_ALIAS:
14714 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14715 break;
14717 case OPT_PROC:
14718 result = cmd->isproc;
14719 break;
14723 Jim_SetResultBool(interp, result);
14724 return JIM_OK;
14727 /* [split] */
14728 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14730 const char *str, *splitChars, *noMatchStart;
14731 int splitLen, strLen;
14732 Jim_Obj *resObjPtr;
14733 int c;
14734 int len;
14736 if (argc != 2 && argc != 3) {
14737 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14738 return JIM_ERR;
14741 str = Jim_GetString(argv[1], &len);
14742 if (len == 0) {
14743 return JIM_OK;
14745 strLen = Jim_Utf8Length(interp, argv[1]);
14747 /* Init */
14748 if (argc == 2) {
14749 splitChars = " \n\t\r";
14750 splitLen = 4;
14752 else {
14753 splitChars = Jim_String(argv[2]);
14754 splitLen = Jim_Utf8Length(interp, argv[2]);
14757 noMatchStart = str;
14758 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14760 /* Split */
14761 if (splitLen) {
14762 Jim_Obj *objPtr;
14763 while (strLen--) {
14764 const char *sc = splitChars;
14765 int scLen = splitLen;
14766 int sl = utf8_tounicode(str, &c);
14767 while (scLen--) {
14768 int pc;
14769 sc += utf8_tounicode(sc, &pc);
14770 if (c == pc) {
14771 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14772 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14773 noMatchStart = str + sl;
14774 break;
14777 str += sl;
14779 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14780 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14782 else {
14783 /* This handles the special case of splitchars eq {}
14784 * Optimise by sharing common (ASCII) characters
14786 Jim_Obj **commonObj = NULL;
14787 #define NUM_COMMON (128 - 9)
14788 while (strLen--) {
14789 int n = utf8_tounicode(str, &c);
14790 #ifdef JIM_OPTIMIZATION
14791 if (c >= 9 && c < 128) {
14792 /* Common ASCII char. Note that 9 is the tab character */
14793 c -= 9;
14794 if (!commonObj) {
14795 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14796 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14798 if (!commonObj[c]) {
14799 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14801 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14802 str++;
14803 continue;
14805 #endif
14806 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14807 str += n;
14809 Jim_Free(commonObj);
14812 Jim_SetResult(interp, resObjPtr);
14813 return JIM_OK;
14816 /* [join] */
14817 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14819 const char *joinStr;
14820 int joinStrLen;
14822 if (argc != 2 && argc != 3) {
14823 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14824 return JIM_ERR;
14826 /* Init */
14827 if (argc == 2) {
14828 joinStr = " ";
14829 joinStrLen = 1;
14831 else {
14832 joinStr = Jim_GetString(argv[2], &joinStrLen);
14834 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14835 return JIM_OK;
14838 /* [format] */
14839 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14841 Jim_Obj *objPtr;
14843 if (argc < 2) {
14844 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14845 return JIM_ERR;
14847 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14848 if (objPtr == NULL)
14849 return JIM_ERR;
14850 Jim_SetResult(interp, objPtr);
14851 return JIM_OK;
14854 /* [scan] */
14855 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14857 Jim_Obj *listPtr, **outVec;
14858 int outc, i;
14860 if (argc < 3) {
14861 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14862 return JIM_ERR;
14864 if (argv[2]->typePtr != &scanFmtStringObjType)
14865 SetScanFmtFromAny(interp, argv[2]);
14866 if (FormatGetError(argv[2]) != 0) {
14867 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14868 return JIM_ERR;
14870 if (argc > 3) {
14871 int maxPos = FormatGetMaxPos(argv[2]);
14872 int count = FormatGetCnvCount(argv[2]);
14874 if (maxPos > argc - 3) {
14875 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14876 return JIM_ERR;
14878 else if (count > argc - 3) {
14879 Jim_SetResultString(interp, "different numbers of variable names and "
14880 "field specifiers", -1);
14881 return JIM_ERR;
14883 else if (count < argc - 3) {
14884 Jim_SetResultString(interp, "variable is not assigned by any "
14885 "conversion specifiers", -1);
14886 return JIM_ERR;
14889 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14890 if (listPtr == 0)
14891 return JIM_ERR;
14892 if (argc > 3) {
14893 int rc = JIM_OK;
14894 int count = 0;
14896 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14897 int len = Jim_ListLength(interp, listPtr);
14899 if (len != 0) {
14900 JimListGetElements(interp, listPtr, &outc, &outVec);
14901 for (i = 0; i < outc; ++i) {
14902 if (Jim_Length(outVec[i]) > 0) {
14903 ++count;
14904 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14905 rc = JIM_ERR;
14910 Jim_FreeNewObj(interp, listPtr);
14912 else {
14913 count = -1;
14915 if (rc == JIM_OK) {
14916 Jim_SetResultInt(interp, count);
14918 return rc;
14920 else {
14921 if (listPtr == (Jim_Obj *)EOF) {
14922 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14923 return JIM_OK;
14925 Jim_SetResult(interp, listPtr);
14927 return JIM_OK;
14930 /* [error] */
14931 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14933 if (argc != 2 && argc != 3) {
14934 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14935 return JIM_ERR;
14937 Jim_SetResult(interp, argv[1]);
14938 if (argc == 3) {
14939 JimSetStackTrace(interp, argv[2]);
14940 return JIM_ERR;
14942 interp->addStackTrace++;
14943 return JIM_ERR;
14946 /* [lrange] */
14947 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14949 Jim_Obj *objPtr;
14951 if (argc != 4) {
14952 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14953 return JIM_ERR;
14955 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14956 return JIM_ERR;
14957 Jim_SetResult(interp, objPtr);
14958 return JIM_OK;
14961 /* [lrepeat] */
14962 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14964 Jim_Obj *objPtr;
14965 long count;
14967 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14968 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14969 return JIM_ERR;
14972 if (count == 0 || argc == 2) {
14973 return JIM_OK;
14976 argc -= 2;
14977 argv += 2;
14979 objPtr = Jim_NewListObj(interp, argv, argc);
14980 while (--count) {
14981 ListInsertElements(objPtr, -1, argc, argv);
14984 Jim_SetResult(interp, objPtr);
14985 return JIM_OK;
14988 char **Jim_GetEnviron(void)
14990 #if defined(HAVE__NSGETENVIRON)
14991 return *_NSGetEnviron();
14992 #else
14993 #if !defined(NO_ENVIRON_EXTERN)
14994 extern char **environ;
14995 #endif
14997 return environ;
14998 #endif
15001 void Jim_SetEnviron(char **env)
15003 #if defined(HAVE__NSGETENVIRON)
15004 *_NSGetEnviron() = env;
15005 #else
15006 #if !defined(NO_ENVIRON_EXTERN)
15007 extern char **environ;
15008 #endif
15010 environ = env;
15011 #endif
15014 /* [env] */
15015 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15017 const char *key;
15018 const char *val;
15020 if (argc == 1) {
15021 char **e = Jim_GetEnviron();
15023 int i;
15024 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15026 for (i = 0; e[i]; i++) {
15027 const char *equals = strchr(e[i], '=');
15029 if (equals) {
15030 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15031 equals - e[i]));
15032 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15036 Jim_SetResult(interp, listObjPtr);
15037 return JIM_OK;
15040 if (argc < 2) {
15041 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15042 return JIM_ERR;
15044 key = Jim_String(argv[1]);
15045 val = getenv(key);
15046 if (val == NULL) {
15047 if (argc < 3) {
15048 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15049 return JIM_ERR;
15051 val = Jim_String(argv[2]);
15053 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15054 return JIM_OK;
15057 /* [source] */
15058 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15060 int retval;
15062 if (argc != 2) {
15063 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15064 return JIM_ERR;
15066 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15067 if (retval == JIM_RETURN)
15068 return JIM_OK;
15069 return retval;
15072 /* [lreverse] */
15073 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15075 Jim_Obj *revObjPtr, **ele;
15076 int len;
15078 if (argc != 2) {
15079 Jim_WrongNumArgs(interp, 1, argv, "list");
15080 return JIM_ERR;
15082 JimListGetElements(interp, argv[1], &len, &ele);
15083 len--;
15084 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15085 while (len >= 0)
15086 ListAppendElement(revObjPtr, ele[len--]);
15087 Jim_SetResult(interp, revObjPtr);
15088 return JIM_OK;
15091 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15093 jim_wide len;
15095 if (step == 0)
15096 return -1;
15097 if (start == end)
15098 return 0;
15099 else if (step > 0 && start > end)
15100 return -1;
15101 else if (step < 0 && end > start)
15102 return -1;
15103 len = end - start;
15104 if (len < 0)
15105 len = -len; /* abs(len) */
15106 if (step < 0)
15107 step = -step; /* abs(step) */
15108 len = 1 + ((len - 1) / step);
15109 /* We can truncate safely to INT_MAX, the range command
15110 * will always return an error for a such long range
15111 * because Tcl lists can't be so long. */
15112 if (len > INT_MAX)
15113 len = INT_MAX;
15114 return (int)((len < 0) ? -1 : len);
15117 /* [range] */
15118 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15120 jim_wide start = 0, end, step = 1;
15121 int len, i;
15122 Jim_Obj *objPtr;
15124 if (argc < 2 || argc > 4) {
15125 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15126 return JIM_ERR;
15128 if (argc == 2) {
15129 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15130 return JIM_ERR;
15132 else {
15133 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15134 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15135 return JIM_ERR;
15136 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15137 return JIM_ERR;
15139 if ((len = JimRangeLen(start, end, step)) == -1) {
15140 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15141 return JIM_ERR;
15143 objPtr = Jim_NewListObj(interp, NULL, 0);
15144 for (i = 0; i < len; i++)
15145 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15146 Jim_SetResult(interp, objPtr);
15147 return JIM_OK;
15150 /* [rand] */
15151 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15153 jim_wide min = 0, max = 0, len, maxMul;
15155 if (argc < 1 || argc > 3) {
15156 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15157 return JIM_ERR;
15159 if (argc == 1) {
15160 max = JIM_WIDE_MAX;
15161 } else if (argc == 2) {
15162 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15163 return JIM_ERR;
15164 } else if (argc == 3) {
15165 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15166 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15167 return JIM_ERR;
15169 len = max-min;
15170 if (len < 0) {
15171 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15172 return JIM_ERR;
15174 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15175 while (1) {
15176 jim_wide r;
15178 JimRandomBytes(interp, &r, sizeof(jim_wide));
15179 if (r < 0 || r >= maxMul) continue;
15180 r = (len == 0) ? 0 : r%len;
15181 Jim_SetResultInt(interp, min+r);
15182 return JIM_OK;
15186 static const struct {
15187 const char *name;
15188 Jim_CmdProc *cmdProc;
15189 } Jim_CoreCommandsTable[] = {
15190 {"alias", Jim_AliasCoreCommand},
15191 {"set", Jim_SetCoreCommand},
15192 {"unset", Jim_UnsetCoreCommand},
15193 {"puts", Jim_PutsCoreCommand},
15194 {"+", Jim_AddCoreCommand},
15195 {"*", Jim_MulCoreCommand},
15196 {"-", Jim_SubCoreCommand},
15197 {"/", Jim_DivCoreCommand},
15198 {"incr", Jim_IncrCoreCommand},
15199 {"while", Jim_WhileCoreCommand},
15200 {"loop", Jim_LoopCoreCommand},
15201 {"for", Jim_ForCoreCommand},
15202 {"foreach", Jim_ForeachCoreCommand},
15203 {"lmap", Jim_LmapCoreCommand},
15204 {"lassign", Jim_LassignCoreCommand},
15205 {"if", Jim_IfCoreCommand},
15206 {"switch", Jim_SwitchCoreCommand},
15207 {"list", Jim_ListCoreCommand},
15208 {"lindex", Jim_LindexCoreCommand},
15209 {"lset", Jim_LsetCoreCommand},
15210 {"lsearch", Jim_LsearchCoreCommand},
15211 {"llength", Jim_LlengthCoreCommand},
15212 {"lappend", Jim_LappendCoreCommand},
15213 {"linsert", Jim_LinsertCoreCommand},
15214 {"lreplace", Jim_LreplaceCoreCommand},
15215 {"lsort", Jim_LsortCoreCommand},
15216 {"append", Jim_AppendCoreCommand},
15217 {"debug", Jim_DebugCoreCommand},
15218 {"eval", Jim_EvalCoreCommand},
15219 {"uplevel", Jim_UplevelCoreCommand},
15220 {"expr", Jim_ExprCoreCommand},
15221 {"break", Jim_BreakCoreCommand},
15222 {"continue", Jim_ContinueCoreCommand},
15223 {"proc", Jim_ProcCoreCommand},
15224 {"concat", Jim_ConcatCoreCommand},
15225 {"return", Jim_ReturnCoreCommand},
15226 {"upvar", Jim_UpvarCoreCommand},
15227 {"global", Jim_GlobalCoreCommand},
15228 {"string", Jim_StringCoreCommand},
15229 {"time", Jim_TimeCoreCommand},
15230 {"exit", Jim_ExitCoreCommand},
15231 {"catch", Jim_CatchCoreCommand},
15232 #ifdef JIM_REFERENCES
15233 {"ref", Jim_RefCoreCommand},
15234 {"getref", Jim_GetrefCoreCommand},
15235 {"setref", Jim_SetrefCoreCommand},
15236 {"finalize", Jim_FinalizeCoreCommand},
15237 {"collect", Jim_CollectCoreCommand},
15238 #endif
15239 {"rename", Jim_RenameCoreCommand},
15240 {"dict", Jim_DictCoreCommand},
15241 {"subst", Jim_SubstCoreCommand},
15242 {"info", Jim_InfoCoreCommand},
15243 {"exists", Jim_ExistsCoreCommand},
15244 {"split", Jim_SplitCoreCommand},
15245 {"join", Jim_JoinCoreCommand},
15246 {"format", Jim_FormatCoreCommand},
15247 {"scan", Jim_ScanCoreCommand},
15248 {"error", Jim_ErrorCoreCommand},
15249 {"lrange", Jim_LrangeCoreCommand},
15250 {"lrepeat", Jim_LrepeatCoreCommand},
15251 {"env", Jim_EnvCoreCommand},
15252 {"source", Jim_SourceCoreCommand},
15253 {"lreverse", Jim_LreverseCoreCommand},
15254 {"range", Jim_RangeCoreCommand},
15255 {"rand", Jim_RandCoreCommand},
15256 {"tailcall", Jim_TailcallCoreCommand},
15257 {"local", Jim_LocalCoreCommand},
15258 {"upcall", Jim_UpcallCoreCommand},
15259 {"apply", Jim_ApplyCoreCommand},
15260 {NULL, NULL},
15263 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15265 int i = 0;
15267 while (Jim_CoreCommandsTable[i].name != NULL) {
15268 Jim_CreateCommand(interp,
15269 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15270 i++;
15274 /* -----------------------------------------------------------------------------
15275 * Interactive prompt
15276 * ---------------------------------------------------------------------------*/
15277 void Jim_MakeErrorMessage(Jim_Interp *interp)
15279 Jim_Obj *argv[2];
15281 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15282 argv[1] = interp->result;
15284 Jim_EvalObjVector(interp, 2, argv);
15287 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15288 const char *prefix, const char *const *tablePtr, const char *name)
15290 int count;
15291 char **tablePtrSorted;
15292 int i;
15294 for (count = 0; tablePtr[count]; count++) {
15297 if (name == NULL) {
15298 name = "option";
15301 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15302 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15303 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15304 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15305 for (i = 0; i < count; i++) {
15306 if (i + 1 == count && count > 1) {
15307 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15309 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15310 if (i + 1 != count) {
15311 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15314 Jim_Free(tablePtrSorted);
15317 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15318 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15320 const char *bad = "bad ";
15321 const char *const *entryPtr = NULL;
15322 int i;
15323 int match = -1;
15324 int arglen;
15325 const char *arg = Jim_GetString(objPtr, &arglen);
15327 *indexPtr = -1;
15329 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15330 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15331 /* Found an exact match */
15332 *indexPtr = i;
15333 return JIM_OK;
15335 if (flags & JIM_ENUM_ABBREV) {
15336 /* Accept an unambiguous abbreviation.
15337 * Note that '-' doesnt' consitute a valid abbreviation
15339 if (strncmp(arg, *entryPtr, arglen) == 0) {
15340 if (*arg == '-' && arglen == 1) {
15341 break;
15343 if (match >= 0) {
15344 bad = "ambiguous ";
15345 goto ambiguous;
15347 match = i;
15352 /* If we had an unambiguous partial match */
15353 if (match >= 0) {
15354 *indexPtr = match;
15355 return JIM_OK;
15358 ambiguous:
15359 if (flags & JIM_ERRMSG) {
15360 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15362 return JIM_ERR;
15365 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15367 int i;
15369 for (i = 0; i < (int)len; i++) {
15370 if (array[i] && strcmp(array[i], name) == 0) {
15371 return i;
15374 return -1;
15377 int Jim_IsDict(Jim_Obj *objPtr)
15379 return objPtr->typePtr == &dictObjType;
15382 int Jim_IsList(Jim_Obj *objPtr)
15384 return objPtr->typePtr == &listObjType;
15388 * Very simple printf-like formatting, designed for error messages.
15390 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15391 * The resulting string is created and set as the result.
15393 * Each '%s' should correspond to a regular string parameter.
15394 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15395 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15397 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15399 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15401 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15403 /* Initial space needed */
15404 int len = strlen(format);
15405 int extra = 0;
15406 int n = 0;
15407 const char *params[5];
15408 char *buf;
15409 va_list args;
15410 int i;
15412 va_start(args, format);
15414 for (i = 0; i < len && n < 5; i++) {
15415 int l;
15417 if (strncmp(format + i, "%s", 2) == 0) {
15418 params[n] = va_arg(args, char *);
15420 l = strlen(params[n]);
15422 else if (strncmp(format + i, "%#s", 3) == 0) {
15423 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15425 params[n] = Jim_GetString(objPtr, &l);
15427 else {
15428 if (format[i] == '%') {
15429 i++;
15431 continue;
15433 n++;
15434 extra += l;
15437 len += extra;
15438 buf = Jim_Alloc(len + 1);
15439 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15441 va_end(args);
15443 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15446 /* stubs */
15447 #ifndef jim_ext_package
15448 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15450 return JIM_OK;
15452 #endif
15453 #ifndef jim_ext_aio
15454 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15456 Jim_SetResultString(interp, "aio not enabled", -1);
15457 return NULL;
15459 #endif
15463 * Local Variables: ***
15464 * c-basic-offset: 4 ***
15465 * tab-width: 4 ***
15466 * End: ***