Fix memory management of aio event handlers
[jimtcl.git] / jim.c
blob3177c104413a78c0ee23e32713aaf25ce00e314c
2 /* Jim - A small embeddable Tcl interpreter
4 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
5 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
7 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
8 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
9 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
10 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
11 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
12 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
13 * Copyright 2009 Zachary T Welch zw@superlucidity.net
14 * Copyright 2009 David Brownell
16 * Redistribution and use in source and binary forms, with or without
17 * modification, are permitted provided that the following conditions
18 * are met:
20 * 1. Redistributions of source code must retain the above copyright
21 * notice, this list of conditions and the following disclaimer.
22 * 2. Redistributions in binary form must reproduce the above
23 * copyright notice, this list of conditions and the following
24 * disclaimer in the documentation and/or other materials
25 * provided with the distribution.
27 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
28 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
29 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
30 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
31 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
32 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
33 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
34 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
35 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
36 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
37 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
38 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
40 * The views and conclusions contained in the software and documentation
41 * are those of the authors and should not be interpreted as representing
42 * official policies, either expressed or implied, of the Jim Tcl Project.
43 **/
44 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
46 #include <stdio.h>
47 #include <stdlib.h>
49 #include <string.h>
50 #include <stdarg.h>
51 #include <ctype.h>
52 #include <limits.h>
53 #include <assert.h>
54 #include <errno.h>
55 #include <time.h>
56 #include <setjmp.h>
58 #include "jim.h"
59 #include "jimautoconf.h"
60 #include "utf8.h"
62 #ifdef HAVE_SYS_TIME_H
63 #include <sys/time.h>
64 #endif
65 #ifdef HAVE_BACKTRACE
66 #include <execinfo.h>
67 #endif
68 #ifdef HAVE_CRT_EXTERNS_H
69 #include <crt_externs.h>
70 #endif
72 /* For INFINITY, even if math functions are not enabled */
73 #include <math.h>
75 /* We may decide to switch to using $[...] after all, so leave it as an option */
76 /*#define EXPRSUGAR_BRACKET*/
78 /* For the no-autoconf case */
79 #ifndef TCL_LIBRARY
80 #define TCL_LIBRARY "."
81 #endif
82 #ifndef TCL_PLATFORM_OS
83 #define TCL_PLATFORM_OS "unknown"
84 #endif
85 #ifndef TCL_PLATFORM_PLATFORM
86 #define TCL_PLATFORM_PLATFORM "unknown"
87 #endif
88 #ifndef TCL_PLATFORM_PATH_SEPARATOR
89 #define TCL_PLATFORM_PATH_SEPARATOR ":"
90 #endif
92 /*#define DEBUG_SHOW_SCRIPT*/
93 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
94 /*#define DEBUG_SHOW_SUBST*/
95 /*#define DEBUG_SHOW_EXPR*/
96 /*#define DEBUG_SHOW_EXPR_TOKENS*/
97 /*#define JIM_DEBUG_GC*/
98 #ifdef JIM_MAINTAINER
99 #define JIM_DEBUG_COMMAND
100 #define JIM_DEBUG_PANIC
101 #endif
102 /* Enable this (in conjunction with valgrind) to help debug
103 * reference counting issues
105 /*#define JIM_DISABLE_OBJECT_POOL*/
107 /* Maximum size of an integer */
108 #define JIM_INTEGER_SPACE 24
110 const char *jim_tt_name(int type);
112 #ifdef JIM_DEBUG_PANIC
113 static void JimPanicDump(int panic_condition, const char *fmt, ...);
114 #define JimPanic(X) JimPanicDump X
115 #else
116 #define JimPanic(X)
117 #endif
119 /* -----------------------------------------------------------------------------
120 * Global variables
121 * ---------------------------------------------------------------------------*/
123 /* A shared empty string for the objects string representation.
124 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
125 static char JimEmptyStringRep[] = "";
127 /* -----------------------------------------------------------------------------
128 * Required prototypes of not exported functions
129 * ---------------------------------------------------------------------------*/
130 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
131 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
132 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
133 int flags);
134 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
135 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
136 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
137 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
138 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
139 const char *prefix, const char *const *tablePtr, const char *name);
140 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
141 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
142 static int JimSign(jim_wide w);
143 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
144 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
145 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
148 /* Fast access to the int (wide) value of an object which is known to be of int type */
149 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
151 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
153 static int utf8_tounicode_case(const char *s, int *uc, int upper)
155 int l = utf8_tounicode(s, uc);
156 if (upper) {
157 *uc = utf8_upper(*uc);
159 return l;
162 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
163 #define JIM_CHARSET_SCAN 2
164 #define JIM_CHARSET_GLOB 0
167 * pattern points to a string like "[^a-z\ub5]"
169 * The pattern may contain trailing chars, which are ignored.
171 * The pattern is matched against unicode char 'c'.
173 * If (flags & JIM_NOCASE), case is ignored when matching.
174 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
175 * of the charset, per scan, rather than glob/string match.
177 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
178 * or the null character if the ']' is missing.
180 * Returns NULL on no match.
182 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
184 int not = 0;
185 int pchar;
186 int match = 0;
187 int nocase = 0;
189 if (flags & JIM_NOCASE) {
190 nocase++;
191 c = utf8_upper(c);
194 if (flags & JIM_CHARSET_SCAN) {
195 if (*pattern == '^') {
196 not++;
197 pattern++;
200 /* Special case. If the first char is ']', it is part of the set */
201 if (*pattern == ']') {
202 goto first;
206 while (*pattern && *pattern != ']') {
207 /* Exact match */
208 if (pattern[0] == '\\') {
209 first:
210 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
212 else {
213 /* Is this a range? a-z */
214 int start;
215 int end;
217 pattern += utf8_tounicode_case(pattern, &start, nocase);
218 if (pattern[0] == '-' && pattern[1]) {
219 /* skip '-' */
220 pattern += utf8_tounicode(pattern, &pchar);
221 pattern += utf8_tounicode_case(pattern, &end, nocase);
223 /* Handle reversed range too */
224 if ((c >= start && c <= end) || (c >= end && c <= start)) {
225 match = 1;
227 continue;
229 pchar = start;
232 if (pchar == c) {
233 match = 1;
236 if (not) {
237 match = !match;
240 return match ? pattern : NULL;
243 /* Glob-style pattern matching. */
245 /* Note: string *must* be valid UTF-8 sequences
247 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
249 int c;
250 int pchar;
251 while (*pattern) {
252 switch (pattern[0]) {
253 case '*':
254 while (pattern[1] == '*') {
255 pattern++;
257 pattern++;
258 if (!pattern[0]) {
259 return 1; /* match */
261 while (*string) {
262 /* Recursive call - Does the remaining pattern match anywhere? */
263 if (JimGlobMatch(pattern, string, nocase))
264 return 1; /* match */
265 string += utf8_tounicode(string, &c);
267 return 0; /* no match */
269 case '?':
270 string += utf8_tounicode(string, &c);
271 break;
273 case '[': {
274 string += utf8_tounicode(string, &c);
275 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
276 if (!pattern) {
277 return 0;
279 if (!*pattern) {
280 /* Ran out of pattern (no ']') */
281 continue;
283 break;
285 case '\\':
286 if (pattern[1]) {
287 pattern++;
289 /* fall through */
290 default:
291 string += utf8_tounicode_case(string, &c, nocase);
292 utf8_tounicode_case(pattern, &pchar, nocase);
293 if (pchar != c) {
294 return 0;
296 break;
298 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
299 if (!*string) {
300 while (*pattern == '*') {
301 pattern++;
303 break;
306 if (!*pattern && !*string) {
307 return 1;
309 return 0;
313 * string comparison works on binary data.
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 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
338 while (*s1 && *s2 && maxchars) {
339 int c1, c2;
340 s1 += utf8_tounicode_case(s1, &c1, nocase);
341 s2 += utf8_tounicode_case(s2, &c2, nocase);
342 if (c1 != c2) {
343 return JimSign(c1 - c2);
345 maxchars--;
347 if (!maxchars) {
348 return 0;
350 /* One string or both terminated */
351 if (*s1) {
352 return 1;
354 if (*s2) {
355 return -1;
357 return 0;
360 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
361 * The index of the first occurrence of s1 in s2 is returned.
362 * If s1 is not found inside s2, -1 is returned. */
363 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
365 int i;
366 int l1bytelen;
368 if (!l1 || !l2 || l1 > l2) {
369 return -1;
371 if (idx < 0)
372 idx = 0;
373 s2 += utf8_index(s2, idx);
375 l1bytelen = utf8_index(s1, l1);
377 for (i = idx; i <= l2 - l1; i++) {
378 int c;
379 if (memcmp(s2, s1, l1bytelen) == 0) {
380 return i;
382 s2 += utf8_tounicode(s2, &c);
384 return -1;
388 * Note: Lengths and return value are in bytes, not chars.
390 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
392 const char *p;
394 if (!l1 || !l2 || l1 > l2)
395 return -1;
397 /* Now search for the needle */
398 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
399 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
400 return p - s2;
403 return -1;
406 #ifdef JIM_UTF8
408 * Note: Lengths and return value are in chars.
410 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
412 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
413 if (n > 0) {
414 n = utf8_strlen(s2, n);
416 return n;
418 #endif
420 static int JimWideToString(char *buf, jim_wide wideValue)
422 int pos = 0;
424 if (wideValue == 0) {
425 buf[pos++] = '0';
427 else {
428 char tmp[JIM_INTEGER_SPACE];
429 int num = 0;
430 int i;
432 if (wideValue < 0) {
433 buf[pos++] = '-';
434 /* -106 % 10 may be -6 or 4! */
435 i = wideValue % 10;
436 tmp[num++] = (i > 0) ? (10 - i) : -i;
437 wideValue /= -10;
440 while (wideValue) {
441 tmp[num++] = wideValue % 10;
442 wideValue /= 10;
445 for (i = 0; i < num; i++) {
446 buf[pos++] = '0' + tmp[num - i - 1];
449 buf[pos] = 0;
451 return pos;
455 * After an strtol()/strtod()-like conversion,
456 * check whether something was converted and that
457 * the only thing left is white space.
459 * Returns JIM_OK or JIM_ERR.
461 static int JimCheckConversion(const char *str, const char *endptr)
463 if (str[0] == '\0' || str == endptr) {
464 return JIM_ERR;
467 if (endptr[0] != '\0') {
468 while (*endptr) {
469 if (!isspace(UCHAR(*endptr))) {
470 return JIM_ERR;
472 endptr++;
475 return JIM_OK;
478 /* Parses the front of a number to determine it's sign and base
479 * Returns the index to start parsing according to the given base
481 static int JimNumberBase(const char *str, int *base, int *sign)
483 int i = 0;
485 *base = 10;
487 while (isspace(UCHAR(str[i]))) {
488 i++;
491 if (str[i] == '-') {
492 *sign = -1;
493 i++;
495 else {
496 if (str[i] == '+') {
497 i++;
499 *sign = 1;
502 if (str[i] != '0') {
503 /* base 10 */
504 return 0;
507 /* We have 0<x>, so see if we can convert it */
508 switch (str[i + 1]) {
509 case 'x': case 'X': *base = 16; break;
510 case 'o': case 'O': *base = 8; break;
511 case 'b': case 'B': *base = 2; break;
512 default: return 0;
514 i += 2;
515 /* Ensure that (e.g.) 0x-5 fails to parse */
516 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
517 /* Parse according to this base */
518 return i;
520 /* Parse as base 10 */
521 *base = 10;
522 return 0;
525 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
526 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
528 static long jim_strtol(const char *str, char **endptr)
530 int sign;
531 int base;
532 int i = JimNumberBase(str, &base, &sign);
534 if (base != 10) {
535 long value = strtol(str + i, endptr, base);
536 if (endptr == NULL || *endptr != str + i) {
537 return value * sign;
541 /* Can just do a regular base-10 conversion */
542 return strtol(str, endptr, 10);
546 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
547 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
549 static jim_wide jim_strtoull(const char *str, char **endptr)
551 #ifdef HAVE_LONG_LONG
552 int sign;
553 int base;
554 int i = JimNumberBase(str, &base, &sign);
556 if (base != 10) {
557 jim_wide value = strtoull(str + i, endptr, base);
558 if (endptr == NULL || *endptr != str + i) {
559 return value * sign;
563 /* Can just do a regular base-10 conversion */
564 return strtoull(str, endptr, 10);
565 #else
566 return (unsigned long)jim_strtol(str, endptr);
567 #endif
570 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
572 char *endptr;
574 if (base) {
575 *widePtr = strtoull(str, &endptr, base);
577 else {
578 *widePtr = jim_strtoull(str, &endptr);
581 return JimCheckConversion(str, endptr);
584 int Jim_DoubleToString(char *buf, double doubleValue)
586 int len;
587 int i;
589 len = sprintf(buf, "%.12g", doubleValue);
591 /* Add a final ".0" if necessary */
592 for (i = 0; i < len; i++) {
593 if (buf[i] == '.' || buf[i] == 'e') {
594 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
595 /* If 'buf' ends in e-0nn or e+0nn, remove
596 * the 0 after the + or - and reduce the length by 1
598 char *e = strchr(buf, 'e');
599 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
600 /* Move it up */
601 e += 2;
602 memmove(e, e + 1, len - (e - buf));
603 return len - 1;
605 #endif
606 return len;
608 /* inf or Infinity -> Inf, nan -> Nan */
609 if (buf[i] == 'i' || buf[i] == 'I' || buf[i] == 'n' || buf[i] == 'N') {
610 buf[i] = toupper(UCHAR(buf[i]));
611 buf[i + 3] = 0;
612 return i + 3;
616 buf[i++] = '.';
617 buf[i++] = '0';
618 buf[i] = '\0';
620 return i;
623 int Jim_StringToDouble(const char *str, double *doublePtr)
625 char *endptr;
627 /* Callers can check for underflow via ERANGE */
628 errno = 0;
630 *doublePtr = strtod(str, &endptr);
632 return JimCheckConversion(str, endptr);
635 static jim_wide JimPowWide(jim_wide b, jim_wide e)
637 jim_wide i, res = 1;
639 if ((b == 0 && e != 0) || (e < 0))
640 return 0;
641 for (i = 0; i < e; i++) {
642 res *= b;
644 return res;
647 /* -----------------------------------------------------------------------------
648 * Special functions
649 * ---------------------------------------------------------------------------*/
650 #ifdef JIM_DEBUG_PANIC
651 void JimPanicDump(int condition, const char *fmt, ...)
653 va_list ap;
655 if (!condition) {
656 return;
659 va_start(ap, fmt);
661 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
662 vfprintf(stderr, fmt, ap);
663 fprintf(stderr, JIM_NL JIM_NL);
664 va_end(ap);
666 #ifdef HAVE_BACKTRACE
668 void *array[40];
669 int size, i;
670 char **strings;
672 size = backtrace(array, 40);
673 strings = backtrace_symbols(array, size);
674 for (i = 0; i < size; i++)
675 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
676 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
677 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
679 #endif
681 exit(1);
683 #endif
685 /* -----------------------------------------------------------------------------
686 * Memory allocation
687 * ---------------------------------------------------------------------------*/
689 void *Jim_Alloc(int size)
691 return size ? malloc(size) : NULL;
694 void Jim_Free(void *ptr)
696 free(ptr);
699 void *Jim_Realloc(void *ptr, int size)
701 return realloc(ptr, size);
704 char *Jim_StrDup(const char *s)
706 return strdup(s);
709 char *Jim_StrDupLen(const char *s, int l)
711 char *copy = Jim_Alloc(l + 1);
713 memcpy(copy, s, l + 1);
714 copy[l] = 0; /* Just to be sure, original could be substring */
715 return copy;
718 /* -----------------------------------------------------------------------------
719 * Time related functions
720 * ---------------------------------------------------------------------------*/
722 /* Returns microseconds of CPU used since start. */
723 static jim_wide JimClock(void)
725 struct timeval tv;
727 gettimeofday(&tv, NULL);
728 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
731 /* -----------------------------------------------------------------------------
732 * Hash Tables
733 * ---------------------------------------------------------------------------*/
735 /* -------------------------- private prototypes ---------------------------- */
736 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
737 static unsigned int JimHashTableNextPower(unsigned int size);
738 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
740 /* -------------------------- hash functions -------------------------------- */
742 /* Thomas Wang's 32 bit Mix Function */
743 unsigned int Jim_IntHashFunction(unsigned int key)
745 key += ~(key << 15);
746 key ^= (key >> 10);
747 key += (key << 3);
748 key ^= (key >> 6);
749 key += ~(key << 11);
750 key ^= (key >> 16);
751 return key;
754 /* Generic hash function (we are using to multiply by 9 and add the byte
755 * as Tcl) */
756 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
758 unsigned int h = 0;
760 while (len--)
761 h += (h << 3) + *buf++;
762 return h;
765 /* ----------------------------- API implementation ------------------------- */
767 /* reset a hashtable already initialized with ht_init().
768 * NOTE: This function should only called by ht_destroy(). */
769 static void JimResetHashTable(Jim_HashTable *ht)
771 ht->table = NULL;
772 ht->size = 0;
773 ht->sizemask = 0;
774 ht->used = 0;
775 ht->collisions = 0;
778 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
780 iter->ht = ht;
781 iter->index = -1;
782 iter->entry = NULL;
783 iter->nextEntry = NULL;
786 /* Initialize the hash table */
787 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
789 JimResetHashTable(ht);
790 ht->type = type;
791 ht->privdata = privDataPtr;
792 return JIM_OK;
795 /* Resize the table to the minimal size that contains all the elements,
796 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
797 void Jim_ResizeHashTable(Jim_HashTable *ht)
799 int minimal = ht->used;
801 if (minimal < JIM_HT_INITIAL_SIZE)
802 minimal = JIM_HT_INITIAL_SIZE;
803 Jim_ExpandHashTable(ht, minimal);
806 /* Expand or create the hashtable */
807 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
809 Jim_HashTable n; /* the new hashtable */
810 unsigned int realsize = JimHashTableNextPower(size), i;
812 /* the size is invalid if it is smaller than the number of
813 * elements already inside the hashtable */
814 if (size <= ht->used)
815 return;
817 Jim_InitHashTable(&n, ht->type, ht->privdata);
818 n.size = realsize;
819 n.sizemask = realsize - 1;
820 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
822 /* Initialize all the pointers to NULL */
823 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
825 /* Copy all the elements from the old to the new table:
826 * note that if the old hash table is empty ht->used is zero,
827 * so Jim_ExpandHashTable just creates an empty hash table. */
828 n.used = ht->used;
829 for (i = 0; ht->used > 0; i++) {
830 Jim_HashEntry *he, *nextHe;
832 if (ht->table[i] == NULL)
833 continue;
835 /* For each hash entry on this slot... */
836 he = ht->table[i];
837 while (he) {
838 unsigned int h;
840 nextHe = he->next;
841 /* Get the new element index */
842 h = Jim_HashKey(ht, he->key) & n.sizemask;
843 he->next = n.table[h];
844 n.table[h] = he;
845 ht->used--;
846 /* Pass to the next element */
847 he = nextHe;
850 assert(ht->used == 0);
851 Jim_Free(ht->table);
853 /* Remap the new hashtable in the old */
854 *ht = n;
857 /* Add an element to the target hash table */
858 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
860 Jim_HashEntry *entry;
862 /* Get the index of the new element, or -1 if
863 * the element already exists. */
864 entry = JimInsertHashEntry(ht, key, 0);
865 if (entry == NULL)
866 return JIM_ERR;
868 /* Set the hash entry fields. */
869 Jim_SetHashKey(ht, entry, key);
870 Jim_SetHashVal(ht, entry, val);
871 return JIM_OK;
874 /* Add an element, discarding the old if the key already exists */
875 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
877 int existed;
878 Jim_HashEntry *entry;
880 /* Get the index of the new element, or -1 if
881 * the element already exists. */
882 entry = JimInsertHashEntry(ht, key, 1);
883 if (entry->key) {
884 /* It already exists, so replace the value */
885 Jim_FreeEntryVal(ht, entry);
886 existed = 1;
888 else {
889 /* Doesn't exist, so set the key */
890 Jim_SetHashKey(ht, entry, key);
891 existed = 0;
893 Jim_SetHashVal(ht, entry, val);
895 return existed;
898 /* Search and remove an element */
899 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
901 unsigned int h;
902 Jim_HashEntry *he, *prevHe;
904 if (ht->used == 0)
905 return JIM_ERR;
906 h = Jim_HashKey(ht, key) & ht->sizemask;
907 he = ht->table[h];
909 prevHe = NULL;
910 while (he) {
911 if (Jim_CompareHashKeys(ht, key, he->key)) {
912 /* Unlink the element from the list */
913 if (prevHe)
914 prevHe->next = he->next;
915 else
916 ht->table[h] = he->next;
917 Jim_FreeEntryKey(ht, he);
918 Jim_FreeEntryVal(ht, he);
919 Jim_Free(he);
920 ht->used--;
921 return JIM_OK;
923 prevHe = he;
924 he = he->next;
926 return JIM_ERR; /* not found */
929 /* Destroy an entire hash table */
930 int Jim_FreeHashTable(Jim_HashTable *ht)
932 unsigned int i;
934 /* Free all the elements */
935 for (i = 0; ht->used > 0; i++) {
936 Jim_HashEntry *he, *nextHe;
938 if ((he = ht->table[i]) == NULL)
939 continue;
940 while (he) {
941 nextHe = he->next;
942 Jim_FreeEntryKey(ht, he);
943 Jim_FreeEntryVal(ht, he);
944 Jim_Free(he);
945 ht->used--;
946 he = nextHe;
949 /* Free the table and the allocated cache structure */
950 Jim_Free(ht->table);
951 /* Re-initialize the table */
952 JimResetHashTable(ht);
953 return JIM_OK; /* never fails */
956 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
958 Jim_HashEntry *he;
959 unsigned int h;
961 if (ht->used == 0)
962 return NULL;
963 h = Jim_HashKey(ht, key) & ht->sizemask;
964 he = ht->table[h];
965 while (he) {
966 if (Jim_CompareHashKeys(ht, key, he->key))
967 return he;
968 he = he->next;
970 return NULL;
973 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
975 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
976 JimInitHashTableIterator(ht, iter);
977 return iter;
980 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
982 while (1) {
983 if (iter->entry == NULL) {
984 iter->index++;
985 if (iter->index >= (signed)iter->ht->size)
986 break;
987 iter->entry = iter->ht->table[iter->index];
989 else {
990 iter->entry = iter->nextEntry;
992 if (iter->entry) {
993 /* We need to save the 'next' here, the iterator user
994 * may delete the entry we are returning. */
995 iter->nextEntry = iter->entry->next;
996 return iter->entry;
999 return NULL;
1002 /* ------------------------- private functions ------------------------------ */
1004 /* Expand the hash table if needed */
1005 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
1007 /* If the hash table is empty expand it to the intial size,
1008 * if the table is "full" dobule its size. */
1009 if (ht->size == 0)
1010 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
1011 if (ht->size == ht->used)
1012 Jim_ExpandHashTable(ht, ht->size * 2);
1015 /* Our hash table capability is a power of two */
1016 static unsigned int JimHashTableNextPower(unsigned int size)
1018 unsigned int i = JIM_HT_INITIAL_SIZE;
1020 if (size >= 2147483648U)
1021 return 2147483648U;
1022 while (1) {
1023 if (i >= size)
1024 return i;
1025 i *= 2;
1029 /* Returns the index of a free slot that can be populated with
1030 * an hash entry for the given 'key'.
1031 * If the key already exists, -1 is returned. */
1032 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1034 unsigned int h;
1035 Jim_HashEntry *he;
1037 /* Expand the hashtable if needed */
1038 JimExpandHashTableIfNeeded(ht);
1040 /* Compute the key hash value */
1041 h = Jim_HashKey(ht, key) & ht->sizemask;
1042 /* Search if this slot does not already contain the given key */
1043 he = ht->table[h];
1044 while (he) {
1045 if (Jim_CompareHashKeys(ht, key, he->key))
1046 return replace ? he : NULL;
1047 he = he->next;
1050 /* Allocates the memory and stores key */
1051 he = Jim_Alloc(sizeof(*he));
1052 he->next = ht->table[h];
1053 ht->table[h] = he;
1054 ht->used++;
1055 he->key = NULL;
1057 return he;
1060 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1062 static unsigned int JimStringCopyHTHashFunction(const void *key)
1064 return Jim_GenHashFunction(key, strlen(key));
1067 static void *JimStringCopyHTDup(void *privdata, const void *key)
1069 return strdup(key);
1072 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1074 return strcmp(key1, key2) == 0;
1077 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1079 Jim_Free(key);
1082 static const Jim_HashTableType JimPackageHashTableType = {
1083 JimStringCopyHTHashFunction, /* hash function */
1084 JimStringCopyHTDup, /* key dup */
1085 NULL, /* val dup */
1086 JimStringCopyHTKeyCompare, /* key compare */
1087 JimStringCopyHTKeyDestructor, /* key destructor */
1088 NULL /* val destructor */
1091 typedef struct AssocDataValue
1093 Jim_InterpDeleteProc *delProc;
1094 void *data;
1095 } AssocDataValue;
1097 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1099 AssocDataValue *assocPtr = (AssocDataValue *) data;
1101 if (assocPtr->delProc != NULL)
1102 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1103 Jim_Free(data);
1106 static const Jim_HashTableType JimAssocDataHashTableType = {
1107 JimStringCopyHTHashFunction, /* hash function */
1108 JimStringCopyHTDup, /* key dup */
1109 NULL, /* val dup */
1110 JimStringCopyHTKeyCompare, /* key compare */
1111 JimStringCopyHTKeyDestructor, /* key destructor */
1112 JimAssocDataHashTableValueDestructor /* val destructor */
1115 /* -----------------------------------------------------------------------------
1116 * Stack - This is a simple generic stack implementation. It is used for
1117 * example in the 'expr' expression compiler.
1118 * ---------------------------------------------------------------------------*/
1119 void Jim_InitStack(Jim_Stack *stack)
1121 stack->len = 0;
1122 stack->maxlen = 0;
1123 stack->vector = NULL;
1126 void Jim_FreeStack(Jim_Stack *stack)
1128 Jim_Free(stack->vector);
1131 int Jim_StackLen(Jim_Stack *stack)
1133 return stack->len;
1136 void Jim_StackPush(Jim_Stack *stack, void *element)
1138 int neededLen = stack->len + 1;
1140 if (neededLen > stack->maxlen) {
1141 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1142 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1144 stack->vector[stack->len] = element;
1145 stack->len++;
1148 void *Jim_StackPop(Jim_Stack *stack)
1150 if (stack->len == 0)
1151 return NULL;
1152 stack->len--;
1153 return stack->vector[stack->len];
1156 void *Jim_StackPeek(Jim_Stack *stack)
1158 if (stack->len == 0)
1159 return NULL;
1160 return stack->vector[stack->len - 1];
1163 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1165 int i;
1167 for (i = 0; i < stack->len; i++)
1168 freeFunc(stack->vector[i]);
1171 /* -----------------------------------------------------------------------------
1172 * Parser
1173 * ---------------------------------------------------------------------------*/
1175 /* Token types */
1176 #define JIM_TT_NONE 0 /* No token returned */
1177 #define JIM_TT_STR 1 /* simple string */
1178 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1179 #define JIM_TT_VAR 3 /* var substitution */
1180 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1181 #define JIM_TT_CMD 5 /* command substitution */
1182 /* Note: Keep these three together for TOKEN_IS_SEP() */
1183 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
1184 #define JIM_TT_EOL 7 /* line separator */
1185 #define JIM_TT_EOF 8 /* end of script */
1187 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1188 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1190 /* Additional token types needed for expressions */
1191 #define JIM_TT_SUBEXPR_START 11
1192 #define JIM_TT_SUBEXPR_END 12
1193 #define JIM_TT_SUBEXPR_COMMA 13
1194 #define JIM_TT_EXPR_INT 14
1195 #define JIM_TT_EXPR_DOUBLE 15
1197 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1199 /* Operator token types start here */
1200 #define JIM_TT_EXPR_OP 20
1202 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1204 /* Parser states */
1205 #define JIM_PS_DEF 0 /* Default state */
1206 #define JIM_PS_QUOTE 1 /* Inside "" */
1207 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1209 /* Parser context structure. The same context is used both to parse
1210 * Tcl scripts and lists. */
1211 struct JimParserCtx
1213 const char *p; /* Pointer to the point of the program we are parsing */
1214 int len; /* Remaining length */
1215 int linenr; /* Current line number */
1216 const char *tstart;
1217 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1218 int tline; /* Line number of the returned token */
1219 int tt; /* Token type */
1220 int eof; /* Non zero if EOF condition is true. */
1221 int state; /* Parser state */
1222 int comment; /* Non zero if the next chars may be a comment. */
1223 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1224 int missingline; /* Line number starting the missing token */
1228 * Results of missing quotes, braces, etc. from parsing.
1230 struct JimParseResult {
1231 char missing; /* From JimParserCtx.missing */
1232 int line; /* From JimParserCtx.missingline */
1235 static int JimParseScript(struct JimParserCtx *pc);
1236 static int JimParseSep(struct JimParserCtx *pc);
1237 static int JimParseEol(struct JimParserCtx *pc);
1238 static int JimParseCmd(struct JimParserCtx *pc);
1239 static int JimParseQuote(struct JimParserCtx *pc);
1240 static int JimParseVar(struct JimParserCtx *pc);
1241 static int JimParseBrace(struct JimParserCtx *pc);
1242 static int JimParseStr(struct JimParserCtx *pc);
1243 static int JimParseComment(struct JimParserCtx *pc);
1244 static void JimParseSubCmd(struct JimParserCtx *pc);
1245 static int JimParseSubQuote(struct JimParserCtx *pc);
1246 static void JimParseSubCmd(struct JimParserCtx *pc);
1247 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1249 /* Initialize a parser context.
1250 * 'prg' is a pointer to the program text, linenr is the line
1251 * number of the first line contained in the program. */
1252 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1254 pc->p = prg;
1255 pc->len = len;
1256 pc->tstart = NULL;
1257 pc->tend = NULL;
1258 pc->tline = 0;
1259 pc->tt = JIM_TT_NONE;
1260 pc->eof = 0;
1261 pc->state = JIM_PS_DEF;
1262 pc->linenr = linenr;
1263 pc->comment = 1;
1264 pc->missing = ' ';
1265 pc->missingline = linenr;
1268 static int JimParseScript(struct JimParserCtx *pc)
1270 while (1) { /* the while is used to reiterate with continue if needed */
1271 if (!pc->len) {
1272 pc->tstart = pc->p;
1273 pc->tend = pc->p - 1;
1274 pc->tline = pc->linenr;
1275 pc->tt = JIM_TT_EOL;
1276 pc->eof = 1;
1277 return JIM_OK;
1279 switch (*(pc->p)) {
1280 case '\\':
1281 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1282 return JimParseSep(pc);
1284 pc->comment = 0;
1285 return JimParseStr(pc);
1286 case ' ':
1287 case '\t':
1288 case '\r':
1289 case '\f':
1290 if (pc->state == JIM_PS_DEF)
1291 return JimParseSep(pc);
1292 pc->comment = 0;
1293 return JimParseStr(pc);
1294 case '\n':
1295 case ';':
1296 pc->comment = 1;
1297 if (pc->state == JIM_PS_DEF)
1298 return JimParseEol(pc);
1299 return JimParseStr(pc);
1300 case '[':
1301 pc->comment = 0;
1302 return JimParseCmd(pc);
1303 case '$':
1304 pc->comment = 0;
1305 if (JimParseVar(pc) == JIM_ERR) {
1306 /* An orphan $. Create as a separate token */
1307 pc->tstart = pc->tend = pc->p++;
1308 pc->len--;
1309 pc->tt = JIM_TT_ESC;
1311 return JIM_OK;
1312 case '#':
1313 if (pc->comment) {
1314 JimParseComment(pc);
1315 continue;
1317 return JimParseStr(pc);
1318 default:
1319 pc->comment = 0;
1320 return JimParseStr(pc);
1322 return JIM_OK;
1326 static int JimParseSep(struct JimParserCtx *pc)
1328 pc->tstart = pc->p;
1329 pc->tline = pc->linenr;
1330 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1331 if (*pc->p == '\n') {
1332 break;
1334 if (*pc->p == '\\') {
1335 pc->p++;
1336 pc->len--;
1337 pc->linenr++;
1339 pc->p++;
1340 pc->len--;
1342 pc->tend = pc->p - 1;
1343 pc->tt = JIM_TT_SEP;
1344 return JIM_OK;
1347 static int JimParseEol(struct JimParserCtx *pc)
1349 pc->tstart = pc->p;
1350 pc->tline = pc->linenr;
1351 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1352 if (*pc->p == '\n')
1353 pc->linenr++;
1354 pc->p++;
1355 pc->len--;
1357 pc->tend = pc->p - 1;
1358 pc->tt = JIM_TT_EOL;
1359 return JIM_OK;
1363 ** Here are the rules for parsing:
1364 ** {braced expression}
1365 ** - Count open and closing braces
1366 ** - Backslash escapes meaning of braces
1368 ** "quoted expression"
1369 ** - First double quote at start of word terminates the expression
1370 ** - Backslash escapes quote and bracket
1371 ** - [commands brackets] are counted/nested
1372 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1374 ** [command expression]
1375 ** - Count open and closing brackets
1376 ** - Backslash escapes quote, bracket and brace
1377 ** - [commands brackets] are counted/nested
1378 ** - "quoted expressions" are parsed according to quoting rules
1379 ** - {braced expressions} are parsed according to brace rules
1381 ** For everything, backslash escapes the next char, newline increments current line
1385 * Parses a braced expression starting at pc->p.
1387 * Positions the parser at the end of the braced expression,
1388 * sets pc->tend and possibly pc->missing.
1390 static void JimParseSubBrace(struct JimParserCtx *pc)
1392 int level = 1;
1394 /* Skip the brace */
1395 pc->p++;
1396 pc->len--;
1397 while (pc->len) {
1398 switch (*pc->p) {
1399 case '\\':
1400 if (pc->len > 1) {
1401 if (*++pc->p == '\n') {
1402 pc->linenr++;
1404 pc->len--;
1406 break;
1408 case '{':
1409 level++;
1410 break;
1412 case '}':
1413 if (--level == 0) {
1414 pc->tend = pc->p - 1;
1415 pc->p++;
1416 pc->len--;
1417 return;
1419 break;
1421 case '\n':
1422 pc->linenr++;
1423 break;
1425 pc->p++;
1426 pc->len--;
1428 pc->missing = '{';
1429 pc->missingline = pc->tline;
1430 pc->tend = pc->p - 1;
1434 * Parses a quoted expression starting at pc->p.
1436 * Positions the parser at the end of the quoted expression,
1437 * sets pc->tend and possibly pc->missing.
1439 * Returns the type of the token of the string,
1440 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1441 * or JIM_TT_STR.
1443 static int JimParseSubQuote(struct JimParserCtx *pc)
1445 int tt = JIM_TT_STR;
1446 int line = pc->tline;
1448 /* Skip the quote */
1449 pc->p++;
1450 pc->len--;
1451 while (pc->len) {
1452 switch (*pc->p) {
1453 case '\\':
1454 if (pc->len > 1) {
1455 if (*++pc->p == '\n') {
1456 pc->linenr++;
1458 pc->len--;
1459 tt = JIM_TT_ESC;
1461 break;
1463 case '"':
1464 pc->tend = pc->p - 1;
1465 pc->p++;
1466 pc->len--;
1467 return tt;
1469 case '[':
1470 JimParseSubCmd(pc);
1471 tt = JIM_TT_ESC;
1472 continue;
1474 case '\n':
1475 pc->linenr++;
1476 break;
1478 case '$':
1479 tt = JIM_TT_ESC;
1480 break;
1482 pc->p++;
1483 pc->len--;
1485 pc->missing = '"';
1486 pc->missingline = line;
1487 pc->tend = pc->p - 1;
1488 return tt;
1492 * Parses a [command] expression starting at pc->p.
1494 * Positions the parser at the end of the command expression,
1495 * sets pc->tend and possibly pc->missing.
1497 static void JimParseSubCmd(struct JimParserCtx *pc)
1499 int level = 1;
1500 int startofword = 1;
1501 int line = pc->tline;
1503 /* Skip the bracket */
1504 pc->p++;
1505 pc->len--;
1506 while (pc->len) {
1507 switch (*pc->p) {
1508 case '\\':
1509 if (pc->len > 1) {
1510 if (*++pc->p == '\n') {
1511 pc->linenr++;
1513 pc->len--;
1515 break;
1517 case '[':
1518 level++;
1519 break;
1521 case ']':
1522 if (--level == 0) {
1523 pc->tend = pc->p - 1;
1524 pc->p++;
1525 pc->len--;
1526 return;
1528 break;
1530 case '"':
1531 if (startofword) {
1532 JimParseSubQuote(pc);
1533 continue;
1535 break;
1537 case '{':
1538 JimParseSubBrace(pc);
1539 startofword = 0;
1540 continue;
1542 case '\n':
1543 pc->linenr++;
1544 break;
1546 startofword = isspace(UCHAR(*pc->p));
1547 pc->p++;
1548 pc->len--;
1550 pc->missing = '[';
1551 pc->missingline = line;
1552 pc->tend = pc->p - 1;
1555 static int JimParseBrace(struct JimParserCtx *pc)
1557 pc->tstart = pc->p + 1;
1558 pc->tline = pc->linenr;
1559 pc->tt = JIM_TT_STR;
1560 JimParseSubBrace(pc);
1561 return JIM_OK;
1564 static int JimParseCmd(struct JimParserCtx *pc)
1566 pc->tstart = pc->p + 1;
1567 pc->tline = pc->linenr;
1568 pc->tt = JIM_TT_CMD;
1569 JimParseSubCmd(pc);
1570 return JIM_OK;
1573 static int JimParseQuote(struct JimParserCtx *pc)
1575 pc->tstart = pc->p + 1;
1576 pc->tline = pc->linenr;
1577 pc->tt = JimParseSubQuote(pc);
1578 return JIM_OK;
1581 static int JimParseVar(struct JimParserCtx *pc)
1583 /* skip the $ */
1584 pc->p++;
1585 pc->len--;
1587 #ifdef EXPRSUGAR_BRACKET
1588 if (*pc->p == '[') {
1589 /* Parse $[...] expr shorthand syntax */
1590 JimParseCmd(pc);
1591 pc->tt = JIM_TT_EXPRSUGAR;
1592 return JIM_OK;
1594 #endif
1596 pc->tstart = pc->p;
1597 pc->tt = JIM_TT_VAR;
1598 pc->tline = pc->linenr;
1600 if (*pc->p == '{') {
1601 pc->tstart = ++pc->p;
1602 pc->len--;
1604 while (pc->len && *pc->p != '}') {
1605 if (*pc->p == '\n') {
1606 pc->linenr++;
1608 pc->p++;
1609 pc->len--;
1611 pc->tend = pc->p - 1;
1612 if (pc->len) {
1613 pc->p++;
1614 pc->len--;
1617 else {
1618 while (1) {
1619 /* Skip double colon, but not single colon! */
1620 if (pc->p[0] == ':' && pc->p[1] == ':') {
1621 while (*pc->p == ':') {
1622 pc->p++;
1623 pc->len--;
1625 continue;
1627 /* Note that any char >= 0x80 must be part of a utf-8 char.
1628 * We consider all unicode points outside of ASCII as letters
1630 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1631 pc->p++;
1632 pc->len--;
1633 continue;
1635 break;
1637 /* Parse [dict get] syntax sugar. */
1638 if (*pc->p == '(') {
1639 int count = 1;
1640 const char *paren = NULL;
1642 pc->tt = JIM_TT_DICTSUGAR;
1644 while (count && pc->len) {
1645 pc->p++;
1646 pc->len--;
1647 if (*pc->p == '\\' && pc->len >= 1) {
1648 pc->p++;
1649 pc->len--;
1651 else if (*pc->p == '(') {
1652 count++;
1654 else if (*pc->p == ')') {
1655 paren = pc->p;
1656 count--;
1659 if (count == 0) {
1660 pc->p++;
1661 pc->len--;
1663 else if (paren) {
1664 /* Did not find a matching paren. Back up */
1665 paren++;
1666 pc->len += (pc->p - paren);
1667 pc->p = paren;
1669 #ifndef EXPRSUGAR_BRACKET
1670 if (*pc->tstart == '(') {
1671 pc->tt = JIM_TT_EXPRSUGAR;
1673 #endif
1675 pc->tend = pc->p - 1;
1677 /* Check if we parsed just the '$' character.
1678 * That's not a variable so an error is returned
1679 * to tell the state machine to consider this '$' just
1680 * a string. */
1681 if (pc->tstart == pc->p) {
1682 pc->p--;
1683 pc->len++;
1684 return JIM_ERR;
1686 return JIM_OK;
1689 static int JimParseStr(struct JimParserCtx *pc)
1691 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1692 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1693 /* Starting a new word */
1694 if (*pc->p == '{') {
1695 return JimParseBrace(pc);
1697 if (*pc->p == '"') {
1698 pc->state = JIM_PS_QUOTE;
1699 pc->p++;
1700 pc->len--;
1701 /* In case the end quote is missing */
1702 pc->missingline = pc->tline;
1705 pc->tstart = pc->p;
1706 pc->tline = pc->linenr;
1707 while (1) {
1708 if (pc->len == 0) {
1709 if (pc->state == JIM_PS_QUOTE) {
1710 pc->missing = '"';
1712 pc->tend = pc->p - 1;
1713 pc->tt = JIM_TT_ESC;
1714 return JIM_OK;
1716 switch (*pc->p) {
1717 case '\\':
1718 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1719 pc->tend = pc->p - 1;
1720 pc->tt = JIM_TT_ESC;
1721 return JIM_OK;
1723 if (pc->len >= 2) {
1724 if (*(pc->p + 1) == '\n') {
1725 pc->linenr++;
1727 pc->p++;
1728 pc->len--;
1730 break;
1731 case '(':
1732 /* If the following token is not '$' just keep going */
1733 if (pc->len > 1 && pc->p[1] != '$') {
1734 break;
1736 case ')':
1737 /* Only need a separate ')' token if the previous was a var */
1738 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1739 if (pc->p == pc->tstart) {
1740 /* At the start of the token, so just return this char */
1741 pc->p++;
1742 pc->len--;
1744 pc->tend = pc->p - 1;
1745 pc->tt = JIM_TT_ESC;
1746 return JIM_OK;
1748 break;
1750 case '$':
1751 case '[':
1752 pc->tend = pc->p - 1;
1753 pc->tt = JIM_TT_ESC;
1754 return JIM_OK;
1755 case ' ':
1756 case '\t':
1757 case '\n':
1758 case '\r':
1759 case '\f':
1760 case ';':
1761 if (pc->state == JIM_PS_DEF) {
1762 pc->tend = pc->p - 1;
1763 pc->tt = JIM_TT_ESC;
1764 return JIM_OK;
1766 else if (*pc->p == '\n') {
1767 pc->linenr++;
1769 break;
1770 case '"':
1771 if (pc->state == JIM_PS_QUOTE) {
1772 pc->tend = pc->p - 1;
1773 pc->tt = JIM_TT_ESC;
1774 pc->p++;
1775 pc->len--;
1776 pc->state = JIM_PS_DEF;
1777 return JIM_OK;
1779 break;
1781 pc->p++;
1782 pc->len--;
1784 return JIM_OK; /* unreached */
1787 static int JimParseComment(struct JimParserCtx *pc)
1789 while (*pc->p) {
1790 if (*pc->p == '\n') {
1791 pc->linenr++;
1792 if (*(pc->p - 1) != '\\') {
1793 pc->p++;
1794 pc->len--;
1795 return JIM_OK;
1798 pc->p++;
1799 pc->len--;
1801 return JIM_OK;
1804 /* xdigitval and odigitval are helper functions for JimEscape() */
1805 static int xdigitval(int c)
1807 if (c >= '0' && c <= '9')
1808 return c - '0';
1809 if (c >= 'a' && c <= 'f')
1810 return c - 'a' + 10;
1811 if (c >= 'A' && c <= 'F')
1812 return c - 'A' + 10;
1813 return -1;
1816 static int odigitval(int c)
1818 if (c >= '0' && c <= '7')
1819 return c - '0';
1820 return -1;
1823 /* Perform Tcl escape substitution of 's', storing the result
1824 * string into 'dest'. The escaped string is guaranteed to
1825 * be the same length or shorted than the source string.
1826 * Slen is the length of the string at 's', if it's -1 the string
1827 * length will be calculated by the function.
1829 * The function returns the length of the resulting string. */
1830 static int JimEscape(char *dest, const char *s, int slen)
1832 char *p = dest;
1833 int i, len;
1835 if (slen == -1)
1836 slen = strlen(s);
1838 for (i = 0; i < slen; i++) {
1839 switch (s[i]) {
1840 case '\\':
1841 switch (s[i + 1]) {
1842 case 'a':
1843 *p++ = 0x7;
1844 i++;
1845 break;
1846 case 'b':
1847 *p++ = 0x8;
1848 i++;
1849 break;
1850 case 'f':
1851 *p++ = 0xc;
1852 i++;
1853 break;
1854 case 'n':
1855 *p++ = 0xa;
1856 i++;
1857 break;
1858 case 'r':
1859 *p++ = 0xd;
1860 i++;
1861 break;
1862 case 't':
1863 *p++ = 0x9;
1864 i++;
1865 break;
1866 case 'u':
1867 case 'U':
1868 case 'x':
1869 /* A unicode or hex sequence.
1870 * \x Expect 1-2 hex chars and convert to hex.
1871 * \u Expect 1-4 hex chars and convert to utf-8.
1872 * \U Expect 1-8 hex chars and convert to utf-8.
1873 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1874 * An invalid sequence means simply the escaped char.
1877 unsigned val = 0;
1878 int k;
1879 int maxchars = 2;
1881 i++;
1883 if (s[i] == 'U') {
1884 maxchars = 8;
1886 else if (s[i] == 'u') {
1887 if (s[i + 1] == '{') {
1888 maxchars = 6;
1889 i++;
1891 else {
1892 maxchars = 4;
1896 for (k = 0; k < maxchars; k++) {
1897 int c = xdigitval(s[i + k + 1]);
1898 if (c == -1) {
1899 break;
1901 val = (val << 4) | c;
1903 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1904 if (s[i] == '{') {
1905 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1906 /* Back up */
1907 i--;
1908 k = 0;
1910 else {
1911 /* Skip the closing brace */
1912 k++;
1915 if (k) {
1916 /* Got a valid sequence, so convert */
1917 if (s[i] == 'x') {
1918 *p++ = val;
1920 else {
1921 p += utf8_fromunicode(p, val);
1923 i += k;
1924 break;
1926 /* Not a valid codepoint, just an escaped char */
1927 *p++ = s[i];
1929 break;
1930 case 'v':
1931 *p++ = 0xb;
1932 i++;
1933 break;
1934 case '\0':
1935 *p++ = '\\';
1936 i++;
1937 break;
1938 case '\n':
1939 /* Replace all spaces and tabs after backslash newline with a single space*/
1940 *p++ = ' ';
1941 do {
1942 i++;
1943 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1944 break;
1945 case '0':
1946 case '1':
1947 case '2':
1948 case '3':
1949 case '4':
1950 case '5':
1951 case '6':
1952 case '7':
1953 /* octal escape */
1955 int val = 0;
1956 int c = odigitval(s[i + 1]);
1958 val = c;
1959 c = odigitval(s[i + 2]);
1960 if (c == -1) {
1961 *p++ = val;
1962 i++;
1963 break;
1965 val = (val * 8) + c;
1966 c = odigitval(s[i + 3]);
1967 if (c == -1) {
1968 *p++ = val;
1969 i += 2;
1970 break;
1972 val = (val * 8) + c;
1973 *p++ = val;
1974 i += 3;
1976 break;
1977 default:
1978 *p++ = s[i + 1];
1979 i++;
1980 break;
1982 break;
1983 default:
1984 *p++ = s[i];
1985 break;
1988 len = p - dest;
1989 *p = '\0';
1990 return len;
1993 /* Returns a dynamically allocated copy of the current token in the
1994 * parser context. The function performs conversion of escapes if
1995 * the token is of type JIM_TT_ESC.
1997 * Note that after the conversion, tokens that are grouped with
1998 * braces in the source code, are always recognizable from the
1999 * identical string obtained in a different way from the type.
2001 * For example the string:
2003 * {*}$a
2005 * will return as first token "*", of type JIM_TT_STR
2007 * While the string:
2009 * *$a
2011 * will return as first token "*", of type JIM_TT_ESC
2013 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2015 const char *start, *end;
2016 char *token;
2017 int len;
2019 start = pc->tstart;
2020 end = pc->tend;
2021 if (start > end) {
2022 len = 0;
2023 token = Jim_Alloc(1);
2024 token[0] = '\0';
2026 else {
2027 len = (end - start) + 1;
2028 token = Jim_Alloc(len + 1);
2029 if (pc->tt != JIM_TT_ESC) {
2030 /* No escape conversion needed? Just copy it. */
2031 memcpy(token, start, len);
2032 token[len] = '\0';
2034 else {
2035 /* Else convert the escape chars. */
2036 len = JimEscape(token, start, len);
2040 return Jim_NewStringObjNoAlloc(interp, token, len);
2043 /* Parses the given string to determine if it represents a complete script.
2045 * This is useful for interactive shells implementation, for [info complete].
2047 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2048 * '{' on scripts incomplete missing one or more '}' to be balanced.
2049 * '[' on scripts incomplete missing one or more ']' to be balanced.
2050 * '"' on scripts incomplete missing a '"' char.
2052 * If the script is complete, 1 is returned, otherwise 0.
2054 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2056 struct JimParserCtx parser;
2058 JimParserInit(&parser, s, len, 1);
2059 while (!parser.eof) {
2060 JimParseScript(&parser);
2062 if (stateCharPtr) {
2063 *stateCharPtr = parser.missing;
2065 return parser.missing == ' ';
2068 /* -----------------------------------------------------------------------------
2069 * Tcl Lists parsing
2070 * ---------------------------------------------------------------------------*/
2071 static int JimParseListSep(struct JimParserCtx *pc);
2072 static int JimParseListStr(struct JimParserCtx *pc);
2073 static int JimParseListQuote(struct JimParserCtx *pc);
2075 static int JimParseList(struct JimParserCtx *pc)
2077 if (isspace(UCHAR(*pc->p))) {
2078 return JimParseListSep(pc);
2080 switch (*pc->p) {
2081 case '"':
2082 return JimParseListQuote(pc);
2084 case '{':
2085 return JimParseBrace(pc);
2087 default:
2088 if (pc->len) {
2089 return JimParseListStr(pc);
2091 break;
2094 pc->tstart = pc->tend = pc->p;
2095 pc->tline = pc->linenr;
2096 pc->tt = JIM_TT_EOL;
2097 pc->eof = 1;
2098 return JIM_OK;
2101 static int JimParseListSep(struct JimParserCtx *pc)
2103 pc->tstart = pc->p;
2104 pc->tline = pc->linenr;
2105 while (isspace(UCHAR(*pc->p))) {
2106 if (*pc->p == '\n') {
2107 pc->linenr++;
2109 pc->p++;
2110 pc->len--;
2112 pc->tend = pc->p - 1;
2113 pc->tt = JIM_TT_SEP;
2114 return JIM_OK;
2117 static int JimParseListQuote(struct JimParserCtx *pc)
2119 pc->p++;
2120 pc->len--;
2122 pc->tstart = pc->p;
2123 pc->tline = pc->linenr;
2124 pc->tt = JIM_TT_STR;
2126 while (pc->len) {
2127 switch (*pc->p) {
2128 case '\\':
2129 pc->tt = JIM_TT_ESC;
2130 if (--pc->len == 0) {
2131 /* Trailing backslash */
2132 pc->tend = pc->p;
2133 return JIM_OK;
2135 pc->p++;
2136 break;
2137 case '\n':
2138 pc->linenr++;
2139 break;
2140 case '"':
2141 pc->tend = pc->p - 1;
2142 pc->p++;
2143 pc->len--;
2144 return JIM_OK;
2146 pc->p++;
2147 pc->len--;
2150 pc->tend = pc->p - 1;
2151 return JIM_OK;
2154 static int JimParseListStr(struct JimParserCtx *pc)
2156 pc->tstart = pc->p;
2157 pc->tline = pc->linenr;
2158 pc->tt = JIM_TT_STR;
2160 while (pc->len) {
2161 if (isspace(UCHAR(*pc->p))) {
2162 pc->tend = pc->p - 1;
2163 return JIM_OK;
2165 if (*pc->p == '\\') {
2166 if (--pc->len == 0) {
2167 /* Trailing backslash */
2168 pc->tend = pc->p;
2169 return JIM_OK;
2171 pc->tt = JIM_TT_ESC;
2172 pc->p++;
2174 pc->p++;
2175 pc->len--;
2177 pc->tend = pc->p - 1;
2178 return JIM_OK;
2181 /* -----------------------------------------------------------------------------
2182 * Jim_Obj related functions
2183 * ---------------------------------------------------------------------------*/
2185 /* Return a new initialized object. */
2186 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2188 Jim_Obj *objPtr;
2190 /* -- Check if there are objects in the free list -- */
2191 if (interp->freeList != NULL) {
2192 /* -- Unlink the object from the free list -- */
2193 objPtr = interp->freeList;
2194 interp->freeList = objPtr->nextObjPtr;
2196 else {
2197 /* -- No ready to use objects: allocate a new one -- */
2198 objPtr = Jim_Alloc(sizeof(*objPtr));
2201 /* Object is returned with refCount of 0. Every
2202 * kind of GC implemented should take care to don't try
2203 * to scan objects with refCount == 0. */
2204 objPtr->refCount = 0;
2205 /* All the other fields are left not initialized to save time.
2206 * The caller will probably want to set them to the right
2207 * value anyway. */
2209 /* -- Put the object into the live list -- */
2210 objPtr->prevObjPtr = NULL;
2211 objPtr->nextObjPtr = interp->liveList;
2212 if (interp->liveList)
2213 interp->liveList->prevObjPtr = objPtr;
2214 interp->liveList = objPtr;
2216 return objPtr;
2219 /* Free an object. Actually objects are never freed, but
2220 * just moved to the free objects list, where they will be
2221 * reused by Jim_NewObj(). */
2222 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2224 /* Check if the object was already freed, panic. */
2225 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2226 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2228 /* Free the internal representation */
2229 Jim_FreeIntRep(interp, objPtr);
2230 /* Free the string representation */
2231 if (objPtr->bytes != NULL) {
2232 if (objPtr->bytes != JimEmptyStringRep)
2233 Jim_Free(objPtr->bytes);
2235 /* Unlink the object from the live objects list */
2236 if (objPtr->prevObjPtr)
2237 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2238 if (objPtr->nextObjPtr)
2239 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2240 if (interp->liveList == objPtr)
2241 interp->liveList = objPtr->nextObjPtr;
2242 #ifdef JIM_DISABLE_OBJECT_POOL
2243 Jim_Free(objPtr);
2244 #else
2245 /* Link the object into the free objects list */
2246 objPtr->prevObjPtr = NULL;
2247 objPtr->nextObjPtr = interp->freeList;
2248 if (interp->freeList)
2249 interp->freeList->prevObjPtr = objPtr;
2250 interp->freeList = objPtr;
2251 objPtr->refCount = -1;
2252 #endif
2255 /* Invalidate the string representation of an object. */
2256 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2258 if (objPtr->bytes != NULL) {
2259 if (objPtr->bytes != JimEmptyStringRep)
2260 Jim_Free(objPtr->bytes);
2262 objPtr->bytes = NULL;
2265 /* Duplicate an object. The returned object has refcount = 0. */
2266 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2268 Jim_Obj *dupPtr;
2270 dupPtr = Jim_NewObj(interp);
2271 if (objPtr->bytes == NULL) {
2272 /* Object does not have a valid string representation. */
2273 dupPtr->bytes = NULL;
2275 else if (objPtr->length == 0) {
2276 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2277 dupPtr->bytes = JimEmptyStringRep;
2278 dupPtr->length = 0;
2279 dupPtr->typePtr = NULL;
2280 return dupPtr;
2282 else {
2283 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2284 dupPtr->length = objPtr->length;
2285 /* Copy the null byte too */
2286 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2289 /* By default, the new object has the same type as the old object */
2290 dupPtr->typePtr = objPtr->typePtr;
2291 if (objPtr->typePtr != NULL) {
2292 if (objPtr->typePtr->dupIntRepProc == NULL) {
2293 dupPtr->internalRep = objPtr->internalRep;
2295 else {
2296 /* The dup proc may set a different type, e.g. NULL */
2297 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2300 return dupPtr;
2303 /* Return the string representation for objPtr. If the object
2304 * string representation is invalid, calls the method to create
2305 * a new one starting from the internal representation of the object. */
2306 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2308 if (objPtr->bytes == NULL) {
2309 /* Invalid string repr. Generate it. */
2310 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2311 objPtr->typePtr->updateStringProc(objPtr);
2313 if (lenPtr)
2314 *lenPtr = objPtr->length;
2315 return objPtr->bytes;
2318 /* Just returns the length of the object's string rep */
2319 int Jim_Length(Jim_Obj *objPtr)
2321 if (objPtr->bytes == NULL) {
2322 /* Invalid string repr. Generate it. */
2323 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2324 objPtr->typePtr->updateStringProc(objPtr);
2326 return objPtr->length;
2329 /* Just returns the length of the object's string rep */
2330 const char *Jim_String(Jim_Obj *objPtr)
2332 if (objPtr->bytes == NULL) {
2333 /* Invalid string repr. Generate it. */
2334 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2335 objPtr->typePtr->updateStringProc(objPtr);
2337 return objPtr->bytes;
2340 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2341 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2343 static const Jim_ObjType dictSubstObjType = {
2344 "dict-substitution",
2345 FreeDictSubstInternalRep,
2346 DupDictSubstInternalRep,
2347 NULL,
2348 JIM_TYPE_NONE,
2351 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2353 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2356 static const Jim_ObjType interpolatedObjType = {
2357 "interpolated",
2358 FreeInterpolatedInternalRep,
2359 NULL,
2360 NULL,
2361 JIM_TYPE_NONE,
2364 /* -----------------------------------------------------------------------------
2365 * String Object
2366 * ---------------------------------------------------------------------------*/
2367 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2368 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2370 static const Jim_ObjType stringObjType = {
2371 "string",
2372 NULL,
2373 DupStringInternalRep,
2374 NULL,
2375 JIM_TYPE_REFERENCES,
2378 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2380 JIM_NOTUSED(interp);
2382 /* This is a bit subtle: the only caller of this function
2383 * should be Jim_DuplicateObj(), that will copy the
2384 * string representaion. After the copy, the duplicated
2385 * object will not have more room in teh buffer than
2386 * srcPtr->length bytes. So we just set it to length. */
2387 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2389 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2392 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2394 if (objPtr->typePtr != &stringObjType) {
2395 /* Get a fresh string representation. */
2396 if (objPtr->bytes == NULL) {
2397 /* Invalid string repr. Generate it. */
2398 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2399 objPtr->typePtr->updateStringProc(objPtr);
2401 /* Free any other internal representation. */
2402 Jim_FreeIntRep(interp, objPtr);
2403 /* Set it as string, i.e. just set the maxLength field. */
2404 objPtr->typePtr = &stringObjType;
2405 objPtr->internalRep.strValue.maxLength = objPtr->length;
2406 /* Don't know the utf-8 length yet */
2407 objPtr->internalRep.strValue.charLength = -1;
2409 return JIM_OK;
2413 * Returns the length of the object string in chars, not bytes.
2415 * These may be different for a utf-8 string.
2417 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2419 #ifdef JIM_UTF8
2420 SetStringFromAny(interp, objPtr);
2422 if (objPtr->internalRep.strValue.charLength < 0) {
2423 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2425 return objPtr->internalRep.strValue.charLength;
2426 #else
2427 return Jim_Length(objPtr);
2428 #endif
2431 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2432 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2434 Jim_Obj *objPtr = Jim_NewObj(interp);
2436 /* Need to find out how many bytes the string requires */
2437 if (len == -1)
2438 len = strlen(s);
2439 /* Alloc/Set the string rep. */
2440 if (len == 0) {
2441 objPtr->bytes = JimEmptyStringRep;
2442 objPtr->length = 0;
2444 else {
2445 objPtr->bytes = Jim_Alloc(len + 1);
2446 objPtr->length = len;
2447 memcpy(objPtr->bytes, s, len);
2448 objPtr->bytes[len] = '\0';
2451 /* No typePtr field for the vanilla string object. */
2452 objPtr->typePtr = NULL;
2453 return objPtr;
2456 /* charlen is in characters -- see also Jim_NewStringObj() */
2457 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2459 #ifdef JIM_UTF8
2460 /* Need to find out how many bytes the string requires */
2461 int bytelen = utf8_index(s, charlen);
2463 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2465 /* Remember the utf8 length, so set the type */
2466 objPtr->typePtr = &stringObjType;
2467 objPtr->internalRep.strValue.maxLength = bytelen;
2468 objPtr->internalRep.strValue.charLength = charlen;
2470 return objPtr;
2471 #else
2472 return Jim_NewStringObj(interp, s, charlen);
2473 #endif
2476 /* This version does not try to duplicate the 's' pointer, but
2477 * use it directly. */
2478 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2480 Jim_Obj *objPtr = Jim_NewObj(interp);
2482 objPtr->bytes = s;
2483 objPtr->length = len == -1 ? strlen(s) : len;
2484 objPtr->typePtr = NULL;
2485 return objPtr;
2488 /* Low-level string append. Use it only against objects
2489 * of type "string". */
2490 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2492 int needlen;
2494 if (len == -1)
2495 len = strlen(str);
2496 needlen = objPtr->length + len;
2497 if (objPtr->internalRep.strValue.maxLength < needlen ||
2498 objPtr->internalRep.strValue.maxLength == 0) {
2499 needlen *= 2;
2500 /* Inefficient to malloc() for less than 8 bytes */
2501 if (needlen < 7) {
2502 needlen = 7;
2504 if (objPtr->bytes == JimEmptyStringRep) {
2505 objPtr->bytes = Jim_Alloc(needlen + 1);
2507 else {
2508 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2510 objPtr->internalRep.strValue.maxLength = needlen;
2512 memcpy(objPtr->bytes + objPtr->length, str, len);
2513 objPtr->bytes[objPtr->length + len] = '\0';
2514 if (objPtr->internalRep.strValue.charLength >= 0) {
2515 /* Update the utf-8 char length */
2516 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2518 objPtr->length += len;
2521 /* Higher level API to append strings to objects. */
2522 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2524 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2525 SetStringFromAny(interp, objPtr);
2526 StringAppendString(objPtr, str, len);
2529 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2531 int len;
2532 const char *str;
2534 str = Jim_GetString(appendObjPtr, &len);
2535 Jim_AppendString(interp, objPtr, str, len);
2538 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2540 va_list ap;
2542 SetStringFromAny(interp, objPtr);
2543 va_start(ap, objPtr);
2544 while (1) {
2545 char *s = va_arg(ap, char *);
2547 if (s == NULL)
2548 break;
2549 Jim_AppendString(interp, objPtr, s, -1);
2551 va_end(ap);
2554 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2556 const char *aStr, *bStr;
2557 int aLen, bLen;
2559 if (aObjPtr == bObjPtr)
2560 return 1;
2561 aStr = Jim_GetString(aObjPtr, &aLen);
2562 bStr = Jim_GetString(bObjPtr, &bLen);
2563 if (aLen != bLen)
2564 return 0;
2565 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2568 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2570 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2573 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2575 int l1, l2;
2576 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2577 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2579 if (nocase) {
2580 /* Do a character compare for nocase */
2581 return JimStringCompareLen(s1, s2, -1, nocase);
2583 return JimStringCompare(s1, l1, s2, l2);
2587 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2589 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2591 const char *s1 = Jim_String(firstObjPtr);
2592 const char *s2 = Jim_String(secondObjPtr);
2594 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2597 /* Convert a range, as returned by Jim_GetRange(), into
2598 * an absolute index into an object of the specified length.
2599 * This function may return negative values, or values
2600 * bigger or equal to the length of the list if the index
2601 * is out of range. */
2602 static int JimRelToAbsIndex(int len, int idx)
2604 if (idx < 0)
2605 return len + idx;
2606 return idx;
2609 /* Convert a pair of index (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2610 * into form suitable for implementation of commands like [string range] and [lrange].
2612 * The resulting range is guaranteed to address valid elements of
2613 * the structure.
2616 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2618 int rangeLen;
2620 if (*firstPtr > *lastPtr) {
2621 rangeLen = 0;
2623 else {
2624 rangeLen = *lastPtr - *firstPtr + 1;
2625 if (rangeLen) {
2626 if (*firstPtr < 0) {
2627 rangeLen += *firstPtr;
2628 *firstPtr = 0;
2630 if (*lastPtr >= len) {
2631 rangeLen -= (*lastPtr - (len - 1));
2632 *lastPtr = len - 1;
2636 if (rangeLen < 0)
2637 rangeLen = 0;
2639 *rangeLenPtr = rangeLen;
2642 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2643 int len, int *first, int *last, int *range)
2645 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2646 return JIM_ERR;
2648 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2649 return JIM_ERR;
2651 *first = JimRelToAbsIndex(len, *first);
2652 *last = JimRelToAbsIndex(len, *last);
2653 JimRelToAbsRange(len, first, last, range);
2654 return JIM_OK;
2657 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2658 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2660 int first, last;
2661 const char *str;
2662 int rangeLen;
2663 int bytelen;
2665 str = Jim_GetString(strObjPtr, &bytelen);
2667 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2668 return NULL;
2671 if (first == 0 && rangeLen == bytelen) {
2672 return strObjPtr;
2674 return Jim_NewStringObj(interp, str + first, rangeLen);
2677 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2678 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2680 #ifdef JIM_UTF8
2681 int first, last;
2682 const char *str;
2683 int len, rangeLen;
2684 int bytelen;
2686 str = Jim_GetString(strObjPtr, &bytelen);
2687 len = Jim_Utf8Length(interp, strObjPtr);
2689 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2690 return NULL;
2693 if (first == 0 && rangeLen == len) {
2694 return strObjPtr;
2696 if (len == bytelen) {
2697 /* ASCII optimisation */
2698 return Jim_NewStringObj(interp, str + first, rangeLen);
2700 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2701 #else
2702 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2703 #endif
2706 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2707 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2709 int first, last;
2710 const char *str;
2711 int len, rangeLen;
2712 Jim_Obj *objPtr;
2714 len = Jim_Utf8Length(interp, strObjPtr);
2716 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2717 return NULL;
2720 if (last < first) {
2721 return strObjPtr;
2724 str = Jim_String(strObjPtr);
2726 /* Before part */
2727 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2729 /* Replacement */
2730 if (newStrObj) {
2731 Jim_AppendObj(interp, objPtr, newStrObj);
2734 /* After part */
2735 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2737 return objPtr;
2740 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2742 while (*str) {
2743 int c;
2744 str += utf8_tounicode(str, &c);
2745 dest += utf8_fromunicode(dest, uc ? utf8_upper(c) : utf8_lower(c));
2747 *dest = 0;
2750 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2752 char *buf;
2753 int len;
2754 const char *str;
2756 SetStringFromAny(interp, strObjPtr);
2758 str = Jim_GetString(strObjPtr, &len);
2760 #ifdef JIM_UTF8
2761 /* Case mapping can change the utf-8 length of the string.
2762 * But at worst it will be by one extra byte per char
2764 len *= 2;
2765 #endif
2766 buf = Jim_Alloc(len + 1);
2767 JimStrCopyUpperLower(buf, str, 0);
2768 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2771 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2773 char *buf;
2774 const char *str;
2775 int len;
2777 if (strObjPtr->typePtr != &stringObjType) {
2778 SetStringFromAny(interp, strObjPtr);
2781 str = Jim_GetString(strObjPtr, &len);
2783 #ifdef JIM_UTF8
2784 /* Case mapping can change the utf-8 length of the string.
2785 * But at worst it will be by one extra byte per char
2787 len *= 2;
2788 #endif
2789 buf = Jim_Alloc(len + 1);
2790 JimStrCopyUpperLower(buf, str, 1);
2791 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2794 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2796 char *buf, *p;
2797 int len;
2798 int c;
2799 const char *str;
2801 str = Jim_GetString(strObjPtr, &len);
2802 if (len == 0) {
2803 return strObjPtr;
2805 #ifdef JIM_UTF8
2806 /* Case mapping can change the utf-8 length of the string.
2807 * But at worst it will be by one extra byte per char
2809 len *= 2;
2810 #endif
2811 buf = p = Jim_Alloc(len + 1);
2813 str += utf8_tounicode(str, &c);
2814 p += utf8_fromunicode(p, utf8_title(c));
2816 JimStrCopyUpperLower(p, str, 0);
2818 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2821 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2822 * for unicode character 'c'.
2823 * Returns the position if found or NULL if not
2825 static const char *utf8_memchr(const char *str, int len, int c)
2827 #ifdef JIM_UTF8
2828 while (len) {
2829 int sc;
2830 int n = utf8_tounicode(str, &sc);
2831 if (sc == c) {
2832 return str;
2834 str += n;
2835 len -= n;
2837 return NULL;
2838 #else
2839 return memchr(str, c, len);
2840 #endif
2844 * Searches for the first non-trim char in string (str, len)
2846 * If none is found, returns just past the last char.
2848 * Lengths are in bytes.
2850 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2852 while (len) {
2853 int c;
2854 int n = utf8_tounicode(str, &c);
2856 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2857 /* Not a trim char, so stop */
2858 break;
2860 str += n;
2861 len -= n;
2863 return str;
2867 * Searches backwards for a non-trim char in string (str, len).
2869 * Returns a pointer to just after the non-trim char, or NULL if not found.
2871 * Lengths are in bytes.
2873 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2875 str += len;
2877 while (len) {
2878 int c;
2879 int n = utf8_prev_len(str, len);
2881 len -= n;
2882 str -= n;
2884 n = utf8_tounicode(str, &c);
2886 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2887 return str + n;
2891 return NULL;
2894 static const char default_trim_chars[] = " \t\n\r";
2895 /* sizeof() here includes the null byte */
2896 static int default_trim_chars_len = sizeof(default_trim_chars);
2898 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2900 int len;
2901 const char *str = Jim_GetString(strObjPtr, &len);
2902 const char *trimchars = default_trim_chars;
2903 int trimcharslen = default_trim_chars_len;
2904 const char *newstr;
2906 if (trimcharsObjPtr) {
2907 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2910 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2911 if (newstr == str) {
2912 return strObjPtr;
2915 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2918 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2920 int len;
2921 const char *trimchars = default_trim_chars;
2922 int trimcharslen = default_trim_chars_len;
2923 const char *nontrim;
2925 if (trimcharsObjPtr) {
2926 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2929 SetStringFromAny(interp, strObjPtr);
2931 len = Jim_Length(strObjPtr);
2932 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2934 if (nontrim == NULL) {
2935 /* All trim, so return a zero-length string */
2936 return Jim_NewEmptyStringObj(interp);
2938 if (nontrim == strObjPtr->bytes + len) {
2939 return strObjPtr;
2942 if (Jim_IsShared(strObjPtr)) {
2943 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2945 else {
2946 /* Can modify this string in place */
2947 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2948 strObjPtr->length = (nontrim - strObjPtr->bytes);
2951 return strObjPtr;
2954 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2956 /* First trim left. */
2957 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2959 /* Now trim right */
2960 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2962 if (objPtr != strObjPtr) {
2963 /* Note that we don't want this object to be leaked */
2964 Jim_IncrRefCount(objPtr);
2965 Jim_DecrRefCount(interp, objPtr);
2968 return strObjPtr;
2972 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2974 static const char * const strclassnames[] = {
2975 "integer", "alpha", "alnum", "ascii", "digit",
2976 "double", "lower", "upper", "space", "xdigit",
2977 "control", "print", "graph", "punct",
2978 NULL
2980 enum {
2981 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2982 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2983 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2985 int strclass;
2986 int len;
2987 int i;
2988 const char *str;
2989 int (*isclassfunc)(int c) = NULL;
2991 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2992 return JIM_ERR;
2995 str = Jim_GetString(strObjPtr, &len);
2996 if (len == 0) {
2997 Jim_SetResultInt(interp, !strict);
2998 return JIM_OK;
3001 switch (strclass) {
3002 case STR_IS_INTEGER:
3004 jim_wide w;
3005 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3006 return JIM_OK;
3009 case STR_IS_DOUBLE:
3011 double d;
3012 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3013 return JIM_OK;
3016 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3017 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3018 case STR_IS_ASCII: isclassfunc = isascii; break;
3019 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3020 case STR_IS_LOWER: isclassfunc = islower; break;
3021 case STR_IS_UPPER: isclassfunc = isupper; break;
3022 case STR_IS_SPACE: isclassfunc = isspace; break;
3023 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3024 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3025 case STR_IS_PRINT: isclassfunc = isprint; break;
3026 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3027 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3028 default:
3029 return JIM_ERR;
3032 for (i = 0; i < len; i++) {
3033 if (!isclassfunc(str[i])) {
3034 Jim_SetResultInt(interp, 0);
3035 return JIM_OK;
3038 Jim_SetResultInt(interp, 1);
3039 return JIM_OK;
3042 /* -----------------------------------------------------------------------------
3043 * Compared String Object
3044 * ---------------------------------------------------------------------------*/
3046 /* This is strange object that allows to compare a C literal string
3047 * with a Jim object in very short time if the same comparison is done
3048 * multiple times. For example every time the [if] command is executed,
3049 * Jim has to check if a given argument is "else". This comparions if
3050 * the code has no errors are true most of the times, so we can cache
3051 * inside the object the pointer of the string of the last matching
3052 * comparison. Because most C compilers perform literal sharing,
3053 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3054 * this works pretty well even if comparisons are at different places
3055 * inside the C code. */
3057 static const Jim_ObjType comparedStringObjType = {
3058 "compared-string",
3059 NULL,
3060 NULL,
3061 NULL,
3062 JIM_TYPE_REFERENCES,
3065 /* The only way this object is exposed to the API is via the following
3066 * function. Returns true if the string and the object string repr.
3067 * are the same, otherwise zero is returned.
3069 * Note: this isn't binary safe, but it hardly needs to be.*/
3070 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3072 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
3073 return 1;
3074 else {
3075 const char *objStr = Jim_String(objPtr);
3077 if (strcmp(str, objStr) != 0)
3078 return 0;
3079 if (objPtr->typePtr != &comparedStringObjType) {
3080 Jim_FreeIntRep(interp, objPtr);
3081 objPtr->typePtr = &comparedStringObjType;
3083 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3084 return 1;
3088 static int qsortCompareStringPointers(const void *a, const void *b)
3090 char *const *sa = (char *const *)a;
3091 char *const *sb = (char *const *)b;
3093 return strcmp(*sa, *sb);
3097 /* -----------------------------------------------------------------------------
3098 * Source Object
3100 * This object is just a string from the language point of view, but
3101 * in the internal representation it contains the filename and line number
3102 * where this given token was read. This information is used by
3103 * Jim_EvalObj() if the object passed happens to be of type "source".
3105 * This allows to propagate the information about line numbers and file
3106 * names and give error messages with absolute line numbers.
3108 * Note that this object uses shared strings for filenames, and the
3109 * pointer to the filename together with the line number is taken into
3110 * the space for the "inline" internal representation of the Jim_Object,
3111 * so there is almost memory zero-overhead.
3113 * Also the object will be converted to something else if the given
3114 * token it represents in the source file is not something to be
3115 * evaluated (not a script), and will be specialized in some other way,
3116 * so the time overhead is also null.
3117 * ---------------------------------------------------------------------------*/
3119 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3120 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3122 static const Jim_ObjType sourceObjType = {
3123 "source",
3124 FreeSourceInternalRep,
3125 DupSourceInternalRep,
3126 NULL,
3127 JIM_TYPE_REFERENCES,
3130 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3132 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3135 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3137 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3138 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3141 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3142 Jim_Obj *fileNameObj, int lineNumber)
3144 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3145 JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
3146 Jim_IncrRefCount(fileNameObj);
3147 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3148 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3149 objPtr->typePtr = &sourceObjType;
3152 /* -----------------------------------------------------------------------------
3153 * Script Object
3154 * ---------------------------------------------------------------------------*/
3156 static const Jim_ObjType scriptLineObjType = {
3157 "scriptline",
3158 NULL,
3159 NULL,
3160 NULL,
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 #define JIM_CMDSTRUCT_EXPAND -1
3184 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3185 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3186 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3188 static const Jim_ObjType scriptObjType = {
3189 "script",
3190 FreeScriptInternalRep,
3191 DupScriptInternalRep,
3192 NULL,
3193 JIM_TYPE_REFERENCES,
3196 /* The ScriptToken structure represents every token into a scriptObj.
3197 * Every token contains an associated Jim_Obj that can be specialized
3198 * by commands operating on it. */
3199 typedef struct ScriptToken
3201 int type;
3202 Jim_Obj *objPtr;
3203 } ScriptToken;
3205 /* This is the script object internal representation. An array of
3206 * ScriptToken structures, including a pre-computed representation of the
3207 * command length and arguments.
3209 * For example the script:
3211 * puts hello
3212 * set $i $x$y [foo]BAR
3214 * will produce a ScriptObj with the following Tokens:
3216 * LIN 2
3217 * ESC puts
3218 * ESC hello
3219 * LIN 4
3220 * ESC set
3221 * VAR i
3222 * WRD 2
3223 * VAR x
3224 * VAR y
3225 * WRD 2
3226 * CMD foo
3227 * ESC BAR
3229 * "puts hello" has two args (LIN 2), composed of single tokens.
3230 * (Note that the WRD token is omitted for the common case of a single token.)
3232 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3233 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3235 * The precomputation of the command structure makes Jim_Eval() faster,
3236 * and simpler because there aren't dynamic lengths / allocations.
3238 * -- {expand}/{*} handling --
3240 * Expand is handled in a special way.
3242 * If a "word" begins with {*}, the word token count is -ve.
3244 * For example the command:
3246 * list {*}{a b}
3248 * Will produce the following cmdstruct array:
3250 * LIN 2
3251 * ESC list
3252 * WRD -1
3253 * STR a b
3255 * Note that the 'LIN' token also contains the source information for the
3256 * first word of the line for error reporting purposes
3258 * -- the substFlags field of the structure --
3260 * The scriptObj structure is used to represent both "script" objects
3261 * and "subst" objects. In the second case, the there are no LIN and WRD
3262 * tokens. Instead SEP and EOL tokens are added as-is.
3263 * In addition, the field 'substFlags' is used to represent the flags used to turn
3264 * the string into the internal representation used to perform the
3265 * substitution. If this flags are not what the application requires
3266 * the scriptObj is created again. For example the script:
3268 * subst -nocommands $string
3269 * subst -novariables $string
3271 * Will recreate the internal representation of the $string object
3272 * two times.
3274 typedef struct ScriptObj
3276 int len; /* Length as number of tokens. */
3277 ScriptToken *token; /* Tokens array. */
3278 int substFlags; /* flags used for the compilation of "subst" objects */
3279 int inUse; /* Used to share a ScriptObj. Currently
3280 only used by Jim_EvalObj() as protection against
3281 shimmering of the currently evaluated object. */
3282 Jim_Obj *fileNameObj;
3283 int firstline; /* Line number of the first line */
3284 int linenr; /* Line number of the current line */
3285 } ScriptObj;
3287 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3289 int i;
3290 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3292 script->inUse--;
3293 if (script->inUse != 0)
3294 return;
3295 for (i = 0; i < script->len; i++) {
3296 Jim_DecrRefCount(interp, script->token[i].objPtr);
3298 Jim_Free(script->token);
3299 Jim_DecrRefCount(interp, script->fileNameObj);
3300 Jim_Free(script);
3303 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3305 JIM_NOTUSED(interp);
3306 JIM_NOTUSED(srcPtr);
3308 /* Just returns an simple string. */
3309 dupPtr->typePtr = NULL;
3312 /* A simple parser token.
3313 * All the simple tokens for the script point into the same script string rep.
3315 typedef struct
3317 const char *token; /* Pointer to the start of the token */
3318 int len; /* Length of this token */
3319 int type; /* Token type */
3320 int line; /* Line number */
3321 } ParseToken;
3323 /* A list of parsed tokens representing a script.
3324 * Tokens are added to this list as the script is parsed.
3325 * It grows as needed.
3327 typedef struct
3329 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3330 ParseToken *list; /* Array of tokens */
3331 int size; /* Current size of the list */
3332 int count; /* Number of entries used */
3333 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3334 } ParseTokenList;
3336 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3338 tokenlist->list = tokenlist->static_list;
3339 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3340 tokenlist->count = 0;
3343 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3345 if (tokenlist->list != tokenlist->static_list) {
3346 Jim_Free(tokenlist->list);
3351 * Adds the new token to the tokenlist.
3352 * The token has the given length, type and line number.
3353 * The token list is resized as necessary.
3355 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3356 int line)
3358 ParseToken *t;
3360 if (tokenlist->count == tokenlist->size) {
3361 /* Resize the list */
3362 tokenlist->size *= 2;
3363 if (tokenlist->list != tokenlist->static_list) {
3364 tokenlist->list =
3365 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3367 else {
3368 /* The list needs to become allocated */
3369 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3370 memcpy(tokenlist->list, tokenlist->static_list,
3371 tokenlist->count * sizeof(*tokenlist->list));
3374 t = &tokenlist->list[tokenlist->count++];
3375 t->token = token;
3376 t->len = len;
3377 t->type = type;
3378 t->line = line;
3381 /* Counts the number of adjoining non-separator.
3383 * Returns -ve if the first token is the expansion
3384 * operator (in which case the count doesn't include
3385 * that token).
3387 static int JimCountWordTokens(ParseToken *t)
3389 int expand = 1;
3390 int count = 0;
3392 /* Is the first word {*} or {expand}? */
3393 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3394 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3395 /* Create an expand token */
3396 expand = -1;
3397 t++;
3401 /* Now count non-separator words */
3402 while (!TOKEN_IS_SEP(t->type)) {
3403 t++;
3404 count++;
3407 return count * expand;
3411 * Create a script/subst object from the given token.
3413 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3415 Jim_Obj *objPtr;
3417 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3418 /* Convert the backlash escapes . */
3419 int len = t->len;
3420 char *str = Jim_Alloc(len + 1);
3421 len = JimEscape(str, t->token, len);
3422 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3424 else {
3425 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
3426 * with a single space. This is currently not done.
3428 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3430 return objPtr;
3434 * Takes a tokenlist and creates the allocated list of script tokens
3435 * in script->token, of length script->len.
3437 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3438 * as required.
3440 * Also sets script->line to the line number of the first token
3442 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3443 ParseTokenList *tokenlist)
3445 int i;
3446 struct ScriptToken *token;
3447 /* Number of tokens so far for the current command */
3448 int lineargs = 0;
3449 /* This is the first token for the current command */
3450 ScriptToken *linefirst;
3451 int count;
3452 int linenr;
3454 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3455 printf("==== Tokens ====\n");
3456 for (i = 0; i < tokenlist->count; i++) {
3457 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3458 tokenlist->list[i].len, tokenlist->list[i].token);
3460 #endif
3462 /* May need up to one extra script token for each EOL in the worst case */
3463 count = tokenlist->count;
3464 for (i = 0; i < tokenlist->count; i++) {
3465 if (tokenlist->list[i].type == JIM_TT_EOL) {
3466 count++;
3469 linenr = script->firstline = tokenlist->list[0].line;
3471 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3473 /* This is the first token for the current command */
3474 linefirst = token++;
3476 for (i = 0; i < tokenlist->count; ) {
3477 /* Look ahead to find out how many tokens make up the next word */
3478 int wordtokens;
3480 /* Skip any leading separators */
3481 while (tokenlist->list[i].type == JIM_TT_SEP) {
3482 i++;
3485 wordtokens = JimCountWordTokens(tokenlist->list + i);
3487 if (wordtokens == 0) {
3488 /* None, so at end of line */
3489 if (lineargs) {
3490 linefirst->type = JIM_TT_LINE;
3491 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3492 Jim_IncrRefCount(linefirst->objPtr);
3494 /* Reset for new line */
3495 lineargs = 0;
3496 linefirst = token++;
3498 i++;
3499 continue;
3501 else if (wordtokens != 1) {
3502 /* More than 1, or {expand}, so insert a WORD token */
3503 token->type = JIM_TT_WORD;
3504 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3505 Jim_IncrRefCount(token->objPtr);
3506 token++;
3507 if (wordtokens < 0) {
3508 /* Skip the expand token */
3509 i++;
3510 wordtokens = -wordtokens - 1;
3511 lineargs--;
3515 if (lineargs == 0) {
3516 /* First real token on the line, so record the line number */
3517 linenr = tokenlist->list[i].line;
3519 lineargs++;
3521 /* Add each non-separator word token to the line */
3522 while (wordtokens--) {
3523 const ParseToken *t = &tokenlist->list[i++];
3525 token->type = t->type;
3526 token->objPtr = JimMakeScriptObj(interp, t);
3527 Jim_IncrRefCount(token->objPtr);
3529 /* Every object is initially a string, but the
3530 * internal type may be specialized during execution of the
3531 * script. */
3532 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3533 token++;
3537 if (lineargs == 0) {
3538 token--;
3541 script->len = token - script->token;
3543 assert(script->len < count);
3545 #ifdef DEBUG_SHOW_SCRIPT
3546 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3547 for (i = 0; i < script->len; i++) {
3548 const ScriptToken *t = &script->token[i];
3549 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3551 #endif
3556 * Similar to ScriptObjAddTokens(), but for subst objects.
3558 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3559 ParseTokenList *tokenlist)
3561 int i;
3562 struct ScriptToken *token;
3564 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3566 for (i = 0; i < tokenlist->count; i++) {
3567 const ParseToken *t = &tokenlist->list[i];
3569 /* Create a token for 't' */
3570 token->type = t->type;
3571 token->objPtr = JimMakeScriptObj(interp, t);
3572 Jim_IncrRefCount(token->objPtr);
3573 token++;
3576 script->len = i;
3579 /* This method takes the string representation of an object
3580 * as a Tcl script, and generates the pre-parsed internal representation
3581 * of the script. */
3582 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3584 int scriptTextLen;
3585 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3586 struct JimParserCtx parser;
3587 struct ScriptObj *script;
3588 ParseTokenList tokenlist;
3589 int line = 1;
3591 /* Try to get information about filename / line number */
3592 if (objPtr->typePtr == &sourceObjType) {
3593 line = objPtr->internalRep.sourceValue.lineNumber;
3596 /* Initially parse the script into tokens (in tokenlist) */
3597 ScriptTokenListInit(&tokenlist);
3599 JimParserInit(&parser, scriptText, scriptTextLen, line);
3600 while (!parser.eof) {
3601 JimParseScript(&parser);
3602 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3603 parser.tline);
3605 if (result && parser.missing != ' ') {
3606 ScriptTokenListFree(&tokenlist);
3607 result->missing = parser.missing;
3608 result->line = parser.missingline;
3609 return JIM_ERR;
3612 /* Add a final EOF token */
3613 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3615 /* Create the "real" script tokens from the initial token list */
3616 script = Jim_Alloc(sizeof(*script));
3617 memset(script, 0, sizeof(*script));
3618 script->inUse = 1;
3619 if (objPtr->typePtr == &sourceObjType) {
3620 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3622 else {
3623 script->fileNameObj = interp->emptyObj;
3625 Jim_IncrRefCount(script->fileNameObj);
3627 ScriptObjAddTokens(interp, script, &tokenlist);
3629 /* No longer need the token list */
3630 ScriptTokenListFree(&tokenlist);
3632 /* Free the old internal rep and set the new one. */
3633 Jim_FreeIntRep(interp, objPtr);
3634 Jim_SetIntRepPtr(objPtr, script);
3635 objPtr->typePtr = &scriptObjType;
3637 return JIM_OK;
3640 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3642 if (objPtr == interp->emptyObj) {
3643 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3644 objPtr = interp->nullScriptObj;
3647 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3648 SetScriptFromAny(interp, objPtr, NULL);
3650 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3653 /* -----------------------------------------------------------------------------
3654 * Commands
3655 * ---------------------------------------------------------------------------*/
3656 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3658 cmdPtr->inUse++;
3661 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3663 if (--cmdPtr->inUse == 0) {
3664 if (cmdPtr->isproc) {
3665 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3666 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3667 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3668 if (cmdPtr->u.proc.staticVars) {
3669 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3670 Jim_Free(cmdPtr->u.proc.staticVars);
3673 else {
3674 /* native (C) */
3675 if (cmdPtr->u.native.delProc) {
3676 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3679 if (cmdPtr->prevCmd) {
3680 /* Delete any pushed command too */
3681 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3683 Jim_Free(cmdPtr);
3687 /* Variables HashTable Type.
3689 * Keys are dynamic allocated strings, Values are Jim_Var structures.
3692 /* Variables HashTable Type.
3694 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3695 static void JimVariablesHTValDestructor(void *interp, void *val)
3697 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3698 Jim_Free(val);
3701 static const Jim_HashTableType JimVariablesHashTableType = {
3702 JimStringCopyHTHashFunction, /* hash function */
3703 JimStringCopyHTDup, /* key dup */
3704 NULL, /* val dup */
3705 JimStringCopyHTKeyCompare, /* key compare */
3706 JimStringCopyHTKeyDestructor, /* key destructor */
3707 JimVariablesHTValDestructor /* val destructor */
3710 /* Commands HashTable Type.
3712 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3713 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3715 JimDecrCmdRefCount(interp, val);
3718 static const Jim_HashTableType JimCommandsHashTableType = {
3719 JimStringCopyHTHashFunction, /* hash function */
3720 JimStringCopyHTDup, /* key dup */
3721 NULL, /* val dup */
3722 JimStringCopyHTKeyCompare, /* key compare */
3723 JimStringCopyHTKeyDestructor, /* key destructor */
3724 JimCommandsHT_ValDestructor /* val destructor */
3727 /* ------------------------- Commands related functions --------------------- */
3729 #ifdef jim_ext_namespace
3731 * Returns the "unscoped" version of the given namespace.
3732 * That is, the fully qualfied name without the leading ::
3733 * The returned value is either nsObj, or an object with a zero ref count.
3735 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3737 const char *name = Jim_String(nsObj);
3738 if (name[0] == ':' && name[1] == ':') {
3739 /* This command is being defined in the global namespace */
3740 while (*++name == ':') {
3742 nsObj = Jim_NewStringObj(interp, name, -1);
3744 else if (Jim_Length(interp->framePtr->nsObj)) {
3745 /* This command is being defined in a non-global namespace */
3746 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3747 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3749 return nsObj;
3753 * An efficient version of JimQualifyNameObj() where the name is
3754 * available (and needed) as a 'const char *'.
3755 * Avoids creating an object if not necessary.
3756 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3758 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3760 Jim_Obj *objPtr = interp->emptyObj;
3762 if (name[0] == ':' && name[1] == ':') {
3763 /* This command is being defined in the global namespace */
3764 while (*++name == ':') {
3767 else if (Jim_Length(interp->framePtr->nsObj)) {
3768 /* This command is being defined in a non-global namespace */
3769 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3770 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3771 name = Jim_String(objPtr);
3773 Jim_IncrRefCount(objPtr);
3774 *objPtrPtr = objPtr;
3775 return name;
3778 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3780 #else
3781 /* We can be more efficient in the no-namespace case */
3782 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3783 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3784 #endif
3786 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3788 /* It may already exist, so we try to delete the old one.
3789 * Note that reference count means that it won't be deleted yet if
3790 * it exists in the call stack.
3792 * BUT, if 'local' is in force, instead of deleting the existing
3793 * proc, we stash a reference to the old proc here.
3795 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3796 if (he) {
3797 /* There was an old cmd with the same name,
3798 * so this requires a 'proc epoch' update. */
3800 /* If a procedure with the same name didn't exist there is no need
3801 * to increment the 'proc epoch' because creation of a new procedure
3802 * can never affect existing cached commands. We don't do
3803 * negative caching. */
3804 Jim_InterpIncrProcEpoch(interp);
3807 if (he && interp->local) {
3808 /* Push this command over the top of the previous one */
3809 cmd->prevCmd = he->u.val;
3810 he->u.val = cmd;
3812 else {
3813 if (he) {
3814 /* Replace the existing command */
3815 Jim_DeleteHashEntry(&interp->commands, name);
3818 Jim_AddHashEntry(&interp->commands, name, cmd);
3820 return JIM_OK;
3824 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3825 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3827 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3829 /* Store the new details for this command */
3830 memset(cmdPtr, 0, sizeof(*cmdPtr));
3831 cmdPtr->inUse = 1;
3832 cmdPtr->u.native.delProc = delProc;
3833 cmdPtr->u.native.cmdProc = cmdProc;
3834 cmdPtr->u.native.privData = privData;
3836 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3838 return JIM_OK;
3841 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3843 int len, i;
3845 len = Jim_ListLength(interp, staticsListObjPtr);
3846 if (len == 0) {
3847 return JIM_OK;
3850 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3851 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3852 for (i = 0; i < len; i++) {
3853 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3854 Jim_Var *varPtr;
3855 int subLen;
3857 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3858 /* Check if it's composed of two elements. */
3859 subLen = Jim_ListLength(interp, objPtr);
3860 if (subLen == 1 || subLen == 2) {
3861 /* Try to get the variable value from the current
3862 * environment. */
3863 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3864 if (subLen == 1) {
3865 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3866 if (initObjPtr == NULL) {
3867 Jim_SetResultFormatted(interp,
3868 "variable for initialization of static \"%#s\" not found in the local context",
3869 nameObjPtr);
3870 return JIM_ERR;
3873 else {
3874 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3876 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3877 return JIM_ERR;
3880 varPtr = Jim_Alloc(sizeof(*varPtr));
3881 varPtr->objPtr = initObjPtr;
3882 Jim_IncrRefCount(initObjPtr);
3883 varPtr->linkFramePtr = NULL;
3884 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3885 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3886 Jim_SetResultFormatted(interp,
3887 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3888 Jim_DecrRefCount(interp, initObjPtr);
3889 Jim_Free(varPtr);
3890 return JIM_ERR;
3893 else {
3894 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3895 objPtr);
3896 return JIM_ERR;
3899 return JIM_OK;
3902 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3904 #ifdef jim_ext_namespace
3905 if (cmdPtr->isproc) {
3906 /* XXX: Really need JimNamespaceSplit() */
3907 const char *pt = strrchr(cmdname, ':');
3908 if (pt && pt != cmdname && pt[-1] == ':') {
3909 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3910 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3911 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3913 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3914 /* This commands shadows a global command, so a proc epoch update is required */
3915 Jim_InterpIncrProcEpoch(interp);
3919 #endif
3922 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3923 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3925 Jim_Cmd *cmdPtr;
3926 int argListLen;
3927 int i;
3929 argListLen = Jim_ListLength(interp, argListObjPtr);
3931 /* Allocate space for both the command pointer and the arg list */
3932 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3933 memset(cmdPtr, 0, sizeof(*cmdPtr));
3934 cmdPtr->inUse = 1;
3935 cmdPtr->isproc = 1;
3936 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3937 cmdPtr->u.proc.argListLen = argListLen;
3938 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3939 cmdPtr->u.proc.argsPos = -1;
3940 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3941 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
3942 Jim_IncrRefCount(argListObjPtr);
3943 Jim_IncrRefCount(bodyObjPtr);
3944 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3946 /* Create the statics hash table. */
3947 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3948 goto err;
3951 /* Parse the args out into arglist, validating as we go */
3952 /* Examine the argument list for default parameters and 'args' */
3953 for (i = 0; i < argListLen; i++) {
3954 Jim_Obj *argPtr;
3955 Jim_Obj *nameObjPtr;
3956 Jim_Obj *defaultObjPtr;
3957 int len;
3959 /* Examine a parameter */
3960 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3961 len = Jim_ListLength(interp, argPtr);
3962 if (len == 0) {
3963 Jim_SetResultString(interp, "argument with no name", -1);
3964 err:
3965 JimDecrCmdRefCount(interp, cmdPtr);
3966 return NULL;
3968 if (len > 2) {
3969 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
3970 goto err;
3973 if (len == 2) {
3974 /* Optional parameter */
3975 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
3976 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
3978 else {
3979 /* Required parameter */
3980 nameObjPtr = argPtr;
3981 defaultObjPtr = NULL;
3985 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
3986 if (cmdPtr->u.proc.argsPos >= 0) {
3987 Jim_SetResultString(interp, "'args' specified more than once", -1);
3988 goto err;
3990 cmdPtr->u.proc.argsPos = i;
3992 else {
3993 if (len == 2) {
3994 cmdPtr->u.proc.optArity++;
3996 else {
3997 cmdPtr->u.proc.reqArity++;
4001 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4002 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4005 return cmdPtr;
4008 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4010 int ret = JIM_OK;
4011 Jim_Obj *qualifiedNameObj;
4012 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4014 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4015 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4016 ret = JIM_ERR;
4018 else {
4019 Jim_InterpIncrProcEpoch(interp);
4022 JimFreeQualifiedName(interp, qualifiedNameObj);
4024 return ret;
4027 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4029 int ret = JIM_ERR;
4030 Jim_HashEntry *he;
4031 Jim_Cmd *cmdPtr;
4032 Jim_Obj *qualifiedOldNameObj;
4033 Jim_Obj *qualifiedNewNameObj;
4034 const char *fqold;
4035 const char *fqnew;
4037 if (newName[0] == 0) {
4038 return Jim_DeleteCommand(interp, oldName);
4041 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4042 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4044 /* Does it exist? */
4045 he = Jim_FindHashEntry(&interp->commands, fqold);
4046 if (he == NULL) {
4047 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4049 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4050 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4052 else {
4053 /* Add the new name first */
4054 cmdPtr = he->u.val;
4055 JimIncrCmdRefCount(cmdPtr);
4056 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4057 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4059 /* Now remove the old name */
4060 Jim_DeleteHashEntry(&interp->commands, fqold);
4062 /* Increment the epoch */
4063 Jim_InterpIncrProcEpoch(interp);
4065 ret = JIM_OK;
4068 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4069 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4071 return ret;
4074 /* -----------------------------------------------------------------------------
4075 * Command object
4076 * ---------------------------------------------------------------------------*/
4078 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4080 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4083 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4085 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4086 dupPtr->typePtr = srcPtr->typePtr;
4087 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4090 static const Jim_ObjType commandObjType = {
4091 "command",
4092 FreeCommandInternalRep,
4093 DupCommandInternalRep,
4094 NULL,
4095 JIM_TYPE_REFERENCES,
4098 /* This function returns the command structure for the command name
4099 * stored in objPtr. It tries to specialize the objPtr to contain
4100 * a cached info instead to perform the lookup into the hash table
4101 * every time. The information cached may not be uptodate, in such
4102 * a case the lookup is performed and the cache updated.
4104 * Respects the 'upcall' setting
4106 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4108 Jim_Cmd *cmd;
4110 /* In order to be valid, the proc epoch must match and
4111 * the lookup must have occurred in the same namespace
4113 if (objPtr->typePtr != &commandObjType ||
4114 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4115 #ifdef jim_ext_namespace
4116 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4117 #endif
4119 /* Not cached or out of date, so lookup */
4121 /* Do we need to try the local namespace? */
4122 const char *name = Jim_String(objPtr);
4123 Jim_HashEntry *he;
4125 if (name[0] == ':' && name[1] == ':') {
4126 while (*++name == ':') {
4129 #ifdef jim_ext_namespace
4130 else if (Jim_Length(interp->framePtr->nsObj)) {
4131 /* This command is being defined in a non-global namespace */
4132 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4133 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4134 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4135 Jim_FreeNewObj(interp, nameObj);
4136 if (he) {
4137 goto found;
4140 #endif
4142 /* Lookup in the global namespace */
4143 he = Jim_FindHashEntry(&interp->commands, name);
4144 if (he == NULL) {
4145 if (flags & JIM_ERRMSG) {
4146 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4148 return NULL;
4150 #ifdef jim_ext_namespace
4151 found:
4152 #endif
4153 cmd = (Jim_Cmd *)he->u.val;
4155 /* Free the old internal repr and set the new one. */
4156 Jim_FreeIntRep(interp, objPtr);
4157 objPtr->typePtr = &commandObjType;
4158 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4159 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4160 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4161 Jim_IncrRefCount(interp->framePtr->nsObj);
4163 else {
4164 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4166 while (cmd->u.proc.upcall) {
4167 cmd = cmd->prevCmd;
4169 return cmd;
4172 /* -----------------------------------------------------------------------------
4173 * Variables
4174 * ---------------------------------------------------------------------------*/
4176 /* -----------------------------------------------------------------------------
4177 * Variable object
4178 * ---------------------------------------------------------------------------*/
4180 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4182 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4184 static const Jim_ObjType variableObjType = {
4185 "variable",
4186 NULL,
4187 NULL,
4188 NULL,
4189 JIM_TYPE_REFERENCES,
4193 * Check that the name does not contain embedded nulls.
4195 * Variable and procedure names are maniplated as null terminated strings, so
4196 * don't allow names with embedded nulls.
4198 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4200 /* Variable names and proc names can't contain embedded nulls */
4201 if (nameObjPtr->typePtr != &variableObjType) {
4202 int len;
4203 const char *str = Jim_GetString(nameObjPtr, &len);
4204 if (memchr(str, '\0', len)) {
4205 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4206 return JIM_ERR;
4209 return JIM_OK;
4212 /* This method should be called only by the variable API.
4213 * It returns JIM_OK on success (variable already exists),
4214 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4215 * a variable name, but syntax glue for [dict] i.e. the last
4216 * character is ')' */
4217 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4219 const char *varName;
4220 Jim_CallFrame *framePtr;
4221 Jim_HashEntry *he;
4222 int global;
4223 int len;
4225 /* Check if the object is already an uptodate variable */
4226 if (objPtr->typePtr == &variableObjType) {
4227 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4228 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4229 /* nothing to do */
4230 return JIM_OK;
4232 /* Need to re-resolve the variable in the updated callframe */
4234 else if (objPtr->typePtr == &dictSubstObjType) {
4235 return JIM_DICT_SUGAR;
4237 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4238 return JIM_ERR;
4242 varName = Jim_GetString(objPtr, &len);
4244 /* Make sure it's not syntax glue to get/set dict. */
4245 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4246 return JIM_DICT_SUGAR;
4249 if (varName[0] == ':' && varName[1] == ':') {
4250 while (*++varName == ':') {
4252 global = 1;
4253 framePtr = interp->topFramePtr;
4255 else {
4256 global = 0;
4257 framePtr = interp->framePtr;
4260 /* Resolve this name in the variables hash table */
4261 he = Jim_FindHashEntry(&framePtr->vars, varName);
4262 if (he == NULL) {
4263 if (!global && framePtr->staticVars) {
4264 /* Try with static vars. */
4265 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4267 if (he == NULL) {
4268 return JIM_ERR;
4272 /* Free the old internal repr and set the new one. */
4273 Jim_FreeIntRep(interp, objPtr);
4274 objPtr->typePtr = &variableObjType;
4275 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4276 objPtr->internalRep.varValue.varPtr = he->u.val;
4277 objPtr->internalRep.varValue.global = global;
4278 return JIM_OK;
4281 /* -------------------- Variables related functions ------------------------- */
4282 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4283 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4285 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4287 const char *name;
4288 Jim_CallFrame *framePtr;
4289 int global;
4291 /* New variable to create */
4292 Jim_Var *var = Jim_Alloc(sizeof(*var));
4294 var->objPtr = valObjPtr;
4295 Jim_IncrRefCount(valObjPtr);
4296 var->linkFramePtr = NULL;
4298 name = Jim_String(nameObjPtr);
4299 if (name[0] == ':' && name[1] == ':') {
4300 while (*++name == ':') {
4302 framePtr = interp->topFramePtr;
4303 global = 1;
4305 else {
4306 framePtr = interp->framePtr;
4307 global = 0;
4310 /* Insert the new variable */
4311 Jim_AddHashEntry(&framePtr->vars, name, var);
4313 /* Make the object int rep a variable */
4314 Jim_FreeIntRep(interp, nameObjPtr);
4315 nameObjPtr->typePtr = &variableObjType;
4316 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4317 nameObjPtr->internalRep.varValue.varPtr = var;
4318 nameObjPtr->internalRep.varValue.global = global;
4320 return var;
4323 /* For now that's dummy. Variables lookup should be optimized
4324 * in many ways, with caching of lookups, and possibly with
4325 * a table of pre-allocated vars in every CallFrame for local vars.
4326 * All the caching should also have an 'epoch' mechanism similar
4327 * to the one used by Tcl for procedures lookup caching. */
4329 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4331 int err;
4332 Jim_Var *var;
4334 switch (SetVariableFromAny(interp, nameObjPtr)) {
4335 case JIM_DICT_SUGAR:
4336 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4338 case JIM_ERR:
4339 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4340 return JIM_ERR;
4342 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4343 break;
4345 case JIM_OK:
4346 var = nameObjPtr->internalRep.varValue.varPtr;
4347 if (var->linkFramePtr == NULL) {
4348 Jim_IncrRefCount(valObjPtr);
4349 Jim_DecrRefCount(interp, var->objPtr);
4350 var->objPtr = valObjPtr;
4352 else { /* Else handle the link */
4353 Jim_CallFrame *savedCallFrame;
4355 savedCallFrame = interp->framePtr;
4356 interp->framePtr = var->linkFramePtr;
4357 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4358 interp->framePtr = savedCallFrame;
4359 if (err != JIM_OK)
4360 return err;
4363 return JIM_OK;
4366 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4368 Jim_Obj *nameObjPtr;
4369 int result;
4371 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4372 Jim_IncrRefCount(nameObjPtr);
4373 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4374 Jim_DecrRefCount(interp, nameObjPtr);
4375 return result;
4378 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4380 Jim_CallFrame *savedFramePtr;
4381 int result;
4383 savedFramePtr = interp->framePtr;
4384 interp->framePtr = interp->topFramePtr;
4385 result = Jim_SetVariableStr(interp, name, objPtr);
4386 interp->framePtr = savedFramePtr;
4387 return result;
4390 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4392 Jim_Obj *nameObjPtr, *valObjPtr;
4393 int result;
4395 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4396 valObjPtr = Jim_NewStringObj(interp, val, -1);
4397 Jim_IncrRefCount(nameObjPtr);
4398 Jim_IncrRefCount(valObjPtr);
4399 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4400 Jim_DecrRefCount(interp, nameObjPtr);
4401 Jim_DecrRefCount(interp, valObjPtr);
4402 return result;
4405 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4406 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4408 const char *varName;
4409 const char *targetName;
4410 Jim_CallFrame *framePtr;
4411 Jim_Var *varPtr;
4413 /* Check for an existing variable or link */
4414 switch (SetVariableFromAny(interp, nameObjPtr)) {
4415 case JIM_DICT_SUGAR:
4416 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4417 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4418 return JIM_ERR;
4420 case JIM_OK:
4421 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4423 if (varPtr->linkFramePtr == NULL) {
4424 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4425 return JIM_ERR;
4428 /* It exists, but is a link, so first delete the link */
4429 varPtr->linkFramePtr = NULL;
4430 break;
4433 /* Resolve the call frames for both variables */
4434 /* XXX: SetVariableFromAny() already did this! */
4435 varName = Jim_String(nameObjPtr);
4437 if (varName[0] == ':' && varName[1] == ':') {
4438 while (*++varName == ':') {
4440 /* Linking a global var does nothing */
4441 framePtr = interp->topFramePtr;
4443 else {
4444 framePtr = interp->framePtr;
4447 targetName = Jim_String(targetNameObjPtr);
4448 if (targetName[0] == ':' && targetName[1] == ':') {
4449 while (*++targetName == ':') {
4451 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4452 targetCallFrame = interp->topFramePtr;
4454 Jim_IncrRefCount(targetNameObjPtr);
4456 if (framePtr->level < targetCallFrame->level) {
4457 Jim_SetResultFormatted(interp,
4458 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4459 nameObjPtr);
4460 Jim_DecrRefCount(interp, targetNameObjPtr);
4461 return JIM_ERR;
4464 /* Check for cycles. */
4465 if (framePtr == targetCallFrame) {
4466 Jim_Obj *objPtr = targetNameObjPtr;
4468 /* Cycles are only possible with 'uplevel 0' */
4469 while (1) {
4470 if (strcmp(Jim_String(objPtr), varName) == 0) {
4471 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4472 Jim_DecrRefCount(interp, targetNameObjPtr);
4473 return JIM_ERR;
4475 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4476 break;
4477 varPtr = objPtr->internalRep.varValue.varPtr;
4478 if (varPtr->linkFramePtr != targetCallFrame)
4479 break;
4480 objPtr = varPtr->objPtr;
4484 /* Perform the binding */
4485 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4486 /* We are now sure 'nameObjPtr' type is variableObjType */
4487 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4488 Jim_DecrRefCount(interp, targetNameObjPtr);
4489 return JIM_OK;
4492 /* Return the Jim_Obj pointer associated with a variable name,
4493 * or NULL if the variable was not found in the current context.
4494 * The same optimization discussed in the comment to the
4495 * 'SetVariable' function should apply here.
4497 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4498 * in a dictionary which is shared, the array variable value is duplicated first.
4499 * This allows the array element to be updated (e.g. append, lappend) without
4500 * affecting other references to the dictionary.
4502 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4504 switch (SetVariableFromAny(interp, nameObjPtr)) {
4505 case JIM_OK:{
4506 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4508 if (varPtr->linkFramePtr == NULL) {
4509 return varPtr->objPtr;
4511 else {
4512 Jim_Obj *objPtr;
4514 /* The variable is a link? Resolve it. */
4515 Jim_CallFrame *savedCallFrame = interp->framePtr;
4517 interp->framePtr = varPtr->linkFramePtr;
4518 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4519 interp->framePtr = savedCallFrame;
4520 if (objPtr) {
4521 return objPtr;
4523 /* Error, so fall through to the error message */
4526 break;
4528 case JIM_DICT_SUGAR:
4529 /* [dict] syntax sugar. */
4530 return JimDictSugarGet(interp, nameObjPtr, flags);
4532 if (flags & JIM_ERRMSG) {
4533 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4535 return NULL;
4538 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4540 Jim_CallFrame *savedFramePtr;
4541 Jim_Obj *objPtr;
4543 savedFramePtr = interp->framePtr;
4544 interp->framePtr = interp->topFramePtr;
4545 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4546 interp->framePtr = savedFramePtr;
4548 return objPtr;
4551 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4553 Jim_Obj *nameObjPtr, *varObjPtr;
4555 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4556 Jim_IncrRefCount(nameObjPtr);
4557 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4558 Jim_DecrRefCount(interp, nameObjPtr);
4559 return varObjPtr;
4562 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4564 Jim_CallFrame *savedFramePtr;
4565 Jim_Obj *objPtr;
4567 savedFramePtr = interp->framePtr;
4568 interp->framePtr = interp->topFramePtr;
4569 objPtr = Jim_GetVariableStr(interp, name, flags);
4570 interp->framePtr = savedFramePtr;
4572 return objPtr;
4575 /* Unset a variable.
4576 * Note: On success unset invalidates all the variable objects created
4577 * in the current call frame incrementing. */
4578 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4580 Jim_Var *varPtr;
4581 int retval;
4582 Jim_CallFrame *framePtr;
4584 retval = SetVariableFromAny(interp, nameObjPtr);
4585 if (retval == JIM_DICT_SUGAR) {
4586 /* [dict] syntax sugar. */
4587 return JimDictSugarSet(interp, nameObjPtr, NULL);
4589 else if (retval == JIM_OK) {
4590 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4592 /* If it's a link call UnsetVariable recursively */
4593 if (varPtr->linkFramePtr) {
4594 framePtr = interp->framePtr;
4595 interp->framePtr = varPtr->linkFramePtr;
4596 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4597 interp->framePtr = framePtr;
4599 else {
4600 const char *name = Jim_String(nameObjPtr);
4601 if (nameObjPtr->internalRep.varValue.global) {
4602 name += 2;
4603 framePtr = interp->topFramePtr;
4605 else {
4606 framePtr = interp->framePtr;
4609 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4610 if (retval == JIM_OK) {
4611 /* Change the callframe id, invalidating var lookup caching */
4612 JimChangeCallFrameId(interp, framePtr);
4616 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4617 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4619 return retval;
4622 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4624 /* Given a variable name for [dict] operation syntax sugar,
4625 * this function returns two objects, the first with the name
4626 * of the variable to set, and the second with the rispective key.
4627 * For example "foo(bar)" will return objects with string repr. of
4628 * "foo" and "bar".
4630 * The returned objects have refcount = 1. The function can't fail. */
4631 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4632 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4634 const char *str, *p;
4635 int len, keyLen;
4636 Jim_Obj *varObjPtr, *keyObjPtr;
4638 str = Jim_GetString(objPtr, &len);
4640 p = strchr(str, '(');
4641 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4643 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4645 p++;
4646 keyLen = (str + len) - p;
4647 if (str[len - 1] == ')') {
4648 keyLen--;
4651 /* Create the objects with the variable name and key. */
4652 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4654 Jim_IncrRefCount(varObjPtr);
4655 Jim_IncrRefCount(keyObjPtr);
4656 *varPtrPtr = varObjPtr;
4657 *keyPtrPtr = keyObjPtr;
4660 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4661 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4662 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4664 int err;
4666 SetDictSubstFromAny(interp, objPtr);
4668 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4669 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4671 if (err == JIM_OK) {
4672 /* Don't keep an extra ref to the result */
4673 Jim_SetEmptyResult(interp);
4675 else {
4676 if (!valObjPtr) {
4677 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4678 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4679 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4680 objPtr);
4681 return err;
4684 /* Make the error more informative and Tcl-compatible */
4685 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4686 (valObjPtr ? "set" : "unset"), objPtr);
4688 return err;
4692 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4694 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4695 * and stored back to the variable before expansion.
4697 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4698 Jim_Obj *keyObjPtr, int flags)
4700 Jim_Obj *dictObjPtr;
4701 Jim_Obj *resObjPtr = NULL;
4702 int ret;
4704 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4705 if (!dictObjPtr) {
4706 return NULL;
4709 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4710 if (ret != JIM_OK) {
4711 resObjPtr = NULL;
4712 if (ret < 0) {
4713 Jim_SetResultFormatted(interp,
4714 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4716 else {
4717 Jim_SetResultFormatted(interp,
4718 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4721 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4722 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4723 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4724 /* This can probably never happen */
4725 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4727 /* We know that the key exists. Get the result in the now-unshared dictionary */
4728 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4731 return resObjPtr;
4734 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4735 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4737 SetDictSubstFromAny(interp, objPtr);
4739 return JimDictExpandArrayVariable(interp,
4740 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4741 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4744 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4746 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4748 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4749 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4752 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4754 JIM_NOTUSED(interp);
4756 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4757 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4758 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4759 dupPtr->typePtr = &dictSubstObjType;
4762 /* Note: The object *must* be in dict-sugar format */
4763 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4765 if (objPtr->typePtr != &dictSubstObjType) {
4766 Jim_Obj *varObjPtr, *keyObjPtr;
4768 if (objPtr->typePtr == &interpolatedObjType) {
4769 /* An interpolated object in dict-sugar form */
4771 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4772 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4774 Jim_IncrRefCount(varObjPtr);
4775 Jim_IncrRefCount(keyObjPtr);
4777 else {
4778 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4781 Jim_FreeIntRep(interp, objPtr);
4782 objPtr->typePtr = &dictSubstObjType;
4783 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4784 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4788 /* This function is used to expand [dict get] sugar in the form
4789 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4790 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4791 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4792 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4793 * the [dict]ionary contained in variable VARNAME. */
4794 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4796 Jim_Obj *resObjPtr = NULL;
4797 Jim_Obj *substKeyObjPtr = NULL;
4799 SetDictSubstFromAny(interp, objPtr);
4801 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4802 &substKeyObjPtr, JIM_NONE)
4803 != JIM_OK) {
4804 return NULL;
4806 Jim_IncrRefCount(substKeyObjPtr);
4807 resObjPtr =
4808 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4809 substKeyObjPtr, 0);
4810 Jim_DecrRefCount(interp, substKeyObjPtr);
4812 return resObjPtr;
4815 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4817 Jim_Obj *resultObjPtr;
4819 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4820 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4821 resultObjPtr->refCount--;
4822 return resultObjPtr;
4824 return NULL;
4827 /* -----------------------------------------------------------------------------
4828 * CallFrame
4829 * ---------------------------------------------------------------------------*/
4831 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4833 Jim_CallFrame *cf;
4835 if (interp->freeFramesList) {
4836 cf = interp->freeFramesList;
4837 interp->freeFramesList = cf->next;
4839 else {
4840 cf = Jim_Alloc(sizeof(*cf));
4841 cf->vars.table = NULL;
4844 cf->id = interp->callFrameEpoch++;
4845 cf->parent = parent;
4846 cf->level = parent ? parent->level + 1 : 0;
4847 cf->argv = NULL;
4848 cf->argc = 0;
4849 cf->procArgsObjPtr = NULL;
4850 cf->procBodyObjPtr = NULL;
4851 cf->next = NULL;
4852 cf->staticVars = NULL;
4853 cf->localCommands = NULL;
4855 cf->nsObj = nsObj;
4856 Jim_IncrRefCount(nsObj);
4857 if (cf->vars.table == NULL)
4858 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4859 return cf;
4862 /* Used to invalidate every caching related to callframe stability. */
4863 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4865 cf->id = interp->callFrameEpoch++;
4868 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4870 /* Delete any local procs */
4871 if (localCommands) {
4872 Jim_Obj *cmdNameObj;
4874 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4875 Jim_HashEntry *he;
4876 Jim_Obj *fqObjName;
4878 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4880 he = Jim_FindHashEntry(&interp->commands, fqname);
4882 if (he) {
4883 Jim_Cmd *cmd = he->u.val;
4884 if (cmd->prevCmd) {
4885 Jim_Cmd *prevCmd = cmd->prevCmd;
4886 cmd->prevCmd = NULL;
4888 /* Delete the old command */
4889 JimDecrCmdRefCount(interp, cmd);
4891 /* And restore the original */
4892 he->u.val = prevCmd;
4894 else {
4895 Jim_DeleteHashEntry(&interp->commands, fqname);
4896 Jim_InterpIncrProcEpoch(interp);
4899 Jim_DecrRefCount(interp, cmdNameObj);
4900 JimFreeQualifiedName(interp, fqObjName);
4902 Jim_FreeStack(localCommands);
4903 Jim_Free(localCommands);
4905 return JIM_OK;
4909 #define JIM_FCF_NONE 0 /* no flags */
4910 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4911 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4913 if (cf->procArgsObjPtr)
4914 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4915 if (cf->procBodyObjPtr)
4916 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4917 Jim_DecrRefCount(interp, cf->nsObj);
4918 if (!(flags & JIM_FCF_NOHT))
4919 Jim_FreeHashTable(&cf->vars);
4920 else {
4921 int i;
4922 Jim_HashEntry **table = cf->vars.table, *he;
4924 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4925 he = table[i];
4926 while (he != NULL) {
4927 Jim_HashEntry *nextEntry = he->next;
4928 Jim_Var *varPtr = (void *)he->u.val;
4930 Jim_DecrRefCount(interp, varPtr->objPtr);
4931 Jim_Free(he->u.val);
4932 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4933 Jim_Free(he);
4934 table[i] = NULL;
4935 he = nextEntry;
4938 cf->vars.used = 0;
4941 JimDeleteLocalProcs(interp, cf->localCommands);
4943 cf->next = interp->freeFramesList;
4944 interp->freeFramesList = cf;
4949 /* -----------------------------------------------------------------------------
4950 * References
4951 * ---------------------------------------------------------------------------*/
4952 #ifdef JIM_REFERENCES
4954 /* References HashTable Type.
4956 * Keys are unsigned long integers, dynamically allocated for now but in the
4957 * future it's worth to cache this 4 bytes objects. Values are pointers
4958 * to Jim_References. */
4959 static void JimReferencesHTValDestructor(void *interp, void *val)
4961 Jim_Reference *refPtr = (void *)val;
4963 Jim_DecrRefCount(interp, refPtr->objPtr);
4964 if (refPtr->finalizerCmdNamePtr != NULL) {
4965 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4967 Jim_Free(val);
4970 static unsigned int JimReferencesHTHashFunction(const void *key)
4972 /* Only the least significant bits are used. */
4973 const unsigned long *widePtr = key;
4974 unsigned int intValue = (unsigned int)*widePtr;
4976 return Jim_IntHashFunction(intValue);
4979 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
4981 void *copy = Jim_Alloc(sizeof(unsigned long));
4983 JIM_NOTUSED(privdata);
4985 memcpy(copy, key, sizeof(unsigned long));
4986 return copy;
4989 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4991 JIM_NOTUSED(privdata);
4993 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
4996 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
4998 JIM_NOTUSED(privdata);
5000 Jim_Free(key);
5003 static const Jim_HashTableType JimReferencesHashTableType = {
5004 JimReferencesHTHashFunction, /* hash function */
5005 JimReferencesHTKeyDup, /* key dup */
5006 NULL, /* val dup */
5007 JimReferencesHTKeyCompare, /* key compare */
5008 JimReferencesHTKeyDestructor, /* key destructor */
5009 JimReferencesHTValDestructor /* val destructor */
5012 /* -----------------------------------------------------------------------------
5013 * Reference object type and References API
5014 * ---------------------------------------------------------------------------*/
5016 /* The string representation of references has two features in order
5017 * to make the GC faster. The first is that every reference starts
5018 * with a non common character '<', in order to make the string matching
5019 * faster. The second is that the reference string rep is 42 characters
5020 * in length, this allows to avoid to check every object with a string
5021 * repr < 42, and usually there aren't many of these objects. */
5023 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5025 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5027 const char *fmt = "<reference.<%s>.%020lu>";
5029 sprintf(buf, fmt, refPtr->tag, id);
5030 return JIM_REFERENCE_SPACE;
5033 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5035 static const Jim_ObjType referenceObjType = {
5036 "reference",
5037 NULL,
5038 NULL,
5039 UpdateStringOfReference,
5040 JIM_TYPE_REFERENCES,
5043 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5045 int len;
5046 char buf[JIM_REFERENCE_SPACE + 1];
5047 Jim_Reference *refPtr;
5049 refPtr = objPtr->internalRep.refValue.refPtr;
5050 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
5051 objPtr->bytes = Jim_Alloc(len + 1);
5052 memcpy(objPtr->bytes, buf, len + 1);
5053 objPtr->length = len;
5056 /* returns true if 'c' is a valid reference tag character.
5057 * i.e. inside the range [_a-zA-Z0-9] */
5058 static int isrefchar(int c)
5060 return (c == '_' || isalnum(c));
5063 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5065 unsigned long value;
5066 int i, len;
5067 const char *str, *start, *end;
5068 char refId[21];
5069 Jim_Reference *refPtr;
5070 Jim_HashEntry *he;
5071 char *endptr;
5073 /* Get the string representation */
5074 str = Jim_GetString(objPtr, &len);
5075 /* Check if it looks like a reference */
5076 if (len < JIM_REFERENCE_SPACE)
5077 goto badformat;
5078 /* Trim spaces */
5079 start = str;
5080 end = str + len - 1;
5081 while (*start == ' ')
5082 start++;
5083 while (*end == ' ' && end > start)
5084 end--;
5085 if (end - start + 1 != JIM_REFERENCE_SPACE)
5086 goto badformat;
5087 /* <reference.<1234567>.%020> */
5088 if (memcmp(start, "<reference.<", 12) != 0)
5089 goto badformat;
5090 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5091 goto badformat;
5092 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5093 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5094 if (!isrefchar(start[12 + i]))
5095 goto badformat;
5097 /* Extract info from the reference. */
5098 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5099 refId[20] = '\0';
5100 /* Try to convert the ID into an unsigned long */
5101 value = strtoul(refId, &endptr, 10);
5102 if (JimCheckConversion(refId, endptr) != JIM_OK)
5103 goto badformat;
5104 /* Check if the reference really exists! */
5105 he = Jim_FindHashEntry(&interp->references, &value);
5106 if (he == NULL) {
5107 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5108 return JIM_ERR;
5110 refPtr = he->u.val;
5111 /* Free the old internal repr and set the new one. */
5112 Jim_FreeIntRep(interp, objPtr);
5113 objPtr->typePtr = &referenceObjType;
5114 objPtr->internalRep.refValue.id = value;
5115 objPtr->internalRep.refValue.refPtr = refPtr;
5116 return JIM_OK;
5118 badformat:
5119 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5120 return JIM_ERR;
5123 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5124 * as finalizer command (or NULL if there is no finalizer).
5125 * The returned reference object has refcount = 0. */
5126 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5128 struct Jim_Reference *refPtr;
5129 unsigned long id;
5130 Jim_Obj *refObjPtr;
5131 const char *tag;
5132 int tagLen, i;
5134 /* Perform the Garbage Collection if needed. */
5135 Jim_CollectIfNeeded(interp);
5137 refPtr = Jim_Alloc(sizeof(*refPtr));
5138 refPtr->objPtr = objPtr;
5139 Jim_IncrRefCount(objPtr);
5140 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5141 if (cmdNamePtr)
5142 Jim_IncrRefCount(cmdNamePtr);
5143 id = interp->referenceNextId++;
5144 Jim_AddHashEntry(&interp->references, &id, refPtr);
5145 refObjPtr = Jim_NewObj(interp);
5146 refObjPtr->typePtr = &referenceObjType;
5147 refObjPtr->bytes = NULL;
5148 refObjPtr->internalRep.refValue.id = id;
5149 refObjPtr->internalRep.refValue.refPtr = refPtr;
5150 interp->referenceNextId++;
5151 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5152 * that does not pass the 'isrefchar' test is replaced with '_' */
5153 tag = Jim_GetString(tagPtr, &tagLen);
5154 if (tagLen > JIM_REFERENCE_TAGLEN)
5155 tagLen = JIM_REFERENCE_TAGLEN;
5156 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5157 if (i < tagLen && isrefchar(tag[i]))
5158 refPtr->tag[i] = tag[i];
5159 else
5160 refPtr->tag[i] = '_';
5162 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5163 return refObjPtr;
5166 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5168 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5169 return NULL;
5170 return objPtr->internalRep.refValue.refPtr;
5173 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5175 Jim_Reference *refPtr;
5177 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5178 return JIM_ERR;
5179 Jim_IncrRefCount(cmdNamePtr);
5180 if (refPtr->finalizerCmdNamePtr)
5181 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5182 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5183 return JIM_OK;
5186 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5188 Jim_Reference *refPtr;
5190 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5191 return JIM_ERR;
5192 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5193 return JIM_OK;
5196 /* -----------------------------------------------------------------------------
5197 * References Garbage Collection
5198 * ---------------------------------------------------------------------------*/
5200 /* This the hash table type for the "MARK" phase of the GC */
5201 static const Jim_HashTableType JimRefMarkHashTableType = {
5202 JimReferencesHTHashFunction, /* hash function */
5203 JimReferencesHTKeyDup, /* key dup */
5204 NULL, /* val dup */
5205 JimReferencesHTKeyCompare, /* key compare */
5206 JimReferencesHTKeyDestructor, /* key destructor */
5207 NULL /* val destructor */
5210 /* Performs the garbage collection. */
5211 int Jim_Collect(Jim_Interp *interp)
5213 int collected = 0;
5214 #ifndef JIM_BOOTSTRAP
5215 Jim_HashTable marks;
5216 Jim_HashTableIterator htiter;
5217 Jim_HashEntry *he;
5218 Jim_Obj *objPtr;
5220 /* Avoid recursive calls */
5221 if (interp->lastCollectId == -1) {
5222 /* Jim_Collect() already running. Return just now. */
5223 return 0;
5225 interp->lastCollectId = -1;
5227 /* Mark all the references found into the 'mark' hash table.
5228 * The references are searched in every live object that
5229 * is of a type that can contain references. */
5230 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5231 objPtr = interp->liveList;
5232 while (objPtr) {
5233 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5234 const char *str, *p;
5235 int len;
5237 /* If the object is of type reference, to get the
5238 * Id is simple... */
5239 if (objPtr->typePtr == &referenceObjType) {
5240 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5241 #ifdef JIM_DEBUG_GC
5242 printf("MARK (reference): %d refcount: %d" JIM_NL,
5243 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5244 #endif
5245 objPtr = objPtr->nextObjPtr;
5246 continue;
5248 /* Get the string repr of the object we want
5249 * to scan for references. */
5250 p = str = Jim_GetString(objPtr, &len);
5251 /* Skip objects too little to contain references. */
5252 if (len < JIM_REFERENCE_SPACE) {
5253 objPtr = objPtr->nextObjPtr;
5254 continue;
5256 /* Extract references from the object string repr. */
5257 while (1) {
5258 int i;
5259 unsigned long id;
5261 if ((p = strstr(p, "<reference.<")) == NULL)
5262 break;
5263 /* Check if it's a valid reference. */
5264 if (len - (p - str) < JIM_REFERENCE_SPACE)
5265 break;
5266 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5267 break;
5268 for (i = 21; i <= 40; i++)
5269 if (!isdigit(UCHAR(p[i])))
5270 break;
5271 /* Get the ID */
5272 id = strtoul(p + 21, NULL, 10);
5274 /* Ok, a reference for the given ID
5275 * was found. Mark it. */
5276 Jim_AddHashEntry(&marks, &id, NULL);
5277 #ifdef JIM_DEBUG_GC
5278 printf("MARK: %d" JIM_NL, (int)id);
5279 #endif
5280 p += JIM_REFERENCE_SPACE;
5283 objPtr = objPtr->nextObjPtr;
5286 /* Run the references hash table to destroy every reference that
5287 * is not referenced outside (not present in the mark HT). */
5288 JimInitHashTableIterator(&interp->references, &htiter);
5289 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5290 const unsigned long *refId;
5291 Jim_Reference *refPtr;
5293 refId = he->key;
5294 /* Check if in the mark phase we encountered
5295 * this reference. */
5296 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5297 #ifdef JIM_DEBUG_GC
5298 printf("COLLECTING %d" JIM_NL, (int)*refId);
5299 #endif
5300 collected++;
5301 /* Drop the reference, but call the
5302 * finalizer first if registered. */
5303 refPtr = he->u.val;
5304 if (refPtr->finalizerCmdNamePtr) {
5305 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5306 Jim_Obj *objv[3], *oldResult;
5308 JimFormatReference(refstr, refPtr, *refId);
5310 objv[0] = refPtr->finalizerCmdNamePtr;
5311 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5312 objv[2] = refPtr->objPtr;
5314 /* Drop the reference itself */
5315 /* Avoid the finaliser being freed here */
5316 Jim_IncrRefCount(objv[0]);
5317 /* Don't remove the reference from the hash table just yet
5318 * since that will free refPtr, and hence refPtr->objPtr
5321 /* Call the finalizer. Errors ignored. */
5322 oldResult = interp->result;
5323 Jim_IncrRefCount(oldResult);
5324 Jim_EvalObjVector(interp, 3, objv);
5325 Jim_SetResult(interp, oldResult);
5326 Jim_DecrRefCount(interp, oldResult);
5327 Jim_DeleteHashEntry(&interp->references, refId);
5329 Jim_DecrRefCount(interp, objv[0]);
5331 else {
5332 Jim_DeleteHashEntry(&interp->references, refId);
5336 Jim_FreeHashTable(&marks);
5337 interp->lastCollectId = interp->referenceNextId;
5338 interp->lastCollectTime = time(NULL);
5339 #endif /* JIM_BOOTSTRAP */
5340 return collected;
5343 #define JIM_COLLECT_ID_PERIOD 5000
5344 #define JIM_COLLECT_TIME_PERIOD 300
5346 void Jim_CollectIfNeeded(Jim_Interp *interp)
5348 unsigned long elapsedId;
5349 int elapsedTime;
5351 elapsedId = interp->referenceNextId - interp->lastCollectId;
5352 elapsedTime = time(NULL) - interp->lastCollectTime;
5355 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5356 Jim_Collect(interp);
5359 #endif
5361 static int JimIsBigEndian(void)
5363 union {
5364 unsigned short s;
5365 unsigned char c[2];
5366 } uval = {0x0102};
5368 return uval.c[0] == 1;
5371 /* -----------------------------------------------------------------------------
5372 * Interpreter related functions
5373 * ---------------------------------------------------------------------------*/
5375 Jim_Interp *Jim_CreateInterp(void)
5377 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5379 memset(i, 0, sizeof(*i));
5381 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5382 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5383 i->lastCollectTime = time(NULL);
5385 /* Note that we can create objects only after the
5386 * interpreter liveList and freeList pointers are
5387 * initialized to NULL. */
5388 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5389 #ifdef JIM_REFERENCES
5390 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5391 #endif
5392 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5393 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5394 i->emptyObj = Jim_NewEmptyStringObj(i);
5395 i->trueObj = Jim_NewIntObj(i, 1);
5396 i->falseObj = Jim_NewIntObj(i, 0);
5397 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5398 i->errorFileNameObj = i->emptyObj;
5399 i->result = i->emptyObj;
5400 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5401 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5402 i->errorProc = i->emptyObj;
5403 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5404 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5405 Jim_IncrRefCount(i->emptyObj);
5406 Jim_IncrRefCount(i->errorFileNameObj);
5407 Jim_IncrRefCount(i->result);
5408 Jim_IncrRefCount(i->stackTrace);
5409 Jim_IncrRefCount(i->unknown);
5410 Jim_IncrRefCount(i->currentScriptObj);
5411 Jim_IncrRefCount(i->nullScriptObj);
5412 Jim_IncrRefCount(i->errorProc);
5413 Jim_IncrRefCount(i->trueObj);
5414 Jim_IncrRefCount(i->falseObj);
5416 /* Initialize key variables every interpreter should contain */
5417 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5418 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5420 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5421 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5422 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5423 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
5424 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5425 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5426 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5428 return i;
5431 void Jim_FreeInterp(Jim_Interp *i)
5433 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5434 Jim_Obj *objPtr, *nextObjPtr;
5436 Jim_DecrRefCount(i, i->emptyObj);
5437 Jim_DecrRefCount(i, i->trueObj);
5438 Jim_DecrRefCount(i, i->falseObj);
5439 Jim_DecrRefCount(i, i->result);
5440 Jim_DecrRefCount(i, i->stackTrace);
5441 Jim_DecrRefCount(i, i->errorProc);
5442 Jim_DecrRefCount(i, i->unknown);
5443 Jim_DecrRefCount(i, i->errorFileNameObj);
5444 Jim_DecrRefCount(i, i->currentScriptObj);
5445 Jim_DecrRefCount(i, i->nullScriptObj);
5446 Jim_FreeHashTable(&i->commands);
5447 #ifdef JIM_REFERENCES
5448 Jim_FreeHashTable(&i->references);
5449 #endif
5450 Jim_FreeHashTable(&i->packages);
5451 Jim_Free(i->prngState);
5452 Jim_FreeHashTable(&i->assocData);
5454 /* Free the call frames list */
5455 while (cf) {
5456 prevcf = cf->parent;
5457 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5458 cf = prevcf;
5460 /* Check that the live object list is empty, otherwise
5461 * there is a memory leak. */
5462 if (i->liveList != NULL) {
5463 objPtr = i->liveList;
5465 printf(JIM_NL "-------------------------------------" JIM_NL);
5466 printf("Objects still in the free list:" JIM_NL);
5467 while (objPtr) {
5468 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5470 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5471 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5472 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5474 else {
5475 printf("%p (%d) %-10s: '%s'" JIM_NL,
5476 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5478 if (objPtr->typePtr == &sourceObjType) {
5479 printf("FILE %s LINE %d" JIM_NL,
5480 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5481 objPtr->internalRep.sourceValue.lineNumber);
5483 objPtr = objPtr->nextObjPtr;
5485 printf("-------------------------------------" JIM_NL JIM_NL);
5486 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5488 /* Free all the freed objects. */
5489 objPtr = i->freeList;
5490 while (objPtr) {
5491 nextObjPtr = objPtr->nextObjPtr;
5492 Jim_Free(objPtr);
5493 objPtr = nextObjPtr;
5495 /* Free cached CallFrame structures */
5496 cf = i->freeFramesList;
5497 while (cf) {
5498 nextcf = cf->next;
5499 if (cf->vars.table != NULL)
5500 Jim_Free(cf->vars.table);
5501 Jim_Free(cf);
5502 cf = nextcf;
5504 #ifdef jim_ext_load
5505 Jim_FreeLoadHandles(i);
5506 #endif
5508 /* Free the interpreter structure. */
5509 Jim_Free(i);
5512 /* Returns the call frame relative to the level represented by
5513 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5515 * This function accepts the 'level' argument in the form
5516 * of the commands [uplevel] and [upvar].
5518 * For a function accepting a relative integer as level suitable
5519 * for implementation of [info level ?level?] check the
5520 * JimGetCallFrameByInteger() function.
5522 * Returns NULL on error.
5524 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5526 long level;
5527 const char *str;
5528 Jim_CallFrame *framePtr;
5530 if (levelObjPtr) {
5531 str = Jim_String(levelObjPtr);
5532 if (str[0] == '#') {
5533 char *endptr;
5535 level = jim_strtol(str + 1, &endptr);
5536 if (str[1] == '\0' || endptr[0] != '\0') {
5537 level = -1;
5540 else {
5541 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5542 level = -1;
5544 else {
5545 /* Convert from a relative to an absolute level */
5546 level = interp->framePtr->level - level;
5550 else {
5551 str = "1"; /* Needed to format the error message. */
5552 level = interp->framePtr->level - 1;
5555 if (level == 0) {
5556 return interp->topFramePtr;
5558 if (level > 0) {
5559 /* Lookup */
5560 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5561 if (framePtr->level == level) {
5562 return framePtr;
5567 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5568 return NULL;
5571 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5572 * as a relative integer like in the [info level ?level?] command.
5574 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5576 long level;
5577 Jim_CallFrame *framePtr;
5579 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5580 if (level <= 0) {
5581 /* Convert from a relative to an absolute level */
5582 level = interp->framePtr->level + level;
5585 if (level == 0) {
5586 return interp->topFramePtr;
5589 /* Lookup */
5590 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5591 if (framePtr->level == level) {
5592 return framePtr;
5597 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5598 return NULL;
5601 static void JimResetStackTrace(Jim_Interp *interp)
5603 Jim_DecrRefCount(interp, interp->stackTrace);
5604 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5605 Jim_IncrRefCount(interp->stackTrace);
5608 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5610 int len;
5612 /* Increment reference first in case these are the same object */
5613 Jim_IncrRefCount(stackTraceObj);
5614 Jim_DecrRefCount(interp, interp->stackTrace);
5615 interp->stackTrace = stackTraceObj;
5616 interp->errorFlag = 1;
5618 /* This is a bit ugly.
5619 * If the filename of the last entry of the stack trace is empty,
5620 * the next stack level should be added.
5622 len = Jim_ListLength(interp, interp->stackTrace);
5623 if (len >= 3) {
5624 Jim_Obj *filenameObj;
5626 Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj, JIM_NONE);
5628 Jim_GetString(filenameObj, &len);
5630 if (!Jim_Length(filenameObj)) {
5631 interp->addStackTrace = 1;
5636 /* Returns 1 if the stack trace information was used or 0 if not */
5637 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5638 Jim_Obj *fileNameObj, int linenr)
5640 if (strcmp(procname, "unknown") == 0) {
5641 procname = "";
5643 if (!*procname && !Jim_Length(fileNameObj)) {
5644 /* No useful info here */
5645 return;
5648 if (Jim_IsShared(interp->stackTrace)) {
5649 Jim_DecrRefCount(interp, interp->stackTrace);
5650 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5651 Jim_IncrRefCount(interp->stackTrace);
5654 /* If we have no procname but the previous element did, merge with that frame */
5655 if (!*procname && Jim_Length(fileNameObj)) {
5656 /* Just a filename. Check the previous entry */
5657 int len = Jim_ListLength(interp, interp->stackTrace);
5659 if (len >= 3) {
5660 Jim_Obj *objPtr;
5661 if (Jim_ListIndex(interp, interp->stackTrace, len - 3, &objPtr, JIM_NONE) == JIM_OK && Jim_Length(objPtr)) {
5662 /* Yes, the previous level had procname */
5663 if (Jim_ListIndex(interp, interp->stackTrace, len - 2, &objPtr, JIM_NONE) == JIM_OK && !Jim_Length(objPtr)) {
5664 /* But no filename, so merge the new info with that frame */
5665 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5666 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5667 return;
5673 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5674 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5675 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5678 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5679 void *data)
5681 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5683 assocEntryPtr->delProc = delProc;
5684 assocEntryPtr->data = data;
5685 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5688 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5690 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5692 if (entryPtr != NULL) {
5693 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5695 return assocEntryPtr->data;
5697 return NULL;
5700 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5702 return Jim_DeleteHashEntry(&interp->assocData, key);
5705 int Jim_GetExitCode(Jim_Interp *interp)
5707 return interp->exitCode;
5710 /* -----------------------------------------------------------------------------
5711 * Integer object
5712 * ---------------------------------------------------------------------------*/
5713 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5714 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5716 static const Jim_ObjType intObjType = {
5717 "int",
5718 NULL,
5719 NULL,
5720 UpdateStringOfInt,
5721 JIM_TYPE_NONE,
5724 /* A coerced double is closer to an int than a double.
5725 * It is an int value temporarily masquerading as a double value.
5726 * i.e. it has the same string value as an int and Jim_GetWide()
5727 * succeeds, but also Jim_GetDouble() returns the value directly.
5729 static const Jim_ObjType coercedDoubleObjType = {
5730 "coerced-double",
5731 NULL,
5732 NULL,
5733 UpdateStringOfInt,
5734 JIM_TYPE_NONE,
5738 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5740 int len;
5741 char buf[JIM_INTEGER_SPACE + 1];
5743 len = JimWideToString(buf, JimWideValue(objPtr));
5744 objPtr->bytes = Jim_Alloc(len + 1);
5745 memcpy(objPtr->bytes, buf, len + 1);
5746 objPtr->length = len;
5749 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5751 jim_wide wideValue;
5752 const char *str;
5754 if (objPtr->typePtr == &coercedDoubleObjType) {
5755 /* Simple switcheroo */
5756 objPtr->typePtr = &intObjType;
5757 return JIM_OK;
5760 /* Get the string representation */
5761 str = Jim_String(objPtr);
5762 /* Try to convert into a jim_wide */
5763 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5764 if (flags & JIM_ERRMSG) {
5765 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5767 return JIM_ERR;
5769 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5770 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5771 return JIM_ERR;
5773 /* Free the old internal repr and set the new one. */
5774 Jim_FreeIntRep(interp, objPtr);
5775 objPtr->typePtr = &intObjType;
5776 objPtr->internalRep.wideValue = wideValue;
5777 return JIM_OK;
5780 #ifdef JIM_OPTIMIZATION
5781 static int JimIsWide(Jim_Obj *objPtr)
5783 return objPtr->typePtr == &intObjType;
5785 #endif
5787 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5789 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5790 return JIM_ERR;
5791 *widePtr = JimWideValue(objPtr);
5792 return JIM_OK;
5795 /* Get a wide but does not set an error if the format is bad. */
5796 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5798 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5799 return JIM_ERR;
5800 *widePtr = JimWideValue(objPtr);
5801 return JIM_OK;
5804 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5806 jim_wide wideValue;
5807 int retval;
5809 retval = Jim_GetWide(interp, objPtr, &wideValue);
5810 if (retval == JIM_OK) {
5811 *longPtr = (long)wideValue;
5812 return JIM_OK;
5814 return JIM_ERR;
5817 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5819 Jim_Obj *objPtr;
5821 objPtr = Jim_NewObj(interp);
5822 objPtr->typePtr = &intObjType;
5823 objPtr->bytes = NULL;
5824 objPtr->internalRep.wideValue = wideValue;
5825 return objPtr;
5828 /* -----------------------------------------------------------------------------
5829 * Double object
5830 * ---------------------------------------------------------------------------*/
5831 #define JIM_DOUBLE_SPACE 30
5833 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5834 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5836 static const Jim_ObjType doubleObjType = {
5837 "double",
5838 NULL,
5839 NULL,
5840 UpdateStringOfDouble,
5841 JIM_TYPE_NONE,
5844 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5846 int len;
5847 char buf[JIM_DOUBLE_SPACE + 1];
5849 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
5850 objPtr->bytes = Jim_Alloc(len + 1);
5851 memcpy(objPtr->bytes, buf, len + 1);
5852 objPtr->length = len;
5855 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5857 double doubleValue;
5858 jim_wide wideValue;
5859 const char *str;
5861 /* Preserve the string representation.
5862 * Needed so we can convert back to int without loss
5864 str = Jim_String(objPtr);
5866 #ifdef HAVE_LONG_LONG
5867 /* Assume a 53 bit mantissa */
5868 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5869 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5871 if (objPtr->typePtr == &intObjType
5872 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5873 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5875 /* Direct conversion to coerced double */
5876 objPtr->typePtr = &coercedDoubleObjType;
5877 return JIM_OK;
5879 else
5880 #endif
5881 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5882 /* Managed to convert to an int, so we can use this as a cooerced double */
5883 Jim_FreeIntRep(interp, objPtr);
5884 objPtr->typePtr = &coercedDoubleObjType;
5885 objPtr->internalRep.wideValue = wideValue;
5886 return JIM_OK;
5888 else {
5889 /* Try to convert into a double */
5890 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5891 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5892 return JIM_ERR;
5894 /* Free the old internal repr and set the new one. */
5895 Jim_FreeIntRep(interp, objPtr);
5897 objPtr->typePtr = &doubleObjType;
5898 objPtr->internalRep.doubleValue = doubleValue;
5899 return JIM_OK;
5902 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5904 if (objPtr->typePtr == &coercedDoubleObjType) {
5905 *doublePtr = JimWideValue(objPtr);
5906 return JIM_OK;
5908 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5909 return JIM_ERR;
5911 if (objPtr->typePtr == &coercedDoubleObjType) {
5912 *doublePtr = JimWideValue(objPtr);
5914 else {
5915 *doublePtr = objPtr->internalRep.doubleValue;
5917 return JIM_OK;
5920 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5922 Jim_Obj *objPtr;
5924 objPtr = Jim_NewObj(interp);
5925 objPtr->typePtr = &doubleObjType;
5926 objPtr->bytes = NULL;
5927 objPtr->internalRep.doubleValue = doubleValue;
5928 return objPtr;
5931 /* -----------------------------------------------------------------------------
5932 * List object
5933 * ---------------------------------------------------------------------------*/
5934 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
5935 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5936 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5937 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5938 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5939 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5941 /* Note that while the elements of the list may contain references,
5942 * the list object itself can't. This basically means that the
5943 * list object string representation as a whole can't contain references
5944 * that are not presents in the single elements. */
5945 static const Jim_ObjType listObjType = {
5946 "list",
5947 FreeListInternalRep,
5948 DupListInternalRep,
5949 UpdateStringOfList,
5950 JIM_TYPE_NONE,
5953 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5955 int i;
5957 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5958 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5960 Jim_Free(objPtr->internalRep.listValue.ele);
5963 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5965 int i;
5967 JIM_NOTUSED(interp);
5969 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5970 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5971 dupPtr->internalRep.listValue.ele =
5972 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
5973 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5974 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
5975 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5976 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5978 dupPtr->typePtr = &listObjType;
5981 /* The following function checks if a given string can be encoded
5982 * into a list element without any kind of quoting, surrounded by braces,
5983 * or using escapes to quote. */
5984 #define JIM_ELESTR_SIMPLE 0
5985 #define JIM_ELESTR_BRACE 1
5986 #define JIM_ELESTR_QUOTE 2
5987 static unsigned char ListElementQuotingType(const char *s, int len)
5989 int i, level, blevel, trySimple = 1;
5991 /* Try with the SIMPLE case */
5992 if (len == 0)
5993 return JIM_ELESTR_BRACE;
5994 if (s[0] == '"' || s[0] == '{') {
5995 trySimple = 0;
5996 goto testbrace;
5998 for (i = 0; i < len; i++) {
5999 switch (s[i]) {
6000 case ' ':
6001 case '$':
6002 case '"':
6003 case '[':
6004 case ']':
6005 case ';':
6006 case '\\':
6007 case '\r':
6008 case '\n':
6009 case '\t':
6010 case '\f':
6011 case '\v':
6012 trySimple = 0;
6013 case '{':
6014 case '}':
6015 goto testbrace;
6018 return JIM_ELESTR_SIMPLE;
6020 testbrace:
6021 /* Test if it's possible to do with braces */
6022 if (s[len - 1] == '\\')
6023 return JIM_ELESTR_QUOTE;
6024 level = 0;
6025 blevel = 0;
6026 for (i = 0; i < len; i++) {
6027 switch (s[i]) {
6028 case '{':
6029 level++;
6030 break;
6031 case '}':
6032 level--;
6033 if (level < 0)
6034 return JIM_ELESTR_QUOTE;
6035 break;
6036 case '[':
6037 blevel++;
6038 break;
6039 case ']':
6040 blevel--;
6041 break;
6042 case '\\':
6043 if (s[i + 1] == '\n')
6044 return JIM_ELESTR_QUOTE;
6045 else if (s[i + 1] != '\0')
6046 i++;
6047 break;
6050 if (blevel < 0) {
6051 return JIM_ELESTR_QUOTE;
6054 if (level == 0) {
6055 if (!trySimple)
6056 return JIM_ELESTR_BRACE;
6057 for (i = 0; i < len; i++) {
6058 switch (s[i]) {
6059 case ' ':
6060 case '$':
6061 case '"':
6062 case '[':
6063 case ']':
6064 case ';':
6065 case '\\':
6066 case '\r':
6067 case '\n':
6068 case '\t':
6069 case '\f':
6070 case '\v':
6071 return JIM_ELESTR_BRACE;
6072 break;
6075 return JIM_ELESTR_SIMPLE;
6077 return JIM_ELESTR_QUOTE;
6080 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6081 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6082 * scenario.
6083 * Returns the length of the result.
6085 static int BackslashQuoteString(const char *s, char *q)
6087 char *p = q;
6089 while (*s) {
6090 switch (*s) {
6091 case ' ':
6092 case '$':
6093 case '"':
6094 case '[':
6095 case ']':
6096 case '{':
6097 case '}':
6098 case ';':
6099 case '\\':
6100 *p++ = '\\';
6101 *p++ = *s++;
6102 break;
6103 case '\n':
6104 *p++ = '\\';
6105 *p++ = 'n';
6106 s++;
6107 break;
6108 case '\r':
6109 *p++ = '\\';
6110 *p++ = 'r';
6111 s++;
6112 break;
6113 case '\t':
6114 *p++ = '\\';
6115 *p++ = 't';
6116 s++;
6117 break;
6118 case '\f':
6119 *p++ = '\\';
6120 *p++ = 'f';
6121 s++;
6122 break;
6123 case '\v':
6124 *p++ = '\\';
6125 *p++ = 'v';
6126 s++;
6127 break;
6128 default:
6129 *p++ = *s++;
6130 break;
6133 *p = '\0';
6135 return p - q;
6138 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6140 #define STATIC_QUOTING_LEN 32
6141 int i, bufLen, realLength;
6142 const char *strRep;
6143 char *p;
6144 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6146 /* Estimate the space needed. */
6147 if (objc > STATIC_QUOTING_LEN) {
6148 quotingType = Jim_Alloc(objc);
6150 else {
6151 quotingType = staticQuoting;
6153 bufLen = 0;
6154 for (i = 0; i < objc; i++) {
6155 int len;
6157 strRep = Jim_GetString(objv[i], &len);
6158 quotingType[i] = ListElementQuotingType(strRep, len);
6159 switch (quotingType[i]) {
6160 case JIM_ELESTR_SIMPLE:
6161 if (i != 0 || strRep[0] != '#') {
6162 bufLen += len;
6163 break;
6165 /* Special case '#' on first element needs braces */
6166 quotingType[i] = JIM_ELESTR_BRACE;
6167 /* fall through */
6168 case JIM_ELESTR_BRACE:
6169 bufLen += len + 2;
6170 break;
6171 case JIM_ELESTR_QUOTE:
6172 bufLen += len * 2;
6173 break;
6175 bufLen++; /* elements separator. */
6177 bufLen++;
6179 /* Generate the string rep. */
6180 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6181 realLength = 0;
6182 for (i = 0; i < objc; i++) {
6183 int len, qlen;
6185 strRep = Jim_GetString(objv[i], &len);
6187 switch (quotingType[i]) {
6188 case JIM_ELESTR_SIMPLE:
6189 memcpy(p, strRep, len);
6190 p += len;
6191 realLength += len;
6192 break;
6193 case JIM_ELESTR_BRACE:
6194 *p++ = '{';
6195 memcpy(p, strRep, len);
6196 p += len;
6197 *p++ = '}';
6198 realLength += len + 2;
6199 break;
6200 case JIM_ELESTR_QUOTE:
6201 if (i == 0 && strRep[0] == '#') {
6202 *p++ = '\\';
6203 realLength++;
6205 qlen = BackslashQuoteString(strRep, p);
6206 p += qlen;
6207 realLength += qlen;
6208 break;
6210 /* Add a separating space */
6211 if (i + 1 != objc) {
6212 *p++ = ' ';
6213 realLength++;
6216 *p = '\0'; /* nul term. */
6217 objPtr->length = realLength;
6219 if (quotingType != staticQuoting) {
6220 Jim_Free(quotingType);
6224 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6226 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6229 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6231 struct JimParserCtx parser;
6232 const char *str;
6233 int strLen;
6234 Jim_Obj *fileNameObj;
6235 int linenr;
6237 if (objPtr->typePtr == &listObjType) {
6238 return JIM_OK;
6241 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6242 * it also preserves any source location of the dict elements
6243 * which can be very useful
6245 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6246 Jim_Obj **listObjPtrPtr;
6247 int len;
6248 int i;
6250 listObjPtrPtr = JimDictPairs(objPtr, &len);
6251 for (i = 0; i < len; i++) {
6252 Jim_IncrRefCount(listObjPtrPtr[i]);
6255 /* Now just switch the internal rep */
6256 Jim_FreeIntRep(interp, objPtr);
6257 objPtr->typePtr = &listObjType;
6258 objPtr->internalRep.listValue.len = len;
6259 objPtr->internalRep.listValue.maxLen = len;
6260 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6262 return JIM_OK;
6265 /* Try to preserve information about filename / line number */
6266 if (objPtr->typePtr == &sourceObjType) {
6267 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6268 linenr = objPtr->internalRep.sourceValue.lineNumber;
6270 else {
6271 fileNameObj = interp->emptyObj;
6272 linenr = 1;
6274 Jim_IncrRefCount(fileNameObj);
6276 /* Get the string representation */
6277 str = Jim_GetString(objPtr, &strLen);
6279 /* Free the old internal repr just now and initialize the
6280 * new one just now. The string->list conversion can't fail. */
6281 Jim_FreeIntRep(interp, objPtr);
6282 objPtr->typePtr = &listObjType;
6283 objPtr->internalRep.listValue.len = 0;
6284 objPtr->internalRep.listValue.maxLen = 0;
6285 objPtr->internalRep.listValue.ele = NULL;
6287 /* Convert into a list */
6288 if (strLen) {
6289 JimParserInit(&parser, str, strLen, linenr);
6290 while (!parser.eof) {
6291 Jim_Obj *elementPtr;
6293 JimParseList(&parser);
6294 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6295 continue;
6296 elementPtr = JimParserGetTokenObj(interp, &parser);
6297 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6298 ListAppendElement(objPtr, elementPtr);
6301 Jim_DecrRefCount(interp, fileNameObj);
6302 return JIM_OK;
6305 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6307 Jim_Obj *objPtr;
6309 objPtr = Jim_NewObj(interp);
6310 objPtr->typePtr = &listObjType;
6311 objPtr->bytes = NULL;
6312 objPtr->internalRep.listValue.ele = NULL;
6313 objPtr->internalRep.listValue.len = 0;
6314 objPtr->internalRep.listValue.maxLen = 0;
6316 if (len) {
6317 ListInsertElements(objPtr, 0, len, elements);
6320 return objPtr;
6323 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6324 * length of the vector. Note that the user of this function should make
6325 * sure that the list object can't shimmer while the vector returned
6326 * is in use, this vector is the one stored inside the internal representation
6327 * of the list object. This function is not exported, extensions should
6328 * always access to the List object elements using Jim_ListIndex(). */
6329 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6330 Jim_Obj ***listVec)
6332 *listLen = Jim_ListLength(interp, listObj);
6333 *listVec = listObj->internalRep.listValue.ele;
6336 /* Sorting uses ints, but commands may return wide */
6337 static int JimSign(jim_wide w)
6339 if (w == 0) {
6340 return 0;
6342 else if (w < 0) {
6343 return -1;
6345 return 1;
6348 /* ListSortElements type values */
6349 struct lsort_info {
6350 jmp_buf jmpbuf;
6351 Jim_Obj *command;
6352 Jim_Interp *interp;
6353 enum {
6354 JIM_LSORT_ASCII,
6355 JIM_LSORT_NOCASE,
6356 JIM_LSORT_INTEGER,
6357 JIM_LSORT_COMMAND
6358 } type;
6359 int order;
6360 int index;
6361 int indexed;
6362 int (*subfn)(Jim_Obj **, Jim_Obj **);
6365 static struct lsort_info *sort_info;
6367 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6369 Jim_Obj *lObj, *rObj;
6371 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6372 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6373 longjmp(sort_info->jmpbuf, JIM_ERR);
6375 return sort_info->subfn(&lObj, &rObj);
6378 /* Sort the internal rep of a list. */
6379 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6381 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6384 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6386 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6389 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6391 jim_wide lhs = 0, rhs = 0;
6393 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6394 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6395 longjmp(sort_info->jmpbuf, JIM_ERR);
6398 return JimSign(lhs - rhs) * sort_info->order;
6401 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6403 Jim_Obj *compare_script;
6404 int rc;
6406 jim_wide ret = 0;
6408 /* This must be a valid list */
6409 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6410 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6411 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6413 rc = Jim_EvalObj(sort_info->interp, compare_script);
6415 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6416 longjmp(sort_info->jmpbuf, rc);
6419 return JimSign(ret) * sort_info->order;
6422 /* Sort a list *in place*. MUST be called with non-shared objects. */
6423 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6425 struct lsort_info *prev_info;
6427 typedef int (qsort_comparator) (const void *, const void *);
6428 int (*fn) (Jim_Obj **, Jim_Obj **);
6429 Jim_Obj **vector;
6430 int len;
6431 int rc;
6433 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6434 SetListFromAny(interp, listObjPtr);
6436 /* Allow lsort to be called reentrantly */
6437 prev_info = sort_info;
6438 sort_info = info;
6440 vector = listObjPtr->internalRep.listValue.ele;
6441 len = listObjPtr->internalRep.listValue.len;
6442 switch (info->type) {
6443 case JIM_LSORT_ASCII:
6444 fn = ListSortString;
6445 break;
6446 case JIM_LSORT_NOCASE:
6447 fn = ListSortStringNoCase;
6448 break;
6449 case JIM_LSORT_INTEGER:
6450 fn = ListSortInteger;
6451 break;
6452 case JIM_LSORT_COMMAND:
6453 fn = ListSortCommand;
6454 break;
6455 default:
6456 fn = NULL; /* avoid warning */
6457 JimPanic((1, "ListSort called with invalid sort type"));
6460 if (info->indexed) {
6461 /* Need to interpose a "list index" function */
6462 info->subfn = fn;
6463 fn = ListSortIndexHelper;
6466 if ((rc = setjmp(info->jmpbuf)) == 0) {
6467 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6469 Jim_InvalidateStringRep(listObjPtr);
6470 sort_info = prev_info;
6472 return rc;
6475 /* This is the low-level function to insert elements into a list.
6476 * The higher-level Jim_ListInsertElements() performs shared object
6477 * check and invalidate the string repr. This version is used
6478 * in the internals of the List Object and is not exported.
6480 * NOTE: this function can be called only against objects
6481 * with internal type of List.
6483 * An insertion point (idx) of -1 means end-of-list.
6485 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6487 int currentLen = listPtr->internalRep.listValue.len;
6488 int requiredLen = currentLen + elemc;
6489 int i;
6490 Jim_Obj **point;
6492 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6493 if (requiredLen < 2) {
6494 /* Don't do allocations of under 4 pointers. */
6495 requiredLen = 4;
6497 else {
6498 requiredLen *= 2;
6501 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6502 sizeof(Jim_Obj *) * requiredLen);
6504 listPtr->internalRep.listValue.maxLen = requiredLen;
6506 if (idx < 0) {
6507 idx = currentLen;
6509 point = listPtr->internalRep.listValue.ele + idx;
6510 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6511 for (i = 0; i < elemc; ++i) {
6512 point[i] = elemVec[i];
6513 Jim_IncrRefCount(point[i]);
6515 listPtr->internalRep.listValue.len += elemc;
6518 /* Convenience call to ListInsertElements() to append a single element.
6520 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6522 ListInsertElements(listPtr, -1, 1, &objPtr);
6525 /* Appends every element of appendListPtr into listPtr.
6526 * Both have to be of the list type.
6527 * Convenience call to ListInsertElements()
6529 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6531 ListInsertElements(listPtr, -1,
6532 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6535 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6537 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6538 SetListFromAny(interp, listPtr);
6539 Jim_InvalidateStringRep(listPtr);
6540 ListAppendElement(listPtr, objPtr);
6543 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6545 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6546 SetListFromAny(interp, listPtr);
6547 SetListFromAny(interp, appendListPtr);
6548 Jim_InvalidateStringRep(listPtr);
6549 ListAppendList(listPtr, appendListPtr);
6552 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6554 SetListFromAny(interp, objPtr);
6555 return objPtr->internalRep.listValue.len;
6558 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6559 int objc, Jim_Obj *const *objVec)
6561 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6562 SetListFromAny(interp, listPtr);
6563 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6564 idx = listPtr->internalRep.listValue.len;
6565 else if (idx < 0)
6566 idx = 0;
6567 Jim_InvalidateStringRep(listPtr);
6568 ListInsertElements(listPtr, idx, objc, objVec);
6571 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6573 SetListFromAny(interp, listPtr);
6574 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6575 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6576 return NULL;
6578 if (idx < 0)
6579 idx = listPtr->internalRep.listValue.len + idx;
6580 return listPtr->internalRep.listValue.ele[idx];
6583 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6585 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6586 if (*objPtrPtr == NULL) {
6587 if (flags & JIM_ERRMSG) {
6588 Jim_SetResultString(interp, "list index out of range", -1);
6590 return JIM_ERR;
6592 return JIM_OK;
6595 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6596 Jim_Obj *newObjPtr, int flags)
6598 SetListFromAny(interp, listPtr);
6599 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6600 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6601 if (flags & JIM_ERRMSG) {
6602 Jim_SetResultString(interp, "list index out of range", -1);
6604 return JIM_ERR;
6606 if (idx < 0)
6607 idx = listPtr->internalRep.listValue.len + idx;
6608 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6609 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6610 Jim_IncrRefCount(newObjPtr);
6611 return JIM_OK;
6614 /* Modify the list stored into the variable named 'varNamePtr'
6615 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6616 * with the new element 'newObjptr'. */
6617 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6618 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6620 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6621 int shared, i, idx;
6623 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6624 if (objPtr == NULL)
6625 return JIM_ERR;
6626 if ((shared = Jim_IsShared(objPtr)))
6627 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6628 for (i = 0; i < indexc - 1; i++) {
6629 listObjPtr = objPtr;
6630 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6631 goto err;
6632 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6633 goto err;
6635 if (Jim_IsShared(objPtr)) {
6636 objPtr = Jim_DuplicateObj(interp, objPtr);
6637 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6639 Jim_InvalidateStringRep(listObjPtr);
6641 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6642 goto err;
6643 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6644 goto err;
6645 Jim_InvalidateStringRep(objPtr);
6646 Jim_InvalidateStringRep(varObjPtr);
6647 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6648 goto err;
6649 Jim_SetResult(interp, varObjPtr);
6650 return JIM_OK;
6651 err:
6652 if (shared) {
6653 Jim_FreeNewObj(interp, varObjPtr);
6655 return JIM_ERR;
6658 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6660 int i;
6661 int listLen = Jim_ListLength(interp, listObjPtr);
6662 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6664 for (i = 0; i < listLen; ) {
6665 Jim_Obj *objPtr;
6667 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6668 Jim_AppendObj(interp, resObjPtr, objPtr);
6669 if (++i != listLen) {
6670 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6673 return resObjPtr;
6676 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6678 int i;
6680 /* If all the objects in objv are lists,
6681 * it's possible to return a list as result, that's the
6682 * concatenation of all the lists. */
6683 for (i = 0; i < objc; i++) {
6684 if (!Jim_IsList(objv[i]))
6685 break;
6687 if (i == objc) {
6688 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6690 for (i = 0; i < objc; i++)
6691 ListAppendList(objPtr, objv[i]);
6692 return objPtr;
6694 else {
6695 /* Else... we have to glue strings together */
6696 int len = 0, objLen;
6697 char *bytes, *p;
6699 /* Compute the length */
6700 for (i = 0; i < objc; i++) {
6701 Jim_GetString(objv[i], &objLen);
6702 len += objLen;
6704 if (objc)
6705 len += objc - 1;
6706 /* Create the string rep, and a string object holding it. */
6707 p = bytes = Jim_Alloc(len + 1);
6708 for (i = 0; i < objc; i++) {
6709 const char *s = Jim_GetString(objv[i], &objLen);
6711 /* Remove leading space */
6712 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6713 s++;
6714 objLen--;
6715 len--;
6717 /* And trailing space */
6718 while (objLen && (s[objLen - 1] == ' ' ||
6719 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6720 /* Handle trailing backslash-space case */
6721 if (objLen > 1 && s[objLen - 2] == '\\') {
6722 break;
6724 objLen--;
6725 len--;
6727 memcpy(p, s, objLen);
6728 p += objLen;
6729 if (objLen && i + 1 != objc) {
6730 *p++ = ' ';
6732 else if (i + 1 != objc) {
6733 /* Drop the space calcuated for this
6734 * element that is instead null. */
6735 len--;
6738 *p = '\0';
6739 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6743 /* Returns a list composed of the elements in the specified range.
6744 * first and start are directly accepted as Jim_Objects and
6745 * processed for the end?-index? case. */
6746 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6747 Jim_Obj *lastObjPtr)
6749 int first, last;
6750 int len, rangeLen;
6752 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6753 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6754 return NULL;
6755 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6756 first = JimRelToAbsIndex(len, first);
6757 last = JimRelToAbsIndex(len, last);
6758 JimRelToAbsRange(len, &first, &last, &rangeLen);
6759 if (first == 0 && last == len) {
6760 return listObjPtr;
6762 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6765 /* -----------------------------------------------------------------------------
6766 * Dict object
6767 * ---------------------------------------------------------------------------*/
6768 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6769 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6770 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6771 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6773 /* Dict HashTable Type.
6775 * Keys and Values are Jim objects. */
6777 static unsigned int JimObjectHTHashFunction(const void *key)
6779 int len;
6780 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6781 return Jim_GenHashFunction((const unsigned char *)str, len);
6784 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6786 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6789 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6791 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6794 static const Jim_HashTableType JimDictHashTableType = {
6795 JimObjectHTHashFunction, /* hash function */
6796 NULL, /* key dup */
6797 NULL, /* val dup */
6798 JimObjectHTKeyCompare, /* key compare */
6799 JimObjectHTKeyValDestructor, /* key destructor */
6800 JimObjectHTKeyValDestructor /* val destructor */
6803 /* Note that while the elements of the dict may contain references,
6804 * the list object itself can't. This basically means that the
6805 * dict object string representation as a whole can't contain references
6806 * that are not presents in the single elements. */
6807 static const Jim_ObjType dictObjType = {
6808 "dict",
6809 FreeDictInternalRep,
6810 DupDictInternalRep,
6811 UpdateStringOfDict,
6812 JIM_TYPE_NONE,
6815 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6817 JIM_NOTUSED(interp);
6819 Jim_FreeHashTable(objPtr->internalRep.ptr);
6820 Jim_Free(objPtr->internalRep.ptr);
6823 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6825 Jim_HashTable *ht, *dupHt;
6826 Jim_HashTableIterator htiter;
6827 Jim_HashEntry *he;
6829 /* Create a new hash table */
6830 ht = srcPtr->internalRep.ptr;
6831 dupHt = Jim_Alloc(sizeof(*dupHt));
6832 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6833 if (ht->size != 0)
6834 Jim_ExpandHashTable(dupHt, ht->size);
6835 /* Copy every element from the source to the dup hash table */
6836 JimInitHashTableIterator(ht, &htiter);
6837 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6838 const Jim_Obj *keyObjPtr = he->key;
6839 Jim_Obj *valObjPtr = he->u.val;
6841 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6842 Jim_IncrRefCount(valObjPtr);
6843 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6846 dupPtr->internalRep.ptr = dupHt;
6847 dupPtr->typePtr = &dictObjType;
6850 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6852 Jim_HashTable *ht;
6853 Jim_HashTableIterator htiter;
6854 Jim_HashEntry *he;
6855 Jim_Obj **objv;
6856 int i;
6858 ht = dictPtr->internalRep.ptr;
6860 /* Turn the hash table into a flat vector of Jim_Objects. */
6861 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6862 JimInitHashTableIterator(ht, &htiter);
6863 i = 0;
6864 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6865 objv[i++] = (Jim_Obj *)he->key;
6866 objv[i++] = he->u.val;
6868 *len = i;
6869 return objv;
6872 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
6874 /* Turn the hash table into a flat vector of Jim_Objects. */
6875 int len;
6876 Jim_Obj **objv = JimDictPairs(objPtr, &len);
6878 JimMakeListStringRep(objPtr, objv, len);
6880 Jim_Free(objv);
6883 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6885 int listlen;
6887 if (objPtr->typePtr == &dictObjType) {
6888 return JIM_OK;
6891 /* Get the string representation. Do this first so we don't
6892 * change order in case of fast conversion to dict.
6894 Jim_String(objPtr);
6896 /* For simplicity, convert a non-list object to a list and then to a dict */
6897 listlen = Jim_ListLength(interp, objPtr);
6898 if (listlen % 2) {
6899 Jim_SetResultString(interp, "missing value to go with key", -1);
6900 return JIM_ERR;
6902 else {
6903 /* Now it is easy to convert to a dict from a list, and it can't fail */
6904 Jim_HashTable *ht;
6905 int i;
6907 ht = Jim_Alloc(sizeof(*ht));
6908 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6910 for (i = 0; i < listlen; i += 2) {
6911 Jim_Obj *keyObjPtr;
6912 Jim_Obj *valObjPtr;
6914 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
6915 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
6917 Jim_IncrRefCount(keyObjPtr);
6918 Jim_IncrRefCount(valObjPtr);
6920 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
6921 Jim_HashEntry *he;
6923 he = Jim_FindHashEntry(ht, keyObjPtr);
6924 Jim_DecrRefCount(interp, keyObjPtr);
6925 /* ATTENTION: const cast */
6926 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
6927 he->u.val = valObjPtr;
6931 Jim_FreeIntRep(interp, objPtr);
6932 objPtr->typePtr = &dictObjType;
6933 objPtr->internalRep.ptr = ht;
6935 return JIM_OK;
6939 /* Dict object API */
6941 /* Add an element to a dict. objPtr must be of the "dict" type.
6942 * The higer-level exported function is Jim_DictAddElement().
6943 * If an element with the specified key already exists, the value
6944 * associated is replaced with the new one.
6946 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6947 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6948 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6950 Jim_HashTable *ht = objPtr->internalRep.ptr;
6952 if (valueObjPtr == NULL) { /* unset */
6953 return Jim_DeleteHashEntry(ht, keyObjPtr);
6955 Jim_IncrRefCount(keyObjPtr);
6956 Jim_IncrRefCount(valueObjPtr);
6957 if (Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr)) {
6958 /* Value existed, so need to decrement key ref count */
6959 Jim_DecrRefCount(interp, keyObjPtr);
6961 return JIM_OK;
6964 /* Add an element, higher-level interface for DictAddElement().
6965 * If valueObjPtr == NULL, the key is removed if it exists. */
6966 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6967 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6969 int retcode;
6971 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
6972 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
6973 return JIM_ERR;
6975 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
6976 Jim_InvalidateStringRep(objPtr);
6977 return retcode;
6980 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6982 Jim_Obj *objPtr;
6983 int i;
6985 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
6987 objPtr = Jim_NewObj(interp);
6988 objPtr->typePtr = &dictObjType;
6989 objPtr->bytes = NULL;
6990 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
6991 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
6992 for (i = 0; i < len; i += 2)
6993 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
6994 return objPtr;
6997 /* Return the value associated to the specified dict key
6998 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7000 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7001 Jim_Obj **objPtrPtr, int flags)
7003 Jim_HashEntry *he;
7004 Jim_HashTable *ht;
7006 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7007 return -1;
7009 ht = dictPtr->internalRep.ptr;
7010 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7011 if (flags & JIM_ERRMSG) {
7012 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7014 return JIM_ERR;
7016 *objPtrPtr = he->u.val;
7017 return JIM_OK;
7020 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7021 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7023 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7024 return JIM_ERR;
7026 *objPtrPtr = JimDictPairs(dictPtr, len);
7028 return JIM_OK;
7032 /* Return the value associated to the specified dict keys */
7033 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7034 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7036 int i;
7038 if (keyc == 0) {
7039 *objPtrPtr = dictPtr;
7040 return JIM_OK;
7043 for (i = 0; i < keyc; i++) {
7044 Jim_Obj *objPtr;
7046 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7047 if (rc != JIM_OK) {
7048 return rc;
7050 dictPtr = objPtr;
7052 *objPtrPtr = dictPtr;
7053 return JIM_OK;
7056 /* Modify the dict stored into the variable named 'varNamePtr'
7057 * setting the element specified by the 'keyc' keys objects in 'keyv',
7058 * with the new value of the element 'newObjPtr'.
7060 * If newObjPtr == NULL the operation is to remove the given key
7061 * from the dictionary.
7063 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7064 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7066 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7067 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7069 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7070 int shared, i;
7072 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7073 if (objPtr == NULL) {
7074 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7075 /* Cannot remove a key from non existing var */
7076 return JIM_ERR;
7078 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7079 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7080 Jim_FreeNewObj(interp, varObjPtr);
7081 return JIM_ERR;
7084 if ((shared = Jim_IsShared(objPtr)))
7085 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7086 for (i = 0; i < keyc; i++) {
7087 dictObjPtr = objPtr;
7089 /* Check if it's a valid dictionary */
7090 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7091 goto err;
7094 if (i == keyc - 1) {
7095 /* Last key: Note that error on unset with missing last key is OK */
7096 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7097 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7098 goto err;
7101 break;
7104 /* Check if the given key exists. */
7105 Jim_InvalidateStringRep(dictObjPtr);
7106 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7107 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7108 /* This key exists at the current level.
7109 * Make sure it's not shared!. */
7110 if (Jim_IsShared(objPtr)) {
7111 objPtr = Jim_DuplicateObj(interp, objPtr);
7112 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7115 else {
7116 /* Key not found. If it's an [unset] operation
7117 * this is an error. Only the last key may not
7118 * exist. */
7119 if (newObjPtr == NULL) {
7120 goto err;
7122 /* Otherwise set an empty dictionary
7123 * as key's value. */
7124 objPtr = Jim_NewDictObj(interp, NULL, 0);
7125 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7128 Jim_InvalidateStringRep(objPtr);
7129 Jim_InvalidateStringRep(varObjPtr);
7130 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7131 goto err;
7133 Jim_SetResult(interp, varObjPtr);
7134 return JIM_OK;
7135 err:
7136 if (shared) {
7137 Jim_FreeNewObj(interp, varObjPtr);
7139 return JIM_ERR;
7142 /* -----------------------------------------------------------------------------
7143 * Index object
7144 * ---------------------------------------------------------------------------*/
7145 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7146 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7148 static const Jim_ObjType indexObjType = {
7149 "index",
7150 NULL,
7151 NULL,
7152 UpdateStringOfIndex,
7153 JIM_TYPE_NONE,
7156 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7158 int len;
7159 char buf[JIM_INTEGER_SPACE + 1];
7161 if (objPtr->internalRep.intValue >= 0)
7162 len = sprintf(buf, "%d", objPtr->internalRep.intValue);
7163 else if (objPtr->internalRep.intValue == -1)
7164 len = sprintf(buf, "end");
7165 else {
7166 len = sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7168 objPtr->bytes = Jim_Alloc(len + 1);
7169 memcpy(objPtr->bytes, buf, len + 1);
7170 objPtr->length = len;
7173 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7175 int idx, end = 0;
7176 const char *str;
7177 char *endptr;
7179 /* Get the string representation */
7180 str = Jim_String(objPtr);
7182 /* Try to convert into an index */
7183 if (strncmp(str, "end", 3) == 0) {
7184 end = 1;
7185 str += 3;
7186 idx = 0;
7188 else {
7189 idx = jim_strtol(str, &endptr);
7191 if (endptr == str) {
7192 goto badindex;
7194 str = endptr;
7197 /* Now str may include or +<num> or -<num> */
7198 if (*str == '+' || *str == '-') {
7199 int sign = (*str == '+' ? 1 : -1);
7201 idx += sign * jim_strtol(++str, &endptr);
7202 if (str == endptr || *endptr) {
7203 goto badindex;
7205 str = endptr;
7207 /* The only thing left should be spaces */
7208 while (isspace(UCHAR(*str))) {
7209 str++;
7211 if (*str) {
7212 goto badindex;
7214 if (end) {
7215 if (idx > 0) {
7216 idx = INT_MAX;
7218 else {
7219 /* end-1 is repesented as -2 */
7220 idx--;
7223 else if (idx < 0) {
7224 idx = -INT_MAX;
7227 /* Free the old internal repr and set the new one. */
7228 Jim_FreeIntRep(interp, objPtr);
7229 objPtr->typePtr = &indexObjType;
7230 objPtr->internalRep.intValue = idx;
7231 return JIM_OK;
7233 badindex:
7234 Jim_SetResultFormatted(interp,
7235 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7236 return JIM_ERR;
7239 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7241 /* Avoid shimmering if the object is an integer. */
7242 if (objPtr->typePtr == &intObjType) {
7243 jim_wide val = JimWideValue(objPtr);
7245 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7246 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7247 return JIM_OK;
7250 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7251 return JIM_ERR;
7252 *indexPtr = objPtr->internalRep.intValue;
7253 return JIM_OK;
7256 /* -----------------------------------------------------------------------------
7257 * Return Code Object.
7258 * ---------------------------------------------------------------------------*/
7260 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7261 static const char * const jimReturnCodes[] = {
7262 "ok",
7263 "error",
7264 "return",
7265 "break",
7266 "continue",
7267 "signal",
7268 "exit",
7269 "eval",
7270 NULL
7273 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7275 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7277 static const Jim_ObjType returnCodeObjType = {
7278 "return-code",
7279 NULL,
7280 NULL,
7281 NULL,
7282 JIM_TYPE_NONE,
7285 /* Converts a (standard) return code to a string. Returns "?" for
7286 * non-standard return codes.
7288 const char *Jim_ReturnCode(int code)
7290 if (code < 0 || code >= (int)jimReturnCodesSize) {
7291 return "?";
7293 else {
7294 return jimReturnCodes[code];
7298 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7300 int returnCode;
7301 jim_wide wideValue;
7303 /* Try to convert into an integer */
7304 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7305 returnCode = (int)wideValue;
7306 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7307 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7308 return JIM_ERR;
7310 /* Free the old internal repr and set the new one. */
7311 Jim_FreeIntRep(interp, objPtr);
7312 objPtr->typePtr = &returnCodeObjType;
7313 objPtr->internalRep.intValue = returnCode;
7314 return JIM_OK;
7317 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7319 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7320 return JIM_ERR;
7321 *intPtr = objPtr->internalRep.intValue;
7322 return JIM_OK;
7325 /* -----------------------------------------------------------------------------
7326 * Expression Parsing
7327 * ---------------------------------------------------------------------------*/
7328 static int JimParseExprOperator(struct JimParserCtx *pc);
7329 static int JimParseExprNumber(struct JimParserCtx *pc);
7330 static int JimParseExprIrrational(struct JimParserCtx *pc);
7332 /* Exrp's Stack machine operators opcodes. */
7334 /* Binary operators (numbers) */
7335 enum
7337 /* Continues on from the JIM_TT_ space */
7338 /* Operations */
7339 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7340 JIM_EXPROP_DIV,
7341 JIM_EXPROP_MOD,
7342 JIM_EXPROP_SUB,
7343 JIM_EXPROP_ADD,
7344 JIM_EXPROP_LSHIFT,
7345 JIM_EXPROP_RSHIFT,
7346 JIM_EXPROP_ROTL,
7347 JIM_EXPROP_ROTR,
7348 JIM_EXPROP_LT,
7349 JIM_EXPROP_GT,
7350 JIM_EXPROP_LTE,
7351 JIM_EXPROP_GTE,
7352 JIM_EXPROP_NUMEQ,
7353 JIM_EXPROP_NUMNE,
7354 JIM_EXPROP_BITAND, /* 35 */
7355 JIM_EXPROP_BITXOR,
7356 JIM_EXPROP_BITOR,
7358 /* Note must keep these together */
7359 JIM_EXPROP_LOGICAND, /* 38 */
7360 JIM_EXPROP_LOGICAND_LEFT,
7361 JIM_EXPROP_LOGICAND_RIGHT,
7363 /* and these */
7364 JIM_EXPROP_LOGICOR, /* 41 */
7365 JIM_EXPROP_LOGICOR_LEFT,
7366 JIM_EXPROP_LOGICOR_RIGHT,
7368 /* and these */
7369 /* Ternary operators */
7370 JIM_EXPROP_TERNARY, /* 44 */
7371 JIM_EXPROP_TERNARY_LEFT,
7372 JIM_EXPROP_TERNARY_RIGHT,
7374 /* and these */
7375 JIM_EXPROP_COLON, /* 47 */
7376 JIM_EXPROP_COLON_LEFT,
7377 JIM_EXPROP_COLON_RIGHT,
7379 JIM_EXPROP_POW, /* 50 */
7381 /* Binary operators (strings) */
7382 JIM_EXPROP_STREQ, /* 51 */
7383 JIM_EXPROP_STRNE,
7384 JIM_EXPROP_STRIN,
7385 JIM_EXPROP_STRNI,
7387 /* Unary operators (numbers) */
7388 JIM_EXPROP_NOT, /* 55 */
7389 JIM_EXPROP_BITNOT,
7390 JIM_EXPROP_UNARYMINUS,
7391 JIM_EXPROP_UNARYPLUS,
7393 /* Functions */
7394 JIM_EXPROP_FUNC_FIRST, /* 59 */
7395 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7396 JIM_EXPROP_FUNC_ABS,
7397 JIM_EXPROP_FUNC_DOUBLE,
7398 JIM_EXPROP_FUNC_ROUND,
7399 JIM_EXPROP_FUNC_RAND,
7400 JIM_EXPROP_FUNC_SRAND,
7402 /* math functions from libm */
7403 JIM_EXPROP_FUNC_SIN, /* 64 */
7404 JIM_EXPROP_FUNC_COS,
7405 JIM_EXPROP_FUNC_TAN,
7406 JIM_EXPROP_FUNC_ASIN,
7407 JIM_EXPROP_FUNC_ACOS,
7408 JIM_EXPROP_FUNC_ATAN,
7409 JIM_EXPROP_FUNC_SINH,
7410 JIM_EXPROP_FUNC_COSH,
7411 JIM_EXPROP_FUNC_TANH,
7412 JIM_EXPROP_FUNC_CEIL,
7413 JIM_EXPROP_FUNC_FLOOR,
7414 JIM_EXPROP_FUNC_EXP,
7415 JIM_EXPROP_FUNC_LOG,
7416 JIM_EXPROP_FUNC_LOG10,
7417 JIM_EXPROP_FUNC_SQRT,
7418 JIM_EXPROP_FUNC_POW,
7421 struct JimExprState
7423 Jim_Obj **stack;
7424 int stacklen;
7425 int opcode;
7426 int skip;
7429 /* Operators table */
7430 typedef struct Jim_ExprOperator
7432 const char *name;
7433 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7434 unsigned char precedence;
7435 unsigned char arity;
7436 unsigned char lazy;
7437 unsigned char namelen;
7438 } Jim_ExprOperator;
7440 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7442 Jim_IncrRefCount(obj);
7443 e->stack[e->stacklen++] = obj;
7446 static Jim_Obj *ExprPop(struct JimExprState *e)
7448 return e->stack[--e->stacklen];
7451 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7453 int intresult = 0;
7454 int rc = JIM_OK;
7455 Jim_Obj *A = ExprPop(e);
7456 double dA, dC = 0;
7457 jim_wide wA, wC = 0;
7459 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7460 intresult = 1;
7462 switch (e->opcode) {
7463 case JIM_EXPROP_FUNC_INT:
7464 wC = wA;
7465 break;
7466 case JIM_EXPROP_FUNC_ROUND:
7467 wC = wA;
7468 break;
7469 case JIM_EXPROP_FUNC_DOUBLE:
7470 dC = wA;
7471 intresult = 0;
7472 break;
7473 case JIM_EXPROP_FUNC_ABS:
7474 wC = wA >= 0 ? wA : -wA;
7475 break;
7476 case JIM_EXPROP_UNARYMINUS:
7477 wC = -wA;
7478 break;
7479 case JIM_EXPROP_UNARYPLUS:
7480 wC = wA;
7481 break;
7482 case JIM_EXPROP_NOT:
7483 wC = !wA;
7484 break;
7485 default:
7486 abort();
7489 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7490 switch (e->opcode) {
7491 case JIM_EXPROP_FUNC_INT:
7492 wC = dA;
7493 intresult = 1;
7494 break;
7495 case JIM_EXPROP_FUNC_ROUND:
7496 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7497 intresult = 1;
7498 break;
7499 case JIM_EXPROP_FUNC_DOUBLE:
7500 dC = dA;
7501 break;
7502 case JIM_EXPROP_FUNC_ABS:
7503 dC = dA >= 0 ? dA : -dA;
7504 break;
7505 case JIM_EXPROP_UNARYMINUS:
7506 dC = -dA;
7507 break;
7508 case JIM_EXPROP_UNARYPLUS:
7509 dC = dA;
7510 break;
7511 case JIM_EXPROP_NOT:
7512 wC = !dA;
7513 intresult = 1;
7514 break;
7515 default:
7516 abort();
7520 if (rc == JIM_OK) {
7521 if (intresult) {
7522 ExprPush(e, Jim_NewIntObj(interp, wC));
7524 else {
7525 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7529 Jim_DecrRefCount(interp, A);
7531 return rc;
7534 static double JimRandDouble(Jim_Interp *interp)
7536 unsigned long x;
7537 JimRandomBytes(interp, &x, sizeof(x));
7539 return (double)x / (unsigned long)~0;
7542 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7544 Jim_Obj *A = ExprPop(e);
7545 jim_wide wA;
7547 int rc = Jim_GetWide(interp, A, &wA);
7548 if (rc == JIM_OK) {
7549 switch (e->opcode) {
7550 case JIM_EXPROP_BITNOT:
7551 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7552 break;
7553 case JIM_EXPROP_FUNC_SRAND:
7554 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7555 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7556 break;
7557 default:
7558 abort();
7562 Jim_DecrRefCount(interp, A);
7564 return rc;
7567 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7569 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7571 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7573 return JIM_OK;
7576 #ifdef JIM_MATH_FUNCTIONS
7577 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7579 int rc;
7580 Jim_Obj *A = ExprPop(e);
7581 double dA, dC;
7583 rc = Jim_GetDouble(interp, A, &dA);
7584 if (rc == JIM_OK) {
7585 switch (e->opcode) {
7586 case JIM_EXPROP_FUNC_SIN:
7587 dC = sin(dA);
7588 break;
7589 case JIM_EXPROP_FUNC_COS:
7590 dC = cos(dA);
7591 break;
7592 case JIM_EXPROP_FUNC_TAN:
7593 dC = tan(dA);
7594 break;
7595 case JIM_EXPROP_FUNC_ASIN:
7596 dC = asin(dA);
7597 break;
7598 case JIM_EXPROP_FUNC_ACOS:
7599 dC = acos(dA);
7600 break;
7601 case JIM_EXPROP_FUNC_ATAN:
7602 dC = atan(dA);
7603 break;
7604 case JIM_EXPROP_FUNC_SINH:
7605 dC = sinh(dA);
7606 break;
7607 case JIM_EXPROP_FUNC_COSH:
7608 dC = cosh(dA);
7609 break;
7610 case JIM_EXPROP_FUNC_TANH:
7611 dC = tanh(dA);
7612 break;
7613 case JIM_EXPROP_FUNC_CEIL:
7614 dC = ceil(dA);
7615 break;
7616 case JIM_EXPROP_FUNC_FLOOR:
7617 dC = floor(dA);
7618 break;
7619 case JIM_EXPROP_FUNC_EXP:
7620 dC = exp(dA);
7621 break;
7622 case JIM_EXPROP_FUNC_LOG:
7623 dC = log(dA);
7624 break;
7625 case JIM_EXPROP_FUNC_LOG10:
7626 dC = log10(dA);
7627 break;
7628 case JIM_EXPROP_FUNC_SQRT:
7629 dC = sqrt(dA);
7630 break;
7631 default:
7632 abort();
7634 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7637 Jim_DecrRefCount(interp, A);
7639 return rc;
7641 #endif
7643 /* A binary operation on two ints */
7644 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7646 Jim_Obj *B = ExprPop(e);
7647 Jim_Obj *A = ExprPop(e);
7648 jim_wide wA, wB;
7649 int rc = JIM_ERR;
7651 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7652 jim_wide wC;
7654 rc = JIM_OK;
7656 switch (e->opcode) {
7657 case JIM_EXPROP_LSHIFT:
7658 wC = wA << wB;
7659 break;
7660 case JIM_EXPROP_RSHIFT:
7661 wC = wA >> wB;
7662 break;
7663 case JIM_EXPROP_BITAND:
7664 wC = wA & wB;
7665 break;
7666 case JIM_EXPROP_BITXOR:
7667 wC = wA ^ wB;
7668 break;
7669 case JIM_EXPROP_BITOR:
7670 wC = wA | wB;
7671 break;
7672 case JIM_EXPROP_MOD:
7673 if (wB == 0) {
7674 wC = 0;
7675 Jim_SetResultString(interp, "Division by zero", -1);
7676 rc = JIM_ERR;
7678 else {
7680 * From Tcl 8.x
7682 * This code is tricky: C doesn't guarantee much
7683 * about the quotient or remainder, but Tcl does.
7684 * The remainder always has the same sign as the
7685 * divisor and a smaller absolute value.
7687 int negative = 0;
7689 if (wB < 0) {
7690 wB = -wB;
7691 wA = -wA;
7692 negative = 1;
7694 wC = wA % wB;
7695 if (wC < 0) {
7696 wC += wB;
7698 if (negative) {
7699 wC = -wC;
7702 break;
7703 case JIM_EXPROP_ROTL:
7704 case JIM_EXPROP_ROTR:{
7705 /* uint32_t would be better. But not everyone has inttypes.h? */
7706 unsigned long uA = (unsigned long)wA;
7707 unsigned long uB = (unsigned long)wB;
7708 const unsigned int S = sizeof(unsigned long) * 8;
7710 /* Shift left by the word size or more is undefined. */
7711 uB %= S;
7713 if (e->opcode == JIM_EXPROP_ROTR) {
7714 uB = S - uB;
7716 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7717 break;
7719 default:
7720 abort();
7722 ExprPush(e, Jim_NewIntObj(interp, wC));
7726 Jim_DecrRefCount(interp, A);
7727 Jim_DecrRefCount(interp, B);
7729 return rc;
7733 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7734 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7736 int intresult = 0;
7737 int rc = JIM_OK;
7738 double dA, dB, dC = 0;
7739 jim_wide wA, wB, wC = 0;
7741 Jim_Obj *B = ExprPop(e);
7742 Jim_Obj *A = ExprPop(e);
7744 if ((A->typePtr != &doubleObjType || A->bytes) &&
7745 (B->typePtr != &doubleObjType || B->bytes) &&
7746 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7748 /* Both are ints */
7750 intresult = 1;
7752 switch (e->opcode) {
7753 case JIM_EXPROP_POW:
7754 case JIM_EXPROP_FUNC_POW:
7755 wC = JimPowWide(wA, wB);
7756 break;
7757 case JIM_EXPROP_ADD:
7758 wC = wA + wB;
7759 break;
7760 case JIM_EXPROP_SUB:
7761 wC = wA - wB;
7762 break;
7763 case JIM_EXPROP_MUL:
7764 wC = wA * wB;
7765 break;
7766 case JIM_EXPROP_DIV:
7767 if (wB == 0) {
7768 Jim_SetResultString(interp, "Division by zero", -1);
7769 rc = JIM_ERR;
7771 else {
7773 * From Tcl 8.x
7775 * This code is tricky: C doesn't guarantee much
7776 * about the quotient or remainder, but Tcl does.
7777 * The remainder always has the same sign as the
7778 * divisor and a smaller absolute value.
7780 if (wB < 0) {
7781 wB = -wB;
7782 wA = -wA;
7784 wC = wA / wB;
7785 if (wA % wB < 0) {
7786 wC--;
7789 break;
7790 case JIM_EXPROP_LT:
7791 wC = wA < wB;
7792 break;
7793 case JIM_EXPROP_GT:
7794 wC = wA > wB;
7795 break;
7796 case JIM_EXPROP_LTE:
7797 wC = wA <= wB;
7798 break;
7799 case JIM_EXPROP_GTE:
7800 wC = wA >= wB;
7801 break;
7802 case JIM_EXPROP_NUMEQ:
7803 wC = wA == wB;
7804 break;
7805 case JIM_EXPROP_NUMNE:
7806 wC = wA != wB;
7807 break;
7808 default:
7809 abort();
7812 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7813 switch (e->opcode) {
7814 case JIM_EXPROP_POW:
7815 case JIM_EXPROP_FUNC_POW:
7816 #ifdef JIM_MATH_FUNCTIONS
7817 dC = pow(dA, dB);
7818 #else
7819 Jim_SetResultString(interp, "unsupported", -1);
7820 rc = JIM_ERR;
7821 #endif
7822 break;
7823 case JIM_EXPROP_ADD:
7824 dC = dA + dB;
7825 break;
7826 case JIM_EXPROP_SUB:
7827 dC = dA - dB;
7828 break;
7829 case JIM_EXPROP_MUL:
7830 dC = dA * dB;
7831 break;
7832 case JIM_EXPROP_DIV:
7833 if (dB == 0) {
7834 #ifdef INFINITY
7835 dC = dA < 0 ? -INFINITY : INFINITY;
7836 #else
7837 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7838 #endif
7840 else {
7841 dC = dA / dB;
7843 break;
7844 case JIM_EXPROP_LT:
7845 wC = dA < dB;
7846 intresult = 1;
7847 break;
7848 case JIM_EXPROP_GT:
7849 wC = dA > dB;
7850 intresult = 1;
7851 break;
7852 case JIM_EXPROP_LTE:
7853 wC = dA <= dB;
7854 intresult = 1;
7855 break;
7856 case JIM_EXPROP_GTE:
7857 wC = dA >= dB;
7858 intresult = 1;
7859 break;
7860 case JIM_EXPROP_NUMEQ:
7861 wC = dA == dB;
7862 intresult = 1;
7863 break;
7864 case JIM_EXPROP_NUMNE:
7865 wC = dA != dB;
7866 intresult = 1;
7867 break;
7868 default:
7869 abort();
7872 else {
7873 /* Handle the string case */
7875 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7876 int i = Jim_StringCompareObj(interp, A, B, 0);
7878 intresult = 1;
7880 switch (e->opcode) {
7881 case JIM_EXPROP_LT:
7882 wC = i < 0;
7883 break;
7884 case JIM_EXPROP_GT:
7885 wC = i > 0;
7886 break;
7887 case JIM_EXPROP_LTE:
7888 wC = i <= 0;
7889 break;
7890 case JIM_EXPROP_GTE:
7891 wC = i >= 0;
7892 break;
7893 case JIM_EXPROP_NUMEQ:
7894 wC = i == 0;
7895 break;
7896 case JIM_EXPROP_NUMNE:
7897 wC = i != 0;
7898 break;
7899 default:
7900 rc = JIM_ERR;
7901 break;
7905 if (rc == JIM_OK) {
7906 if (intresult) {
7907 ExprPush(e, Jim_NewIntObj(interp, wC));
7909 else {
7910 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7914 Jim_DecrRefCount(interp, A);
7915 Jim_DecrRefCount(interp, B);
7917 return rc;
7920 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
7922 int listlen;
7923 int i;
7925 listlen = Jim_ListLength(interp, listObjPtr);
7926 for (i = 0; i < listlen; i++) {
7927 Jim_Obj *objPtr;
7929 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
7931 if (Jim_StringEqObj(objPtr, valObj)) {
7932 return 1;
7935 return 0;
7938 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
7940 Jim_Obj *B = ExprPop(e);
7941 Jim_Obj *A = ExprPop(e);
7943 jim_wide wC;
7945 switch (e->opcode) {
7946 case JIM_EXPROP_STREQ:
7947 case JIM_EXPROP_STRNE: {
7948 int Alen, Blen;
7949 const char *sA = Jim_GetString(A, &Alen);
7950 const char *sB = Jim_GetString(B, &Blen);
7952 if (e->opcode == JIM_EXPROP_STREQ) {
7953 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7955 else {
7956 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7958 break;
7960 case JIM_EXPROP_STRIN:
7961 wC = JimSearchList(interp, B, A);
7962 break;
7963 case JIM_EXPROP_STRNI:
7964 wC = !JimSearchList(interp, B, A);
7965 break;
7966 default:
7967 abort();
7969 ExprPush(e, Jim_NewIntObj(interp, wC));
7971 Jim_DecrRefCount(interp, A);
7972 Jim_DecrRefCount(interp, B);
7974 return JIM_OK;
7977 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
7979 long l;
7980 double d;
7982 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
7983 return l != 0;
7985 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
7986 return d != 0;
7988 return -1;
7991 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
7993 Jim_Obj *skip = ExprPop(e);
7994 Jim_Obj *A = ExprPop(e);
7995 int rc = JIM_OK;
7997 switch (ExprBool(interp, A)) {
7998 case 0:
7999 /* false, so skip RHS opcodes with a 0 result */
8000 e->skip = JimWideValue(skip);
8001 ExprPush(e, Jim_NewIntObj(interp, 0));
8002 break;
8004 case 1:
8005 /* true so continue */
8006 break;
8008 case -1:
8009 /* Invalid */
8010 rc = JIM_ERR;
8012 Jim_DecrRefCount(interp, A);
8013 Jim_DecrRefCount(interp, skip);
8015 return rc;
8018 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8020 Jim_Obj *skip = ExprPop(e);
8021 Jim_Obj *A = ExprPop(e);
8022 int rc = JIM_OK;
8024 switch (ExprBool(interp, A)) {
8025 case 0:
8026 /* false, so do nothing */
8027 break;
8029 case 1:
8030 /* true so skip RHS opcodes with a 1 result */
8031 e->skip = JimWideValue(skip);
8032 ExprPush(e, Jim_NewIntObj(interp, 1));
8033 break;
8035 case -1:
8036 /* Invalid */
8037 rc = JIM_ERR;
8038 break;
8040 Jim_DecrRefCount(interp, A);
8041 Jim_DecrRefCount(interp, skip);
8043 return rc;
8046 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8048 Jim_Obj *A = ExprPop(e);
8049 int rc = JIM_OK;
8051 switch (ExprBool(interp, A)) {
8052 case 0:
8053 ExprPush(e, Jim_NewIntObj(interp, 0));
8054 break;
8056 case 1:
8057 ExprPush(e, Jim_NewIntObj(interp, 1));
8058 break;
8060 case -1:
8061 /* Invalid */
8062 rc = JIM_ERR;
8063 break;
8065 Jim_DecrRefCount(interp, A);
8067 return rc;
8070 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8072 Jim_Obj *skip = ExprPop(e);
8073 Jim_Obj *A = ExprPop(e);
8074 int rc = JIM_OK;
8076 /* Repush A */
8077 ExprPush(e, A);
8079 switch (ExprBool(interp, A)) {
8080 case 0:
8081 /* false, skip RHS opcodes */
8082 e->skip = JimWideValue(skip);
8083 /* Push a dummy value */
8084 ExprPush(e, Jim_NewIntObj(interp, 0));
8085 break;
8087 case 1:
8088 /* true so do nothing */
8089 break;
8091 case -1:
8092 /* Invalid */
8093 rc = JIM_ERR;
8094 break;
8096 Jim_DecrRefCount(interp, A);
8097 Jim_DecrRefCount(interp, skip);
8099 return rc;
8102 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8104 Jim_Obj *skip = ExprPop(e);
8105 Jim_Obj *B = ExprPop(e);
8106 Jim_Obj *A = ExprPop(e);
8108 /* No need to check for A as non-boolean */
8109 if (ExprBool(interp, A)) {
8110 /* true, so skip RHS opcodes */
8111 e->skip = JimWideValue(skip);
8112 /* Repush B as the answer */
8113 ExprPush(e, B);
8116 Jim_DecrRefCount(interp, skip);
8117 Jim_DecrRefCount(interp, A);
8118 Jim_DecrRefCount(interp, B);
8119 return JIM_OK;
8122 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8124 return JIM_OK;
8127 enum
8129 LAZY_NONE,
8130 LAZY_OP,
8131 LAZY_LEFT,
8132 LAZY_RIGHT
8135 /* name - precedence - arity - opcode
8137 * This array *must* be kept in sync with the JIM_EXPROP enum.
8139 * The following macro pre-computes the string length at compile time.
8141 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8143 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8144 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8145 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8146 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8148 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8149 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8151 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8152 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8154 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8155 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8157 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8158 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8159 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8160 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8162 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8163 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8165 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8166 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8167 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8169 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8170 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8171 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8173 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8174 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8175 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8177 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8178 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8179 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8181 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8182 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8183 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8185 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8187 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8188 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8190 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8191 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8193 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8194 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8195 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8196 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8200 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8201 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8202 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8203 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8204 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8205 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8207 #ifdef JIM_MATH_FUNCTIONS
8208 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8209 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8210 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8211 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8212 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8213 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8214 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8215 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8216 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8217 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8218 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8219 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8220 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8221 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8222 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8223 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8224 #endif
8226 #undef OPRINIT
8228 #define JIM_EXPR_OPERATORS_NUM \
8229 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8231 static int JimParseExpression(struct JimParserCtx *pc)
8233 /* Discard spaces and quoted newline */
8234 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8235 if (*pc->p == '\n') {
8236 pc->linenr++;
8238 pc->p++;
8239 pc->len--;
8242 if (pc->len == 0) {
8243 pc->tstart = pc->tend = pc->p;
8244 pc->tline = pc->linenr;
8245 pc->tt = JIM_TT_EOL;
8246 pc->eof = 1;
8247 return JIM_OK;
8249 switch (*(pc->p)) {
8250 case '(':
8251 pc->tt = JIM_TT_SUBEXPR_START;
8252 goto singlechar;
8253 case ')':
8254 pc->tt = JIM_TT_SUBEXPR_END;
8255 goto singlechar;
8256 case ',':
8257 pc->tt = JIM_TT_SUBEXPR_COMMA;
8258 singlechar:
8259 pc->tstart = pc->tend = pc->p;
8260 pc->tline = pc->linenr;
8261 pc->p++;
8262 pc->len--;
8263 break;
8264 case '[':
8265 return JimParseCmd(pc);
8266 case '$':
8267 if (JimParseVar(pc) == JIM_ERR)
8268 return JimParseExprOperator(pc);
8269 else {
8270 /* Don't allow expr sugar in expressions */
8271 if (pc->tt == JIM_TT_EXPRSUGAR) {
8272 return JIM_ERR;
8274 return JIM_OK;
8276 break;
8277 case '0':
8278 case '1':
8279 case '2':
8280 case '3':
8281 case '4':
8282 case '5':
8283 case '6':
8284 case '7':
8285 case '8':
8286 case '9':
8287 case '.':
8288 return JimParseExprNumber(pc);
8289 case '"':
8290 return JimParseQuote(pc);
8291 case '{':
8292 return JimParseBrace(pc);
8294 case 'N':
8295 case 'I':
8296 case 'n':
8297 case 'i':
8298 if (JimParseExprIrrational(pc) == JIM_ERR)
8299 return JimParseExprOperator(pc);
8300 break;
8301 default:
8302 return JimParseExprOperator(pc);
8303 break;
8305 return JIM_OK;
8308 static int JimParseExprNumber(struct JimParserCtx *pc)
8310 int allowdot = 1;
8311 int base = 10;
8313 /* Assume an integer for now */
8314 pc->tt = JIM_TT_EXPR_INT;
8315 pc->tstart = pc->p;
8316 pc->tline = pc->linenr;
8318 /* Parse initial 0<x> */
8319 if (pc->p[0] == '0') {
8320 switch (pc->p[1]) {
8321 case 'x':
8322 case 'X':
8323 base = 16;
8324 allowdot = 0;
8325 pc->p += 2;
8326 pc->len -= 2;
8327 break;
8328 case 'o':
8329 case 'O':
8330 base = 8;
8331 allowdot = 0;
8332 pc->p += 2;
8333 pc->len -= 2;
8334 break;
8335 case 'b':
8336 case 'B':
8337 base = 2;
8338 allowdot = 0;
8339 pc->p += 2;
8340 pc->len -= 2;
8341 break;
8345 while (isdigit(UCHAR(*pc->p))
8346 || (base == 16 && isxdigit(UCHAR(*pc->p)))
8347 || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
8348 || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
8349 || (allowdot && *pc->p == '.')
8351 if (*pc->p == '.') {
8352 allowdot = 0;
8353 pc->tt = JIM_TT_EXPR_DOUBLE;
8355 pc->p++;
8356 pc->len--;
8357 if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
8358 || isdigit(UCHAR(pc->p[1])))) {
8359 pc->p += 2;
8360 pc->len -= 2;
8361 pc->tt = JIM_TT_EXPR_DOUBLE;
8364 pc->tend = pc->p - 1;
8365 return JIM_OK;
8368 static int JimParseExprIrrational(struct JimParserCtx *pc)
8370 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8371 const char **token;
8373 for (token = Tokens; *token != NULL; token++) {
8374 int len = strlen(*token);
8376 if (strncmp(*token, pc->p, len) == 0) {
8377 pc->tstart = pc->p;
8378 pc->tend = pc->p + len - 1;
8379 pc->p += len;
8380 pc->len -= len;
8381 pc->tline = pc->linenr;
8382 pc->tt = JIM_TT_EXPR_DOUBLE;
8383 return JIM_OK;
8386 return JIM_ERR;
8389 static int JimParseExprOperator(struct JimParserCtx *pc)
8391 int i;
8392 int bestIdx = -1, bestLen = 0;
8394 /* Try to get the longest match. */
8395 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8396 const char * const opname = Jim_ExprOperators[i].name;
8397 const int oplen = Jim_ExprOperators[i].namelen;
8399 if (opname == NULL || opname[0] != pc->p[0]) {
8400 continue;
8403 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8404 bestIdx = i + JIM_TT_EXPR_OP;
8405 bestLen = oplen;
8408 if (bestIdx == -1) {
8409 return JIM_ERR;
8412 /* Validate paretheses around function arguments */
8413 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8414 const char *p = pc->p + bestLen;
8415 int len = pc->len - bestLen;
8417 while (len && isspace(UCHAR(*p))) {
8418 len--;
8419 p++;
8421 if (*p != '(') {
8422 return JIM_ERR;
8425 pc->tstart = pc->p;
8426 pc->tend = pc->p + bestLen - 1;
8427 pc->p += bestLen;
8428 pc->len -= bestLen;
8429 pc->tline = pc->linenr;
8431 pc->tt = bestIdx;
8432 return JIM_OK;
8435 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8437 static Jim_ExprOperator dummy_op;
8438 if (opcode < JIM_TT_EXPR_OP) {
8439 return &dummy_op;
8441 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8444 const char *jim_tt_name(int type)
8446 static const char * const tt_names[JIM_TT_EXPR_OP] =
8447 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8448 "DBL", "$()" };
8449 if (type < JIM_TT_EXPR_OP) {
8450 return tt_names[type];
8452 else {
8453 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8454 static char buf[20];
8456 if (op->name) {
8457 return op->name;
8459 sprintf(buf, "(%d)", type);
8460 return buf;
8464 /* -----------------------------------------------------------------------------
8465 * Expression Object
8466 * ---------------------------------------------------------------------------*/
8467 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8468 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8469 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8471 static const Jim_ObjType exprObjType = {
8472 "expression",
8473 FreeExprInternalRep,
8474 DupExprInternalRep,
8475 NULL,
8476 JIM_TYPE_REFERENCES,
8479 /* Expr bytecode structure */
8480 typedef struct ExprByteCode
8482 ScriptToken *token; /* Tokens array. */
8483 int len; /* Length as number of tokens. */
8484 int inUse; /* Used for sharing. */
8485 } ExprByteCode;
8487 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8489 int i;
8491 for (i = 0; i < expr->len; i++) {
8492 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8494 Jim_Free(expr->token);
8495 Jim_Free(expr);
8498 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8500 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8502 if (expr) {
8503 if (--expr->inUse != 0) {
8504 return;
8507 ExprFreeByteCode(interp, expr);
8511 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8513 JIM_NOTUSED(interp);
8514 JIM_NOTUSED(srcPtr);
8516 /* Just returns an simple string. */
8517 dupPtr->typePtr = NULL;
8520 /* Check if an expr program looks correct. */
8521 static int ExprCheckCorrectness(ExprByteCode * expr)
8523 int i;
8524 int stacklen = 0;
8525 int ternary = 0;
8527 /* Try to check if there are stack underflows,
8528 * and make sure at the end of the program there is
8529 * a single result on the stack. */
8530 for (i = 0; i < expr->len; i++) {
8531 ScriptToken *t = &expr->token[i];
8532 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8534 stacklen -= op->arity;
8535 if (stacklen < 0) {
8536 break;
8538 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8539 ternary++;
8541 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8542 ternary--;
8545 /* All operations and operands add one to the stack */
8546 stacklen++;
8548 if (stacklen != 1 || ternary != 0) {
8549 return JIM_ERR;
8551 return JIM_OK;
8554 /* This procedure converts every occurrence of || and && opereators
8555 * in lazy unary versions.
8557 * a b || is converted into:
8559 * a <offset> |L b |R
8561 * a b && is converted into:
8563 * a <offset> &L b &R
8565 * "|L" checks if 'a' is true:
8566 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8567 * the opcode just after |R.
8568 * 2) if it is false does nothing.
8569 * "|R" checks if 'b' is true:
8570 * 1) if it is true pushes 1, otherwise pushes 0.
8572 * "&L" checks if 'a' is true:
8573 * 1) if it is true does nothing.
8574 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8575 * the opcode just after &R
8576 * "&R" checks if 'a' is true:
8577 * if it is true pushes 1, otherwise pushes 0.
8579 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8581 int i;
8583 int leftindex, arity, offset;
8585 /* Search for the end of the first operator */
8586 leftindex = expr->len - 1;
8588 arity = 1;
8589 while (arity) {
8590 ScriptToken *tt = &expr->token[leftindex];
8592 if (tt->type >= JIM_TT_EXPR_OP) {
8593 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8595 arity--;
8596 if (--leftindex < 0) {
8597 return JIM_ERR;
8600 leftindex++;
8602 /* Move them up */
8603 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8604 sizeof(*expr->token) * (expr->len - leftindex));
8605 expr->len += 2;
8606 offset = (expr->len - leftindex) - 1;
8608 /* Now we rely on the fact the the left and right version have opcodes
8609 * 1 and 2 after the main opcode respectively
8611 expr->token[leftindex + 1].type = t->type + 1;
8612 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8614 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8615 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8617 /* Now add the 'R' operator */
8618 expr->token[expr->len].objPtr = interp->emptyObj;
8619 expr->token[expr->len].type = t->type + 2;
8620 expr->len++;
8622 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8623 for (i = leftindex - 1; i > 0; i--) {
8624 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8625 if (op->lazy == LAZY_LEFT) {
8626 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8627 JimWideValue(expr->token[i - 1].objPtr) += 2;
8631 return JIM_OK;
8634 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8636 struct ScriptToken *token = &expr->token[expr->len];
8637 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8639 if (op->lazy == LAZY_OP) {
8640 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8641 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8642 return JIM_ERR;
8645 else {
8646 token->objPtr = interp->emptyObj;
8647 token->type = t->type;
8648 expr->len++;
8650 return JIM_OK;
8654 * Returns the index of the COLON_LEFT to the left of 'right_index'
8655 * taking into account nesting.
8657 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8659 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8661 int ternary_count = 1;
8663 right_index--;
8665 while (right_index > 1) {
8666 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8667 ternary_count--;
8669 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8670 ternary_count++;
8672 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8673 return right_index;
8675 right_index--;
8678 /*notreached*/
8679 return -1;
8683 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8685 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8686 * Otherwise returns 0.
8688 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8690 int i = right_index - 1;
8691 int ternary_count = 1;
8693 while (i > 1) {
8694 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8695 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8696 *prev_right_index = i - 2;
8697 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8698 return 1;
8701 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8702 if (ternary_count == 0) {
8703 return 0;
8705 ternary_count++;
8707 i--;
8709 return 0;
8713 * ExprTernaryReorderExpression description
8714 * ========================================
8716 * ?: is right-to-left associative which doesn't work with the stack-based
8717 * expression engine. The fix is to reorder the bytecode.
8719 * The expression:
8721 * expr 1?2:0?3:4
8723 * Has initial bytecode:
8725 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8726 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8728 * The fix involves simulating this expression instead:
8730 * expr 1?2:(0?3:4)
8732 * With the following bytecode:
8734 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8735 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8737 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8738 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8739 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8740 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8742 * ExprTernaryReorderExpression works thus as follows :
8743 * - start from the end of the stack
8744 * - while walking towards the beginning of the stack
8745 * if token=JIM_EXPROP_COLON_RIGHT then
8746 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8747 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8748 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8749 * if all found then
8750 * perform the rotation
8751 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8752 * end if
8753 * end if
8755 * Note: care has to be taken for nested ternary constructs!!!
8757 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8759 int i;
8761 for (i = expr->len - 1; i > 1; i--) {
8762 int prev_right_index;
8763 int prev_left_index;
8764 int j;
8765 ScriptToken tmp;
8767 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8768 continue;
8771 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8772 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8773 continue;
8777 ** rotate tokens down
8779 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8780 ** | | |
8781 ** | V V
8782 ** | [...] : ...
8783 ** | | |
8784 ** | V V
8785 ** | [...] : ...
8786 ** | | |
8787 ** | V V
8788 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8790 tmp = expr->token[prev_right_index];
8791 for (j = prev_right_index; j < i; j++) {
8792 expr->token[j] = expr->token[j + 1];
8794 expr->token[i] = tmp;
8796 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8798 * This is 'colon left increment' = i - prev_right_index
8800 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8801 * [prev_left_index-1] : skip_count
8804 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8806 /* Adjust for i-- in the loop */
8807 i++;
8811 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8813 Jim_Stack stack;
8814 ExprByteCode *expr;
8815 int ok = 1;
8816 int i;
8817 int prevtt = JIM_TT_NONE;
8818 int have_ternary = 0;
8820 /* -1 for EOL */
8821 int count = tokenlist->count - 1;
8823 expr = Jim_Alloc(sizeof(*expr));
8824 expr->inUse = 1;
8825 expr->len = 0;
8827 Jim_InitStack(&stack);
8829 /* Need extra bytecodes for lazy operators.
8830 * Also check for the ternary operator
8832 for (i = 0; i < tokenlist->count; i++) {
8833 ParseToken *t = &tokenlist->list[i];
8834 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8836 if (op->lazy == LAZY_OP) {
8837 count += 2;
8838 /* Ternary is a lazy op but also needs reordering */
8839 if (t->type == JIM_EXPROP_TERNARY) {
8840 have_ternary = 1;
8845 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8847 for (i = 0; i < tokenlist->count && ok; i++) {
8848 ParseToken *t = &tokenlist->list[i];
8850 /* Next token will be stored here */
8851 struct ScriptToken *token = &expr->token[expr->len];
8853 if (t->type == JIM_TT_EOL) {
8854 break;
8857 switch (t->type) {
8858 case JIM_TT_STR:
8859 case JIM_TT_ESC:
8860 case JIM_TT_VAR:
8861 case JIM_TT_DICTSUGAR:
8862 case JIM_TT_EXPRSUGAR:
8863 case JIM_TT_CMD:
8864 token->type = t->type;
8865 strexpr:
8866 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8867 if (t->type == JIM_TT_CMD) {
8868 /* Only commands need source info */
8869 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8871 expr->len++;
8872 break;
8874 case JIM_TT_EXPR_INT:
8875 case JIM_TT_EXPR_DOUBLE:
8877 char *endptr;
8878 if (t->type == JIM_TT_EXPR_INT) {
8879 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8881 else {
8882 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8884 if (endptr != t->token + t->len) {
8885 /* Conversion failed, so just store it as a string */
8886 Jim_FreeNewObj(interp, token->objPtr);
8887 token->type = JIM_TT_STR;
8888 goto strexpr;
8890 token->type = t->type;
8891 expr->len++;
8893 break;
8895 case JIM_TT_SUBEXPR_START:
8896 Jim_StackPush(&stack, t);
8897 prevtt = JIM_TT_NONE;
8898 continue;
8900 case JIM_TT_SUBEXPR_COMMA:
8901 /* Simple approach. Comma is simply ignored */
8902 continue;
8904 case JIM_TT_SUBEXPR_END:
8905 ok = 0;
8906 while (Jim_StackLen(&stack)) {
8907 ParseToken *tt = Jim_StackPop(&stack);
8909 if (tt->type == JIM_TT_SUBEXPR_START) {
8910 ok = 1;
8911 break;
8914 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8915 goto err;
8918 if (!ok) {
8919 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8920 goto err;
8922 break;
8925 default:{
8926 /* Must be an operator */
8927 const struct Jim_ExprOperator *op;
8928 ParseToken *tt;
8930 /* Convert -/+ to unary minus or unary plus if necessary */
8931 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
8932 if (t->type == JIM_EXPROP_SUB) {
8933 t->type = JIM_EXPROP_UNARYMINUS;
8935 else if (t->type == JIM_EXPROP_ADD) {
8936 t->type = JIM_EXPROP_UNARYPLUS;
8940 op = JimExprOperatorInfoByOpcode(t->type);
8942 /* Now handle precedence */
8943 while ((tt = Jim_StackPeek(&stack)) != NULL) {
8944 const struct Jim_ExprOperator *tt_op =
8945 JimExprOperatorInfoByOpcode(tt->type);
8947 /* Note that right-to-left associativity of ?: operator is handled later */
8949 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
8950 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8951 ok = 0;
8952 goto err;
8954 Jim_StackPop(&stack);
8956 else {
8957 break;
8960 Jim_StackPush(&stack, t);
8961 break;
8964 prevtt = t->type;
8967 /* Reduce any remaining subexpr */
8968 while (Jim_StackLen(&stack)) {
8969 ParseToken *tt = Jim_StackPop(&stack);
8971 if (tt->type == JIM_TT_SUBEXPR_START) {
8972 ok = 0;
8973 Jim_SetResultString(interp, "Missing close parenthesis", -1);
8974 goto err;
8976 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8977 ok = 0;
8978 goto err;
8982 if (have_ternary) {
8983 ExprTernaryReorderExpression(interp, expr);
8986 err:
8987 /* Free the stack used for the compilation. */
8988 Jim_FreeStack(&stack);
8990 for (i = 0; i < expr->len; i++) {
8991 Jim_IncrRefCount(expr->token[i].objPtr);
8994 if (!ok) {
8995 ExprFreeByteCode(interp, expr);
8996 return NULL;
8999 return expr;
9003 /* This method takes the string representation of an expression
9004 * and generates a program for the Expr's stack-based VM. */
9005 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9007 int exprTextLen;
9008 const char *exprText;
9009 struct JimParserCtx parser;
9010 struct ExprByteCode *expr;
9011 ParseTokenList tokenlist;
9012 int line;
9013 Jim_Obj *fileNameObj;
9014 int rc = JIM_ERR;
9016 /* Try to get information about filename / line number */
9017 if (objPtr->typePtr == &sourceObjType) {
9018 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9019 line = objPtr->internalRep.sourceValue.lineNumber;
9021 else {
9022 fileNameObj = interp->emptyObj;
9023 line = 1;
9025 Jim_IncrRefCount(fileNameObj);
9027 exprText = Jim_GetString(objPtr, &exprTextLen);
9029 /* Initially tokenise the expression into tokenlist */
9030 ScriptTokenListInit(&tokenlist);
9032 JimParserInit(&parser, exprText, exprTextLen, line);
9033 while (!parser.eof) {
9034 if (JimParseExpression(&parser) != JIM_OK) {
9035 ScriptTokenListFree(&tokenlist);
9036 invalidexpr:
9037 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9038 expr = NULL;
9039 goto err;
9042 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9043 parser.tline);
9046 #ifdef DEBUG_SHOW_EXPR_TOKENS
9048 int i;
9049 printf("==== Expr Tokens ====\n");
9050 for (i = 0; i < tokenlist.count; i++) {
9051 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9052 tokenlist.list[i].len, tokenlist.list[i].token);
9055 #endif
9057 /* Now create the expression bytecode from the tokenlist */
9058 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9060 /* No longer need the token list */
9061 ScriptTokenListFree(&tokenlist);
9063 if (!expr) {
9064 goto err;
9067 #ifdef DEBUG_SHOW_EXPR
9069 int i;
9071 printf("==== Expr ====\n");
9072 for (i = 0; i < expr->len; i++) {
9073 ScriptToken *t = &expr->token[i];
9075 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9078 #endif
9080 /* Check program correctness. */
9081 if (ExprCheckCorrectness(expr) != JIM_OK) {
9082 ExprFreeByteCode(interp, expr);
9083 goto invalidexpr;
9086 rc = JIM_OK;
9088 err:
9089 /* Free the old internal rep and set the new one. */
9090 Jim_DecrRefCount(interp, fileNameObj);
9091 Jim_FreeIntRep(interp, objPtr);
9092 Jim_SetIntRepPtr(objPtr, expr);
9093 objPtr->typePtr = &exprObjType;
9094 return rc;
9097 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9099 if (objPtr->typePtr != &exprObjType) {
9100 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9101 return NULL;
9104 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9107 /* -----------------------------------------------------------------------------
9108 * Expressions evaluation.
9109 * Jim uses a specialized stack-based virtual machine for expressions,
9110 * that takes advantage of the fact that expr's operators
9111 * can't be redefined.
9113 * Jim_EvalExpression() uses the bytecode compiled by
9114 * SetExprFromAny() method of the "expression" object.
9116 * On success a Tcl Object containing the result of the evaluation
9117 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9118 * returned.
9119 * On error the function returns a retcode != to JIM_OK and set a suitable
9120 * error on the interp.
9121 * ---------------------------------------------------------------------------*/
9122 #define JIM_EE_STATICSTACK_LEN 10
9124 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9126 ExprByteCode *expr;
9127 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9128 int i;
9129 int retcode = JIM_OK;
9130 struct JimExprState e;
9132 expr = JimGetExpression(interp, exprObjPtr);
9133 if (!expr) {
9134 return JIM_ERR; /* error in expression. */
9137 #ifdef JIM_OPTIMIZATION
9138 /* Check for one of the following common expressions used by while/for
9140 * CONST
9141 * $a
9142 * !$a
9143 * $a < CONST, $a < $b
9144 * $a <= CONST, $a <= $b
9145 * $a > CONST, $a > $b
9146 * $a >= CONST, $a >= $b
9147 * $a != CONST, $a != $b
9148 * $a == CONST, $a == $b
9151 Jim_Obj *objPtr;
9153 /* STEP 1 -- Check if there are the conditions to run the specialized
9154 * version of while */
9156 switch (expr->len) {
9157 case 1:
9158 if (expr->token[0].type == JIM_TT_EXPR_INT) {
9159 *exprResultPtrPtr = expr->token[0].objPtr;
9160 Jim_IncrRefCount(*exprResultPtrPtr);
9161 return JIM_OK;
9163 if (expr->token[0].type == JIM_TT_VAR) {
9164 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
9165 if (objPtr) {
9166 *exprResultPtrPtr = objPtr;
9167 Jim_IncrRefCount(*exprResultPtrPtr);
9168 return JIM_OK;
9171 break;
9173 case 2:
9174 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
9175 jim_wide wideValue;
9177 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9178 if (objPtr && JimIsWide(objPtr)
9179 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
9180 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
9181 Jim_IncrRefCount(*exprResultPtrPtr);
9182 return JIM_OK;
9185 break;
9187 case 3:
9188 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
9189 || expr->token[1].type == JIM_TT_VAR)) {
9190 switch (expr->token[2].type) {
9191 case JIM_EXPROP_LT:
9192 case JIM_EXPROP_LTE:
9193 case JIM_EXPROP_GT:
9194 case JIM_EXPROP_GTE:
9195 case JIM_EXPROP_NUMEQ:
9196 case JIM_EXPROP_NUMNE:{
9197 /* optimise ok */
9198 jim_wide wideValueA;
9199 jim_wide wideValueB;
9201 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9202 if (objPtr && JimIsWide(objPtr)
9203 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
9204 if (expr->token[1].type == JIM_TT_VAR) {
9205 objPtr =
9206 Jim_GetVariable(interp, expr->token[1].objPtr,
9207 JIM_NONE);
9209 else {
9210 objPtr = expr->token[1].objPtr;
9212 if (objPtr && JimIsWide(objPtr)
9213 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
9214 int cmpRes;
9216 switch (expr->token[2].type) {
9217 case JIM_EXPROP_LT:
9218 cmpRes = wideValueA < wideValueB;
9219 break;
9220 case JIM_EXPROP_LTE:
9221 cmpRes = wideValueA <= wideValueB;
9222 break;
9223 case JIM_EXPROP_GT:
9224 cmpRes = wideValueA > wideValueB;
9225 break;
9226 case JIM_EXPROP_GTE:
9227 cmpRes = wideValueA >= wideValueB;
9228 break;
9229 case JIM_EXPROP_NUMEQ:
9230 cmpRes = wideValueA == wideValueB;
9231 break;
9232 case JIM_EXPROP_NUMNE:
9233 cmpRes = wideValueA != wideValueB;
9234 break;
9235 default: /*notreached */
9236 cmpRes = 0;
9238 *exprResultPtrPtr =
9239 cmpRes ? interp->trueObj : interp->falseObj;
9240 Jim_IncrRefCount(*exprResultPtrPtr);
9241 return JIM_OK;
9247 break;
9250 #endif
9252 /* In order to avoid that the internal repr gets freed due to
9253 * shimmering of the exprObjPtr's object, we make the internal rep
9254 * shared. */
9255 expr->inUse++;
9257 /* The stack-based expr VM itself */
9259 /* Stack allocation. Expr programs have the feature that
9260 * a program of length N can't require a stack longer than
9261 * N. */
9262 if (expr->len > JIM_EE_STATICSTACK_LEN)
9263 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9264 else
9265 e.stack = staticStack;
9267 e.stacklen = 0;
9269 /* Execute every instruction */
9270 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9271 Jim_Obj *objPtr;
9273 switch (expr->token[i].type) {
9274 case JIM_TT_EXPR_INT:
9275 case JIM_TT_EXPR_DOUBLE:
9276 case JIM_TT_STR:
9277 ExprPush(&e, expr->token[i].objPtr);
9278 break;
9280 case JIM_TT_VAR:
9281 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9282 if (objPtr) {
9283 ExprPush(&e, objPtr);
9285 else {
9286 retcode = JIM_ERR;
9288 break;
9290 case JIM_TT_DICTSUGAR:
9291 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9292 if (objPtr) {
9293 ExprPush(&e, objPtr);
9295 else {
9296 retcode = JIM_ERR;
9298 break;
9300 case JIM_TT_ESC:
9301 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9302 if (retcode == JIM_OK) {
9303 ExprPush(&e, objPtr);
9305 break;
9307 case JIM_TT_CMD:
9308 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9309 if (retcode == JIM_OK) {
9310 ExprPush(&e, Jim_GetResult(interp));
9312 break;
9314 default:{
9315 /* Find and execute the operation */
9316 e.skip = 0;
9317 e.opcode = expr->token[i].type;
9319 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9320 /* Skip some opcodes if necessary */
9321 i += e.skip;
9322 continue;
9327 expr->inUse--;
9329 if (retcode == JIM_OK) {
9330 *exprResultPtrPtr = ExprPop(&e);
9332 else {
9333 for (i = 0; i < e.stacklen; i++) {
9334 Jim_DecrRefCount(interp, e.stack[i]);
9337 if (e.stack != staticStack) {
9338 Jim_Free(e.stack);
9340 return retcode;
9343 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9345 int retcode;
9346 jim_wide wideValue;
9347 double doubleValue;
9348 Jim_Obj *exprResultPtr;
9350 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9351 if (retcode != JIM_OK)
9352 return retcode;
9354 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9355 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9356 Jim_DecrRefCount(interp, exprResultPtr);
9357 return JIM_ERR;
9359 else {
9360 Jim_DecrRefCount(interp, exprResultPtr);
9361 *boolPtr = doubleValue != 0;
9362 return JIM_OK;
9365 *boolPtr = wideValue != 0;
9367 Jim_DecrRefCount(interp, exprResultPtr);
9368 return JIM_OK;
9371 /* -----------------------------------------------------------------------------
9372 * ScanFormat String Object
9373 * ---------------------------------------------------------------------------*/
9375 /* This Jim_Obj will held a parsed representation of a format string passed to
9376 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9377 * to be parsed in its entirely first and then, if correct, can be used for
9378 * scanning. To avoid endless re-parsing, the parsed representation will be
9379 * stored in an internal representation and re-used for performance reason. */
9381 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9382 * scanformat string. This part will later be used to extract information
9383 * out from the string to be parsed by Jim_ScanString */
9385 typedef struct ScanFmtPartDescr
9387 char *arg; /* Specification of a CHARSET conversion */
9388 char *prefix; /* Prefix to be scanned literally before conversion */
9389 size_t width; /* Maximal width of input to be converted */
9390 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9391 char type; /* Type of conversion (e.g. c, d, f) */
9392 char modifier; /* Modify type (e.g. l - long, h - short */
9393 } ScanFmtPartDescr;
9395 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9396 * string parsed and separated in part descriptions. Furthermore it contains
9397 * the original string representation of the scanformat string to allow for
9398 * fast update of the Jim_Obj's string representation part.
9400 * As an add-on the internal object representation adds some scratch pad area
9401 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9402 * memory for purpose of string scanning.
9404 * The error member points to a static allocated string in case of a mal-
9405 * formed scanformat string or it contains '0' (NULL) in case of a valid
9406 * parse representation.
9408 * The whole memory of the internal representation is allocated as a single
9409 * area of memory that will be internally separated. So freeing and duplicating
9410 * of such an object is cheap */
9412 typedef struct ScanFmtStringObj
9414 jim_wide size; /* Size of internal repr in bytes */
9415 char *stringRep; /* Original string representation */
9416 size_t count; /* Number of ScanFmtPartDescr contained */
9417 size_t convCount; /* Number of conversions that will assign */
9418 size_t maxPos; /* Max position index if XPG3 is used */
9419 const char *error; /* Ptr to error text (NULL if no error */
9420 char *scratch; /* Some scratch pad used by Jim_ScanString */
9421 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9422 } ScanFmtStringObj;
9425 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9426 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9427 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9429 static const Jim_ObjType scanFmtStringObjType = {
9430 "scanformatstring",
9431 FreeScanFmtInternalRep,
9432 DupScanFmtInternalRep,
9433 UpdateStringOfScanFmt,
9434 JIM_TYPE_NONE,
9437 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9439 JIM_NOTUSED(interp);
9440 Jim_Free((char *)objPtr->internalRep.ptr);
9441 objPtr->internalRep.ptr = 0;
9444 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9446 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9447 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9449 JIM_NOTUSED(interp);
9450 memcpy(newVec, srcPtr->internalRep.ptr, size);
9451 dupPtr->internalRep.ptr = newVec;
9452 dupPtr->typePtr = &scanFmtStringObjType;
9455 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9457 char *bytes = ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep;
9459 objPtr->bytes = Jim_StrDup(bytes);
9460 objPtr->length = strlen(bytes);
9463 /* SetScanFmtFromAny will parse a given string and create the internal
9464 * representation of the format specification. In case of an error
9465 * the error data member of the internal representation will be set
9466 * to an descriptive error text and the function will be left with
9467 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9468 * specification */
9470 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9472 ScanFmtStringObj *fmtObj;
9473 char *buffer;
9474 int maxCount, i, approxSize, lastPos = -1;
9475 const char *fmt = objPtr->bytes;
9476 int maxFmtLen = objPtr->length;
9477 const char *fmtEnd = fmt + maxFmtLen;
9478 int curr;
9480 Jim_FreeIntRep(interp, objPtr);
9481 /* Count how many conversions could take place maximally */
9482 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9483 if (fmt[i] == '%')
9484 ++maxCount;
9485 /* Calculate an approximation of the memory necessary */
9486 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9487 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9488 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9489 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9490 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9491 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9492 +1; /* safety byte */
9493 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9494 memset(fmtObj, 0, approxSize);
9495 fmtObj->size = approxSize;
9496 fmtObj->maxPos = 0;
9497 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9498 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9499 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9500 buffer = fmtObj->stringRep + maxFmtLen + 1;
9501 objPtr->internalRep.ptr = fmtObj;
9502 objPtr->typePtr = &scanFmtStringObjType;
9503 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9504 int width = 0, skip;
9505 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9507 fmtObj->count++;
9508 descr->width = 0; /* Assume width unspecified */
9509 /* Overread and store any "literal" prefix */
9510 if (*fmt != '%' || fmt[1] == '%') {
9511 descr->type = 0;
9512 descr->prefix = &buffer[i];
9513 for (; fmt < fmtEnd; ++fmt) {
9514 if (*fmt == '%') {
9515 if (fmt[1] != '%')
9516 break;
9517 ++fmt;
9519 buffer[i++] = *fmt;
9521 buffer[i++] = 0;
9523 /* Skip the conversion introducing '%' sign */
9524 ++fmt;
9525 /* End reached due to non-conversion literal only? */
9526 if (fmt >= fmtEnd)
9527 goto done;
9528 descr->pos = 0; /* Assume "natural" positioning */
9529 if (*fmt == '*') {
9530 descr->pos = -1; /* Okay, conversion will not be assigned */
9531 ++fmt;
9533 else
9534 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9535 /* Check if next token is a number (could be width or pos */
9536 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9537 fmt += skip;
9538 /* Was the number a XPG3 position specifier? */
9539 if (descr->pos != -1 && *fmt == '$') {
9540 int prev;
9542 ++fmt;
9543 descr->pos = width;
9544 width = 0;
9545 /* Look if "natural" postioning and XPG3 one was mixed */
9546 if ((lastPos == 0 && descr->pos > 0)
9547 || (lastPos > 0 && descr->pos == 0)) {
9548 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9549 return JIM_ERR;
9551 /* Look if this position was already used */
9552 for (prev = 0; prev < curr; ++prev) {
9553 if (fmtObj->descr[prev].pos == -1)
9554 continue;
9555 if (fmtObj->descr[prev].pos == descr->pos) {
9556 fmtObj->error =
9557 "variable is assigned by multiple \"%n$\" conversion specifiers";
9558 return JIM_ERR;
9561 /* Try to find a width after the XPG3 specifier */
9562 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9563 descr->width = width;
9564 fmt += skip;
9566 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9567 fmtObj->maxPos = descr->pos;
9569 else {
9570 /* Number was not a XPG3, so it has to be a width */
9571 descr->width = width;
9574 /* If positioning mode was undetermined yet, fix this */
9575 if (lastPos == -1)
9576 lastPos = descr->pos;
9577 /* Handle CHARSET conversion type ... */
9578 if (*fmt == '[') {
9579 int swapped = 1, beg = i, end, j;
9581 descr->type = '[';
9582 descr->arg = &buffer[i];
9583 ++fmt;
9584 if (*fmt == '^')
9585 buffer[i++] = *fmt++;
9586 if (*fmt == ']')
9587 buffer[i++] = *fmt++;
9588 while (*fmt && *fmt != ']')
9589 buffer[i++] = *fmt++;
9590 if (*fmt != ']') {
9591 fmtObj->error = "unmatched [ in format string";
9592 return JIM_ERR;
9594 end = i;
9595 buffer[i++] = 0;
9596 /* In case a range fence was given "backwards", swap it */
9597 while (swapped) {
9598 swapped = 0;
9599 for (j = beg + 1; j < end - 1; ++j) {
9600 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9601 char tmp = buffer[j - 1];
9603 buffer[j - 1] = buffer[j + 1];
9604 buffer[j + 1] = tmp;
9605 swapped = 1;
9610 else {
9611 /* Remember any valid modifier if given */
9612 if (strchr("hlL", *fmt) != 0)
9613 descr->modifier = tolower((int)*fmt++);
9615 descr->type = *fmt;
9616 if (strchr("efgcsndoxui", *fmt) == 0) {
9617 fmtObj->error = "bad scan conversion character";
9618 return JIM_ERR;
9620 else if (*fmt == 'c' && descr->width != 0) {
9621 fmtObj->error = "field width may not be specified in %c " "conversion";
9622 return JIM_ERR;
9624 else if (*fmt == 'u' && descr->modifier == 'l') {
9625 fmtObj->error = "unsigned wide not supported";
9626 return JIM_ERR;
9629 curr++;
9631 done:
9632 return JIM_OK;
9635 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9637 #define FormatGetCnvCount(_fo_) \
9638 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9639 #define FormatGetMaxPos(_fo_) \
9640 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9641 #define FormatGetError(_fo_) \
9642 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9644 /* JimScanAString is used to scan an unspecified string that ends with
9645 * next WS, or a string that is specified via a charset.
9648 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9650 char *buffer = Jim_StrDup(str);
9651 char *p = buffer;
9653 while (*str) {
9654 int c;
9655 int n;
9657 if (!sdescr && isspace(UCHAR(*str)))
9658 break; /* EOS via WS if unspecified */
9660 n = utf8_tounicode(str, &c);
9661 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9662 break;
9663 while (n--)
9664 *p++ = *str++;
9666 *p = 0;
9667 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9670 /* ScanOneEntry will scan one entry out of the string passed as argument.
9671 * It use the sscanf() function for this task. After extracting and
9672 * converting of the value, the count of scanned characters will be
9673 * returned of -1 in case of no conversion tool place and string was
9674 * already scanned thru */
9676 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9677 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9679 const char *tok;
9680 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9681 size_t scanned = 0;
9682 size_t anchor = pos;
9683 int i;
9684 Jim_Obj *tmpObj = NULL;
9686 /* First pessimistically assume, we will not scan anything :-) */
9687 *valObjPtr = 0;
9688 if (descr->prefix) {
9689 /* There was a prefix given before the conversion, skip it and adjust
9690 * the string-to-be-parsed accordingly */
9691 /* XXX: Should be checking strLen, not str[pos] */
9692 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9693 /* If prefix require, skip WS */
9694 if (isspace(UCHAR(descr->prefix[i])))
9695 while (pos < strLen && isspace(UCHAR(str[pos])))
9696 ++pos;
9697 else if (descr->prefix[i] != str[pos])
9698 break; /* Prefix do not match here, leave the loop */
9699 else
9700 ++pos; /* Prefix matched so far, next round */
9702 if (pos >= strLen) {
9703 return -1; /* All of str consumed: EOF condition */
9705 else if (descr->prefix[i] != 0)
9706 return 0; /* Not whole prefix consumed, no conversion possible */
9708 /* For all but following conversion, skip leading WS */
9709 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9710 while (isspace(UCHAR(str[pos])))
9711 ++pos;
9712 /* Determine how much skipped/scanned so far */
9713 scanned = pos - anchor;
9715 /* %c is a special, simple case. no width */
9716 if (descr->type == 'n') {
9717 /* Return pseudo conversion means: how much scanned so far? */
9718 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9720 else if (pos >= strLen) {
9721 /* Cannot scan anything, as str is totally consumed */
9722 return -1;
9724 else if (descr->type == 'c') {
9725 int c;
9726 scanned += utf8_tounicode(&str[pos], &c);
9727 *valObjPtr = Jim_NewIntObj(interp, c);
9728 return scanned;
9730 else {
9731 /* Processing of conversions follows ... */
9732 if (descr->width > 0) {
9733 /* Do not try to scan as fas as possible but only the given width.
9734 * To ensure this, we copy the part that should be scanned. */
9735 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9736 size_t tLen = descr->width > sLen ? sLen : descr->width;
9738 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9739 tok = tmpObj->bytes;
9741 else {
9742 /* As no width was given, simply refer to the original string */
9743 tok = &str[pos];
9745 switch (descr->type) {
9746 case 'd':
9747 case 'o':
9748 case 'x':
9749 case 'u':
9750 case 'i':{
9751 char *endp; /* Position where the number finished */
9752 jim_wide w;
9754 int base = descr->type == 'o' ? 8
9755 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9757 /* Try to scan a number with the given base */
9758 if (base == 0) {
9759 w = jim_strtoull(tok, &endp);
9761 else {
9762 w = strtoull(tok, &endp, base);
9765 if (endp != tok) {
9766 /* There was some number sucessfully scanned! */
9767 *valObjPtr = Jim_NewIntObj(interp, w);
9769 /* Adjust the number-of-chars scanned so far */
9770 scanned += endp - tok;
9772 else {
9773 /* Nothing was scanned. We have to determine if this
9774 * happened due to e.g. prefix mismatch or input str
9775 * exhausted */
9776 scanned = *tok ? 0 : -1;
9778 break;
9780 case 's':
9781 case '[':{
9782 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9783 scanned += Jim_Length(*valObjPtr);
9784 break;
9786 case 'e':
9787 case 'f':
9788 case 'g':{
9789 char *endp;
9790 double value = strtod(tok, &endp);
9792 if (endp != tok) {
9793 /* There was some number sucessfully scanned! */
9794 *valObjPtr = Jim_NewDoubleObj(interp, value);
9795 /* Adjust the number-of-chars scanned so far */
9796 scanned += endp - tok;
9798 else {
9799 /* Nothing was scanned. We have to determine if this
9800 * happened due to e.g. prefix mismatch or input str
9801 * exhausted */
9802 scanned = *tok ? 0 : -1;
9804 break;
9807 /* If a substring was allocated (due to pre-defined width) do not
9808 * forget to free it */
9809 if (tmpObj) {
9810 Jim_FreeNewObj(interp, tmpObj);
9813 return scanned;
9816 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9817 * string and returns all converted (and not ignored) values in a list back
9818 * to the caller. If an error occured, a NULL pointer will be returned */
9820 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9822 size_t i, pos;
9823 int scanned = 1;
9824 const char *str = Jim_String(strObjPtr);
9825 int strLen = Jim_Utf8Length(interp, strObjPtr);
9826 Jim_Obj *resultList = 0;
9827 Jim_Obj **resultVec = 0;
9828 int resultc;
9829 Jim_Obj *emptyStr = 0;
9830 ScanFmtStringObj *fmtObj;
9832 /* This should never happen. The format object should already be of the correct type */
9833 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9835 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9836 /* Check if format specification was valid */
9837 if (fmtObj->error != 0) {
9838 if (flags & JIM_ERRMSG)
9839 Jim_SetResultString(interp, fmtObj->error, -1);
9840 return 0;
9842 /* Allocate a new "shared" empty string for all unassigned conversions */
9843 emptyStr = Jim_NewEmptyStringObj(interp);
9844 Jim_IncrRefCount(emptyStr);
9845 /* Create a list and fill it with empty strings up to max specified XPG3 */
9846 resultList = Jim_NewListObj(interp, NULL, 0);
9847 if (fmtObj->maxPos > 0) {
9848 for (i = 0; i < fmtObj->maxPos; ++i)
9849 Jim_ListAppendElement(interp, resultList, emptyStr);
9850 JimListGetElements(interp, resultList, &resultc, &resultVec);
9852 /* Now handle every partial format description */
9853 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9854 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9855 Jim_Obj *value = 0;
9857 /* Only last type may be "literal" w/o conversion - skip it! */
9858 if (descr->type == 0)
9859 continue;
9860 /* As long as any conversion could be done, we will proceed */
9861 if (scanned > 0)
9862 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9863 /* In case our first try results in EOF, we will leave */
9864 if (scanned == -1 && i == 0)
9865 goto eof;
9866 /* Advance next pos-to-be-scanned for the amount scanned already */
9867 pos += scanned;
9869 /* value == 0 means no conversion took place so take empty string */
9870 if (value == 0)
9871 value = Jim_NewEmptyStringObj(interp);
9872 /* If value is a non-assignable one, skip it */
9873 if (descr->pos == -1) {
9874 Jim_FreeNewObj(interp, value);
9876 else if (descr->pos == 0)
9877 /* Otherwise append it to the result list if no XPG3 was given */
9878 Jim_ListAppendElement(interp, resultList, value);
9879 else if (resultVec[descr->pos - 1] == emptyStr) {
9880 /* But due to given XPG3, put the value into the corr. slot */
9881 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9882 Jim_IncrRefCount(value);
9883 resultVec[descr->pos - 1] = value;
9885 else {
9886 /* Otherwise, the slot was already used - free obj and ERROR */
9887 Jim_FreeNewObj(interp, value);
9888 goto err;
9891 Jim_DecrRefCount(interp, emptyStr);
9892 return resultList;
9893 eof:
9894 Jim_DecrRefCount(interp, emptyStr);
9895 Jim_FreeNewObj(interp, resultList);
9896 return (Jim_Obj *)EOF;
9897 err:
9898 Jim_DecrRefCount(interp, emptyStr);
9899 Jim_FreeNewObj(interp, resultList);
9900 return 0;
9903 /* -----------------------------------------------------------------------------
9904 * Pseudo Random Number Generation
9905 * ---------------------------------------------------------------------------*/
9906 /* Initialize the sbox with the numbers from 0 to 255 */
9907 static void JimPrngInit(Jim_Interp *interp)
9909 #define PRNG_SEED_SIZE 256
9910 int i;
9911 unsigned int *seed;
9912 time_t t = time(NULL);
9914 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9916 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9917 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9918 seed[i] = (rand() ^ t ^ clock());
9920 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9921 Jim_Free(seed);
9924 /* Generates N bytes of random data */
9925 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9927 Jim_PrngState *prng;
9928 unsigned char *destByte = (unsigned char *)dest;
9929 unsigned int si, sj, x;
9931 /* initialization, only needed the first time */
9932 if (interp->prngState == NULL)
9933 JimPrngInit(interp);
9934 prng = interp->prngState;
9935 /* generates 'len' bytes of pseudo-random numbers */
9936 for (x = 0; x < len; x++) {
9937 prng->i = (prng->i + 1) & 0xff;
9938 si = prng->sbox[prng->i];
9939 prng->j = (prng->j + si) & 0xff;
9940 sj = prng->sbox[prng->j];
9941 prng->sbox[prng->i] = sj;
9942 prng->sbox[prng->j] = si;
9943 *destByte++ = prng->sbox[(si + sj) & 0xff];
9947 /* Re-seed the generator with user-provided bytes */
9948 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9950 int i;
9951 Jim_PrngState *prng;
9953 /* initialization, only needed the first time */
9954 if (interp->prngState == NULL)
9955 JimPrngInit(interp);
9956 prng = interp->prngState;
9958 /* Set the sbox[i] with i */
9959 for (i = 0; i < 256; i++)
9960 prng->sbox[i] = i;
9961 /* Now use the seed to perform a random permutation of the sbox */
9962 for (i = 0; i < seedLen; i++) {
9963 unsigned char t;
9965 t = prng->sbox[i & 0xFF];
9966 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9967 prng->sbox[seed[i]] = t;
9969 prng->i = prng->j = 0;
9971 /* discard at least the first 256 bytes of stream.
9972 * borrow the seed buffer for this
9974 for (i = 0; i < 256; i += seedLen) {
9975 JimRandomBytes(interp, seed, seedLen);
9979 /* [incr] */
9980 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9982 jim_wide wideValue, increment = 1;
9983 Jim_Obj *intObjPtr;
9985 if (argc != 2 && argc != 3) {
9986 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9987 return JIM_ERR;
9989 if (argc == 3) {
9990 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9991 return JIM_ERR;
9993 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
9994 if (!intObjPtr) {
9995 /* Set missing variable to 0 */
9996 wideValue = 0;
9998 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
9999 return JIM_ERR;
10001 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10002 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10003 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10004 Jim_FreeNewObj(interp, intObjPtr);
10005 return JIM_ERR;
10008 else {
10009 /* Can do it the quick way */
10010 Jim_InvalidateStringRep(intObjPtr);
10011 JimWideValue(intObjPtr) = wideValue + increment;
10013 /* The following step is required in order to invalidate the
10014 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10015 if (argv[1]->typePtr != &variableObjType) {
10016 /* Note that this can't fail since GetVariable already succeeded */
10017 Jim_SetVariable(interp, argv[1], intObjPtr);
10020 Jim_SetResult(interp, intObjPtr);
10021 return JIM_OK;
10025 /* -----------------------------------------------------------------------------
10026 * Eval
10027 * ---------------------------------------------------------------------------*/
10028 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10029 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10031 /* Handle calls to the [unknown] command */
10032 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10034 int retcode;
10036 /* If JimUnknown() is recursively called too many times...
10037 * done here
10039 if (interp->unknown_called > 50) {
10040 return JIM_ERR;
10043 /* The object interp->unknown just contains
10044 * the "unknown" string, it is used in order to
10045 * avoid to lookup the unknown command every time
10046 * but instead to cache the result. */
10048 /* If the [unknown] command does not exist ... */
10049 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10050 return JIM_ERR;
10052 interp->unknown_called++;
10053 /* XXX: Are we losing fileNameObj and linenr? */
10054 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10055 interp->unknown_called--;
10057 return retcode;
10060 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10062 int retcode;
10063 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10065 if (cmdPtr == NULL) {
10066 return JimUnknown(interp, objc, objv);
10068 if (interp->evalDepth == interp->maxEvalDepth) {
10069 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10070 return JIM_ERR;
10072 interp->evalDepth++;
10074 /* Call it -- Make sure result is an empty object. */
10075 JimIncrCmdRefCount(cmdPtr);
10076 Jim_SetEmptyResult(interp);
10077 if (cmdPtr->isproc) {
10078 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10080 else {
10081 interp->cmdPrivData = cmdPtr->u.native.privData;
10082 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10084 JimDecrCmdRefCount(interp, cmdPtr);
10085 interp->evalDepth--;
10087 return retcode;
10090 /* Eval the object vector 'objv' composed of 'objc' elements.
10091 * Every element is used as single argument.
10092 * Jim_EvalObj() will call this function every time its object
10093 * argument is of "list" type, with no string representation.
10095 * This is possible because the string representation of a
10096 * list object generated by the UpdateStringOfList is made
10097 * in a way that ensures that every list element is a different
10098 * command argument. */
10099 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10101 int i, retcode;
10103 /* Incr refcount of arguments. */
10104 for (i = 0; i < objc; i++)
10105 Jim_IncrRefCount(objv[i]);
10107 retcode = JimInvokeCommand(interp, objc, objv);
10109 /* Decr refcount of arguments and return the retcode */
10110 for (i = 0; i < objc; i++)
10111 Jim_DecrRefCount(interp, objv[i]);
10113 return retcode;
10117 * Invokes 'prefix' as a command with the objv array as arguments.
10119 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10121 int ret;
10122 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10124 nargv[0] = prefix;
10125 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10126 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10127 Jim_Free(nargv);
10128 return ret;
10131 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10133 int rc = retcode;
10135 if (rc == JIM_ERR && !interp->errorFlag) {
10136 /* This is the first error, so save the file/line information and reset the stack */
10137 interp->errorFlag = 1;
10138 Jim_IncrRefCount(script->fileNameObj);
10139 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10140 interp->errorFileNameObj = script->fileNameObj;
10141 interp->errorLine = script->linenr;
10143 JimResetStackTrace(interp);
10144 /* Always add a level where the error first occurs */
10145 interp->addStackTrace++;
10148 /* Now if this is an "interesting" level, add it to the stack trace */
10149 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10150 /* Add the stack info for the current level */
10152 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10154 /* Note: if we didn't have a filename for this level,
10155 * don't clear the addStackTrace flag
10156 * so we can pick it up at the next level
10158 if (Jim_Length(script->fileNameObj)) {
10159 interp->addStackTrace = 0;
10162 Jim_DecrRefCount(interp, interp->errorProc);
10163 interp->errorProc = interp->emptyObj;
10164 Jim_IncrRefCount(interp->errorProc);
10166 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10167 /* Propagate the addStackTrace value through 'return -code error' */
10169 else {
10170 interp->addStackTrace = 0;
10174 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10176 Jim_Obj *objPtr;
10178 switch (token->type) {
10179 case JIM_TT_STR:
10180 case JIM_TT_ESC:
10181 objPtr = token->objPtr;
10182 break;
10183 case JIM_TT_VAR:
10184 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10185 break;
10186 case JIM_TT_DICTSUGAR:
10187 objPtr = JimExpandDictSugar(interp, token->objPtr);
10188 break;
10189 case JIM_TT_EXPRSUGAR:
10190 objPtr = JimExpandExprSugar(interp, token->objPtr);
10191 break;
10192 case JIM_TT_CMD:
10193 switch (Jim_EvalObj(interp, token->objPtr)) {
10194 case JIM_OK:
10195 case JIM_RETURN:
10196 objPtr = interp->result;
10197 break;
10198 case JIM_BREAK:
10199 /* Stop substituting */
10200 return JIM_BREAK;
10201 case JIM_CONTINUE:
10202 /* just skip this one */
10203 return JIM_CONTINUE;
10204 default:
10205 return JIM_ERR;
10207 break;
10208 default:
10209 JimPanic((1,
10210 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10211 objPtr = NULL;
10212 break;
10214 if (objPtr) {
10215 *objPtrPtr = objPtr;
10216 return JIM_OK;
10218 return JIM_ERR;
10221 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10222 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10223 * The returned object has refcount = 0.
10225 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10227 int totlen = 0, i;
10228 Jim_Obj **intv;
10229 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10230 Jim_Obj *objPtr;
10231 char *s;
10233 if (tokens <= JIM_EVAL_SINTV_LEN)
10234 intv = sintv;
10235 else
10236 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10238 /* Compute every token forming the argument
10239 * in the intv objects vector. */
10240 for (i = 0; i < tokens; i++) {
10241 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10242 case JIM_OK:
10243 case JIM_RETURN:
10244 break;
10245 case JIM_BREAK:
10246 if (flags & JIM_SUBST_FLAG) {
10247 /* Stop here */
10248 tokens = i;
10249 continue;
10251 /* XXX: Should probably set an error about break outside loop */
10252 /* fall through to error */
10253 case JIM_CONTINUE:
10254 if (flags & JIM_SUBST_FLAG) {
10255 intv[i] = NULL;
10256 continue;
10258 /* XXX: Ditto continue outside loop */
10259 /* fall through to error */
10260 default:
10261 while (i--) {
10262 Jim_DecrRefCount(interp, intv[i]);
10264 if (intv != sintv) {
10265 Jim_Free(intv);
10267 return NULL;
10269 Jim_IncrRefCount(intv[i]);
10270 Jim_String(intv[i]);
10271 totlen += intv[i]->length;
10274 /* Fast path return for a single token */
10275 if (tokens == 1 && intv[0] && intv == sintv) {
10276 Jim_DecrRefCount(interp, intv[0]);
10277 return intv[0];
10280 /* Concatenate every token in an unique
10281 * object. */
10282 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10284 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10285 && token[2].type == JIM_TT_VAR) {
10286 /* May be able to do fast interpolated object -> dictSubst */
10287 objPtr->typePtr = &interpolatedObjType;
10288 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10289 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10290 Jim_IncrRefCount(intv[2]);
10293 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10294 objPtr->length = totlen;
10295 for (i = 0; i < tokens; i++) {
10296 if (intv[i]) {
10297 memcpy(s, intv[i]->bytes, intv[i]->length);
10298 s += intv[i]->length;
10299 Jim_DecrRefCount(interp, intv[i]);
10302 objPtr->bytes[totlen] = '\0';
10303 /* Free the intv vector if not static. */
10304 if (intv != sintv) {
10305 Jim_Free(intv);
10308 return objPtr;
10312 /* listPtr *must* be a list.
10313 * The contents of the list is evaluated with the first element as the command and
10314 * the remaining elements as the arguments.
10316 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10318 int retcode = JIM_OK;
10320 if (listPtr->internalRep.listValue.len) {
10321 Jim_IncrRefCount(listPtr);
10322 retcode = JimInvokeCommand(interp,
10323 listPtr->internalRep.listValue.len,
10324 listPtr->internalRep.listValue.ele);
10325 Jim_DecrRefCount(interp, listPtr);
10327 return retcode;
10330 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10332 SetListFromAny(interp, listPtr);
10333 return JimEvalObjList(interp, listPtr);
10336 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10338 int i;
10339 ScriptObj *script;
10340 ScriptToken *token;
10341 int retcode = JIM_OK;
10342 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10343 Jim_Obj *prevScriptObj;
10345 /* If the object is of type "list", with no string rep we can call
10346 * a specialized version of Jim_EvalObj() */
10347 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10348 return JimEvalObjList(interp, scriptObjPtr);
10351 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10352 script = Jim_GetScript(interp, scriptObjPtr);
10354 /* Reset the interpreter result. This is useful to
10355 * return the empty result in the case of empty program. */
10356 Jim_SetEmptyResult(interp);
10358 token = script->token;
10360 #ifdef JIM_OPTIMIZATION
10361 /* Check for one of the following common scripts used by for, while
10363 * {}
10364 * incr a
10366 if (script->len == 0) {
10367 Jim_DecrRefCount(interp, scriptObjPtr);
10368 return JIM_OK;
10370 if (script->len == 3
10371 && token[1].objPtr->typePtr == &commandObjType
10372 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10373 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10374 && token[2].objPtr->typePtr == &variableObjType) {
10376 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10378 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10379 JimWideValue(objPtr)++;
10380 Jim_InvalidateStringRep(objPtr);
10381 Jim_DecrRefCount(interp, scriptObjPtr);
10382 Jim_SetResult(interp, objPtr);
10383 return JIM_OK;
10386 #endif
10388 /* Now we have to make sure the internal repr will not be
10389 * freed on shimmering.
10391 * Think for example to this:
10393 * set x {llength $x; ... some more code ...}; eval $x
10395 * In order to preserve the internal rep, we increment the
10396 * inUse field of the script internal rep structure. */
10397 script->inUse++;
10399 /* Stash the current script */
10400 prevScriptObj = interp->currentScriptObj;
10401 interp->currentScriptObj = scriptObjPtr;
10403 interp->errorFlag = 0;
10404 argv = sargv;
10406 /* Execute every command sequentially until the end of the script
10407 * or an error occurs.
10409 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10410 int argc;
10411 int j;
10413 /* First token of the line is always JIM_TT_LINE */
10414 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10415 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10417 /* Allocate the arguments vector if required */
10418 if (argc > JIM_EVAL_SARGV_LEN)
10419 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10421 /* Skip the JIM_TT_LINE token */
10422 i++;
10424 /* Populate the arguments objects.
10425 * If an error occurs, retcode will be set and
10426 * 'j' will be set to the number of args expanded
10428 for (j = 0; j < argc; j++) {
10429 long wordtokens = 1;
10430 int expand = 0;
10431 Jim_Obj *wordObjPtr = NULL;
10433 if (token[i].type == JIM_TT_WORD) {
10434 wordtokens = JimWideValue(token[i++].objPtr);
10435 if (wordtokens < 0) {
10436 expand = 1;
10437 wordtokens = -wordtokens;
10441 if (wordtokens == 1) {
10442 /* Fast path if the token does not
10443 * need interpolation */
10445 switch (token[i].type) {
10446 case JIM_TT_ESC:
10447 case JIM_TT_STR:
10448 wordObjPtr = token[i].objPtr;
10449 break;
10450 case JIM_TT_VAR:
10451 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10452 break;
10453 case JIM_TT_EXPRSUGAR:
10454 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10455 break;
10456 case JIM_TT_DICTSUGAR:
10457 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10458 break;
10459 case JIM_TT_CMD:
10460 retcode = Jim_EvalObj(interp, token[i].objPtr);
10461 if (retcode == JIM_OK) {
10462 wordObjPtr = Jim_GetResult(interp);
10464 break;
10465 default:
10466 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10469 else {
10470 /* For interpolation we call a helper
10471 * function to do the work for us. */
10472 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10475 if (!wordObjPtr) {
10476 if (retcode == JIM_OK) {
10477 retcode = JIM_ERR;
10479 break;
10482 Jim_IncrRefCount(wordObjPtr);
10483 i += wordtokens;
10485 if (!expand) {
10486 argv[j] = wordObjPtr;
10488 else {
10489 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10490 int len = Jim_ListLength(interp, wordObjPtr);
10491 int newargc = argc + len - 1;
10492 int k;
10494 if (len > 1) {
10495 if (argv == sargv) {
10496 if (newargc > JIM_EVAL_SARGV_LEN) {
10497 argv = Jim_Alloc(sizeof(*argv) * newargc);
10498 memcpy(argv, sargv, sizeof(*argv) * j);
10501 else {
10502 /* Need to realloc to make room for (len - 1) more entries */
10503 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10507 /* Now copy in the expanded version */
10508 for (k = 0; k < len; k++) {
10509 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10510 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10513 /* The original object reference is no longer needed,
10514 * after the expansion it is no longer present on
10515 * the argument vector, but the single elements are
10516 * in its place. */
10517 Jim_DecrRefCount(interp, wordObjPtr);
10519 /* And update the indexes */
10520 j--;
10521 argc += len - 1;
10525 if (retcode == JIM_OK && argc) {
10526 /* Invoke the command */
10527 retcode = JimInvokeCommand(interp, argc, argv);
10528 /* Check for a signal after each command */
10529 if (Jim_CheckSignal(interp)) {
10530 retcode = JIM_SIGNAL;
10534 /* Finished with the command, so decrement ref counts of each argument */
10535 while (j-- > 0) {
10536 Jim_DecrRefCount(interp, argv[j]);
10539 if (argv != sargv) {
10540 Jim_Free(argv);
10541 argv = sargv;
10545 /* Possibly add to the error stack trace */
10546 JimAddErrorToStack(interp, retcode, script);
10548 /* Restore the current script */
10549 interp->currentScriptObj = prevScriptObj;
10551 /* Note that we don't have to decrement inUse, because the
10552 * following code transfers our use of the reference again to
10553 * the script object. */
10554 Jim_FreeIntRep(interp, scriptObjPtr);
10555 scriptObjPtr->typePtr = &scriptObjType;
10556 Jim_SetIntRepPtr(scriptObjPtr, script);
10557 Jim_DecrRefCount(interp, scriptObjPtr);
10559 return retcode;
10562 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10564 int retcode;
10565 /* If argObjPtr begins with '&', do an automatic upvar */
10566 const char *varname = Jim_String(argNameObj);
10567 if (*varname == '&') {
10568 /* First check that the target variable exists */
10569 Jim_Obj *objPtr;
10570 Jim_CallFrame *savedCallFrame = interp->framePtr;
10572 interp->framePtr = interp->framePtr->parent;
10573 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10574 interp->framePtr = savedCallFrame;
10575 if (!objPtr) {
10576 return JIM_ERR;
10579 /* It exists, so perform the binding. */
10580 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10581 Jim_IncrRefCount(objPtr);
10582 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10583 Jim_DecrRefCount(interp, objPtr);
10585 else {
10586 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10588 return retcode;
10592 * Sets the interp result to be an error message indicating the required proc args.
10594 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10596 /* Create a nice error message, consistent with Tcl 8.5 */
10597 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10598 int i;
10600 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10601 Jim_AppendString(interp, argmsg, " ", 1);
10603 if (i == cmd->u.proc.argsPos) {
10604 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10605 /* Renamed args */
10606 Jim_AppendString(interp, argmsg, "?", 1);
10607 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10608 Jim_AppendString(interp, argmsg, " ...?", -1);
10610 else {
10611 /* We have plain args */
10612 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10615 else {
10616 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10617 Jim_AppendString(interp, argmsg, "?", 1);
10618 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10619 Jim_AppendString(interp, argmsg, "?", 1);
10621 else {
10622 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10623 if (*arg == '&') {
10624 arg++;
10626 Jim_AppendString(interp, argmsg, arg, -1);
10630 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10631 Jim_FreeNewObj(interp, argmsg);
10634 #ifdef jim_ext_namespace
10636 * [namespace eval]
10638 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10640 Jim_CallFrame *callFramePtr;
10641 int retcode;
10643 /* Create a new callframe */
10644 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10645 callFramePtr->argv = &interp->emptyObj;
10646 callFramePtr->argc = 0;
10647 callFramePtr->procArgsObjPtr = NULL;
10648 callFramePtr->procBodyObjPtr = scriptObj;
10649 callFramePtr->staticVars = NULL;
10650 callFramePtr->fileNameObj = interp->emptyObj;
10651 callFramePtr->line = 0;
10652 Jim_IncrRefCount(scriptObj);
10653 interp->framePtr = callFramePtr;
10655 /* Check if there are too nested calls */
10656 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10657 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10658 retcode = JIM_ERR;
10660 else {
10661 /* Eval the body */
10662 retcode = Jim_EvalObj(interp, scriptObj);
10665 /* Destroy the callframe */
10666 interp->framePtr = interp->framePtr->parent;
10667 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10668 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10670 else {
10671 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10674 return retcode;
10676 #endif
10678 /* Call a procedure implemented in Tcl.
10679 * It's possible to speed-up a lot this function, currently
10680 * the callframes are not cached, but allocated and
10681 * destroied every time. What is expecially costly is
10682 * to create/destroy the local vars hash table every time.
10684 * This can be fixed just implementing callframes caching
10685 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10686 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10688 Jim_CallFrame *callFramePtr;
10689 int i, d, retcode, optargs;
10690 Jim_Stack *localCommands;
10691 ScriptObj *script;
10693 /* Check arity */
10694 if (argc - 1 < cmd->u.proc.reqArity ||
10695 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10696 JimSetProcWrongArgs(interp, argv[0], cmd);
10697 return JIM_ERR;
10700 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10701 /* Optimise for procedure with no body - useful for optional debugging */
10702 return JIM_OK;
10705 /* Check if there are too nested calls */
10706 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10707 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10708 return JIM_ERR;
10711 /* Create a new callframe */
10712 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10713 callFramePtr->argv = argv;
10714 callFramePtr->argc = argc;
10715 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10716 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10717 callFramePtr->staticVars = cmd->u.proc.staticVars;
10719 /* Remember where we were called from. */
10720 script = Jim_GetScript(interp, interp->currentScriptObj);
10721 callFramePtr->fileNameObj = script->fileNameObj;
10722 callFramePtr->line = script->linenr;
10724 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10725 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10726 interp->framePtr = callFramePtr;
10728 /* How many optional args are available */
10729 optargs = (argc - 1 - cmd->u.proc.reqArity);
10731 /* Step 'i' along the actual args, and step 'd' along the formal args */
10732 i = 1;
10733 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10734 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10735 if (d == cmd->u.proc.argsPos) {
10736 /* assign $args */
10737 Jim_Obj *listObjPtr;
10738 int argsLen = 0;
10739 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10740 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10742 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10744 /* It is possible to rename args. */
10745 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10746 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10748 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10749 if (retcode != JIM_OK) {
10750 goto badargset;
10753 i += argsLen;
10754 continue;
10757 /* Optional or required? */
10758 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10759 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10761 else {
10762 /* Ran out, so use the default */
10763 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10765 if (retcode != JIM_OK) {
10766 goto badargset;
10770 /* Eval the body */
10771 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10773 badargset:
10774 /* Destroy the callframe */
10775 /* But first remove the local commands */
10776 localCommands = callFramePtr->localCommands;
10777 callFramePtr->localCommands = NULL;
10779 interp->framePtr = interp->framePtr->parent;
10780 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10781 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10783 else {
10784 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10787 /* Handle the JIM_EVAL return code */
10788 while (retcode == JIM_EVAL) {
10789 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
10791 Jim_IncrRefCount(resultScriptObjPtr);
10792 /* Result must be a list */
10793 JimPanic((!Jim_IsList(resultScriptObjPtr), "tailcall (JIM_EVAL) returned non-list"));
10795 retcode = JimEvalObjList(interp, resultScriptObjPtr);
10796 if (retcode == JIM_RETURN) {
10797 /* If the result of the tailcall invokes 'return', push
10798 * it up to the caller
10800 interp->returnLevel++;
10802 Jim_DecrRefCount(interp, resultScriptObjPtr);
10804 /* Handle the JIM_RETURN return code */
10805 if (retcode == JIM_RETURN) {
10806 if (--interp->returnLevel <= 0) {
10807 retcode = interp->returnCode;
10808 interp->returnCode = JIM_OK;
10809 interp->returnLevel = 0;
10812 else if (retcode == JIM_ERR) {
10813 interp->addStackTrace++;
10814 Jim_DecrRefCount(interp, interp->errorProc);
10815 interp->errorProc = argv[0];
10816 Jim_IncrRefCount(interp->errorProc);
10819 /* Finally delete local procs */
10820 JimDeleteLocalProcs(interp, localCommands);
10822 return retcode;
10825 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10827 int retval;
10828 Jim_Obj *scriptObjPtr;
10830 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10831 Jim_IncrRefCount(scriptObjPtr);
10833 if (filename) {
10834 Jim_Obj *prevScriptObj;
10836 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10838 prevScriptObj = interp->currentScriptObj;
10839 interp->currentScriptObj = scriptObjPtr;
10841 retval = Jim_EvalObj(interp, scriptObjPtr);
10843 interp->currentScriptObj = prevScriptObj;
10845 else {
10846 retval = Jim_EvalObj(interp, scriptObjPtr);
10848 Jim_DecrRefCount(interp, scriptObjPtr);
10849 return retval;
10852 int Jim_Eval(Jim_Interp *interp, const char *script)
10854 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10857 /* Execute script in the scope of the global level */
10858 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10860 int retval;
10861 Jim_CallFrame *savedFramePtr = interp->framePtr;
10863 interp->framePtr = interp->topFramePtr;
10864 retval = Jim_Eval(interp, script);
10865 interp->framePtr = savedFramePtr;
10867 return retval;
10870 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10872 int retval;
10873 Jim_CallFrame *savedFramePtr = interp->framePtr;
10875 interp->framePtr = interp->topFramePtr;
10876 retval = Jim_EvalFile(interp, filename);
10877 interp->framePtr = savedFramePtr;
10879 return retval;
10882 #include <sys/stat.h>
10884 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10886 FILE *fp;
10887 char *buf;
10888 Jim_Obj *scriptObjPtr;
10889 Jim_Obj *prevScriptObj;
10890 struct stat sb;
10891 int retcode;
10892 int readlen;
10893 struct JimParseResult result;
10895 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10896 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10897 return JIM_ERR;
10899 if (sb.st_size == 0) {
10900 fclose(fp);
10901 return JIM_OK;
10904 buf = Jim_Alloc(sb.st_size + 1);
10905 readlen = fread(buf, 1, sb.st_size, fp);
10906 if (ferror(fp)) {
10907 fclose(fp);
10908 Jim_Free(buf);
10909 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10910 return JIM_ERR;
10912 fclose(fp);
10913 buf[readlen] = 0;
10915 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10916 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10917 Jim_IncrRefCount(scriptObjPtr);
10919 /* Now check the script for unmatched braces, etc. */
10920 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
10921 const char *msg;
10922 char linebuf[20];
10924 switch (result.missing) {
10925 case '[':
10926 msg = "unmatched \"[\"";
10927 break;
10928 case '{':
10929 msg = "missing close-brace";
10930 break;
10931 case '"':
10932 default:
10933 msg = "missing quote";
10934 break;
10937 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
10939 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
10940 msg, filename, linebuf);
10941 Jim_DecrRefCount(interp, scriptObjPtr);
10942 return JIM_ERR;
10945 prevScriptObj = interp->currentScriptObj;
10946 interp->currentScriptObj = scriptObjPtr;
10948 retcode = Jim_EvalObj(interp, scriptObjPtr);
10950 /* Handle the JIM_RETURN return code */
10951 if (retcode == JIM_RETURN) {
10952 if (--interp->returnLevel <= 0) {
10953 retcode = interp->returnCode;
10954 interp->returnCode = JIM_OK;
10955 interp->returnLevel = 0;
10958 if (retcode == JIM_ERR) {
10959 /* EvalFile changes context, so add a stack frame here */
10960 interp->addStackTrace++;
10963 interp->currentScriptObj = prevScriptObj;
10965 Jim_DecrRefCount(interp, scriptObjPtr);
10967 return retcode;
10970 /* -----------------------------------------------------------------------------
10971 * Subst
10972 * ---------------------------------------------------------------------------*/
10973 static void JimParseSubst(struct JimParserCtx *pc, int flags)
10975 pc->tstart = pc->p;
10976 pc->tline = pc->linenr;
10978 if (pc->len == 0) {
10979 pc->tend = pc->p;
10980 pc->tt = JIM_TT_EOL;
10981 pc->eof = 1;
10982 return;
10984 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
10985 JimParseCmd(pc);
10986 return;
10988 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
10989 if (JimParseVar(pc) == JIM_OK) {
10990 return;
10992 /* Not a var, so treat as a string */
10993 pc->tstart = pc->p;
10994 flags |= JIM_SUBST_NOVAR;
10996 while (pc->len) {
10997 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
10998 break;
11000 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11001 break;
11003 if (*pc->p == '\\' && pc->len > 1) {
11004 pc->p++;
11005 pc->len--;
11007 pc->p++;
11008 pc->len--;
11010 pc->tend = pc->p - 1;
11011 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11014 /* The subst object type reuses most of the data structures and functions
11015 * of the script object. Script's data structures are a bit more complex
11016 * for what is needed for [subst]itution tasks, but the reuse helps to
11017 * deal with a single data structure at the cost of some more memory
11018 * usage for substitutions. */
11020 /* This method takes the string representation of an object
11021 * as a Tcl string where to perform [subst]itution, and generates
11022 * the pre-parsed internal representation. */
11023 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11025 int scriptTextLen;
11026 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11027 struct JimParserCtx parser;
11028 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11029 ParseTokenList tokenlist;
11031 /* Initially parse the subst into tokens (in tokenlist) */
11032 ScriptTokenListInit(&tokenlist);
11034 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11035 while (1) {
11036 JimParseSubst(&parser, flags);
11037 if (parser.eof) {
11038 /* Note that subst doesn't need the EOL token */
11039 break;
11041 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11042 parser.tline);
11045 /* Create the "real" subst/script tokens from the initial token list */
11046 script->inUse = 1;
11047 script->substFlags = flags;
11048 script->fileNameObj = interp->emptyObj;
11049 Jim_IncrRefCount(script->fileNameObj);
11050 SubstObjAddTokens(interp, script, &tokenlist);
11052 /* No longer need the token list */
11053 ScriptTokenListFree(&tokenlist);
11055 #ifdef DEBUG_SHOW_SUBST
11057 int i;
11059 printf("==== Subst ====\n");
11060 for (i = 0; i < script->len; i++) {
11061 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11062 Jim_String(script->token[i].objPtr));
11065 #endif
11067 /* Free the old internal rep and set the new one. */
11068 Jim_FreeIntRep(interp, objPtr);
11069 Jim_SetIntRepPtr(objPtr, script);
11070 objPtr->typePtr = &scriptObjType;
11071 return JIM_OK;
11074 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11076 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11077 SetSubstFromAny(interp, objPtr, flags);
11078 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11081 /* Performs commands,variables,blackslashes substitution,
11082 * storing the result object (with refcount 0) into
11083 * resObjPtrPtr. */
11084 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11086 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11088 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11089 /* In order to preserve the internal rep, we increment the
11090 * inUse field of the script internal rep structure. */
11091 script->inUse++;
11093 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11095 script->inUse--;
11096 Jim_DecrRefCount(interp, substObjPtr);
11097 if (*resObjPtrPtr == NULL) {
11098 return JIM_ERR;
11100 return JIM_OK;
11103 /* -----------------------------------------------------------------------------
11104 * Core commands utility functions
11105 * ---------------------------------------------------------------------------*/
11106 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11108 Jim_Obj *objPtr;
11109 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11111 if (*msg) {
11112 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11114 Jim_IncrRefCount(listObjPtr);
11115 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11116 Jim_DecrRefCount(interp, listObjPtr);
11118 Jim_IncrRefCount(objPtr);
11119 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11120 Jim_DecrRefCount(interp, objPtr);
11124 * May add the key and/or value to the list.
11126 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11127 Jim_HashEntry *he, int type);
11129 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11132 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11133 * invoke the callback to add entries to a list.
11134 * Returns the list.
11136 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11137 JimHashtableIteratorCallbackType *callback, int type)
11139 Jim_HashEntry *he;
11140 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11142 /* Check for the non-pattern case. We can do this much more efficiently. */
11143 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11144 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11145 if (he) {
11146 callback(interp, listObjPtr, he, type);
11149 else {
11150 Jim_HashTableIterator htiter;
11151 JimInitHashTableIterator(ht, &htiter);
11152 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11153 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11154 callback(interp, listObjPtr, he, type);
11158 return listObjPtr;
11161 /* Keep these in order */
11162 #define JIM_CMDLIST_COMMANDS 0
11163 #define JIM_CMDLIST_PROCS 1
11164 #define JIM_CMDLIST_CHANNELS 2
11167 * Adds matching command names (procs, channels) to the list.
11169 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11170 Jim_HashEntry *he, int type)
11172 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11173 Jim_Obj *objPtr;
11175 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11176 /* not a proc */
11177 return;
11180 objPtr = Jim_NewStringObj(interp, he->key, -1);
11181 Jim_IncrRefCount(objPtr);
11183 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11184 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11186 Jim_DecrRefCount(interp, objPtr);
11189 /* type is JIM_CMDLIST_xxx */
11190 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11192 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11195 /* Keep these in order */
11196 #define JIM_VARLIST_GLOBALS 0
11197 #define JIM_VARLIST_LOCALS 1
11198 #define JIM_VARLIST_VARS 2
11200 #define JIM_VARLIST_VALUES 0x1000
11203 * Adds matching variable names to the list.
11205 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11206 Jim_HashEntry *he, int type)
11208 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11210 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11211 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11212 if (type & JIM_VARLIST_VALUES) {
11213 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11218 /* mode is JIM_VARLIST_xxx */
11219 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11221 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11222 /* For [info locals], if we are at top level an emtpy list
11223 * is returned. I don't agree, but we aim at compatibility (SS) */
11224 return interp->emptyObj;
11226 else {
11227 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11228 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11232 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11233 Jim_Obj **objPtrPtr, int info_level_cmd)
11235 Jim_CallFrame *targetCallFrame;
11237 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11238 if (targetCallFrame == NULL) {
11239 return JIM_ERR;
11241 /* No proc call at toplevel callframe */
11242 if (targetCallFrame == interp->topFramePtr) {
11243 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11244 return JIM_ERR;
11246 if (info_level_cmd) {
11247 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11249 else {
11250 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11252 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11253 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11254 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11255 *objPtrPtr = listObj;
11257 return JIM_OK;
11260 /* -----------------------------------------------------------------------------
11261 * Core commands
11262 * ---------------------------------------------------------------------------*/
11264 /* fake [puts] -- not the real puts, just for debugging. */
11265 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11267 if (argc != 2 && argc != 3) {
11268 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11269 return JIM_ERR;
11271 if (argc == 3) {
11272 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11273 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11274 return JIM_ERR;
11276 else {
11277 fputs(Jim_String(argv[2]), stdout);
11280 else {
11281 puts(Jim_String(argv[1]));
11283 return JIM_OK;
11286 /* Helper for [+] and [*] */
11287 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11289 jim_wide wideValue, res;
11290 double doubleValue, doubleRes;
11291 int i;
11293 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11295 for (i = 1; i < argc; i++) {
11296 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11297 goto trydouble;
11298 if (op == JIM_EXPROP_ADD)
11299 res += wideValue;
11300 else
11301 res *= wideValue;
11303 Jim_SetResultInt(interp, res);
11304 return JIM_OK;
11305 trydouble:
11306 doubleRes = (double)res;
11307 for (; i < argc; i++) {
11308 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11309 return JIM_ERR;
11310 if (op == JIM_EXPROP_ADD)
11311 doubleRes += doubleValue;
11312 else
11313 doubleRes *= doubleValue;
11315 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11316 return JIM_OK;
11319 /* Helper for [-] and [/] */
11320 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11322 jim_wide wideValue, res = 0;
11323 double doubleValue, doubleRes = 0;
11324 int i = 2;
11326 if (argc < 2) {
11327 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11328 return JIM_ERR;
11330 else if (argc == 2) {
11331 /* The arity = 2 case is different. For [- x] returns -x,
11332 * while [/ x] returns 1/x. */
11333 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11334 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11335 return JIM_ERR;
11337 else {
11338 if (op == JIM_EXPROP_SUB)
11339 doubleRes = -doubleValue;
11340 else
11341 doubleRes = 1.0 / doubleValue;
11342 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11343 return JIM_OK;
11346 if (op == JIM_EXPROP_SUB) {
11347 res = -wideValue;
11348 Jim_SetResultInt(interp, res);
11350 else {
11351 doubleRes = 1.0 / wideValue;
11352 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11354 return JIM_OK;
11356 else {
11357 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11358 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11359 != JIM_OK) {
11360 return JIM_ERR;
11362 else {
11363 goto trydouble;
11367 for (i = 2; i < argc; i++) {
11368 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11369 doubleRes = (double)res;
11370 goto trydouble;
11372 if (op == JIM_EXPROP_SUB)
11373 res -= wideValue;
11374 else
11375 res /= wideValue;
11377 Jim_SetResultInt(interp, res);
11378 return JIM_OK;
11379 trydouble:
11380 for (; i < argc; i++) {
11381 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11382 return JIM_ERR;
11383 if (op == JIM_EXPROP_SUB)
11384 doubleRes -= doubleValue;
11385 else
11386 doubleRes /= doubleValue;
11388 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11389 return JIM_OK;
11393 /* [+] */
11394 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11396 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11399 /* [*] */
11400 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11402 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11405 /* [-] */
11406 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11408 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11411 /* [/] */
11412 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11414 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11417 /* [set] */
11418 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11420 if (argc != 2 && argc != 3) {
11421 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11422 return JIM_ERR;
11424 if (argc == 2) {
11425 Jim_Obj *objPtr;
11427 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11428 if (!objPtr)
11429 return JIM_ERR;
11430 Jim_SetResult(interp, objPtr);
11431 return JIM_OK;
11433 /* argc == 3 case. */
11434 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11435 return JIM_ERR;
11436 Jim_SetResult(interp, argv[2]);
11437 return JIM_OK;
11440 /* [unset]
11442 * unset ?-nocomplain? ?--? ?varName ...?
11444 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11446 int i = 1;
11447 int complain = 1;
11449 while (i < argc) {
11450 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11451 i++;
11452 break;
11454 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11455 complain = 0;
11456 i++;
11457 continue;
11459 break;
11462 while (i < argc) {
11463 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11464 && complain) {
11465 return JIM_ERR;
11467 i++;
11469 return JIM_OK;
11472 /* [while] */
11473 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11475 if (argc != 3) {
11476 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11477 return JIM_ERR;
11480 /* The general purpose implementation of while starts here */
11481 while (1) {
11482 int boolean, retval;
11484 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11485 return retval;
11486 if (!boolean)
11487 break;
11489 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11490 switch (retval) {
11491 case JIM_BREAK:
11492 goto out;
11493 break;
11494 case JIM_CONTINUE:
11495 continue;
11496 break;
11497 default:
11498 return retval;
11502 out:
11503 Jim_SetEmptyResult(interp);
11504 return JIM_OK;
11507 /* [for] */
11508 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11510 int retval;
11511 int boolean = 1;
11512 Jim_Obj *varNamePtr = NULL;
11513 Jim_Obj *stopVarNamePtr = NULL;
11515 if (argc != 5) {
11516 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11517 return JIM_ERR;
11520 /* Do the initialisation */
11521 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11522 return retval;
11525 /* And do the first test now. Better for optimisation
11526 * if we can do next/test at the bottom of the loop
11528 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11530 /* Ready to do the body as follows:
11531 * while (1) {
11532 * body // check retcode
11533 * next // check retcode
11534 * test // check retcode/test bool
11538 #ifdef JIM_OPTIMIZATION
11539 /* Check if the for is on the form:
11540 * for ... {$i < CONST} {incr i}
11541 * for ... {$i < $j} {incr i}
11543 if (retval == JIM_OK && boolean) {
11544 ScriptObj *incrScript;
11545 ExprByteCode *expr;
11546 jim_wide stop, currentVal;
11547 Jim_Obj *objPtr;
11548 int cmpOffset;
11550 /* Do it only if there aren't shared arguments */
11551 expr = JimGetExpression(interp, argv[2]);
11552 incrScript = Jim_GetScript(interp, argv[3]);
11554 /* Ensure proper lengths to start */
11555 if (incrScript->len != 3 || !expr || expr->len != 3) {
11556 goto evalstart;
11558 /* Ensure proper token types. */
11559 if (incrScript->token[1].type != JIM_TT_ESC ||
11560 expr->token[0].type != JIM_TT_VAR ||
11561 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11562 goto evalstart;
11565 if (expr->token[2].type == JIM_EXPROP_LT) {
11566 cmpOffset = 0;
11568 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11569 cmpOffset = 1;
11571 else {
11572 goto evalstart;
11575 /* Update command must be incr */
11576 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11577 goto evalstart;
11580 /* incr, expression must be about the same variable */
11581 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11582 goto evalstart;
11585 /* Get the stop condition (must be a variable or integer) */
11586 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11587 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11588 goto evalstart;
11591 else {
11592 stopVarNamePtr = expr->token[1].objPtr;
11593 Jim_IncrRefCount(stopVarNamePtr);
11594 /* Keep the compiler happy */
11595 stop = 0;
11598 /* Initialization */
11599 varNamePtr = expr->token[0].objPtr;
11600 Jim_IncrRefCount(varNamePtr);
11602 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11603 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11604 goto testcond;
11607 /* --- OPTIMIZED FOR --- */
11608 while (retval == JIM_OK) {
11609 /* === Check condition === */
11610 /* Note that currentVal is already set here */
11612 /* Immediate or Variable? get the 'stop' value if the latter. */
11613 if (stopVarNamePtr) {
11614 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11615 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11616 goto testcond;
11620 if (currentVal >= stop + cmpOffset) {
11621 break;
11624 /* Eval body */
11625 retval = Jim_EvalObj(interp, argv[4]);
11626 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11627 retval = JIM_OK;
11629 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11631 /* Increment */
11632 if (objPtr == NULL) {
11633 retval = JIM_ERR;
11634 goto out;
11636 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11637 currentVal = ++JimWideValue(objPtr);
11638 Jim_InvalidateStringRep(objPtr);
11640 else {
11641 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11642 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11643 ++currentVal)) != JIM_OK) {
11644 goto evalnext;
11649 goto out;
11651 evalstart:
11652 #endif
11654 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11655 /* Body */
11656 retval = Jim_EvalObj(interp, argv[4]);
11658 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11659 /* increment */
11660 evalnext:
11661 retval = Jim_EvalObj(interp, argv[3]);
11662 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11663 /* test */
11664 testcond:
11665 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11669 out:
11670 if (stopVarNamePtr) {
11671 Jim_DecrRefCount(interp, stopVarNamePtr);
11673 if (varNamePtr) {
11674 Jim_DecrRefCount(interp, varNamePtr);
11677 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11678 Jim_SetEmptyResult(interp);
11679 return JIM_OK;
11682 return retval;
11685 /* [loop] */
11686 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11688 int retval;
11689 jim_wide i;
11690 jim_wide limit;
11691 jim_wide incr = 1;
11692 Jim_Obj *bodyObjPtr;
11694 if (argc != 5 && argc != 6) {
11695 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11696 return JIM_ERR;
11699 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11700 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11701 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11702 return JIM_ERR;
11704 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11706 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11708 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11709 retval = Jim_EvalObj(interp, bodyObjPtr);
11710 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11711 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11713 retval = JIM_OK;
11715 /* Increment */
11716 i += incr;
11718 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11719 if (argv[1]->typePtr != &variableObjType) {
11720 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11721 return JIM_ERR;
11724 JimWideValue(objPtr) = i;
11725 Jim_InvalidateStringRep(objPtr);
11727 /* The following step is required in order to invalidate the
11728 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11729 if (argv[1]->typePtr != &variableObjType) {
11730 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11731 retval = JIM_ERR;
11732 break;
11736 else {
11737 objPtr = Jim_NewIntObj(interp, i);
11738 retval = Jim_SetVariable(interp, argv[1], objPtr);
11739 if (retval != JIM_OK) {
11740 Jim_FreeNewObj(interp, objPtr);
11746 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11747 Jim_SetEmptyResult(interp);
11748 return JIM_OK;
11750 return retval;
11753 /* List iterators make it easy to iterate over a list.
11754 * At some point iterators will be expanded to support generators.
11756 typedef struct {
11757 Jim_Obj *objPtr;
11758 int idx;
11759 } Jim_ListIter;
11762 * Initialise the iterator at the start of the list.
11764 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11766 iter->objPtr = objPtr;
11767 iter->idx = 0;
11771 * Returns the next object from the list, or NULL on end-of-list.
11773 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11775 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11776 return NULL;
11778 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11782 * Returns 1 if end-of-list has been reached.
11784 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11786 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11789 /* foreach + lmap implementation. */
11790 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11792 int result = JIM_ERR;
11793 int i, numargs;
11794 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11795 Jim_ListIter *iters;
11796 Jim_Obj *script;
11797 Jim_Obj *resultObj;
11799 if (argc < 4 || argc % 2 != 0) {
11800 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11801 return JIM_ERR;
11803 script = argv[argc - 1]; /* Last argument is a script */
11804 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11806 if (numargs == 2) {
11807 iters = twoiters;
11809 else {
11810 iters = Jim_Alloc(numargs * sizeof(*iters));
11812 for (i = 0; i < numargs; i++) {
11813 JimListIterInit(&iters[i], argv[i + 1]);
11814 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11815 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11816 return JIM_ERR;
11820 if (doMap) {
11821 resultObj = Jim_NewListObj(interp, NULL, 0);
11823 else {
11824 resultObj = interp->emptyObj;
11826 Jim_IncrRefCount(resultObj);
11828 while (1) {
11829 /* Have we expired all lists? */
11830 for (i = 0; i < numargs; i += 2) {
11831 if (!JimListIterDone(interp, &iters[i + 1])) {
11832 break;
11835 if (i == numargs) {
11836 /* All done */
11837 break;
11840 /* For each list */
11841 for (i = 0; i < numargs; i += 2) {
11842 Jim_Obj *varName;
11844 /* foreach var */
11845 JimListIterInit(&iters[i], argv[i + 1]);
11846 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11847 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11848 if (!valObj) {
11849 /* Ran out, so store the empty string */
11850 valObj = interp->emptyObj;
11852 /* Avoid shimmering */
11853 Jim_IncrRefCount(valObj);
11854 result = Jim_SetVariable(interp, varName, valObj);
11855 Jim_DecrRefCount(interp, valObj);
11856 if (result != JIM_OK) {
11857 goto err;
11861 switch (result = Jim_EvalObj(interp, script)) {
11862 case JIM_OK:
11863 if (doMap) {
11864 Jim_ListAppendElement(interp, resultObj, interp->result);
11866 break;
11867 case JIM_CONTINUE:
11868 break;
11869 case JIM_BREAK:
11870 goto out;
11871 default:
11872 goto err;
11875 out:
11876 result = JIM_OK;
11877 Jim_SetResult(interp, resultObj);
11878 err:
11879 Jim_DecrRefCount(interp, resultObj);
11880 if (numargs > 2) {
11881 Jim_Free(iters);
11883 return result;
11886 /* [foreach] */
11887 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11889 return JimForeachMapHelper(interp, argc, argv, 0);
11892 /* [lmap] */
11893 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11895 return JimForeachMapHelper(interp, argc, argv, 1);
11898 /* [lassign] */
11899 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11901 int result = JIM_ERR;
11902 int i;
11903 Jim_ListIter iter;
11904 Jim_Obj *resultObj;
11906 if (argc < 2) {
11907 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11908 return JIM_ERR;
11911 JimListIterInit(&iter, argv[1]);
11913 for (i = 2; i < argc; i++) {
11914 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11915 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11916 if (result != JIM_OK) {
11917 return result;
11921 resultObj = Jim_NewListObj(interp, NULL, 0);
11922 while (!JimListIterDone(interp, &iter)) {
11923 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11926 Jim_SetResult(interp, resultObj);
11928 return JIM_OK;
11931 /* [if] */
11932 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11934 int boolean, retval, current = 1, falsebody = 0;
11936 if (argc >= 3) {
11937 while (1) {
11938 /* Far not enough arguments given! */
11939 if (current >= argc)
11940 goto err;
11941 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11942 != JIM_OK)
11943 return retval;
11944 /* There lacks something, isn't it? */
11945 if (current >= argc)
11946 goto err;
11947 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11948 current++;
11949 /* Tsk tsk, no then-clause? */
11950 if (current >= argc)
11951 goto err;
11952 if (boolean)
11953 return Jim_EvalObj(interp, argv[current]);
11954 /* Ok: no else-clause follows */
11955 if (++current >= argc) {
11956 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11957 return JIM_OK;
11959 falsebody = current++;
11960 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
11961 /* IIICKS - else-clause isn't last cmd? */
11962 if (current != argc - 1)
11963 goto err;
11964 return Jim_EvalObj(interp, argv[current]);
11966 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
11967 /* Ok: elseif follows meaning all the stuff
11968 * again (how boring...) */
11969 continue;
11970 /* OOPS - else-clause is not last cmd? */
11971 else if (falsebody != argc - 1)
11972 goto err;
11973 return Jim_EvalObj(interp, argv[falsebody]);
11975 return JIM_OK;
11977 err:
11978 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11979 return JIM_ERR;
11983 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11984 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
11985 Jim_Obj *stringObj, int nocase)
11987 Jim_Obj *parms[4];
11988 int argc = 0;
11989 long eq;
11990 int rc;
11992 parms[argc++] = commandObj;
11993 if (nocase) {
11994 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
11996 parms[argc++] = patternObj;
11997 parms[argc++] = stringObj;
11999 rc = Jim_EvalObjVector(interp, argc, parms);
12001 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12002 eq = -rc;
12005 return eq;
12008 enum
12009 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12011 /* [switch] */
12012 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12014 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12015 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12016 Jim_Obj *script = 0;
12018 if (argc < 3) {
12019 wrongnumargs:
12020 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12021 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12022 return JIM_ERR;
12024 for (opt = 1; opt < argc; ++opt) {
12025 const char *option = Jim_String(argv[opt]);
12027 if (*option != '-')
12028 break;
12029 else if (strncmp(option, "--", 2) == 0) {
12030 ++opt;
12031 break;
12033 else if (strncmp(option, "-exact", 2) == 0)
12034 matchOpt = SWITCH_EXACT;
12035 else if (strncmp(option, "-glob", 2) == 0)
12036 matchOpt = SWITCH_GLOB;
12037 else if (strncmp(option, "-regexp", 2) == 0)
12038 matchOpt = SWITCH_RE;
12039 else if (strncmp(option, "-command", 2) == 0) {
12040 matchOpt = SWITCH_CMD;
12041 if ((argc - opt) < 2)
12042 goto wrongnumargs;
12043 command = argv[++opt];
12045 else {
12046 Jim_SetResultFormatted(interp,
12047 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12048 argv[opt]);
12049 return JIM_ERR;
12051 if ((argc - opt) < 2)
12052 goto wrongnumargs;
12054 strObj = argv[opt++];
12055 patCount = argc - opt;
12056 if (patCount == 1) {
12057 Jim_Obj **vector;
12059 JimListGetElements(interp, argv[opt], &patCount, &vector);
12060 caseList = vector;
12062 else
12063 caseList = &argv[opt];
12064 if (patCount == 0 || patCount % 2 != 0)
12065 goto wrongnumargs;
12066 for (i = 0; script == 0 && i < patCount; i += 2) {
12067 Jim_Obj *patObj = caseList[i];
12069 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12070 || i < (patCount - 2)) {
12071 switch (matchOpt) {
12072 case SWITCH_EXACT:
12073 if (Jim_StringEqObj(strObj, patObj))
12074 script = caseList[i + 1];
12075 break;
12076 case SWITCH_GLOB:
12077 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12078 script = caseList[i + 1];
12079 break;
12080 case SWITCH_RE:
12081 command = Jim_NewStringObj(interp, "regexp", -1);
12082 /* Fall thru intentionally */
12083 case SWITCH_CMD:{
12084 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12086 /* After the execution of a command we need to
12087 * make sure to reconvert the object into a list
12088 * again. Only for the single-list style [switch]. */
12089 if (argc - opt == 1) {
12090 Jim_Obj **vector;
12092 JimListGetElements(interp, argv[opt], &patCount, &vector);
12093 caseList = vector;
12095 /* command is here already decref'd */
12096 if (rc < 0) {
12097 return -rc;
12099 if (rc)
12100 script = caseList[i + 1];
12101 break;
12105 else {
12106 script = caseList[i + 1];
12109 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12110 script = caseList[i + 1];
12111 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12112 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12113 return JIM_ERR;
12115 Jim_SetEmptyResult(interp);
12116 if (script) {
12117 return Jim_EvalObj(interp, script);
12119 return JIM_OK;
12122 /* [list] */
12123 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12125 Jim_Obj *listObjPtr;
12127 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12128 Jim_SetResult(interp, listObjPtr);
12129 return JIM_OK;
12132 /* [lindex] */
12133 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12135 Jim_Obj *objPtr, *listObjPtr;
12136 int i;
12137 int idx;
12139 if (argc < 3) {
12140 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12141 return JIM_ERR;
12143 objPtr = argv[1];
12144 Jim_IncrRefCount(objPtr);
12145 for (i = 2; i < argc; i++) {
12146 listObjPtr = objPtr;
12147 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12148 Jim_DecrRefCount(interp, listObjPtr);
12149 return JIM_ERR;
12151 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12152 /* Returns an empty object if the index
12153 * is out of range. */
12154 Jim_DecrRefCount(interp, listObjPtr);
12155 Jim_SetEmptyResult(interp);
12156 return JIM_OK;
12158 Jim_IncrRefCount(objPtr);
12159 Jim_DecrRefCount(interp, listObjPtr);
12161 Jim_SetResult(interp, objPtr);
12162 Jim_DecrRefCount(interp, objPtr);
12163 return JIM_OK;
12166 /* [llength] */
12167 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12169 if (argc != 2) {
12170 Jim_WrongNumArgs(interp, 1, argv, "list");
12171 return JIM_ERR;
12173 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12174 return JIM_OK;
12177 /* [lsearch] */
12178 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12180 static const char * const options[] = {
12181 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12182 NULL
12184 enum
12185 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12186 OPT_COMMAND };
12187 int i;
12188 int opt_bool = 0;
12189 int opt_not = 0;
12190 int opt_nocase = 0;
12191 int opt_all = 0;
12192 int opt_inline = 0;
12193 int opt_match = OPT_EXACT;
12194 int listlen;
12195 int rc = JIM_OK;
12196 Jim_Obj *listObjPtr = NULL;
12197 Jim_Obj *commandObj = NULL;
12199 if (argc < 3) {
12200 wrongargs:
12201 Jim_WrongNumArgs(interp, 1, argv,
12202 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12203 return JIM_ERR;
12206 for (i = 1; i < argc - 2; i++) {
12207 int option;
12209 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12210 return JIM_ERR;
12212 switch (option) {
12213 case OPT_BOOL:
12214 opt_bool = 1;
12215 opt_inline = 0;
12216 break;
12217 case OPT_NOT:
12218 opt_not = 1;
12219 break;
12220 case OPT_NOCASE:
12221 opt_nocase = 1;
12222 break;
12223 case OPT_INLINE:
12224 opt_inline = 1;
12225 opt_bool = 0;
12226 break;
12227 case OPT_ALL:
12228 opt_all = 1;
12229 break;
12230 case OPT_COMMAND:
12231 if (i >= argc - 2) {
12232 goto wrongargs;
12234 commandObj = argv[++i];
12235 /* fallthru */
12236 case OPT_EXACT:
12237 case OPT_GLOB:
12238 case OPT_REGEXP:
12239 opt_match = option;
12240 break;
12244 argv += i;
12246 if (opt_all) {
12247 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12249 if (opt_match == OPT_REGEXP) {
12250 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12252 if (commandObj) {
12253 Jim_IncrRefCount(commandObj);
12256 listlen = Jim_ListLength(interp, argv[0]);
12257 for (i = 0; i < listlen; i++) {
12258 Jim_Obj *objPtr;
12259 int eq = 0;
12261 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12262 switch (opt_match) {
12263 case OPT_EXACT:
12264 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12265 break;
12267 case OPT_GLOB:
12268 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12269 break;
12271 case OPT_REGEXP:
12272 case OPT_COMMAND:
12273 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12274 if (eq < 0) {
12275 if (listObjPtr) {
12276 Jim_FreeNewObj(interp, listObjPtr);
12278 rc = JIM_ERR;
12279 goto done;
12281 break;
12284 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12285 if (!eq && opt_bool && opt_not && !opt_all) {
12286 continue;
12289 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12290 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12291 Jim_Obj *resultObj;
12293 if (opt_bool) {
12294 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12296 else if (!opt_inline) {
12297 resultObj = Jim_NewIntObj(interp, i);
12299 else {
12300 resultObj = objPtr;
12303 if (opt_all) {
12304 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12306 else {
12307 Jim_SetResult(interp, resultObj);
12308 goto done;
12313 if (opt_all) {
12314 Jim_SetResult(interp, listObjPtr);
12316 else {
12317 /* No match */
12318 if (opt_bool) {
12319 Jim_SetResultBool(interp, opt_not);
12321 else if (!opt_inline) {
12322 Jim_SetResultInt(interp, -1);
12326 done:
12327 if (commandObj) {
12328 Jim_DecrRefCount(interp, commandObj);
12330 return rc;
12333 /* [lappend] */
12334 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12336 Jim_Obj *listObjPtr;
12337 int shared, i;
12339 if (argc < 2) {
12340 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12341 return JIM_ERR;
12343 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12344 if (!listObjPtr) {
12345 /* Create the list if it does not exists */
12346 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12347 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12348 Jim_FreeNewObj(interp, listObjPtr);
12349 return JIM_ERR;
12352 shared = Jim_IsShared(listObjPtr);
12353 if (shared)
12354 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12355 for (i = 2; i < argc; i++)
12356 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12357 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12358 if (shared)
12359 Jim_FreeNewObj(interp, listObjPtr);
12360 return JIM_ERR;
12362 Jim_SetResult(interp, listObjPtr);
12363 return JIM_OK;
12366 /* [linsert] */
12367 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12369 int idx, len;
12370 Jim_Obj *listPtr;
12372 if (argc < 3) {
12373 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12374 return JIM_ERR;
12376 listPtr = argv[1];
12377 if (Jim_IsShared(listPtr))
12378 listPtr = Jim_DuplicateObj(interp, listPtr);
12379 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12380 goto err;
12381 len = Jim_ListLength(interp, listPtr);
12382 if (idx >= len)
12383 idx = len;
12384 else if (idx < 0)
12385 idx = len + idx + 1;
12386 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12387 Jim_SetResult(interp, listPtr);
12388 return JIM_OK;
12389 err:
12390 if (listPtr != argv[1]) {
12391 Jim_FreeNewObj(interp, listPtr);
12393 return JIM_ERR;
12396 /* [lreplace] */
12397 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12399 int first, last, len, rangeLen;
12400 Jim_Obj *listObj;
12401 Jim_Obj *newListObj;
12403 if (argc < 4) {
12404 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12405 return JIM_ERR;
12407 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12408 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12409 return JIM_ERR;
12412 listObj = argv[1];
12413 len = Jim_ListLength(interp, listObj);
12415 first = JimRelToAbsIndex(len, first);
12416 last = JimRelToAbsIndex(len, last);
12417 JimRelToAbsRange(len, &first, &last, &rangeLen);
12419 /* Now construct a new list which consists of:
12420 * <elements before first> <supplied elements> <elements after last>
12423 /* Check to see if trying to replace past the end of the list */
12424 if (first < len) {
12425 /* OK. Not past the end */
12427 else if (len == 0) {
12428 /* Special for empty list, adjust first to 0 */
12429 first = 0;
12431 else {
12432 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12433 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12434 return JIM_ERR;
12437 /* Add the first set of elements */
12438 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12440 /* Add supplied elements */
12441 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12443 /* Add the remaining elements */
12444 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12446 Jim_SetResult(interp, newListObj);
12447 return JIM_OK;
12450 /* [lset] */
12451 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12453 if (argc < 3) {
12454 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12455 return JIM_ERR;
12457 else if (argc == 3) {
12458 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12459 return JIM_ERR;
12460 Jim_SetResult(interp, argv[2]);
12461 return JIM_OK;
12463 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12464 == JIM_ERR)
12465 return JIM_ERR;
12466 return JIM_OK;
12469 /* [lsort] */
12470 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12472 static const char * const options[] = {
12473 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
12475 enum
12476 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_INDEX };
12477 Jim_Obj *resObj;
12478 int i;
12479 int retCode;
12481 struct lsort_info info;
12483 if (argc < 2) {
12484 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12485 return JIM_ERR;
12488 info.type = JIM_LSORT_ASCII;
12489 info.order = 1;
12490 info.indexed = 0;
12491 info.command = NULL;
12492 info.interp = interp;
12494 for (i = 1; i < (argc - 1); i++) {
12495 int option;
12497 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
12498 != JIM_OK)
12499 return JIM_ERR;
12500 switch (option) {
12501 case OPT_ASCII:
12502 info.type = JIM_LSORT_ASCII;
12503 break;
12504 case OPT_NOCASE:
12505 info.type = JIM_LSORT_NOCASE;
12506 break;
12507 case OPT_INTEGER:
12508 info.type = JIM_LSORT_INTEGER;
12509 break;
12510 case OPT_INCREASING:
12511 info.order = 1;
12512 break;
12513 case OPT_DECREASING:
12514 info.order = -1;
12515 break;
12516 case OPT_COMMAND:
12517 if (i >= (argc - 2)) {
12518 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12519 return JIM_ERR;
12521 info.type = JIM_LSORT_COMMAND;
12522 info.command = argv[i + 1];
12523 i++;
12524 break;
12525 case OPT_INDEX:
12526 if (i >= (argc - 2)) {
12527 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12528 return JIM_ERR;
12530 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12531 return JIM_ERR;
12533 info.indexed = 1;
12534 i++;
12535 break;
12538 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12539 retCode = ListSortElements(interp, resObj, &info);
12540 if (retCode == JIM_OK) {
12541 Jim_SetResult(interp, resObj);
12543 else {
12544 Jim_FreeNewObj(interp, resObj);
12546 return retCode;
12549 /* [append] */
12550 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12552 Jim_Obj *stringObjPtr;
12553 int i;
12555 if (argc < 2) {
12556 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12557 return JIM_ERR;
12559 if (argc == 2) {
12560 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12561 if (!stringObjPtr)
12562 return JIM_ERR;
12564 else {
12565 int freeobj = 0;
12566 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12567 if (!stringObjPtr) {
12568 /* Create the string if it doesn't exist */
12569 stringObjPtr = Jim_NewEmptyStringObj(interp);
12570 freeobj = 1;
12572 else if (Jim_IsShared(stringObjPtr)) {
12573 freeobj = 1;
12574 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12576 for (i = 2; i < argc; i++) {
12577 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12579 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12580 if (freeobj) {
12581 Jim_FreeNewObj(interp, stringObjPtr);
12583 return JIM_ERR;
12586 Jim_SetResult(interp, stringObjPtr);
12587 return JIM_OK;
12590 /* [debug] */
12591 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12593 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12594 static const char * const options[] = {
12595 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12596 "exprbc", "show",
12597 NULL
12599 enum
12601 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12602 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12604 int option;
12606 if (argc < 2) {
12607 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12608 return JIM_ERR;
12610 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12611 return JIM_ERR;
12612 if (option == OPT_REFCOUNT) {
12613 if (argc != 3) {
12614 Jim_WrongNumArgs(interp, 2, argv, "object");
12615 return JIM_ERR;
12617 Jim_SetResultInt(interp, argv[2]->refCount);
12618 return JIM_OK;
12620 else if (option == OPT_OBJCOUNT) {
12621 int freeobj = 0, liveobj = 0;
12622 char buf[256];
12623 Jim_Obj *objPtr;
12625 if (argc != 2) {
12626 Jim_WrongNumArgs(interp, 2, argv, "");
12627 return JIM_ERR;
12629 /* Count the number of free objects. */
12630 objPtr = interp->freeList;
12631 while (objPtr) {
12632 freeobj++;
12633 objPtr = objPtr->nextObjPtr;
12635 /* Count the number of live objects. */
12636 objPtr = interp->liveList;
12637 while (objPtr) {
12638 liveobj++;
12639 objPtr = objPtr->nextObjPtr;
12641 /* Set the result string and return. */
12642 sprintf(buf, "free %d used %d", freeobj, liveobj);
12643 Jim_SetResultString(interp, buf, -1);
12644 return JIM_OK;
12646 else if (option == OPT_OBJECTS) {
12647 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12649 /* Count the number of live objects. */
12650 objPtr = interp->liveList;
12651 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12652 while (objPtr) {
12653 char buf[128];
12654 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12656 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12657 sprintf(buf, "%p", objPtr);
12658 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12659 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12660 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12661 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12662 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12663 objPtr = objPtr->nextObjPtr;
12665 Jim_SetResult(interp, listObjPtr);
12666 return JIM_OK;
12668 else if (option == OPT_INVSTR) {
12669 Jim_Obj *objPtr;
12671 if (argc != 3) {
12672 Jim_WrongNumArgs(interp, 2, argv, "object");
12673 return JIM_ERR;
12675 objPtr = argv[2];
12676 if (objPtr->typePtr != NULL)
12677 Jim_InvalidateStringRep(objPtr);
12678 Jim_SetEmptyResult(interp);
12679 return JIM_OK;
12681 else if (option == OPT_SHOW) {
12682 const char *s;
12683 int len, charlen;
12685 if (argc != 3) {
12686 Jim_WrongNumArgs(interp, 2, argv, "object");
12687 return JIM_ERR;
12689 s = Jim_GetString(argv[2], &len);
12690 #ifdef JIM_UTF8
12691 charlen = utf8_strlen(s, len);
12692 #else
12693 charlen = len;
12694 #endif
12695 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12696 printf("chars (%d): <<%s>>\n", charlen, s);
12697 printf("bytes (%d):", len);
12698 while (len--) {
12699 printf(" %02x", (unsigned char)*s++);
12701 printf("\n");
12702 return JIM_OK;
12704 else if (option == OPT_SCRIPTLEN) {
12705 ScriptObj *script;
12707 if (argc != 3) {
12708 Jim_WrongNumArgs(interp, 2, argv, "script");
12709 return JIM_ERR;
12711 script = Jim_GetScript(interp, argv[2]);
12712 Jim_SetResultInt(interp, script->len);
12713 return JIM_OK;
12715 else if (option == OPT_EXPRLEN) {
12716 ExprByteCode *expr;
12718 if (argc != 3) {
12719 Jim_WrongNumArgs(interp, 2, argv, "expression");
12720 return JIM_ERR;
12722 expr = JimGetExpression(interp, argv[2]);
12723 if (expr == NULL)
12724 return JIM_ERR;
12725 Jim_SetResultInt(interp, expr->len);
12726 return JIM_OK;
12728 else if (option == OPT_EXPRBC) {
12729 Jim_Obj *objPtr;
12730 ExprByteCode *expr;
12731 int i;
12733 if (argc != 3) {
12734 Jim_WrongNumArgs(interp, 2, argv, "expression");
12735 return JIM_ERR;
12737 expr = JimGetExpression(interp, argv[2]);
12738 if (expr == NULL)
12739 return JIM_ERR;
12740 objPtr = Jim_NewListObj(interp, NULL, 0);
12741 for (i = 0; i < expr->len; i++) {
12742 const char *type;
12743 const Jim_ExprOperator *op;
12744 Jim_Obj *obj = expr->token[i].objPtr;
12746 switch (expr->token[i].type) {
12747 case JIM_TT_EXPR_INT:
12748 type = "int";
12749 break;
12750 case JIM_TT_EXPR_DOUBLE:
12751 type = "double";
12752 break;
12753 case JIM_TT_CMD:
12754 type = "command";
12755 break;
12756 case JIM_TT_VAR:
12757 type = "variable";
12758 break;
12759 case JIM_TT_DICTSUGAR:
12760 type = "dictsugar";
12761 break;
12762 case JIM_TT_EXPRSUGAR:
12763 type = "exprsugar";
12764 break;
12765 case JIM_TT_ESC:
12766 type = "subst";
12767 break;
12768 case JIM_TT_STR:
12769 type = "string";
12770 break;
12771 default:
12772 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12773 if (op == NULL) {
12774 type = "private";
12776 else {
12777 type = "operator";
12779 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12780 break;
12782 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12783 Jim_ListAppendElement(interp, objPtr, obj);
12785 Jim_SetResult(interp, objPtr);
12786 return JIM_OK;
12788 else {
12789 Jim_SetResultString(interp,
12790 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12791 return JIM_ERR;
12793 /* unreached */
12794 #endif /* JIM_BOOTSTRAP */
12795 #if !defined(JIM_DEBUG_COMMAND)
12796 Jim_SetResultString(interp, "unsupported", -1);
12797 return JIM_ERR;
12798 #endif
12801 /* [eval] */
12802 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12804 int rc;
12806 if (argc < 2) {
12807 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12808 return JIM_ERR;
12811 if (argc == 2) {
12812 rc = Jim_EvalObj(interp, argv[1]);
12814 else {
12815 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12818 if (rc == JIM_ERR) {
12819 /* eval is "interesting", so add a stack frame here */
12820 interp->addStackTrace++;
12822 return rc;
12825 /* [uplevel] */
12826 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12828 if (argc >= 2) {
12829 int retcode;
12830 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12831 Jim_Obj *objPtr;
12832 const char *str;
12834 /* Save the old callframe pointer */
12835 savedCallFrame = interp->framePtr;
12837 /* Lookup the target frame pointer */
12838 str = Jim_String(argv[1]);
12839 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12840 targetCallFrame =Jim_GetCallFrameByLevel(interp, argv[1]);
12841 argc--;
12842 argv++;
12844 else {
12845 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12847 if (targetCallFrame == NULL) {
12848 return JIM_ERR;
12850 if (argc < 2) {
12851 argv--;
12852 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12853 return JIM_ERR;
12855 /* Eval the code in the target callframe. */
12856 interp->framePtr = targetCallFrame;
12857 if (argc == 2) {
12858 retcode = Jim_EvalObj(interp, argv[1]);
12860 else {
12861 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12862 Jim_IncrRefCount(objPtr);
12863 retcode = Jim_EvalObj(interp, objPtr);
12864 Jim_DecrRefCount(interp, objPtr);
12866 interp->framePtr = savedCallFrame;
12867 return retcode;
12869 else {
12870 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12871 return JIM_ERR;
12875 /* [expr] */
12876 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12878 Jim_Obj *exprResultPtr;
12879 int retcode;
12881 if (argc == 2) {
12882 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12884 else if (argc > 2) {
12885 Jim_Obj *objPtr;
12887 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12888 Jim_IncrRefCount(objPtr);
12889 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12890 Jim_DecrRefCount(interp, objPtr);
12892 else {
12893 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12894 return JIM_ERR;
12896 if (retcode != JIM_OK)
12897 return retcode;
12898 Jim_SetResult(interp, exprResultPtr);
12899 Jim_DecrRefCount(interp, exprResultPtr);
12900 return JIM_OK;
12903 /* [break] */
12904 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12906 if (argc != 1) {
12907 Jim_WrongNumArgs(interp, 1, argv, "");
12908 return JIM_ERR;
12910 return JIM_BREAK;
12913 /* [continue] */
12914 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12916 if (argc != 1) {
12917 Jim_WrongNumArgs(interp, 1, argv, "");
12918 return JIM_ERR;
12920 return JIM_CONTINUE;
12923 /* [return] */
12924 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12926 int i;
12927 Jim_Obj *stackTraceObj = NULL;
12928 Jim_Obj *errorCodeObj = NULL;
12929 int returnCode = JIM_OK;
12930 long level = 1;
12932 for (i = 1; i < argc - 1; i += 2) {
12933 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12934 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12935 return JIM_ERR;
12938 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12939 stackTraceObj = argv[i + 1];
12941 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12942 errorCodeObj = argv[i + 1];
12944 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12945 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12946 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12947 return JIM_ERR;
12950 else {
12951 break;
12955 if (i != argc - 1 && i != argc) {
12956 Jim_WrongNumArgs(interp, 1, argv,
12957 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12960 /* If a stack trace is supplied and code is error, set the stack trace */
12961 if (stackTraceObj && returnCode == JIM_ERR) {
12962 JimSetStackTrace(interp, stackTraceObj);
12964 /* If an error code list is supplied, set the global $errorCode */
12965 if (errorCodeObj && returnCode == JIM_ERR) {
12966 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12968 interp->returnCode = returnCode;
12969 interp->returnLevel = level;
12971 if (i == argc - 1) {
12972 Jim_SetResult(interp, argv[i]);
12974 return JIM_RETURN;
12977 /* [tailcall] */
12978 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12980 Jim_SetResult(interp, Jim_NewListObj(interp, argv + 1, argc - 1));
12981 return JIM_EVAL;
12984 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12986 Jim_Obj *cmdList;
12987 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
12989 /* prefixListObj is a list to which the args need to be appended */
12990 cmdList = Jim_DuplicateObj(interp, prefixListObj);
12991 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
12993 return JimEvalObjList(interp, cmdList);
12996 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
12998 Jim_Obj *prefixListObj = privData;
12999 Jim_DecrRefCount(interp, prefixListObj);
13002 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13004 Jim_Obj *prefixListObj;
13005 const char *newname;
13007 if (argc < 3) {
13008 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13009 return JIM_ERR;
13012 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13013 Jim_IncrRefCount(prefixListObj);
13014 newname = Jim_String(argv[1]);
13015 if (newname[0] == ':' && newname[1] == ':') {
13016 while (*++newname == ':') {
13020 Jim_SetResult(interp, argv[1]);
13022 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13025 /* [proc] */
13026 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13028 Jim_Cmd *cmd;
13030 if (argc != 4 && argc != 5) {
13031 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13032 return JIM_ERR;
13035 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13036 return JIM_ERR;
13039 if (argc == 4) {
13040 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13042 else {
13043 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13046 if (cmd) {
13047 /* Add the new command */
13048 Jim_Obj *qualifiedCmdNameObj;
13049 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13051 JimCreateCommand(interp, cmdname, cmd);
13053 /* Calculate and set the namespace for this proc */
13054 JimUpdateProcNamespace(interp, cmd, cmdname);
13056 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13058 /* Unlike Tcl, set the name of the proc as the result */
13059 Jim_SetResult(interp, argv[1]);
13060 return JIM_OK;
13062 return JIM_ERR;
13065 /* [local] */
13066 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13068 int retcode;
13070 /* Evaluate the arguments with 'local' in force */
13071 interp->local++;
13072 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13073 interp->local--;
13076 /* If OK, and the result is a proc, add it to the list of local procs */
13077 if (retcode == 0) {
13078 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13080 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13081 return JIM_ERR;
13083 if (interp->framePtr->localCommands == NULL) {
13084 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13085 Jim_InitStack(interp->framePtr->localCommands);
13087 Jim_IncrRefCount(cmdNameObj);
13088 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13091 return retcode;
13094 /* [upcall] */
13095 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13097 if (argc < 2) {
13098 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13099 return JIM_ERR;
13101 else {
13102 int retcode;
13104 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13105 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13106 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13107 return JIM_ERR;
13109 /* OK. Mark this command as being in an upcall */
13110 cmdPtr->u.proc.upcall++;
13111 JimIncrCmdRefCount(cmdPtr);
13113 /* Invoke the command as normal */
13114 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13116 /* No longer in an upcall */
13117 cmdPtr->u.proc.upcall--;
13118 JimDecrCmdRefCount(interp, cmdPtr);
13120 return retcode;
13124 /* [apply] */
13125 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13127 if (argc < 2) {
13128 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13129 return JIM_ERR;
13131 else {
13132 int ret;
13133 Jim_Cmd *cmd;
13134 Jim_Obj *argListObjPtr;
13135 Jim_Obj *bodyObjPtr;
13136 Jim_Obj *nsObj = NULL;
13137 Jim_Obj **nargv;
13139 int len = Jim_ListLength(interp, argv[1]);
13140 if (len != 2 && len != 3) {
13141 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13142 return JIM_ERR;
13145 if (len == 3) {
13146 #ifdef jim_ext_namespace
13147 /* Need to canonicalise the given namespace. */
13148 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13149 #else
13150 Jim_SetResultString(interp, "namespaces not enabled", -1);
13151 return JIM_ERR;
13152 #endif
13154 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13155 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13157 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13159 if (cmd) {
13160 /* Create a new argv array with a dummy argv[0], for error messages */
13161 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13162 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13163 Jim_IncrRefCount(nargv[0]);
13164 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13165 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13166 Jim_DecrRefCount(interp, nargv[0]);
13167 Jim_Free(nargv);
13169 JimDecrCmdRefCount(interp, cmd);
13170 return ret;
13172 return JIM_ERR;
13177 /* [concat] */
13178 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13180 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13181 return JIM_OK;
13184 /* [upvar] */
13185 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13187 int i;
13188 Jim_CallFrame *targetCallFrame;
13190 /* Lookup the target frame pointer */
13191 if (argc > 3 && (argc % 2 == 0)) {
13192 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13193 argc--;
13194 argv++;
13196 else {
13197 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13199 if (targetCallFrame == NULL) {
13200 return JIM_ERR;
13203 /* Check for arity */
13204 if (argc < 3) {
13205 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13206 return JIM_ERR;
13209 /* Now... for every other/local couple: */
13210 for (i = 1; i < argc; i += 2) {
13211 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13212 return JIM_ERR;
13214 return JIM_OK;
13217 /* [global] */
13218 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13220 int i;
13222 if (argc < 2) {
13223 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13224 return JIM_ERR;
13226 /* Link every var to the toplevel having the same name */
13227 if (interp->framePtr->level == 0)
13228 return JIM_OK; /* global at toplevel... */
13229 for (i = 1; i < argc; i++) {
13230 /* global ::blah does nothing */
13231 const char *name = Jim_String(argv[i]);
13232 if (name[0] != ':' || name[1] != ':') {
13233 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13234 return JIM_ERR;
13237 return JIM_OK;
13240 /* does the [string map] operation. On error NULL is returned,
13241 * otherwise a new string object with the result, having refcount = 0,
13242 * is returned. */
13243 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13244 Jim_Obj *objPtr, int nocase)
13246 int numMaps;
13247 const char *str, *noMatchStart = NULL;
13248 int strLen, i;
13249 Jim_Obj *resultObjPtr;
13251 numMaps = Jim_ListLength(interp, mapListObjPtr);
13252 if (numMaps % 2) {
13253 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13254 return NULL;
13257 str = Jim_String(objPtr);
13258 strLen = Jim_Utf8Length(interp, objPtr);
13260 /* Map it */
13261 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13262 while (strLen) {
13263 for (i = 0; i < numMaps; i += 2) {
13264 Jim_Obj *objPtr;
13265 const char *k;
13266 int kl;
13268 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13269 k = Jim_String(objPtr);
13270 kl = Jim_Utf8Length(interp, objPtr);
13272 if (strLen >= kl && kl) {
13273 int rc;
13274 rc = JimStringCompareLen(str, k, kl, nocase);
13275 if (rc == 0) {
13276 if (noMatchStart) {
13277 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13278 noMatchStart = NULL;
13280 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13281 Jim_AppendObj(interp, resultObjPtr, objPtr);
13282 str += utf8_index(str, kl);
13283 strLen -= kl;
13284 break;
13288 if (i == numMaps) { /* no match */
13289 int c;
13290 if (noMatchStart == NULL)
13291 noMatchStart = str;
13292 str += utf8_tounicode(str, &c);
13293 strLen--;
13296 if (noMatchStart) {
13297 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13299 return resultObjPtr;
13302 /* [string] */
13303 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13305 int len;
13306 int opt_case = 1;
13307 int option;
13308 static const char * const options[] = {
13309 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13310 "map", "repeat", "reverse", "index", "first", "last",
13311 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13313 enum
13315 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13316 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13317 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13319 static const char * const nocase_options[] = {
13320 "-nocase", NULL
13322 static const char * const nocase_length_options[] = {
13323 "-nocase", "-length", NULL
13326 if (argc < 2) {
13327 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13328 return JIM_ERR;
13330 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13331 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13332 return JIM_ERR;
13334 switch (option) {
13335 case OPT_LENGTH:
13336 case OPT_BYTELENGTH:
13337 if (argc != 3) {
13338 Jim_WrongNumArgs(interp, 2, argv, "string");
13339 return JIM_ERR;
13341 if (option == OPT_LENGTH) {
13342 len = Jim_Utf8Length(interp, argv[2]);
13344 else {
13345 len = Jim_Length(argv[2]);
13347 Jim_SetResultInt(interp, len);
13348 return JIM_OK;
13350 case OPT_COMPARE:
13351 case OPT_EQUAL:
13353 /* n is the number of remaining option args */
13354 long opt_length = -1;
13355 int n = argc - 4;
13356 int i = 2;
13357 while (n > 0) {
13358 int subopt;
13359 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13360 JIM_ENUM_ABBREV) != JIM_OK) {
13361 badcompareargs:
13362 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13363 return JIM_ERR;
13365 if (subopt == 0) {
13366 /* -nocase */
13367 opt_case = 0;
13368 n--;
13370 else {
13371 /* -length */
13372 if (n < 2) {
13373 goto badcompareargs;
13375 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13376 return JIM_ERR;
13378 n -= 2;
13381 if (n) {
13382 goto badcompareargs;
13384 argv += argc - 2;
13385 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13386 /* Fast version - [string equal], case sensitive, no length */
13387 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13389 else {
13390 if (opt_length >= 0) {
13391 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13393 else {
13394 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13396 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13398 return JIM_OK;
13401 case OPT_MATCH:
13402 if (argc != 4 &&
13403 (argc != 5 ||
13404 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13405 JIM_ENUM_ABBREV) != JIM_OK)) {
13406 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13407 return JIM_ERR;
13409 if (opt_case == 0) {
13410 argv++;
13412 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13413 return JIM_OK;
13415 case OPT_MAP:{
13416 Jim_Obj *objPtr;
13418 if (argc != 4 &&
13419 (argc != 5 ||
13420 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13421 JIM_ENUM_ABBREV) != JIM_OK)) {
13422 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13423 return JIM_ERR;
13426 if (opt_case == 0) {
13427 argv++;
13429 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13430 if (objPtr == NULL) {
13431 return JIM_ERR;
13433 Jim_SetResult(interp, objPtr);
13434 return JIM_OK;
13437 case OPT_RANGE:
13438 case OPT_BYTERANGE:{
13439 Jim_Obj *objPtr;
13441 if (argc != 5) {
13442 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13443 return JIM_ERR;
13445 if (option == OPT_RANGE) {
13446 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13448 else
13450 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13453 if (objPtr == NULL) {
13454 return JIM_ERR;
13456 Jim_SetResult(interp, objPtr);
13457 return JIM_OK;
13460 case OPT_REPLACE:{
13461 Jim_Obj *objPtr;
13463 if (argc != 5 && argc != 6) {
13464 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13465 return JIM_ERR;
13467 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13468 if (objPtr == NULL) {
13469 return JIM_ERR;
13471 Jim_SetResult(interp, objPtr);
13472 return JIM_OK;
13476 case OPT_REPEAT:{
13477 Jim_Obj *objPtr;
13478 jim_wide count;
13480 if (argc != 4) {
13481 Jim_WrongNumArgs(interp, 2, argv, "string count");
13482 return JIM_ERR;
13484 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13485 return JIM_ERR;
13487 objPtr = Jim_NewStringObj(interp, "", 0);
13488 if (count > 0) {
13489 while (count--) {
13490 Jim_AppendObj(interp, objPtr, argv[2]);
13493 Jim_SetResult(interp, objPtr);
13494 return JIM_OK;
13497 case OPT_REVERSE:{
13498 char *buf, *p;
13499 const char *str;
13500 int len;
13501 int i;
13503 if (argc != 3) {
13504 Jim_WrongNumArgs(interp, 2, argv, "string");
13505 return JIM_ERR;
13508 str = Jim_GetString(argv[2], &len);
13509 buf = Jim_Alloc(len + 1);
13510 p = buf + len;
13511 *p = 0;
13512 for (i = 0; i < len; ) {
13513 int c;
13514 int l = utf8_tounicode(str, &c);
13515 memcpy(p - l, str, l);
13516 p -= l;
13517 i += l;
13518 str += l;
13520 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13521 return JIM_OK;
13524 case OPT_INDEX:{
13525 int idx;
13526 const char *str;
13528 if (argc != 4) {
13529 Jim_WrongNumArgs(interp, 2, argv, "string index");
13530 return JIM_ERR;
13532 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13533 return JIM_ERR;
13535 str = Jim_String(argv[2]);
13536 len = Jim_Utf8Length(interp, argv[2]);
13537 if (idx != INT_MIN && idx != INT_MAX) {
13538 idx = JimRelToAbsIndex(len, idx);
13540 if (idx < 0 || idx >= len || str == NULL) {
13541 Jim_SetResultString(interp, "", 0);
13543 else if (len == Jim_Length(argv[2])) {
13544 /* ASCII optimisation */
13545 Jim_SetResultString(interp, str + idx, 1);
13547 else {
13548 int c;
13549 int i = utf8_index(str, idx);
13550 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13552 return JIM_OK;
13555 case OPT_FIRST:
13556 case OPT_LAST:{
13557 int idx = 0, l1, l2;
13558 const char *s1, *s2;
13560 if (argc != 4 && argc != 5) {
13561 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13562 return JIM_ERR;
13564 s1 = Jim_String(argv[2]);
13565 s2 = Jim_String(argv[3]);
13566 l1 = Jim_Utf8Length(interp, argv[2]);
13567 l2 = Jim_Utf8Length(interp, argv[3]);
13568 if (argc == 5) {
13569 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13570 return JIM_ERR;
13572 idx = JimRelToAbsIndex(l2, idx);
13574 else if (option == OPT_LAST) {
13575 idx = l2;
13577 if (option == OPT_FIRST) {
13578 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13580 else {
13581 #ifdef JIM_UTF8
13582 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13583 #else
13584 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13585 #endif
13587 return JIM_OK;
13590 case OPT_TRIM:
13591 case OPT_TRIMLEFT:
13592 case OPT_TRIMRIGHT:{
13593 Jim_Obj *trimchars;
13595 if (argc != 3 && argc != 4) {
13596 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13597 return JIM_ERR;
13599 trimchars = (argc == 4 ? argv[3] : NULL);
13600 if (option == OPT_TRIM) {
13601 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13603 else if (option == OPT_TRIMLEFT) {
13604 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13606 else if (option == OPT_TRIMRIGHT) {
13607 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13609 return JIM_OK;
13612 case OPT_TOLOWER:
13613 case OPT_TOUPPER:
13614 case OPT_TOTITLE:
13615 if (argc != 3) {
13616 Jim_WrongNumArgs(interp, 2, argv, "string");
13617 return JIM_ERR;
13619 if (option == OPT_TOLOWER) {
13620 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13622 else if (option == OPT_TOUPPER) {
13623 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13625 else {
13626 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13628 return JIM_OK;
13630 case OPT_IS:
13631 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13632 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13634 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13635 return JIM_ERR;
13637 return JIM_OK;
13640 /* [time] */
13641 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13643 long i, count = 1;
13644 jim_wide start, elapsed;
13645 char buf[60];
13646 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13648 if (argc < 2) {
13649 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13650 return JIM_ERR;
13652 if (argc == 3) {
13653 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13654 return JIM_ERR;
13656 if (count < 0)
13657 return JIM_OK;
13658 i = count;
13659 start = JimClock();
13660 while (i-- > 0) {
13661 int retval;
13663 retval = Jim_EvalObj(interp, argv[1]);
13664 if (retval != JIM_OK) {
13665 return retval;
13668 elapsed = JimClock() - start;
13669 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13670 Jim_SetResultString(interp, buf, -1);
13671 return JIM_OK;
13674 /* [exit] */
13675 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13677 long exitCode = 0;
13679 if (argc > 2) {
13680 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13681 return JIM_ERR;
13683 if (argc == 2) {
13684 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13685 return JIM_ERR;
13687 interp->exitCode = exitCode;
13688 return JIM_EXIT;
13691 /* [catch] */
13692 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13694 int exitCode = 0;
13695 int i;
13696 int sig = 0;
13698 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13699 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13700 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13702 /* Reset the error code before catch.
13703 * Note that this is not strictly correct.
13705 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13707 for (i = 1; i < argc - 1; i++) {
13708 const char *arg = Jim_String(argv[i]);
13709 jim_wide option;
13710 int ignore;
13712 /* It's a pity we can't use Jim_GetEnum here :-( */
13713 if (strcmp(arg, "--") == 0) {
13714 i++;
13715 break;
13717 if (*arg != '-') {
13718 break;
13721 if (strncmp(arg, "-no", 3) == 0) {
13722 arg += 3;
13723 ignore = 1;
13725 else {
13726 arg++;
13727 ignore = 0;
13730 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13731 option = -1;
13733 if (option < 0) {
13734 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13736 if (option < 0) {
13737 goto wrongargs;
13740 if (ignore) {
13741 ignore_mask |= (1 << option);
13743 else {
13744 ignore_mask &= ~(1 << option);
13748 argc -= i;
13749 if (argc < 1 || argc > 3) {
13750 wrongargs:
13751 Jim_WrongNumArgs(interp, 1, argv,
13752 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13753 return JIM_ERR;
13755 argv += i;
13757 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13758 sig++;
13761 interp->signal_level += sig;
13762 if (Jim_CheckSignal(interp)) {
13763 /* If a signal is set, don't even try to execute the body */
13764 exitCode = JIM_SIGNAL;
13766 else {
13767 exitCode = Jim_EvalObj(interp, argv[0]);
13769 interp->signal_level -= sig;
13771 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13772 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13773 /* Not caught, pass it up */
13774 return exitCode;
13777 if (sig && exitCode == JIM_SIGNAL) {
13778 /* Catch the signal at this level */
13779 if (interp->signal_set_result) {
13780 interp->signal_set_result(interp, interp->sigmask);
13782 else {
13783 Jim_SetResultInt(interp, interp->sigmask);
13785 interp->sigmask = 0;
13788 if (argc >= 2) {
13789 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13790 return JIM_ERR;
13792 if (argc == 3) {
13793 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13795 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13796 Jim_ListAppendElement(interp, optListObj,
13797 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13798 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13799 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13800 if (exitCode == JIM_ERR) {
13801 Jim_Obj *errorCode;
13802 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13803 -1));
13804 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13806 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13807 if (errorCode) {
13808 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13809 Jim_ListAppendElement(interp, optListObj, errorCode);
13812 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13813 return JIM_ERR;
13817 Jim_SetResultInt(interp, exitCode);
13818 return JIM_OK;
13821 #ifdef JIM_REFERENCES
13823 /* [ref] */
13824 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13826 if (argc != 3 && argc != 4) {
13827 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13828 return JIM_ERR;
13830 if (argc == 3) {
13831 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13833 else {
13834 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13836 return JIM_OK;
13839 /* [getref] */
13840 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13842 Jim_Reference *refPtr;
13844 if (argc != 2) {
13845 Jim_WrongNumArgs(interp, 1, argv, "reference");
13846 return JIM_ERR;
13848 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13849 return JIM_ERR;
13850 Jim_SetResult(interp, refPtr->objPtr);
13851 return JIM_OK;
13854 /* [setref] */
13855 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13857 Jim_Reference *refPtr;
13859 if (argc != 3) {
13860 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13861 return JIM_ERR;
13863 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13864 return JIM_ERR;
13865 Jim_IncrRefCount(argv[2]);
13866 Jim_DecrRefCount(interp, refPtr->objPtr);
13867 refPtr->objPtr = argv[2];
13868 Jim_SetResult(interp, argv[2]);
13869 return JIM_OK;
13872 /* [collect] */
13873 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13875 if (argc != 1) {
13876 Jim_WrongNumArgs(interp, 1, argv, "");
13877 return JIM_ERR;
13879 Jim_SetResultInt(interp, Jim_Collect(interp));
13881 /* Free all the freed objects. */
13882 while (interp->freeList) {
13883 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13884 Jim_Free(interp->freeList);
13885 interp->freeList = nextObjPtr;
13888 return JIM_OK;
13891 /* [finalize] reference ?newValue? */
13892 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13894 if (argc != 2 && argc != 3) {
13895 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13896 return JIM_ERR;
13898 if (argc == 2) {
13899 Jim_Obj *cmdNamePtr;
13901 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13902 return JIM_ERR;
13903 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13904 Jim_SetResult(interp, cmdNamePtr);
13906 else {
13907 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13908 return JIM_ERR;
13909 Jim_SetResult(interp, argv[2]);
13911 return JIM_OK;
13914 /* [info references] */
13915 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13917 Jim_Obj *listObjPtr;
13918 Jim_HashTableIterator htiter;
13919 Jim_HashEntry *he;
13921 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13923 JimInitHashTableIterator(&interp->references, &htiter);
13924 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13925 char buf[JIM_REFERENCE_SPACE + 1];
13926 Jim_Reference *refPtr = he->u.val;
13927 const unsigned long *refId = he->key;
13929 JimFormatReference(buf, refPtr, *refId);
13930 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
13932 Jim_SetResult(interp, listObjPtr);
13933 return JIM_OK;
13935 #endif
13937 /* [rename] */
13938 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13940 if (argc != 3) {
13941 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
13942 return JIM_ERR;
13945 if (JimValidName(interp, "new procedure", argv[2])) {
13946 return JIM_ERR;
13949 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
13952 #define JIM_DICTMATCH_VALUES 0x0001
13954 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
13956 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
13958 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
13959 if (type & JIM_DICTMATCH_VALUES) {
13960 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
13965 * Like JimHashtablePatternMatch, but for dictionaries.
13967 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
13968 JimDictMatchCallbackType *callback, int type)
13970 Jim_HashEntry *he;
13971 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13973 /* Check for the non-pattern case. We can do this much more efficiently. */
13974 Jim_HashTableIterator htiter;
13975 JimInitHashTableIterator(ht, &htiter);
13976 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13977 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
13978 callback(interp, listObjPtr, he, type);
13982 return listObjPtr;
13986 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
13988 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13989 return JIM_ERR;
13991 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
13992 return JIM_OK;
13995 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
13997 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13998 return JIM_ERR;
14000 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14001 return JIM_OK;
14004 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14006 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14007 return -1;
14009 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14012 /* [dict] */
14013 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14015 Jim_Obj *objPtr;
14016 int option;
14017 static const char * const options[] = {
14018 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
14020 enum
14022 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST, OPT_KEYS, OPT_MERGE, OPT_SIZE, OPT_WITH,
14025 if (argc < 2) {
14026 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14027 return JIM_ERR;
14030 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14031 return JIM_ERR;
14034 switch (option) {
14035 case OPT_GET:
14036 if (argc < 3) {
14037 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
14038 return JIM_ERR;
14040 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14041 JIM_ERRMSG) != JIM_OK) {
14042 return JIM_ERR;
14044 Jim_SetResult(interp, objPtr);
14045 return JIM_OK;
14047 case OPT_SET:
14048 if (argc < 5) {
14049 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14050 return JIM_ERR;
14052 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14054 case OPT_EXIST:
14055 if (argc < 3) {
14056 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
14057 return JIM_ERR;
14059 Jim_SetResultBool(interp, Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3,
14060 &objPtr, JIM_ERRMSG) == JIM_OK);
14061 return JIM_OK;
14063 case OPT_UNSET:
14064 if (argc < 4) {
14065 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14066 return JIM_ERR;
14068 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE);
14070 case OPT_KEYS:
14071 if (argc != 3 && argc != 4) {
14072 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?pattern?");
14073 return JIM_ERR;
14075 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14077 case OPT_SIZE: {
14078 int size;
14080 if (argc != 3) {
14081 Jim_WrongNumArgs(interp, 2, argv, "dictVar");
14082 return JIM_ERR;
14085 size = Jim_DictSize(interp, argv[2]);
14086 if (size < 0) {
14087 return JIM_ERR;
14089 Jim_SetResultInt(interp, size);
14090 return JIM_OK;
14093 case OPT_MERGE:
14094 if (argc == 2) {
14095 return JIM_OK;
14097 else if (SetDictFromAny(interp, argv[2]) != JIM_OK) {
14098 return JIM_ERR;
14100 else {
14101 return Jim_EvalPrefix(interp, "dict merge", argc - 2, argv + 2);
14104 case OPT_WITH:
14105 if (argc < 4) {
14106 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14107 return JIM_ERR;
14109 else if (Jim_GetVariable(interp, argv[2], JIM_ERRMSG) == NULL) {
14110 return JIM_ERR;
14112 else {
14113 return Jim_EvalPrefix(interp, "dict with", argc - 2, argv + 2);
14116 case OPT_CREATE:
14117 if (argc % 2) {
14118 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14119 return JIM_ERR;
14121 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14122 Jim_SetResult(interp, objPtr);
14123 return JIM_OK;
14125 return JIM_ERR;
14128 /* [subst] */
14129 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14131 static const char * const options[] = {
14132 "-nobackslashes", "-nocommands", "-novariables", NULL
14134 enum
14135 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14136 int i;
14137 int flags = JIM_SUBST_FLAG;
14138 Jim_Obj *objPtr;
14140 if (argc < 2) {
14141 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14142 return JIM_ERR;
14144 for (i = 1; i < (argc - 1); i++) {
14145 int option;
14147 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14148 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14149 return JIM_ERR;
14151 switch (option) {
14152 case OPT_NOBACKSLASHES:
14153 flags |= JIM_SUBST_NOESC;
14154 break;
14155 case OPT_NOCOMMANDS:
14156 flags |= JIM_SUBST_NOCMD;
14157 break;
14158 case OPT_NOVARIABLES:
14159 flags |= JIM_SUBST_NOVAR;
14160 break;
14163 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14164 return JIM_ERR;
14166 Jim_SetResult(interp, objPtr);
14167 return JIM_OK;
14170 /* [info] */
14171 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14173 int cmd;
14174 Jim_Obj *objPtr;
14175 int mode = 0;
14177 static const char * const commands[] = {
14178 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14179 "vars", "version", "patchlevel", "complete", "args", "hostname",
14180 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14181 "references", "alias", NULL
14183 enum
14184 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14185 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14186 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14187 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS
14190 #ifdef jim_ext_namespace
14191 int nons = 0;
14193 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14194 /* This is for internal use only */
14195 argc--;
14196 argv++;
14197 nons = 1;
14199 #endif
14201 if (argc < 2) {
14202 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14203 return JIM_ERR;
14205 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14206 != JIM_OK) {
14207 return JIM_ERR;
14210 /* Test for the the most common commands first, just in case it makes a difference */
14211 switch (cmd) {
14212 case INFO_EXISTS:
14213 if (argc != 3) {
14214 Jim_WrongNumArgs(interp, 2, argv, "varName");
14215 return JIM_ERR;
14217 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14218 break;
14220 case INFO_ALIAS:{
14221 Jim_Cmd *cmdPtr;
14223 if (argc != 3) {
14224 Jim_WrongNumArgs(interp, 2, argv, "command");
14225 return JIM_ERR;
14227 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14228 return JIM_ERR;
14230 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14231 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14232 return JIM_ERR;
14234 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14235 return JIM_OK;
14238 case INFO_CHANNELS:
14239 mode++; /* JIM_CMDLIST_CHANNELS */
14240 #ifndef jim_ext_aio
14241 Jim_SetResultString(interp, "aio not enabled", -1);
14242 return JIM_ERR;
14243 #endif
14244 case INFO_PROCS:
14245 mode++; /* JIM_CMDLIST_PROCS */
14246 case INFO_COMMANDS:
14247 /* mode 0 => JIM_CMDLIST_COMMANDS */
14248 if (argc != 2 && argc != 3) {
14249 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14250 return JIM_ERR;
14252 #ifdef jim_ext_namespace
14253 if (!nons) {
14254 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14255 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14258 #endif
14259 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14260 break;
14262 case INFO_VARS:
14263 mode++; /* JIM_VARLIST_VARS */
14264 case INFO_LOCALS:
14265 mode++; /* JIM_VARLIST_LOCALS */
14266 case INFO_GLOBALS:
14267 /* mode 0 => JIM_VARLIST_GLOBALS */
14268 if (argc != 2 && argc != 3) {
14269 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14270 return JIM_ERR;
14272 #ifdef jim_ext_namespace
14273 if (!nons) {
14274 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14275 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14278 #endif
14279 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14280 break;
14282 case INFO_SCRIPT:
14283 if (argc != 2) {
14284 Jim_WrongNumArgs(interp, 2, argv, "");
14285 return JIM_ERR;
14287 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14288 break;
14290 case INFO_SOURCE:{
14291 int line;
14292 Jim_Obj *resObjPtr;
14293 Jim_Obj *fileNameObj;
14295 if (argc != 3) {
14296 Jim_WrongNumArgs(interp, 2, argv, "source");
14297 return JIM_ERR;
14299 if (argv[2]->typePtr == &sourceObjType) {
14300 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14301 line = argv[2]->internalRep.sourceValue.lineNumber;
14303 else if (argv[2]->typePtr == &scriptObjType) {
14304 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14305 fileNameObj = script->fileNameObj;
14306 line = script->firstline;
14308 else {
14309 fileNameObj = interp->emptyObj;
14310 line = 1;
14312 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14313 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14314 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14315 Jim_SetResult(interp, resObjPtr);
14316 break;
14319 case INFO_STACKTRACE:
14320 Jim_SetResult(interp, interp->stackTrace);
14321 break;
14323 case INFO_LEVEL:
14324 case INFO_FRAME:
14325 switch (argc) {
14326 case 2:
14327 Jim_SetResultInt(interp, interp->framePtr->level);
14328 break;
14330 case 3:
14331 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14332 return JIM_ERR;
14334 Jim_SetResult(interp, objPtr);
14335 break;
14337 default:
14338 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14339 return JIM_ERR;
14341 break;
14343 case INFO_BODY:
14344 case INFO_STATICS:
14345 case INFO_ARGS:{
14346 Jim_Cmd *cmdPtr;
14348 if (argc != 3) {
14349 Jim_WrongNumArgs(interp, 2, argv, "procname");
14350 return JIM_ERR;
14352 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14353 return JIM_ERR;
14355 if (!cmdPtr->isproc) {
14356 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14357 return JIM_ERR;
14359 switch (cmd) {
14360 case INFO_BODY:
14361 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14362 break;
14363 case INFO_ARGS:
14364 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14365 break;
14366 case INFO_STATICS:
14367 if (cmdPtr->u.proc.staticVars) {
14368 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14369 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14370 NULL, JimVariablesMatch, mode));
14372 break;
14374 break;
14377 case INFO_VERSION:
14378 case INFO_PATCHLEVEL:{
14379 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14381 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14382 Jim_SetResultString(interp, buf, -1);
14383 break;
14386 case INFO_COMPLETE:
14387 if (argc != 3 && argc != 4) {
14388 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14389 return JIM_ERR;
14391 else {
14392 int len;
14393 const char *s = Jim_GetString(argv[2], &len);
14394 char missing;
14396 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14397 if (missing != ' ' && argc == 4) {
14398 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14401 break;
14403 case INFO_HOSTNAME:
14404 /* Redirect to os.gethostname if it exists */
14405 return Jim_Eval(interp, "os.gethostname");
14407 case INFO_NAMEOFEXECUTABLE:
14408 /* Redirect to Tcl proc */
14409 return Jim_Eval(interp, "{info nameofexecutable}");
14411 case INFO_RETURNCODES:
14412 if (argc == 2) {
14413 int i;
14414 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14416 for (i = 0; jimReturnCodes[i]; i++) {
14417 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14418 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14419 jimReturnCodes[i], -1));
14422 Jim_SetResult(interp, listObjPtr);
14424 else if (argc == 3) {
14425 long code;
14426 const char *name;
14428 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14429 return JIM_ERR;
14431 name = Jim_ReturnCode(code);
14432 if (*name == '?') {
14433 Jim_SetResultInt(interp, code);
14435 else {
14436 Jim_SetResultString(interp, name, -1);
14439 else {
14440 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14441 return JIM_ERR;
14443 break;
14444 case INFO_REFERENCES:
14445 #ifdef JIM_REFERENCES
14446 return JimInfoReferences(interp, argc, argv);
14447 #else
14448 Jim_SetResultString(interp, "not supported", -1);
14449 return JIM_ERR;
14450 #endif
14452 return JIM_OK;
14455 /* [exists] */
14456 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14458 Jim_Obj *objPtr;
14459 int result = 0;
14461 static const char * const options[] = {
14462 "-command", "-proc", "-alias", "-var", NULL
14464 enum
14466 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14468 int option;
14470 if (argc == 2) {
14471 option = OPT_VAR;
14472 objPtr = argv[1];
14474 else if (argc == 3) {
14475 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14476 return JIM_ERR;
14478 objPtr = argv[2];
14480 else {
14481 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14482 return JIM_ERR;
14485 if (option == OPT_VAR) {
14486 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14488 else {
14489 /* Now different kinds of commands */
14490 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14492 if (cmd) {
14493 switch (option) {
14494 case OPT_COMMAND:
14495 result = 1;
14496 break;
14498 case OPT_ALIAS:
14499 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14500 break;
14502 case OPT_PROC:
14503 result = cmd->isproc;
14504 break;
14508 Jim_SetResultBool(interp, result);
14509 return JIM_OK;
14512 /* [split] */
14513 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14515 const char *str, *splitChars, *noMatchStart;
14516 int splitLen, strLen;
14517 Jim_Obj *resObjPtr;
14518 int c;
14519 int len;
14521 if (argc != 2 && argc != 3) {
14522 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14523 return JIM_ERR;
14526 str = Jim_GetString(argv[1], &len);
14527 if (len == 0) {
14528 return JIM_OK;
14530 strLen = Jim_Utf8Length(interp, argv[1]);
14532 /* Init */
14533 if (argc == 2) {
14534 splitChars = " \n\t\r";
14535 splitLen = 4;
14537 else {
14538 splitChars = Jim_String(argv[2]);
14539 splitLen = Jim_Utf8Length(interp, argv[2]);
14542 noMatchStart = str;
14543 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14545 /* Split */
14546 if (splitLen) {
14547 Jim_Obj *objPtr;
14548 while (strLen--) {
14549 const char *sc = splitChars;
14550 int scLen = splitLen;
14551 int sl = utf8_tounicode(str, &c);
14552 while (scLen--) {
14553 int pc;
14554 sc += utf8_tounicode(sc, &pc);
14555 if (c == pc) {
14556 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14557 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14558 noMatchStart = str + sl;
14559 break;
14562 str += sl;
14564 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14565 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14567 else {
14568 /* This handles the special case of splitchars eq {}
14569 * Optimise by sharing common (ASCII) characters
14571 Jim_Obj **commonObj = NULL;
14572 #define NUM_COMMON (128 - 9)
14573 while (strLen--) {
14574 int n = utf8_tounicode(str, &c);
14575 #ifdef JIM_OPTIMIZATION
14576 if (c >= 9 && c < 128) {
14577 /* Common ASCII char. Note that 9 is the tab character */
14578 c -= 9;
14579 if (!commonObj) {
14580 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14581 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14583 if (!commonObj[c]) {
14584 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14586 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14587 str++;
14588 continue;
14590 #endif
14591 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14592 str += n;
14594 Jim_Free(commonObj);
14597 Jim_SetResult(interp, resObjPtr);
14598 return JIM_OK;
14601 /* [join] */
14602 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14604 const char *joinStr;
14605 int joinStrLen;
14607 if (argc != 2 && argc != 3) {
14608 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14609 return JIM_ERR;
14611 /* Init */
14612 if (argc == 2) {
14613 joinStr = " ";
14614 joinStrLen = 1;
14616 else {
14617 joinStr = Jim_GetString(argv[2], &joinStrLen);
14619 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14620 return JIM_OK;
14623 /* [format] */
14624 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14626 Jim_Obj *objPtr;
14628 if (argc < 2) {
14629 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14630 return JIM_ERR;
14632 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14633 if (objPtr == NULL)
14634 return JIM_ERR;
14635 Jim_SetResult(interp, objPtr);
14636 return JIM_OK;
14639 /* [scan] */
14640 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14642 Jim_Obj *listPtr, **outVec;
14643 int outc, i;
14645 if (argc < 3) {
14646 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14647 return JIM_ERR;
14649 if (argv[2]->typePtr != &scanFmtStringObjType)
14650 SetScanFmtFromAny(interp, argv[2]);
14651 if (FormatGetError(argv[2]) != 0) {
14652 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14653 return JIM_ERR;
14655 if (argc > 3) {
14656 int maxPos = FormatGetMaxPos(argv[2]);
14657 int count = FormatGetCnvCount(argv[2]);
14659 if (maxPos > argc - 3) {
14660 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14661 return JIM_ERR;
14663 else if (count > argc - 3) {
14664 Jim_SetResultString(interp, "different numbers of variable names and "
14665 "field specifiers", -1);
14666 return JIM_ERR;
14668 else if (count < argc - 3) {
14669 Jim_SetResultString(interp, "variable is not assigned by any "
14670 "conversion specifiers", -1);
14671 return JIM_ERR;
14674 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14675 if (listPtr == 0)
14676 return JIM_ERR;
14677 if (argc > 3) {
14678 int rc = JIM_OK;
14679 int count = 0;
14681 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14682 int len = Jim_ListLength(interp, listPtr);
14684 if (len != 0) {
14685 JimListGetElements(interp, listPtr, &outc, &outVec);
14686 for (i = 0; i < outc; ++i) {
14687 if (Jim_Length(outVec[i]) > 0) {
14688 ++count;
14689 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14690 rc = JIM_ERR;
14695 Jim_FreeNewObj(interp, listPtr);
14697 else {
14698 count = -1;
14700 if (rc == JIM_OK) {
14701 Jim_SetResultInt(interp, count);
14703 return rc;
14705 else {
14706 if (listPtr == (Jim_Obj *)EOF) {
14707 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14708 return JIM_OK;
14710 Jim_SetResult(interp, listPtr);
14712 return JIM_OK;
14715 /* [error] */
14716 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14718 if (argc != 2 && argc != 3) {
14719 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14720 return JIM_ERR;
14722 Jim_SetResult(interp, argv[1]);
14723 if (argc == 3) {
14724 JimSetStackTrace(interp, argv[2]);
14725 return JIM_ERR;
14727 interp->addStackTrace++;
14728 return JIM_ERR;
14731 /* [lrange] */
14732 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14734 Jim_Obj *objPtr;
14736 if (argc != 4) {
14737 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14738 return JIM_ERR;
14740 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14741 return JIM_ERR;
14742 Jim_SetResult(interp, objPtr);
14743 return JIM_OK;
14746 /* [lrepeat] */
14747 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14749 Jim_Obj *objPtr;
14750 long count;
14752 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14753 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14754 return JIM_ERR;
14757 if (count == 0 || argc == 2) {
14758 return JIM_OK;
14761 argc -= 2;
14762 argv += 2;
14764 objPtr = Jim_NewListObj(interp, argv, argc);
14765 while (--count) {
14766 ListInsertElements(objPtr, -1, argc, argv);
14769 Jim_SetResult(interp, objPtr);
14770 return JIM_OK;
14773 char **Jim_GetEnviron(void)
14775 #if defined(HAVE__NSGETENVIRON)
14776 return *_NSGetEnviron();
14777 #else
14778 #if !defined(NO_ENVIRON_EXTERN)
14779 extern char **environ;
14780 #endif
14782 return environ;
14783 #endif
14786 void Jim_SetEnviron(char **env)
14788 #if defined(HAVE__NSGETENVIRON)
14789 *_NSGetEnviron() = env;
14790 #else
14791 #if !defined(NO_ENVIRON_EXTERN)
14792 extern char **environ;
14793 #endif
14795 environ = env;
14796 #endif
14799 /* [env] */
14800 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14802 const char *key;
14803 const char *val;
14805 if (argc == 1) {
14806 char **e = Jim_GetEnviron();
14808 int i;
14809 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14811 for (i = 0; e[i]; i++) {
14812 const char *equals = strchr(e[i], '=');
14814 if (equals) {
14815 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14816 equals - e[i]));
14817 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14821 Jim_SetResult(interp, listObjPtr);
14822 return JIM_OK;
14825 if (argc < 2) {
14826 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14827 return JIM_ERR;
14829 key = Jim_String(argv[1]);
14830 val = getenv(key);
14831 if (val == NULL) {
14832 if (argc < 3) {
14833 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14834 return JIM_ERR;
14836 val = Jim_String(argv[2]);
14838 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
14839 return JIM_OK;
14842 /* [source] */
14843 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14845 int retval;
14847 if (argc != 2) {
14848 Jim_WrongNumArgs(interp, 1, argv, "fileName");
14849 return JIM_ERR;
14851 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
14852 if (retval == JIM_RETURN)
14853 return JIM_OK;
14854 return retval;
14857 /* [lreverse] */
14858 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14860 Jim_Obj *revObjPtr, **ele;
14861 int len;
14863 if (argc != 2) {
14864 Jim_WrongNumArgs(interp, 1, argv, "list");
14865 return JIM_ERR;
14867 JimListGetElements(interp, argv[1], &len, &ele);
14868 len--;
14869 revObjPtr = Jim_NewListObj(interp, NULL, 0);
14870 while (len >= 0)
14871 ListAppendElement(revObjPtr, ele[len--]);
14872 Jim_SetResult(interp, revObjPtr);
14873 return JIM_OK;
14876 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
14878 jim_wide len;
14880 if (step == 0)
14881 return -1;
14882 if (start == end)
14883 return 0;
14884 else if (step > 0 && start > end)
14885 return -1;
14886 else if (step < 0 && end > start)
14887 return -1;
14888 len = end - start;
14889 if (len < 0)
14890 len = -len; /* abs(len) */
14891 if (step < 0)
14892 step = -step; /* abs(step) */
14893 len = 1 + ((len - 1) / step);
14894 /* We can truncate safely to INT_MAX, the range command
14895 * will always return an error for a such long range
14896 * because Tcl lists can't be so long. */
14897 if (len > INT_MAX)
14898 len = INT_MAX;
14899 return (int)((len < 0) ? -1 : len);
14902 /* [range] */
14903 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14905 jim_wide start = 0, end, step = 1;
14906 int len, i;
14907 Jim_Obj *objPtr;
14909 if (argc < 2 || argc > 4) {
14910 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
14911 return JIM_ERR;
14913 if (argc == 2) {
14914 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
14915 return JIM_ERR;
14917 else {
14918 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
14919 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
14920 return JIM_ERR;
14921 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
14922 return JIM_ERR;
14924 if ((len = JimRangeLen(start, end, step)) == -1) {
14925 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
14926 return JIM_ERR;
14928 objPtr = Jim_NewListObj(interp, NULL, 0);
14929 for (i = 0; i < len; i++)
14930 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
14931 Jim_SetResult(interp, objPtr);
14932 return JIM_OK;
14935 /* [rand] */
14936 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14938 jim_wide min = 0, max = 0, len, maxMul;
14940 if (argc < 1 || argc > 3) {
14941 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
14942 return JIM_ERR;
14944 if (argc == 1) {
14945 max = JIM_WIDE_MAX;
14946 } else if (argc == 2) {
14947 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
14948 return JIM_ERR;
14949 } else if (argc == 3) {
14950 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
14951 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
14952 return JIM_ERR;
14954 len = max-min;
14955 if (len < 0) {
14956 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
14957 return JIM_ERR;
14959 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
14960 while (1) {
14961 jim_wide r;
14963 JimRandomBytes(interp, &r, sizeof(jim_wide));
14964 if (r < 0 || r >= maxMul) continue;
14965 r = (len == 0) ? 0 : r%len;
14966 Jim_SetResultInt(interp, min+r);
14967 return JIM_OK;
14971 static const struct {
14972 const char *name;
14973 Jim_CmdProc cmdProc;
14974 } Jim_CoreCommandsTable[] = {
14975 {"alias", Jim_AliasCoreCommand},
14976 {"set", Jim_SetCoreCommand},
14977 {"unset", Jim_UnsetCoreCommand},
14978 {"puts", Jim_PutsCoreCommand},
14979 {"+", Jim_AddCoreCommand},
14980 {"*", Jim_MulCoreCommand},
14981 {"-", Jim_SubCoreCommand},
14982 {"/", Jim_DivCoreCommand},
14983 {"incr", Jim_IncrCoreCommand},
14984 {"while", Jim_WhileCoreCommand},
14985 {"loop", Jim_LoopCoreCommand},
14986 {"for", Jim_ForCoreCommand},
14987 {"foreach", Jim_ForeachCoreCommand},
14988 {"lmap", Jim_LmapCoreCommand},
14989 {"lassign", Jim_LassignCoreCommand},
14990 {"if", Jim_IfCoreCommand},
14991 {"switch", Jim_SwitchCoreCommand},
14992 {"list", Jim_ListCoreCommand},
14993 {"lindex", Jim_LindexCoreCommand},
14994 {"lset", Jim_LsetCoreCommand},
14995 {"lsearch", Jim_LsearchCoreCommand},
14996 {"llength", Jim_LlengthCoreCommand},
14997 {"lappend", Jim_LappendCoreCommand},
14998 {"linsert", Jim_LinsertCoreCommand},
14999 {"lreplace", Jim_LreplaceCoreCommand},
15000 {"lsort", Jim_LsortCoreCommand},
15001 {"append", Jim_AppendCoreCommand},
15002 {"debug", Jim_DebugCoreCommand},
15003 {"eval", Jim_EvalCoreCommand},
15004 {"uplevel", Jim_UplevelCoreCommand},
15005 {"expr", Jim_ExprCoreCommand},
15006 {"break", Jim_BreakCoreCommand},
15007 {"continue", Jim_ContinueCoreCommand},
15008 {"proc", Jim_ProcCoreCommand},
15009 {"concat", Jim_ConcatCoreCommand},
15010 {"return", Jim_ReturnCoreCommand},
15011 {"upvar", Jim_UpvarCoreCommand},
15012 {"global", Jim_GlobalCoreCommand},
15013 {"string", Jim_StringCoreCommand},
15014 {"time", Jim_TimeCoreCommand},
15015 {"exit", Jim_ExitCoreCommand},
15016 {"catch", Jim_CatchCoreCommand},
15017 #ifdef JIM_REFERENCES
15018 {"ref", Jim_RefCoreCommand},
15019 {"getref", Jim_GetrefCoreCommand},
15020 {"setref", Jim_SetrefCoreCommand},
15021 {"finalize", Jim_FinalizeCoreCommand},
15022 {"collect", Jim_CollectCoreCommand},
15023 #endif
15024 {"rename", Jim_RenameCoreCommand},
15025 {"dict", Jim_DictCoreCommand},
15026 {"subst", Jim_SubstCoreCommand},
15027 {"info", Jim_InfoCoreCommand},
15028 {"exists", Jim_ExistsCoreCommand},
15029 {"split", Jim_SplitCoreCommand},
15030 {"join", Jim_JoinCoreCommand},
15031 {"format", Jim_FormatCoreCommand},
15032 {"scan", Jim_ScanCoreCommand},
15033 {"error", Jim_ErrorCoreCommand},
15034 {"lrange", Jim_LrangeCoreCommand},
15035 {"lrepeat", Jim_LrepeatCoreCommand},
15036 {"env", Jim_EnvCoreCommand},
15037 {"source", Jim_SourceCoreCommand},
15038 {"lreverse", Jim_LreverseCoreCommand},
15039 {"range", Jim_RangeCoreCommand},
15040 {"rand", Jim_RandCoreCommand},
15041 {"tailcall", Jim_TailcallCoreCommand},
15042 {"local", Jim_LocalCoreCommand},
15043 {"upcall", Jim_UpcallCoreCommand},
15044 {"apply", Jim_ApplyCoreCommand},
15045 {NULL, NULL},
15048 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15050 int i = 0;
15052 while (Jim_CoreCommandsTable[i].name != NULL) {
15053 Jim_CreateCommand(interp,
15054 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15055 i++;
15059 /* -----------------------------------------------------------------------------
15060 * Interactive prompt
15061 * ---------------------------------------------------------------------------*/
15062 void Jim_MakeErrorMessage(Jim_Interp *interp)
15064 Jim_Obj *argv[2];
15066 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15067 argv[1] = interp->result;
15069 Jim_EvalObjVector(interp, 2, argv);
15072 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15073 const char *prefix, const char *const *tablePtr, const char *name)
15075 int count;
15076 char **tablePtrSorted;
15077 int i;
15079 for (count = 0; tablePtr[count]; count++) {
15082 if (name == NULL) {
15083 name = "option";
15086 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15087 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15088 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15089 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15090 for (i = 0; i < count; i++) {
15091 if (i + 1 == count && count > 1) {
15092 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15094 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15095 if (i + 1 != count) {
15096 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15099 Jim_Free(tablePtrSorted);
15102 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15103 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15105 const char *bad = "bad ";
15106 const char *const *entryPtr = NULL;
15107 int i;
15108 int match = -1;
15109 int arglen;
15110 const char *arg = Jim_GetString(objPtr, &arglen);
15112 *indexPtr = -1;
15114 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15115 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15116 /* Found an exact match */
15117 *indexPtr = i;
15118 return JIM_OK;
15120 if (flags & JIM_ENUM_ABBREV) {
15121 /* Accept an unambiguous abbreviation.
15122 * Note that '-' doesnt' consitute a valid abbreviation
15124 if (strncmp(arg, *entryPtr, arglen) == 0) {
15125 if (*arg == '-' && arglen == 1) {
15126 break;
15128 if (match >= 0) {
15129 bad = "ambiguous ";
15130 goto ambiguous;
15132 match = i;
15137 /* If we had an unambiguous partial match */
15138 if (match >= 0) {
15139 *indexPtr = match;
15140 return JIM_OK;
15143 ambiguous:
15144 if (flags & JIM_ERRMSG) {
15145 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15147 return JIM_ERR;
15150 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15152 int i;
15154 for (i = 0; i < (int)len; i++) {
15155 if (array[i] && strcmp(array[i], name) == 0) {
15156 return i;
15159 return -1;
15162 int Jim_IsDict(Jim_Obj *objPtr)
15164 return objPtr->typePtr == &dictObjType;
15167 int Jim_IsList(Jim_Obj *objPtr)
15169 return objPtr->typePtr == &listObjType;
15173 * Very simple printf-like formatting, designed for error messages.
15175 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15176 * The resulting string is created and set as the result.
15178 * Each '%s' should correspond to a regular string parameter.
15179 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15180 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15182 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15184 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15186 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15188 /* Initial space needed */
15189 int len = strlen(format);
15190 int extra = 0;
15191 int n = 0;
15192 const char *params[5];
15193 char *buf;
15194 va_list args;
15195 int i;
15197 va_start(args, format);
15199 for (i = 0; i < len && n < 5; i++) {
15200 int l;
15202 if (strncmp(format + i, "%s", 2) == 0) {
15203 params[n] = va_arg(args, char *);
15205 l = strlen(params[n]);
15207 else if (strncmp(format + i, "%#s", 3) == 0) {
15208 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15210 params[n] = Jim_GetString(objPtr, &l);
15212 else {
15213 if (format[i] == '%') {
15214 i++;
15216 continue;
15218 n++;
15219 extra += l;
15222 len += extra;
15223 buf = Jim_Alloc(len + 1);
15224 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15226 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15229 /* stubs */
15230 #ifndef jim_ext_package
15231 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15233 return JIM_OK;
15235 #endif
15236 #ifndef jim_ext_aio
15237 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15239 Jim_SetResultString(interp, "aio not enabled", -1);
15240 return NULL;
15242 #endif
15246 * Local Variables: ***
15247 * c-basic-offset: 4 ***
15248 * tab-width: 4 ***
15249 * End: ***