aio: optional argument addrvar for accept.
[jimtcl.git] / jim.c
blob76a192e2d1949eec43e956d9779ce7ed4f731be4
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
130 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
131 int flags);
132 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
133 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
134 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
135 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
136 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
137 const char *prefix, const char *const *tablePtr, const char *name);
138 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
139 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
140 static int JimSign(jim_wide w);
141 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
142 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
143 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s, int *uc, int upper)
153 int l = utf8_tounicode(s, uc);
154 if (upper) {
155 *uc = utf8_upper(*uc);
157 return l;
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
182 int not = 0;
183 int pchar;
184 int match = 0;
185 int nocase = 0;
187 if (flags & JIM_NOCASE) {
188 nocase++;
189 c = utf8_upper(c);
192 if (flags & JIM_CHARSET_SCAN) {
193 if (*pattern == '^') {
194 not++;
195 pattern++;
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern == ']') {
200 goto first;
204 while (*pattern && *pattern != ']') {
205 /* Exact match */
206 if (pattern[0] == '\\') {
207 first:
208 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
210 else {
211 /* Is this a range? a-z */
212 int start;
213 int end;
215 pattern += utf8_tounicode_case(pattern, &start, nocase);
216 if (pattern[0] == '-' && pattern[1]) {
217 /* skip '-' */
218 pattern += utf8_tounicode(pattern, &pchar);
219 pattern += utf8_tounicode_case(pattern, &end, nocase);
221 /* Handle reversed range too */
222 if ((c >= start && c <= end) || (c >= end && c <= start)) {
223 match = 1;
225 continue;
227 pchar = start;
230 if (pchar == c) {
231 match = 1;
234 if (not) {
235 match = !match;
238 return match ? pattern : NULL;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
247 int c;
248 int pchar;
249 while (*pattern) {
250 switch (pattern[0]) {
251 case '*':
252 while (pattern[1] == '*') {
253 pattern++;
255 pattern++;
256 if (!pattern[0]) {
257 return 1; /* match */
259 while (*string) {
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern, string, nocase))
262 return 1; /* match */
263 string += utf8_tounicode(string, &c);
265 return 0; /* no match */
267 case '?':
268 string += utf8_tounicode(string, &c);
269 break;
271 case '[': {
272 string += utf8_tounicode(string, &c);
273 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
274 if (!pattern) {
275 return 0;
277 if (!*pattern) {
278 /* Ran out of pattern (no ']') */
279 continue;
281 break;
283 case '\\':
284 if (pattern[1]) {
285 pattern++;
287 /* fall through */
288 default:
289 string += utf8_tounicode_case(string, &c, nocase);
290 utf8_tounicode_case(pattern, &pchar, nocase);
291 if (pchar != c) {
292 return 0;
294 break;
296 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
297 if (!*string) {
298 while (*pattern == '*') {
299 pattern++;
301 break;
304 if (!*pattern && !*string) {
305 return 1;
307 return 0;
311 * string comparison. Works on binary data.
313 * Returns -1, 0 or 1
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
319 if (l1 < l2) {
320 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
322 else if (l2 < l1) {
323 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
325 else {
326 return JimSign(memcmp(s1, s2, l1));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
340 while (*s1 && *s2 && maxchars) {
341 int c1, c2;
342 s1 += utf8_tounicode_case(s1, &c1, nocase);
343 s2 += utf8_tounicode_case(s2, &c2, nocase);
344 if (c1 != c2) {
345 return JimSign(c1 - c2);
347 maxchars--;
349 if (!maxchars) {
350 return 0;
352 /* One string or both terminated */
353 if (*s1) {
354 return 1;
356 if (*s2) {
357 return -1;
359 return 0;
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
367 int i;
368 int l1bytelen;
370 if (!l1 || !l2 || l1 > l2) {
371 return -1;
373 if (idx < 0)
374 idx = 0;
375 s2 += utf8_index(s2, idx);
377 l1bytelen = utf8_index(s1, l1);
379 for (i = idx; i <= l2 - l1; i++) {
380 int c;
381 if (memcmp(s2, s1, l1bytelen) == 0) {
382 return i;
384 s2 += utf8_tounicode(s2, &c);
386 return -1;
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
394 const char *p;
396 if (!l1 || !l2 || l1 > l2)
397 return -1;
399 /* Now search for the needle */
400 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
401 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
402 return p - s2;
405 return -1;
408 #ifdef JIM_UTF8
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
414 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
415 if (n > 0) {
416 n = utf8_strlen(s2, n);
418 return n;
420 #endif
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str, const char *endptr)
431 if (str[0] == '\0' || str == endptr) {
432 return JIM_ERR;
435 if (endptr[0] != '\0') {
436 while (*endptr) {
437 if (!isspace(UCHAR(*endptr))) {
438 return JIM_ERR;
440 endptr++;
443 return JIM_OK;
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str, int *base, int *sign)
451 int i = 0;
453 *base = 10;
455 while (isspace(UCHAR(str[i]))) {
456 i++;
459 if (str[i] == '-') {
460 *sign = -1;
461 i++;
463 else {
464 if (str[i] == '+') {
465 i++;
467 *sign = 1;
470 if (str[i] != '0') {
471 /* base 10 */
472 return 0;
475 /* We have 0<x>, so see if we can convert it */
476 switch (str[i + 1]) {
477 case 'x': case 'X': *base = 16; break;
478 case 'o': case 'O': *base = 8; break;
479 case 'b': case 'B': *base = 2; break;
480 default: return 0;
482 i += 2;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
485 /* Parse according to this base */
486 return i;
488 /* Parse as base 10 */
489 *base = 10;
490 return 0;
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str, char **endptr)
498 int sign;
499 int base;
500 int i = JimNumberBase(str, &base, &sign);
502 if (base != 10) {
503 long value = strtol(str + i, endptr, base);
504 if (endptr == NULL || *endptr != str + i) {
505 return value * sign;
509 /* Can just do a regular base-10 conversion */
510 return strtol(str, endptr, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide jim_strtoull(const char *str, char **endptr)
519 #ifdef HAVE_LONG_LONG
520 int sign;
521 int base;
522 int i = JimNumberBase(str, &base, &sign);
524 if (base != 10) {
525 jim_wide value = strtoull(str + i, endptr, base);
526 if (endptr == NULL || *endptr != str + i) {
527 return value * sign;
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str, endptr, 10);
533 #else
534 return (unsigned long)jim_strtol(str, endptr);
535 #endif
538 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
540 char *endptr;
542 if (base) {
543 *widePtr = strtoull(str, &endptr, base);
545 else {
546 *widePtr = jim_strtoull(str, &endptr);
549 return JimCheckConversion(str, endptr);
552 int Jim_StringToDouble(const char *str, double *doublePtr)
554 char *endptr;
556 /* Callers can check for underflow via ERANGE */
557 errno = 0;
559 *doublePtr = strtod(str, &endptr);
561 return JimCheckConversion(str, endptr);
564 static jim_wide JimPowWide(jim_wide b, jim_wide e)
566 jim_wide i, res = 1;
568 if ((b == 0 && e != 0) || (e < 0))
569 return 0;
570 for (i = 0; i < e; i++) {
571 res *= b;
573 return res;
576 /* -----------------------------------------------------------------------------
577 * Special functions
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition, const char *fmt, ...)
582 va_list ap;
584 if (!condition) {
585 return;
588 va_start(ap, fmt);
590 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr, fmt, ap);
592 fprintf(stderr, "\n\n");
593 va_end(ap);
595 #ifdef HAVE_BACKTRACE
597 void *array[40];
598 int size, i;
599 char **strings;
601 size = backtrace(array, 40);
602 strings = backtrace_symbols(array, size);
603 for (i = 0; i < size; i++)
604 fprintf(stderr, "[backtrace] %s\n", strings[i]);
605 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
608 #endif
610 exit(1);
612 #endif
614 /* -----------------------------------------------------------------------------
615 * Memory allocation
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size)
620 return size ? malloc(size) : NULL;
623 void Jim_Free(void *ptr)
625 free(ptr);
628 void *Jim_Realloc(void *ptr, int size)
630 return realloc(ptr, size);
633 char *Jim_StrDup(const char *s)
635 return strdup(s);
638 char *Jim_StrDupLen(const char *s, int l)
640 char *copy = Jim_Alloc(l + 1);
642 memcpy(copy, s, l + 1);
643 copy[l] = 0; /* Just to be sure, original could be substring */
644 return copy;
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide JimClock(void)
654 struct timeval tv;
656 gettimeofday(&tv, NULL);
657 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
660 /* -----------------------------------------------------------------------------
661 * Hash Tables
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
666 static unsigned int JimHashTableNextPower(unsigned int size);
667 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key)
674 key += ~(key << 15);
675 key ^= (key >> 10);
676 key += (key << 3);
677 key ^= (key >> 6);
678 key += ~(key << 11);
679 key ^= (key >> 16);
680 return key;
683 /* Generic hash function (we are using to multiply by 9 and add the byte
684 * as Tcl) */
685 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
687 unsigned int h = 0;
689 while (len--)
690 h += (h << 3) + *buf++;
691 return h;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable *ht)
699 ht->table = NULL;
700 ht->size = 0;
701 ht->sizemask = 0;
702 ht->used = 0;
703 ht->collisions = 0;
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht->uniq = (rand() ^ time(NULL) ^ clock());
709 #else
710 ht->uniq = 0;
711 #endif
714 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
716 iter->ht = ht;
717 iter->index = -1;
718 iter->entry = NULL;
719 iter->nextEntry = NULL;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
725 JimResetHashTable(ht);
726 ht->type = type;
727 ht->privdata = privDataPtr;
728 return JIM_OK;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable *ht)
735 int minimal = ht->used;
737 if (minimal < JIM_HT_INITIAL_SIZE)
738 minimal = JIM_HT_INITIAL_SIZE;
739 Jim_ExpandHashTable(ht, minimal);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
745 Jim_HashTable n; /* the new hashtable */
746 unsigned int realsize = JimHashTableNextPower(size), i;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size <= ht->used)
751 return;
753 Jim_InitHashTable(&n, ht->type, ht->privdata);
754 n.size = realsize;
755 n.sizemask = realsize - 1;
756 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
757 /* Keep the same 'uniq' as the original */
758 n.uniq = ht->uniq;
760 /* Initialize all the pointers to NULL */
761 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
766 n.used = ht->used;
767 for (i = 0; ht->used > 0; i++) {
768 Jim_HashEntry *he, *nextHe;
770 if (ht->table[i] == NULL)
771 continue;
773 /* For each hash entry on this slot... */
774 he = ht->table[i];
775 while (he) {
776 unsigned int h;
778 nextHe = he->next;
779 /* Get the new element index */
780 h = Jim_HashKey(ht, he->key) & n.sizemask;
781 he->next = n.table[h];
782 n.table[h] = he;
783 ht->used--;
784 /* Pass to the next element */
785 he = nextHe;
788 assert(ht->used == 0);
789 Jim_Free(ht->table);
791 /* Remap the new hashtable in the old */
792 *ht = n;
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
798 Jim_HashEntry *entry;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry = JimInsertHashEntry(ht, key, 0);
803 if (entry == NULL)
804 return JIM_ERR;
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht, entry, key);
808 Jim_SetHashVal(ht, entry, val);
809 return JIM_OK;
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
815 int existed;
816 Jim_HashEntry *entry;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry = JimInsertHashEntry(ht, key, 1);
821 if (entry->key) {
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht->type->valDestructor && ht->type->valDup) {
828 void *newval = ht->type->valDup(ht->privdata, val);
829 ht->type->valDestructor(ht->privdata, entry->u.val);
830 entry->u.val = newval;
832 else {
833 Jim_FreeEntryVal(ht, entry);
834 Jim_SetHashVal(ht, entry, val);
836 existed = 1;
838 else {
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht, entry, key);
841 Jim_SetHashVal(ht, entry, val);
842 existed = 0;
845 return existed;
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
851 unsigned int h;
852 Jim_HashEntry *he, *prevHe;
854 if (ht->used == 0)
855 return JIM_ERR;
856 h = Jim_HashKey(ht, key) & ht->sizemask;
857 he = ht->table[h];
859 prevHe = NULL;
860 while (he) {
861 if (Jim_CompareHashKeys(ht, key, he->key)) {
862 /* Unlink the element from the list */
863 if (prevHe)
864 prevHe->next = he->next;
865 else
866 ht->table[h] = he->next;
867 Jim_FreeEntryKey(ht, he);
868 Jim_FreeEntryVal(ht, he);
869 Jim_Free(he);
870 ht->used--;
871 return JIM_OK;
873 prevHe = he;
874 he = he->next;
876 return JIM_ERR; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable *ht)
882 unsigned int i;
884 /* Free all the elements */
885 for (i = 0; ht->used > 0; i++) {
886 Jim_HashEntry *he, *nextHe;
888 if ((he = ht->table[i]) == NULL)
889 continue;
890 while (he) {
891 nextHe = he->next;
892 Jim_FreeEntryKey(ht, he);
893 Jim_FreeEntryVal(ht, he);
894 Jim_Free(he);
895 ht->used--;
896 he = nextHe;
899 /* Free the table and the allocated cache structure */
900 Jim_Free(ht->table);
901 /* Re-initialize the table */
902 JimResetHashTable(ht);
903 return JIM_OK; /* never fails */
906 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
908 Jim_HashEntry *he;
909 unsigned int h;
911 if (ht->used == 0)
912 return NULL;
913 h = Jim_HashKey(ht, key) & ht->sizemask;
914 he = ht->table[h];
915 while (he) {
916 if (Jim_CompareHashKeys(ht, key, he->key))
917 return he;
918 he = he->next;
920 return NULL;
923 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
925 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
926 JimInitHashTableIterator(ht, iter);
927 return iter;
930 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
932 while (1) {
933 if (iter->entry == NULL) {
934 iter->index++;
935 if (iter->index >= (signed)iter->ht->size)
936 break;
937 iter->entry = iter->ht->table[iter->index];
939 else {
940 iter->entry = iter->nextEntry;
942 if (iter->entry) {
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter->nextEntry = iter->entry->next;
946 return iter->entry;
949 return NULL;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
959 if (ht->size == 0)
960 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
961 if (ht->size == ht->used)
962 Jim_ExpandHashTable(ht, ht->size * 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size)
968 unsigned int i = JIM_HT_INITIAL_SIZE;
970 if (size >= 2147483648U)
971 return 2147483648U;
972 while (1) {
973 if (i >= size)
974 return i;
975 i *= 2;
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
984 unsigned int h;
985 Jim_HashEntry *he;
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht);
990 /* Compute the key hash value */
991 h = Jim_HashKey(ht, key) & ht->sizemask;
992 /* Search if this slot does not already contain the given key */
993 he = ht->table[h];
994 while (he) {
995 if (Jim_CompareHashKeys(ht, key, he->key))
996 return replace ? he : NULL;
997 he = he->next;
1000 /* Allocates the memory and stores key */
1001 he = Jim_Alloc(sizeof(*he));
1002 he->next = ht->table[h];
1003 ht->table[h] = he;
1004 ht->used++;
1005 he->key = NULL;
1007 return he;
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key)
1014 return Jim_GenHashFunction(key, strlen(key));
1017 static void *JimStringCopyHTDup(void *privdata, const void *key)
1019 return Jim_StrDup(key);
1022 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1024 return strcmp(key1, key2) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1029 Jim_Free(key);
1032 static const Jim_HashTableType JimPackageHashTableType = {
1033 JimStringCopyHTHashFunction, /* hash function */
1034 JimStringCopyHTDup, /* key dup */
1035 NULL, /* val dup */
1036 JimStringCopyHTKeyCompare, /* key compare */
1037 JimStringCopyHTKeyDestructor, /* key destructor */
1038 NULL /* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc *delProc;
1044 void *data;
1045 } AssocDataValue;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1049 AssocDataValue *assocPtr = (AssocDataValue *) data;
1051 if (assocPtr->delProc != NULL)
1052 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1053 Jim_Free(data);
1056 static const Jim_HashTableType JimAssocDataHashTableType = {
1057 JimStringCopyHTHashFunction, /* hash function */
1058 JimStringCopyHTDup, /* key dup */
1059 NULL, /* val dup */
1060 JimStringCopyHTKeyCompare, /* key compare */
1061 JimStringCopyHTKeyDestructor, /* key destructor */
1062 JimAssocDataHashTableValueDestructor /* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack *stack)
1071 stack->len = 0;
1072 stack->maxlen = 0;
1073 stack->vector = NULL;
1076 void Jim_FreeStack(Jim_Stack *stack)
1078 Jim_Free(stack->vector);
1081 int Jim_StackLen(Jim_Stack *stack)
1083 return stack->len;
1086 void Jim_StackPush(Jim_Stack *stack, void *element)
1088 int neededLen = stack->len + 1;
1090 if (neededLen > stack->maxlen) {
1091 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1092 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1094 stack->vector[stack->len] = element;
1095 stack->len++;
1098 void *Jim_StackPop(Jim_Stack *stack)
1100 if (stack->len == 0)
1101 return NULL;
1102 stack->len--;
1103 return stack->vector[stack->len];
1106 void *Jim_StackPeek(Jim_Stack *stack)
1108 if (stack->len == 0)
1109 return NULL;
1110 return stack->vector[stack->len - 1];
1113 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1115 int i;
1117 for (i = 0; i < stack->len; i++)
1118 freeFunc(stack->vector[i]);
1121 /* -----------------------------------------------------------------------------
1122 * Tcl Parser
1123 * ---------------------------------------------------------------------------*/
1125 /* Token types */
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1154 /* Parser states */
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing {
1163 int ch; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1164 int line; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1169 struct JimParserCtx
1171 const char *p; /* Pointer to the point of the program we are parsing */
1172 int len; /* Remaining length */
1173 int linenr; /* Current line number */
1174 const char *tstart;
1175 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline; /* Line number of the returned token */
1177 int tt; /* Token type */
1178 int eof; /* Non zero if EOF condition is true. */
1179 int state; /* Parser state */
1180 int comment; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx *pc);
1185 static int JimParseSep(struct JimParserCtx *pc);
1186 static int JimParseEol(struct JimParserCtx *pc);
1187 static int JimParseCmd(struct JimParserCtx *pc);
1188 static int JimParseQuote(struct JimParserCtx *pc);
1189 static int JimParseVar(struct JimParserCtx *pc);
1190 static int JimParseBrace(struct JimParserCtx *pc);
1191 static int JimParseStr(struct JimParserCtx *pc);
1192 static int JimParseComment(struct JimParserCtx *pc);
1193 static void JimParseSubCmd(struct JimParserCtx *pc);
1194 static int JimParseSubQuote(struct JimParserCtx *pc);
1195 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1202 pc->p = prg;
1203 pc->len = len;
1204 pc->tstart = NULL;
1205 pc->tend = NULL;
1206 pc->tline = 0;
1207 pc->tt = JIM_TT_NONE;
1208 pc->eof = 0;
1209 pc->state = JIM_PS_DEF;
1210 pc->linenr = linenr;
1211 pc->comment = 1;
1212 pc->missing.ch = ' ';
1213 pc->missing.line = linenr;
1216 static int JimParseScript(struct JimParserCtx *pc)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1219 if (!pc->len) {
1220 pc->tstart = pc->p;
1221 pc->tend = pc->p - 1;
1222 pc->tline = pc->linenr;
1223 pc->tt = JIM_TT_EOL;
1224 pc->eof = 1;
1225 return JIM_OK;
1227 switch (*(pc->p)) {
1228 case '\\':
1229 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1230 return JimParseSep(pc);
1232 pc->comment = 0;
1233 return JimParseStr(pc);
1234 case ' ':
1235 case '\t':
1236 case '\r':
1237 case '\f':
1238 if (pc->state == JIM_PS_DEF)
1239 return JimParseSep(pc);
1240 pc->comment = 0;
1241 return JimParseStr(pc);
1242 case '\n':
1243 case ';':
1244 pc->comment = 1;
1245 if (pc->state == JIM_PS_DEF)
1246 return JimParseEol(pc);
1247 return JimParseStr(pc);
1248 case '[':
1249 pc->comment = 0;
1250 return JimParseCmd(pc);
1251 case '$':
1252 pc->comment = 0;
1253 if (JimParseVar(pc) == JIM_ERR) {
1254 /* An orphan $. Create as a separate token */
1255 pc->tstart = pc->tend = pc->p++;
1256 pc->len--;
1257 pc->tt = JIM_TT_ESC;
1259 return JIM_OK;
1260 case '#':
1261 if (pc->comment) {
1262 JimParseComment(pc);
1263 continue;
1265 return JimParseStr(pc);
1266 default:
1267 pc->comment = 0;
1268 return JimParseStr(pc);
1270 return JIM_OK;
1274 static int JimParseSep(struct JimParserCtx *pc)
1276 pc->tstart = pc->p;
1277 pc->tline = pc->linenr;
1278 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1279 if (*pc->p == '\n') {
1280 break;
1282 if (*pc->p == '\\') {
1283 pc->p++;
1284 pc->len--;
1285 pc->linenr++;
1287 pc->p++;
1288 pc->len--;
1290 pc->tend = pc->p - 1;
1291 pc->tt = JIM_TT_SEP;
1292 return JIM_OK;
1295 static int JimParseEol(struct JimParserCtx *pc)
1297 pc->tstart = pc->p;
1298 pc->tline = pc->linenr;
1299 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1300 if (*pc->p == '\n')
1301 pc->linenr++;
1302 pc->p++;
1303 pc->len--;
1305 pc->tend = pc->p - 1;
1306 pc->tt = JIM_TT_EOL;
1307 return JIM_OK;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx *pc)
1340 int level = 1;
1342 /* Skip the brace */
1343 pc->p++;
1344 pc->len--;
1345 while (pc->len) {
1346 switch (*pc->p) {
1347 case '\\':
1348 if (pc->len > 1) {
1349 if (*++pc->p == '\n') {
1350 pc->linenr++;
1352 pc->len--;
1354 break;
1356 case '{':
1357 level++;
1358 break;
1360 case '}':
1361 if (--level == 0) {
1362 pc->tend = pc->p - 1;
1363 pc->p++;
1364 pc->len--;
1365 return;
1367 break;
1369 case '\n':
1370 pc->linenr++;
1371 break;
1373 pc->p++;
1374 pc->len--;
1376 pc->missing.ch = '{';
1377 pc->missing.line = pc->tline;
1378 pc->tend = pc->p - 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1389 * or JIM_TT_STR.
1391 static int JimParseSubQuote(struct JimParserCtx *pc)
1393 int tt = JIM_TT_STR;
1394 int line = pc->tline;
1396 /* Skip the quote */
1397 pc->p++;
1398 pc->len--;
1399 while (pc->len) {
1400 switch (*pc->p) {
1401 case '\\':
1402 if (pc->len > 1) {
1403 if (*++pc->p == '\n') {
1404 pc->linenr++;
1406 pc->len--;
1407 tt = JIM_TT_ESC;
1409 break;
1411 case '"':
1412 pc->tend = pc->p - 1;
1413 pc->p++;
1414 pc->len--;
1415 return tt;
1417 case '[':
1418 JimParseSubCmd(pc);
1419 tt = JIM_TT_ESC;
1420 continue;
1422 case '\n':
1423 pc->linenr++;
1424 break;
1426 case '$':
1427 tt = JIM_TT_ESC;
1428 break;
1430 pc->p++;
1431 pc->len--;
1433 pc->missing.ch = '"';
1434 pc->missing.line = line;
1435 pc->tend = pc->p - 1;
1436 return tt;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx *pc)
1447 int level = 1;
1448 int startofword = 1;
1449 int line = pc->tline;
1451 /* Skip the bracket */
1452 pc->p++;
1453 pc->len--;
1454 while (pc->len) {
1455 switch (*pc->p) {
1456 case '\\':
1457 if (pc->len > 1) {
1458 if (*++pc->p == '\n') {
1459 pc->linenr++;
1461 pc->len--;
1463 break;
1465 case '[':
1466 level++;
1467 break;
1469 case ']':
1470 if (--level == 0) {
1471 pc->tend = pc->p - 1;
1472 pc->p++;
1473 pc->len--;
1474 return;
1476 break;
1478 case '"':
1479 if (startofword) {
1480 JimParseSubQuote(pc);
1481 continue;
1483 break;
1485 case '{':
1486 JimParseSubBrace(pc);
1487 startofword = 0;
1488 continue;
1490 case '\n':
1491 pc->linenr++;
1492 break;
1494 startofword = isspace(UCHAR(*pc->p));
1495 pc->p++;
1496 pc->len--;
1498 pc->missing.ch = '[';
1499 pc->missing.line = line;
1500 pc->tend = pc->p - 1;
1503 static int JimParseBrace(struct JimParserCtx *pc)
1505 pc->tstart = pc->p + 1;
1506 pc->tline = pc->linenr;
1507 pc->tt = JIM_TT_STR;
1508 JimParseSubBrace(pc);
1509 return JIM_OK;
1512 static int JimParseCmd(struct JimParserCtx *pc)
1514 pc->tstart = pc->p + 1;
1515 pc->tline = pc->linenr;
1516 pc->tt = JIM_TT_CMD;
1517 JimParseSubCmd(pc);
1518 return JIM_OK;
1521 static int JimParseQuote(struct JimParserCtx *pc)
1523 pc->tstart = pc->p + 1;
1524 pc->tline = pc->linenr;
1525 pc->tt = JimParseSubQuote(pc);
1526 return JIM_OK;
1529 static int JimParseVar(struct JimParserCtx *pc)
1531 /* skip the $ */
1532 pc->p++;
1533 pc->len--;
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc->p == '[') {
1537 /* Parse $[...] expr shorthand syntax */
1538 JimParseCmd(pc);
1539 pc->tt = JIM_TT_EXPRSUGAR;
1540 return JIM_OK;
1542 #endif
1544 pc->tstart = pc->p;
1545 pc->tt = JIM_TT_VAR;
1546 pc->tline = pc->linenr;
1548 if (*pc->p == '{') {
1549 pc->tstart = ++pc->p;
1550 pc->len--;
1552 while (pc->len && *pc->p != '}') {
1553 if (*pc->p == '\n') {
1554 pc->linenr++;
1556 pc->p++;
1557 pc->len--;
1559 pc->tend = pc->p - 1;
1560 if (pc->len) {
1561 pc->p++;
1562 pc->len--;
1565 else {
1566 while (1) {
1567 /* Skip double colon, but not single colon! */
1568 if (pc->p[0] == ':' && pc->p[1] == ':') {
1569 while (*pc->p == ':') {
1570 pc->p++;
1571 pc->len--;
1573 continue;
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1579 pc->p++;
1580 pc->len--;
1581 continue;
1583 break;
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc->p == '(') {
1587 int count = 1;
1588 const char *paren = NULL;
1590 pc->tt = JIM_TT_DICTSUGAR;
1592 while (count && pc->len) {
1593 pc->p++;
1594 pc->len--;
1595 if (*pc->p == '\\' && pc->len >= 1) {
1596 pc->p++;
1597 pc->len--;
1599 else if (*pc->p == '(') {
1600 count++;
1602 else if (*pc->p == ')') {
1603 paren = pc->p;
1604 count--;
1607 if (count == 0) {
1608 pc->p++;
1609 pc->len--;
1611 else if (paren) {
1612 /* Did not find a matching paren. Back up */
1613 paren++;
1614 pc->len += (pc->p - paren);
1615 pc->p = paren;
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc->tstart == '(') {
1619 pc->tt = JIM_TT_EXPRSUGAR;
1621 #endif
1623 pc->tend = pc->p - 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1628 * a string. */
1629 if (pc->tstart == pc->p) {
1630 pc->p--;
1631 pc->len++;
1632 return JIM_ERR;
1634 return JIM_OK;
1637 static int JimParseStr(struct JimParserCtx *pc)
1639 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1640 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1641 /* Starting a new word */
1642 if (*pc->p == '{') {
1643 return JimParseBrace(pc);
1645 if (*pc->p == '"') {
1646 pc->state = JIM_PS_QUOTE;
1647 pc->p++;
1648 pc->len--;
1649 /* In case the end quote is missing */
1650 pc->missing.line = pc->tline;
1653 pc->tstart = pc->p;
1654 pc->tline = pc->linenr;
1655 while (1) {
1656 if (pc->len == 0) {
1657 if (pc->state == JIM_PS_QUOTE) {
1658 pc->missing.ch = '"';
1660 pc->tend = pc->p - 1;
1661 pc->tt = JIM_TT_ESC;
1662 return JIM_OK;
1664 switch (*pc->p) {
1665 case '\\':
1666 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1667 pc->tend = pc->p - 1;
1668 pc->tt = JIM_TT_ESC;
1669 return JIM_OK;
1671 if (pc->len >= 2) {
1672 if (*(pc->p + 1) == '\n') {
1673 pc->linenr++;
1675 pc->p++;
1676 pc->len--;
1678 else if (pc->len == 1) {
1679 /* End of script with trailing backslash */
1680 pc->missing.ch = '\\';
1682 break;
1683 case '(':
1684 /* If the following token is not '$' just keep going */
1685 if (pc->len > 1 && pc->p[1] != '$') {
1686 break;
1688 case ')':
1689 /* Only need a separate ')' token if the previous was a var */
1690 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1691 if (pc->p == pc->tstart) {
1692 /* At the start of the token, so just return this char */
1693 pc->p++;
1694 pc->len--;
1696 pc->tend = pc->p - 1;
1697 pc->tt = JIM_TT_ESC;
1698 return JIM_OK;
1700 break;
1702 case '$':
1703 case '[':
1704 pc->tend = pc->p - 1;
1705 pc->tt = JIM_TT_ESC;
1706 return JIM_OK;
1707 case ' ':
1708 case '\t':
1709 case '\n':
1710 case '\r':
1711 case '\f':
1712 case ';':
1713 if (pc->state == JIM_PS_DEF) {
1714 pc->tend = pc->p - 1;
1715 pc->tt = JIM_TT_ESC;
1716 return JIM_OK;
1718 else if (*pc->p == '\n') {
1719 pc->linenr++;
1721 break;
1722 case '"':
1723 if (pc->state == JIM_PS_QUOTE) {
1724 pc->tend = pc->p - 1;
1725 pc->tt = JIM_TT_ESC;
1726 pc->p++;
1727 pc->len--;
1728 pc->state = JIM_PS_DEF;
1729 return JIM_OK;
1731 break;
1733 pc->p++;
1734 pc->len--;
1736 return JIM_OK; /* unreached */
1739 static int JimParseComment(struct JimParserCtx *pc)
1741 while (*pc->p) {
1742 if (*pc->p == '\\') {
1743 pc->p++;
1744 pc->len--;
1745 if (pc->len == 0) {
1746 pc->missing.ch = '\\';
1747 return JIM_OK;
1749 if (*pc->p == '\n') {
1750 pc->linenr++;
1753 else if (*pc->p == '\n') {
1754 pc->p++;
1755 pc->len--;
1756 pc->linenr++;
1757 break;
1759 pc->p++;
1760 pc->len--;
1762 return JIM_OK;
1765 /* xdigitval and odigitval are helper functions for JimEscape() */
1766 static int xdigitval(int c)
1768 if (c >= '0' && c <= '9')
1769 return c - '0';
1770 if (c >= 'a' && c <= 'f')
1771 return c - 'a' + 10;
1772 if (c >= 'A' && c <= 'F')
1773 return c - 'A' + 10;
1774 return -1;
1777 static int odigitval(int c)
1779 if (c >= '0' && c <= '7')
1780 return c - '0';
1781 return -1;
1784 /* Perform Tcl escape substitution of 's', storing the result
1785 * string into 'dest'. The escaped string is guaranteed to
1786 * be the same length or shorted than the source string.
1787 * Slen is the length of the string at 's', if it's -1 the string
1788 * length will be calculated by the function.
1790 * The function returns the length of the resulting string. */
1791 static int JimEscape(char *dest, const char *s, int slen)
1793 char *p = dest;
1794 int i, len;
1796 if (slen == -1)
1797 slen = strlen(s);
1799 for (i = 0; i < slen; i++) {
1800 switch (s[i]) {
1801 case '\\':
1802 switch (s[i + 1]) {
1803 case 'a':
1804 *p++ = 0x7;
1805 i++;
1806 break;
1807 case 'b':
1808 *p++ = 0x8;
1809 i++;
1810 break;
1811 case 'f':
1812 *p++ = 0xc;
1813 i++;
1814 break;
1815 case 'n':
1816 *p++ = 0xa;
1817 i++;
1818 break;
1819 case 'r':
1820 *p++ = 0xd;
1821 i++;
1822 break;
1823 case 't':
1824 *p++ = 0x9;
1825 i++;
1826 break;
1827 case 'u':
1828 case 'U':
1829 case 'x':
1830 /* A unicode or hex sequence.
1831 * \x Expect 1-2 hex chars and convert to hex.
1832 * \u Expect 1-4 hex chars and convert to utf-8.
1833 * \U Expect 1-8 hex chars and convert to utf-8.
1834 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1835 * An invalid sequence means simply the escaped char.
1838 unsigned val = 0;
1839 int k;
1840 int maxchars = 2;
1842 i++;
1844 if (s[i] == 'U') {
1845 maxchars = 8;
1847 else if (s[i] == 'u') {
1848 if (s[i + 1] == '{') {
1849 maxchars = 6;
1850 i++;
1852 else {
1853 maxchars = 4;
1857 for (k = 0; k < maxchars; k++) {
1858 int c = xdigitval(s[i + k + 1]);
1859 if (c == -1) {
1860 break;
1862 val = (val << 4) | c;
1864 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1865 if (s[i] == '{') {
1866 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1867 /* Back up */
1868 i--;
1869 k = 0;
1871 else {
1872 /* Skip the closing brace */
1873 k++;
1876 if (k) {
1877 /* Got a valid sequence, so convert */
1878 if (s[i] == 'x') {
1879 *p++ = val;
1881 else {
1882 p += utf8_fromunicode(p, val);
1884 i += k;
1885 break;
1887 /* Not a valid codepoint, just an escaped char */
1888 *p++ = s[i];
1890 break;
1891 case 'v':
1892 *p++ = 0xb;
1893 i++;
1894 break;
1895 case '\0':
1896 *p++ = '\\';
1897 i++;
1898 break;
1899 case '\n':
1900 /* Replace all spaces and tabs after backslash newline with a single space*/
1901 *p++ = ' ';
1902 do {
1903 i++;
1904 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1905 break;
1906 case '0':
1907 case '1':
1908 case '2':
1909 case '3':
1910 case '4':
1911 case '5':
1912 case '6':
1913 case '7':
1914 /* octal escape */
1916 int val = 0;
1917 int c = odigitval(s[i + 1]);
1919 val = c;
1920 c = odigitval(s[i + 2]);
1921 if (c == -1) {
1922 *p++ = val;
1923 i++;
1924 break;
1926 val = (val * 8) + c;
1927 c = odigitval(s[i + 3]);
1928 if (c == -1) {
1929 *p++ = val;
1930 i += 2;
1931 break;
1933 val = (val * 8) + c;
1934 *p++ = val;
1935 i += 3;
1937 break;
1938 default:
1939 *p++ = s[i + 1];
1940 i++;
1941 break;
1943 break;
1944 default:
1945 *p++ = s[i];
1946 break;
1949 len = p - dest;
1950 *p = '\0';
1951 return len;
1954 /* Returns a dynamically allocated copy of the current token in the
1955 * parser context. The function performs conversion of escapes if
1956 * the token is of type JIM_TT_ESC.
1958 * Note that after the conversion, tokens that are grouped with
1959 * braces in the source code, are always recognizable from the
1960 * identical string obtained in a different way from the type.
1962 * For example the string:
1964 * {*}$a
1966 * will return as first token "*", of type JIM_TT_STR
1968 * While the string:
1970 * *$a
1972 * will return as first token "*", of type JIM_TT_ESC
1974 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1976 const char *start, *end;
1977 char *token;
1978 int len;
1980 start = pc->tstart;
1981 end = pc->tend;
1982 if (start > end) {
1983 len = 0;
1984 token = Jim_Alloc(1);
1985 token[0] = '\0';
1987 else {
1988 len = (end - start) + 1;
1989 token = Jim_Alloc(len + 1);
1990 if (pc->tt != JIM_TT_ESC) {
1991 /* No escape conversion needed? Just copy it. */
1992 memcpy(token, start, len);
1993 token[len] = '\0';
1995 else {
1996 /* Else convert the escape chars. */
1997 len = JimEscape(token, start, len);
2001 return Jim_NewStringObjNoAlloc(interp, token, len);
2004 /* Parses the given string to determine if it represents a complete script.
2006 * This is useful for interactive shells implementation, for [info complete].
2008 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2009 * '{' on scripts incomplete missing one or more '}' to be balanced.
2010 * '[' on scripts incomplete missing one or more ']' to be balanced.
2011 * '"' on scripts incomplete missing a '"' char.
2012 * '\\' on scripts with a trailing backslash.
2014 * If the script is complete, 1 is returned, otherwise 0.
2016 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2018 struct JimParserCtx parser;
2020 JimParserInit(&parser, s, len, 1);
2021 while (!parser.eof) {
2022 JimParseScript(&parser);
2024 if (stateCharPtr) {
2025 *stateCharPtr = parser.missing.ch;
2027 return parser.missing.ch == ' ';
2030 /* -----------------------------------------------------------------------------
2031 * Tcl Lists parsing
2032 * ---------------------------------------------------------------------------*/
2033 static int JimParseListSep(struct JimParserCtx *pc);
2034 static int JimParseListStr(struct JimParserCtx *pc);
2035 static int JimParseListQuote(struct JimParserCtx *pc);
2037 static int JimParseList(struct JimParserCtx *pc)
2039 if (isspace(UCHAR(*pc->p))) {
2040 return JimParseListSep(pc);
2042 switch (*pc->p) {
2043 case '"':
2044 return JimParseListQuote(pc);
2046 case '{':
2047 return JimParseBrace(pc);
2049 default:
2050 if (pc->len) {
2051 return JimParseListStr(pc);
2053 break;
2056 pc->tstart = pc->tend = pc->p;
2057 pc->tline = pc->linenr;
2058 pc->tt = JIM_TT_EOL;
2059 pc->eof = 1;
2060 return JIM_OK;
2063 static int JimParseListSep(struct JimParserCtx *pc)
2065 pc->tstart = pc->p;
2066 pc->tline = pc->linenr;
2067 while (isspace(UCHAR(*pc->p))) {
2068 if (*pc->p == '\n') {
2069 pc->linenr++;
2071 pc->p++;
2072 pc->len--;
2074 pc->tend = pc->p - 1;
2075 pc->tt = JIM_TT_SEP;
2076 return JIM_OK;
2079 static int JimParseListQuote(struct JimParserCtx *pc)
2081 pc->p++;
2082 pc->len--;
2084 pc->tstart = pc->p;
2085 pc->tline = pc->linenr;
2086 pc->tt = JIM_TT_STR;
2088 while (pc->len) {
2089 switch (*pc->p) {
2090 case '\\':
2091 pc->tt = JIM_TT_ESC;
2092 if (--pc->len == 0) {
2093 /* Trailing backslash */
2094 pc->tend = pc->p;
2095 return JIM_OK;
2097 pc->p++;
2098 break;
2099 case '\n':
2100 pc->linenr++;
2101 break;
2102 case '"':
2103 pc->tend = pc->p - 1;
2104 pc->p++;
2105 pc->len--;
2106 return JIM_OK;
2108 pc->p++;
2109 pc->len--;
2112 pc->tend = pc->p - 1;
2113 return JIM_OK;
2116 static int JimParseListStr(struct JimParserCtx *pc)
2118 pc->tstart = pc->p;
2119 pc->tline = pc->linenr;
2120 pc->tt = JIM_TT_STR;
2122 while (pc->len) {
2123 if (isspace(UCHAR(*pc->p))) {
2124 pc->tend = pc->p - 1;
2125 return JIM_OK;
2127 if (*pc->p == '\\') {
2128 if (--pc->len == 0) {
2129 /* Trailing backslash */
2130 pc->tend = pc->p;
2131 return JIM_OK;
2133 pc->tt = JIM_TT_ESC;
2134 pc->p++;
2136 pc->p++;
2137 pc->len--;
2139 pc->tend = pc->p - 1;
2140 return JIM_OK;
2143 /* -----------------------------------------------------------------------------
2144 * Jim_Obj related functions
2145 * ---------------------------------------------------------------------------*/
2147 /* Return a new initialized object. */
2148 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2150 Jim_Obj *objPtr;
2152 /* -- Check if there are objects in the free list -- */
2153 if (interp->freeList != NULL) {
2154 /* -- Unlink the object from the free list -- */
2155 objPtr = interp->freeList;
2156 interp->freeList = objPtr->nextObjPtr;
2158 else {
2159 /* -- No ready to use objects: allocate a new one -- */
2160 objPtr = Jim_Alloc(sizeof(*objPtr));
2163 /* Object is returned with refCount of 0. Every
2164 * kind of GC implemented should take care to don't try
2165 * to scan objects with refCount == 0. */
2166 objPtr->refCount = 0;
2167 /* All the other fields are left not initialized to save time.
2168 * The caller will probably want to set them to the right
2169 * value anyway. */
2171 /* -- Put the object into the live list -- */
2172 objPtr->prevObjPtr = NULL;
2173 objPtr->nextObjPtr = interp->liveList;
2174 if (interp->liveList)
2175 interp->liveList->prevObjPtr = objPtr;
2176 interp->liveList = objPtr;
2178 return objPtr;
2181 /* Free an object. Actually objects are never freed, but
2182 * just moved to the free objects list, where they will be
2183 * reused by Jim_NewObj(). */
2184 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2186 /* Check if the object was already freed, panic. */
2187 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2188 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2190 /* Free the internal representation */
2191 Jim_FreeIntRep(interp, objPtr);
2192 /* Free the string representation */
2193 if (objPtr->bytes != NULL) {
2194 if (objPtr->bytes != JimEmptyStringRep)
2195 Jim_Free(objPtr->bytes);
2197 /* Unlink the object from the live objects list */
2198 if (objPtr->prevObjPtr)
2199 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2200 if (objPtr->nextObjPtr)
2201 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2202 if (interp->liveList == objPtr)
2203 interp->liveList = objPtr->nextObjPtr;
2204 #ifdef JIM_DISABLE_OBJECT_POOL
2205 Jim_Free(objPtr);
2206 #else
2207 /* Link the object into the free objects list */
2208 objPtr->prevObjPtr = NULL;
2209 objPtr->nextObjPtr = interp->freeList;
2210 if (interp->freeList)
2211 interp->freeList->prevObjPtr = objPtr;
2212 interp->freeList = objPtr;
2213 objPtr->refCount = -1;
2214 #endif
2217 /* Invalidate the string representation of an object. */
2218 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2220 if (objPtr->bytes != NULL) {
2221 if (objPtr->bytes != JimEmptyStringRep)
2222 Jim_Free(objPtr->bytes);
2224 objPtr->bytes = NULL;
2227 /* Duplicate an object. The returned object has refcount = 0. */
2228 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2230 Jim_Obj *dupPtr;
2232 dupPtr = Jim_NewObj(interp);
2233 if (objPtr->bytes == NULL) {
2234 /* Object does not have a valid string representation. */
2235 dupPtr->bytes = NULL;
2237 else if (objPtr->length == 0) {
2238 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2239 dupPtr->bytes = JimEmptyStringRep;
2240 dupPtr->length = 0;
2241 dupPtr->typePtr = NULL;
2242 return dupPtr;
2244 else {
2245 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2246 dupPtr->length = objPtr->length;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr->typePtr = objPtr->typePtr;
2253 if (objPtr->typePtr != NULL) {
2254 if (objPtr->typePtr->dupIntRepProc == NULL) {
2255 dupPtr->internalRep = objPtr->internalRep;
2257 else {
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2262 return dupPtr;
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2271 if (objPtr->bytes == NULL) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2274 objPtr->typePtr->updateStringProc(objPtr);
2276 if (lenPtr)
2277 *lenPtr = objPtr->length;
2278 return objPtr->bytes;
2281 /* Just returns the length of the object's string rep */
2282 int Jim_Length(Jim_Obj *objPtr)
2284 if (objPtr->bytes == NULL) {
2285 /* Invalid string repr. Generate it. */
2286 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2287 objPtr->typePtr->updateStringProc(objPtr);
2289 return objPtr->length;
2292 /* Just returns the length of the object's string rep */
2293 const char *Jim_String(Jim_Obj *objPtr)
2295 if (objPtr->bytes == NULL) {
2296 /* Invalid string repr. Generate it. */
2297 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2298 objPtr->typePtr->updateStringProc(objPtr);
2300 return objPtr->bytes;
2303 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2305 objPtr->bytes = Jim_StrDup(str);
2306 objPtr->length = strlen(str);
2309 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2310 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2312 static const Jim_ObjType dictSubstObjType = {
2313 "dict-substitution",
2314 FreeDictSubstInternalRep,
2315 DupDictSubstInternalRep,
2316 NULL,
2317 JIM_TYPE_NONE,
2320 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2322 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2325 static const Jim_ObjType interpolatedObjType = {
2326 "interpolated",
2327 FreeInterpolatedInternalRep,
2328 NULL,
2329 NULL,
2330 JIM_TYPE_NONE,
2333 /* -----------------------------------------------------------------------------
2334 * String Object
2335 * ---------------------------------------------------------------------------*/
2336 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2337 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2339 static const Jim_ObjType stringObjType = {
2340 "string",
2341 NULL,
2342 DupStringInternalRep,
2343 NULL,
2344 JIM_TYPE_REFERENCES,
2347 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2349 JIM_NOTUSED(interp);
2351 /* This is a bit subtle: the only caller of this function
2352 * should be Jim_DuplicateObj(), that will copy the
2353 * string representaion. After the copy, the duplicated
2354 * object will not have more room in the buffer than
2355 * srcPtr->length bytes. So we just set it to length. */
2356 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2357 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2360 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2362 if (objPtr->typePtr != &stringObjType) {
2363 /* Get a fresh string representation. */
2364 if (objPtr->bytes == NULL) {
2365 /* Invalid string repr. Generate it. */
2366 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2367 objPtr->typePtr->updateStringProc(objPtr);
2369 /* Free any other internal representation. */
2370 Jim_FreeIntRep(interp, objPtr);
2371 /* Set it as string, i.e. just set the maxLength field. */
2372 objPtr->typePtr = &stringObjType;
2373 objPtr->internalRep.strValue.maxLength = objPtr->length;
2374 /* Don't know the utf-8 length yet */
2375 objPtr->internalRep.strValue.charLength = -1;
2377 return JIM_OK;
2381 * Returns the length of the object string in chars, not bytes.
2383 * These may be different for a utf-8 string.
2385 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2387 #ifdef JIM_UTF8
2388 SetStringFromAny(interp, objPtr);
2390 if (objPtr->internalRep.strValue.charLength < 0) {
2391 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2393 return objPtr->internalRep.strValue.charLength;
2394 #else
2395 return Jim_Length(objPtr);
2396 #endif
2399 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2400 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2402 Jim_Obj *objPtr = Jim_NewObj(interp);
2404 /* Need to find out how many bytes the string requires */
2405 if (len == -1)
2406 len = strlen(s);
2407 /* Alloc/Set the string rep. */
2408 if (len == 0) {
2409 objPtr->bytes = JimEmptyStringRep;
2411 else {
2412 objPtr->bytes = Jim_Alloc(len + 1);
2413 memcpy(objPtr->bytes, s, len);
2414 objPtr->bytes[len] = '\0';
2416 objPtr->length = len;
2418 /* No typePtr field for the vanilla string object. */
2419 objPtr->typePtr = NULL;
2420 return objPtr;
2423 /* charlen is in characters -- see also Jim_NewStringObj() */
2424 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2426 #ifdef JIM_UTF8
2427 /* Need to find out how many bytes the string requires */
2428 int bytelen = utf8_index(s, charlen);
2430 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2432 /* Remember the utf8 length, so set the type */
2433 objPtr->typePtr = &stringObjType;
2434 objPtr->internalRep.strValue.maxLength = bytelen;
2435 objPtr->internalRep.strValue.charLength = charlen;
2437 return objPtr;
2438 #else
2439 return Jim_NewStringObj(interp, s, charlen);
2440 #endif
2443 /* This version does not try to duplicate the 's' pointer, but
2444 * use it directly. */
2445 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2447 Jim_Obj *objPtr = Jim_NewObj(interp);
2449 objPtr->bytes = s;
2450 objPtr->length = (len == -1) ? strlen(s) : len;
2451 objPtr->typePtr = NULL;
2452 return objPtr;
2455 /* Low-level string append. Use it only against unshared objects
2456 * of type "string". */
2457 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2459 int needlen;
2461 if (len == -1)
2462 len = strlen(str);
2463 needlen = objPtr->length + len;
2464 if (objPtr->internalRep.strValue.maxLength < needlen ||
2465 objPtr->internalRep.strValue.maxLength == 0) {
2466 needlen *= 2;
2467 /* Inefficient to malloc() for less than 8 bytes */
2468 if (needlen < 7) {
2469 needlen = 7;
2471 if (objPtr->bytes == JimEmptyStringRep) {
2472 objPtr->bytes = Jim_Alloc(needlen + 1);
2474 else {
2475 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2477 objPtr->internalRep.strValue.maxLength = needlen;
2479 memcpy(objPtr->bytes + objPtr->length, str, len);
2480 objPtr->bytes[objPtr->length + len] = '\0';
2482 if (objPtr->internalRep.strValue.charLength >= 0) {
2483 /* Update the utf-8 char length */
2484 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2486 objPtr->length += len;
2489 /* Higher level API to append strings to objects.
2490 * Object must not be unshared for each of these.
2492 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2494 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2495 SetStringFromAny(interp, objPtr);
2496 StringAppendString(objPtr, str, len);
2499 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2501 int len;
2502 const char *str = Jim_GetString(appendObjPtr, &len);
2503 Jim_AppendString(interp, objPtr, str, len);
2506 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2508 va_list ap;
2510 SetStringFromAny(interp, objPtr);
2511 va_start(ap, objPtr);
2512 while (1) {
2513 const char *s = va_arg(ap, const char *);
2515 if (s == NULL)
2516 break;
2517 Jim_AppendString(interp, objPtr, s, -1);
2519 va_end(ap);
2522 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2524 if (aObjPtr == bObjPtr) {
2525 return 1;
2527 else {
2528 int Alen, Blen;
2529 const char *sA = Jim_GetString(aObjPtr, &Alen);
2530 const char *sB = Jim_GetString(bObjPtr, &Blen);
2532 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2537 * Note. Does not support embedded nulls in either the pattern or the object.
2539 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2541 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2545 * Note: does not support embedded nulls for the nocase option.
2547 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2549 int l1, l2;
2550 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2551 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2553 if (nocase) {
2554 /* Do a character compare for nocase */
2555 return JimStringCompareLen(s1, s2, -1, nocase);
2557 return JimStringCompare(s1, l1, s2, l2);
2561 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2563 * Note: does not support embedded nulls
2565 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2567 const char *s1 = Jim_String(firstObjPtr);
2568 const char *s2 = Jim_String(secondObjPtr);
2570 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2573 /* Convert a range, as returned by Jim_GetRange(), into
2574 * an absolute index into an object of the specified length.
2575 * This function may return negative values, or values
2576 * greater than or equal to the length of the list if the index
2577 * is out of range. */
2578 static int JimRelToAbsIndex(int len, int idx)
2580 if (idx < 0)
2581 return len + idx;
2582 return idx;
2585 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2586 * into a form suitable for implementation of commands like [string range] and [lrange].
2588 * The resulting range is guaranteed to address valid elements of
2589 * the structure.
2591 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2593 int rangeLen;
2595 if (*firstPtr > *lastPtr) {
2596 rangeLen = 0;
2598 else {
2599 rangeLen = *lastPtr - *firstPtr + 1;
2600 if (rangeLen) {
2601 if (*firstPtr < 0) {
2602 rangeLen += *firstPtr;
2603 *firstPtr = 0;
2605 if (*lastPtr >= len) {
2606 rangeLen -= (*lastPtr - (len - 1));
2607 *lastPtr = len - 1;
2611 if (rangeLen < 0)
2612 rangeLen = 0;
2614 *rangeLenPtr = rangeLen;
2617 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2618 int len, int *first, int *last, int *range)
2620 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2621 return JIM_ERR;
2623 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2624 return JIM_ERR;
2626 *first = JimRelToAbsIndex(len, *first);
2627 *last = JimRelToAbsIndex(len, *last);
2628 JimRelToAbsRange(len, first, last, range);
2629 return JIM_OK;
2632 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2633 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2635 int first, last;
2636 const char *str;
2637 int rangeLen;
2638 int bytelen;
2640 str = Jim_GetString(strObjPtr, &bytelen);
2642 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2643 return NULL;
2646 if (first == 0 && rangeLen == bytelen) {
2647 return strObjPtr;
2649 return Jim_NewStringObj(interp, str + first, rangeLen);
2652 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2653 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2655 #ifdef JIM_UTF8
2656 int first, last;
2657 const char *str;
2658 int len, rangeLen;
2659 int bytelen;
2661 str = Jim_GetString(strObjPtr, &bytelen);
2662 len = Jim_Utf8Length(interp, strObjPtr);
2664 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2665 return NULL;
2668 if (first == 0 && rangeLen == len) {
2669 return strObjPtr;
2671 if (len == bytelen) {
2672 /* ASCII optimisation */
2673 return Jim_NewStringObj(interp, str + first, rangeLen);
2675 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2676 #else
2677 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2678 #endif
2681 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2682 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2684 int first, last;
2685 const char *str;
2686 int len, rangeLen;
2687 Jim_Obj *objPtr;
2689 len = Jim_Utf8Length(interp, strObjPtr);
2691 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2692 return NULL;
2695 if (last < first) {
2696 return strObjPtr;
2699 str = Jim_String(strObjPtr);
2701 /* Before part */
2702 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2704 /* Replacement */
2705 if (newStrObj) {
2706 Jim_AppendObj(interp, objPtr, newStrObj);
2709 /* After part */
2710 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2712 return objPtr;
2716 * Note: does not support embedded nulls.
2718 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2720 while (*str) {
2721 int c;
2722 str += utf8_tounicode(str, &c);
2723 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2725 *dest = 0;
2729 * Note: does not support embedded nulls.
2731 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2733 char *buf;
2734 int len;
2735 const char *str;
2737 SetStringFromAny(interp, strObjPtr);
2739 str = Jim_GetString(strObjPtr, &len);
2741 #ifdef JIM_UTF8
2742 /* Case mapping can change the utf-8 length of the string.
2743 * But at worst it will be by one extra byte per char
2745 len *= 2;
2746 #endif
2747 buf = Jim_Alloc(len + 1);
2748 JimStrCopyUpperLower(buf, str, 0);
2749 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2753 * Note: does not support embedded nulls.
2755 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2757 char *buf;
2758 const char *str;
2759 int len;
2761 if (strObjPtr->typePtr != &stringObjType) {
2762 SetStringFromAny(interp, strObjPtr);
2765 str = Jim_GetString(strObjPtr, &len);
2767 #ifdef JIM_UTF8
2768 /* Case mapping can change the utf-8 length of the string.
2769 * But at worst it will be by one extra byte per char
2771 len *= 2;
2772 #endif
2773 buf = Jim_Alloc(len + 1);
2774 JimStrCopyUpperLower(buf, str, 1);
2775 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2779 * Note: does not support embedded nulls.
2781 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2783 char *buf, *p;
2784 int len;
2785 int c;
2786 const char *str;
2788 str = Jim_GetString(strObjPtr, &len);
2789 if (len == 0) {
2790 return strObjPtr;
2792 #ifdef JIM_UTF8
2793 /* Case mapping can change the utf-8 length of the string.
2794 * But at worst it will be by one extra byte per char
2796 len *= 2;
2797 #endif
2798 buf = p = Jim_Alloc(len + 1);
2800 str += utf8_tounicode(str, &c);
2801 p += utf8_getchars(p, utf8_title(c));
2803 JimStrCopyUpperLower(p, str, 0);
2805 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2808 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2809 * for unicode character 'c'.
2810 * Returns the position if found or NULL if not
2812 static const char *utf8_memchr(const char *str, int len, int c)
2814 #ifdef JIM_UTF8
2815 while (len) {
2816 int sc;
2817 int n = utf8_tounicode(str, &sc);
2818 if (sc == c) {
2819 return str;
2821 str += n;
2822 len -= n;
2824 return NULL;
2825 #else
2826 return memchr(str, c, len);
2827 #endif
2831 * Searches for the first non-trim char in string (str, len)
2833 * If none is found, returns just past the last char.
2835 * Lengths are in bytes.
2837 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2839 while (len) {
2840 int c;
2841 int n = utf8_tounicode(str, &c);
2843 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2844 /* Not a trim char, so stop */
2845 break;
2847 str += n;
2848 len -= n;
2850 return str;
2854 * Searches backwards for a non-trim char in string (str, len).
2856 * Returns a pointer to just after the non-trim char, or NULL if not found.
2858 * Lengths are in bytes.
2860 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2862 str += len;
2864 while (len) {
2865 int c;
2866 int n = utf8_prev_len(str, len);
2868 len -= n;
2869 str -= n;
2871 n = utf8_tounicode(str, &c);
2873 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2874 return str + n;
2878 return NULL;
2881 static const char default_trim_chars[] = " \t\n\r";
2882 /* sizeof() here includes the null byte */
2883 static int default_trim_chars_len = sizeof(default_trim_chars);
2885 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2887 int len;
2888 const char *str = Jim_GetString(strObjPtr, &len);
2889 const char *trimchars = default_trim_chars;
2890 int trimcharslen = default_trim_chars_len;
2891 const char *newstr;
2893 if (trimcharsObjPtr) {
2894 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2897 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2898 if (newstr == str) {
2899 return strObjPtr;
2902 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2905 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2907 int len;
2908 const char *trimchars = default_trim_chars;
2909 int trimcharslen = default_trim_chars_len;
2910 const char *nontrim;
2912 if (trimcharsObjPtr) {
2913 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2916 SetStringFromAny(interp, strObjPtr);
2918 len = Jim_Length(strObjPtr);
2919 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2921 if (nontrim == NULL) {
2922 /* All trim, so return a zero-length string */
2923 return Jim_NewEmptyStringObj(interp);
2925 if (nontrim == strObjPtr->bytes + len) {
2926 /* All non-trim, so return the original object */
2927 return strObjPtr;
2930 if (Jim_IsShared(strObjPtr)) {
2931 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2933 else {
2934 /* Can modify this string in place */
2935 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2936 strObjPtr->length = (nontrim - strObjPtr->bytes);
2939 return strObjPtr;
2942 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2944 /* First trim left. */
2945 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2947 /* Now trim right */
2948 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2950 /* Note: refCount check is needed since objPtr may be emptyObj */
2951 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2952 /* We don't want this object to be leaked */
2953 Jim_FreeNewObj(interp, objPtr);
2956 return strObjPtr;
2959 /* Some platforms don't have isascii - need a non-macro version */
2960 #ifdef HAVE_ISASCII
2961 #define jim_isascii isascii
2962 #else
2963 static int jim_isascii(int c)
2965 return !(c & ~0x7f);
2967 #endif
2969 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2971 static const char * const strclassnames[] = {
2972 "integer", "alpha", "alnum", "ascii", "digit",
2973 "double", "lower", "upper", "space", "xdigit",
2974 "control", "print", "graph", "punct",
2975 NULL
2977 enum {
2978 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2979 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2980 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2982 int strclass;
2983 int len;
2984 int i;
2985 const char *str;
2986 int (*isclassfunc)(int c) = NULL;
2988 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2989 return JIM_ERR;
2992 str = Jim_GetString(strObjPtr, &len);
2993 if (len == 0) {
2994 Jim_SetResultBool(interp, !strict);
2995 return JIM_OK;
2998 switch (strclass) {
2999 case STR_IS_INTEGER:
3001 jim_wide w;
3002 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3003 return JIM_OK;
3006 case STR_IS_DOUBLE:
3008 double d;
3009 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3010 return JIM_OK;
3013 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3014 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3015 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3016 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3017 case STR_IS_LOWER: isclassfunc = islower; break;
3018 case STR_IS_UPPER: isclassfunc = isupper; break;
3019 case STR_IS_SPACE: isclassfunc = isspace; break;
3020 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3021 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3022 case STR_IS_PRINT: isclassfunc = isprint; break;
3023 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3024 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3025 default:
3026 return JIM_ERR;
3029 for (i = 0; i < len; i++) {
3030 if (!isclassfunc(str[i])) {
3031 Jim_SetResultBool(interp, 0);
3032 return JIM_OK;
3035 Jim_SetResultBool(interp, 1);
3036 return JIM_OK;
3039 /* -----------------------------------------------------------------------------
3040 * Compared String Object
3041 * ---------------------------------------------------------------------------*/
3043 /* This is strange object that allows comparison of a C literal string
3044 * with a Jim object in a very short time if the same comparison is done
3045 * multiple times. For example every time the [if] command is executed,
3046 * Jim has to check if a given argument is "else".
3047 * If the code has no errors, this comparison is true most of the time,
3048 * so we can cache the pointer of the string of the last matching
3049 * comparison inside the object. Because most C compilers perform literal sharing,
3050 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3051 * this works pretty well even if comparisons are at different places
3052 * inside the C code. */
3054 static const Jim_ObjType comparedStringObjType = {
3055 "compared-string",
3056 NULL,
3057 NULL,
3058 NULL,
3059 JIM_TYPE_REFERENCES,
3062 /* The only way this object is exposed to the API is via the following
3063 * function. Returns true if the string and the object string repr.
3064 * are the same, otherwise zero is returned.
3066 * Note: this isn't binary safe, but it hardly needs to be.*/
3067 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3069 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3070 return 1;
3072 else {
3073 const char *objStr = Jim_String(objPtr);
3075 if (strcmp(str, objStr) != 0)
3076 return 0;
3078 if (objPtr->typePtr != &comparedStringObjType) {
3079 Jim_FreeIntRep(interp, objPtr);
3080 objPtr->typePtr = &comparedStringObjType;
3082 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3083 return 1;
3087 static int qsortCompareStringPointers(const void *a, const void *b)
3089 char *const *sa = (char *const *)a;
3090 char *const *sb = (char *const *)b;
3092 return strcmp(*sa, *sb);
3096 /* -----------------------------------------------------------------------------
3097 * Source Object
3099 * This object is just a string from the language point of view, but
3100 * the internal representation contains the filename and line number
3101 * where this token was read. This information is used by
3102 * Jim_EvalObj() if the object passed happens to be of type "source".
3104 * This allows propagation of the information about line numbers and file
3105 * names and gives error messages with absolute line numbers.
3107 * Note that this object uses the internal representation of the Jim_Object,
3108 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3110 * Also the object will be converted to something else if the given
3111 * token it represents in the source file is not something to be
3112 * evaluated (not a script), and will be specialized in some other way,
3113 * so the time overhead is also almost zero.
3114 * ---------------------------------------------------------------------------*/
3116 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3117 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3119 static const Jim_ObjType sourceObjType = {
3120 "source",
3121 FreeSourceInternalRep,
3122 DupSourceInternalRep,
3123 NULL,
3124 JIM_TYPE_REFERENCES,
3127 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3129 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3132 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3134 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3135 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3138 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3139 Jim_Obj *fileNameObj, int lineNumber)
3141 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3142 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3143 Jim_IncrRefCount(fileNameObj);
3144 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3145 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3146 objPtr->typePtr = &sourceObjType;
3149 /* -----------------------------------------------------------------------------
3150 * ScriptLine Object
3152 * This object is used only in the Script internal represenation.
3153 * For each line of the script, it holds the number of tokens on the line
3154 * and the source line number.
3156 static const Jim_ObjType scriptLineObjType = {
3157 "scriptline",
3158 NULL,
3159 NULL,
3160 NULL,
3161 JIM_NONE,
3164 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3166 Jim_Obj *objPtr;
3168 #ifdef DEBUG_SHOW_SCRIPT
3169 char buf[100];
3170 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3171 objPtr = Jim_NewStringObj(interp, buf, -1);
3172 #else
3173 objPtr = Jim_NewEmptyStringObj(interp);
3174 #endif
3175 objPtr->typePtr = &scriptLineObjType;
3176 objPtr->internalRep.scriptLineValue.argc = argc;
3177 objPtr->internalRep.scriptLineValue.line = line;
3179 return objPtr;
3182 /* -----------------------------------------------------------------------------
3183 * Script Object
3185 * This object holds the parsed internal representation of a script.
3186 * This representation is help within an allocated ScriptObj (see below)
3188 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3189 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3190 static int JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3191 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3193 static const Jim_ObjType scriptObjType = {
3194 "script",
3195 FreeScriptInternalRep,
3196 DupScriptInternalRep,
3197 NULL,
3198 JIM_TYPE_REFERENCES,
3201 /* Each token of a script is represented by a ScriptToken.
3202 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3203 * can be specialized by commands operating on it.
3205 typedef struct ScriptToken
3207 Jim_Obj *objPtr;
3208 int type;
3209 } ScriptToken;
3211 /* This is the script object internal representation. An array of
3212 * ScriptToken structures, including a pre-computed representation of the
3213 * command length and arguments.
3215 * For example the script:
3217 * puts hello
3218 * set $i $x$y [foo]BAR
3220 * will produce a ScriptObj with the following ScriptToken's:
3222 * LIN 2
3223 * ESC puts
3224 * ESC hello
3225 * LIN 4
3226 * ESC set
3227 * VAR i
3228 * WRD 2
3229 * VAR x
3230 * VAR y
3231 * WRD 2
3232 * CMD foo
3233 * ESC BAR
3235 * "puts hello" has two args (LIN 2), composed of single tokens.
3236 * (Note that the WRD token is omitted for the common case of a single token.)
3238 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3239 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3241 * The precomputation of the command structure makes Jim_Eval() faster,
3242 * and simpler because there aren't dynamic lengths / allocations.
3244 * -- {expand}/{*} handling --
3246 * Expand is handled in a special way.
3248 * If a "word" begins with {*}, the word token count is -ve.
3250 * For example the command:
3252 * list {*}{a b}
3254 * Will produce the following cmdstruct array:
3256 * LIN 2
3257 * ESC list
3258 * WRD -1
3259 * STR a b
3261 * Note that the 'LIN' token also contains the source information for the
3262 * first word of the line for error reporting purposes
3264 * -- the substFlags field of the structure --
3266 * The scriptObj structure is used to represent both "script" objects
3267 * and "subst" objects. In the second case, the there are no LIN and WRD
3268 * tokens. Instead SEP and EOL tokens are added as-is.
3269 * In addition, the field 'substFlags' is used to represent the flags used to turn
3270 * the string into the internal representation.
3271 * If these flags do not match what the application requires,
3272 * the scriptObj is created again. For example the script:
3274 * subst -nocommands $string
3275 * subst -novariables $string
3277 * Will (re)create the internal representation of the $string object
3278 * two times.
3280 typedef struct ScriptObj
3282 ScriptToken *token; /* Tokens array. */
3283 Jim_Obj *fileNameObj; /* Filename */
3284 int len; /* Length of token[] */
3285 int substFlags; /* flags used for the compilation of "subst" objects */
3286 int inUse; /* Used to share a ScriptObj. Currently
3287 only used by Jim_EvalObj() as protection against
3288 shimmering of the currently evaluated object. */
3289 int firstline; /* Line number of the first line */
3290 int linenr; /* Line number of the current line */
3291 } ScriptObj;
3293 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3295 int i;
3296 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3298 if (--script->inUse != 0)
3299 return;
3300 for (i = 0; i < script->len; i++) {
3301 Jim_DecrRefCount(interp, script->token[i].objPtr);
3303 Jim_Free(script->token);
3304 Jim_DecrRefCount(interp, script->fileNameObj);
3305 Jim_Free(script);
3308 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3310 JIM_NOTUSED(interp);
3311 JIM_NOTUSED(srcPtr);
3313 /* Just return a simple string. We don't try to preserve the source info
3314 * since in practice scripts are never duplicated
3316 dupPtr->typePtr = NULL;
3319 /* A simple parse token.
3320 * As the script is parsed, the created tokens point into the script string rep.
3322 typedef struct
3324 const char *token; /* Pointer to the start of the token */
3325 int len; /* Length of this token */
3326 int type; /* Token type */
3327 int line; /* Line number */
3328 } ParseToken;
3330 /* A list of parsed tokens representing a script.
3331 * Tokens are added to this list as the script is parsed.
3332 * It grows as needed.
3334 typedef struct
3336 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3337 ParseToken *list; /* Array of tokens */
3338 int size; /* Current size of the list */
3339 int count; /* Number of entries used */
3340 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3341 } ParseTokenList;
3343 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3345 tokenlist->list = tokenlist->static_list;
3346 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3347 tokenlist->count = 0;
3350 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3352 if (tokenlist->list != tokenlist->static_list) {
3353 Jim_Free(tokenlist->list);
3358 * Adds the new token to the tokenlist.
3359 * The token has the given length, type and line number.
3360 * The token list is resized as necessary.
3362 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3363 int line)
3365 ParseToken *t;
3367 if (tokenlist->count == tokenlist->size) {
3368 /* Resize the list */
3369 tokenlist->size *= 2;
3370 if (tokenlist->list != tokenlist->static_list) {
3371 tokenlist->list =
3372 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3374 else {
3375 /* The list needs to become allocated */
3376 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3377 memcpy(tokenlist->list, tokenlist->static_list,
3378 tokenlist->count * sizeof(*tokenlist->list));
3381 t = &tokenlist->list[tokenlist->count++];
3382 t->token = token;
3383 t->len = len;
3384 t->type = type;
3385 t->line = line;
3388 /* Counts the number of adjoining non-separator tokens.
3390 * Returns -ve if the first token is the expansion
3391 * operator (in which case the count doesn't include
3392 * that token).
3394 static int JimCountWordTokens(ParseToken *t)
3396 int expand = 1;
3397 int count = 0;
3399 /* Is the first word {*} or {expand}? */
3400 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3401 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3402 /* Create an expand token */
3403 expand = -1;
3404 t++;
3408 /* Now count non-separator words */
3409 while (!TOKEN_IS_SEP(t->type)) {
3410 t++;
3411 count++;
3414 return count * expand;
3418 * Create a script/subst object from the given token.
3420 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3422 Jim_Obj *objPtr;
3424 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3425 /* Convert backlash escapes. The result will never be longer than the original */
3426 int len = t->len;
3427 char *str = Jim_Alloc(len + 1);
3428 len = JimEscape(str, t->token, len);
3429 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3431 else {
3432 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3433 * with a single space.
3435 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3437 return objPtr;
3441 * Takes a tokenlist and creates the allocated list of script tokens
3442 * in script->token, of length script->len.
3444 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3445 * as required.
3447 * Also sets script->line to the line number of the first token
3449 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3450 ParseTokenList *tokenlist)
3452 int i;
3453 struct ScriptToken *token;
3454 /* Number of tokens so far for the current command */
3455 int lineargs = 0;
3456 /* This is the first token for the current command */
3457 ScriptToken *linefirst;
3458 int count;
3459 int linenr;
3461 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3462 printf("==== Tokens ====\n");
3463 for (i = 0; i < tokenlist->count; i++) {
3464 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3465 tokenlist->list[i].len, tokenlist->list[i].token);
3467 #endif
3469 /* May need up to one extra script token for each EOL in the worst case */
3470 count = tokenlist->count;
3471 for (i = 0; i < tokenlist->count; i++) {
3472 if (tokenlist->list[i].type == JIM_TT_EOL) {
3473 count++;
3476 linenr = script->firstline = tokenlist->list[0].line;
3478 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3480 /* This is the first token for the current command */
3481 linefirst = token++;
3483 for (i = 0; i < tokenlist->count; ) {
3484 /* Look ahead to find out how many tokens make up the next word */
3485 int wordtokens;
3487 /* Skip any leading separators */
3488 while (tokenlist->list[i].type == JIM_TT_SEP) {
3489 i++;
3492 wordtokens = JimCountWordTokens(tokenlist->list + i);
3494 if (wordtokens == 0) {
3495 /* None, so at end of line */
3496 if (lineargs) {
3497 linefirst->type = JIM_TT_LINE;
3498 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3499 Jim_IncrRefCount(linefirst->objPtr);
3501 /* Reset for new line */
3502 lineargs = 0;
3503 linefirst = token++;
3505 i++;
3506 continue;
3508 else if (wordtokens != 1) {
3509 /* More than 1, or {*}, so insert a WORD token */
3510 token->type = JIM_TT_WORD;
3511 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3512 Jim_IncrRefCount(token->objPtr);
3513 token++;
3514 if (wordtokens < 0) {
3515 /* Skip the expand token */
3516 i++;
3517 wordtokens = -wordtokens - 1;
3518 lineargs--;
3522 if (lineargs == 0) {
3523 /* First real token on the line, so record the line number */
3524 linenr = tokenlist->list[i].line;
3526 lineargs++;
3528 /* Add each non-separator word token to the line */
3529 while (wordtokens--) {
3530 const ParseToken *t = &tokenlist->list[i++];
3532 token->type = t->type;
3533 token->objPtr = JimMakeScriptObj(interp, t);
3534 Jim_IncrRefCount(token->objPtr);
3536 /* Every object is initially a string of type 'source', but the
3537 * internal type may be specialized during execution of the
3538 * script. */
3539 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3540 token++;
3544 if (lineargs == 0) {
3545 token--;
3548 script->len = token - script->token;
3550 JimPanic((script->len >= count, "allocated script array is too short"));
3552 #ifdef DEBUG_SHOW_SCRIPT
3553 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3554 for (i = 0; i < script->len; i++) {
3555 const ScriptToken *t = &script->token[i];
3556 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3558 #endif
3563 * Sets an appropriate error message for a missing script/expression terminator.
3565 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3567 * Note that a trailing backslash is not considered to be an error.
3569 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3571 const char *msg;
3573 switch (ch) {
3574 case '\\':
3575 case ' ':
3576 return JIM_OK;
3578 case '[':
3579 msg = "unmatched \"[\"";
3580 break;
3581 case '{':
3582 msg = "missing close-brace";
3583 break;
3584 case '"':
3585 default:
3586 msg = "missing quote";
3587 break;
3590 Jim_SetResultString(interp, msg, -1);
3591 return JIM_ERR;
3595 * Similar to ScriptObjAddTokens(), but for subst objects.
3597 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3598 ParseTokenList *tokenlist)
3600 int i;
3601 struct ScriptToken *token;
3603 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3605 for (i = 0; i < tokenlist->count; i++) {
3606 const ParseToken *t = &tokenlist->list[i];
3608 /* Create a token for 't' */
3609 token->type = t->type;
3610 token->objPtr = JimMakeScriptObj(interp, t);
3611 Jim_IncrRefCount(token->objPtr);
3612 token++;
3615 script->len = i;
3618 /* This method takes the string representation of an object
3619 * as a Tcl script, and generates the pre-parsed internal representation
3620 * of the script.
3622 * On parse error, sets an error message and returns JIM_ERR
3623 * (Note: the object is still converted to a script, even if an error occurs)
3625 static int JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3627 int scriptTextLen;
3628 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3629 struct JimParserCtx parser;
3630 struct ScriptObj *script;
3631 ParseTokenList tokenlist;
3632 int line = 1;
3633 int retcode = JIM_OK;
3635 /* Try to get information about filename / line number */
3636 if (objPtr->typePtr == &sourceObjType) {
3637 line = objPtr->internalRep.sourceValue.lineNumber;
3640 /* Initially parse the script into tokens (in tokenlist) */
3641 ScriptTokenListInit(&tokenlist);
3643 JimParserInit(&parser, scriptText, scriptTextLen, line);
3644 while (!parser.eof) {
3645 JimParseScript(&parser);
3646 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3647 parser.tline);
3650 retcode = JimParseCheckMissing(interp, parser.missing.ch);
3652 /* Add a final EOF token */
3653 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3655 /* Create the "real" script tokens from the parsed tokens */
3656 script = Jim_Alloc(sizeof(*script));
3657 memset(script, 0, sizeof(*script));
3658 script->inUse = 1;
3659 if (objPtr->typePtr == &sourceObjType) {
3660 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3662 else {
3663 script->fileNameObj = interp->emptyObj;
3665 script->linenr = parser.missing.line;
3666 Jim_IncrRefCount(script->fileNameObj);
3668 ScriptObjAddTokens(interp, script, &tokenlist);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp, objPtr);
3675 Jim_SetIntRepPtr(objPtr, script);
3676 objPtr->typePtr = &scriptObjType;
3678 return retcode;
3682 * Returns NULL if the script failed to parse and leaves
3683 * an error message in the interp result.
3685 * Otherwise returns a parsed script object.
3686 * (Note: the object is still converted to a script, even if an error occurs)
3688 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3690 if (objPtr == interp->emptyObj) {
3691 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3692 objPtr = interp->nullScriptObj;
3695 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3696 if (JimSetScriptFromAny(interp, objPtr) == JIM_ERR) {
3697 return NULL;
3700 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3703 /* -----------------------------------------------------------------------------
3704 * Commands
3705 * ---------------------------------------------------------------------------*/
3706 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3708 cmdPtr->inUse++;
3711 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3713 if (--cmdPtr->inUse == 0) {
3714 if (cmdPtr->isproc) {
3715 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3716 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3717 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3718 if (cmdPtr->u.proc.staticVars) {
3719 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3720 Jim_Free(cmdPtr->u.proc.staticVars);
3723 else {
3724 /* native (C) */
3725 if (cmdPtr->u.native.delProc) {
3726 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3729 if (cmdPtr->prevCmd) {
3730 /* Delete any pushed command too */
3731 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3733 Jim_Free(cmdPtr);
3737 /* Variables HashTable Type.
3739 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3742 /* Variables HashTable Type.
3744 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3745 static void JimVariablesHTValDestructor(void *interp, void *val)
3747 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3748 Jim_Free(val);
3751 static const Jim_HashTableType JimVariablesHashTableType = {
3752 JimStringCopyHTHashFunction, /* hash function */
3753 JimStringCopyHTDup, /* key dup */
3754 NULL, /* val dup */
3755 JimStringCopyHTKeyCompare, /* key compare */
3756 JimStringCopyHTKeyDestructor, /* key destructor */
3757 JimVariablesHTValDestructor /* val destructor */
3760 /* Commands HashTable Type.
3762 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3764 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3766 JimDecrCmdRefCount(interp, val);
3769 static const Jim_HashTableType JimCommandsHashTableType = {
3770 JimStringCopyHTHashFunction, /* hash function */
3771 JimStringCopyHTDup, /* key dup */
3772 NULL, /* val dup */
3773 JimStringCopyHTKeyCompare, /* key compare */
3774 JimStringCopyHTKeyDestructor, /* key destructor */
3775 JimCommandsHT_ValDestructor /* val destructor */
3778 /* ------------------------- Commands related functions --------------------- */
3780 #ifdef jim_ext_namespace
3782 * Returns the "unscoped" version of the given namespace.
3783 * That is, the fully qualfied name without the leading ::
3784 * The returned value is either nsObj, or an object with a zero ref count.
3786 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3788 const char *name = Jim_String(nsObj);
3789 if (name[0] == ':' && name[1] == ':') {
3790 /* This command is being defined in the global namespace */
3791 while (*++name == ':') {
3793 nsObj = Jim_NewStringObj(interp, name, -1);
3795 else if (Jim_Length(interp->framePtr->nsObj)) {
3796 /* This command is being defined in a non-global namespace */
3797 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3798 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3800 return nsObj;
3803 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3805 Jim_Obj *resultObj;
3807 const char *name = Jim_String(nameObjPtr);
3808 if (name[0] == ':' && name[1] == ':') {
3809 return nameObjPtr;
3811 Jim_IncrRefCount(nameObjPtr);
3812 resultObj = Jim_NewStringObj(interp, "::", -1);
3813 Jim_AppendObj(interp, resultObj, nameObjPtr);
3814 Jim_DecrRefCount(interp, nameObjPtr);
3816 return resultObj;
3820 * An efficient version of JimQualifyNameObj() where the name is
3821 * available (and needed) as a 'const char *'.
3822 * Avoids creating an object if not necessary.
3823 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3825 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3827 Jim_Obj *objPtr = interp->emptyObj;
3829 if (name[0] == ':' && name[1] == ':') {
3830 /* This command is being defined in the global namespace */
3831 while (*++name == ':') {
3834 else if (Jim_Length(interp->framePtr->nsObj)) {
3835 /* This command is being defined in a non-global namespace */
3836 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3837 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3838 name = Jim_String(objPtr);
3840 Jim_IncrRefCount(objPtr);
3841 *objPtrPtr = objPtr;
3842 return name;
3845 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3847 #else
3848 /* We can be more efficient in the no-namespace case */
3849 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3850 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3852 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3854 return nameObjPtr;
3856 #endif
3858 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3860 /* It may already exist, so we try to delete the old one.
3861 * Note that reference count means that it won't be deleted yet if
3862 * it exists in the call stack.
3864 * BUT, if 'local' is in force, instead of deleting the existing
3865 * proc, we stash a reference to the old proc here.
3867 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3868 if (he) {
3869 /* There was an old cmd with the same name,
3870 * so this requires a 'proc epoch' update. */
3872 /* If a procedure with the same name didn't exist there is no need
3873 * to increment the 'proc epoch' because creation of a new procedure
3874 * can never affect existing cached commands. We don't do
3875 * negative caching. */
3876 Jim_InterpIncrProcEpoch(interp);
3879 if (he && interp->local) {
3880 /* Push this command over the top of the previous one */
3881 cmd->prevCmd = Jim_GetHashEntryVal(he);
3882 Jim_SetHashVal(&interp->commands, he, cmd);
3884 else {
3885 if (he) {
3886 /* Replace the existing command */
3887 Jim_DeleteHashEntry(&interp->commands, name);
3890 Jim_AddHashEntry(&interp->commands, name, cmd);
3892 return JIM_OK;
3896 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3897 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3899 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3901 /* Store the new details for this command */
3902 memset(cmdPtr, 0, sizeof(*cmdPtr));
3903 cmdPtr->inUse = 1;
3904 cmdPtr->u.native.delProc = delProc;
3905 cmdPtr->u.native.cmdProc = cmdProc;
3906 cmdPtr->u.native.privData = privData;
3908 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3910 return JIM_OK;
3913 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3915 int len, i;
3917 len = Jim_ListLength(interp, staticsListObjPtr);
3918 if (len == 0) {
3919 return JIM_OK;
3922 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3923 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3924 for (i = 0; i < len; i++) {
3925 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3926 Jim_Var *varPtr;
3927 int subLen;
3929 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3930 /* Check if it's composed of two elements. */
3931 subLen = Jim_ListLength(interp, objPtr);
3932 if (subLen == 1 || subLen == 2) {
3933 /* Try to get the variable value from the current
3934 * environment. */
3935 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3936 if (subLen == 1) {
3937 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3938 if (initObjPtr == NULL) {
3939 Jim_SetResultFormatted(interp,
3940 "variable for initialization of static \"%#s\" not found in the local context",
3941 nameObjPtr);
3942 return JIM_ERR;
3945 else {
3946 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3948 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3949 return JIM_ERR;
3952 varPtr = Jim_Alloc(sizeof(*varPtr));
3953 varPtr->objPtr = initObjPtr;
3954 Jim_IncrRefCount(initObjPtr);
3955 varPtr->linkFramePtr = NULL;
3956 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3957 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3958 Jim_SetResultFormatted(interp,
3959 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3960 Jim_DecrRefCount(interp, initObjPtr);
3961 Jim_Free(varPtr);
3962 return JIM_ERR;
3965 else {
3966 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3967 objPtr);
3968 return JIM_ERR;
3971 return JIM_OK;
3974 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3976 #ifdef jim_ext_namespace
3977 if (cmdPtr->isproc) {
3978 /* XXX: Really need JimNamespaceSplit() */
3979 const char *pt = strrchr(cmdname, ':');
3980 if (pt && pt != cmdname && pt[-1] == ':') {
3981 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3982 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3983 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3985 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3986 /* This commands shadows a global command, so a proc epoch update is required */
3987 Jim_InterpIncrProcEpoch(interp);
3991 #endif
3994 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3995 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3997 Jim_Cmd *cmdPtr;
3998 int argListLen;
3999 int i;
4001 argListLen = Jim_ListLength(interp, argListObjPtr);
4003 /* Allocate space for both the command pointer and the arg list */
4004 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4005 memset(cmdPtr, 0, sizeof(*cmdPtr));
4006 cmdPtr->inUse = 1;
4007 cmdPtr->isproc = 1;
4008 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4009 cmdPtr->u.proc.argListLen = argListLen;
4010 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4011 cmdPtr->u.proc.argsPos = -1;
4012 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4013 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4014 Jim_IncrRefCount(argListObjPtr);
4015 Jim_IncrRefCount(bodyObjPtr);
4016 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4018 /* Create the statics hash table. */
4019 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4020 goto err;
4023 /* Parse the args out into arglist, validating as we go */
4024 /* Examine the argument list for default parameters and 'args' */
4025 for (i = 0; i < argListLen; i++) {
4026 Jim_Obj *argPtr;
4027 Jim_Obj *nameObjPtr;
4028 Jim_Obj *defaultObjPtr;
4029 int len;
4031 /* Examine a parameter */
4032 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4033 len = Jim_ListLength(interp, argPtr);
4034 if (len == 0) {
4035 Jim_SetResultString(interp, "argument with no name", -1);
4036 err:
4037 JimDecrCmdRefCount(interp, cmdPtr);
4038 return NULL;
4040 if (len > 2) {
4041 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4042 goto err;
4045 if (len == 2) {
4046 /* Optional parameter */
4047 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4048 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4050 else {
4051 /* Required parameter */
4052 nameObjPtr = argPtr;
4053 defaultObjPtr = NULL;
4057 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4058 if (cmdPtr->u.proc.argsPos >= 0) {
4059 Jim_SetResultString(interp, "'args' specified more than once", -1);
4060 goto err;
4062 cmdPtr->u.proc.argsPos = i;
4064 else {
4065 if (len == 2) {
4066 cmdPtr->u.proc.optArity++;
4068 else {
4069 cmdPtr->u.proc.reqArity++;
4073 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4074 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4077 return cmdPtr;
4080 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4082 int ret = JIM_OK;
4083 Jim_Obj *qualifiedNameObj;
4084 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4086 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4087 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4088 ret = JIM_ERR;
4090 else {
4091 Jim_InterpIncrProcEpoch(interp);
4094 JimFreeQualifiedName(interp, qualifiedNameObj);
4096 return ret;
4099 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4101 int ret = JIM_ERR;
4102 Jim_HashEntry *he;
4103 Jim_Cmd *cmdPtr;
4104 Jim_Obj *qualifiedOldNameObj;
4105 Jim_Obj *qualifiedNewNameObj;
4106 const char *fqold;
4107 const char *fqnew;
4109 if (newName[0] == 0) {
4110 return Jim_DeleteCommand(interp, oldName);
4113 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4114 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4116 /* Does it exist? */
4117 he = Jim_FindHashEntry(&interp->commands, fqold);
4118 if (he == NULL) {
4119 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4121 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4122 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4124 else {
4125 /* Add the new name first */
4126 cmdPtr = Jim_GetHashEntryVal(he);
4127 JimIncrCmdRefCount(cmdPtr);
4128 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4129 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4131 /* Now remove the old name */
4132 Jim_DeleteHashEntry(&interp->commands, fqold);
4134 /* Increment the epoch */
4135 Jim_InterpIncrProcEpoch(interp);
4137 ret = JIM_OK;
4140 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4141 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4143 return ret;
4146 /* -----------------------------------------------------------------------------
4147 * Command object
4148 * ---------------------------------------------------------------------------*/
4150 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4152 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4155 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4157 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4158 dupPtr->typePtr = srcPtr->typePtr;
4159 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4162 static const Jim_ObjType commandObjType = {
4163 "command",
4164 FreeCommandInternalRep,
4165 DupCommandInternalRep,
4166 NULL,
4167 JIM_TYPE_REFERENCES,
4170 /* This function returns the command structure for the command name
4171 * stored in objPtr. It tries to specialize the objPtr to contain
4172 * a cached info instead to perform the lookup into the hash table
4173 * every time. The information cached may not be uptodate, in such
4174 * a case the lookup is performed and the cache updated.
4176 * Respects the 'upcall' setting
4178 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4180 Jim_Cmd *cmd;
4182 /* In order to be valid, the proc epoch must match and
4183 * the lookup must have occurred in the same namespace
4185 if (objPtr->typePtr != &commandObjType ||
4186 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4187 #ifdef jim_ext_namespace
4188 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4189 #endif
4191 /* Not cached or out of date, so lookup */
4193 /* Do we need to try the local namespace? */
4194 const char *name = Jim_String(objPtr);
4195 Jim_HashEntry *he;
4197 if (name[0] == ':' && name[1] == ':') {
4198 while (*++name == ':') {
4201 #ifdef jim_ext_namespace
4202 else if (Jim_Length(interp->framePtr->nsObj)) {
4203 /* This command is being defined in a non-global namespace */
4204 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4205 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4206 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4207 Jim_FreeNewObj(interp, nameObj);
4208 if (he) {
4209 goto found;
4212 #endif
4214 /* Lookup in the global namespace */
4215 he = Jim_FindHashEntry(&interp->commands, name);
4216 if (he == NULL) {
4217 if (flags & JIM_ERRMSG) {
4218 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4220 return NULL;
4222 #ifdef jim_ext_namespace
4223 found:
4224 #endif
4225 cmd = Jim_GetHashEntryVal(he);
4227 /* Free the old internal repr and set the new one. */
4228 Jim_FreeIntRep(interp, objPtr);
4229 objPtr->typePtr = &commandObjType;
4230 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4231 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4232 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4233 Jim_IncrRefCount(interp->framePtr->nsObj);
4235 else {
4236 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4238 while (cmd->u.proc.upcall) {
4239 cmd = cmd->prevCmd;
4241 return cmd;
4244 /* -----------------------------------------------------------------------------
4245 * Variables
4246 * ---------------------------------------------------------------------------*/
4248 /* -----------------------------------------------------------------------------
4249 * Variable object
4250 * ---------------------------------------------------------------------------*/
4252 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4254 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4256 static const Jim_ObjType variableObjType = {
4257 "variable",
4258 NULL,
4259 NULL,
4260 NULL,
4261 JIM_TYPE_REFERENCES,
4265 * Check that the name does not contain embedded nulls.
4267 * Variable and procedure names are maniplated as null terminated strings, so
4268 * don't allow names with embedded nulls.
4270 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4272 /* Variable names and proc names can't contain embedded nulls */
4273 if (nameObjPtr->typePtr != &variableObjType) {
4274 int len;
4275 const char *str = Jim_GetString(nameObjPtr, &len);
4276 if (memchr(str, '\0', len)) {
4277 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4278 return JIM_ERR;
4281 return JIM_OK;
4284 /* This method should be called only by the variable API.
4285 * It returns JIM_OK on success (variable already exists),
4286 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4287 * a variable name, but syntax glue for [dict] i.e. the last
4288 * character is ')' */
4289 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4291 const char *varName;
4292 Jim_CallFrame *framePtr;
4293 Jim_HashEntry *he;
4294 int global;
4295 int len;
4297 /* Check if the object is already an uptodate variable */
4298 if (objPtr->typePtr == &variableObjType) {
4299 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4300 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4301 /* nothing to do */
4302 return JIM_OK;
4304 /* Need to re-resolve the variable in the updated callframe */
4306 else if (objPtr->typePtr == &dictSubstObjType) {
4307 return JIM_DICT_SUGAR;
4309 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4310 return JIM_ERR;
4314 varName = Jim_GetString(objPtr, &len);
4316 /* Make sure it's not syntax glue to get/set dict. */
4317 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4318 return JIM_DICT_SUGAR;
4321 if (varName[0] == ':' && varName[1] == ':') {
4322 while (*++varName == ':') {
4324 global = 1;
4325 framePtr = interp->topFramePtr;
4327 else {
4328 global = 0;
4329 framePtr = interp->framePtr;
4332 /* Resolve this name in the variables hash table */
4333 he = Jim_FindHashEntry(&framePtr->vars, varName);
4334 if (he == NULL) {
4335 if (!global && framePtr->staticVars) {
4336 /* Try with static vars. */
4337 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4339 if (he == NULL) {
4340 return JIM_ERR;
4344 /* Free the old internal repr and set the new one. */
4345 Jim_FreeIntRep(interp, objPtr);
4346 objPtr->typePtr = &variableObjType;
4347 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4348 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4349 objPtr->internalRep.varValue.global = global;
4350 return JIM_OK;
4353 /* -------------------- Variables related functions ------------------------- */
4354 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4355 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4357 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4359 const char *name;
4360 Jim_CallFrame *framePtr;
4361 int global;
4363 /* New variable to create */
4364 Jim_Var *var = Jim_Alloc(sizeof(*var));
4366 var->objPtr = valObjPtr;
4367 Jim_IncrRefCount(valObjPtr);
4368 var->linkFramePtr = NULL;
4370 name = Jim_String(nameObjPtr);
4371 if (name[0] == ':' && name[1] == ':') {
4372 while (*++name == ':') {
4374 framePtr = interp->topFramePtr;
4375 global = 1;
4377 else {
4378 framePtr = interp->framePtr;
4379 global = 0;
4382 /* Insert the new variable */
4383 Jim_AddHashEntry(&framePtr->vars, name, var);
4385 /* Make the object int rep a variable */
4386 Jim_FreeIntRep(interp, nameObjPtr);
4387 nameObjPtr->typePtr = &variableObjType;
4388 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4389 nameObjPtr->internalRep.varValue.varPtr = var;
4390 nameObjPtr->internalRep.varValue.global = global;
4392 return var;
4395 /* For now that's dummy. Variables lookup should be optimized
4396 * in many ways, with caching of lookups, and possibly with
4397 * a table of pre-allocated vars in every CallFrame for local vars.
4398 * All the caching should also have an 'epoch' mechanism similar
4399 * to the one used by Tcl for procedures lookup caching. */
4401 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4403 int err;
4404 Jim_Var *var;
4406 switch (SetVariableFromAny(interp, nameObjPtr)) {
4407 case JIM_DICT_SUGAR:
4408 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4410 case JIM_ERR:
4411 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4412 return JIM_ERR;
4414 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4415 break;
4417 case JIM_OK:
4418 var = nameObjPtr->internalRep.varValue.varPtr;
4419 if (var->linkFramePtr == NULL) {
4420 Jim_IncrRefCount(valObjPtr);
4421 Jim_DecrRefCount(interp, var->objPtr);
4422 var->objPtr = valObjPtr;
4424 else { /* Else handle the link */
4425 Jim_CallFrame *savedCallFrame;
4427 savedCallFrame = interp->framePtr;
4428 interp->framePtr = var->linkFramePtr;
4429 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4430 interp->framePtr = savedCallFrame;
4431 if (err != JIM_OK)
4432 return err;
4435 return JIM_OK;
4438 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4440 Jim_Obj *nameObjPtr;
4441 int result;
4443 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4444 Jim_IncrRefCount(nameObjPtr);
4445 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4446 Jim_DecrRefCount(interp, nameObjPtr);
4447 return result;
4450 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4452 Jim_CallFrame *savedFramePtr;
4453 int result;
4455 savedFramePtr = interp->framePtr;
4456 interp->framePtr = interp->topFramePtr;
4457 result = Jim_SetVariableStr(interp, name, objPtr);
4458 interp->framePtr = savedFramePtr;
4459 return result;
4462 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4464 Jim_Obj *nameObjPtr, *valObjPtr;
4465 int result;
4467 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4468 valObjPtr = Jim_NewStringObj(interp, val, -1);
4469 Jim_IncrRefCount(nameObjPtr);
4470 Jim_IncrRefCount(valObjPtr);
4471 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4472 Jim_DecrRefCount(interp, nameObjPtr);
4473 Jim_DecrRefCount(interp, valObjPtr);
4474 return result;
4477 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4478 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4480 const char *varName;
4481 const char *targetName;
4482 Jim_CallFrame *framePtr;
4483 Jim_Var *varPtr;
4485 /* Check for an existing variable or link */
4486 switch (SetVariableFromAny(interp, nameObjPtr)) {
4487 case JIM_DICT_SUGAR:
4488 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4489 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4490 return JIM_ERR;
4492 case JIM_OK:
4493 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4495 if (varPtr->linkFramePtr == NULL) {
4496 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4497 return JIM_ERR;
4500 /* It exists, but is a link, so first delete the link */
4501 varPtr->linkFramePtr = NULL;
4502 break;
4505 /* Resolve the call frames for both variables */
4506 /* XXX: SetVariableFromAny() already did this! */
4507 varName = Jim_String(nameObjPtr);
4509 if (varName[0] == ':' && varName[1] == ':') {
4510 while (*++varName == ':') {
4512 /* Linking a global var does nothing */
4513 framePtr = interp->topFramePtr;
4515 else {
4516 framePtr = interp->framePtr;
4519 targetName = Jim_String(targetNameObjPtr);
4520 if (targetName[0] == ':' && targetName[1] == ':') {
4521 while (*++targetName == ':') {
4523 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4524 targetCallFrame = interp->topFramePtr;
4526 Jim_IncrRefCount(targetNameObjPtr);
4528 if (framePtr->level < targetCallFrame->level) {
4529 Jim_SetResultFormatted(interp,
4530 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4531 nameObjPtr);
4532 Jim_DecrRefCount(interp, targetNameObjPtr);
4533 return JIM_ERR;
4536 /* Check for cycles. */
4537 if (framePtr == targetCallFrame) {
4538 Jim_Obj *objPtr = targetNameObjPtr;
4540 /* Cycles are only possible with 'uplevel 0' */
4541 while (1) {
4542 if (strcmp(Jim_String(objPtr), varName) == 0) {
4543 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4544 Jim_DecrRefCount(interp, targetNameObjPtr);
4545 return JIM_ERR;
4547 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4548 break;
4549 varPtr = objPtr->internalRep.varValue.varPtr;
4550 if (varPtr->linkFramePtr != targetCallFrame)
4551 break;
4552 objPtr = varPtr->objPtr;
4556 /* Perform the binding */
4557 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4558 /* We are now sure 'nameObjPtr' type is variableObjType */
4559 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4560 Jim_DecrRefCount(interp, targetNameObjPtr);
4561 return JIM_OK;
4564 /* Return the Jim_Obj pointer associated with a variable name,
4565 * or NULL if the variable was not found in the current context.
4566 * The same optimization discussed in the comment to the
4567 * 'SetVariable' function should apply here.
4569 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4570 * in a dictionary which is shared, the array variable value is duplicated first.
4571 * This allows the array element to be updated (e.g. append, lappend) without
4572 * affecting other references to the dictionary.
4574 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4576 switch (SetVariableFromAny(interp, nameObjPtr)) {
4577 case JIM_OK:{
4578 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4580 if (varPtr->linkFramePtr == NULL) {
4581 return varPtr->objPtr;
4583 else {
4584 Jim_Obj *objPtr;
4586 /* The variable is a link? Resolve it. */
4587 Jim_CallFrame *savedCallFrame = interp->framePtr;
4589 interp->framePtr = varPtr->linkFramePtr;
4590 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4591 interp->framePtr = savedCallFrame;
4592 if (objPtr) {
4593 return objPtr;
4595 /* Error, so fall through to the error message */
4598 break;
4600 case JIM_DICT_SUGAR:
4601 /* [dict] syntax sugar. */
4602 return JimDictSugarGet(interp, nameObjPtr, flags);
4604 if (flags & JIM_ERRMSG) {
4605 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4607 return NULL;
4610 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4612 Jim_CallFrame *savedFramePtr;
4613 Jim_Obj *objPtr;
4615 savedFramePtr = interp->framePtr;
4616 interp->framePtr = interp->topFramePtr;
4617 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4618 interp->framePtr = savedFramePtr;
4620 return objPtr;
4623 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4625 Jim_Obj *nameObjPtr, *varObjPtr;
4627 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4628 Jim_IncrRefCount(nameObjPtr);
4629 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4630 Jim_DecrRefCount(interp, nameObjPtr);
4631 return varObjPtr;
4634 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4636 Jim_CallFrame *savedFramePtr;
4637 Jim_Obj *objPtr;
4639 savedFramePtr = interp->framePtr;
4640 interp->framePtr = interp->topFramePtr;
4641 objPtr = Jim_GetVariableStr(interp, name, flags);
4642 interp->framePtr = savedFramePtr;
4644 return objPtr;
4647 /* Unset a variable.
4648 * Note: On success unset invalidates all the variable objects created
4649 * in the current call frame incrementing. */
4650 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4652 Jim_Var *varPtr;
4653 int retval;
4654 Jim_CallFrame *framePtr;
4656 retval = SetVariableFromAny(interp, nameObjPtr);
4657 if (retval == JIM_DICT_SUGAR) {
4658 /* [dict] syntax sugar. */
4659 return JimDictSugarSet(interp, nameObjPtr, NULL);
4661 else if (retval == JIM_OK) {
4662 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4664 /* If it's a link call UnsetVariable recursively */
4665 if (varPtr->linkFramePtr) {
4666 framePtr = interp->framePtr;
4667 interp->framePtr = varPtr->linkFramePtr;
4668 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4669 interp->framePtr = framePtr;
4671 else {
4672 const char *name = Jim_String(nameObjPtr);
4673 if (nameObjPtr->internalRep.varValue.global) {
4674 name += 2;
4675 framePtr = interp->topFramePtr;
4677 else {
4678 framePtr = interp->framePtr;
4681 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4682 if (retval == JIM_OK) {
4683 /* Change the callframe id, invalidating var lookup caching */
4684 framePtr->id = interp->callFrameEpoch++;
4688 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4689 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4691 return retval;
4694 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4696 /* Given a variable name for [dict] operation syntax sugar,
4697 * this function returns two objects, the first with the name
4698 * of the variable to set, and the second with the rispective key.
4699 * For example "foo(bar)" will return objects with string repr. of
4700 * "foo" and "bar".
4702 * The returned objects have refcount = 1. The function can't fail. */
4703 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4704 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4706 const char *str, *p;
4707 int len, keyLen;
4708 Jim_Obj *varObjPtr, *keyObjPtr;
4710 str = Jim_GetString(objPtr, &len);
4712 p = strchr(str, '(');
4713 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4715 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4717 p++;
4718 keyLen = (str + len) - p;
4719 if (str[len - 1] == ')') {
4720 keyLen--;
4723 /* Create the objects with the variable name and key. */
4724 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4726 Jim_IncrRefCount(varObjPtr);
4727 Jim_IncrRefCount(keyObjPtr);
4728 *varPtrPtr = varObjPtr;
4729 *keyPtrPtr = keyObjPtr;
4732 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4733 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4734 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4736 int err;
4738 SetDictSubstFromAny(interp, objPtr);
4740 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4741 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4743 if (err == JIM_OK) {
4744 /* Don't keep an extra ref to the result */
4745 Jim_SetEmptyResult(interp);
4747 else {
4748 if (!valObjPtr) {
4749 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4750 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4751 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4752 objPtr);
4753 return err;
4756 /* Make the error more informative and Tcl-compatible */
4757 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4758 (valObjPtr ? "set" : "unset"), objPtr);
4760 return err;
4764 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4766 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4767 * and stored back to the variable before expansion.
4769 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4770 Jim_Obj *keyObjPtr, int flags)
4772 Jim_Obj *dictObjPtr;
4773 Jim_Obj *resObjPtr = NULL;
4774 int ret;
4776 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4777 if (!dictObjPtr) {
4778 return NULL;
4781 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4782 if (ret != JIM_OK) {
4783 Jim_SetResultFormatted(interp,
4784 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4785 ret < 0 ? "variable isn't" : "no such element in");
4787 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4788 /* Update the variable to have an unshared copy */
4789 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4792 return resObjPtr;
4795 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4796 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4798 SetDictSubstFromAny(interp, objPtr);
4800 return JimDictExpandArrayVariable(interp,
4801 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4802 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4805 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4807 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4809 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4810 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4813 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4815 JIM_NOTUSED(interp);
4817 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4818 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4819 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4820 dupPtr->typePtr = &dictSubstObjType;
4823 /* Note: The object *must* be in dict-sugar format */
4824 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4826 if (objPtr->typePtr != &dictSubstObjType) {
4827 Jim_Obj *varObjPtr, *keyObjPtr;
4829 if (objPtr->typePtr == &interpolatedObjType) {
4830 /* An interpolated object in dict-sugar form */
4832 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4833 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4835 Jim_IncrRefCount(varObjPtr);
4836 Jim_IncrRefCount(keyObjPtr);
4838 else {
4839 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4842 Jim_FreeIntRep(interp, objPtr);
4843 objPtr->typePtr = &dictSubstObjType;
4844 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4845 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4849 /* This function is used to expand [dict get] sugar in the form
4850 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4851 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4852 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4853 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4854 * the [dict]ionary contained in variable VARNAME. */
4855 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4857 Jim_Obj *resObjPtr = NULL;
4858 Jim_Obj *substKeyObjPtr = NULL;
4860 SetDictSubstFromAny(interp, objPtr);
4862 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4863 &substKeyObjPtr, JIM_NONE)
4864 != JIM_OK) {
4865 return NULL;
4867 Jim_IncrRefCount(substKeyObjPtr);
4868 resObjPtr =
4869 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4870 substKeyObjPtr, 0);
4871 Jim_DecrRefCount(interp, substKeyObjPtr);
4873 return resObjPtr;
4876 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4878 Jim_Obj *resultObjPtr;
4880 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4881 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4882 resultObjPtr->refCount--;
4883 return resultObjPtr;
4885 return NULL;
4888 /* -----------------------------------------------------------------------------
4889 * CallFrame
4890 * ---------------------------------------------------------------------------*/
4892 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4894 Jim_CallFrame *cf;
4896 if (interp->freeFramesList) {
4897 cf = interp->freeFramesList;
4898 interp->freeFramesList = cf->next;
4900 cf->argv = NULL;
4901 cf->argc = 0;
4902 cf->procArgsObjPtr = NULL;
4903 cf->procBodyObjPtr = NULL;
4904 cf->next = NULL;
4905 cf->staticVars = NULL;
4906 cf->localCommands = NULL;
4907 cf->tailcall = 0;
4908 cf->tailcallObj = NULL;
4909 cf->tailcallCmd = NULL;
4911 else {
4912 cf = Jim_Alloc(sizeof(*cf));
4913 memset(cf, 0, sizeof(*cf));
4915 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4918 cf->id = interp->callFrameEpoch++;
4919 cf->parent = parent;
4920 cf->level = parent ? parent->level + 1 : 0;
4921 cf->nsObj = nsObj;
4922 Jim_IncrRefCount(nsObj);
4924 return cf;
4927 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4929 /* Delete any local procs */
4930 if (localCommands) {
4931 Jim_Obj *cmdNameObj;
4933 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4934 Jim_HashEntry *he;
4935 Jim_Obj *fqObjName;
4936 Jim_HashTable *ht = &interp->commands;
4938 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4940 he = Jim_FindHashEntry(ht, fqname);
4942 if (he) {
4943 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4944 if (cmd->prevCmd) {
4945 Jim_Cmd *prevCmd = cmd->prevCmd;
4946 cmd->prevCmd = NULL;
4948 /* Delete the old command */
4949 JimDecrCmdRefCount(interp, cmd);
4951 /* And restore the original */
4952 Jim_SetHashVal(ht, he, prevCmd);
4954 else {
4955 Jim_DeleteHashEntry(ht, fqname);
4956 Jim_InterpIncrProcEpoch(interp);
4959 Jim_DecrRefCount(interp, cmdNameObj);
4960 JimFreeQualifiedName(interp, fqObjName);
4962 Jim_FreeStack(localCommands);
4963 Jim_Free(localCommands);
4965 return JIM_OK;
4969 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4970 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4971 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4973 JimDeleteLocalProcs(interp, cf->localCommands);
4975 if (cf->procArgsObjPtr)
4976 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4977 if (cf->procBodyObjPtr)
4978 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4979 Jim_DecrRefCount(interp, cf->nsObj);
4980 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4981 Jim_FreeHashTable(&cf->vars);
4982 else {
4983 int i;
4984 Jim_HashEntry **table = cf->vars.table, *he;
4986 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4987 he = table[i];
4988 while (he != NULL) {
4989 Jim_HashEntry *nextEntry = he->next;
4990 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
4992 Jim_DecrRefCount(interp, varPtr->objPtr);
4993 Jim_Free(Jim_GetHashEntryKey(he));
4994 Jim_Free(varPtr);
4995 Jim_Free(he);
4996 table[i] = NULL;
4997 he = nextEntry;
5000 cf->vars.used = 0;
5002 cf->next = interp->freeFramesList;
5003 interp->freeFramesList = cf;
5007 /* -----------------------------------------------------------------------------
5008 * References
5009 * ---------------------------------------------------------------------------*/
5010 #ifdef JIM_REFERENCES
5012 /* References HashTable Type.
5014 * Keys are unsigned long integers, dynamically allocated for now but in the
5015 * future it's worth to cache this 4 bytes objects. Values are pointers
5016 * to Jim_References. */
5017 static void JimReferencesHTValDestructor(void *interp, void *val)
5019 Jim_Reference *refPtr = (void *)val;
5021 Jim_DecrRefCount(interp, refPtr->objPtr);
5022 if (refPtr->finalizerCmdNamePtr != NULL) {
5023 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5025 Jim_Free(val);
5028 static unsigned int JimReferencesHTHashFunction(const void *key)
5030 /* Only the least significant bits are used. */
5031 const unsigned long *widePtr = key;
5032 unsigned int intValue = (unsigned int)*widePtr;
5034 return Jim_IntHashFunction(intValue);
5037 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5039 void *copy = Jim_Alloc(sizeof(unsigned long));
5041 JIM_NOTUSED(privdata);
5043 memcpy(copy, key, sizeof(unsigned long));
5044 return copy;
5047 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5049 JIM_NOTUSED(privdata);
5051 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5054 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5056 JIM_NOTUSED(privdata);
5058 Jim_Free(key);
5061 static const Jim_HashTableType JimReferencesHashTableType = {
5062 JimReferencesHTHashFunction, /* hash function */
5063 JimReferencesHTKeyDup, /* key dup */
5064 NULL, /* val dup */
5065 JimReferencesHTKeyCompare, /* key compare */
5066 JimReferencesHTKeyDestructor, /* key destructor */
5067 JimReferencesHTValDestructor /* val destructor */
5070 /* -----------------------------------------------------------------------------
5071 * Reference object type and References API
5072 * ---------------------------------------------------------------------------*/
5074 /* The string representation of references has two features in order
5075 * to make the GC faster. The first is that every reference starts
5076 * with a non common character '<', in order to make the string matching
5077 * faster. The second is that the reference string rep is 42 characters
5078 * in length, this means that it is not necessary to check any object with a string
5079 * repr < 42, and usually there aren't many of these objects. */
5081 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5083 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5085 const char *fmt = "<reference.<%s>.%020lu>";
5087 sprintf(buf, fmt, refPtr->tag, id);
5088 return JIM_REFERENCE_SPACE;
5091 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5093 static const Jim_ObjType referenceObjType = {
5094 "reference",
5095 NULL,
5096 NULL,
5097 UpdateStringOfReference,
5098 JIM_TYPE_REFERENCES,
5101 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5103 char buf[JIM_REFERENCE_SPACE + 1];
5105 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5106 JimSetStringBytes(objPtr, buf);
5109 /* returns true if 'c' is a valid reference tag character.
5110 * i.e. inside the range [_a-zA-Z0-9] */
5111 static int isrefchar(int c)
5113 return (c == '_' || isalnum(c));
5116 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5118 unsigned long value;
5119 int i, len;
5120 const char *str, *start, *end;
5121 char refId[21];
5122 Jim_Reference *refPtr;
5123 Jim_HashEntry *he;
5124 char *endptr;
5126 /* Get the string representation */
5127 str = Jim_GetString(objPtr, &len);
5128 /* Check if it looks like a reference */
5129 if (len < JIM_REFERENCE_SPACE)
5130 goto badformat;
5131 /* Trim spaces */
5132 start = str;
5133 end = str + len - 1;
5134 while (*start == ' ')
5135 start++;
5136 while (*end == ' ' && end > start)
5137 end--;
5138 if (end - start + 1 != JIM_REFERENCE_SPACE)
5139 goto badformat;
5140 /* <reference.<1234567>.%020> */
5141 if (memcmp(start, "<reference.<", 12) != 0)
5142 goto badformat;
5143 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5144 goto badformat;
5145 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5146 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5147 if (!isrefchar(start[12 + i]))
5148 goto badformat;
5150 /* Extract info from the reference. */
5151 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5152 refId[20] = '\0';
5153 /* Try to convert the ID into an unsigned long */
5154 value = strtoul(refId, &endptr, 10);
5155 if (JimCheckConversion(refId, endptr) != JIM_OK)
5156 goto badformat;
5157 /* Check if the reference really exists! */
5158 he = Jim_FindHashEntry(&interp->references, &value);
5159 if (he == NULL) {
5160 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5161 return JIM_ERR;
5163 refPtr = Jim_GetHashEntryVal(he);
5164 /* Free the old internal repr and set the new one. */
5165 Jim_FreeIntRep(interp, objPtr);
5166 objPtr->typePtr = &referenceObjType;
5167 objPtr->internalRep.refValue.id = value;
5168 objPtr->internalRep.refValue.refPtr = refPtr;
5169 return JIM_OK;
5171 badformat:
5172 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5173 return JIM_ERR;
5176 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5177 * as finalizer command (or NULL if there is no finalizer).
5178 * The returned reference object has refcount = 0. */
5179 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5181 struct Jim_Reference *refPtr;
5182 unsigned long id;
5183 Jim_Obj *refObjPtr;
5184 const char *tag;
5185 int tagLen, i;
5187 /* Perform the Garbage Collection if needed. */
5188 Jim_CollectIfNeeded(interp);
5190 refPtr = Jim_Alloc(sizeof(*refPtr));
5191 refPtr->objPtr = objPtr;
5192 Jim_IncrRefCount(objPtr);
5193 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5194 if (cmdNamePtr)
5195 Jim_IncrRefCount(cmdNamePtr);
5196 id = interp->referenceNextId++;
5197 Jim_AddHashEntry(&interp->references, &id, refPtr);
5198 refObjPtr = Jim_NewObj(interp);
5199 refObjPtr->typePtr = &referenceObjType;
5200 refObjPtr->bytes = NULL;
5201 refObjPtr->internalRep.refValue.id = id;
5202 refObjPtr->internalRep.refValue.refPtr = refPtr;
5203 interp->referenceNextId++;
5204 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5205 * that does not pass the 'isrefchar' test is replaced with '_' */
5206 tag = Jim_GetString(tagPtr, &tagLen);
5207 if (tagLen > JIM_REFERENCE_TAGLEN)
5208 tagLen = JIM_REFERENCE_TAGLEN;
5209 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5210 if (i < tagLen && isrefchar(tag[i]))
5211 refPtr->tag[i] = tag[i];
5212 else
5213 refPtr->tag[i] = '_';
5215 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5216 return refObjPtr;
5219 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5221 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5222 return NULL;
5223 return objPtr->internalRep.refValue.refPtr;
5226 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5228 Jim_Reference *refPtr;
5230 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5231 return JIM_ERR;
5232 Jim_IncrRefCount(cmdNamePtr);
5233 if (refPtr->finalizerCmdNamePtr)
5234 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5235 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5236 return JIM_OK;
5239 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5241 Jim_Reference *refPtr;
5243 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5244 return JIM_ERR;
5245 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5246 return JIM_OK;
5249 /* -----------------------------------------------------------------------------
5250 * References Garbage Collection
5251 * ---------------------------------------------------------------------------*/
5253 /* This the hash table type for the "MARK" phase of the GC */
5254 static const Jim_HashTableType JimRefMarkHashTableType = {
5255 JimReferencesHTHashFunction, /* hash function */
5256 JimReferencesHTKeyDup, /* key dup */
5257 NULL, /* val dup */
5258 JimReferencesHTKeyCompare, /* key compare */
5259 JimReferencesHTKeyDestructor, /* key destructor */
5260 NULL /* val destructor */
5263 /* Performs the garbage collection. */
5264 int Jim_Collect(Jim_Interp *interp)
5266 int collected = 0;
5267 #ifndef JIM_BOOTSTRAP
5268 Jim_HashTable marks;
5269 Jim_HashTableIterator htiter;
5270 Jim_HashEntry *he;
5271 Jim_Obj *objPtr;
5273 /* Avoid recursive calls */
5274 if (interp->lastCollectId == -1) {
5275 /* Jim_Collect() already running. Return just now. */
5276 return 0;
5278 interp->lastCollectId = -1;
5280 /* Mark all the references found into the 'mark' hash table.
5281 * The references are searched in every live object that
5282 * is of a type that can contain references. */
5283 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5284 objPtr = interp->liveList;
5285 while (objPtr) {
5286 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5287 const char *str, *p;
5288 int len;
5290 /* If the object is of type reference, to get the
5291 * Id is simple... */
5292 if (objPtr->typePtr == &referenceObjType) {
5293 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5294 #ifdef JIM_DEBUG_GC
5295 printf("MARK (reference): %d refcount: %d\n",
5296 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5297 #endif
5298 objPtr = objPtr->nextObjPtr;
5299 continue;
5301 /* Get the string repr of the object we want
5302 * to scan for references. */
5303 p = str = Jim_GetString(objPtr, &len);
5304 /* Skip objects too little to contain references. */
5305 if (len < JIM_REFERENCE_SPACE) {
5306 objPtr = objPtr->nextObjPtr;
5307 continue;
5309 /* Extract references from the object string repr. */
5310 while (1) {
5311 int i;
5312 unsigned long id;
5314 if ((p = strstr(p, "<reference.<")) == NULL)
5315 break;
5316 /* Check if it's a valid reference. */
5317 if (len - (p - str) < JIM_REFERENCE_SPACE)
5318 break;
5319 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5320 break;
5321 for (i = 21; i <= 40; i++)
5322 if (!isdigit(UCHAR(p[i])))
5323 break;
5324 /* Get the ID */
5325 id = strtoul(p + 21, NULL, 10);
5327 /* Ok, a reference for the given ID
5328 * was found. Mark it. */
5329 Jim_AddHashEntry(&marks, &id, NULL);
5330 #ifdef JIM_DEBUG_GC
5331 printf("MARK: %d\n", (int)id);
5332 #endif
5333 p += JIM_REFERENCE_SPACE;
5336 objPtr = objPtr->nextObjPtr;
5339 /* Run the references hash table to destroy every reference that
5340 * is not referenced outside (not present in the mark HT). */
5341 JimInitHashTableIterator(&interp->references, &htiter);
5342 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5343 const unsigned long *refId;
5344 Jim_Reference *refPtr;
5346 refId = he->key;
5347 /* Check if in the mark phase we encountered
5348 * this reference. */
5349 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5350 #ifdef JIM_DEBUG_GC
5351 printf("COLLECTING %d\n", (int)*refId);
5352 #endif
5353 collected++;
5354 /* Drop the reference, but call the
5355 * finalizer first if registered. */
5356 refPtr = Jim_GetHashEntryVal(he);
5357 if (refPtr->finalizerCmdNamePtr) {
5358 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5359 Jim_Obj *objv[3], *oldResult;
5361 JimFormatReference(refstr, refPtr, *refId);
5363 objv[0] = refPtr->finalizerCmdNamePtr;
5364 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5365 objv[2] = refPtr->objPtr;
5367 /* Drop the reference itself */
5368 /* Avoid the finaliser being freed here */
5369 Jim_IncrRefCount(objv[0]);
5370 /* Don't remove the reference from the hash table just yet
5371 * since that will free refPtr, and hence refPtr->objPtr
5374 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5375 oldResult = interp->result;
5376 Jim_IncrRefCount(oldResult);
5377 Jim_EvalObjVector(interp, 3, objv);
5378 Jim_SetResult(interp, oldResult);
5379 Jim_DecrRefCount(interp, oldResult);
5381 Jim_DecrRefCount(interp, objv[0]);
5383 Jim_DeleteHashEntry(&interp->references, refId);
5386 Jim_FreeHashTable(&marks);
5387 interp->lastCollectId = interp->referenceNextId;
5388 interp->lastCollectTime = time(NULL);
5389 #endif /* JIM_BOOTSTRAP */
5390 return collected;
5393 #define JIM_COLLECT_ID_PERIOD 5000
5394 #define JIM_COLLECT_TIME_PERIOD 300
5396 void Jim_CollectIfNeeded(Jim_Interp *interp)
5398 unsigned long elapsedId;
5399 int elapsedTime;
5401 elapsedId = interp->referenceNextId - interp->lastCollectId;
5402 elapsedTime = time(NULL) - interp->lastCollectTime;
5405 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5406 Jim_Collect(interp);
5409 #endif
5411 int Jim_IsBigEndian(void)
5413 union {
5414 unsigned short s;
5415 unsigned char c[2];
5416 } uval = {0x0102};
5418 return uval.c[0] == 1;
5421 /* -----------------------------------------------------------------------------
5422 * Interpreter related functions
5423 * ---------------------------------------------------------------------------*/
5425 Jim_Interp *Jim_CreateInterp(void)
5427 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5429 memset(i, 0, sizeof(*i));
5431 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5432 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5433 i->lastCollectTime = time(NULL);
5435 /* Note that we can create objects only after the
5436 * interpreter liveList and freeList pointers are
5437 * initialized to NULL. */
5438 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5439 #ifdef JIM_REFERENCES
5440 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5441 #endif
5442 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5443 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5444 i->emptyObj = Jim_NewEmptyStringObj(i);
5445 i->trueObj = Jim_NewIntObj(i, 1);
5446 i->falseObj = Jim_NewIntObj(i, 0);
5447 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5448 i->errorFileNameObj = i->emptyObj;
5449 i->result = i->emptyObj;
5450 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5451 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5452 i->errorProc = i->emptyObj;
5453 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5454 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5455 Jim_IncrRefCount(i->emptyObj);
5456 Jim_IncrRefCount(i->errorFileNameObj);
5457 Jim_IncrRefCount(i->result);
5458 Jim_IncrRefCount(i->stackTrace);
5459 Jim_IncrRefCount(i->unknown);
5460 Jim_IncrRefCount(i->currentScriptObj);
5461 Jim_IncrRefCount(i->nullScriptObj);
5462 Jim_IncrRefCount(i->errorProc);
5463 Jim_IncrRefCount(i->trueObj);
5464 Jim_IncrRefCount(i->falseObj);
5466 /* Initialize key variables every interpreter should contain */
5467 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5468 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5470 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5471 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5472 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5473 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5474 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5475 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5476 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5478 return i;
5481 void Jim_FreeInterp(Jim_Interp *i)
5483 Jim_CallFrame *cf, *cfx;
5485 Jim_Obj *objPtr, *nextObjPtr;
5487 /* Free the active call frames list - must be done before i->commands is destroyed */
5488 for (cf = i->framePtr; cf; cf = cfx) {
5489 cfx = cf->parent;
5490 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5493 Jim_DecrRefCount(i, i->emptyObj);
5494 Jim_DecrRefCount(i, i->trueObj);
5495 Jim_DecrRefCount(i, i->falseObj);
5496 Jim_DecrRefCount(i, i->result);
5497 Jim_DecrRefCount(i, i->stackTrace);
5498 Jim_DecrRefCount(i, i->errorProc);
5499 Jim_DecrRefCount(i, i->unknown);
5500 Jim_DecrRefCount(i, i->errorFileNameObj);
5501 Jim_DecrRefCount(i, i->currentScriptObj);
5502 Jim_DecrRefCount(i, i->nullScriptObj);
5503 Jim_FreeHashTable(&i->commands);
5504 #ifdef JIM_REFERENCES
5505 Jim_FreeHashTable(&i->references);
5506 #endif
5507 Jim_FreeHashTable(&i->packages);
5508 Jim_Free(i->prngState);
5509 Jim_FreeHashTable(&i->assocData);
5511 /* Check that the live object list is empty, otherwise
5512 * there is a memory leak. */
5513 #ifdef JIM_MAINTAINER
5514 if (i->liveList != NULL) {
5515 objPtr = i->liveList;
5517 printf("\n-------------------------------------\n");
5518 printf("Objects still in the free list:\n");
5519 while (objPtr) {
5520 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5522 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5523 printf("%p (%d) %-10s: '%.20s...'\n",
5524 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5526 else {
5527 printf("%p (%d) %-10s: '%s'\n",
5528 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5530 if (objPtr->typePtr == &sourceObjType) {
5531 printf("FILE %s LINE %d\n",
5532 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5533 objPtr->internalRep.sourceValue.lineNumber);
5535 objPtr = objPtr->nextObjPtr;
5537 printf("-------------------------------------\n\n");
5538 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5540 #endif
5542 /* Free all the freed objects. */
5543 objPtr = i->freeList;
5544 while (objPtr) {
5545 nextObjPtr = objPtr->nextObjPtr;
5546 Jim_Free(objPtr);
5547 objPtr = nextObjPtr;
5550 /* Free the free call frames list */
5551 for (cf = i->freeFramesList; cf; cf = cfx) {
5552 cfx = cf->next;
5553 if (cf->vars.table)
5554 Jim_FreeHashTable(&cf->vars);
5555 Jim_Free(cf);
5558 /* Free the interpreter structure. */
5559 Jim_Free(i);
5562 /* Returns the call frame relative to the level represented by
5563 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5565 * This function accepts the 'level' argument in the form
5566 * of the commands [uplevel] and [upvar].
5568 * Returns NULL on error.
5570 * Note: for a function accepting a relative integer as level suitable
5571 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5573 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5575 long level;
5576 const char *str;
5577 Jim_CallFrame *framePtr;
5579 if (levelObjPtr) {
5580 str = Jim_String(levelObjPtr);
5581 if (str[0] == '#') {
5582 char *endptr;
5584 level = jim_strtol(str + 1, &endptr);
5585 if (str[1] == '\0' || endptr[0] != '\0') {
5586 level = -1;
5589 else {
5590 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5591 level = -1;
5593 else {
5594 /* Convert from a relative to an absolute level */
5595 level = interp->framePtr->level - level;
5599 else {
5600 str = "1"; /* Needed to format the error message. */
5601 level = interp->framePtr->level - 1;
5604 if (level == 0) {
5605 return interp->topFramePtr;
5607 if (level > 0) {
5608 /* Lookup */
5609 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5610 if (framePtr->level == level) {
5611 return framePtr;
5616 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5617 return NULL;
5620 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5621 * as a relative integer like in the [info level ?level?] command.
5623 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5625 long level;
5626 Jim_CallFrame *framePtr;
5628 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5629 if (level <= 0) {
5630 /* Convert from a relative to an absolute level */
5631 level = interp->framePtr->level + level;
5634 if (level == 0) {
5635 return interp->topFramePtr;
5638 /* Lookup */
5639 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5640 if (framePtr->level == level) {
5641 return framePtr;
5646 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5647 return NULL;
5650 static void JimResetStackTrace(Jim_Interp *interp)
5652 Jim_DecrRefCount(interp, interp->stackTrace);
5653 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5654 Jim_IncrRefCount(interp->stackTrace);
5657 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5659 int len;
5661 /* Increment reference first in case these are the same object */
5662 Jim_IncrRefCount(stackTraceObj);
5663 Jim_DecrRefCount(interp, interp->stackTrace);
5664 interp->stackTrace = stackTraceObj;
5665 interp->errorFlag = 1;
5667 /* This is a bit ugly.
5668 * If the filename of the last entry of the stack trace is empty,
5669 * the next stack level should be added.
5671 len = Jim_ListLength(interp, interp->stackTrace);
5672 if (len >= 3) {
5673 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5674 interp->addStackTrace = 1;
5679 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5680 Jim_Obj *fileNameObj, int linenr)
5682 if (strcmp(procname, "unknown") == 0) {
5683 procname = "";
5685 if (!*procname && !Jim_Length(fileNameObj)) {
5686 /* No useful info here */
5687 return;
5690 if (Jim_IsShared(interp->stackTrace)) {
5691 Jim_DecrRefCount(interp, interp->stackTrace);
5692 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5693 Jim_IncrRefCount(interp->stackTrace);
5696 /* If we have no procname but the previous element did, merge with that frame */
5697 if (!*procname && Jim_Length(fileNameObj)) {
5698 /* Just a filename. Check the previous entry */
5699 int len = Jim_ListLength(interp, interp->stackTrace);
5701 if (len >= 3) {
5702 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5703 if (Jim_Length(objPtr)) {
5704 /* Yes, the previous level had procname */
5705 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5706 if (Jim_Length(objPtr) == 0) {
5707 /* But no filename, so merge the new info with that frame */
5708 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5709 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5710 return;
5716 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5717 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5718 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5721 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5722 void *data)
5724 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5726 assocEntryPtr->delProc = delProc;
5727 assocEntryPtr->data = data;
5728 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5731 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5733 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5735 if (entryPtr != NULL) {
5736 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5737 return assocEntryPtr->data;
5739 return NULL;
5742 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5744 return Jim_DeleteHashEntry(&interp->assocData, key);
5747 int Jim_GetExitCode(Jim_Interp *interp)
5749 return interp->exitCode;
5752 /* -----------------------------------------------------------------------------
5753 * Integer object
5754 * ---------------------------------------------------------------------------*/
5755 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5756 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5758 static const Jim_ObjType intObjType = {
5759 "int",
5760 NULL,
5761 NULL,
5762 UpdateStringOfInt,
5763 JIM_TYPE_NONE,
5766 /* A coerced double is closer to an int than a double.
5767 * It is an int value temporarily masquerading as a double value.
5768 * i.e. it has the same string value as an int and Jim_GetWide()
5769 * succeeds, but also Jim_GetDouble() returns the value directly.
5771 static const Jim_ObjType coercedDoubleObjType = {
5772 "coerced-double",
5773 NULL,
5774 NULL,
5775 UpdateStringOfInt,
5776 JIM_TYPE_NONE,
5780 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5782 char buf[JIM_INTEGER_SPACE + 1];
5783 jim_wide wideValue = JimWideValue(objPtr);
5784 int pos = 0;
5786 if (wideValue == 0) {
5787 buf[pos++] = '0';
5789 else {
5790 char tmp[JIM_INTEGER_SPACE];
5791 int num = 0;
5792 int i;
5794 if (wideValue < 0) {
5795 buf[pos++] = '-';
5796 i = wideValue % 10;
5797 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5798 * whereas C99 is always -6
5799 * coverity[dead_error_line]
5801 tmp[num++] = (i > 0) ? (10 - i) : -i;
5802 wideValue /= -10;
5805 while (wideValue) {
5806 tmp[num++] = wideValue % 10;
5807 wideValue /= 10;
5810 for (i = 0; i < num; i++) {
5811 buf[pos++] = '0' + tmp[num - i - 1];
5814 buf[pos] = 0;
5816 JimSetStringBytes(objPtr, buf);
5819 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5821 jim_wide wideValue;
5822 const char *str;
5824 if (objPtr->typePtr == &coercedDoubleObjType) {
5825 /* Simple switcheroo */
5826 objPtr->typePtr = &intObjType;
5827 return JIM_OK;
5830 /* Get the string representation */
5831 str = Jim_String(objPtr);
5832 /* Try to convert into a jim_wide */
5833 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5834 if (flags & JIM_ERRMSG) {
5835 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5837 return JIM_ERR;
5839 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5840 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5841 return JIM_ERR;
5843 /* Free the old internal repr and set the new one. */
5844 Jim_FreeIntRep(interp, objPtr);
5845 objPtr->typePtr = &intObjType;
5846 objPtr->internalRep.wideValue = wideValue;
5847 return JIM_OK;
5850 #ifdef JIM_OPTIMIZATION
5851 static int JimIsWide(Jim_Obj *objPtr)
5853 return objPtr->typePtr == &intObjType;
5855 #endif
5857 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5859 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5860 return JIM_ERR;
5861 *widePtr = JimWideValue(objPtr);
5862 return JIM_OK;
5865 /* Get a wide but does not set an error if the format is bad. */
5866 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5868 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5869 return JIM_ERR;
5870 *widePtr = JimWideValue(objPtr);
5871 return JIM_OK;
5874 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5876 jim_wide wideValue;
5877 int retval;
5879 retval = Jim_GetWide(interp, objPtr, &wideValue);
5880 if (retval == JIM_OK) {
5881 *longPtr = (long)wideValue;
5882 return JIM_OK;
5884 return JIM_ERR;
5887 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5889 Jim_Obj *objPtr;
5891 objPtr = Jim_NewObj(interp);
5892 objPtr->typePtr = &intObjType;
5893 objPtr->bytes = NULL;
5894 objPtr->internalRep.wideValue = wideValue;
5895 return objPtr;
5898 /* -----------------------------------------------------------------------------
5899 * Double object
5900 * ---------------------------------------------------------------------------*/
5901 #define JIM_DOUBLE_SPACE 30
5903 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5904 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5906 static const Jim_ObjType doubleObjType = {
5907 "double",
5908 NULL,
5909 NULL,
5910 UpdateStringOfDouble,
5911 JIM_TYPE_NONE,
5914 #ifndef HAVE_ISNAN
5915 #undef isnan
5916 #define isnan(X) ((X) != (X))
5917 #endif
5918 #ifndef HAVE_ISINF
5919 #undef isinf
5920 #define isinf(X) (1.0 / (X) == 0.0)
5921 #endif
5923 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5925 double value = objPtr->internalRep.doubleValue;
5927 if (isnan(value)) {
5928 JimSetStringBytes(objPtr, "NaN");
5929 return;
5931 if (isinf(value)) {
5932 if (value < 0) {
5933 JimSetStringBytes(objPtr, "-Inf");
5935 else {
5936 JimSetStringBytes(objPtr, "Inf");
5938 return;
5941 char buf[JIM_DOUBLE_SPACE + 1];
5942 int i;
5943 int len = sprintf(buf, "%.12g", value);
5945 /* Add a final ".0" if necessary */
5946 for (i = 0; i < len; i++) {
5947 if (buf[i] == '.' || buf[i] == 'e') {
5948 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5949 /* If 'buf' ends in e-0nn or e+0nn, remove
5950 * the 0 after the + or - and reduce the length by 1
5952 char *e = strchr(buf, 'e');
5953 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5954 /* Move it up */
5955 e += 2;
5956 memmove(e, e + 1, len - (e - buf));
5958 #endif
5959 break;
5962 if (buf[i] == '\0') {
5963 buf[i++] = '.';
5964 buf[i++] = '0';
5965 buf[i] = '\0';
5967 JimSetStringBytes(objPtr, buf);
5971 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5973 double doubleValue;
5974 jim_wide wideValue;
5975 const char *str;
5977 /* Preserve the string representation.
5978 * Needed so we can convert back to int without loss
5980 str = Jim_String(objPtr);
5982 #ifdef HAVE_LONG_LONG
5983 /* Assume a 53 bit mantissa */
5984 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5985 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5987 if (objPtr->typePtr == &intObjType
5988 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5989 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5991 /* Direct conversion to coerced double */
5992 objPtr->typePtr = &coercedDoubleObjType;
5993 return JIM_OK;
5995 else
5996 #endif
5997 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5998 /* Managed to convert to an int, so we can use this as a cooerced double */
5999 Jim_FreeIntRep(interp, objPtr);
6000 objPtr->typePtr = &coercedDoubleObjType;
6001 objPtr->internalRep.wideValue = wideValue;
6002 return JIM_OK;
6004 else {
6005 /* Try to convert into a double */
6006 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6007 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
6008 return JIM_ERR;
6010 /* Free the old internal repr and set the new one. */
6011 Jim_FreeIntRep(interp, objPtr);
6013 objPtr->typePtr = &doubleObjType;
6014 objPtr->internalRep.doubleValue = doubleValue;
6015 return JIM_OK;
6018 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6020 if (objPtr->typePtr == &coercedDoubleObjType) {
6021 *doublePtr = JimWideValue(objPtr);
6022 return JIM_OK;
6024 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6025 return JIM_ERR;
6027 if (objPtr->typePtr == &coercedDoubleObjType) {
6028 *doublePtr = JimWideValue(objPtr);
6030 else {
6031 *doublePtr = objPtr->internalRep.doubleValue;
6033 return JIM_OK;
6036 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6038 Jim_Obj *objPtr;
6040 objPtr = Jim_NewObj(interp);
6041 objPtr->typePtr = &doubleObjType;
6042 objPtr->bytes = NULL;
6043 objPtr->internalRep.doubleValue = doubleValue;
6044 return objPtr;
6047 /* -----------------------------------------------------------------------------
6048 * List object
6049 * ---------------------------------------------------------------------------*/
6050 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6051 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6052 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6053 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6054 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6055 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6057 /* Note that while the elements of the list may contain references,
6058 * the list object itself can't. This basically means that the
6059 * list object string representation as a whole can't contain references
6060 * that are not presents in the single elements. */
6061 static const Jim_ObjType listObjType = {
6062 "list",
6063 FreeListInternalRep,
6064 DupListInternalRep,
6065 UpdateStringOfList,
6066 JIM_TYPE_NONE,
6069 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6071 int i;
6073 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6074 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6076 Jim_Free(objPtr->internalRep.listValue.ele);
6079 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6081 int i;
6083 JIM_NOTUSED(interp);
6085 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6086 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6087 dupPtr->internalRep.listValue.ele =
6088 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6089 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6090 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6091 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6092 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6094 dupPtr->typePtr = &listObjType;
6097 /* The following function checks if a given string can be encoded
6098 * into a list element without any kind of quoting, surrounded by braces,
6099 * or using escapes to quote. */
6100 #define JIM_ELESTR_SIMPLE 0
6101 #define JIM_ELESTR_BRACE 1
6102 #define JIM_ELESTR_QUOTE 2
6103 static unsigned char ListElementQuotingType(const char *s, int len)
6105 int i, level, blevel, trySimple = 1;
6107 /* Try with the SIMPLE case */
6108 if (len == 0)
6109 return JIM_ELESTR_BRACE;
6110 if (s[0] == '"' || s[0] == '{') {
6111 trySimple = 0;
6112 goto testbrace;
6114 for (i = 0; i < len; i++) {
6115 switch (s[i]) {
6116 case ' ':
6117 case '$':
6118 case '"':
6119 case '[':
6120 case ']':
6121 case ';':
6122 case '\\':
6123 case '\r':
6124 case '\n':
6125 case '\t':
6126 case '\f':
6127 case '\v':
6128 trySimple = 0;
6129 case '{':
6130 case '}':
6131 goto testbrace;
6134 return JIM_ELESTR_SIMPLE;
6136 testbrace:
6137 /* Test if it's possible to do with braces */
6138 if (s[len - 1] == '\\')
6139 return JIM_ELESTR_QUOTE;
6140 level = 0;
6141 blevel = 0;
6142 for (i = 0; i < len; i++) {
6143 switch (s[i]) {
6144 case '{':
6145 level++;
6146 break;
6147 case '}':
6148 level--;
6149 if (level < 0)
6150 return JIM_ELESTR_QUOTE;
6151 break;
6152 case '[':
6153 blevel++;
6154 break;
6155 case ']':
6156 blevel--;
6157 break;
6158 case '\\':
6159 if (s[i + 1] == '\n')
6160 return JIM_ELESTR_QUOTE;
6161 else if (s[i + 1] != '\0')
6162 i++;
6163 break;
6166 if (blevel < 0) {
6167 return JIM_ELESTR_QUOTE;
6170 if (level == 0) {
6171 if (!trySimple)
6172 return JIM_ELESTR_BRACE;
6173 for (i = 0; i < len; i++) {
6174 switch (s[i]) {
6175 case ' ':
6176 case '$':
6177 case '"':
6178 case '[':
6179 case ']':
6180 case ';':
6181 case '\\':
6182 case '\r':
6183 case '\n':
6184 case '\t':
6185 case '\f':
6186 case '\v':
6187 return JIM_ELESTR_BRACE;
6188 break;
6191 return JIM_ELESTR_SIMPLE;
6193 return JIM_ELESTR_QUOTE;
6196 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6197 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6198 * scenario.
6199 * Returns the length of the result.
6201 static int BackslashQuoteString(const char *s, int len, char *q)
6203 char *p = q;
6205 while (len--) {
6206 switch (*s) {
6207 case ' ':
6208 case '$':
6209 case '"':
6210 case '[':
6211 case ']':
6212 case '{':
6213 case '}':
6214 case ';':
6215 case '\\':
6216 *p++ = '\\';
6217 *p++ = *s++;
6218 break;
6219 case '\n':
6220 *p++ = '\\';
6221 *p++ = 'n';
6222 s++;
6223 break;
6224 case '\r':
6225 *p++ = '\\';
6226 *p++ = 'r';
6227 s++;
6228 break;
6229 case '\t':
6230 *p++ = '\\';
6231 *p++ = 't';
6232 s++;
6233 break;
6234 case '\f':
6235 *p++ = '\\';
6236 *p++ = 'f';
6237 s++;
6238 break;
6239 case '\v':
6240 *p++ = '\\';
6241 *p++ = 'v';
6242 s++;
6243 break;
6244 default:
6245 *p++ = *s++;
6246 break;
6249 *p = '\0';
6251 return p - q;
6254 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6256 #define STATIC_QUOTING_LEN 32
6257 int i, bufLen, realLength;
6258 const char *strRep;
6259 char *p;
6260 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6262 /* Estimate the space needed. */
6263 if (objc > STATIC_QUOTING_LEN) {
6264 quotingType = Jim_Alloc(objc);
6266 else {
6267 quotingType = staticQuoting;
6269 bufLen = 0;
6270 for (i = 0; i < objc; i++) {
6271 int len;
6273 strRep = Jim_GetString(objv[i], &len);
6274 quotingType[i] = ListElementQuotingType(strRep, len);
6275 switch (quotingType[i]) {
6276 case JIM_ELESTR_SIMPLE:
6277 if (i != 0 || strRep[0] != '#') {
6278 bufLen += len;
6279 break;
6281 /* Special case '#' on first element needs braces */
6282 quotingType[i] = JIM_ELESTR_BRACE;
6283 /* fall through */
6284 case JIM_ELESTR_BRACE:
6285 bufLen += len + 2;
6286 break;
6287 case JIM_ELESTR_QUOTE:
6288 bufLen += len * 2;
6289 break;
6291 bufLen++; /* elements separator. */
6293 bufLen++;
6295 /* Generate the string rep. */
6296 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6297 realLength = 0;
6298 for (i = 0; i < objc; i++) {
6299 int len, qlen;
6301 strRep = Jim_GetString(objv[i], &len);
6303 switch (quotingType[i]) {
6304 case JIM_ELESTR_SIMPLE:
6305 memcpy(p, strRep, len);
6306 p += len;
6307 realLength += len;
6308 break;
6309 case JIM_ELESTR_BRACE:
6310 *p++ = '{';
6311 memcpy(p, strRep, len);
6312 p += len;
6313 *p++ = '}';
6314 realLength += len + 2;
6315 break;
6316 case JIM_ELESTR_QUOTE:
6317 if (i == 0 && strRep[0] == '#') {
6318 *p++ = '\\';
6319 realLength++;
6321 qlen = BackslashQuoteString(strRep, len, p);
6322 p += qlen;
6323 realLength += qlen;
6324 break;
6326 /* Add a separating space */
6327 if (i + 1 != objc) {
6328 *p++ = ' ';
6329 realLength++;
6332 *p = '\0'; /* nul term. */
6333 objPtr->length = realLength;
6335 if (quotingType != staticQuoting) {
6336 Jim_Free(quotingType);
6340 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6342 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6345 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6347 struct JimParserCtx parser;
6348 const char *str;
6349 int strLen;
6350 Jim_Obj *fileNameObj;
6351 int linenr;
6353 if (objPtr->typePtr == &listObjType) {
6354 return JIM_OK;
6357 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6358 * it also preserves any source location of the dict elements
6359 * which can be very useful
6361 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6362 Jim_Obj **listObjPtrPtr;
6363 int len;
6364 int i;
6366 listObjPtrPtr = JimDictPairs(objPtr, &len);
6367 for (i = 0; i < len; i++) {
6368 Jim_IncrRefCount(listObjPtrPtr[i]);
6371 /* Now just switch the internal rep */
6372 Jim_FreeIntRep(interp, objPtr);
6373 objPtr->typePtr = &listObjType;
6374 objPtr->internalRep.listValue.len = len;
6375 objPtr->internalRep.listValue.maxLen = len;
6376 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6378 return JIM_OK;
6381 /* Try to preserve information about filename / line number */
6382 if (objPtr->typePtr == &sourceObjType) {
6383 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6384 linenr = objPtr->internalRep.sourceValue.lineNumber;
6386 else {
6387 fileNameObj = interp->emptyObj;
6388 linenr = 1;
6390 Jim_IncrRefCount(fileNameObj);
6392 /* Get the string representation */
6393 str = Jim_GetString(objPtr, &strLen);
6395 /* Free the old internal repr just now and initialize the
6396 * new one just now. The string->list conversion can't fail. */
6397 Jim_FreeIntRep(interp, objPtr);
6398 objPtr->typePtr = &listObjType;
6399 objPtr->internalRep.listValue.len = 0;
6400 objPtr->internalRep.listValue.maxLen = 0;
6401 objPtr->internalRep.listValue.ele = NULL;
6403 /* Convert into a list */
6404 if (strLen) {
6405 JimParserInit(&parser, str, strLen, linenr);
6406 while (!parser.eof) {
6407 Jim_Obj *elementPtr;
6409 JimParseList(&parser);
6410 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6411 continue;
6412 elementPtr = JimParserGetTokenObj(interp, &parser);
6413 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6414 ListAppendElement(objPtr, elementPtr);
6417 Jim_DecrRefCount(interp, fileNameObj);
6418 return JIM_OK;
6421 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6423 Jim_Obj *objPtr;
6425 objPtr = Jim_NewObj(interp);
6426 objPtr->typePtr = &listObjType;
6427 objPtr->bytes = NULL;
6428 objPtr->internalRep.listValue.ele = NULL;
6429 objPtr->internalRep.listValue.len = 0;
6430 objPtr->internalRep.listValue.maxLen = 0;
6432 if (len) {
6433 ListInsertElements(objPtr, 0, len, elements);
6436 return objPtr;
6439 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6440 * length of the vector. Note that the user of this function should make
6441 * sure that the list object can't shimmer while the vector returned
6442 * is in use, this vector is the one stored inside the internal representation
6443 * of the list object. This function is not exported, extensions should
6444 * always access to the List object elements using Jim_ListIndex(). */
6445 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6446 Jim_Obj ***listVec)
6448 *listLen = Jim_ListLength(interp, listObj);
6449 *listVec = listObj->internalRep.listValue.ele;
6452 /* Sorting uses ints, but commands may return wide */
6453 static int JimSign(jim_wide w)
6455 if (w == 0) {
6456 return 0;
6458 else if (w < 0) {
6459 return -1;
6461 return 1;
6464 /* ListSortElements type values */
6465 struct lsort_info {
6466 jmp_buf jmpbuf;
6467 Jim_Obj *command;
6468 Jim_Interp *interp;
6469 enum {
6470 JIM_LSORT_ASCII,
6471 JIM_LSORT_NOCASE,
6472 JIM_LSORT_INTEGER,
6473 JIM_LSORT_REAL,
6474 JIM_LSORT_COMMAND
6475 } type;
6476 int order;
6477 int index;
6478 int indexed;
6479 int unique;
6480 int (*subfn)(Jim_Obj **, Jim_Obj **);
6483 static struct lsort_info *sort_info;
6485 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6487 Jim_Obj *lObj, *rObj;
6489 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6490 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6491 longjmp(sort_info->jmpbuf, JIM_ERR);
6493 return sort_info->subfn(&lObj, &rObj);
6496 /* Sort the internal rep of a list. */
6497 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6499 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6502 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6504 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6507 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6509 jim_wide lhs = 0, rhs = 0;
6511 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6512 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6513 longjmp(sort_info->jmpbuf, JIM_ERR);
6516 return JimSign(lhs - rhs) * sort_info->order;
6519 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6521 double lhs = 0, rhs = 0;
6523 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6524 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6525 longjmp(sort_info->jmpbuf, JIM_ERR);
6527 if (lhs == rhs) {
6528 return 0;
6530 if (lhs > rhs) {
6531 return sort_info->order;
6533 return -sort_info->order;
6536 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6538 Jim_Obj *compare_script;
6539 int rc;
6541 jim_wide ret = 0;
6543 /* This must be a valid list */
6544 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6545 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6546 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6548 rc = Jim_EvalObj(sort_info->interp, compare_script);
6550 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6551 longjmp(sort_info->jmpbuf, rc);
6554 return JimSign(ret) * sort_info->order;
6557 /* Remove duplicate elements from the (sorted) list in-place, according to the
6558 * comparison function, comp.
6560 * Note that the last unique value is kept, not the first
6562 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6564 int src;
6565 int dst = 0;
6566 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6568 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6569 if (comp(&ele[dst], &ele[src]) == 0) {
6570 /* Match, so replace the dest with the current source */
6571 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6573 else {
6574 /* No match, so keep the current source and move to the next destination */
6575 dst++;
6577 ele[dst] = ele[src];
6579 /* At end of list, keep the final element */
6580 ele[++dst] = ele[src];
6582 /* Set the new length */
6583 listObjPtr->internalRep.listValue.len = dst;
6586 /* Sort a list *in place*. MUST be called with a non-shared list. */
6587 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6589 struct lsort_info *prev_info;
6591 typedef int (qsort_comparator) (const void *, const void *);
6592 int (*fn) (Jim_Obj **, Jim_Obj **);
6593 Jim_Obj **vector;
6594 int len;
6595 int rc;
6597 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6598 SetListFromAny(interp, listObjPtr);
6600 /* Allow lsort to be called reentrantly */
6601 prev_info = sort_info;
6602 sort_info = info;
6604 vector = listObjPtr->internalRep.listValue.ele;
6605 len = listObjPtr->internalRep.listValue.len;
6606 switch (info->type) {
6607 case JIM_LSORT_ASCII:
6608 fn = ListSortString;
6609 break;
6610 case JIM_LSORT_NOCASE:
6611 fn = ListSortStringNoCase;
6612 break;
6613 case JIM_LSORT_INTEGER:
6614 fn = ListSortInteger;
6615 break;
6616 case JIM_LSORT_REAL:
6617 fn = ListSortReal;
6618 break;
6619 case JIM_LSORT_COMMAND:
6620 fn = ListSortCommand;
6621 break;
6622 default:
6623 fn = NULL; /* avoid warning */
6624 JimPanic((1, "ListSort called with invalid sort type"));
6627 if (info->indexed) {
6628 /* Need to interpose a "list index" function */
6629 info->subfn = fn;
6630 fn = ListSortIndexHelper;
6633 if ((rc = setjmp(info->jmpbuf)) == 0) {
6634 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6636 if (info->unique && len > 1) {
6637 ListRemoveDuplicates(listObjPtr, fn);
6640 Jim_InvalidateStringRep(listObjPtr);
6642 sort_info = prev_info;
6644 return rc;
6647 /* This is the low-level function to insert elements into a list.
6648 * The higher-level Jim_ListInsertElements() performs shared object
6649 * check and invalidates the string repr. This version is used
6650 * in the internals of the List Object and is not exported.
6652 * NOTE: this function can be called only against objects
6653 * with internal type of List.
6655 * An insertion point (idx) of -1 means end-of-list.
6657 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6659 int currentLen = listPtr->internalRep.listValue.len;
6660 int requiredLen = currentLen + elemc;
6661 int i;
6662 Jim_Obj **point;
6664 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6665 if (requiredLen < 2) {
6666 /* Don't do allocations of under 4 pointers. */
6667 requiredLen = 4;
6669 else {
6670 requiredLen *= 2;
6673 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6674 sizeof(Jim_Obj *) * requiredLen);
6676 listPtr->internalRep.listValue.maxLen = requiredLen;
6678 if (idx < 0) {
6679 idx = currentLen;
6681 point = listPtr->internalRep.listValue.ele + idx;
6682 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6683 for (i = 0; i < elemc; ++i) {
6684 point[i] = elemVec[i];
6685 Jim_IncrRefCount(point[i]);
6687 listPtr->internalRep.listValue.len += elemc;
6690 /* Convenience call to ListInsertElements() to append a single element.
6692 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6694 ListInsertElements(listPtr, -1, 1, &objPtr);
6697 /* Appends every element of appendListPtr into listPtr.
6698 * Both have to be of the list type.
6699 * Convenience call to ListInsertElements()
6701 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6703 ListInsertElements(listPtr, -1,
6704 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6707 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6709 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6710 SetListFromAny(interp, listPtr);
6711 Jim_InvalidateStringRep(listPtr);
6712 ListAppendElement(listPtr, objPtr);
6715 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6717 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6718 SetListFromAny(interp, listPtr);
6719 SetListFromAny(interp, appendListPtr);
6720 Jim_InvalidateStringRep(listPtr);
6721 ListAppendList(listPtr, appendListPtr);
6724 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6726 SetListFromAny(interp, objPtr);
6727 return objPtr->internalRep.listValue.len;
6730 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6731 int objc, Jim_Obj *const *objVec)
6733 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6734 SetListFromAny(interp, listPtr);
6735 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6736 idx = listPtr->internalRep.listValue.len;
6737 else if (idx < 0)
6738 idx = 0;
6739 Jim_InvalidateStringRep(listPtr);
6740 ListInsertElements(listPtr, idx, objc, objVec);
6743 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6745 SetListFromAny(interp, listPtr);
6746 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6747 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6748 return NULL;
6750 if (idx < 0)
6751 idx = listPtr->internalRep.listValue.len + idx;
6752 return listPtr->internalRep.listValue.ele[idx];
6755 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6757 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6758 if (*objPtrPtr == NULL) {
6759 if (flags & JIM_ERRMSG) {
6760 Jim_SetResultString(interp, "list index out of range", -1);
6762 return JIM_ERR;
6764 return JIM_OK;
6767 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6768 Jim_Obj *newObjPtr, int flags)
6770 SetListFromAny(interp, listPtr);
6771 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6772 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6773 if (flags & JIM_ERRMSG) {
6774 Jim_SetResultString(interp, "list index out of range", -1);
6776 return JIM_ERR;
6778 if (idx < 0)
6779 idx = listPtr->internalRep.listValue.len + idx;
6780 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6781 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6782 Jim_IncrRefCount(newObjPtr);
6783 return JIM_OK;
6786 /* Modify the list stored in the variable named 'varNamePtr'
6787 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6788 * with the new element 'newObjptr'. (implements the [lset] command) */
6789 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6790 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6792 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6793 int shared, i, idx;
6795 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6796 if (objPtr == NULL)
6797 return JIM_ERR;
6798 if ((shared = Jim_IsShared(objPtr)))
6799 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6800 for (i = 0; i < indexc - 1; i++) {
6801 listObjPtr = objPtr;
6802 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6803 goto err;
6804 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6805 goto err;
6807 if (Jim_IsShared(objPtr)) {
6808 objPtr = Jim_DuplicateObj(interp, objPtr);
6809 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6811 Jim_InvalidateStringRep(listObjPtr);
6813 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6814 goto err;
6815 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6816 goto err;
6817 Jim_InvalidateStringRep(objPtr);
6818 Jim_InvalidateStringRep(varObjPtr);
6819 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6820 goto err;
6821 Jim_SetResult(interp, varObjPtr);
6822 return JIM_OK;
6823 err:
6824 if (shared) {
6825 Jim_FreeNewObj(interp, varObjPtr);
6827 return JIM_ERR;
6830 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6832 int i;
6833 int listLen = Jim_ListLength(interp, listObjPtr);
6834 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6836 for (i = 0; i < listLen; ) {
6837 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6838 if (++i != listLen) {
6839 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6842 return resObjPtr;
6845 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6847 int i;
6849 /* If all the objects in objv are lists,
6850 * it's possible to return a list as result, that's the
6851 * concatenation of all the lists. */
6852 for (i = 0; i < objc; i++) {
6853 if (!Jim_IsList(objv[i]))
6854 break;
6856 if (i == objc) {
6857 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6859 for (i = 0; i < objc; i++)
6860 ListAppendList(objPtr, objv[i]);
6861 return objPtr;
6863 else {
6864 /* Else... we have to glue strings together */
6865 int len = 0, objLen;
6866 char *bytes, *p;
6868 /* Compute the length */
6869 for (i = 0; i < objc; i++) {
6870 len += Jim_Length(objv[i]);
6872 if (objc)
6873 len += objc - 1;
6874 /* Create the string rep, and a string object holding it. */
6875 p = bytes = Jim_Alloc(len + 1);
6876 for (i = 0; i < objc; i++) {
6877 const char *s = Jim_GetString(objv[i], &objLen);
6879 /* Remove leading space */
6880 while (objLen && isspace(UCHAR(*s))) {
6881 s++;
6882 objLen--;
6883 len--;
6885 /* And trailing space */
6886 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6887 /* Handle trailing backslash-space case */
6888 if (objLen > 1 && s[objLen - 2] == '\\') {
6889 break;
6891 objLen--;
6892 len--;
6894 memcpy(p, s, objLen);
6895 p += objLen;
6896 if (i + 1 != objc) {
6897 if (objLen)
6898 *p++ = ' ';
6899 else {
6900 /* Drop the space calcuated for this
6901 * element that is instead null. */
6902 len--;
6906 *p = '\0';
6907 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6911 /* Returns a list composed of the elements in the specified range.
6912 * first and start are directly accepted as Jim_Objects and
6913 * processed for the end?-index? case. */
6914 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6915 Jim_Obj *lastObjPtr)
6917 int first, last;
6918 int len, rangeLen;
6920 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6921 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6922 return NULL;
6923 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6924 first = JimRelToAbsIndex(len, first);
6925 last = JimRelToAbsIndex(len, last);
6926 JimRelToAbsRange(len, &first, &last, &rangeLen);
6927 if (first == 0 && last == len) {
6928 return listObjPtr;
6930 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6933 /* -----------------------------------------------------------------------------
6934 * Dict object
6935 * ---------------------------------------------------------------------------*/
6936 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6937 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6938 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6939 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6941 /* Dict HashTable Type.
6943 * Keys and Values are Jim objects. */
6945 static unsigned int JimObjectHTHashFunction(const void *key)
6947 int len;
6948 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6949 return Jim_GenHashFunction((const unsigned char *)str, len);
6952 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6954 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6957 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6959 Jim_IncrRefCount((Jim_Obj *)val);
6960 return (void *)val;
6963 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6965 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6968 static const Jim_HashTableType JimDictHashTableType = {
6969 JimObjectHTHashFunction, /* hash function */
6970 JimObjectHTKeyValDup, /* key dup */
6971 JimObjectHTKeyValDup, /* val dup */
6972 JimObjectHTKeyCompare, /* key compare */
6973 JimObjectHTKeyValDestructor, /* key destructor */
6974 JimObjectHTKeyValDestructor /* val destructor */
6977 /* Note that while the elements of the dict may contain references,
6978 * the list object itself can't. This basically means that the
6979 * dict object string representation as a whole can't contain references
6980 * that are not presents in the single elements. */
6981 static const Jim_ObjType dictObjType = {
6982 "dict",
6983 FreeDictInternalRep,
6984 DupDictInternalRep,
6985 UpdateStringOfDict,
6986 JIM_TYPE_NONE,
6989 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6991 JIM_NOTUSED(interp);
6993 Jim_FreeHashTable(objPtr->internalRep.ptr);
6994 Jim_Free(objPtr->internalRep.ptr);
6997 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6999 Jim_HashTable *ht, *dupHt;
7000 Jim_HashTableIterator htiter;
7001 Jim_HashEntry *he;
7003 /* Create a new hash table */
7004 ht = srcPtr->internalRep.ptr;
7005 dupHt = Jim_Alloc(sizeof(*dupHt));
7006 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7007 if (ht->size != 0)
7008 Jim_ExpandHashTable(dupHt, ht->size);
7009 /* Copy every element from the source to the dup hash table */
7010 JimInitHashTableIterator(ht, &htiter);
7011 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7012 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7015 dupPtr->internalRep.ptr = dupHt;
7016 dupPtr->typePtr = &dictObjType;
7019 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7021 Jim_HashTable *ht;
7022 Jim_HashTableIterator htiter;
7023 Jim_HashEntry *he;
7024 Jim_Obj **objv;
7025 int i;
7027 ht = dictPtr->internalRep.ptr;
7029 /* Turn the hash table into a flat vector of Jim_Objects. */
7030 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7031 JimInitHashTableIterator(ht, &htiter);
7032 i = 0;
7033 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7034 objv[i++] = Jim_GetHashEntryKey(he);
7035 objv[i++] = Jim_GetHashEntryVal(he);
7037 *len = i;
7038 return objv;
7041 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7043 /* Turn the hash table into a flat vector of Jim_Objects. */
7044 int len;
7045 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7047 /* And now generate the string rep as a list */
7048 JimMakeListStringRep(objPtr, objv, len);
7050 Jim_Free(objv);
7053 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7055 int listlen;
7057 if (objPtr->typePtr == &dictObjType) {
7058 return JIM_OK;
7061 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7062 /* A shared list, so get the string representation now to avoid
7063 * changing the order in case of fast conversion to dict.
7065 Jim_String(objPtr);
7068 /* For simplicity, convert a non-list object to a list and then to a dict */
7069 listlen = Jim_ListLength(interp, objPtr);
7070 if (listlen % 2) {
7071 Jim_SetResultString(interp, "missing value to go with key", -1);
7072 return JIM_ERR;
7074 else {
7075 /* Converting from a list to a dict can't fail */
7076 Jim_HashTable *ht;
7077 int i;
7079 ht = Jim_Alloc(sizeof(*ht));
7080 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7082 for (i = 0; i < listlen; i += 2) {
7083 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7084 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7086 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7089 Jim_FreeIntRep(interp, objPtr);
7090 objPtr->typePtr = &dictObjType;
7091 objPtr->internalRep.ptr = ht;
7093 return JIM_OK;
7097 /* Dict object API */
7099 /* Add an element to a dict. objPtr must be of the "dict" type.
7100 * The higer-level exported function is Jim_DictAddElement().
7101 * If an element with the specified key already exists, the value
7102 * associated is replaced with the new one.
7104 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7105 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7106 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7108 Jim_HashTable *ht = objPtr->internalRep.ptr;
7110 if (valueObjPtr == NULL) { /* unset */
7111 return Jim_DeleteHashEntry(ht, keyObjPtr);
7113 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7114 return JIM_OK;
7117 /* Add an element, higher-level interface for DictAddElement().
7118 * If valueObjPtr == NULL, the key is removed if it exists. */
7119 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7120 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7122 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7123 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7124 return JIM_ERR;
7126 Jim_InvalidateStringRep(objPtr);
7127 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7130 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7132 Jim_Obj *objPtr;
7133 int i;
7135 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7137 objPtr = Jim_NewObj(interp);
7138 objPtr->typePtr = &dictObjType;
7139 objPtr->bytes = NULL;
7140 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7141 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7142 for (i = 0; i < len; i += 2)
7143 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7144 return objPtr;
7147 /* Return the value associated to the specified dict key
7148 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7150 * Sets *objPtrPtr to non-NULL only upon success.
7152 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7153 Jim_Obj **objPtrPtr, int flags)
7155 Jim_HashEntry *he;
7156 Jim_HashTable *ht;
7158 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7159 return -1;
7161 ht = dictPtr->internalRep.ptr;
7162 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7163 if (flags & JIM_ERRMSG) {
7164 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7166 return JIM_ERR;
7168 *objPtrPtr = he->u.val;
7169 return JIM_OK;
7172 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7173 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7175 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7176 return JIM_ERR;
7178 *objPtrPtr = JimDictPairs(dictPtr, len);
7180 return JIM_OK;
7184 /* Return the value associated to the specified dict keys */
7185 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7186 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7188 int i;
7190 if (keyc == 0) {
7191 *objPtrPtr = dictPtr;
7192 return JIM_OK;
7195 for (i = 0; i < keyc; i++) {
7196 Jim_Obj *objPtr;
7198 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7199 if (rc != JIM_OK) {
7200 return rc;
7202 dictPtr = objPtr;
7204 *objPtrPtr = dictPtr;
7205 return JIM_OK;
7208 /* Modify the dict stored into the variable named 'varNamePtr'
7209 * setting the element specified by the 'keyc' keys objects in 'keyv',
7210 * with the new value of the element 'newObjPtr'.
7212 * If newObjPtr == NULL the operation is to remove the given key
7213 * from the dictionary.
7215 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7216 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7218 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7219 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7221 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7222 int shared, i;
7224 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7225 if (objPtr == NULL) {
7226 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7227 /* Cannot remove a key from non existing var */
7228 return JIM_ERR;
7230 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7231 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7232 Jim_FreeNewObj(interp, varObjPtr);
7233 return JIM_ERR;
7236 if ((shared = Jim_IsShared(objPtr)))
7237 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7238 for (i = 0; i < keyc; i++) {
7239 dictObjPtr = objPtr;
7241 /* Check if it's a valid dictionary */
7242 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7243 goto err;
7246 if (i == keyc - 1) {
7247 /* Last key: Note that error on unset with missing last key is OK */
7248 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7249 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7250 goto err;
7253 break;
7256 /* Check if the given key exists. */
7257 Jim_InvalidateStringRep(dictObjPtr);
7258 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7259 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7260 /* This key exists at the current level.
7261 * Make sure it's not shared!. */
7262 if (Jim_IsShared(objPtr)) {
7263 objPtr = Jim_DuplicateObj(interp, objPtr);
7264 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7267 else {
7268 /* Key not found. If it's an [unset] operation
7269 * this is an error. Only the last key may not
7270 * exist. */
7271 if (newObjPtr == NULL) {
7272 goto err;
7274 /* Otherwise set an empty dictionary
7275 * as key's value. */
7276 objPtr = Jim_NewDictObj(interp, NULL, 0);
7277 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7280 /* XXX: Is this necessary? */
7281 Jim_InvalidateStringRep(objPtr);
7282 Jim_InvalidateStringRep(varObjPtr);
7283 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7284 goto err;
7286 Jim_SetResult(interp, varObjPtr);
7287 return JIM_OK;
7288 err:
7289 if (shared) {
7290 Jim_FreeNewObj(interp, varObjPtr);
7292 return JIM_ERR;
7295 /* -----------------------------------------------------------------------------
7296 * Index object
7297 * ---------------------------------------------------------------------------*/
7298 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7299 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7301 static const Jim_ObjType indexObjType = {
7302 "index",
7303 NULL,
7304 NULL,
7305 UpdateStringOfIndex,
7306 JIM_TYPE_NONE,
7309 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7311 if (objPtr->internalRep.intValue == -1) {
7312 JimSetStringBytes(objPtr, "end");
7314 else {
7315 char buf[JIM_INTEGER_SPACE + 1];
7316 if (objPtr->internalRep.intValue >= 0) {
7317 sprintf(buf, "%d", objPtr->internalRep.intValue);
7319 else {
7320 /* Must be <= -2 */
7321 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7323 JimSetStringBytes(objPtr, buf);
7327 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7329 int idx, end = 0;
7330 const char *str;
7331 char *endptr;
7333 /* Get the string representation */
7334 str = Jim_String(objPtr);
7336 /* Try to convert into an index */
7337 if (strncmp(str, "end", 3) == 0) {
7338 end = 1;
7339 str += 3;
7340 idx = 0;
7342 else {
7343 idx = jim_strtol(str, &endptr);
7345 if (endptr == str) {
7346 goto badindex;
7348 str = endptr;
7351 /* Now str may include or +<num> or -<num> */
7352 if (*str == '+' || *str == '-') {
7353 int sign = (*str == '+' ? 1 : -1);
7355 idx += sign * jim_strtol(++str, &endptr);
7356 if (str == endptr || *endptr) {
7357 goto badindex;
7359 str = endptr;
7361 /* The only thing left should be spaces */
7362 while (isspace(UCHAR(*str))) {
7363 str++;
7365 if (*str) {
7366 goto badindex;
7368 if (end) {
7369 if (idx > 0) {
7370 idx = INT_MAX;
7372 else {
7373 /* end-1 is repesented as -2 */
7374 idx--;
7377 else if (idx < 0) {
7378 idx = -INT_MAX;
7381 /* Free the old internal repr and set the new one. */
7382 Jim_FreeIntRep(interp, objPtr);
7383 objPtr->typePtr = &indexObjType;
7384 objPtr->internalRep.intValue = idx;
7385 return JIM_OK;
7387 badindex:
7388 Jim_SetResultFormatted(interp,
7389 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7390 return JIM_ERR;
7393 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7395 /* Avoid shimmering if the object is an integer. */
7396 if (objPtr->typePtr == &intObjType) {
7397 jim_wide val = JimWideValue(objPtr);
7399 if (val < 0)
7400 *indexPtr = -INT_MAX;
7401 else if (val > INT_MAX)
7402 *indexPtr = INT_MAX;
7403 else
7404 *indexPtr = (int)val;
7405 return JIM_OK;
7407 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7408 return JIM_ERR;
7409 *indexPtr = objPtr->internalRep.intValue;
7410 return JIM_OK;
7413 /* -----------------------------------------------------------------------------
7414 * Return Code Object.
7415 * ---------------------------------------------------------------------------*/
7417 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7418 static const char * const jimReturnCodes[] = {
7419 "ok",
7420 "error",
7421 "return",
7422 "break",
7423 "continue",
7424 "signal",
7425 "exit",
7426 "eval",
7427 NULL
7430 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7432 static const Jim_ObjType returnCodeObjType = {
7433 "return-code",
7434 NULL,
7435 NULL,
7436 NULL,
7437 JIM_TYPE_NONE,
7440 /* Converts a (standard) return code to a string. Returns "?" for
7441 * non-standard return codes.
7443 const char *Jim_ReturnCode(int code)
7445 if (code < 0 || code >= (int)jimReturnCodesSize) {
7446 return "?";
7448 else {
7449 return jimReturnCodes[code];
7453 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7455 int returnCode;
7456 jim_wide wideValue;
7458 /* Try to convert into an integer */
7459 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7460 returnCode = (int)wideValue;
7461 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7462 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7463 return JIM_ERR;
7465 /* Free the old internal repr and set the new one. */
7466 Jim_FreeIntRep(interp, objPtr);
7467 objPtr->typePtr = &returnCodeObjType;
7468 objPtr->internalRep.intValue = returnCode;
7469 return JIM_OK;
7472 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7474 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7475 return JIM_ERR;
7476 *intPtr = objPtr->internalRep.intValue;
7477 return JIM_OK;
7480 /* -----------------------------------------------------------------------------
7481 * Expression Parsing
7482 * ---------------------------------------------------------------------------*/
7483 static int JimParseExprOperator(struct JimParserCtx *pc);
7484 static int JimParseExprNumber(struct JimParserCtx *pc);
7485 static int JimParseExprIrrational(struct JimParserCtx *pc);
7487 /* Exrp's Stack machine operators opcodes. */
7489 /* Binary operators (numbers) */
7490 enum
7492 /* Continues on from the JIM_TT_ space */
7493 /* Operations */
7494 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7495 JIM_EXPROP_DIV,
7496 JIM_EXPROP_MOD,
7497 JIM_EXPROP_SUB,
7498 JIM_EXPROP_ADD,
7499 JIM_EXPROP_LSHIFT,
7500 JIM_EXPROP_RSHIFT,
7501 JIM_EXPROP_ROTL,
7502 JIM_EXPROP_ROTR,
7503 JIM_EXPROP_LT,
7504 JIM_EXPROP_GT,
7505 JIM_EXPROP_LTE,
7506 JIM_EXPROP_GTE,
7507 JIM_EXPROP_NUMEQ,
7508 JIM_EXPROP_NUMNE,
7509 JIM_EXPROP_BITAND, /* 35 */
7510 JIM_EXPROP_BITXOR,
7511 JIM_EXPROP_BITOR,
7513 /* Note must keep these together */
7514 JIM_EXPROP_LOGICAND, /* 38 */
7515 JIM_EXPROP_LOGICAND_LEFT,
7516 JIM_EXPROP_LOGICAND_RIGHT,
7518 /* and these */
7519 JIM_EXPROP_LOGICOR, /* 41 */
7520 JIM_EXPROP_LOGICOR_LEFT,
7521 JIM_EXPROP_LOGICOR_RIGHT,
7523 /* and these */
7524 /* Ternary operators */
7525 JIM_EXPROP_TERNARY, /* 44 */
7526 JIM_EXPROP_TERNARY_LEFT,
7527 JIM_EXPROP_TERNARY_RIGHT,
7529 /* and these */
7530 JIM_EXPROP_COLON, /* 47 */
7531 JIM_EXPROP_COLON_LEFT,
7532 JIM_EXPROP_COLON_RIGHT,
7534 JIM_EXPROP_POW, /* 50 */
7536 /* Binary operators (strings) */
7537 JIM_EXPROP_STREQ, /* 51 */
7538 JIM_EXPROP_STRNE,
7539 JIM_EXPROP_STRIN,
7540 JIM_EXPROP_STRNI,
7542 /* Unary operators (numbers) */
7543 JIM_EXPROP_NOT, /* 55 */
7544 JIM_EXPROP_BITNOT,
7545 JIM_EXPROP_UNARYMINUS,
7546 JIM_EXPROP_UNARYPLUS,
7548 /* Functions */
7549 JIM_EXPROP_FUNC_FIRST, /* 59 */
7550 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7551 JIM_EXPROP_FUNC_ABS,
7552 JIM_EXPROP_FUNC_DOUBLE,
7553 JIM_EXPROP_FUNC_ROUND,
7554 JIM_EXPROP_FUNC_RAND,
7555 JIM_EXPROP_FUNC_SRAND,
7557 /* math functions from libm */
7558 JIM_EXPROP_FUNC_SIN, /* 64 */
7559 JIM_EXPROP_FUNC_COS,
7560 JIM_EXPROP_FUNC_TAN,
7561 JIM_EXPROP_FUNC_ASIN,
7562 JIM_EXPROP_FUNC_ACOS,
7563 JIM_EXPROP_FUNC_ATAN,
7564 JIM_EXPROP_FUNC_SINH,
7565 JIM_EXPROP_FUNC_COSH,
7566 JIM_EXPROP_FUNC_TANH,
7567 JIM_EXPROP_FUNC_CEIL,
7568 JIM_EXPROP_FUNC_FLOOR,
7569 JIM_EXPROP_FUNC_EXP,
7570 JIM_EXPROP_FUNC_LOG,
7571 JIM_EXPROP_FUNC_LOG10,
7572 JIM_EXPROP_FUNC_SQRT,
7573 JIM_EXPROP_FUNC_POW,
7576 struct JimExprState
7578 Jim_Obj **stack;
7579 int stacklen;
7580 int opcode;
7581 int skip;
7584 /* Operators table */
7585 typedef struct Jim_ExprOperator
7587 const char *name;
7588 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7589 unsigned char precedence;
7590 unsigned char arity;
7591 unsigned char lazy;
7592 unsigned char namelen;
7593 } Jim_ExprOperator;
7595 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7597 Jim_IncrRefCount(obj);
7598 e->stack[e->stacklen++] = obj;
7601 static Jim_Obj *ExprPop(struct JimExprState *e)
7603 return e->stack[--e->stacklen];
7606 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7608 int intresult = 1;
7609 int rc = JIM_OK;
7610 Jim_Obj *A = ExprPop(e);
7611 double dA, dC = 0;
7612 jim_wide wA, wC = 0;
7614 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7615 switch (e->opcode) {
7616 case JIM_EXPROP_FUNC_INT:
7617 case JIM_EXPROP_FUNC_ROUND:
7618 case JIM_EXPROP_UNARYPLUS:
7619 wC = wA;
7620 break;
7621 case JIM_EXPROP_FUNC_DOUBLE:
7622 dC = wA;
7623 intresult = 0;
7624 break;
7625 case JIM_EXPROP_FUNC_ABS:
7626 wC = wA >= 0 ? wA : -wA;
7627 break;
7628 case JIM_EXPROP_UNARYMINUS:
7629 wC = -wA;
7630 break;
7631 case JIM_EXPROP_NOT:
7632 wC = !wA;
7633 break;
7634 default:
7635 abort();
7638 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7639 switch (e->opcode) {
7640 case JIM_EXPROP_FUNC_INT:
7641 wC = dA;
7642 break;
7643 case JIM_EXPROP_FUNC_ROUND:
7644 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7645 break;
7646 case JIM_EXPROP_FUNC_DOUBLE:
7647 case JIM_EXPROP_UNARYPLUS:
7648 dC = dA;
7649 intresult = 0;
7650 break;
7651 case JIM_EXPROP_FUNC_ABS:
7652 dC = dA >= 0 ? dA : -dA;
7653 intresult = 0;
7654 break;
7655 case JIM_EXPROP_UNARYMINUS:
7656 dC = -dA;
7657 intresult = 0;
7658 break;
7659 case JIM_EXPROP_NOT:
7660 wC = !dA;
7661 break;
7662 default:
7663 abort();
7667 if (rc == JIM_OK) {
7668 if (intresult) {
7669 ExprPush(e, Jim_NewIntObj(interp, wC));
7671 else {
7672 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7676 Jim_DecrRefCount(interp, A);
7678 return rc;
7681 static double JimRandDouble(Jim_Interp *interp)
7683 unsigned long x;
7684 JimRandomBytes(interp, &x, sizeof(x));
7686 return (double)x / (unsigned long)~0;
7689 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7691 Jim_Obj *A = ExprPop(e);
7692 jim_wide wA;
7694 int rc = Jim_GetWide(interp, A, &wA);
7695 if (rc == JIM_OK) {
7696 switch (e->opcode) {
7697 case JIM_EXPROP_BITNOT:
7698 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7699 break;
7700 case JIM_EXPROP_FUNC_SRAND:
7701 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7702 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7703 break;
7704 default:
7705 abort();
7709 Jim_DecrRefCount(interp, A);
7711 return rc;
7714 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7716 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7718 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7720 return JIM_OK;
7723 #ifdef JIM_MATH_FUNCTIONS
7724 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7726 int rc;
7727 Jim_Obj *A = ExprPop(e);
7728 double dA, dC;
7730 rc = Jim_GetDouble(interp, A, &dA);
7731 if (rc == JIM_OK) {
7732 switch (e->opcode) {
7733 case JIM_EXPROP_FUNC_SIN:
7734 dC = sin(dA);
7735 break;
7736 case JIM_EXPROP_FUNC_COS:
7737 dC = cos(dA);
7738 break;
7739 case JIM_EXPROP_FUNC_TAN:
7740 dC = tan(dA);
7741 break;
7742 case JIM_EXPROP_FUNC_ASIN:
7743 dC = asin(dA);
7744 break;
7745 case JIM_EXPROP_FUNC_ACOS:
7746 dC = acos(dA);
7747 break;
7748 case JIM_EXPROP_FUNC_ATAN:
7749 dC = atan(dA);
7750 break;
7751 case JIM_EXPROP_FUNC_SINH:
7752 dC = sinh(dA);
7753 break;
7754 case JIM_EXPROP_FUNC_COSH:
7755 dC = cosh(dA);
7756 break;
7757 case JIM_EXPROP_FUNC_TANH:
7758 dC = tanh(dA);
7759 break;
7760 case JIM_EXPROP_FUNC_CEIL:
7761 dC = ceil(dA);
7762 break;
7763 case JIM_EXPROP_FUNC_FLOOR:
7764 dC = floor(dA);
7765 break;
7766 case JIM_EXPROP_FUNC_EXP:
7767 dC = exp(dA);
7768 break;
7769 case JIM_EXPROP_FUNC_LOG:
7770 dC = log(dA);
7771 break;
7772 case JIM_EXPROP_FUNC_LOG10:
7773 dC = log10(dA);
7774 break;
7775 case JIM_EXPROP_FUNC_SQRT:
7776 dC = sqrt(dA);
7777 break;
7778 default:
7779 abort();
7781 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7784 Jim_DecrRefCount(interp, A);
7786 return rc;
7788 #endif
7790 /* A binary operation on two ints */
7791 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7793 Jim_Obj *B = ExprPop(e);
7794 Jim_Obj *A = ExprPop(e);
7795 jim_wide wA, wB;
7796 int rc = JIM_ERR;
7798 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7799 jim_wide wC;
7801 rc = JIM_OK;
7803 switch (e->opcode) {
7804 case JIM_EXPROP_LSHIFT:
7805 wC = wA << wB;
7806 break;
7807 case JIM_EXPROP_RSHIFT:
7808 wC = wA >> wB;
7809 break;
7810 case JIM_EXPROP_BITAND:
7811 wC = wA & wB;
7812 break;
7813 case JIM_EXPROP_BITXOR:
7814 wC = wA ^ wB;
7815 break;
7816 case JIM_EXPROP_BITOR:
7817 wC = wA | wB;
7818 break;
7819 case JIM_EXPROP_MOD:
7820 if (wB == 0) {
7821 wC = 0;
7822 Jim_SetResultString(interp, "Division by zero", -1);
7823 rc = JIM_ERR;
7825 else {
7827 * From Tcl 8.x
7829 * This code is tricky: C doesn't guarantee much
7830 * about the quotient or remainder, but Tcl does.
7831 * The remainder always has the same sign as the
7832 * divisor and a smaller absolute value.
7834 int negative = 0;
7836 if (wB < 0) {
7837 wB = -wB;
7838 wA = -wA;
7839 negative = 1;
7841 wC = wA % wB;
7842 if (wC < 0) {
7843 wC += wB;
7845 if (negative) {
7846 wC = -wC;
7849 break;
7850 case JIM_EXPROP_ROTL:
7851 case JIM_EXPROP_ROTR:{
7852 /* uint32_t would be better. But not everyone has inttypes.h? */
7853 unsigned long uA = (unsigned long)wA;
7854 unsigned long uB = (unsigned long)wB;
7855 const unsigned int S = sizeof(unsigned long) * 8;
7857 /* Shift left by the word size or more is undefined. */
7858 uB %= S;
7860 if (e->opcode == JIM_EXPROP_ROTR) {
7861 uB = S - uB;
7863 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7864 break;
7866 default:
7867 abort();
7869 ExprPush(e, Jim_NewIntObj(interp, wC));
7873 Jim_DecrRefCount(interp, A);
7874 Jim_DecrRefCount(interp, B);
7876 return rc;
7880 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7881 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7883 int intresult = 1;
7884 int rc = JIM_OK;
7885 double dA, dB, dC = 0;
7886 jim_wide wA, wB, wC = 0;
7888 Jim_Obj *B = ExprPop(e);
7889 Jim_Obj *A = ExprPop(e);
7891 if ((A->typePtr != &doubleObjType || A->bytes) &&
7892 (B->typePtr != &doubleObjType || B->bytes) &&
7893 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7895 /* Both are ints */
7897 switch (e->opcode) {
7898 case JIM_EXPROP_POW:
7899 case JIM_EXPROP_FUNC_POW:
7900 wC = JimPowWide(wA, wB);
7901 break;
7902 case JIM_EXPROP_ADD:
7903 wC = wA + wB;
7904 break;
7905 case JIM_EXPROP_SUB:
7906 wC = wA - wB;
7907 break;
7908 case JIM_EXPROP_MUL:
7909 wC = wA * wB;
7910 break;
7911 case JIM_EXPROP_DIV:
7912 if (wB == 0) {
7913 Jim_SetResultString(interp, "Division by zero", -1);
7914 rc = JIM_ERR;
7916 else {
7918 * From Tcl 8.x
7920 * This code is tricky: C doesn't guarantee much
7921 * about the quotient or remainder, but Tcl does.
7922 * The remainder always has the same sign as the
7923 * divisor and a smaller absolute value.
7925 if (wB < 0) {
7926 wB = -wB;
7927 wA = -wA;
7929 wC = wA / wB;
7930 if (wA % wB < 0) {
7931 wC--;
7934 break;
7935 case JIM_EXPROP_LT:
7936 wC = wA < wB;
7937 break;
7938 case JIM_EXPROP_GT:
7939 wC = wA > wB;
7940 break;
7941 case JIM_EXPROP_LTE:
7942 wC = wA <= wB;
7943 break;
7944 case JIM_EXPROP_GTE:
7945 wC = wA >= wB;
7946 break;
7947 case JIM_EXPROP_NUMEQ:
7948 wC = wA == wB;
7949 break;
7950 case JIM_EXPROP_NUMNE:
7951 wC = wA != wB;
7952 break;
7953 default:
7954 abort();
7957 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7958 intresult = 0;
7959 switch (e->opcode) {
7960 case JIM_EXPROP_POW:
7961 case JIM_EXPROP_FUNC_POW:
7962 #ifdef JIM_MATH_FUNCTIONS
7963 dC = pow(dA, dB);
7964 #else
7965 Jim_SetResultString(interp, "unsupported", -1);
7966 rc = JIM_ERR;
7967 #endif
7968 break;
7969 case JIM_EXPROP_ADD:
7970 dC = dA + dB;
7971 break;
7972 case JIM_EXPROP_SUB:
7973 dC = dA - dB;
7974 break;
7975 case JIM_EXPROP_MUL:
7976 dC = dA * dB;
7977 break;
7978 case JIM_EXPROP_DIV:
7979 if (dB == 0) {
7980 #ifdef INFINITY
7981 dC = dA < 0 ? -INFINITY : INFINITY;
7982 #else
7983 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7984 #endif
7986 else {
7987 dC = dA / dB;
7989 break;
7990 case JIM_EXPROP_LT:
7991 wC = dA < dB;
7992 intresult = 1;
7993 break;
7994 case JIM_EXPROP_GT:
7995 wC = dA > dB;
7996 intresult = 1;
7997 break;
7998 case JIM_EXPROP_LTE:
7999 wC = dA <= dB;
8000 intresult = 1;
8001 break;
8002 case JIM_EXPROP_GTE:
8003 wC = dA >= dB;
8004 intresult = 1;
8005 break;
8006 case JIM_EXPROP_NUMEQ:
8007 wC = dA == dB;
8008 intresult = 1;
8009 break;
8010 case JIM_EXPROP_NUMNE:
8011 wC = dA != dB;
8012 intresult = 1;
8013 break;
8014 default:
8015 abort();
8018 else {
8019 /* Handle the string case */
8021 /* XXX: Could optimise the eq/ne case by checking lengths */
8022 int i = Jim_StringCompareObj(interp, A, B, 0);
8024 switch (e->opcode) {
8025 case JIM_EXPROP_LT:
8026 wC = i < 0;
8027 break;
8028 case JIM_EXPROP_GT:
8029 wC = i > 0;
8030 break;
8031 case JIM_EXPROP_LTE:
8032 wC = i <= 0;
8033 break;
8034 case JIM_EXPROP_GTE:
8035 wC = i >= 0;
8036 break;
8037 case JIM_EXPROP_NUMEQ:
8038 wC = i == 0;
8039 break;
8040 case JIM_EXPROP_NUMNE:
8041 wC = i != 0;
8042 break;
8043 default:
8044 rc = JIM_ERR;
8045 break;
8049 if (rc == JIM_OK) {
8050 if (intresult) {
8051 ExprPush(e, Jim_NewIntObj(interp, wC));
8053 else {
8054 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8058 Jim_DecrRefCount(interp, A);
8059 Jim_DecrRefCount(interp, B);
8061 return rc;
8064 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8066 int listlen;
8067 int i;
8069 listlen = Jim_ListLength(interp, listObjPtr);
8070 for (i = 0; i < listlen; i++) {
8071 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8072 return 1;
8075 return 0;
8078 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8080 Jim_Obj *B = ExprPop(e);
8081 Jim_Obj *A = ExprPop(e);
8083 jim_wide wC;
8085 switch (e->opcode) {
8086 case JIM_EXPROP_STREQ:
8087 case JIM_EXPROP_STRNE:
8088 wC = Jim_StringEqObj(A, B);
8089 if (e->opcode == JIM_EXPROP_STRNE) {
8090 wC = !wC;
8092 break;
8093 case JIM_EXPROP_STRIN:
8094 wC = JimSearchList(interp, B, A);
8095 break;
8096 case JIM_EXPROP_STRNI:
8097 wC = !JimSearchList(interp, B, A);
8098 break;
8099 default:
8100 abort();
8102 ExprPush(e, Jim_NewIntObj(interp, wC));
8104 Jim_DecrRefCount(interp, A);
8105 Jim_DecrRefCount(interp, B);
8107 return JIM_OK;
8110 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8112 long l;
8113 double d;
8115 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8116 return l != 0;
8118 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8119 return d != 0;
8121 return -1;
8124 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8126 Jim_Obj *skip = ExprPop(e);
8127 Jim_Obj *A = ExprPop(e);
8128 int rc = JIM_OK;
8130 switch (ExprBool(interp, A)) {
8131 case 0:
8132 /* false, so skip RHS opcodes with a 0 result */
8133 e->skip = JimWideValue(skip);
8134 ExprPush(e, Jim_NewIntObj(interp, 0));
8135 break;
8137 case 1:
8138 /* true so continue */
8139 break;
8141 case -1:
8142 /* Invalid */
8143 rc = JIM_ERR;
8145 Jim_DecrRefCount(interp, A);
8146 Jim_DecrRefCount(interp, skip);
8148 return rc;
8151 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8153 Jim_Obj *skip = ExprPop(e);
8154 Jim_Obj *A = ExprPop(e);
8155 int rc = JIM_OK;
8157 switch (ExprBool(interp, A)) {
8158 case 0:
8159 /* false, so do nothing */
8160 break;
8162 case 1:
8163 /* true so skip RHS opcodes with a 1 result */
8164 e->skip = JimWideValue(skip);
8165 ExprPush(e, Jim_NewIntObj(interp, 1));
8166 break;
8168 case -1:
8169 /* Invalid */
8170 rc = JIM_ERR;
8171 break;
8173 Jim_DecrRefCount(interp, A);
8174 Jim_DecrRefCount(interp, skip);
8176 return rc;
8179 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8181 Jim_Obj *A = ExprPop(e);
8182 int rc = JIM_OK;
8184 switch (ExprBool(interp, A)) {
8185 case 0:
8186 ExprPush(e, Jim_NewIntObj(interp, 0));
8187 break;
8189 case 1:
8190 ExprPush(e, Jim_NewIntObj(interp, 1));
8191 break;
8193 case -1:
8194 /* Invalid */
8195 rc = JIM_ERR;
8196 break;
8198 Jim_DecrRefCount(interp, A);
8200 return rc;
8203 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8205 Jim_Obj *skip = ExprPop(e);
8206 Jim_Obj *A = ExprPop(e);
8207 int rc = JIM_OK;
8209 /* Repush A */
8210 ExprPush(e, A);
8212 switch (ExprBool(interp, A)) {
8213 case 0:
8214 /* false, skip RHS opcodes */
8215 e->skip = JimWideValue(skip);
8216 /* Push a dummy value */
8217 ExprPush(e, Jim_NewIntObj(interp, 0));
8218 break;
8220 case 1:
8221 /* true so do nothing */
8222 break;
8224 case -1:
8225 /* Invalid */
8226 rc = JIM_ERR;
8227 break;
8229 Jim_DecrRefCount(interp, A);
8230 Jim_DecrRefCount(interp, skip);
8232 return rc;
8235 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8237 Jim_Obj *skip = ExprPop(e);
8238 Jim_Obj *B = ExprPop(e);
8239 Jim_Obj *A = ExprPop(e);
8241 /* No need to check for A as non-boolean */
8242 if (ExprBool(interp, A)) {
8243 /* true, so skip RHS opcodes */
8244 e->skip = JimWideValue(skip);
8245 /* Repush B as the answer */
8246 ExprPush(e, B);
8249 Jim_DecrRefCount(interp, skip);
8250 Jim_DecrRefCount(interp, A);
8251 Jim_DecrRefCount(interp, B);
8252 return JIM_OK;
8255 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8257 return JIM_OK;
8260 enum
8262 LAZY_NONE,
8263 LAZY_OP,
8264 LAZY_LEFT,
8265 LAZY_RIGHT
8268 /* name - precedence - arity - opcode
8270 * This array *must* be kept in sync with the JIM_EXPROP enum.
8272 * The following macros pre-compute the string length at compile time.
8274 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8275 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8277 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8278 OPRINIT("*", 110, 2, JimExprOpBin),
8279 OPRINIT("/", 110, 2, JimExprOpBin),
8280 OPRINIT("%", 110, 2, JimExprOpIntBin),
8282 OPRINIT("-", 100, 2, JimExprOpBin),
8283 OPRINIT("+", 100, 2, JimExprOpBin),
8285 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8286 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8288 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8289 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8291 OPRINIT("<", 80, 2, JimExprOpBin),
8292 OPRINIT(">", 80, 2, JimExprOpBin),
8293 OPRINIT("<=", 80, 2, JimExprOpBin),
8294 OPRINIT(">=", 80, 2, JimExprOpBin),
8296 OPRINIT("==", 70, 2, JimExprOpBin),
8297 OPRINIT("!=", 70, 2, JimExprOpBin),
8299 OPRINIT("&", 50, 2, JimExprOpIntBin),
8300 OPRINIT("^", 49, 2, JimExprOpIntBin),
8301 OPRINIT("|", 48, 2, JimExprOpIntBin),
8303 OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP),
8304 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8305 OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8307 OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP),
8308 OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8309 OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8311 OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP),
8312 OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8313 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8315 OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP),
8316 OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8317 OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8319 OPRINIT("**", 250, 2, JimExprOpBin),
8321 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8322 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8324 OPRINIT("in", 55, 2, JimExprOpStrBin),
8325 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8327 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8328 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8329 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8330 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8334 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8335 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8336 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8337 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8338 OPRINIT("rand", 200, 0, JimExprOpNone),
8339 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8341 #ifdef JIM_MATH_FUNCTIONS
8342 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8343 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8344 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8345 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8346 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8347 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8348 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8349 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8350 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8351 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8352 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8353 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8354 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8355 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8356 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8357 OPRINIT("pow", 200, 2, JimExprOpBin),
8358 #endif
8360 #undef OPRINIT
8361 #undef OPRINIT_LAZY
8363 #define JIM_EXPR_OPERATORS_NUM \
8364 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8366 static int JimParseExpression(struct JimParserCtx *pc)
8368 /* Discard spaces and quoted newline */
8369 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8370 if (*pc->p == '\n') {
8371 pc->linenr++;
8373 pc->p++;
8374 pc->len--;
8377 /* Common case */
8378 pc->tline = pc->linenr;
8379 pc->tstart = pc->p;
8381 if (pc->len == 0) {
8382 pc->tend = pc->p;
8383 pc->tt = JIM_TT_EOL;
8384 pc->eof = 1;
8385 return JIM_OK;
8387 switch (*(pc->p)) {
8388 case '(':
8389 pc->tt = JIM_TT_SUBEXPR_START;
8390 goto singlechar;
8391 case ')':
8392 pc->tt = JIM_TT_SUBEXPR_END;
8393 goto singlechar;
8394 case ',':
8395 pc->tt = JIM_TT_SUBEXPR_COMMA;
8396 singlechar:
8397 pc->tend = pc->p;
8398 pc->p++;
8399 pc->len--;
8400 break;
8401 case '[':
8402 return JimParseCmd(pc);
8403 case '$':
8404 if (JimParseVar(pc) == JIM_ERR)
8405 return JimParseExprOperator(pc);
8406 else {
8407 /* Don't allow expr sugar in expressions */
8408 if (pc->tt == JIM_TT_EXPRSUGAR) {
8409 return JIM_ERR;
8411 return JIM_OK;
8413 break;
8414 case '0':
8415 case '1':
8416 case '2':
8417 case '3':
8418 case '4':
8419 case '5':
8420 case '6':
8421 case '7':
8422 case '8':
8423 case '9':
8424 case '.':
8425 return JimParseExprNumber(pc);
8426 case '"':
8427 return JimParseQuote(pc);
8428 case '{':
8429 return JimParseBrace(pc);
8431 case 'N':
8432 case 'I':
8433 case 'n':
8434 case 'i':
8435 if (JimParseExprIrrational(pc) == JIM_ERR)
8436 return JimParseExprOperator(pc);
8437 break;
8438 default:
8439 return JimParseExprOperator(pc);
8440 break;
8442 return JIM_OK;
8445 static int JimParseExprNumber(struct JimParserCtx *pc)
8447 char *end;
8449 /* Assume an integer for now */
8450 pc->tt = JIM_TT_EXPR_INT;
8452 jim_strtoull(pc->p, (char **)&pc->p);
8453 /* Tried as an integer, but perhaps it parses as a double */
8454 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8455 /* Some stupid compilers insist they are cleverer that
8456 * we are. Even a (void) cast doesn't prevent this warning!
8458 if (strtod(pc->tstart, &end)) { /* nothing */ }
8459 if (end == pc->tstart)
8460 return JIM_ERR;
8461 if (end > pc->p) {
8462 /* Yes, double captured more chars */
8463 pc->tt = JIM_TT_EXPR_DOUBLE;
8464 pc->p = end;
8467 pc->tend = pc->p - 1;
8468 pc->len -= (pc->p - pc->tstart);
8469 return JIM_OK;
8472 static int JimParseExprIrrational(struct JimParserCtx *pc)
8474 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8475 int i;
8477 for (i = 0; irrationals[i]; i++) {
8478 const char *irr = irrationals[i];
8480 if (strncmp(irr, pc->p, 3) == 0) {
8481 pc->p += 3;
8482 pc->len -= 3;
8483 pc->tend = pc->p - 1;
8484 pc->tt = JIM_TT_EXPR_DOUBLE;
8485 return JIM_OK;
8488 return JIM_ERR;
8491 static int JimParseExprOperator(struct JimParserCtx *pc)
8493 int i;
8494 int bestIdx = -1, bestLen = 0;
8496 /* Try to get the longest match. */
8497 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8498 const char * const opname = Jim_ExprOperators[i].name;
8499 const int oplen = Jim_ExprOperators[i].namelen;
8501 if (opname == NULL || opname[0] != pc->p[0]) {
8502 continue;
8505 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8506 bestIdx = i + JIM_TT_EXPR_OP;
8507 bestLen = oplen;
8510 if (bestIdx == -1) {
8511 return JIM_ERR;
8514 /* Validate paretheses around function arguments */
8515 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8516 const char *p = pc->p + bestLen;
8517 int len = pc->len - bestLen;
8519 while (len && isspace(UCHAR(*p))) {
8520 len--;
8521 p++;
8523 if (*p != '(') {
8524 return JIM_ERR;
8527 pc->tend = pc->p + bestLen - 1;
8528 pc->p += bestLen;
8529 pc->len -= bestLen;
8531 pc->tt = bestIdx;
8532 return JIM_OK;
8535 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8537 static Jim_ExprOperator dummy_op;
8538 if (opcode < JIM_TT_EXPR_OP) {
8539 return &dummy_op;
8541 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8544 const char *jim_tt_name(int type)
8546 static const char * const tt_names[JIM_TT_EXPR_OP] =
8547 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8548 "DBL", "$()" };
8549 if (type < JIM_TT_EXPR_OP) {
8550 return tt_names[type];
8552 else {
8553 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8554 static char buf[20];
8556 if (op->name) {
8557 return op->name;
8559 sprintf(buf, "(%d)", type);
8560 return buf;
8564 /* -----------------------------------------------------------------------------
8565 * Expression Object
8566 * ---------------------------------------------------------------------------*/
8567 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8568 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8569 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8571 static const Jim_ObjType exprObjType = {
8572 "expression",
8573 FreeExprInternalRep,
8574 DupExprInternalRep,
8575 NULL,
8576 JIM_TYPE_REFERENCES,
8579 /* Expr bytecode structure */
8580 typedef struct ExprByteCode
8582 ScriptToken *token; /* Tokens array. */
8583 int len; /* Length as number of tokens. */
8584 int inUse; /* Used for sharing. */
8585 } ExprByteCode;
8587 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8589 int i;
8591 for (i = 0; i < expr->len; i++) {
8592 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8594 Jim_Free(expr->token);
8595 Jim_Free(expr);
8598 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8600 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8602 if (expr) {
8603 if (--expr->inUse != 0) {
8604 return;
8607 ExprFreeByteCode(interp, expr);
8611 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8613 JIM_NOTUSED(interp);
8614 JIM_NOTUSED(srcPtr);
8616 /* Just returns an simple string. */
8617 dupPtr->typePtr = NULL;
8620 /* Check if an expr program looks correct. */
8621 static int ExprCheckCorrectness(ExprByteCode * expr)
8623 int i;
8624 int stacklen = 0;
8625 int ternary = 0;
8627 /* Try to check if there are stack underflows,
8628 * and make sure at the end of the program there is
8629 * a single result on the stack. */
8630 for (i = 0; i < expr->len; i++) {
8631 ScriptToken *t = &expr->token[i];
8632 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8634 stacklen -= op->arity;
8635 if (stacklen < 0) {
8636 break;
8638 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8639 ternary++;
8641 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8642 ternary--;
8645 /* All operations and operands add one to the stack */
8646 stacklen++;
8648 if (stacklen != 1 || ternary != 0) {
8649 return JIM_ERR;
8651 return JIM_OK;
8654 /* This procedure converts every occurrence of || and && opereators
8655 * in lazy unary versions.
8657 * a b || is converted into:
8659 * a <offset> |L b |R
8661 * a b && is converted into:
8663 * a <offset> &L b &R
8665 * "|L" checks if 'a' is true:
8666 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8667 * the opcode just after |R.
8668 * 2) if it is false does nothing.
8669 * "|R" checks if 'b' is true:
8670 * 1) if it is true pushes 1, otherwise pushes 0.
8672 * "&L" checks if 'a' is true:
8673 * 1) if it is true does nothing.
8674 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8675 * the opcode just after &R
8676 * "&R" checks if 'a' is true:
8677 * if it is true pushes 1, otherwise pushes 0.
8679 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8681 int i;
8683 int leftindex, arity, offset;
8685 /* Search for the end of the first operator */
8686 leftindex = expr->len - 1;
8688 arity = 1;
8689 while (arity) {
8690 ScriptToken *tt = &expr->token[leftindex];
8692 if (tt->type >= JIM_TT_EXPR_OP) {
8693 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8695 arity--;
8696 if (--leftindex < 0) {
8697 return JIM_ERR;
8700 leftindex++;
8702 /* Move them up */
8703 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8704 sizeof(*expr->token) * (expr->len - leftindex));
8705 expr->len += 2;
8706 offset = (expr->len - leftindex) - 1;
8708 /* Now we rely on the fact the the left and right version have opcodes
8709 * 1 and 2 after the main opcode respectively
8711 expr->token[leftindex + 1].type = t->type + 1;
8712 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8714 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8715 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8717 /* Now add the 'R' operator */
8718 expr->token[expr->len].objPtr = interp->emptyObj;
8719 expr->token[expr->len].type = t->type + 2;
8720 expr->len++;
8722 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8723 for (i = leftindex - 1; i > 0; i--) {
8724 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8725 if (op->lazy == LAZY_LEFT) {
8726 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8727 JimWideValue(expr->token[i - 1].objPtr) += 2;
8731 return JIM_OK;
8734 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8736 struct ScriptToken *token = &expr->token[expr->len];
8737 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8739 if (op->lazy == LAZY_OP) {
8740 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8741 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8742 return JIM_ERR;
8745 else {
8746 token->objPtr = interp->emptyObj;
8747 token->type = t->type;
8748 expr->len++;
8750 return JIM_OK;
8754 * Returns the index of the COLON_LEFT to the left of 'right_index'
8755 * taking into account nesting.
8757 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8759 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8761 int ternary_count = 1;
8763 right_index--;
8765 while (right_index > 1) {
8766 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8767 ternary_count--;
8769 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8770 ternary_count++;
8772 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8773 return right_index;
8775 right_index--;
8778 /*notreached*/
8779 return -1;
8783 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8785 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8786 * Otherwise returns 0.
8788 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8790 int i = right_index - 1;
8791 int ternary_count = 1;
8793 while (i > 1) {
8794 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8795 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8796 *prev_right_index = i - 2;
8797 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8798 return 1;
8801 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8802 if (ternary_count == 0) {
8803 return 0;
8805 ternary_count++;
8807 i--;
8809 return 0;
8813 * ExprTernaryReorderExpression description
8814 * ========================================
8816 * ?: is right-to-left associative which doesn't work with the stack-based
8817 * expression engine. The fix is to reorder the bytecode.
8819 * The expression:
8821 * expr 1?2:0?3:4
8823 * Has initial bytecode:
8825 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8826 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8828 * The fix involves simulating this expression instead:
8830 * expr 1?2:(0?3:4)
8832 * With the following bytecode:
8834 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8835 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8837 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8838 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8839 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8840 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8842 * ExprTernaryReorderExpression works thus as follows :
8843 * - start from the end of the stack
8844 * - while walking towards the beginning of the stack
8845 * if token=JIM_EXPROP_COLON_RIGHT then
8846 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8847 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8848 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8849 * if all found then
8850 * perform the rotation
8851 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8852 * end if
8853 * end if
8855 * Note: care has to be taken for nested ternary constructs!!!
8857 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8859 int i;
8861 for (i = expr->len - 1; i > 1; i--) {
8862 int prev_right_index;
8863 int prev_left_index;
8864 int j;
8865 ScriptToken tmp;
8867 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8868 continue;
8871 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8872 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8873 continue;
8877 ** rotate tokens down
8879 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8880 ** | | |
8881 ** | V V
8882 ** | [...] : ...
8883 ** | | |
8884 ** | V V
8885 ** | [...] : ...
8886 ** | | |
8887 ** | V V
8888 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8890 tmp = expr->token[prev_right_index];
8891 for (j = prev_right_index; j < i; j++) {
8892 expr->token[j] = expr->token[j + 1];
8894 expr->token[i] = tmp;
8896 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8898 * This is 'colon left increment' = i - prev_right_index
8900 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8901 * [prev_left_index-1] : skip_count
8904 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8906 /* Adjust for i-- in the loop */
8907 i++;
8911 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8913 Jim_Stack stack;
8914 ExprByteCode *expr;
8915 int ok = 1;
8916 int i;
8917 int prevtt = JIM_TT_NONE;
8918 int have_ternary = 0;
8920 /* -1 for EOL */
8921 int count = tokenlist->count - 1;
8923 expr = Jim_Alloc(sizeof(*expr));
8924 expr->inUse = 1;
8925 expr->len = 0;
8927 Jim_InitStack(&stack);
8929 /* Need extra bytecodes for lazy operators.
8930 * Also check for the ternary operator
8932 for (i = 0; i < tokenlist->count; i++) {
8933 ParseToken *t = &tokenlist->list[i];
8934 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8936 if (op->lazy == LAZY_OP) {
8937 count += 2;
8938 /* Ternary is a lazy op but also needs reordering */
8939 if (t->type == JIM_EXPROP_TERNARY) {
8940 have_ternary = 1;
8945 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8947 for (i = 0; i < tokenlist->count && ok; i++) {
8948 ParseToken *t = &tokenlist->list[i];
8950 /* Next token will be stored here */
8951 struct ScriptToken *token = &expr->token[expr->len];
8953 if (t->type == JIM_TT_EOL) {
8954 break;
8957 switch (t->type) {
8958 case JIM_TT_STR:
8959 case JIM_TT_ESC:
8960 case JIM_TT_VAR:
8961 case JIM_TT_DICTSUGAR:
8962 case JIM_TT_EXPRSUGAR:
8963 case JIM_TT_CMD:
8964 token->type = t->type;
8965 strexpr:
8966 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8967 if (t->type == JIM_TT_CMD) {
8968 /* Only commands need source info */
8969 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8971 expr->len++;
8972 break;
8974 case JIM_TT_EXPR_INT:
8975 case JIM_TT_EXPR_DOUBLE:
8977 char *endptr;
8978 if (t->type == JIM_TT_EXPR_INT) {
8979 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8981 else {
8982 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8984 if (endptr != t->token + t->len) {
8985 /* Conversion failed, so just store it as a string */
8986 Jim_FreeNewObj(interp, token->objPtr);
8987 token->type = JIM_TT_STR;
8988 goto strexpr;
8990 token->type = t->type;
8991 expr->len++;
8993 break;
8995 case JIM_TT_SUBEXPR_START:
8996 Jim_StackPush(&stack, t);
8997 prevtt = JIM_TT_NONE;
8998 continue;
9000 case JIM_TT_SUBEXPR_COMMA:
9001 /* Simple approach. Comma is simply ignored */
9002 continue;
9004 case JIM_TT_SUBEXPR_END:
9005 ok = 0;
9006 while (Jim_StackLen(&stack)) {
9007 ParseToken *tt = Jim_StackPop(&stack);
9009 if (tt->type == JIM_TT_SUBEXPR_START) {
9010 ok = 1;
9011 break;
9014 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9015 goto err;
9018 if (!ok) {
9019 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9020 goto err;
9022 break;
9025 default:{
9026 /* Must be an operator */
9027 const struct Jim_ExprOperator *op;
9028 ParseToken *tt;
9030 /* Convert -/+ to unary minus or unary plus if necessary */
9031 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9032 if (t->type == JIM_EXPROP_SUB) {
9033 t->type = JIM_EXPROP_UNARYMINUS;
9035 else if (t->type == JIM_EXPROP_ADD) {
9036 t->type = JIM_EXPROP_UNARYPLUS;
9040 op = JimExprOperatorInfoByOpcode(t->type);
9042 /* Now handle precedence */
9043 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9044 const struct Jim_ExprOperator *tt_op =
9045 JimExprOperatorInfoByOpcode(tt->type);
9047 /* Note that right-to-left associativity of ?: operator is handled later */
9049 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9050 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9051 ok = 0;
9052 goto err;
9054 Jim_StackPop(&stack);
9056 else {
9057 break;
9060 Jim_StackPush(&stack, t);
9061 break;
9064 prevtt = t->type;
9067 /* Reduce any remaining subexpr */
9068 while (Jim_StackLen(&stack)) {
9069 ParseToken *tt = Jim_StackPop(&stack);
9071 if (tt->type == JIM_TT_SUBEXPR_START) {
9072 ok = 0;
9073 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9074 goto err;
9076 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9077 ok = 0;
9078 goto err;
9082 if (have_ternary) {
9083 ExprTernaryReorderExpression(interp, expr);
9086 err:
9087 /* Free the stack used for the compilation. */
9088 Jim_FreeStack(&stack);
9090 for (i = 0; i < expr->len; i++) {
9091 Jim_IncrRefCount(expr->token[i].objPtr);
9094 if (!ok) {
9095 ExprFreeByteCode(interp, expr);
9096 return NULL;
9099 return expr;
9103 /* This method takes the string representation of an expression
9104 * and generates a program for the Expr's stack-based VM. */
9105 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9107 int exprTextLen;
9108 const char *exprText;
9109 struct JimParserCtx parser;
9110 struct ExprByteCode *expr;
9111 ParseTokenList tokenlist;
9112 int line;
9113 Jim_Obj *fileNameObj;
9114 int rc = JIM_ERR;
9116 /* Try to get information about filename / line number */
9117 if (objPtr->typePtr == &sourceObjType) {
9118 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9119 line = objPtr->internalRep.sourceValue.lineNumber;
9121 else {
9122 fileNameObj = interp->emptyObj;
9123 line = 1;
9125 Jim_IncrRefCount(fileNameObj);
9127 exprText = Jim_GetString(objPtr, &exprTextLen);
9129 /* Initially tokenise the expression into tokenlist */
9130 ScriptTokenListInit(&tokenlist);
9132 JimParserInit(&parser, exprText, exprTextLen, line);
9133 while (!parser.eof) {
9134 if (JimParseExpression(&parser) != JIM_OK) {
9135 ScriptTokenListFree(&tokenlist);
9136 invalidexpr:
9137 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9138 expr = NULL;
9139 goto err;
9142 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9143 parser.tline);
9146 #ifdef DEBUG_SHOW_EXPR_TOKENS
9148 int i;
9149 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9150 for (i = 0; i < tokenlist.count; i++) {
9151 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9152 tokenlist.list[i].len, tokenlist.list[i].token);
9155 #endif
9157 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9158 ScriptTokenListFree(&tokenlist);
9159 Jim_DecrRefCount(interp, fileNameObj);
9160 return JIM_ERR;
9163 /* Now create the expression bytecode from the tokenlist */
9164 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9166 /* No longer need the token list */
9167 ScriptTokenListFree(&tokenlist);
9169 if (!expr) {
9170 goto err;
9173 #ifdef DEBUG_SHOW_EXPR
9175 int i;
9177 printf("==== Expr ====\n");
9178 for (i = 0; i < expr->len; i++) {
9179 ScriptToken *t = &expr->token[i];
9181 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9184 #endif
9186 /* Check program correctness. */
9187 if (ExprCheckCorrectness(expr) != JIM_OK) {
9188 ExprFreeByteCode(interp, expr);
9189 goto invalidexpr;
9192 rc = JIM_OK;
9194 err:
9195 /* Free the old internal rep and set the new one. */
9196 Jim_DecrRefCount(interp, fileNameObj);
9197 Jim_FreeIntRep(interp, objPtr);
9198 Jim_SetIntRepPtr(objPtr, expr);
9199 objPtr->typePtr = &exprObjType;
9200 return rc;
9203 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9205 if (objPtr->typePtr != &exprObjType) {
9206 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9207 return NULL;
9210 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9213 #ifdef JIM_OPTIMIZATION
9214 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9216 if (token->type == JIM_TT_EXPR_INT)
9217 return token->objPtr;
9218 else if (token->type == JIM_TT_VAR)
9219 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9220 else if (token->type == JIM_TT_DICTSUGAR)
9221 return JimExpandDictSugar(interp, token->objPtr);
9222 else
9223 return NULL;
9225 #endif
9227 /* -----------------------------------------------------------------------------
9228 * Expressions evaluation.
9229 * Jim uses a specialized stack-based virtual machine for expressions,
9230 * that takes advantage of the fact that expr's operators
9231 * can't be redefined.
9233 * Jim_EvalExpression() uses the bytecode compiled by
9234 * SetExprFromAny() method of the "expression" object.
9236 * On success a Tcl Object containing the result of the evaluation
9237 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9238 * returned.
9239 * On error the function returns a retcode != to JIM_OK and set a suitable
9240 * error on the interp.
9241 * ---------------------------------------------------------------------------*/
9242 #define JIM_EE_STATICSTACK_LEN 10
9244 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9246 ExprByteCode *expr;
9247 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9248 int i;
9249 int retcode = JIM_OK;
9250 struct JimExprState e;
9252 expr = JimGetExpression(interp, exprObjPtr);
9253 if (!expr) {
9254 return JIM_ERR; /* error in expression. */
9257 #ifdef JIM_OPTIMIZATION
9258 /* Check for one of the following common expressions used by while/for
9260 * CONST
9261 * $a
9262 * !$a
9263 * $a < CONST, $a < $b
9264 * $a <= CONST, $a <= $b
9265 * $a > CONST, $a > $b
9266 * $a >= CONST, $a >= $b
9267 * $a != CONST, $a != $b
9268 * $a == CONST, $a == $b
9271 Jim_Obj *objPtr;
9273 /* STEP 1 -- Check if there are the conditions to run the specialized
9274 * version of while */
9276 switch (expr->len) {
9277 case 1:
9278 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9279 if (objPtr) {
9280 Jim_IncrRefCount(objPtr);
9281 *exprResultPtrPtr = objPtr;
9282 return JIM_OK;
9284 break;
9286 case 2:
9287 if (expr->token[1].type == JIM_EXPROP_NOT) {
9288 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9290 if (objPtr && JimIsWide(objPtr)) {
9291 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9292 Jim_IncrRefCount(*exprResultPtrPtr);
9293 return JIM_OK;
9296 break;
9298 case 3:
9299 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9300 if (objPtr && JimIsWide(objPtr)) {
9301 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9302 if (objPtr2 && JimIsWide(objPtr2)) {
9303 jim_wide wideValueA = JimWideValue(objPtr);
9304 jim_wide wideValueB = JimWideValue(objPtr2);
9305 int cmpRes;
9306 switch (expr->token[2].type) {
9307 case JIM_EXPROP_LT:
9308 cmpRes = wideValueA < wideValueB;
9309 break;
9310 case JIM_EXPROP_LTE:
9311 cmpRes = wideValueA <= wideValueB;
9312 break;
9313 case JIM_EXPROP_GT:
9314 cmpRes = wideValueA > wideValueB;
9315 break;
9316 case JIM_EXPROP_GTE:
9317 cmpRes = wideValueA >= wideValueB;
9318 break;
9319 case JIM_EXPROP_NUMEQ:
9320 cmpRes = wideValueA == wideValueB;
9321 break;
9322 case JIM_EXPROP_NUMNE:
9323 cmpRes = wideValueA != wideValueB;
9324 break;
9325 default:
9326 goto noopt;
9328 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9329 Jim_IncrRefCount(*exprResultPtrPtr);
9330 return JIM_OK;
9333 break;
9336 noopt:
9337 #endif
9339 /* In order to avoid that the internal repr gets freed due to
9340 * shimmering of the exprObjPtr's object, we make the internal rep
9341 * shared. */
9342 expr->inUse++;
9344 /* The stack-based expr VM itself */
9346 /* Stack allocation. Expr programs have the feature that
9347 * a program of length N can't require a stack longer than
9348 * N. */
9349 if (expr->len > JIM_EE_STATICSTACK_LEN)
9350 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9351 else
9352 e.stack = staticStack;
9354 e.stacklen = 0;
9356 /* Execute every instruction */
9357 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9358 Jim_Obj *objPtr;
9360 switch (expr->token[i].type) {
9361 case JIM_TT_EXPR_INT:
9362 case JIM_TT_EXPR_DOUBLE:
9363 case JIM_TT_STR:
9364 ExprPush(&e, expr->token[i].objPtr);
9365 break;
9367 case JIM_TT_VAR:
9368 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9369 if (objPtr) {
9370 ExprPush(&e, objPtr);
9372 else {
9373 retcode = JIM_ERR;
9375 break;
9377 case JIM_TT_DICTSUGAR:
9378 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9379 if (objPtr) {
9380 ExprPush(&e, objPtr);
9382 else {
9383 retcode = JIM_ERR;
9385 break;
9387 case JIM_TT_ESC:
9388 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9389 if (retcode == JIM_OK) {
9390 ExprPush(&e, objPtr);
9392 break;
9394 case JIM_TT_CMD:
9395 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9396 if (retcode == JIM_OK) {
9397 ExprPush(&e, Jim_GetResult(interp));
9399 break;
9401 default:{
9402 /* Find and execute the operation */
9403 e.skip = 0;
9404 e.opcode = expr->token[i].type;
9406 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9407 /* Skip some opcodes if necessary */
9408 i += e.skip;
9409 continue;
9414 expr->inUse--;
9416 if (retcode == JIM_OK) {
9417 *exprResultPtrPtr = ExprPop(&e);
9419 else {
9420 for (i = 0; i < e.stacklen; i++) {
9421 Jim_DecrRefCount(interp, e.stack[i]);
9424 if (e.stack != staticStack) {
9425 Jim_Free(e.stack);
9427 return retcode;
9430 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9432 int retcode;
9433 jim_wide wideValue;
9434 double doubleValue;
9435 Jim_Obj *exprResultPtr;
9437 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9438 if (retcode != JIM_OK)
9439 return retcode;
9441 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9442 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9443 Jim_DecrRefCount(interp, exprResultPtr);
9444 return JIM_ERR;
9446 else {
9447 Jim_DecrRefCount(interp, exprResultPtr);
9448 *boolPtr = doubleValue != 0;
9449 return JIM_OK;
9452 *boolPtr = wideValue != 0;
9454 Jim_DecrRefCount(interp, exprResultPtr);
9455 return JIM_OK;
9458 /* -----------------------------------------------------------------------------
9459 * ScanFormat String Object
9460 * ---------------------------------------------------------------------------*/
9462 /* This Jim_Obj will held a parsed representation of a format string passed to
9463 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9464 * to be parsed in its entirely first and then, if correct, can be used for
9465 * scanning. To avoid endless re-parsing, the parsed representation will be
9466 * stored in an internal representation and re-used for performance reason. */
9468 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9469 * scanformat string. This part will later be used to extract information
9470 * out from the string to be parsed by Jim_ScanString */
9472 typedef struct ScanFmtPartDescr
9474 char *arg; /* Specification of a CHARSET conversion */
9475 char *prefix; /* Prefix to be scanned literally before conversion */
9476 size_t width; /* Maximal width of input to be converted */
9477 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9478 char type; /* Type of conversion (e.g. c, d, f) */
9479 char modifier; /* Modify type (e.g. l - long, h - short */
9480 } ScanFmtPartDescr;
9482 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9483 * string parsed and separated in part descriptions. Furthermore it contains
9484 * the original string representation of the scanformat string to allow for
9485 * fast update of the Jim_Obj's string representation part.
9487 * As an add-on the internal object representation adds some scratch pad area
9488 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9489 * memory for purpose of string scanning.
9491 * The error member points to a static allocated string in case of a mal-
9492 * formed scanformat string or it contains '0' (NULL) in case of a valid
9493 * parse representation.
9495 * The whole memory of the internal representation is allocated as a single
9496 * area of memory that will be internally separated. So freeing and duplicating
9497 * of such an object is cheap */
9499 typedef struct ScanFmtStringObj
9501 jim_wide size; /* Size of internal repr in bytes */
9502 char *stringRep; /* Original string representation */
9503 size_t count; /* Number of ScanFmtPartDescr contained */
9504 size_t convCount; /* Number of conversions that will assign */
9505 size_t maxPos; /* Max position index if XPG3 is used */
9506 const char *error; /* Ptr to error text (NULL if no error */
9507 char *scratch; /* Some scratch pad used by Jim_ScanString */
9508 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9509 } ScanFmtStringObj;
9512 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9513 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9514 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9516 static const Jim_ObjType scanFmtStringObjType = {
9517 "scanformatstring",
9518 FreeScanFmtInternalRep,
9519 DupScanFmtInternalRep,
9520 UpdateStringOfScanFmt,
9521 JIM_TYPE_NONE,
9524 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9526 JIM_NOTUSED(interp);
9527 Jim_Free((char *)objPtr->internalRep.ptr);
9528 objPtr->internalRep.ptr = 0;
9531 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9533 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9534 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9536 JIM_NOTUSED(interp);
9537 memcpy(newVec, srcPtr->internalRep.ptr, size);
9538 dupPtr->internalRep.ptr = newVec;
9539 dupPtr->typePtr = &scanFmtStringObjType;
9542 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9544 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9547 /* SetScanFmtFromAny will parse a given string and create the internal
9548 * representation of the format specification. In case of an error
9549 * the error data member of the internal representation will be set
9550 * to an descriptive error text and the function will be left with
9551 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9552 * specification */
9554 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9556 ScanFmtStringObj *fmtObj;
9557 char *buffer;
9558 int maxCount, i, approxSize, lastPos = -1;
9559 const char *fmt = objPtr->bytes;
9560 int maxFmtLen = objPtr->length;
9561 const char *fmtEnd = fmt + maxFmtLen;
9562 int curr;
9564 Jim_FreeIntRep(interp, objPtr);
9565 /* Count how many conversions could take place maximally */
9566 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9567 if (fmt[i] == '%')
9568 ++maxCount;
9569 /* Calculate an approximation of the memory necessary */
9570 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9571 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9572 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9573 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9574 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9575 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9576 +1; /* safety byte */
9577 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9578 memset(fmtObj, 0, approxSize);
9579 fmtObj->size = approxSize;
9580 fmtObj->maxPos = 0;
9581 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9582 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9583 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9584 buffer = fmtObj->stringRep + maxFmtLen + 1;
9585 objPtr->internalRep.ptr = fmtObj;
9586 objPtr->typePtr = &scanFmtStringObjType;
9587 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9588 int width = 0, skip;
9589 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9591 fmtObj->count++;
9592 descr->width = 0; /* Assume width unspecified */
9593 /* Overread and store any "literal" prefix */
9594 if (*fmt != '%' || fmt[1] == '%') {
9595 descr->type = 0;
9596 descr->prefix = &buffer[i];
9597 for (; fmt < fmtEnd; ++fmt) {
9598 if (*fmt == '%') {
9599 if (fmt[1] != '%')
9600 break;
9601 ++fmt;
9603 buffer[i++] = *fmt;
9605 buffer[i++] = 0;
9607 /* Skip the conversion introducing '%' sign */
9608 ++fmt;
9609 /* End reached due to non-conversion literal only? */
9610 if (fmt >= fmtEnd)
9611 goto done;
9612 descr->pos = 0; /* Assume "natural" positioning */
9613 if (*fmt == '*') {
9614 descr->pos = -1; /* Okay, conversion will not be assigned */
9615 ++fmt;
9617 else
9618 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9619 /* Check if next token is a number (could be width or pos */
9620 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9621 fmt += skip;
9622 /* Was the number a XPG3 position specifier? */
9623 if (descr->pos != -1 && *fmt == '$') {
9624 int prev;
9626 ++fmt;
9627 descr->pos = width;
9628 width = 0;
9629 /* Look if "natural" postioning and XPG3 one was mixed */
9630 if ((lastPos == 0 && descr->pos > 0)
9631 || (lastPos > 0 && descr->pos == 0)) {
9632 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9633 return JIM_ERR;
9635 /* Look if this position was already used */
9636 for (prev = 0; prev < curr; ++prev) {
9637 if (fmtObj->descr[prev].pos == -1)
9638 continue;
9639 if (fmtObj->descr[prev].pos == descr->pos) {
9640 fmtObj->error =
9641 "variable is assigned by multiple \"%n$\" conversion specifiers";
9642 return JIM_ERR;
9645 /* Try to find a width after the XPG3 specifier */
9646 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9647 descr->width = width;
9648 fmt += skip;
9650 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9651 fmtObj->maxPos = descr->pos;
9653 else {
9654 /* Number was not a XPG3, so it has to be a width */
9655 descr->width = width;
9658 /* If positioning mode was undetermined yet, fix this */
9659 if (lastPos == -1)
9660 lastPos = descr->pos;
9661 /* Handle CHARSET conversion type ... */
9662 if (*fmt == '[') {
9663 int swapped = 1, beg = i, end, j;
9665 descr->type = '[';
9666 descr->arg = &buffer[i];
9667 ++fmt;
9668 if (*fmt == '^')
9669 buffer[i++] = *fmt++;
9670 if (*fmt == ']')
9671 buffer[i++] = *fmt++;
9672 while (*fmt && *fmt != ']')
9673 buffer[i++] = *fmt++;
9674 if (*fmt != ']') {
9675 fmtObj->error = "unmatched [ in format string";
9676 return JIM_ERR;
9678 end = i;
9679 buffer[i++] = 0;
9680 /* In case a range fence was given "backwards", swap it */
9681 while (swapped) {
9682 swapped = 0;
9683 for (j = beg + 1; j < end - 1; ++j) {
9684 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9685 char tmp = buffer[j - 1];
9687 buffer[j - 1] = buffer[j + 1];
9688 buffer[j + 1] = tmp;
9689 swapped = 1;
9694 else {
9695 /* Remember any valid modifier if given */
9696 if (strchr("hlL", *fmt) != 0)
9697 descr->modifier = tolower((int)*fmt++);
9699 descr->type = *fmt;
9700 if (strchr("efgcsndoxui", *fmt) == 0) {
9701 fmtObj->error = "bad scan conversion character";
9702 return JIM_ERR;
9704 else if (*fmt == 'c' && descr->width != 0) {
9705 fmtObj->error = "field width may not be specified in %c " "conversion";
9706 return JIM_ERR;
9708 else if (*fmt == 'u' && descr->modifier == 'l') {
9709 fmtObj->error = "unsigned wide not supported";
9710 return JIM_ERR;
9713 curr++;
9715 done:
9716 return JIM_OK;
9719 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9721 #define FormatGetCnvCount(_fo_) \
9722 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9723 #define FormatGetMaxPos(_fo_) \
9724 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9725 #define FormatGetError(_fo_) \
9726 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9728 /* JimScanAString is used to scan an unspecified string that ends with
9729 * next WS, or a string that is specified via a charset.
9732 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9734 char *buffer = Jim_StrDup(str);
9735 char *p = buffer;
9737 while (*str) {
9738 int c;
9739 int n;
9741 if (!sdescr && isspace(UCHAR(*str)))
9742 break; /* EOS via WS if unspecified */
9744 n = utf8_tounicode(str, &c);
9745 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9746 break;
9747 while (n--)
9748 *p++ = *str++;
9750 *p = 0;
9751 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9754 /* ScanOneEntry will scan one entry out of the string passed as argument.
9755 * It use the sscanf() function for this task. After extracting and
9756 * converting of the value, the count of scanned characters will be
9757 * returned of -1 in case of no conversion tool place and string was
9758 * already scanned thru */
9760 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9761 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9763 const char *tok;
9764 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9765 size_t scanned = 0;
9766 size_t anchor = pos;
9767 int i;
9768 Jim_Obj *tmpObj = NULL;
9770 /* First pessimistically assume, we will not scan anything :-) */
9771 *valObjPtr = 0;
9772 if (descr->prefix) {
9773 /* There was a prefix given before the conversion, skip it and adjust
9774 * the string-to-be-parsed accordingly */
9775 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9776 /* If prefix require, skip WS */
9777 if (isspace(UCHAR(descr->prefix[i])))
9778 while (pos < strLen && isspace(UCHAR(str[pos])))
9779 ++pos;
9780 else if (descr->prefix[i] != str[pos])
9781 break; /* Prefix do not match here, leave the loop */
9782 else
9783 ++pos; /* Prefix matched so far, next round */
9785 if (pos >= strLen) {
9786 return -1; /* All of str consumed: EOF condition */
9788 else if (descr->prefix[i] != 0)
9789 return 0; /* Not whole prefix consumed, no conversion possible */
9791 /* For all but following conversion, skip leading WS */
9792 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9793 while (isspace(UCHAR(str[pos])))
9794 ++pos;
9795 /* Determine how much skipped/scanned so far */
9796 scanned = pos - anchor;
9798 /* %c is a special, simple case. no width */
9799 if (descr->type == 'n') {
9800 /* Return pseudo conversion means: how much scanned so far? */
9801 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9803 else if (pos >= strLen) {
9804 /* Cannot scan anything, as str is totally consumed */
9805 return -1;
9807 else if (descr->type == 'c') {
9808 int c;
9809 scanned += utf8_tounicode(&str[pos], &c);
9810 *valObjPtr = Jim_NewIntObj(interp, c);
9811 return scanned;
9813 else {
9814 /* Processing of conversions follows ... */
9815 if (descr->width > 0) {
9816 /* Do not try to scan as fas as possible but only the given width.
9817 * To ensure this, we copy the part that should be scanned. */
9818 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9819 size_t tLen = descr->width > sLen ? sLen : descr->width;
9821 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9822 tok = tmpObj->bytes;
9824 else {
9825 /* As no width was given, simply refer to the original string */
9826 tok = &str[pos];
9828 switch (descr->type) {
9829 case 'd':
9830 case 'o':
9831 case 'x':
9832 case 'u':
9833 case 'i':{
9834 char *endp; /* Position where the number finished */
9835 jim_wide w;
9837 int base = descr->type == 'o' ? 8
9838 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9840 /* Try to scan a number with the given base */
9841 if (base == 0) {
9842 w = jim_strtoull(tok, &endp);
9844 else {
9845 w = strtoull(tok, &endp, base);
9848 if (endp != tok) {
9849 /* There was some number sucessfully scanned! */
9850 *valObjPtr = Jim_NewIntObj(interp, w);
9852 /* Adjust the number-of-chars scanned so far */
9853 scanned += endp - tok;
9855 else {
9856 /* Nothing was scanned. We have to determine if this
9857 * happened due to e.g. prefix mismatch or input str
9858 * exhausted */
9859 scanned = *tok ? 0 : -1;
9861 break;
9863 case 's':
9864 case '[':{
9865 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9866 scanned += Jim_Length(*valObjPtr);
9867 break;
9869 case 'e':
9870 case 'f':
9871 case 'g':{
9872 char *endp;
9873 double value = strtod(tok, &endp);
9875 if (endp != tok) {
9876 /* There was some number sucessfully scanned! */
9877 *valObjPtr = Jim_NewDoubleObj(interp, value);
9878 /* Adjust the number-of-chars scanned so far */
9879 scanned += endp - tok;
9881 else {
9882 /* Nothing was scanned. We have to determine if this
9883 * happened due to e.g. prefix mismatch or input str
9884 * exhausted */
9885 scanned = *tok ? 0 : -1;
9887 break;
9890 /* If a substring was allocated (due to pre-defined width) do not
9891 * forget to free it */
9892 if (tmpObj) {
9893 Jim_FreeNewObj(interp, tmpObj);
9896 return scanned;
9899 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9900 * string and returns all converted (and not ignored) values in a list back
9901 * to the caller. If an error occured, a NULL pointer will be returned */
9903 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9905 size_t i, pos;
9906 int scanned = 1;
9907 const char *str = Jim_String(strObjPtr);
9908 int strLen = Jim_Utf8Length(interp, strObjPtr);
9909 Jim_Obj *resultList = 0;
9910 Jim_Obj **resultVec = 0;
9911 int resultc;
9912 Jim_Obj *emptyStr = 0;
9913 ScanFmtStringObj *fmtObj;
9915 /* This should never happen. The format object should already be of the correct type */
9916 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9918 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9919 /* Check if format specification was valid */
9920 if (fmtObj->error != 0) {
9921 if (flags & JIM_ERRMSG)
9922 Jim_SetResultString(interp, fmtObj->error, -1);
9923 return 0;
9925 /* Allocate a new "shared" empty string for all unassigned conversions */
9926 emptyStr = Jim_NewEmptyStringObj(interp);
9927 Jim_IncrRefCount(emptyStr);
9928 /* Create a list and fill it with empty strings up to max specified XPG3 */
9929 resultList = Jim_NewListObj(interp, NULL, 0);
9930 if (fmtObj->maxPos > 0) {
9931 for (i = 0; i < fmtObj->maxPos; ++i)
9932 Jim_ListAppendElement(interp, resultList, emptyStr);
9933 JimListGetElements(interp, resultList, &resultc, &resultVec);
9935 /* Now handle every partial format description */
9936 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9937 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9938 Jim_Obj *value = 0;
9940 /* Only last type may be "literal" w/o conversion - skip it! */
9941 if (descr->type == 0)
9942 continue;
9943 /* As long as any conversion could be done, we will proceed */
9944 if (scanned > 0)
9945 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9946 /* In case our first try results in EOF, we will leave */
9947 if (scanned == -1 && i == 0)
9948 goto eof;
9949 /* Advance next pos-to-be-scanned for the amount scanned already */
9950 pos += scanned;
9952 /* value == 0 means no conversion took place so take empty string */
9953 if (value == 0)
9954 value = Jim_NewEmptyStringObj(interp);
9955 /* If value is a non-assignable one, skip it */
9956 if (descr->pos == -1) {
9957 Jim_FreeNewObj(interp, value);
9959 else if (descr->pos == 0)
9960 /* Otherwise append it to the result list if no XPG3 was given */
9961 Jim_ListAppendElement(interp, resultList, value);
9962 else if (resultVec[descr->pos - 1] == emptyStr) {
9963 /* But due to given XPG3, put the value into the corr. slot */
9964 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9965 Jim_IncrRefCount(value);
9966 resultVec[descr->pos - 1] = value;
9968 else {
9969 /* Otherwise, the slot was already used - free obj and ERROR */
9970 Jim_FreeNewObj(interp, value);
9971 goto err;
9974 Jim_DecrRefCount(interp, emptyStr);
9975 return resultList;
9976 eof:
9977 Jim_DecrRefCount(interp, emptyStr);
9978 Jim_FreeNewObj(interp, resultList);
9979 return (Jim_Obj *)EOF;
9980 err:
9981 Jim_DecrRefCount(interp, emptyStr);
9982 Jim_FreeNewObj(interp, resultList);
9983 return 0;
9986 /* -----------------------------------------------------------------------------
9987 * Pseudo Random Number Generation
9988 * ---------------------------------------------------------------------------*/
9989 /* Initialize the sbox with the numbers from 0 to 255 */
9990 static void JimPrngInit(Jim_Interp *interp)
9992 #define PRNG_SEED_SIZE 256
9993 int i;
9994 unsigned int *seed;
9995 time_t t = time(NULL);
9997 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9999 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10000 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10001 seed[i] = (rand() ^ t ^ clock());
10003 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10004 Jim_Free(seed);
10007 /* Generates N bytes of random data */
10008 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10010 Jim_PrngState *prng;
10011 unsigned char *destByte = (unsigned char *)dest;
10012 unsigned int si, sj, x;
10014 /* initialization, only needed the first time */
10015 if (interp->prngState == NULL)
10016 JimPrngInit(interp);
10017 prng = interp->prngState;
10018 /* generates 'len' bytes of pseudo-random numbers */
10019 for (x = 0; x < len; x++) {
10020 prng->i = (prng->i + 1) & 0xff;
10021 si = prng->sbox[prng->i];
10022 prng->j = (prng->j + si) & 0xff;
10023 sj = prng->sbox[prng->j];
10024 prng->sbox[prng->i] = sj;
10025 prng->sbox[prng->j] = si;
10026 *destByte++ = prng->sbox[(si + sj) & 0xff];
10030 /* Re-seed the generator with user-provided bytes */
10031 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10033 int i;
10034 Jim_PrngState *prng;
10036 /* initialization, only needed the first time */
10037 if (interp->prngState == NULL)
10038 JimPrngInit(interp);
10039 prng = interp->prngState;
10041 /* Set the sbox[i] with i */
10042 for (i = 0; i < 256; i++)
10043 prng->sbox[i] = i;
10044 /* Now use the seed to perform a random permutation of the sbox */
10045 for (i = 0; i < seedLen; i++) {
10046 unsigned char t;
10048 t = prng->sbox[i & 0xFF];
10049 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10050 prng->sbox[seed[i]] = t;
10052 prng->i = prng->j = 0;
10054 /* discard at least the first 256 bytes of stream.
10055 * borrow the seed buffer for this
10057 for (i = 0; i < 256; i += seedLen) {
10058 JimRandomBytes(interp, seed, seedLen);
10062 /* [incr] */
10063 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10065 jim_wide wideValue, increment = 1;
10066 Jim_Obj *intObjPtr;
10068 if (argc != 2 && argc != 3) {
10069 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10070 return JIM_ERR;
10072 if (argc == 3) {
10073 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10074 return JIM_ERR;
10076 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10077 if (!intObjPtr) {
10078 /* Set missing variable to 0 */
10079 wideValue = 0;
10081 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10082 return JIM_ERR;
10084 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10085 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10086 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10087 Jim_FreeNewObj(interp, intObjPtr);
10088 return JIM_ERR;
10091 else {
10092 /* Can do it the quick way */
10093 Jim_InvalidateStringRep(intObjPtr);
10094 JimWideValue(intObjPtr) = wideValue + increment;
10096 /* The following step is required in order to invalidate the
10097 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10098 if (argv[1]->typePtr != &variableObjType) {
10099 /* Note that this can't fail since GetVariable already succeeded */
10100 Jim_SetVariable(interp, argv[1], intObjPtr);
10103 Jim_SetResult(interp, intObjPtr);
10104 return JIM_OK;
10108 /* -----------------------------------------------------------------------------
10109 * Eval
10110 * ---------------------------------------------------------------------------*/
10111 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10112 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10114 /* Handle calls to the [unknown] command */
10115 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10117 int retcode;
10119 /* If JimUnknown() is recursively called too many times...
10120 * done here
10122 if (interp->unknown_called > 50) {
10123 return JIM_ERR;
10126 /* The object interp->unknown just contains
10127 * the "unknown" string, it is used in order to
10128 * avoid to lookup the unknown command every time
10129 * but instead to cache the result. */
10131 /* If the [unknown] command does not exist ... */
10132 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10133 return JIM_ERR;
10135 interp->unknown_called++;
10136 /* XXX: Are we losing fileNameObj and linenr? */
10137 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10138 interp->unknown_called--;
10140 return retcode;
10143 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10145 int retcode;
10146 Jim_Cmd *cmdPtr;
10148 #if 0
10149 printf("invoke");
10150 int j;
10151 for (j = 0; j < objc; j++) {
10152 printf(" '%s'", Jim_String(objv[j]));
10154 printf("\n");
10155 #endif
10157 if (interp->framePtr->tailcallCmd) {
10158 /* Special tailcall command was pre-resolved */
10159 cmdPtr = interp->framePtr->tailcallCmd;
10160 interp->framePtr->tailcallCmd = NULL;
10162 else {
10163 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10164 if (cmdPtr == NULL) {
10165 return JimUnknown(interp, objc, objv);
10167 JimIncrCmdRefCount(cmdPtr);
10170 if (interp->evalDepth == interp->maxEvalDepth) {
10171 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10172 retcode = JIM_ERR;
10173 goto out;
10175 interp->evalDepth++;
10177 /* Call it -- Make sure result is an empty object. */
10178 Jim_SetEmptyResult(interp);
10179 if (cmdPtr->isproc) {
10180 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10182 else {
10183 interp->cmdPrivData = cmdPtr->u.native.privData;
10184 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10186 interp->evalDepth--;
10188 out:
10189 JimDecrCmdRefCount(interp, cmdPtr);
10191 return retcode;
10194 /* Eval the object vector 'objv' composed of 'objc' elements.
10195 * Every element is used as single argument.
10196 * Jim_EvalObj() will call this function every time its object
10197 * argument is of "list" type, with no string representation.
10199 * This is possible because the string representation of a
10200 * list object generated by the UpdateStringOfList is made
10201 * in a way that ensures that every list element is a different
10202 * command argument. */
10203 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10205 int i, retcode;
10207 /* Incr refcount of arguments. */
10208 for (i = 0; i < objc; i++)
10209 Jim_IncrRefCount(objv[i]);
10211 retcode = JimInvokeCommand(interp, objc, objv);
10213 /* Decr refcount of arguments and return the retcode */
10214 for (i = 0; i < objc; i++)
10215 Jim_DecrRefCount(interp, objv[i]);
10217 return retcode;
10221 * Invokes 'prefix' as a command with the objv array as arguments.
10223 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10225 int ret;
10226 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10228 nargv[0] = prefix;
10229 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10230 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10231 Jim_Free(nargv);
10232 return ret;
10235 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10237 int rc = retcode;
10239 if (rc == JIM_ERR && !interp->errorFlag) {
10240 /* This is the first error, so save the file/line information and reset the stack */
10241 interp->errorFlag = 1;
10242 Jim_IncrRefCount(script->fileNameObj);
10243 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10244 interp->errorFileNameObj = script->fileNameObj;
10245 interp->errorLine = script->linenr;
10247 JimResetStackTrace(interp);
10248 /* Always add a level where the error first occurs */
10249 interp->addStackTrace++;
10252 /* Now if this is an "interesting" level, add it to the stack trace */
10253 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10254 /* Add the stack info for the current level */
10256 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10258 /* Note: if we didn't have a filename for this level,
10259 * don't clear the addStackTrace flag
10260 * so we can pick it up at the next level
10262 if (Jim_Length(script->fileNameObj)) {
10263 interp->addStackTrace = 0;
10266 Jim_DecrRefCount(interp, interp->errorProc);
10267 interp->errorProc = interp->emptyObj;
10268 Jim_IncrRefCount(interp->errorProc);
10270 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10271 /* Propagate the addStackTrace value through 'return -code error' */
10273 else {
10274 interp->addStackTrace = 0;
10278 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10280 Jim_Obj *objPtr;
10282 switch (token->type) {
10283 case JIM_TT_STR:
10284 case JIM_TT_ESC:
10285 objPtr = token->objPtr;
10286 break;
10287 case JIM_TT_VAR:
10288 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10289 break;
10290 case JIM_TT_DICTSUGAR:
10291 objPtr = JimExpandDictSugar(interp, token->objPtr);
10292 break;
10293 case JIM_TT_EXPRSUGAR:
10294 objPtr = JimExpandExprSugar(interp, token->objPtr);
10295 break;
10296 case JIM_TT_CMD:
10297 switch (Jim_EvalObj(interp, token->objPtr)) {
10298 case JIM_OK:
10299 case JIM_RETURN:
10300 objPtr = interp->result;
10301 break;
10302 case JIM_BREAK:
10303 /* Stop substituting */
10304 return JIM_BREAK;
10305 case JIM_CONTINUE:
10306 /* just skip this one */
10307 return JIM_CONTINUE;
10308 default:
10309 return JIM_ERR;
10311 break;
10312 default:
10313 JimPanic((1,
10314 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10315 objPtr = NULL;
10316 break;
10318 if (objPtr) {
10319 *objPtrPtr = objPtr;
10320 return JIM_OK;
10322 return JIM_ERR;
10325 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10326 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10327 * The returned object has refcount = 0.
10329 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10331 int totlen = 0, i;
10332 Jim_Obj **intv;
10333 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10334 Jim_Obj *objPtr;
10335 char *s;
10337 if (tokens <= JIM_EVAL_SINTV_LEN)
10338 intv = sintv;
10339 else
10340 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10342 /* Compute every token forming the argument
10343 * in the intv objects vector. */
10344 for (i = 0; i < tokens; i++) {
10345 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10346 case JIM_OK:
10347 case JIM_RETURN:
10348 break;
10349 case JIM_BREAK:
10350 if (flags & JIM_SUBST_FLAG) {
10351 /* Stop here */
10352 tokens = i;
10353 continue;
10355 /* XXX: Should probably set an error about break outside loop */
10356 /* fall through to error */
10357 case JIM_CONTINUE:
10358 if (flags & JIM_SUBST_FLAG) {
10359 intv[i] = NULL;
10360 continue;
10362 /* XXX: Ditto continue outside loop */
10363 /* fall through to error */
10364 default:
10365 while (i--) {
10366 Jim_DecrRefCount(interp, intv[i]);
10368 if (intv != sintv) {
10369 Jim_Free(intv);
10371 return NULL;
10373 Jim_IncrRefCount(intv[i]);
10374 Jim_String(intv[i]);
10375 totlen += intv[i]->length;
10378 /* Fast path return for a single token */
10379 if (tokens == 1 && intv[0] && intv == sintv) {
10380 Jim_DecrRefCount(interp, intv[0]);
10381 return intv[0];
10384 /* Concatenate every token in an unique
10385 * object. */
10386 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10388 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10389 && token[2].type == JIM_TT_VAR) {
10390 /* May be able to do fast interpolated object -> dictSubst */
10391 objPtr->typePtr = &interpolatedObjType;
10392 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10393 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10394 Jim_IncrRefCount(intv[2]);
10396 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10397 /* The first interpolated token is source, so preserve the source info */
10398 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10402 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10403 objPtr->length = totlen;
10404 for (i = 0; i < tokens; i++) {
10405 if (intv[i]) {
10406 memcpy(s, intv[i]->bytes, intv[i]->length);
10407 s += intv[i]->length;
10408 Jim_DecrRefCount(interp, intv[i]);
10411 objPtr->bytes[totlen] = '\0';
10412 /* Free the intv vector if not static. */
10413 if (intv != sintv) {
10414 Jim_Free(intv);
10417 return objPtr;
10421 /* listPtr *must* be a list.
10422 * The contents of the list is evaluated with the first element as the command and
10423 * the remaining elements as the arguments.
10425 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10427 int retcode = JIM_OK;
10429 if (listPtr->internalRep.listValue.len) {
10430 Jim_IncrRefCount(listPtr);
10431 retcode = JimInvokeCommand(interp,
10432 listPtr->internalRep.listValue.len,
10433 listPtr->internalRep.listValue.ele);
10434 Jim_DecrRefCount(interp, listPtr);
10436 return retcode;
10439 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10441 SetListFromAny(interp, listPtr);
10442 return JimEvalObjList(interp, listPtr);
10445 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10447 int i;
10448 ScriptObj *script;
10449 ScriptToken *token;
10450 int retcode = JIM_OK;
10451 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10452 Jim_Obj *prevScriptObj;
10454 /* If the object is of type "list", with no string rep we can call
10455 * a specialized version of Jim_EvalObj() */
10456 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10457 return JimEvalObjList(interp, scriptObjPtr);
10460 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10461 script = Jim_GetScript(interp, scriptObjPtr);
10462 if (script == NULL) {
10463 Jim_DecrRefCount(interp, scriptObjPtr);
10464 return JIM_ERR;
10467 /* Reset the interpreter result. This is useful to
10468 * return the empty result in the case of empty program. */
10469 Jim_SetEmptyResult(interp);
10471 token = script->token;
10473 #ifdef JIM_OPTIMIZATION
10474 /* Check for one of the following common scripts used by for, while
10476 * {}
10477 * incr a
10479 if (script->len == 0) {
10480 Jim_DecrRefCount(interp, scriptObjPtr);
10481 return JIM_OK;
10483 if (script->len == 3
10484 && token[1].objPtr->typePtr == &commandObjType
10485 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10486 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10487 && token[2].objPtr->typePtr == &variableObjType) {
10489 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10491 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10492 JimWideValue(objPtr)++;
10493 Jim_InvalidateStringRep(objPtr);
10494 Jim_DecrRefCount(interp, scriptObjPtr);
10495 Jim_SetResult(interp, objPtr);
10496 return JIM_OK;
10499 #endif
10501 /* Now we have to make sure the internal repr will not be
10502 * freed on shimmering.
10504 * Think for example to this:
10506 * set x {llength $x; ... some more code ...}; eval $x
10508 * In order to preserve the internal rep, we increment the
10509 * inUse field of the script internal rep structure. */
10510 script->inUse++;
10512 /* Stash the current script */
10513 prevScriptObj = interp->currentScriptObj;
10514 interp->currentScriptObj = scriptObjPtr;
10516 interp->errorFlag = 0;
10517 argv = sargv;
10519 /* Execute every command sequentially until the end of the script
10520 * or an error occurs.
10522 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10523 int argc;
10524 int j;
10526 /* First token of the line is always JIM_TT_LINE */
10527 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10528 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10530 /* Allocate the arguments vector if required */
10531 if (argc > JIM_EVAL_SARGV_LEN)
10532 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10534 /* Skip the JIM_TT_LINE token */
10535 i++;
10537 /* Populate the arguments objects.
10538 * If an error occurs, retcode will be set and
10539 * 'j' will be set to the number of args expanded
10541 for (j = 0; j < argc; j++) {
10542 long wordtokens = 1;
10543 int expand = 0;
10544 Jim_Obj *wordObjPtr = NULL;
10546 if (token[i].type == JIM_TT_WORD) {
10547 wordtokens = JimWideValue(token[i++].objPtr);
10548 if (wordtokens < 0) {
10549 expand = 1;
10550 wordtokens = -wordtokens;
10554 if (wordtokens == 1) {
10555 /* Fast path if the token does not
10556 * need interpolation */
10558 switch (token[i].type) {
10559 case JIM_TT_ESC:
10560 case JIM_TT_STR:
10561 wordObjPtr = token[i].objPtr;
10562 break;
10563 case JIM_TT_VAR:
10564 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10565 break;
10566 case JIM_TT_EXPRSUGAR:
10567 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10568 break;
10569 case JIM_TT_DICTSUGAR:
10570 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10571 break;
10572 case JIM_TT_CMD:
10573 retcode = Jim_EvalObj(interp, token[i].objPtr);
10574 if (retcode == JIM_OK) {
10575 wordObjPtr = Jim_GetResult(interp);
10577 break;
10578 default:
10579 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10582 else {
10583 /* For interpolation we call a helper
10584 * function to do the work for us. */
10585 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10588 if (!wordObjPtr) {
10589 if (retcode == JIM_OK) {
10590 retcode = JIM_ERR;
10592 break;
10595 Jim_IncrRefCount(wordObjPtr);
10596 i += wordtokens;
10598 if (!expand) {
10599 argv[j] = wordObjPtr;
10601 else {
10602 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10603 int len = Jim_ListLength(interp, wordObjPtr);
10604 int newargc = argc + len - 1;
10605 int k;
10607 if (len > 1) {
10608 if (argv == sargv) {
10609 if (newargc > JIM_EVAL_SARGV_LEN) {
10610 argv = Jim_Alloc(sizeof(*argv) * newargc);
10611 memcpy(argv, sargv, sizeof(*argv) * j);
10614 else {
10615 /* Need to realloc to make room for (len - 1) more entries */
10616 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10620 /* Now copy in the expanded version */
10621 for (k = 0; k < len; k++) {
10622 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10623 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10626 /* The original object reference is no longer needed,
10627 * after the expansion it is no longer present on
10628 * the argument vector, but the single elements are
10629 * in its place. */
10630 Jim_DecrRefCount(interp, wordObjPtr);
10632 /* And update the indexes */
10633 j--;
10634 argc += len - 1;
10638 if (retcode == JIM_OK && argc) {
10639 /* Invoke the command */
10640 retcode = JimInvokeCommand(interp, argc, argv);
10641 /* Check for a signal after each command */
10642 if (Jim_CheckSignal(interp)) {
10643 retcode = JIM_SIGNAL;
10647 /* Finished with the command, so decrement ref counts of each argument */
10648 while (j-- > 0) {
10649 Jim_DecrRefCount(interp, argv[j]);
10652 if (argv != sargv) {
10653 Jim_Free(argv);
10654 argv = sargv;
10658 /* Possibly add to the error stack trace */
10659 JimAddErrorToStack(interp, retcode, script);
10661 /* Restore the current script */
10662 interp->currentScriptObj = prevScriptObj;
10664 /* Note that we don't have to decrement inUse, because the
10665 * following code transfers our use of the reference again to
10666 * the script object. */
10667 Jim_FreeIntRep(interp, scriptObjPtr);
10668 scriptObjPtr->typePtr = &scriptObjType;
10669 Jim_SetIntRepPtr(scriptObjPtr, script);
10670 Jim_DecrRefCount(interp, scriptObjPtr);
10672 return retcode;
10675 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10677 int retcode;
10678 /* If argObjPtr begins with '&', do an automatic upvar */
10679 const char *varname = Jim_String(argNameObj);
10680 if (*varname == '&') {
10681 /* First check that the target variable exists */
10682 Jim_Obj *objPtr;
10683 Jim_CallFrame *savedCallFrame = interp->framePtr;
10685 interp->framePtr = interp->framePtr->parent;
10686 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10687 interp->framePtr = savedCallFrame;
10688 if (!objPtr) {
10689 return JIM_ERR;
10692 /* It exists, so perform the binding. */
10693 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10694 Jim_IncrRefCount(objPtr);
10695 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10696 Jim_DecrRefCount(interp, objPtr);
10698 else {
10699 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10701 return retcode;
10705 * Sets the interp result to be an error message indicating the required proc args.
10707 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10709 /* Create a nice error message, consistent with Tcl 8.5 */
10710 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10711 int i;
10713 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10714 Jim_AppendString(interp, argmsg, " ", 1);
10716 if (i == cmd->u.proc.argsPos) {
10717 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10718 /* Renamed args */
10719 Jim_AppendString(interp, argmsg, "?", 1);
10720 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10721 Jim_AppendString(interp, argmsg, " ...?", -1);
10723 else {
10724 /* We have plain args */
10725 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10728 else {
10729 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10730 Jim_AppendString(interp, argmsg, "?", 1);
10731 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10732 Jim_AppendString(interp, argmsg, "?", 1);
10734 else {
10735 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10736 if (*arg == '&') {
10737 arg++;
10739 Jim_AppendString(interp, argmsg, arg, -1);
10743 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10744 Jim_FreeNewObj(interp, argmsg);
10747 #ifdef jim_ext_namespace
10749 * [namespace eval]
10751 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10753 Jim_CallFrame *callFramePtr;
10754 int retcode;
10756 /* Create a new callframe */
10757 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10758 callFramePtr->argv = &interp->emptyObj;
10759 callFramePtr->argc = 0;
10760 callFramePtr->procArgsObjPtr = NULL;
10761 callFramePtr->procBodyObjPtr = scriptObj;
10762 callFramePtr->staticVars = NULL;
10763 callFramePtr->fileNameObj = interp->emptyObj;
10764 callFramePtr->line = 0;
10765 Jim_IncrRefCount(scriptObj);
10766 interp->framePtr = callFramePtr;
10768 /* Check if there are too nested calls */
10769 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10770 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10771 retcode = JIM_ERR;
10773 else {
10774 /* Eval the body */
10775 retcode = Jim_EvalObj(interp, scriptObj);
10778 /* Destroy the callframe */
10779 interp->framePtr = interp->framePtr->parent;
10780 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10782 return retcode;
10784 #endif
10786 /* Call a procedure implemented in Tcl.
10787 * It's possible to speed-up a lot this function, currently
10788 * the callframes are not cached, but allocated and
10789 * destroied every time. What is expecially costly is
10790 * to create/destroy the local vars hash table every time.
10792 * This can be fixed just implementing callframes caching
10793 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10794 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10796 Jim_CallFrame *callFramePtr;
10797 int i, d, retcode, optargs;
10798 ScriptObj *script;
10800 /* Check arity */
10801 if (argc - 1 < cmd->u.proc.reqArity ||
10802 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10803 JimSetProcWrongArgs(interp, argv[0], cmd);
10804 return JIM_ERR;
10807 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10808 /* Optimise for procedure with no body - useful for optional debugging */
10809 return JIM_OK;
10812 /* Check if there are too nested calls */
10813 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10814 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10815 return JIM_ERR;
10818 /* Create a new callframe */
10819 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10820 callFramePtr->argv = argv;
10821 callFramePtr->argc = argc;
10822 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10823 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10824 callFramePtr->staticVars = cmd->u.proc.staticVars;
10826 /* Remember where we were called from. */
10827 script = Jim_GetScript(interp, interp->currentScriptObj);
10828 callFramePtr->fileNameObj = script->fileNameObj;
10829 callFramePtr->line = script->linenr;
10831 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10832 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10833 interp->framePtr = callFramePtr;
10835 /* How many optional args are available */
10836 optargs = (argc - 1 - cmd->u.proc.reqArity);
10838 /* Step 'i' along the actual args, and step 'd' along the formal args */
10839 i = 1;
10840 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10841 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10842 if (d == cmd->u.proc.argsPos) {
10843 /* assign $args */
10844 Jim_Obj *listObjPtr;
10845 int argsLen = 0;
10846 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10847 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10849 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10851 /* It is possible to rename args. */
10852 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10853 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10855 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10856 if (retcode != JIM_OK) {
10857 goto badargset;
10860 i += argsLen;
10861 continue;
10864 /* Optional or required? */
10865 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10866 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10868 else {
10869 /* Ran out, so use the default */
10870 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10872 if (retcode != JIM_OK) {
10873 goto badargset;
10877 /* Eval the body */
10878 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10880 badargset:
10882 /* Free the callframe */
10883 interp->framePtr = interp->framePtr->parent;
10884 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10886 if (interp->framePtr->tailcallObj) {
10887 /* If a tailcall is already being executed, merge this tailcall with that one */
10888 if (interp->framePtr->tailcall++ == 0) {
10889 /* No current tailcall in this frame, so invoke the tailcall command */
10890 do {
10891 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10893 interp->framePtr->tailcallObj = NULL;
10895 if (retcode == JIM_EVAL) {
10896 retcode = Jim_EvalObjList(interp, tailcallObj);
10897 if (retcode == JIM_RETURN) {
10898 /* If the result of the tailcall is 'return', push
10899 * it up to the caller
10901 interp->returnLevel++;
10904 Jim_DecrRefCount(interp, tailcallObj);
10905 } while (interp->framePtr->tailcallObj);
10907 /* If the tailcall chain finished early, may need to manually discard the command */
10908 if (interp->framePtr->tailcallCmd) {
10909 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10910 interp->framePtr->tailcallCmd = NULL;
10913 interp->framePtr->tailcall--;
10916 /* Handle the JIM_RETURN return code */
10917 if (retcode == JIM_RETURN) {
10918 if (--interp->returnLevel <= 0) {
10919 retcode = interp->returnCode;
10920 interp->returnCode = JIM_OK;
10921 interp->returnLevel = 0;
10924 else if (retcode == JIM_ERR) {
10925 interp->addStackTrace++;
10926 Jim_DecrRefCount(interp, interp->errorProc);
10927 interp->errorProc = argv[0];
10928 Jim_IncrRefCount(interp->errorProc);
10931 return retcode;
10934 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10936 int retval;
10937 Jim_Obj *scriptObjPtr;
10939 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10940 Jim_IncrRefCount(scriptObjPtr);
10942 if (filename) {
10943 Jim_Obj *prevScriptObj;
10945 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10947 prevScriptObj = interp->currentScriptObj;
10948 interp->currentScriptObj = scriptObjPtr;
10950 retval = Jim_EvalObj(interp, scriptObjPtr);
10952 interp->currentScriptObj = prevScriptObj;
10954 else {
10955 retval = Jim_EvalObj(interp, scriptObjPtr);
10957 Jim_DecrRefCount(interp, scriptObjPtr);
10958 return retval;
10961 int Jim_Eval(Jim_Interp *interp, const char *script)
10963 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10966 /* Execute script in the scope of the global level */
10967 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10969 int retval;
10970 Jim_CallFrame *savedFramePtr = interp->framePtr;
10972 interp->framePtr = interp->topFramePtr;
10973 retval = Jim_Eval(interp, script);
10974 interp->framePtr = savedFramePtr;
10976 return retval;
10979 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10981 int retval;
10982 Jim_CallFrame *savedFramePtr = interp->framePtr;
10984 interp->framePtr = interp->topFramePtr;
10985 retval = Jim_EvalFile(interp, filename);
10986 interp->framePtr = savedFramePtr;
10988 return retval;
10991 #include <sys/stat.h>
10993 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10995 FILE *fp;
10996 char *buf;
10997 Jim_Obj *scriptObjPtr;
10998 Jim_Obj *prevScriptObj;
10999 struct stat sb;
11000 int retcode;
11001 int readlen;
11003 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11004 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11005 return JIM_ERR;
11007 if (sb.st_size == 0) {
11008 fclose(fp);
11009 return JIM_OK;
11012 buf = Jim_Alloc(sb.st_size + 1);
11013 readlen = fread(buf, 1, sb.st_size, fp);
11014 if (ferror(fp)) {
11015 fclose(fp);
11016 Jim_Free(buf);
11017 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11018 return JIM_ERR;
11020 fclose(fp);
11021 buf[readlen] = 0;
11023 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11024 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11025 Jim_IncrRefCount(scriptObjPtr);
11027 /* Now check the script for unmatched braces, etc. */
11028 if (Jim_GetScript(interp, scriptObjPtr) == NULL) {
11029 /* EvalFile changes context, so add a stack frame here */
11030 JimAddErrorToStack(interp, JIM_ERR, (ScriptObj *)Jim_GetIntRepPtr(scriptObjPtr));
11031 Jim_DecrRefCount(interp, scriptObjPtr);
11032 return JIM_ERR;
11035 prevScriptObj = interp->currentScriptObj;
11036 interp->currentScriptObj = scriptObjPtr;
11038 retcode = Jim_EvalObj(interp, scriptObjPtr);
11040 /* Handle the JIM_RETURN return code */
11041 if (retcode == JIM_RETURN) {
11042 if (--interp->returnLevel <= 0) {
11043 retcode = interp->returnCode;
11044 interp->returnCode = JIM_OK;
11045 interp->returnLevel = 0;
11048 if (retcode == JIM_ERR) {
11049 /* EvalFile changes context, so add a stack frame here */
11050 interp->addStackTrace++;
11053 interp->currentScriptObj = prevScriptObj;
11055 Jim_DecrRefCount(interp, scriptObjPtr);
11057 return retcode;
11060 /* -----------------------------------------------------------------------------
11061 * Subst
11062 * ---------------------------------------------------------------------------*/
11063 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11065 pc->tstart = pc->p;
11066 pc->tline = pc->linenr;
11068 if (pc->len == 0) {
11069 pc->tend = pc->p;
11070 pc->tt = JIM_TT_EOL;
11071 pc->eof = 1;
11072 return;
11074 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11075 JimParseCmd(pc);
11076 return;
11078 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11079 if (JimParseVar(pc) == JIM_OK) {
11080 return;
11082 /* Not a var, so treat as a string */
11083 pc->tstart = pc->p;
11084 flags |= JIM_SUBST_NOVAR;
11086 while (pc->len) {
11087 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11088 break;
11090 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11091 break;
11093 if (*pc->p == '\\' && pc->len > 1) {
11094 pc->p++;
11095 pc->len--;
11097 pc->p++;
11098 pc->len--;
11100 pc->tend = pc->p - 1;
11101 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11104 /* The subst object type reuses most of the data structures and functions
11105 * of the script object. Script's data structures are a bit more complex
11106 * for what is needed for [subst]itution tasks, but the reuse helps to
11107 * deal with a single data structure at the cost of some more memory
11108 * usage for substitutions. */
11110 /* This method takes the string representation of an object
11111 * as a Tcl string where to perform [subst]itution, and generates
11112 * the pre-parsed internal representation. */
11113 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11115 int scriptTextLen;
11116 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11117 struct JimParserCtx parser;
11118 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11119 ParseTokenList tokenlist;
11121 /* Initially parse the subst into tokens (in tokenlist) */
11122 ScriptTokenListInit(&tokenlist);
11124 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11125 while (1) {
11126 JimParseSubst(&parser, flags);
11127 if (parser.eof) {
11128 /* Note that subst doesn't need the EOL token */
11129 break;
11131 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11132 parser.tline);
11135 /* Create the "real" subst/script tokens from the initial token list */
11136 script->inUse = 1;
11137 script->substFlags = flags;
11138 script->fileNameObj = interp->emptyObj;
11139 Jim_IncrRefCount(script->fileNameObj);
11140 SubstObjAddTokens(interp, script, &tokenlist);
11142 /* No longer need the token list */
11143 ScriptTokenListFree(&tokenlist);
11145 #ifdef DEBUG_SHOW_SUBST
11147 int i;
11149 printf("==== Subst ====\n");
11150 for (i = 0; i < script->len; i++) {
11151 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11152 Jim_String(script->token[i].objPtr));
11155 #endif
11157 /* Free the old internal rep and set the new one. */
11158 Jim_FreeIntRep(interp, objPtr);
11159 Jim_SetIntRepPtr(objPtr, script);
11160 objPtr->typePtr = &scriptObjType;
11161 return JIM_OK;
11164 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11166 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11167 SetSubstFromAny(interp, objPtr, flags);
11168 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11171 /* Performs commands,variables,blackslashes substitution,
11172 * storing the result object (with refcount 0) into
11173 * resObjPtrPtr. */
11174 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11176 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11178 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11179 /* In order to preserve the internal rep, we increment the
11180 * inUse field of the script internal rep structure. */
11181 script->inUse++;
11183 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11185 script->inUse--;
11186 Jim_DecrRefCount(interp, substObjPtr);
11187 if (*resObjPtrPtr == NULL) {
11188 return JIM_ERR;
11190 return JIM_OK;
11193 /* -----------------------------------------------------------------------------
11194 * Core commands utility functions
11195 * ---------------------------------------------------------------------------*/
11196 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11198 Jim_Obj *objPtr;
11199 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11201 if (*msg) {
11202 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11204 Jim_IncrRefCount(listObjPtr);
11205 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11206 Jim_DecrRefCount(interp, listObjPtr);
11208 Jim_IncrRefCount(objPtr);
11209 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11210 Jim_DecrRefCount(interp, objPtr);
11214 * May add the key and/or value to the list.
11216 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11217 Jim_HashEntry *he, int type);
11219 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11222 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11223 * invoke the callback to add entries to a list.
11224 * Returns the list.
11226 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11227 JimHashtableIteratorCallbackType *callback, int type)
11229 Jim_HashEntry *he;
11230 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11232 /* Check for the non-pattern case. We can do this much more efficiently. */
11233 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11234 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11235 if (he) {
11236 callback(interp, listObjPtr, he, type);
11239 else {
11240 Jim_HashTableIterator htiter;
11241 JimInitHashTableIterator(ht, &htiter);
11242 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11243 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11244 callback(interp, listObjPtr, he, type);
11248 return listObjPtr;
11251 /* Keep these in order */
11252 #define JIM_CMDLIST_COMMANDS 0
11253 #define JIM_CMDLIST_PROCS 1
11254 #define JIM_CMDLIST_CHANNELS 2
11257 * Adds matching command names (procs, channels) to the list.
11259 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11260 Jim_HashEntry *he, int type)
11262 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11263 Jim_Obj *objPtr;
11265 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11266 /* not a proc */
11267 return;
11270 objPtr = Jim_NewStringObj(interp, he->key, -1);
11271 Jim_IncrRefCount(objPtr);
11273 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11274 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11276 Jim_DecrRefCount(interp, objPtr);
11279 /* type is JIM_CMDLIST_xxx */
11280 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11282 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11285 /* Keep these in order */
11286 #define JIM_VARLIST_GLOBALS 0
11287 #define JIM_VARLIST_LOCALS 1
11288 #define JIM_VARLIST_VARS 2
11290 #define JIM_VARLIST_VALUES 0x1000
11293 * Adds matching variable names to the list.
11295 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11296 Jim_HashEntry *he, int type)
11298 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11300 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11301 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11302 if (type & JIM_VARLIST_VALUES) {
11303 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11308 /* mode is JIM_VARLIST_xxx */
11309 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11311 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11312 /* For [info locals], if we are at top level an emtpy list
11313 * is returned. I don't agree, but we aim at compatibility (SS) */
11314 return interp->emptyObj;
11316 else {
11317 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11318 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11322 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11323 Jim_Obj **objPtrPtr, int info_level_cmd)
11325 Jim_CallFrame *targetCallFrame;
11327 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11328 if (targetCallFrame == NULL) {
11329 return JIM_ERR;
11331 /* No proc call at toplevel callframe */
11332 if (targetCallFrame == interp->topFramePtr) {
11333 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11334 return JIM_ERR;
11336 if (info_level_cmd) {
11337 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11339 else {
11340 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11342 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11343 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11344 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11345 *objPtrPtr = listObj;
11347 return JIM_OK;
11350 /* -----------------------------------------------------------------------------
11351 * Core commands
11352 * ---------------------------------------------------------------------------*/
11354 /* fake [puts] -- not the real puts, just for debugging. */
11355 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11357 if (argc != 2 && argc != 3) {
11358 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11359 return JIM_ERR;
11361 if (argc == 3) {
11362 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11363 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11364 return JIM_ERR;
11366 else {
11367 fputs(Jim_String(argv[2]), stdout);
11370 else {
11371 puts(Jim_String(argv[1]));
11373 return JIM_OK;
11376 /* Helper for [+] and [*] */
11377 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11379 jim_wide wideValue, res;
11380 double doubleValue, doubleRes;
11381 int i;
11383 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11385 for (i = 1; i < argc; i++) {
11386 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11387 goto trydouble;
11388 if (op == JIM_EXPROP_ADD)
11389 res += wideValue;
11390 else
11391 res *= wideValue;
11393 Jim_SetResultInt(interp, res);
11394 return JIM_OK;
11395 trydouble:
11396 doubleRes = (double)res;
11397 for (; i < argc; i++) {
11398 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11399 return JIM_ERR;
11400 if (op == JIM_EXPROP_ADD)
11401 doubleRes += doubleValue;
11402 else
11403 doubleRes *= doubleValue;
11405 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11406 return JIM_OK;
11409 /* Helper for [-] and [/] */
11410 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11412 jim_wide wideValue, res = 0;
11413 double doubleValue, doubleRes = 0;
11414 int i = 2;
11416 if (argc < 2) {
11417 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11418 return JIM_ERR;
11420 else if (argc == 2) {
11421 /* The arity = 2 case is different. For [- x] returns -x,
11422 * while [/ x] returns 1/x. */
11423 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11424 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11425 return JIM_ERR;
11427 else {
11428 if (op == JIM_EXPROP_SUB)
11429 doubleRes = -doubleValue;
11430 else
11431 doubleRes = 1.0 / doubleValue;
11432 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11433 return JIM_OK;
11436 if (op == JIM_EXPROP_SUB) {
11437 res = -wideValue;
11438 Jim_SetResultInt(interp, res);
11440 else {
11441 doubleRes = 1.0 / wideValue;
11442 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11444 return JIM_OK;
11446 else {
11447 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11448 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11449 != JIM_OK) {
11450 return JIM_ERR;
11452 else {
11453 goto trydouble;
11457 for (i = 2; i < argc; i++) {
11458 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11459 doubleRes = (double)res;
11460 goto trydouble;
11462 if (op == JIM_EXPROP_SUB)
11463 res -= wideValue;
11464 else
11465 res /= wideValue;
11467 Jim_SetResultInt(interp, res);
11468 return JIM_OK;
11469 trydouble:
11470 for (; i < argc; i++) {
11471 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11472 return JIM_ERR;
11473 if (op == JIM_EXPROP_SUB)
11474 doubleRes -= doubleValue;
11475 else
11476 doubleRes /= doubleValue;
11478 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11479 return JIM_OK;
11483 /* [+] */
11484 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11486 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11489 /* [*] */
11490 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11492 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11495 /* [-] */
11496 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11498 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11501 /* [/] */
11502 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11504 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11507 /* [set] */
11508 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11510 if (argc != 2 && argc != 3) {
11511 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11512 return JIM_ERR;
11514 if (argc == 2) {
11515 Jim_Obj *objPtr;
11517 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11518 if (!objPtr)
11519 return JIM_ERR;
11520 Jim_SetResult(interp, objPtr);
11521 return JIM_OK;
11523 /* argc == 3 case. */
11524 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11525 return JIM_ERR;
11526 Jim_SetResult(interp, argv[2]);
11527 return JIM_OK;
11530 /* [unset]
11532 * unset ?-nocomplain? ?--? ?varName ...?
11534 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11536 int i = 1;
11537 int complain = 1;
11539 while (i < argc) {
11540 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11541 i++;
11542 break;
11544 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11545 complain = 0;
11546 i++;
11547 continue;
11549 break;
11552 while (i < argc) {
11553 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11554 && complain) {
11555 return JIM_ERR;
11557 i++;
11559 return JIM_OK;
11562 /* [while] */
11563 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11565 if (argc != 3) {
11566 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11567 return JIM_ERR;
11570 /* The general purpose implementation of while starts here */
11571 while (1) {
11572 int boolean, retval;
11574 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11575 return retval;
11576 if (!boolean)
11577 break;
11579 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11580 switch (retval) {
11581 case JIM_BREAK:
11582 goto out;
11583 break;
11584 case JIM_CONTINUE:
11585 continue;
11586 break;
11587 default:
11588 return retval;
11592 out:
11593 Jim_SetEmptyResult(interp);
11594 return JIM_OK;
11597 /* [for] */
11598 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11600 int retval;
11601 int boolean = 1;
11602 Jim_Obj *varNamePtr = NULL;
11603 Jim_Obj *stopVarNamePtr = NULL;
11605 if (argc != 5) {
11606 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11607 return JIM_ERR;
11610 /* Do the initialisation */
11611 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11612 return retval;
11615 /* And do the first test now. Better for optimisation
11616 * if we can do next/test at the bottom of the loop
11618 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11620 /* Ready to do the body as follows:
11621 * while (1) {
11622 * body // check retcode
11623 * next // check retcode
11624 * test // check retcode/test bool
11628 #ifdef JIM_OPTIMIZATION
11629 /* Check if the for is on the form:
11630 * for ... {$i < CONST} {incr i}
11631 * for ... {$i < $j} {incr i}
11633 if (retval == JIM_OK && boolean) {
11634 ScriptObj *incrScript;
11635 ExprByteCode *expr;
11636 jim_wide stop, currentVal;
11637 Jim_Obj *objPtr;
11638 int cmpOffset;
11640 /* Do it only if there aren't shared arguments */
11641 expr = JimGetExpression(interp, argv[2]);
11642 incrScript = Jim_GetScript(interp, argv[3]);
11644 /* Ensure proper lengths to start */
11645 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11646 goto evalstart;
11648 /* Ensure proper token types. */
11649 if (incrScript->token[1].type != JIM_TT_ESC ||
11650 expr->token[0].type != JIM_TT_VAR ||
11651 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11652 goto evalstart;
11655 if (expr->token[2].type == JIM_EXPROP_LT) {
11656 cmpOffset = 0;
11658 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11659 cmpOffset = 1;
11661 else {
11662 goto evalstart;
11665 /* Update command must be incr */
11666 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11667 goto evalstart;
11670 /* incr, expression must be about the same variable */
11671 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11672 goto evalstart;
11675 /* Get the stop condition (must be a variable or integer) */
11676 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11677 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11678 goto evalstart;
11681 else {
11682 stopVarNamePtr = expr->token[1].objPtr;
11683 Jim_IncrRefCount(stopVarNamePtr);
11684 /* Keep the compiler happy */
11685 stop = 0;
11688 /* Initialization */
11689 varNamePtr = expr->token[0].objPtr;
11690 Jim_IncrRefCount(varNamePtr);
11692 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11693 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11694 goto testcond;
11697 /* --- OPTIMIZED FOR --- */
11698 while (retval == JIM_OK) {
11699 /* === Check condition === */
11700 /* Note that currentVal is already set here */
11702 /* Immediate or Variable? get the 'stop' value if the latter. */
11703 if (stopVarNamePtr) {
11704 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11705 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11706 goto testcond;
11710 if (currentVal >= stop + cmpOffset) {
11711 break;
11714 /* Eval body */
11715 retval = Jim_EvalObj(interp, argv[4]);
11716 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11717 retval = JIM_OK;
11719 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11721 /* Increment */
11722 if (objPtr == NULL) {
11723 retval = JIM_ERR;
11724 goto out;
11726 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11727 currentVal = ++JimWideValue(objPtr);
11728 Jim_InvalidateStringRep(objPtr);
11730 else {
11731 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11732 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11733 ++currentVal)) != JIM_OK) {
11734 goto evalnext;
11739 goto out;
11741 evalstart:
11742 #endif
11744 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11745 /* Body */
11746 retval = Jim_EvalObj(interp, argv[4]);
11748 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11749 /* increment */
11750 evalnext:
11751 retval = Jim_EvalObj(interp, argv[3]);
11752 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11753 /* test */
11754 testcond:
11755 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11759 out:
11760 if (stopVarNamePtr) {
11761 Jim_DecrRefCount(interp, stopVarNamePtr);
11763 if (varNamePtr) {
11764 Jim_DecrRefCount(interp, varNamePtr);
11767 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11768 Jim_SetEmptyResult(interp);
11769 return JIM_OK;
11772 return retval;
11775 /* [loop] */
11776 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11778 int retval;
11779 jim_wide i;
11780 jim_wide limit;
11781 jim_wide incr = 1;
11782 Jim_Obj *bodyObjPtr;
11784 if (argc != 5 && argc != 6) {
11785 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11786 return JIM_ERR;
11789 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11790 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11791 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11792 return JIM_ERR;
11794 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11796 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11798 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11799 retval = Jim_EvalObj(interp, bodyObjPtr);
11800 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11801 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11803 retval = JIM_OK;
11805 /* Increment */
11806 i += incr;
11808 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11809 if (argv[1]->typePtr != &variableObjType) {
11810 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11811 return JIM_ERR;
11814 JimWideValue(objPtr) = i;
11815 Jim_InvalidateStringRep(objPtr);
11817 /* The following step is required in order to invalidate the
11818 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11819 if (argv[1]->typePtr != &variableObjType) {
11820 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11821 retval = JIM_ERR;
11822 break;
11826 else {
11827 objPtr = Jim_NewIntObj(interp, i);
11828 retval = Jim_SetVariable(interp, argv[1], objPtr);
11829 if (retval != JIM_OK) {
11830 Jim_FreeNewObj(interp, objPtr);
11836 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11837 Jim_SetEmptyResult(interp);
11838 return JIM_OK;
11840 return retval;
11843 /* List iterators make it easy to iterate over a list.
11844 * At some point iterators will be expanded to support generators.
11846 typedef struct {
11847 Jim_Obj *objPtr;
11848 int idx;
11849 } Jim_ListIter;
11852 * Initialise the iterator at the start of the list.
11854 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11856 iter->objPtr = objPtr;
11857 iter->idx = 0;
11861 * Returns the next object from the list, or NULL on end-of-list.
11863 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11865 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11866 return NULL;
11868 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11872 * Returns 1 if end-of-list has been reached.
11874 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11876 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11879 /* foreach + lmap implementation. */
11880 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11882 int result = JIM_OK;
11883 int i, numargs;
11884 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11885 Jim_ListIter *iters;
11886 Jim_Obj *script;
11887 Jim_Obj *resultObj;
11889 if (argc < 4 || argc % 2 != 0) {
11890 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11891 return JIM_ERR;
11893 script = argv[argc - 1]; /* Last argument is a script */
11894 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11896 if (numargs == 2) {
11897 iters = twoiters;
11899 else {
11900 iters = Jim_Alloc(numargs * sizeof(*iters));
11902 for (i = 0; i < numargs; i++) {
11903 JimListIterInit(&iters[i], argv[i + 1]);
11904 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11905 result = JIM_ERR;
11908 if (result != JIM_OK) {
11909 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11910 return result;
11913 if (doMap) {
11914 resultObj = Jim_NewListObj(interp, NULL, 0);
11916 else {
11917 resultObj = interp->emptyObj;
11919 Jim_IncrRefCount(resultObj);
11921 while (1) {
11922 /* Have we expired all lists? */
11923 for (i = 0; i < numargs; i += 2) {
11924 if (!JimListIterDone(interp, &iters[i + 1])) {
11925 break;
11928 if (i == numargs) {
11929 /* All done */
11930 break;
11933 /* For each list */
11934 for (i = 0; i < numargs; i += 2) {
11935 Jim_Obj *varName;
11937 /* foreach var */
11938 JimListIterInit(&iters[i], argv[i + 1]);
11939 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11940 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11941 if (!valObj) {
11942 /* Ran out, so store the empty string */
11943 valObj = interp->emptyObj;
11945 /* Avoid shimmering */
11946 Jim_IncrRefCount(valObj);
11947 result = Jim_SetVariable(interp, varName, valObj);
11948 Jim_DecrRefCount(interp, valObj);
11949 if (result != JIM_OK) {
11950 goto err;
11954 switch (result = Jim_EvalObj(interp, script)) {
11955 case JIM_OK:
11956 if (doMap) {
11957 Jim_ListAppendElement(interp, resultObj, interp->result);
11959 break;
11960 case JIM_CONTINUE:
11961 break;
11962 case JIM_BREAK:
11963 goto out;
11964 default:
11965 goto err;
11968 out:
11969 result = JIM_OK;
11970 Jim_SetResult(interp, resultObj);
11971 err:
11972 Jim_DecrRefCount(interp, resultObj);
11973 if (numargs > 2) {
11974 Jim_Free(iters);
11976 return result;
11979 /* [foreach] */
11980 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11982 return JimForeachMapHelper(interp, argc, argv, 0);
11985 /* [lmap] */
11986 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11988 return JimForeachMapHelper(interp, argc, argv, 1);
11991 /* [lassign] */
11992 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11994 int result = JIM_ERR;
11995 int i;
11996 Jim_ListIter iter;
11997 Jim_Obj *resultObj;
11999 if (argc < 2) {
12000 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12001 return JIM_ERR;
12004 JimListIterInit(&iter, argv[1]);
12006 for (i = 2; i < argc; i++) {
12007 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12008 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12009 if (result != JIM_OK) {
12010 return result;
12014 resultObj = Jim_NewListObj(interp, NULL, 0);
12015 while (!JimListIterDone(interp, &iter)) {
12016 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12019 Jim_SetResult(interp, resultObj);
12021 return JIM_OK;
12024 /* [if] */
12025 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12027 int boolean, retval, current = 1, falsebody = 0;
12029 if (argc >= 3) {
12030 while (1) {
12031 /* Far not enough arguments given! */
12032 if (current >= argc)
12033 goto err;
12034 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12035 != JIM_OK)
12036 return retval;
12037 /* There lacks something, isn't it? */
12038 if (current >= argc)
12039 goto err;
12040 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12041 current++;
12042 /* Tsk tsk, no then-clause? */
12043 if (current >= argc)
12044 goto err;
12045 if (boolean)
12046 return Jim_EvalObj(interp, argv[current]);
12047 /* Ok: no else-clause follows */
12048 if (++current >= argc) {
12049 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12050 return JIM_OK;
12052 falsebody = current++;
12053 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12054 /* IIICKS - else-clause isn't last cmd? */
12055 if (current != argc - 1)
12056 goto err;
12057 return Jim_EvalObj(interp, argv[current]);
12059 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12060 /* Ok: elseif follows meaning all the stuff
12061 * again (how boring...) */
12062 continue;
12063 /* OOPS - else-clause is not last cmd? */
12064 else if (falsebody != argc - 1)
12065 goto err;
12066 return Jim_EvalObj(interp, argv[falsebody]);
12068 return JIM_OK;
12070 err:
12071 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12072 return JIM_ERR;
12076 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12077 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12078 Jim_Obj *stringObj, int nocase)
12080 Jim_Obj *parms[4];
12081 int argc = 0;
12082 long eq;
12083 int rc;
12085 parms[argc++] = commandObj;
12086 if (nocase) {
12087 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12089 parms[argc++] = patternObj;
12090 parms[argc++] = stringObj;
12092 rc = Jim_EvalObjVector(interp, argc, parms);
12094 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12095 eq = -rc;
12098 return eq;
12101 enum
12102 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12104 /* [switch] */
12105 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12107 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12108 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12109 Jim_Obj *script = 0;
12111 if (argc < 3) {
12112 wrongnumargs:
12113 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12114 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12115 return JIM_ERR;
12117 for (opt = 1; opt < argc; ++opt) {
12118 const char *option = Jim_String(argv[opt]);
12120 if (*option != '-')
12121 break;
12122 else if (strncmp(option, "--", 2) == 0) {
12123 ++opt;
12124 break;
12126 else if (strncmp(option, "-exact", 2) == 0)
12127 matchOpt = SWITCH_EXACT;
12128 else if (strncmp(option, "-glob", 2) == 0)
12129 matchOpt = SWITCH_GLOB;
12130 else if (strncmp(option, "-regexp", 2) == 0)
12131 matchOpt = SWITCH_RE;
12132 else if (strncmp(option, "-command", 2) == 0) {
12133 matchOpt = SWITCH_CMD;
12134 if ((argc - opt) < 2)
12135 goto wrongnumargs;
12136 command = argv[++opt];
12138 else {
12139 Jim_SetResultFormatted(interp,
12140 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12141 argv[opt]);
12142 return JIM_ERR;
12144 if ((argc - opt) < 2)
12145 goto wrongnumargs;
12147 strObj = argv[opt++];
12148 patCount = argc - opt;
12149 if (patCount == 1) {
12150 Jim_Obj **vector;
12152 JimListGetElements(interp, argv[opt], &patCount, &vector);
12153 caseList = vector;
12155 else
12156 caseList = &argv[opt];
12157 if (patCount == 0 || patCount % 2 != 0)
12158 goto wrongnumargs;
12159 for (i = 0; script == 0 && i < patCount; i += 2) {
12160 Jim_Obj *patObj = caseList[i];
12162 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12163 || i < (patCount - 2)) {
12164 switch (matchOpt) {
12165 case SWITCH_EXACT:
12166 if (Jim_StringEqObj(strObj, patObj))
12167 script = caseList[i + 1];
12168 break;
12169 case SWITCH_GLOB:
12170 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12171 script = caseList[i + 1];
12172 break;
12173 case SWITCH_RE:
12174 command = Jim_NewStringObj(interp, "regexp", -1);
12175 /* Fall thru intentionally */
12176 case SWITCH_CMD:{
12177 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12179 /* After the execution of a command we need to
12180 * make sure to reconvert the object into a list
12181 * again. Only for the single-list style [switch]. */
12182 if (argc - opt == 1) {
12183 Jim_Obj **vector;
12185 JimListGetElements(interp, argv[opt], &patCount, &vector);
12186 caseList = vector;
12188 /* command is here already decref'd */
12189 if (rc < 0) {
12190 return -rc;
12192 if (rc)
12193 script = caseList[i + 1];
12194 break;
12198 else {
12199 script = caseList[i + 1];
12202 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12203 script = caseList[i + 1];
12204 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12205 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12206 return JIM_ERR;
12208 Jim_SetEmptyResult(interp);
12209 if (script) {
12210 return Jim_EvalObj(interp, script);
12212 return JIM_OK;
12215 /* [list] */
12216 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12218 Jim_Obj *listObjPtr;
12220 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12221 Jim_SetResult(interp, listObjPtr);
12222 return JIM_OK;
12225 /* [lindex] */
12226 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12228 Jim_Obj *objPtr, *listObjPtr;
12229 int i;
12230 int idx;
12232 if (argc < 2) {
12233 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12234 return JIM_ERR;
12236 objPtr = argv[1];
12237 Jim_IncrRefCount(objPtr);
12238 for (i = 2; i < argc; i++) {
12239 listObjPtr = objPtr;
12240 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12241 Jim_DecrRefCount(interp, listObjPtr);
12242 return JIM_ERR;
12244 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12245 /* Returns an empty object if the index
12246 * is out of range. */
12247 Jim_DecrRefCount(interp, listObjPtr);
12248 Jim_SetEmptyResult(interp);
12249 return JIM_OK;
12251 Jim_IncrRefCount(objPtr);
12252 Jim_DecrRefCount(interp, listObjPtr);
12254 Jim_SetResult(interp, objPtr);
12255 Jim_DecrRefCount(interp, objPtr);
12256 return JIM_OK;
12259 /* [llength] */
12260 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12262 if (argc != 2) {
12263 Jim_WrongNumArgs(interp, 1, argv, "list");
12264 return JIM_ERR;
12266 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12267 return JIM_OK;
12270 /* [lsearch] */
12271 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12273 static const char * const options[] = {
12274 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12275 NULL
12277 enum
12278 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12279 OPT_COMMAND };
12280 int i;
12281 int opt_bool = 0;
12282 int opt_not = 0;
12283 int opt_nocase = 0;
12284 int opt_all = 0;
12285 int opt_inline = 0;
12286 int opt_match = OPT_EXACT;
12287 int listlen;
12288 int rc = JIM_OK;
12289 Jim_Obj *listObjPtr = NULL;
12290 Jim_Obj *commandObj = NULL;
12292 if (argc < 3) {
12293 wrongargs:
12294 Jim_WrongNumArgs(interp, 1, argv,
12295 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12296 return JIM_ERR;
12299 for (i = 1; i < argc - 2; i++) {
12300 int option;
12302 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12303 return JIM_ERR;
12305 switch (option) {
12306 case OPT_BOOL:
12307 opt_bool = 1;
12308 opt_inline = 0;
12309 break;
12310 case OPT_NOT:
12311 opt_not = 1;
12312 break;
12313 case OPT_NOCASE:
12314 opt_nocase = 1;
12315 break;
12316 case OPT_INLINE:
12317 opt_inline = 1;
12318 opt_bool = 0;
12319 break;
12320 case OPT_ALL:
12321 opt_all = 1;
12322 break;
12323 case OPT_COMMAND:
12324 if (i >= argc - 2) {
12325 goto wrongargs;
12327 commandObj = argv[++i];
12328 /* fallthru */
12329 case OPT_EXACT:
12330 case OPT_GLOB:
12331 case OPT_REGEXP:
12332 opt_match = option;
12333 break;
12337 argv += i;
12339 if (opt_all) {
12340 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12342 if (opt_match == OPT_REGEXP) {
12343 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12345 if (commandObj) {
12346 Jim_IncrRefCount(commandObj);
12349 listlen = Jim_ListLength(interp, argv[0]);
12350 for (i = 0; i < listlen; i++) {
12351 int eq = 0;
12352 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12354 switch (opt_match) {
12355 case OPT_EXACT:
12356 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12357 break;
12359 case OPT_GLOB:
12360 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12361 break;
12363 case OPT_REGEXP:
12364 case OPT_COMMAND:
12365 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12366 if (eq < 0) {
12367 if (listObjPtr) {
12368 Jim_FreeNewObj(interp, listObjPtr);
12370 rc = JIM_ERR;
12371 goto done;
12373 break;
12376 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12377 if (!eq && opt_bool && opt_not && !opt_all) {
12378 continue;
12381 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12382 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12383 Jim_Obj *resultObj;
12385 if (opt_bool) {
12386 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12388 else if (!opt_inline) {
12389 resultObj = Jim_NewIntObj(interp, i);
12391 else {
12392 resultObj = objPtr;
12395 if (opt_all) {
12396 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12398 else {
12399 Jim_SetResult(interp, resultObj);
12400 goto done;
12405 if (opt_all) {
12406 Jim_SetResult(interp, listObjPtr);
12408 else {
12409 /* No match */
12410 if (opt_bool) {
12411 Jim_SetResultBool(interp, opt_not);
12413 else if (!opt_inline) {
12414 Jim_SetResultInt(interp, -1);
12418 done:
12419 if (commandObj) {
12420 Jim_DecrRefCount(interp, commandObj);
12422 return rc;
12425 /* [lappend] */
12426 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12428 Jim_Obj *listObjPtr;
12429 int shared, i;
12431 if (argc < 2) {
12432 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12433 return JIM_ERR;
12435 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12436 if (!listObjPtr) {
12437 /* Create the list if it does not exists */
12438 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12439 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12440 Jim_FreeNewObj(interp, listObjPtr);
12441 return JIM_ERR;
12444 shared = Jim_IsShared(listObjPtr);
12445 if (shared)
12446 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12447 for (i = 2; i < argc; i++)
12448 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12449 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12450 if (shared)
12451 Jim_FreeNewObj(interp, listObjPtr);
12452 return JIM_ERR;
12454 Jim_SetResult(interp, listObjPtr);
12455 return JIM_OK;
12458 /* [linsert] */
12459 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12461 int idx, len;
12462 Jim_Obj *listPtr;
12464 if (argc < 3) {
12465 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12466 return JIM_ERR;
12468 listPtr = argv[1];
12469 if (Jim_IsShared(listPtr))
12470 listPtr = Jim_DuplicateObj(interp, listPtr);
12471 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12472 goto err;
12473 len = Jim_ListLength(interp, listPtr);
12474 if (idx >= len)
12475 idx = len;
12476 else if (idx < 0)
12477 idx = len + idx + 1;
12478 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12479 Jim_SetResult(interp, listPtr);
12480 return JIM_OK;
12481 err:
12482 if (listPtr != argv[1]) {
12483 Jim_FreeNewObj(interp, listPtr);
12485 return JIM_ERR;
12488 /* [lreplace] */
12489 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12491 int first, last, len, rangeLen;
12492 Jim_Obj *listObj;
12493 Jim_Obj *newListObj;
12495 if (argc < 4) {
12496 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12497 return JIM_ERR;
12499 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12500 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12501 return JIM_ERR;
12504 listObj = argv[1];
12505 len = Jim_ListLength(interp, listObj);
12507 first = JimRelToAbsIndex(len, first);
12508 last = JimRelToAbsIndex(len, last);
12509 JimRelToAbsRange(len, &first, &last, &rangeLen);
12511 /* Now construct a new list which consists of:
12512 * <elements before first> <supplied elements> <elements after last>
12515 /* Check to see if trying to replace past the end of the list */
12516 if (first < len) {
12517 /* OK. Not past the end */
12519 else if (len == 0) {
12520 /* Special for empty list, adjust first to 0 */
12521 first = 0;
12523 else {
12524 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12525 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12526 return JIM_ERR;
12529 /* Add the first set of elements */
12530 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12532 /* Add supplied elements */
12533 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12535 /* Add the remaining elements */
12536 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12538 Jim_SetResult(interp, newListObj);
12539 return JIM_OK;
12542 /* [lset] */
12543 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12545 if (argc < 3) {
12546 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12547 return JIM_ERR;
12549 else if (argc == 3) {
12550 /* With no indexes, simply implements [set] */
12551 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12552 return JIM_ERR;
12553 Jim_SetResult(interp, argv[2]);
12554 return JIM_OK;
12556 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12559 /* [lsort] */
12560 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12562 static const char * const options[] = {
12563 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12565 enum
12566 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12567 Jim_Obj *resObj;
12568 int i;
12569 int retCode;
12571 struct lsort_info info;
12573 if (argc < 2) {
12574 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12575 return JIM_ERR;
12578 info.type = JIM_LSORT_ASCII;
12579 info.order = 1;
12580 info.indexed = 0;
12581 info.unique = 0;
12582 info.command = NULL;
12583 info.interp = interp;
12585 for (i = 1; i < (argc - 1); i++) {
12586 int option;
12588 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12589 != JIM_OK)
12590 return JIM_ERR;
12591 switch (option) {
12592 case OPT_ASCII:
12593 info.type = JIM_LSORT_ASCII;
12594 break;
12595 case OPT_NOCASE:
12596 info.type = JIM_LSORT_NOCASE;
12597 break;
12598 case OPT_INTEGER:
12599 info.type = JIM_LSORT_INTEGER;
12600 break;
12601 case OPT_REAL:
12602 info.type = JIM_LSORT_REAL;
12603 break;
12604 case OPT_INCREASING:
12605 info.order = 1;
12606 break;
12607 case OPT_DECREASING:
12608 info.order = -1;
12609 break;
12610 case OPT_UNIQUE:
12611 info.unique = 1;
12612 break;
12613 case OPT_COMMAND:
12614 if (i >= (argc - 2)) {
12615 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12616 return JIM_ERR;
12618 info.type = JIM_LSORT_COMMAND;
12619 info.command = argv[i + 1];
12620 i++;
12621 break;
12622 case OPT_INDEX:
12623 if (i >= (argc - 2)) {
12624 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12625 return JIM_ERR;
12627 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12628 return JIM_ERR;
12630 info.indexed = 1;
12631 i++;
12632 break;
12635 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12636 retCode = ListSortElements(interp, resObj, &info);
12637 if (retCode == JIM_OK) {
12638 Jim_SetResult(interp, resObj);
12640 else {
12641 Jim_FreeNewObj(interp, resObj);
12643 return retCode;
12646 /* [append] */
12647 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12649 Jim_Obj *stringObjPtr;
12650 int i;
12652 if (argc < 2) {
12653 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12654 return JIM_ERR;
12656 if (argc == 2) {
12657 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12658 if (!stringObjPtr)
12659 return JIM_ERR;
12661 else {
12662 int freeobj = 0;
12663 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12664 if (!stringObjPtr) {
12665 /* Create the string if it doesn't exist */
12666 stringObjPtr = Jim_NewEmptyStringObj(interp);
12667 freeobj = 1;
12669 else if (Jim_IsShared(stringObjPtr)) {
12670 freeobj = 1;
12671 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12673 for (i = 2; i < argc; i++) {
12674 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12676 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12677 if (freeobj) {
12678 Jim_FreeNewObj(interp, stringObjPtr);
12680 return JIM_ERR;
12683 Jim_SetResult(interp, stringObjPtr);
12684 return JIM_OK;
12687 /* [debug] */
12688 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12690 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12691 static const char * const options[] = {
12692 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12693 "exprbc", "show",
12694 NULL
12696 enum
12698 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12699 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12701 int option;
12703 if (argc < 2) {
12704 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12705 return JIM_ERR;
12707 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12708 return JIM_ERR;
12709 if (option == OPT_REFCOUNT) {
12710 if (argc != 3) {
12711 Jim_WrongNumArgs(interp, 2, argv, "object");
12712 return JIM_ERR;
12714 Jim_SetResultInt(interp, argv[2]->refCount);
12715 return JIM_OK;
12717 else if (option == OPT_OBJCOUNT) {
12718 int freeobj = 0, liveobj = 0;
12719 char buf[256];
12720 Jim_Obj *objPtr;
12722 if (argc != 2) {
12723 Jim_WrongNumArgs(interp, 2, argv, "");
12724 return JIM_ERR;
12726 /* Count the number of free objects. */
12727 objPtr = interp->freeList;
12728 while (objPtr) {
12729 freeobj++;
12730 objPtr = objPtr->nextObjPtr;
12732 /* Count the number of live objects. */
12733 objPtr = interp->liveList;
12734 while (objPtr) {
12735 liveobj++;
12736 objPtr = objPtr->nextObjPtr;
12738 /* Set the result string and return. */
12739 sprintf(buf, "free %d used %d", freeobj, liveobj);
12740 Jim_SetResultString(interp, buf, -1);
12741 return JIM_OK;
12743 else if (option == OPT_OBJECTS) {
12744 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12746 /* Count the number of live objects. */
12747 objPtr = interp->liveList;
12748 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12749 while (objPtr) {
12750 char buf[128];
12751 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12753 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12754 sprintf(buf, "%p", objPtr);
12755 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12756 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12757 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12758 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12759 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12760 objPtr = objPtr->nextObjPtr;
12762 Jim_SetResult(interp, listObjPtr);
12763 return JIM_OK;
12765 else if (option == OPT_INVSTR) {
12766 Jim_Obj *objPtr;
12768 if (argc != 3) {
12769 Jim_WrongNumArgs(interp, 2, argv, "object");
12770 return JIM_ERR;
12772 objPtr = argv[2];
12773 if (objPtr->typePtr != NULL)
12774 Jim_InvalidateStringRep(objPtr);
12775 Jim_SetEmptyResult(interp);
12776 return JIM_OK;
12778 else if (option == OPT_SHOW) {
12779 const char *s;
12780 int len, charlen;
12782 if (argc != 3) {
12783 Jim_WrongNumArgs(interp, 2, argv, "object");
12784 return JIM_ERR;
12786 s = Jim_GetString(argv[2], &len);
12787 #ifdef JIM_UTF8
12788 charlen = utf8_strlen(s, len);
12789 #else
12790 charlen = len;
12791 #endif
12792 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12793 printf("chars (%d): <<%s>>\n", charlen, s);
12794 printf("bytes (%d):", len);
12795 while (len--) {
12796 printf(" %02x", (unsigned char)*s++);
12798 printf("\n");
12799 return JIM_OK;
12801 else if (option == OPT_SCRIPTLEN) {
12802 ScriptObj *script;
12804 if (argc != 3) {
12805 Jim_WrongNumArgs(interp, 2, argv, "script");
12806 return JIM_ERR;
12808 script = Jim_GetScript(interp, argv[2]);
12809 if (script == NULL)
12810 return JIM_ERR;
12811 Jim_SetResultInt(interp, script->len);
12812 return JIM_OK;
12814 else if (option == OPT_EXPRLEN) {
12815 ExprByteCode *expr;
12817 if (argc != 3) {
12818 Jim_WrongNumArgs(interp, 2, argv, "expression");
12819 return JIM_ERR;
12821 expr = JimGetExpression(interp, argv[2]);
12822 if (expr == NULL)
12823 return JIM_ERR;
12824 Jim_SetResultInt(interp, expr->len);
12825 return JIM_OK;
12827 else if (option == OPT_EXPRBC) {
12828 Jim_Obj *objPtr;
12829 ExprByteCode *expr;
12830 int i;
12832 if (argc != 3) {
12833 Jim_WrongNumArgs(interp, 2, argv, "expression");
12834 return JIM_ERR;
12836 expr = JimGetExpression(interp, argv[2]);
12837 if (expr == NULL)
12838 return JIM_ERR;
12839 objPtr = Jim_NewListObj(interp, NULL, 0);
12840 for (i = 0; i < expr->len; i++) {
12841 const char *type;
12842 const Jim_ExprOperator *op;
12843 Jim_Obj *obj = expr->token[i].objPtr;
12845 switch (expr->token[i].type) {
12846 case JIM_TT_EXPR_INT:
12847 type = "int";
12848 break;
12849 case JIM_TT_EXPR_DOUBLE:
12850 type = "double";
12851 break;
12852 case JIM_TT_CMD:
12853 type = "command";
12854 break;
12855 case JIM_TT_VAR:
12856 type = "variable";
12857 break;
12858 case JIM_TT_DICTSUGAR:
12859 type = "dictsugar";
12860 break;
12861 case JIM_TT_EXPRSUGAR:
12862 type = "exprsugar";
12863 break;
12864 case JIM_TT_ESC:
12865 type = "subst";
12866 break;
12867 case JIM_TT_STR:
12868 type = "string";
12869 break;
12870 default:
12871 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12872 if (op == NULL) {
12873 type = "private";
12875 else {
12876 type = "operator";
12878 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12879 break;
12881 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12882 Jim_ListAppendElement(interp, objPtr, obj);
12884 Jim_SetResult(interp, objPtr);
12885 return JIM_OK;
12887 else {
12888 Jim_SetResultString(interp,
12889 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12890 return JIM_ERR;
12892 /* unreached */
12893 #endif /* JIM_BOOTSTRAP */
12894 #if !defined(JIM_DEBUG_COMMAND)
12895 Jim_SetResultString(interp, "unsupported", -1);
12896 return JIM_ERR;
12897 #endif
12900 /* [eval] */
12901 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12903 int rc;
12905 if (argc < 2) {
12906 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12907 return JIM_ERR;
12910 if (argc == 2) {
12911 rc = Jim_EvalObj(interp, argv[1]);
12913 else {
12914 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12917 if (rc == JIM_ERR) {
12918 /* eval is "interesting", so add a stack frame here */
12919 interp->addStackTrace++;
12921 return rc;
12924 /* [uplevel] */
12925 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12927 if (argc >= 2) {
12928 int retcode;
12929 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12930 int savedTailcall;
12931 const char *str;
12933 /* Save the old callframe pointer */
12934 savedCallFrame = interp->framePtr;
12936 /* Lookup the target frame pointer */
12937 str = Jim_String(argv[1]);
12938 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12939 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12940 argc--;
12941 argv++;
12943 else {
12944 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12946 if (targetCallFrame == NULL) {
12947 return JIM_ERR;
12949 if (argc < 2) {
12950 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12951 return JIM_ERR;
12953 /* Eval the code in the target callframe. */
12954 interp->framePtr = targetCallFrame;
12955 /* Can't merge tailcalls across upcall */
12956 savedTailcall = interp->framePtr->tailcall;
12957 interp->framePtr->tailcall = 0;
12958 if (argc == 2) {
12959 retcode = Jim_EvalObj(interp, argv[1]);
12961 else {
12962 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12964 interp->framePtr->tailcall = savedTailcall;
12965 interp->framePtr = savedCallFrame;
12966 return retcode;
12968 else {
12969 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12970 return JIM_ERR;
12974 /* [expr] */
12975 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12977 Jim_Obj *exprResultPtr;
12978 int retcode;
12980 if (argc == 2) {
12981 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12983 else if (argc > 2) {
12984 Jim_Obj *objPtr;
12986 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12987 Jim_IncrRefCount(objPtr);
12988 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12989 Jim_DecrRefCount(interp, objPtr);
12991 else {
12992 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12993 return JIM_ERR;
12995 if (retcode != JIM_OK)
12996 return retcode;
12997 Jim_SetResult(interp, exprResultPtr);
12998 Jim_DecrRefCount(interp, exprResultPtr);
12999 return JIM_OK;
13002 /* [break] */
13003 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13005 if (argc != 1) {
13006 Jim_WrongNumArgs(interp, 1, argv, "");
13007 return JIM_ERR;
13009 return JIM_BREAK;
13012 /* [continue] */
13013 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13015 if (argc != 1) {
13016 Jim_WrongNumArgs(interp, 1, argv, "");
13017 return JIM_ERR;
13019 return JIM_CONTINUE;
13022 /* [return] */
13023 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13025 int i;
13026 Jim_Obj *stackTraceObj = NULL;
13027 Jim_Obj *errorCodeObj = NULL;
13028 int returnCode = JIM_OK;
13029 long level = 1;
13031 for (i = 1; i < argc - 1; i += 2) {
13032 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13033 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13034 return JIM_ERR;
13037 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13038 stackTraceObj = argv[i + 1];
13040 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13041 errorCodeObj = argv[i + 1];
13043 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13044 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13045 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13046 return JIM_ERR;
13049 else {
13050 break;
13054 if (i != argc - 1 && i != argc) {
13055 Jim_WrongNumArgs(interp, 1, argv,
13056 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13059 /* If a stack trace is supplied and code is error, set the stack trace */
13060 if (stackTraceObj && returnCode == JIM_ERR) {
13061 JimSetStackTrace(interp, stackTraceObj);
13063 /* If an error code list is supplied, set the global $errorCode */
13064 if (errorCodeObj && returnCode == JIM_ERR) {
13065 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13067 interp->returnCode = returnCode;
13068 interp->returnLevel = level;
13070 if (i == argc - 1) {
13071 Jim_SetResult(interp, argv[i]);
13073 return JIM_RETURN;
13076 /* [tailcall] */
13077 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13079 if (interp->framePtr->level == 0) {
13080 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13081 return JIM_ERR;
13083 else if (argc >= 2) {
13084 /* Need to resolve the tailcall command in the current context */
13085 Jim_CallFrame *cf = interp->framePtr->parent;
13087 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13088 if (cmdPtr == NULL) {
13089 return JIM_ERR;
13092 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13094 /* And stash this pre-resolved command */
13095 JimIncrCmdRefCount(cmdPtr);
13096 cf->tailcallCmd = cmdPtr;
13098 /* And stash the command list */
13099 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13101 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13102 Jim_IncrRefCount(cf->tailcallObj);
13104 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13105 return JIM_EVAL;
13107 return JIM_OK;
13110 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13112 Jim_Obj *cmdList;
13113 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13115 /* prefixListObj is a list to which the args need to be appended */
13116 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13117 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13119 return JimEvalObjList(interp, cmdList);
13122 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13124 Jim_Obj *prefixListObj = privData;
13125 Jim_DecrRefCount(interp, prefixListObj);
13128 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13130 Jim_Obj *prefixListObj;
13131 const char *newname;
13133 if (argc < 3) {
13134 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13135 return JIM_ERR;
13138 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13139 Jim_IncrRefCount(prefixListObj);
13140 newname = Jim_String(argv[1]);
13141 if (newname[0] == ':' && newname[1] == ':') {
13142 while (*++newname == ':') {
13146 Jim_SetResult(interp, argv[1]);
13148 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13151 /* [proc] */
13152 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13154 Jim_Cmd *cmd;
13156 if (argc != 4 && argc != 5) {
13157 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13158 return JIM_ERR;
13161 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13162 return JIM_ERR;
13165 if (argc == 4) {
13166 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13168 else {
13169 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13172 if (cmd) {
13173 /* Add the new command */
13174 Jim_Obj *qualifiedCmdNameObj;
13175 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13177 JimCreateCommand(interp, cmdname, cmd);
13179 /* Calculate and set the namespace for this proc */
13180 JimUpdateProcNamespace(interp, cmd, cmdname);
13182 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13184 /* Unlike Tcl, set the name of the proc as the result */
13185 Jim_SetResult(interp, argv[1]);
13186 return JIM_OK;
13188 return JIM_ERR;
13191 /* [local] */
13192 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13194 int retcode;
13196 if (argc < 2) {
13197 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13198 return JIM_ERR;
13201 /* Evaluate the arguments with 'local' in force */
13202 interp->local++;
13203 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13204 interp->local--;
13207 /* If OK, and the result is a proc, add it to the list of local procs */
13208 if (retcode == 0) {
13209 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13211 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13212 return JIM_ERR;
13214 if (interp->framePtr->localCommands == NULL) {
13215 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13216 Jim_InitStack(interp->framePtr->localCommands);
13218 Jim_IncrRefCount(cmdNameObj);
13219 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13222 return retcode;
13225 /* [upcall] */
13226 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13228 if (argc < 2) {
13229 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13230 return JIM_ERR;
13232 else {
13233 int retcode;
13235 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13236 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13237 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13238 return JIM_ERR;
13240 /* OK. Mark this command as being in an upcall */
13241 cmdPtr->u.proc.upcall++;
13242 JimIncrCmdRefCount(cmdPtr);
13244 /* Invoke the command as normal */
13245 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13247 /* No longer in an upcall */
13248 cmdPtr->u.proc.upcall--;
13249 JimDecrCmdRefCount(interp, cmdPtr);
13251 return retcode;
13255 /* [apply] */
13256 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13258 if (argc < 2) {
13259 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13260 return JIM_ERR;
13262 else {
13263 int ret;
13264 Jim_Cmd *cmd;
13265 Jim_Obj *argListObjPtr;
13266 Jim_Obj *bodyObjPtr;
13267 Jim_Obj *nsObj = NULL;
13268 Jim_Obj **nargv;
13270 int len = Jim_ListLength(interp, argv[1]);
13271 if (len != 2 && len != 3) {
13272 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13273 return JIM_ERR;
13276 if (len == 3) {
13277 #ifdef jim_ext_namespace
13278 /* Need to canonicalise the given namespace. */
13279 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13280 #else
13281 Jim_SetResultString(interp, "namespaces not enabled", -1);
13282 return JIM_ERR;
13283 #endif
13285 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13286 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13288 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13290 if (cmd) {
13291 /* Create a new argv array with a dummy argv[0], for error messages */
13292 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13293 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13294 Jim_IncrRefCount(nargv[0]);
13295 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13296 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13297 Jim_DecrRefCount(interp, nargv[0]);
13298 Jim_Free(nargv);
13300 JimDecrCmdRefCount(interp, cmd);
13301 return ret;
13303 return JIM_ERR;
13308 /* [concat] */
13309 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13311 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13312 return JIM_OK;
13315 /* [upvar] */
13316 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13318 int i;
13319 Jim_CallFrame *targetCallFrame;
13321 /* Lookup the target frame pointer */
13322 if (argc > 3 && (argc % 2 == 0)) {
13323 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13324 argc--;
13325 argv++;
13327 else {
13328 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13330 if (targetCallFrame == NULL) {
13331 return JIM_ERR;
13334 /* Check for arity */
13335 if (argc < 3) {
13336 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13337 return JIM_ERR;
13340 /* Now... for every other/local couple: */
13341 for (i = 1; i < argc; i += 2) {
13342 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13343 return JIM_ERR;
13345 return JIM_OK;
13348 /* [global] */
13349 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13351 int i;
13353 if (argc < 2) {
13354 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13355 return JIM_ERR;
13357 /* Link every var to the toplevel having the same name */
13358 if (interp->framePtr->level == 0)
13359 return JIM_OK; /* global at toplevel... */
13360 for (i = 1; i < argc; i++) {
13361 /* global ::blah does nothing */
13362 const char *name = Jim_String(argv[i]);
13363 if (name[0] != ':' || name[1] != ':') {
13364 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13365 return JIM_ERR;
13368 return JIM_OK;
13371 /* does the [string map] operation. On error NULL is returned,
13372 * otherwise a new string object with the result, having refcount = 0,
13373 * is returned. */
13374 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13375 Jim_Obj *objPtr, int nocase)
13377 int numMaps;
13378 const char *str, *noMatchStart = NULL;
13379 int strLen, i;
13380 Jim_Obj *resultObjPtr;
13382 numMaps = Jim_ListLength(interp, mapListObjPtr);
13383 if (numMaps % 2) {
13384 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13385 return NULL;
13388 str = Jim_String(objPtr);
13389 strLen = Jim_Utf8Length(interp, objPtr);
13391 /* Map it */
13392 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13393 while (strLen) {
13394 for (i = 0; i < numMaps; i += 2) {
13395 Jim_Obj *objPtr;
13396 const char *k;
13397 int kl;
13399 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13400 k = Jim_String(objPtr);
13401 kl = Jim_Utf8Length(interp, objPtr);
13403 if (strLen >= kl && kl) {
13404 int rc;
13405 rc = JimStringCompareLen(str, k, kl, nocase);
13406 if (rc == 0) {
13407 if (noMatchStart) {
13408 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13409 noMatchStart = NULL;
13411 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13412 str += utf8_index(str, kl);
13413 strLen -= kl;
13414 break;
13418 if (i == numMaps) { /* no match */
13419 int c;
13420 if (noMatchStart == NULL)
13421 noMatchStart = str;
13422 str += utf8_tounicode(str, &c);
13423 strLen--;
13426 if (noMatchStart) {
13427 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13429 return resultObjPtr;
13432 /* [string] */
13433 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13435 int len;
13436 int opt_case = 1;
13437 int option;
13438 static const char * const options[] = {
13439 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13440 "map", "repeat", "reverse", "index", "first", "last",
13441 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13443 enum
13445 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13446 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13447 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13449 static const char * const nocase_options[] = {
13450 "-nocase", NULL
13452 static const char * const nocase_length_options[] = {
13453 "-nocase", "-length", NULL
13456 if (argc < 2) {
13457 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13458 return JIM_ERR;
13460 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13461 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13462 return JIM_ERR;
13464 switch (option) {
13465 case OPT_LENGTH:
13466 case OPT_BYTELENGTH:
13467 if (argc != 3) {
13468 Jim_WrongNumArgs(interp, 2, argv, "string");
13469 return JIM_ERR;
13471 if (option == OPT_LENGTH) {
13472 len = Jim_Utf8Length(interp, argv[2]);
13474 else {
13475 len = Jim_Length(argv[2]);
13477 Jim_SetResultInt(interp, len);
13478 return JIM_OK;
13480 case OPT_COMPARE:
13481 case OPT_EQUAL:
13483 /* n is the number of remaining option args */
13484 long opt_length = -1;
13485 int n = argc - 4;
13486 int i = 2;
13487 while (n > 0) {
13488 int subopt;
13489 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13490 JIM_ENUM_ABBREV) != JIM_OK) {
13491 badcompareargs:
13492 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13493 return JIM_ERR;
13495 if (subopt == 0) {
13496 /* -nocase */
13497 opt_case = 0;
13498 n--;
13500 else {
13501 /* -length */
13502 if (n < 2) {
13503 goto badcompareargs;
13505 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13506 return JIM_ERR;
13508 n -= 2;
13511 if (n) {
13512 goto badcompareargs;
13514 argv += argc - 2;
13515 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13516 /* Fast version - [string equal], case sensitive, no length */
13517 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13519 else {
13520 if (opt_length >= 0) {
13521 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13523 else {
13524 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13526 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13528 return JIM_OK;
13531 case OPT_MATCH:
13532 if (argc != 4 &&
13533 (argc != 5 ||
13534 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13535 JIM_ENUM_ABBREV) != JIM_OK)) {
13536 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13537 return JIM_ERR;
13539 if (opt_case == 0) {
13540 argv++;
13542 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13543 return JIM_OK;
13545 case OPT_MAP:{
13546 Jim_Obj *objPtr;
13548 if (argc != 4 &&
13549 (argc != 5 ||
13550 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13551 JIM_ENUM_ABBREV) != JIM_OK)) {
13552 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13553 return JIM_ERR;
13556 if (opt_case == 0) {
13557 argv++;
13559 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13560 if (objPtr == NULL) {
13561 return JIM_ERR;
13563 Jim_SetResult(interp, objPtr);
13564 return JIM_OK;
13567 case OPT_RANGE:
13568 case OPT_BYTERANGE:{
13569 Jim_Obj *objPtr;
13571 if (argc != 5) {
13572 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13573 return JIM_ERR;
13575 if (option == OPT_RANGE) {
13576 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13578 else
13580 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13583 if (objPtr == NULL) {
13584 return JIM_ERR;
13586 Jim_SetResult(interp, objPtr);
13587 return JIM_OK;
13590 case OPT_REPLACE:{
13591 Jim_Obj *objPtr;
13593 if (argc != 5 && argc != 6) {
13594 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13595 return JIM_ERR;
13597 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13598 if (objPtr == NULL) {
13599 return JIM_ERR;
13601 Jim_SetResult(interp, objPtr);
13602 return JIM_OK;
13606 case OPT_REPEAT:{
13607 Jim_Obj *objPtr;
13608 jim_wide count;
13610 if (argc != 4) {
13611 Jim_WrongNumArgs(interp, 2, argv, "string count");
13612 return JIM_ERR;
13614 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13615 return JIM_ERR;
13617 objPtr = Jim_NewStringObj(interp, "", 0);
13618 if (count > 0) {
13619 while (count--) {
13620 Jim_AppendObj(interp, objPtr, argv[2]);
13623 Jim_SetResult(interp, objPtr);
13624 return JIM_OK;
13627 case OPT_REVERSE:{
13628 char *buf, *p;
13629 const char *str;
13630 int len;
13631 int i;
13633 if (argc != 3) {
13634 Jim_WrongNumArgs(interp, 2, argv, "string");
13635 return JIM_ERR;
13638 str = Jim_GetString(argv[2], &len);
13639 buf = Jim_Alloc(len + 1);
13640 p = buf + len;
13641 *p = 0;
13642 for (i = 0; i < len; ) {
13643 int c;
13644 int l = utf8_tounicode(str, &c);
13645 memcpy(p - l, str, l);
13646 p -= l;
13647 i += l;
13648 str += l;
13650 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13651 return JIM_OK;
13654 case OPT_INDEX:{
13655 int idx;
13656 const char *str;
13658 if (argc != 4) {
13659 Jim_WrongNumArgs(interp, 2, argv, "string index");
13660 return JIM_ERR;
13662 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13663 return JIM_ERR;
13665 str = Jim_String(argv[2]);
13666 len = Jim_Utf8Length(interp, argv[2]);
13667 if (idx != INT_MIN && idx != INT_MAX) {
13668 idx = JimRelToAbsIndex(len, idx);
13670 if (idx < 0 || idx >= len || str == NULL) {
13671 Jim_SetResultString(interp, "", 0);
13673 else if (len == Jim_Length(argv[2])) {
13674 /* ASCII optimisation */
13675 Jim_SetResultString(interp, str + idx, 1);
13677 else {
13678 int c;
13679 int i = utf8_index(str, idx);
13680 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13682 return JIM_OK;
13685 case OPT_FIRST:
13686 case OPT_LAST:{
13687 int idx = 0, l1, l2;
13688 const char *s1, *s2;
13690 if (argc != 4 && argc != 5) {
13691 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13692 return JIM_ERR;
13694 s1 = Jim_String(argv[2]);
13695 s2 = Jim_String(argv[3]);
13696 l1 = Jim_Utf8Length(interp, argv[2]);
13697 l2 = Jim_Utf8Length(interp, argv[3]);
13698 if (argc == 5) {
13699 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13700 return JIM_ERR;
13702 idx = JimRelToAbsIndex(l2, idx);
13704 else if (option == OPT_LAST) {
13705 idx = l2;
13707 if (option == OPT_FIRST) {
13708 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13710 else {
13711 #ifdef JIM_UTF8
13712 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13713 #else
13714 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13715 #endif
13717 return JIM_OK;
13720 case OPT_TRIM:
13721 case OPT_TRIMLEFT:
13722 case OPT_TRIMRIGHT:{
13723 Jim_Obj *trimchars;
13725 if (argc != 3 && argc != 4) {
13726 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13727 return JIM_ERR;
13729 trimchars = (argc == 4 ? argv[3] : NULL);
13730 if (option == OPT_TRIM) {
13731 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13733 else if (option == OPT_TRIMLEFT) {
13734 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13736 else if (option == OPT_TRIMRIGHT) {
13737 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13739 return JIM_OK;
13742 case OPT_TOLOWER:
13743 case OPT_TOUPPER:
13744 case OPT_TOTITLE:
13745 if (argc != 3) {
13746 Jim_WrongNumArgs(interp, 2, argv, "string");
13747 return JIM_ERR;
13749 if (option == OPT_TOLOWER) {
13750 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13752 else if (option == OPT_TOUPPER) {
13753 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13755 else {
13756 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13758 return JIM_OK;
13760 case OPT_IS:
13761 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13762 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13764 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13765 return JIM_ERR;
13767 return JIM_OK;
13770 /* [time] */
13771 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13773 long i, count = 1;
13774 jim_wide start, elapsed;
13775 char buf[60];
13776 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13778 if (argc < 2) {
13779 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13780 return JIM_ERR;
13782 if (argc == 3) {
13783 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13784 return JIM_ERR;
13786 if (count < 0)
13787 return JIM_OK;
13788 i = count;
13789 start = JimClock();
13790 while (i-- > 0) {
13791 int retval;
13793 retval = Jim_EvalObj(interp, argv[1]);
13794 if (retval != JIM_OK) {
13795 return retval;
13798 elapsed = JimClock() - start;
13799 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13800 Jim_SetResultString(interp, buf, -1);
13801 return JIM_OK;
13804 /* [exit] */
13805 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13807 long exitCode = 0;
13809 if (argc > 2) {
13810 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13811 return JIM_ERR;
13813 if (argc == 2) {
13814 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13815 return JIM_ERR;
13817 interp->exitCode = exitCode;
13818 return JIM_EXIT;
13821 /* [catch] */
13822 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13824 int exitCode = 0;
13825 int i;
13826 int sig = 0;
13828 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13829 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13830 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13832 /* Reset the error code before catch.
13833 * Note that this is not strictly correct.
13835 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13837 for (i = 1; i < argc - 1; i++) {
13838 const char *arg = Jim_String(argv[i]);
13839 jim_wide option;
13840 int ignore;
13842 /* It's a pity we can't use Jim_GetEnum here :-( */
13843 if (strcmp(arg, "--") == 0) {
13844 i++;
13845 break;
13847 if (*arg != '-') {
13848 break;
13851 if (strncmp(arg, "-no", 3) == 0) {
13852 arg += 3;
13853 ignore = 1;
13855 else {
13856 arg++;
13857 ignore = 0;
13860 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13861 option = -1;
13863 if (option < 0) {
13864 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13866 if (option < 0) {
13867 goto wrongargs;
13870 if (ignore) {
13871 ignore_mask |= (1 << option);
13873 else {
13874 ignore_mask &= ~(1 << option);
13878 argc -= i;
13879 if (argc < 1 || argc > 3) {
13880 wrongargs:
13881 Jim_WrongNumArgs(interp, 1, argv,
13882 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13883 return JIM_ERR;
13885 argv += i;
13887 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13888 sig++;
13891 interp->signal_level += sig;
13892 if (Jim_CheckSignal(interp)) {
13893 /* If a signal is set, don't even try to execute the body */
13894 exitCode = JIM_SIGNAL;
13896 else {
13897 exitCode = Jim_EvalObj(interp, argv[0]);
13898 /* Don't want any caught error included in a later stack trace */
13899 interp->errorFlag = 0;
13901 interp->signal_level -= sig;
13903 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13904 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13905 /* Not caught, pass it up */
13906 return exitCode;
13909 if (sig && exitCode == JIM_SIGNAL) {
13910 /* Catch the signal at this level */
13911 if (interp->signal_set_result) {
13912 interp->signal_set_result(interp, interp->sigmask);
13914 else {
13915 Jim_SetResultInt(interp, interp->sigmask);
13917 interp->sigmask = 0;
13920 if (argc >= 2) {
13921 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13922 return JIM_ERR;
13924 if (argc == 3) {
13925 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13927 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13928 Jim_ListAppendElement(interp, optListObj,
13929 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13930 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13931 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13932 if (exitCode == JIM_ERR) {
13933 Jim_Obj *errorCode;
13934 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13935 -1));
13936 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13938 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13939 if (errorCode) {
13940 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13941 Jim_ListAppendElement(interp, optListObj, errorCode);
13944 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13945 return JIM_ERR;
13949 Jim_SetResultInt(interp, exitCode);
13950 return JIM_OK;
13953 #ifdef JIM_REFERENCES
13955 /* [ref] */
13956 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13958 if (argc != 3 && argc != 4) {
13959 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13960 return JIM_ERR;
13962 if (argc == 3) {
13963 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13965 else {
13966 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13968 return JIM_OK;
13971 /* [getref] */
13972 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13974 Jim_Reference *refPtr;
13976 if (argc != 2) {
13977 Jim_WrongNumArgs(interp, 1, argv, "reference");
13978 return JIM_ERR;
13980 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13981 return JIM_ERR;
13982 Jim_SetResult(interp, refPtr->objPtr);
13983 return JIM_OK;
13986 /* [setref] */
13987 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13989 Jim_Reference *refPtr;
13991 if (argc != 3) {
13992 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13993 return JIM_ERR;
13995 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13996 return JIM_ERR;
13997 Jim_IncrRefCount(argv[2]);
13998 Jim_DecrRefCount(interp, refPtr->objPtr);
13999 refPtr->objPtr = argv[2];
14000 Jim_SetResult(interp, argv[2]);
14001 return JIM_OK;
14004 /* [collect] */
14005 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14007 if (argc != 1) {
14008 Jim_WrongNumArgs(interp, 1, argv, "");
14009 return JIM_ERR;
14011 Jim_SetResultInt(interp, Jim_Collect(interp));
14013 /* Free all the freed objects. */
14014 while (interp->freeList) {
14015 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14016 Jim_Free(interp->freeList);
14017 interp->freeList = nextObjPtr;
14020 return JIM_OK;
14023 /* [finalize] reference ?newValue? */
14024 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14026 if (argc != 2 && argc != 3) {
14027 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14028 return JIM_ERR;
14030 if (argc == 2) {
14031 Jim_Obj *cmdNamePtr;
14033 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14034 return JIM_ERR;
14035 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14036 Jim_SetResult(interp, cmdNamePtr);
14038 else {
14039 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14040 return JIM_ERR;
14041 Jim_SetResult(interp, argv[2]);
14043 return JIM_OK;
14046 /* [info references] */
14047 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14049 Jim_Obj *listObjPtr;
14050 Jim_HashTableIterator htiter;
14051 Jim_HashEntry *he;
14053 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14055 JimInitHashTableIterator(&interp->references, &htiter);
14056 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14057 char buf[JIM_REFERENCE_SPACE + 1];
14058 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14059 const unsigned long *refId = he->key;
14061 JimFormatReference(buf, refPtr, *refId);
14062 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14064 Jim_SetResult(interp, listObjPtr);
14065 return JIM_OK;
14067 #endif
14069 /* [rename] */
14070 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14072 if (argc != 3) {
14073 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14074 return JIM_ERR;
14077 if (JimValidName(interp, "new procedure", argv[2])) {
14078 return JIM_ERR;
14081 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14084 #define JIM_DICTMATCH_VALUES 0x0001
14086 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14088 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14090 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14091 if (type & JIM_DICTMATCH_VALUES) {
14092 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14097 * Like JimHashtablePatternMatch, but for dictionaries.
14099 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14100 JimDictMatchCallbackType *callback, int type)
14102 Jim_HashEntry *he;
14103 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14105 /* Check for the non-pattern case. We can do this much more efficiently. */
14106 Jim_HashTableIterator htiter;
14107 JimInitHashTableIterator(ht, &htiter);
14108 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14109 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14110 callback(interp, listObjPtr, he, type);
14114 return listObjPtr;
14118 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14120 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14121 return JIM_ERR;
14123 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14124 return JIM_OK;
14127 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14129 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14130 return JIM_ERR;
14132 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14133 return JIM_OK;
14136 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14138 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14139 return -1;
14141 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14144 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14146 Jim_HashTable *ht;
14147 unsigned int i;
14149 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14150 return JIM_ERR;
14153 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14155 /* Note that this uses internal knowledge of the hash table */
14156 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14158 for (i = 0; i < ht->size; i++) {
14159 Jim_HashEntry *he = ht->table[i];
14161 if (he) {
14162 printf("%d: ", i);
14164 while (he) {
14165 printf(" %s", Jim_String(he->key));
14166 he = he->next;
14168 printf("\n");
14171 return JIM_OK;
14174 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14176 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14178 Jim_AppendString(interp, prefixObj, " ", 1);
14179 Jim_AppendString(interp, prefixObj, subcmd, -1);
14181 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14184 /* [dict] */
14185 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14187 Jim_Obj *objPtr;
14188 int option;
14189 static const char * const options[] = {
14190 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14191 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14192 "replace", "update", NULL
14194 enum
14196 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14197 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14198 OPT_REPLACE, OPT_UPDATE,
14201 if (argc < 2) {
14202 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14203 return JIM_ERR;
14206 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14207 return JIM_ERR;
14210 switch (option) {
14211 case OPT_GET:
14212 if (argc < 3) {
14213 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14214 return JIM_ERR;
14216 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14217 JIM_ERRMSG) != JIM_OK) {
14218 return JIM_ERR;
14220 Jim_SetResult(interp, objPtr);
14221 return JIM_OK;
14223 case OPT_SET:
14224 if (argc < 5) {
14225 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14226 return JIM_ERR;
14228 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14230 case OPT_EXISTS:
14231 if (argc < 4) {
14232 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14233 return JIM_ERR;
14235 else {
14236 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14237 if (rc < 0) {
14238 return JIM_ERR;
14240 Jim_SetResultBool(interp, rc == JIM_OK);
14241 return JIM_OK;
14244 case OPT_UNSET:
14245 if (argc < 4) {
14246 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14247 return JIM_ERR;
14249 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14250 return JIM_ERR;
14252 return JIM_OK;
14254 case OPT_KEYS:
14255 if (argc != 3 && argc != 4) {
14256 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14257 return JIM_ERR;
14259 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14261 case OPT_SIZE:
14262 if (argc != 3) {
14263 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14264 return JIM_ERR;
14266 else if (Jim_DictSize(interp, argv[2]) < 0) {
14267 return JIM_ERR;
14269 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14270 return JIM_OK;
14272 case OPT_MERGE:
14273 if (argc == 2) {
14274 return JIM_OK;
14276 if (Jim_DictSize(interp, argv[2]) < 0) {
14277 return JIM_ERR;
14279 /* Handle as ensemble */
14280 break;
14282 case OPT_UPDATE:
14283 if (argc < 6 || argc % 2) {
14284 /* Better error message */
14285 argc = 2;
14287 break;
14289 case OPT_CREATE:
14290 if (argc % 2) {
14291 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14292 return JIM_ERR;
14294 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14295 Jim_SetResult(interp, objPtr);
14296 return JIM_OK;
14298 case OPT_INFO:
14299 if (argc != 3) {
14300 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14301 return JIM_ERR;
14303 return Jim_DictInfo(interp, argv[2]);
14305 /* Handle command as an ensemble */
14306 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14309 /* [subst] */
14310 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14312 static const char * const options[] = {
14313 "-nobackslashes", "-nocommands", "-novariables", NULL
14315 enum
14316 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14317 int i;
14318 int flags = JIM_SUBST_FLAG;
14319 Jim_Obj *objPtr;
14321 if (argc < 2) {
14322 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14323 return JIM_ERR;
14325 for (i = 1; i < (argc - 1); i++) {
14326 int option;
14328 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14329 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14330 return JIM_ERR;
14332 switch (option) {
14333 case OPT_NOBACKSLASHES:
14334 flags |= JIM_SUBST_NOESC;
14335 break;
14336 case OPT_NOCOMMANDS:
14337 flags |= JIM_SUBST_NOCMD;
14338 break;
14339 case OPT_NOVARIABLES:
14340 flags |= JIM_SUBST_NOVAR;
14341 break;
14344 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14345 return JIM_ERR;
14347 Jim_SetResult(interp, objPtr);
14348 return JIM_OK;
14351 /* [info] */
14352 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14354 int cmd;
14355 Jim_Obj *objPtr;
14356 int mode = 0;
14358 static const char * const commands[] = {
14359 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14360 "vars", "version", "patchlevel", "complete", "args", "hostname",
14361 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14362 "references", "alias", NULL
14364 enum
14365 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14366 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14367 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14368 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14371 #ifdef jim_ext_namespace
14372 int nons = 0;
14374 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14375 /* This is for internal use only */
14376 argc--;
14377 argv++;
14378 nons = 1;
14380 #endif
14382 if (argc < 2) {
14383 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14384 return JIM_ERR;
14386 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14387 != JIM_OK) {
14388 return JIM_ERR;
14391 /* Test for the the most common commands first, just in case it makes a difference */
14392 switch (cmd) {
14393 case INFO_EXISTS:
14394 if (argc != 3) {
14395 Jim_WrongNumArgs(interp, 2, argv, "varName");
14396 return JIM_ERR;
14398 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14399 break;
14401 case INFO_ALIAS:{
14402 Jim_Cmd *cmdPtr;
14404 if (argc != 3) {
14405 Jim_WrongNumArgs(interp, 2, argv, "command");
14406 return JIM_ERR;
14408 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14409 return JIM_ERR;
14411 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14412 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14413 return JIM_ERR;
14415 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14416 return JIM_OK;
14419 case INFO_CHANNELS:
14420 mode++; /* JIM_CMDLIST_CHANNELS */
14421 #ifndef jim_ext_aio
14422 Jim_SetResultString(interp, "aio not enabled", -1);
14423 return JIM_ERR;
14424 #endif
14425 case INFO_PROCS:
14426 mode++; /* JIM_CMDLIST_PROCS */
14427 case INFO_COMMANDS:
14428 /* mode 0 => JIM_CMDLIST_COMMANDS */
14429 if (argc != 2 && argc != 3) {
14430 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14431 return JIM_ERR;
14433 #ifdef jim_ext_namespace
14434 if (!nons) {
14435 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14436 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14439 #endif
14440 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14441 break;
14443 case INFO_VARS:
14444 mode++; /* JIM_VARLIST_VARS */
14445 case INFO_LOCALS:
14446 mode++; /* JIM_VARLIST_LOCALS */
14447 case INFO_GLOBALS:
14448 /* mode 0 => JIM_VARLIST_GLOBALS */
14449 if (argc != 2 && argc != 3) {
14450 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14451 return JIM_ERR;
14453 #ifdef jim_ext_namespace
14454 if (!nons) {
14455 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14456 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14459 #endif
14460 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14461 break;
14463 case INFO_SCRIPT:
14464 if (argc != 2) {
14465 Jim_WrongNumArgs(interp, 2, argv, "");
14466 return JIM_ERR;
14468 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14469 break;
14471 case INFO_SOURCE:{
14472 int line;
14473 Jim_Obj *resObjPtr;
14474 Jim_Obj *fileNameObj;
14476 if (argc != 3) {
14477 Jim_WrongNumArgs(interp, 2, argv, "source");
14478 return JIM_ERR;
14480 if (argv[2]->typePtr == &sourceObjType) {
14481 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14482 line = argv[2]->internalRep.sourceValue.lineNumber;
14484 else if (argv[2]->typePtr == &scriptObjType) {
14485 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14486 fileNameObj = script->fileNameObj;
14487 line = script->firstline;
14489 else {
14490 fileNameObj = interp->emptyObj;
14491 line = 1;
14493 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14494 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14495 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14496 Jim_SetResult(interp, resObjPtr);
14497 break;
14500 case INFO_STACKTRACE:
14501 Jim_SetResult(interp, interp->stackTrace);
14502 break;
14504 case INFO_LEVEL:
14505 case INFO_FRAME:
14506 switch (argc) {
14507 case 2:
14508 Jim_SetResultInt(interp, interp->framePtr->level);
14509 break;
14511 case 3:
14512 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14513 return JIM_ERR;
14515 Jim_SetResult(interp, objPtr);
14516 break;
14518 default:
14519 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14520 return JIM_ERR;
14522 break;
14524 case INFO_BODY:
14525 case INFO_STATICS:
14526 case INFO_ARGS:{
14527 Jim_Cmd *cmdPtr;
14529 if (argc != 3) {
14530 Jim_WrongNumArgs(interp, 2, argv, "procname");
14531 return JIM_ERR;
14533 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14534 return JIM_ERR;
14536 if (!cmdPtr->isproc) {
14537 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14538 return JIM_ERR;
14540 switch (cmd) {
14541 case INFO_BODY:
14542 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14543 break;
14544 case INFO_ARGS:
14545 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14546 break;
14547 case INFO_STATICS:
14548 if (cmdPtr->u.proc.staticVars) {
14549 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14550 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14551 NULL, JimVariablesMatch, mode));
14553 break;
14555 break;
14558 case INFO_VERSION:
14559 case INFO_PATCHLEVEL:{
14560 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14562 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14563 Jim_SetResultString(interp, buf, -1);
14564 break;
14567 case INFO_COMPLETE:
14568 if (argc != 3 && argc != 4) {
14569 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14570 return JIM_ERR;
14572 else {
14573 int len;
14574 const char *s = Jim_GetString(argv[2], &len);
14575 char missing;
14577 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14578 if (missing != ' ' && argc == 4) {
14579 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14582 break;
14584 case INFO_HOSTNAME:
14585 /* Redirect to os.gethostname if it exists */
14586 return Jim_Eval(interp, "os.gethostname");
14588 case INFO_NAMEOFEXECUTABLE:
14589 /* Redirect to Tcl proc */
14590 return Jim_Eval(interp, "{info nameofexecutable}");
14592 case INFO_RETURNCODES:
14593 if (argc == 2) {
14594 int i;
14595 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14597 for (i = 0; jimReturnCodes[i]; i++) {
14598 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14599 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14600 jimReturnCodes[i], -1));
14603 Jim_SetResult(interp, listObjPtr);
14605 else if (argc == 3) {
14606 long code;
14607 const char *name;
14609 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14610 return JIM_ERR;
14612 name = Jim_ReturnCode(code);
14613 if (*name == '?') {
14614 Jim_SetResultInt(interp, code);
14616 else {
14617 Jim_SetResultString(interp, name, -1);
14620 else {
14621 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14622 return JIM_ERR;
14624 break;
14625 case INFO_REFERENCES:
14626 #ifdef JIM_REFERENCES
14627 return JimInfoReferences(interp, argc, argv);
14628 #else
14629 Jim_SetResultString(interp, "not supported", -1);
14630 return JIM_ERR;
14631 #endif
14633 return JIM_OK;
14636 /* [exists] */
14637 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14639 Jim_Obj *objPtr;
14640 int result = 0;
14642 static const char * const options[] = {
14643 "-command", "-proc", "-alias", "-var", NULL
14645 enum
14647 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14649 int option;
14651 if (argc == 2) {
14652 option = OPT_VAR;
14653 objPtr = argv[1];
14655 else if (argc == 3) {
14656 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14657 return JIM_ERR;
14659 objPtr = argv[2];
14661 else {
14662 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14663 return JIM_ERR;
14666 if (option == OPT_VAR) {
14667 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14669 else {
14670 /* Now different kinds of commands */
14671 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14673 if (cmd) {
14674 switch (option) {
14675 case OPT_COMMAND:
14676 result = 1;
14677 break;
14679 case OPT_ALIAS:
14680 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14681 break;
14683 case OPT_PROC:
14684 result = cmd->isproc;
14685 break;
14689 Jim_SetResultBool(interp, result);
14690 return JIM_OK;
14693 /* [split] */
14694 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14696 const char *str, *splitChars, *noMatchStart;
14697 int splitLen, strLen;
14698 Jim_Obj *resObjPtr;
14699 int c;
14700 int len;
14702 if (argc != 2 && argc != 3) {
14703 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14704 return JIM_ERR;
14707 str = Jim_GetString(argv[1], &len);
14708 if (len == 0) {
14709 return JIM_OK;
14711 strLen = Jim_Utf8Length(interp, argv[1]);
14713 /* Init */
14714 if (argc == 2) {
14715 splitChars = " \n\t\r";
14716 splitLen = 4;
14718 else {
14719 splitChars = Jim_String(argv[2]);
14720 splitLen = Jim_Utf8Length(interp, argv[2]);
14723 noMatchStart = str;
14724 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14726 /* Split */
14727 if (splitLen) {
14728 Jim_Obj *objPtr;
14729 while (strLen--) {
14730 const char *sc = splitChars;
14731 int scLen = splitLen;
14732 int sl = utf8_tounicode(str, &c);
14733 while (scLen--) {
14734 int pc;
14735 sc += utf8_tounicode(sc, &pc);
14736 if (c == pc) {
14737 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14738 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14739 noMatchStart = str + sl;
14740 break;
14743 str += sl;
14745 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14746 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14748 else {
14749 /* This handles the special case of splitchars eq {}
14750 * Optimise by sharing common (ASCII) characters
14752 Jim_Obj **commonObj = NULL;
14753 #define NUM_COMMON (128 - 9)
14754 while (strLen--) {
14755 int n = utf8_tounicode(str, &c);
14756 #ifdef JIM_OPTIMIZATION
14757 if (c >= 9 && c < 128) {
14758 /* Common ASCII char. Note that 9 is the tab character */
14759 c -= 9;
14760 if (!commonObj) {
14761 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14762 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14764 if (!commonObj[c]) {
14765 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14767 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14768 str++;
14769 continue;
14771 #endif
14772 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14773 str += n;
14775 Jim_Free(commonObj);
14778 Jim_SetResult(interp, resObjPtr);
14779 return JIM_OK;
14782 /* [join] */
14783 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14785 const char *joinStr;
14786 int joinStrLen;
14788 if (argc != 2 && argc != 3) {
14789 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14790 return JIM_ERR;
14792 /* Init */
14793 if (argc == 2) {
14794 joinStr = " ";
14795 joinStrLen = 1;
14797 else {
14798 joinStr = Jim_GetString(argv[2], &joinStrLen);
14800 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14801 return JIM_OK;
14804 /* [format] */
14805 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14807 Jim_Obj *objPtr;
14809 if (argc < 2) {
14810 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14811 return JIM_ERR;
14813 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14814 if (objPtr == NULL)
14815 return JIM_ERR;
14816 Jim_SetResult(interp, objPtr);
14817 return JIM_OK;
14820 /* [scan] */
14821 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14823 Jim_Obj *listPtr, **outVec;
14824 int outc, i;
14826 if (argc < 3) {
14827 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14828 return JIM_ERR;
14830 if (argv[2]->typePtr != &scanFmtStringObjType)
14831 SetScanFmtFromAny(interp, argv[2]);
14832 if (FormatGetError(argv[2]) != 0) {
14833 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14834 return JIM_ERR;
14836 if (argc > 3) {
14837 int maxPos = FormatGetMaxPos(argv[2]);
14838 int count = FormatGetCnvCount(argv[2]);
14840 if (maxPos > argc - 3) {
14841 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14842 return JIM_ERR;
14844 else if (count > argc - 3) {
14845 Jim_SetResultString(interp, "different numbers of variable names and "
14846 "field specifiers", -1);
14847 return JIM_ERR;
14849 else if (count < argc - 3) {
14850 Jim_SetResultString(interp, "variable is not assigned by any "
14851 "conversion specifiers", -1);
14852 return JIM_ERR;
14855 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14856 if (listPtr == 0)
14857 return JIM_ERR;
14858 if (argc > 3) {
14859 int rc = JIM_OK;
14860 int count = 0;
14862 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14863 int len = Jim_ListLength(interp, listPtr);
14865 if (len != 0) {
14866 JimListGetElements(interp, listPtr, &outc, &outVec);
14867 for (i = 0; i < outc; ++i) {
14868 if (Jim_Length(outVec[i]) > 0) {
14869 ++count;
14870 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14871 rc = JIM_ERR;
14876 Jim_FreeNewObj(interp, listPtr);
14878 else {
14879 count = -1;
14881 if (rc == JIM_OK) {
14882 Jim_SetResultInt(interp, count);
14884 return rc;
14886 else {
14887 if (listPtr == (Jim_Obj *)EOF) {
14888 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14889 return JIM_OK;
14891 Jim_SetResult(interp, listPtr);
14893 return JIM_OK;
14896 /* [error] */
14897 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14899 if (argc != 2 && argc != 3) {
14900 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14901 return JIM_ERR;
14903 Jim_SetResult(interp, argv[1]);
14904 if (argc == 3) {
14905 JimSetStackTrace(interp, argv[2]);
14906 return JIM_ERR;
14908 interp->addStackTrace++;
14909 return JIM_ERR;
14912 /* [lrange] */
14913 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14915 Jim_Obj *objPtr;
14917 if (argc != 4) {
14918 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14919 return JIM_ERR;
14921 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14922 return JIM_ERR;
14923 Jim_SetResult(interp, objPtr);
14924 return JIM_OK;
14927 /* [lrepeat] */
14928 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14930 Jim_Obj *objPtr;
14931 long count;
14933 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14934 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14935 return JIM_ERR;
14938 if (count == 0 || argc == 2) {
14939 return JIM_OK;
14942 argc -= 2;
14943 argv += 2;
14945 objPtr = Jim_NewListObj(interp, argv, argc);
14946 while (--count) {
14947 ListInsertElements(objPtr, -1, argc, argv);
14950 Jim_SetResult(interp, objPtr);
14951 return JIM_OK;
14954 char **Jim_GetEnviron(void)
14956 #if defined(HAVE__NSGETENVIRON)
14957 return *_NSGetEnviron();
14958 #else
14959 #if !defined(NO_ENVIRON_EXTERN)
14960 extern char **environ;
14961 #endif
14963 return environ;
14964 #endif
14967 void Jim_SetEnviron(char **env)
14969 #if defined(HAVE__NSGETENVIRON)
14970 *_NSGetEnviron() = env;
14971 #else
14972 #if !defined(NO_ENVIRON_EXTERN)
14973 extern char **environ;
14974 #endif
14976 environ = env;
14977 #endif
14980 /* [env] */
14981 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14983 const char *key;
14984 const char *val;
14986 if (argc == 1) {
14987 char **e = Jim_GetEnviron();
14989 int i;
14990 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14992 for (i = 0; e[i]; i++) {
14993 const char *equals = strchr(e[i], '=');
14995 if (equals) {
14996 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14997 equals - e[i]));
14998 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15002 Jim_SetResult(interp, listObjPtr);
15003 return JIM_OK;
15006 if (argc < 2) {
15007 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15008 return JIM_ERR;
15010 key = Jim_String(argv[1]);
15011 val = getenv(key);
15012 if (val == NULL) {
15013 if (argc < 3) {
15014 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15015 return JIM_ERR;
15017 val = Jim_String(argv[2]);
15019 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15020 return JIM_OK;
15023 /* [source] */
15024 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15026 int retval;
15028 if (argc != 2) {
15029 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15030 return JIM_ERR;
15032 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15033 if (retval == JIM_RETURN)
15034 return JIM_OK;
15035 return retval;
15038 /* [lreverse] */
15039 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15041 Jim_Obj *revObjPtr, **ele;
15042 int len;
15044 if (argc != 2) {
15045 Jim_WrongNumArgs(interp, 1, argv, "list");
15046 return JIM_ERR;
15048 JimListGetElements(interp, argv[1], &len, &ele);
15049 len--;
15050 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15051 while (len >= 0)
15052 ListAppendElement(revObjPtr, ele[len--]);
15053 Jim_SetResult(interp, revObjPtr);
15054 return JIM_OK;
15057 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15059 jim_wide len;
15061 if (step == 0)
15062 return -1;
15063 if (start == end)
15064 return 0;
15065 else if (step > 0 && start > end)
15066 return -1;
15067 else if (step < 0 && end > start)
15068 return -1;
15069 len = end - start;
15070 if (len < 0)
15071 len = -len; /* abs(len) */
15072 if (step < 0)
15073 step = -step; /* abs(step) */
15074 len = 1 + ((len - 1) / step);
15075 /* We can truncate safely to INT_MAX, the range command
15076 * will always return an error for a such long range
15077 * because Tcl lists can't be so long. */
15078 if (len > INT_MAX)
15079 len = INT_MAX;
15080 return (int)((len < 0) ? -1 : len);
15083 /* [range] */
15084 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15086 jim_wide start = 0, end, step = 1;
15087 int len, i;
15088 Jim_Obj *objPtr;
15090 if (argc < 2 || argc > 4) {
15091 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15092 return JIM_ERR;
15094 if (argc == 2) {
15095 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15096 return JIM_ERR;
15098 else {
15099 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15100 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15101 return JIM_ERR;
15102 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15103 return JIM_ERR;
15105 if ((len = JimRangeLen(start, end, step)) == -1) {
15106 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15107 return JIM_ERR;
15109 objPtr = Jim_NewListObj(interp, NULL, 0);
15110 for (i = 0; i < len; i++)
15111 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15112 Jim_SetResult(interp, objPtr);
15113 return JIM_OK;
15116 /* [rand] */
15117 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15119 jim_wide min = 0, max = 0, len, maxMul;
15121 if (argc < 1 || argc > 3) {
15122 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15123 return JIM_ERR;
15125 if (argc == 1) {
15126 max = JIM_WIDE_MAX;
15127 } else if (argc == 2) {
15128 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15129 return JIM_ERR;
15130 } else if (argc == 3) {
15131 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15132 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15133 return JIM_ERR;
15135 len = max-min;
15136 if (len < 0) {
15137 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15138 return JIM_ERR;
15140 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15141 while (1) {
15142 jim_wide r;
15144 JimRandomBytes(interp, &r, sizeof(jim_wide));
15145 if (r < 0 || r >= maxMul) continue;
15146 r = (len == 0) ? 0 : r%len;
15147 Jim_SetResultInt(interp, min+r);
15148 return JIM_OK;
15152 static const struct {
15153 const char *name;
15154 Jim_CmdProc *cmdProc;
15155 } Jim_CoreCommandsTable[] = {
15156 {"alias", Jim_AliasCoreCommand},
15157 {"set", Jim_SetCoreCommand},
15158 {"unset", Jim_UnsetCoreCommand},
15159 {"puts", Jim_PutsCoreCommand},
15160 {"+", Jim_AddCoreCommand},
15161 {"*", Jim_MulCoreCommand},
15162 {"-", Jim_SubCoreCommand},
15163 {"/", Jim_DivCoreCommand},
15164 {"incr", Jim_IncrCoreCommand},
15165 {"while", Jim_WhileCoreCommand},
15166 {"loop", Jim_LoopCoreCommand},
15167 {"for", Jim_ForCoreCommand},
15168 {"foreach", Jim_ForeachCoreCommand},
15169 {"lmap", Jim_LmapCoreCommand},
15170 {"lassign", Jim_LassignCoreCommand},
15171 {"if", Jim_IfCoreCommand},
15172 {"switch", Jim_SwitchCoreCommand},
15173 {"list", Jim_ListCoreCommand},
15174 {"lindex", Jim_LindexCoreCommand},
15175 {"lset", Jim_LsetCoreCommand},
15176 {"lsearch", Jim_LsearchCoreCommand},
15177 {"llength", Jim_LlengthCoreCommand},
15178 {"lappend", Jim_LappendCoreCommand},
15179 {"linsert", Jim_LinsertCoreCommand},
15180 {"lreplace", Jim_LreplaceCoreCommand},
15181 {"lsort", Jim_LsortCoreCommand},
15182 {"append", Jim_AppendCoreCommand},
15183 {"debug", Jim_DebugCoreCommand},
15184 {"eval", Jim_EvalCoreCommand},
15185 {"uplevel", Jim_UplevelCoreCommand},
15186 {"expr", Jim_ExprCoreCommand},
15187 {"break", Jim_BreakCoreCommand},
15188 {"continue", Jim_ContinueCoreCommand},
15189 {"proc", Jim_ProcCoreCommand},
15190 {"concat", Jim_ConcatCoreCommand},
15191 {"return", Jim_ReturnCoreCommand},
15192 {"upvar", Jim_UpvarCoreCommand},
15193 {"global", Jim_GlobalCoreCommand},
15194 {"string", Jim_StringCoreCommand},
15195 {"time", Jim_TimeCoreCommand},
15196 {"exit", Jim_ExitCoreCommand},
15197 {"catch", Jim_CatchCoreCommand},
15198 #ifdef JIM_REFERENCES
15199 {"ref", Jim_RefCoreCommand},
15200 {"getref", Jim_GetrefCoreCommand},
15201 {"setref", Jim_SetrefCoreCommand},
15202 {"finalize", Jim_FinalizeCoreCommand},
15203 {"collect", Jim_CollectCoreCommand},
15204 #endif
15205 {"rename", Jim_RenameCoreCommand},
15206 {"dict", Jim_DictCoreCommand},
15207 {"subst", Jim_SubstCoreCommand},
15208 {"info", Jim_InfoCoreCommand},
15209 {"exists", Jim_ExistsCoreCommand},
15210 {"split", Jim_SplitCoreCommand},
15211 {"join", Jim_JoinCoreCommand},
15212 {"format", Jim_FormatCoreCommand},
15213 {"scan", Jim_ScanCoreCommand},
15214 {"error", Jim_ErrorCoreCommand},
15215 {"lrange", Jim_LrangeCoreCommand},
15216 {"lrepeat", Jim_LrepeatCoreCommand},
15217 {"env", Jim_EnvCoreCommand},
15218 {"source", Jim_SourceCoreCommand},
15219 {"lreverse", Jim_LreverseCoreCommand},
15220 {"range", Jim_RangeCoreCommand},
15221 {"rand", Jim_RandCoreCommand},
15222 {"tailcall", Jim_TailcallCoreCommand},
15223 {"local", Jim_LocalCoreCommand},
15224 {"upcall", Jim_UpcallCoreCommand},
15225 {"apply", Jim_ApplyCoreCommand},
15226 {NULL, NULL},
15229 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15231 int i = 0;
15233 while (Jim_CoreCommandsTable[i].name != NULL) {
15234 Jim_CreateCommand(interp,
15235 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15236 i++;
15240 /* -----------------------------------------------------------------------------
15241 * Interactive prompt
15242 * ---------------------------------------------------------------------------*/
15243 void Jim_MakeErrorMessage(Jim_Interp *interp)
15245 Jim_Obj *argv[2];
15247 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15248 argv[1] = interp->result;
15250 Jim_EvalObjVector(interp, 2, argv);
15253 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15254 const char *prefix, const char *const *tablePtr, const char *name)
15256 int count;
15257 char **tablePtrSorted;
15258 int i;
15260 for (count = 0; tablePtr[count]; count++) {
15263 if (name == NULL) {
15264 name = "option";
15267 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15268 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15269 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15270 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15271 for (i = 0; i < count; i++) {
15272 if (i + 1 == count && count > 1) {
15273 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15275 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15276 if (i + 1 != count) {
15277 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15280 Jim_Free(tablePtrSorted);
15283 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15284 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15286 const char *bad = "bad ";
15287 const char *const *entryPtr = NULL;
15288 int i;
15289 int match = -1;
15290 int arglen;
15291 const char *arg = Jim_GetString(objPtr, &arglen);
15293 *indexPtr = -1;
15295 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15296 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15297 /* Found an exact match */
15298 *indexPtr = i;
15299 return JIM_OK;
15301 if (flags & JIM_ENUM_ABBREV) {
15302 /* Accept an unambiguous abbreviation.
15303 * Note that '-' doesnt' consitute a valid abbreviation
15305 if (strncmp(arg, *entryPtr, arglen) == 0) {
15306 if (*arg == '-' && arglen == 1) {
15307 break;
15309 if (match >= 0) {
15310 bad = "ambiguous ";
15311 goto ambiguous;
15313 match = i;
15318 /* If we had an unambiguous partial match */
15319 if (match >= 0) {
15320 *indexPtr = match;
15321 return JIM_OK;
15324 ambiguous:
15325 if (flags & JIM_ERRMSG) {
15326 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15328 return JIM_ERR;
15331 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15333 int i;
15335 for (i = 0; i < (int)len; i++) {
15336 if (array[i] && strcmp(array[i], name) == 0) {
15337 return i;
15340 return -1;
15343 int Jim_IsDict(Jim_Obj *objPtr)
15345 return objPtr->typePtr == &dictObjType;
15348 int Jim_IsList(Jim_Obj *objPtr)
15350 return objPtr->typePtr == &listObjType;
15354 * Very simple printf-like formatting, designed for error messages.
15356 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15357 * The resulting string is created and set as the result.
15359 * Each '%s' should correspond to a regular string parameter.
15360 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15361 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15363 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15365 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15367 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15369 /* Initial space needed */
15370 int len = strlen(format);
15371 int extra = 0;
15372 int n = 0;
15373 const char *params[5];
15374 char *buf;
15375 va_list args;
15376 int i;
15378 va_start(args, format);
15380 for (i = 0; i < len && n < 5; i++) {
15381 int l;
15383 if (strncmp(format + i, "%s", 2) == 0) {
15384 params[n] = va_arg(args, char *);
15386 l = strlen(params[n]);
15388 else if (strncmp(format + i, "%#s", 3) == 0) {
15389 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15391 params[n] = Jim_GetString(objPtr, &l);
15393 else {
15394 if (format[i] == '%') {
15395 i++;
15397 continue;
15399 n++;
15400 extra += l;
15403 len += extra;
15404 buf = Jim_Alloc(len + 1);
15405 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15407 va_end(args);
15409 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15412 /* stubs */
15413 #ifndef jim_ext_package
15414 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15416 return JIM_OK;
15418 #endif
15419 #ifndef jim_ext_aio
15420 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15422 Jim_SetResultString(interp, "aio not enabled", -1);
15423 return NULL;
15425 #endif
15429 * Local Variables: ***
15430 * c-basic-offset: 4 ***
15431 * tab-width: 4 ***
15432 * End: ***