Add floating point support for [binary]
[jimtcl.git] / jim.c
blob1cd696f1a6233096297e406690487b61758cda41
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 if (buf[i] == 'n' || buf[i] == 'N')
612 buf[i+2] = toupper(UCHAR(buf[i+2]));
613 buf[i + 3] = 0;
614 return i + 3;
618 buf[i++] = '.';
619 buf[i++] = '0';
620 buf[i] = '\0';
622 return i;
625 int Jim_StringToDouble(const char *str, double *doublePtr)
627 char *endptr;
629 /* Callers can check for underflow via ERANGE */
630 errno = 0;
632 *doublePtr = strtod(str, &endptr);
634 return JimCheckConversion(str, endptr);
637 static jim_wide JimPowWide(jim_wide b, jim_wide e)
639 jim_wide i, res = 1;
641 if ((b == 0 && e != 0) || (e < 0))
642 return 0;
643 for (i = 0; i < e; i++) {
644 res *= b;
646 return res;
649 /* -----------------------------------------------------------------------------
650 * Special functions
651 * ---------------------------------------------------------------------------*/
652 #ifdef JIM_DEBUG_PANIC
653 void JimPanicDump(int condition, const char *fmt, ...)
655 va_list ap;
657 if (!condition) {
658 return;
661 va_start(ap, fmt);
663 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
664 vfprintf(stderr, fmt, ap);
665 fprintf(stderr, JIM_NL JIM_NL);
666 va_end(ap);
668 #ifdef HAVE_BACKTRACE
670 void *array[40];
671 int size, i;
672 char **strings;
674 size = backtrace(array, 40);
675 strings = backtrace_symbols(array, size);
676 for (i = 0; i < size; i++)
677 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
678 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
679 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
681 #endif
683 exit(1);
685 #endif
687 /* -----------------------------------------------------------------------------
688 * Memory allocation
689 * ---------------------------------------------------------------------------*/
691 void *Jim_Alloc(int size)
693 return size ? malloc(size) : NULL;
696 void Jim_Free(void *ptr)
698 free(ptr);
701 void *Jim_Realloc(void *ptr, int size)
703 return realloc(ptr, size);
706 char *Jim_StrDup(const char *s)
708 return strdup(s);
711 char *Jim_StrDupLen(const char *s, int l)
713 char *copy = Jim_Alloc(l + 1);
715 memcpy(copy, s, l + 1);
716 copy[l] = 0; /* Just to be sure, original could be substring */
717 return copy;
720 /* -----------------------------------------------------------------------------
721 * Time related functions
722 * ---------------------------------------------------------------------------*/
724 /* Returns microseconds of CPU used since start. */
725 static jim_wide JimClock(void)
727 struct timeval tv;
729 gettimeofday(&tv, NULL);
730 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
733 /* -----------------------------------------------------------------------------
734 * Hash Tables
735 * ---------------------------------------------------------------------------*/
737 /* -------------------------- private prototypes ---------------------------- */
738 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
739 static unsigned int JimHashTableNextPower(unsigned int size);
740 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
742 /* -------------------------- hash functions -------------------------------- */
744 /* Thomas Wang's 32 bit Mix Function */
745 unsigned int Jim_IntHashFunction(unsigned int key)
747 key += ~(key << 15);
748 key ^= (key >> 10);
749 key += (key << 3);
750 key ^= (key >> 6);
751 key += ~(key << 11);
752 key ^= (key >> 16);
753 return key;
756 /* Generic hash function (we are using to multiply by 9 and add the byte
757 * as Tcl) */
758 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
760 unsigned int h = 0;
762 while (len--)
763 h += (h << 3) + *buf++;
764 return h;
767 /* ----------------------------- API implementation ------------------------- */
769 /* reset a hashtable already initialized with ht_init().
770 * NOTE: This function should only called by ht_destroy(). */
771 static void JimResetHashTable(Jim_HashTable *ht)
773 ht->table = NULL;
774 ht->size = 0;
775 ht->sizemask = 0;
776 ht->used = 0;
777 ht->collisions = 0;
780 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
782 iter->ht = ht;
783 iter->index = -1;
784 iter->entry = NULL;
785 iter->nextEntry = NULL;
788 /* Initialize the hash table */
789 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
791 JimResetHashTable(ht);
792 ht->type = type;
793 ht->privdata = privDataPtr;
794 return JIM_OK;
797 /* Resize the table to the minimal size that contains all the elements,
798 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
799 void Jim_ResizeHashTable(Jim_HashTable *ht)
801 int minimal = ht->used;
803 if (minimal < JIM_HT_INITIAL_SIZE)
804 minimal = JIM_HT_INITIAL_SIZE;
805 Jim_ExpandHashTable(ht, minimal);
808 /* Expand or create the hashtable */
809 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
811 Jim_HashTable n; /* the new hashtable */
812 unsigned int realsize = JimHashTableNextPower(size), i;
814 /* the size is invalid if it is smaller than the number of
815 * elements already inside the hashtable */
816 if (size <= ht->used)
817 return;
819 Jim_InitHashTable(&n, ht->type, ht->privdata);
820 n.size = realsize;
821 n.sizemask = realsize - 1;
822 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
824 /* Initialize all the pointers to NULL */
825 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
827 /* Copy all the elements from the old to the new table:
828 * note that if the old hash table is empty ht->used is zero,
829 * so Jim_ExpandHashTable just creates an empty hash table. */
830 n.used = ht->used;
831 for (i = 0; ht->used > 0; i++) {
832 Jim_HashEntry *he, *nextHe;
834 if (ht->table[i] == NULL)
835 continue;
837 /* For each hash entry on this slot... */
838 he = ht->table[i];
839 while (he) {
840 unsigned int h;
842 nextHe = he->next;
843 /* Get the new element index */
844 h = Jim_HashKey(ht, he->key) & n.sizemask;
845 he->next = n.table[h];
846 n.table[h] = he;
847 ht->used--;
848 /* Pass to the next element */
849 he = nextHe;
852 assert(ht->used == 0);
853 Jim_Free(ht->table);
855 /* Remap the new hashtable in the old */
856 *ht = n;
859 /* Add an element to the target hash table */
860 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
862 Jim_HashEntry *entry;
864 /* Get the index of the new element, or -1 if
865 * the element already exists. */
866 entry = JimInsertHashEntry(ht, key, 0);
867 if (entry == NULL)
868 return JIM_ERR;
870 /* Set the hash entry fields. */
871 Jim_SetHashKey(ht, entry, key);
872 Jim_SetHashVal(ht, entry, val);
873 return JIM_OK;
876 /* Add an element, discarding the old if the key already exists */
877 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
879 int existed;
880 Jim_HashEntry *entry;
882 /* Get the index of the new element, or -1 if
883 * the element already exists. */
884 entry = JimInsertHashEntry(ht, key, 1);
885 if (entry->key) {
886 /* It already exists, so replace the value */
887 Jim_FreeEntryVal(ht, entry);
888 existed = 1;
890 else {
891 /* Doesn't exist, so set the key */
892 Jim_SetHashKey(ht, entry, key);
893 existed = 0;
895 Jim_SetHashVal(ht, entry, val);
897 return existed;
900 /* Search and remove an element */
901 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
903 unsigned int h;
904 Jim_HashEntry *he, *prevHe;
906 if (ht->used == 0)
907 return JIM_ERR;
908 h = Jim_HashKey(ht, key) & ht->sizemask;
909 he = ht->table[h];
911 prevHe = NULL;
912 while (he) {
913 if (Jim_CompareHashKeys(ht, key, he->key)) {
914 /* Unlink the element from the list */
915 if (prevHe)
916 prevHe->next = he->next;
917 else
918 ht->table[h] = he->next;
919 Jim_FreeEntryKey(ht, he);
920 Jim_FreeEntryVal(ht, he);
921 Jim_Free(he);
922 ht->used--;
923 return JIM_OK;
925 prevHe = he;
926 he = he->next;
928 return JIM_ERR; /* not found */
931 /* Destroy an entire hash table */
932 int Jim_FreeHashTable(Jim_HashTable *ht)
934 unsigned int i;
936 /* Free all the elements */
937 for (i = 0; ht->used > 0; i++) {
938 Jim_HashEntry *he, *nextHe;
940 if ((he = ht->table[i]) == NULL)
941 continue;
942 while (he) {
943 nextHe = he->next;
944 Jim_FreeEntryKey(ht, he);
945 Jim_FreeEntryVal(ht, he);
946 Jim_Free(he);
947 ht->used--;
948 he = nextHe;
951 /* Free the table and the allocated cache structure */
952 Jim_Free(ht->table);
953 /* Re-initialize the table */
954 JimResetHashTable(ht);
955 return JIM_OK; /* never fails */
958 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
960 Jim_HashEntry *he;
961 unsigned int h;
963 if (ht->used == 0)
964 return NULL;
965 h = Jim_HashKey(ht, key) & ht->sizemask;
966 he = ht->table[h];
967 while (he) {
968 if (Jim_CompareHashKeys(ht, key, he->key))
969 return he;
970 he = he->next;
972 return NULL;
975 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
977 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
978 JimInitHashTableIterator(ht, iter);
979 return iter;
982 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
984 while (1) {
985 if (iter->entry == NULL) {
986 iter->index++;
987 if (iter->index >= (signed)iter->ht->size)
988 break;
989 iter->entry = iter->ht->table[iter->index];
991 else {
992 iter->entry = iter->nextEntry;
994 if (iter->entry) {
995 /* We need to save the 'next' here, the iterator user
996 * may delete the entry we are returning. */
997 iter->nextEntry = iter->entry->next;
998 return iter->entry;
1001 return NULL;
1004 /* ------------------------- private functions ------------------------------ */
1006 /* Expand the hash table if needed */
1007 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
1009 /* If the hash table is empty expand it to the intial size,
1010 * if the table is "full" dobule its size. */
1011 if (ht->size == 0)
1012 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
1013 if (ht->size == ht->used)
1014 Jim_ExpandHashTable(ht, ht->size * 2);
1017 /* Our hash table capability is a power of two */
1018 static unsigned int JimHashTableNextPower(unsigned int size)
1020 unsigned int i = JIM_HT_INITIAL_SIZE;
1022 if (size >= 2147483648U)
1023 return 2147483648U;
1024 while (1) {
1025 if (i >= size)
1026 return i;
1027 i *= 2;
1031 /* Returns the index of a free slot that can be populated with
1032 * an hash entry for the given 'key'.
1033 * If the key already exists, -1 is returned. */
1034 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1036 unsigned int h;
1037 Jim_HashEntry *he;
1039 /* Expand the hashtable if needed */
1040 JimExpandHashTableIfNeeded(ht);
1042 /* Compute the key hash value */
1043 h = Jim_HashKey(ht, key) & ht->sizemask;
1044 /* Search if this slot does not already contain the given key */
1045 he = ht->table[h];
1046 while (he) {
1047 if (Jim_CompareHashKeys(ht, key, he->key))
1048 return replace ? he : NULL;
1049 he = he->next;
1052 /* Allocates the memory and stores key */
1053 he = Jim_Alloc(sizeof(*he));
1054 he->next = ht->table[h];
1055 ht->table[h] = he;
1056 ht->used++;
1057 he->key = NULL;
1059 return he;
1062 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1064 static unsigned int JimStringCopyHTHashFunction(const void *key)
1066 return Jim_GenHashFunction(key, strlen(key));
1069 static void *JimStringCopyHTDup(void *privdata, const void *key)
1071 return strdup(key);
1074 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1076 return strcmp(key1, key2) == 0;
1079 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1081 Jim_Free(key);
1084 static const Jim_HashTableType JimPackageHashTableType = {
1085 JimStringCopyHTHashFunction, /* hash function */
1086 JimStringCopyHTDup, /* key dup */
1087 NULL, /* val dup */
1088 JimStringCopyHTKeyCompare, /* key compare */
1089 JimStringCopyHTKeyDestructor, /* key destructor */
1090 NULL /* val destructor */
1093 typedef struct AssocDataValue
1095 Jim_InterpDeleteProc *delProc;
1096 void *data;
1097 } AssocDataValue;
1099 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1101 AssocDataValue *assocPtr = (AssocDataValue *) data;
1103 if (assocPtr->delProc != NULL)
1104 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1105 Jim_Free(data);
1108 static const Jim_HashTableType JimAssocDataHashTableType = {
1109 JimStringCopyHTHashFunction, /* hash function */
1110 JimStringCopyHTDup, /* key dup */
1111 NULL, /* val dup */
1112 JimStringCopyHTKeyCompare, /* key compare */
1113 JimStringCopyHTKeyDestructor, /* key destructor */
1114 JimAssocDataHashTableValueDestructor /* val destructor */
1117 /* -----------------------------------------------------------------------------
1118 * Stack - This is a simple generic stack implementation. It is used for
1119 * example in the 'expr' expression compiler.
1120 * ---------------------------------------------------------------------------*/
1121 void Jim_InitStack(Jim_Stack *stack)
1123 stack->len = 0;
1124 stack->maxlen = 0;
1125 stack->vector = NULL;
1128 void Jim_FreeStack(Jim_Stack *stack)
1130 Jim_Free(stack->vector);
1133 int Jim_StackLen(Jim_Stack *stack)
1135 return stack->len;
1138 void Jim_StackPush(Jim_Stack *stack, void *element)
1140 int neededLen = stack->len + 1;
1142 if (neededLen > stack->maxlen) {
1143 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1144 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1146 stack->vector[stack->len] = element;
1147 stack->len++;
1150 void *Jim_StackPop(Jim_Stack *stack)
1152 if (stack->len == 0)
1153 return NULL;
1154 stack->len--;
1155 return stack->vector[stack->len];
1158 void *Jim_StackPeek(Jim_Stack *stack)
1160 if (stack->len == 0)
1161 return NULL;
1162 return stack->vector[stack->len - 1];
1165 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1167 int i;
1169 for (i = 0; i < stack->len; i++)
1170 freeFunc(stack->vector[i]);
1173 /* -----------------------------------------------------------------------------
1174 * Parser
1175 * ---------------------------------------------------------------------------*/
1177 /* Token types */
1178 #define JIM_TT_NONE 0 /* No token returned */
1179 #define JIM_TT_STR 1 /* simple string */
1180 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1181 #define JIM_TT_VAR 3 /* var substitution */
1182 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1183 #define JIM_TT_CMD 5 /* command substitution */
1184 /* Note: Keep these three together for TOKEN_IS_SEP() */
1185 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
1186 #define JIM_TT_EOL 7 /* line separator */
1187 #define JIM_TT_EOF 8 /* end of script */
1189 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1190 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1192 /* Additional token types needed for expressions */
1193 #define JIM_TT_SUBEXPR_START 11
1194 #define JIM_TT_SUBEXPR_END 12
1195 #define JIM_TT_SUBEXPR_COMMA 13
1196 #define JIM_TT_EXPR_INT 14
1197 #define JIM_TT_EXPR_DOUBLE 15
1199 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1201 /* Operator token types start here */
1202 #define JIM_TT_EXPR_OP 20
1204 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1206 /* Parser states */
1207 #define JIM_PS_DEF 0 /* Default state */
1208 #define JIM_PS_QUOTE 1 /* Inside "" */
1209 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1211 /* Parser context structure. The same context is used both to parse
1212 * Tcl scripts and lists. */
1213 struct JimParserCtx
1215 const char *p; /* Pointer to the point of the program we are parsing */
1216 int len; /* Remaining length */
1217 int linenr; /* Current line number */
1218 const char *tstart;
1219 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1220 int tline; /* Line number of the returned token */
1221 int tt; /* Token type */
1222 int eof; /* Non zero if EOF condition is true. */
1223 int state; /* Parser state */
1224 int comment; /* Non zero if the next chars may be a comment. */
1225 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1226 int missingline; /* Line number starting the missing token */
1230 * Results of missing quotes, braces, etc. from parsing.
1232 struct JimParseResult {
1233 char missing; /* From JimParserCtx.missing */
1234 int line; /* From JimParserCtx.missingline */
1237 static int JimParseScript(struct JimParserCtx *pc);
1238 static int JimParseSep(struct JimParserCtx *pc);
1239 static int JimParseEol(struct JimParserCtx *pc);
1240 static int JimParseCmd(struct JimParserCtx *pc);
1241 static int JimParseQuote(struct JimParserCtx *pc);
1242 static int JimParseVar(struct JimParserCtx *pc);
1243 static int JimParseBrace(struct JimParserCtx *pc);
1244 static int JimParseStr(struct JimParserCtx *pc);
1245 static int JimParseComment(struct JimParserCtx *pc);
1246 static void JimParseSubCmd(struct JimParserCtx *pc);
1247 static int JimParseSubQuote(struct JimParserCtx *pc);
1248 static void JimParseSubCmd(struct JimParserCtx *pc);
1249 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1251 /* Initialize a parser context.
1252 * 'prg' is a pointer to the program text, linenr is the line
1253 * number of the first line contained in the program. */
1254 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1256 pc->p = prg;
1257 pc->len = len;
1258 pc->tstart = NULL;
1259 pc->tend = NULL;
1260 pc->tline = 0;
1261 pc->tt = JIM_TT_NONE;
1262 pc->eof = 0;
1263 pc->state = JIM_PS_DEF;
1264 pc->linenr = linenr;
1265 pc->comment = 1;
1266 pc->missing = ' ';
1267 pc->missingline = linenr;
1270 static int JimParseScript(struct JimParserCtx *pc)
1272 while (1) { /* the while is used to reiterate with continue if needed */
1273 if (!pc->len) {
1274 pc->tstart = pc->p;
1275 pc->tend = pc->p - 1;
1276 pc->tline = pc->linenr;
1277 pc->tt = JIM_TT_EOL;
1278 pc->eof = 1;
1279 return JIM_OK;
1281 switch (*(pc->p)) {
1282 case '\\':
1283 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1284 return JimParseSep(pc);
1286 pc->comment = 0;
1287 return JimParseStr(pc);
1288 case ' ':
1289 case '\t':
1290 case '\r':
1291 case '\f':
1292 if (pc->state == JIM_PS_DEF)
1293 return JimParseSep(pc);
1294 pc->comment = 0;
1295 return JimParseStr(pc);
1296 case '\n':
1297 case ';':
1298 pc->comment = 1;
1299 if (pc->state == JIM_PS_DEF)
1300 return JimParseEol(pc);
1301 return JimParseStr(pc);
1302 case '[':
1303 pc->comment = 0;
1304 return JimParseCmd(pc);
1305 case '$':
1306 pc->comment = 0;
1307 if (JimParseVar(pc) == JIM_ERR) {
1308 /* An orphan $. Create as a separate token */
1309 pc->tstart = pc->tend = pc->p++;
1310 pc->len--;
1311 pc->tt = JIM_TT_ESC;
1313 return JIM_OK;
1314 case '#':
1315 if (pc->comment) {
1316 JimParseComment(pc);
1317 continue;
1319 return JimParseStr(pc);
1320 default:
1321 pc->comment = 0;
1322 return JimParseStr(pc);
1324 return JIM_OK;
1328 static int JimParseSep(struct JimParserCtx *pc)
1330 pc->tstart = pc->p;
1331 pc->tline = pc->linenr;
1332 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1333 if (*pc->p == '\n') {
1334 break;
1336 if (*pc->p == '\\') {
1337 pc->p++;
1338 pc->len--;
1339 pc->linenr++;
1341 pc->p++;
1342 pc->len--;
1344 pc->tend = pc->p - 1;
1345 pc->tt = JIM_TT_SEP;
1346 return JIM_OK;
1349 static int JimParseEol(struct JimParserCtx *pc)
1351 pc->tstart = pc->p;
1352 pc->tline = pc->linenr;
1353 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1354 if (*pc->p == '\n')
1355 pc->linenr++;
1356 pc->p++;
1357 pc->len--;
1359 pc->tend = pc->p - 1;
1360 pc->tt = JIM_TT_EOL;
1361 return JIM_OK;
1365 ** Here are the rules for parsing:
1366 ** {braced expression}
1367 ** - Count open and closing braces
1368 ** - Backslash escapes meaning of braces
1370 ** "quoted expression"
1371 ** - First double quote at start of word terminates the expression
1372 ** - Backslash escapes quote and bracket
1373 ** - [commands brackets] are counted/nested
1374 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1376 ** [command expression]
1377 ** - Count open and closing brackets
1378 ** - Backslash escapes quote, bracket and brace
1379 ** - [commands brackets] are counted/nested
1380 ** - "quoted expressions" are parsed according to quoting rules
1381 ** - {braced expressions} are parsed according to brace rules
1383 ** For everything, backslash escapes the next char, newline increments current line
1387 * Parses a braced expression starting at pc->p.
1389 * Positions the parser at the end of the braced expression,
1390 * sets pc->tend and possibly pc->missing.
1392 static void JimParseSubBrace(struct JimParserCtx *pc)
1394 int level = 1;
1396 /* Skip the brace */
1397 pc->p++;
1398 pc->len--;
1399 while (pc->len) {
1400 switch (*pc->p) {
1401 case '\\':
1402 if (pc->len > 1) {
1403 if (*++pc->p == '\n') {
1404 pc->linenr++;
1406 pc->len--;
1408 break;
1410 case '{':
1411 level++;
1412 break;
1414 case '}':
1415 if (--level == 0) {
1416 pc->tend = pc->p - 1;
1417 pc->p++;
1418 pc->len--;
1419 return;
1421 break;
1423 case '\n':
1424 pc->linenr++;
1425 break;
1427 pc->p++;
1428 pc->len--;
1430 pc->missing = '{';
1431 pc->missingline = pc->tline;
1432 pc->tend = pc->p - 1;
1436 * Parses a quoted expression starting at pc->p.
1438 * Positions the parser at the end of the quoted expression,
1439 * sets pc->tend and possibly pc->missing.
1441 * Returns the type of the token of the string,
1442 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1443 * or JIM_TT_STR.
1445 static int JimParseSubQuote(struct JimParserCtx *pc)
1447 int tt = JIM_TT_STR;
1448 int line = pc->tline;
1450 /* Skip the quote */
1451 pc->p++;
1452 pc->len--;
1453 while (pc->len) {
1454 switch (*pc->p) {
1455 case '\\':
1456 if (pc->len > 1) {
1457 if (*++pc->p == '\n') {
1458 pc->linenr++;
1460 pc->len--;
1461 tt = JIM_TT_ESC;
1463 break;
1465 case '"':
1466 pc->tend = pc->p - 1;
1467 pc->p++;
1468 pc->len--;
1469 return tt;
1471 case '[':
1472 JimParseSubCmd(pc);
1473 tt = JIM_TT_ESC;
1474 continue;
1476 case '\n':
1477 pc->linenr++;
1478 break;
1480 case '$':
1481 tt = JIM_TT_ESC;
1482 break;
1484 pc->p++;
1485 pc->len--;
1487 pc->missing = '"';
1488 pc->missingline = line;
1489 pc->tend = pc->p - 1;
1490 return tt;
1494 * Parses a [command] expression starting at pc->p.
1496 * Positions the parser at the end of the command expression,
1497 * sets pc->tend and possibly pc->missing.
1499 static void JimParseSubCmd(struct JimParserCtx *pc)
1501 int level = 1;
1502 int startofword = 1;
1503 int line = pc->tline;
1505 /* Skip the bracket */
1506 pc->p++;
1507 pc->len--;
1508 while (pc->len) {
1509 switch (*pc->p) {
1510 case '\\':
1511 if (pc->len > 1) {
1512 if (*++pc->p == '\n') {
1513 pc->linenr++;
1515 pc->len--;
1517 break;
1519 case '[':
1520 level++;
1521 break;
1523 case ']':
1524 if (--level == 0) {
1525 pc->tend = pc->p - 1;
1526 pc->p++;
1527 pc->len--;
1528 return;
1530 break;
1532 case '"':
1533 if (startofword) {
1534 JimParseSubQuote(pc);
1535 continue;
1537 break;
1539 case '{':
1540 JimParseSubBrace(pc);
1541 startofword = 0;
1542 continue;
1544 case '\n':
1545 pc->linenr++;
1546 break;
1548 startofword = isspace(UCHAR(*pc->p));
1549 pc->p++;
1550 pc->len--;
1552 pc->missing = '[';
1553 pc->missingline = line;
1554 pc->tend = pc->p - 1;
1557 static int JimParseBrace(struct JimParserCtx *pc)
1559 pc->tstart = pc->p + 1;
1560 pc->tline = pc->linenr;
1561 pc->tt = JIM_TT_STR;
1562 JimParseSubBrace(pc);
1563 return JIM_OK;
1566 static int JimParseCmd(struct JimParserCtx *pc)
1568 pc->tstart = pc->p + 1;
1569 pc->tline = pc->linenr;
1570 pc->tt = JIM_TT_CMD;
1571 JimParseSubCmd(pc);
1572 return JIM_OK;
1575 static int JimParseQuote(struct JimParserCtx *pc)
1577 pc->tstart = pc->p + 1;
1578 pc->tline = pc->linenr;
1579 pc->tt = JimParseSubQuote(pc);
1580 return JIM_OK;
1583 static int JimParseVar(struct JimParserCtx *pc)
1585 /* skip the $ */
1586 pc->p++;
1587 pc->len--;
1589 #ifdef EXPRSUGAR_BRACKET
1590 if (*pc->p == '[') {
1591 /* Parse $[...] expr shorthand syntax */
1592 JimParseCmd(pc);
1593 pc->tt = JIM_TT_EXPRSUGAR;
1594 return JIM_OK;
1596 #endif
1598 pc->tstart = pc->p;
1599 pc->tt = JIM_TT_VAR;
1600 pc->tline = pc->linenr;
1602 if (*pc->p == '{') {
1603 pc->tstart = ++pc->p;
1604 pc->len--;
1606 while (pc->len && *pc->p != '}') {
1607 if (*pc->p == '\n') {
1608 pc->linenr++;
1610 pc->p++;
1611 pc->len--;
1613 pc->tend = pc->p - 1;
1614 if (pc->len) {
1615 pc->p++;
1616 pc->len--;
1619 else {
1620 while (1) {
1621 /* Skip double colon, but not single colon! */
1622 if (pc->p[0] == ':' && pc->p[1] == ':') {
1623 while (*pc->p == ':') {
1624 pc->p++;
1625 pc->len--;
1627 continue;
1629 /* Note that any char >= 0x80 must be part of a utf-8 char.
1630 * We consider all unicode points outside of ASCII as letters
1632 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1633 pc->p++;
1634 pc->len--;
1635 continue;
1637 break;
1639 /* Parse [dict get] syntax sugar. */
1640 if (*pc->p == '(') {
1641 int count = 1;
1642 const char *paren = NULL;
1644 pc->tt = JIM_TT_DICTSUGAR;
1646 while (count && pc->len) {
1647 pc->p++;
1648 pc->len--;
1649 if (*pc->p == '\\' && pc->len >= 1) {
1650 pc->p++;
1651 pc->len--;
1653 else if (*pc->p == '(') {
1654 count++;
1656 else if (*pc->p == ')') {
1657 paren = pc->p;
1658 count--;
1661 if (count == 0) {
1662 pc->p++;
1663 pc->len--;
1665 else if (paren) {
1666 /* Did not find a matching paren. Back up */
1667 paren++;
1668 pc->len += (pc->p - paren);
1669 pc->p = paren;
1671 #ifndef EXPRSUGAR_BRACKET
1672 if (*pc->tstart == '(') {
1673 pc->tt = JIM_TT_EXPRSUGAR;
1675 #endif
1677 pc->tend = pc->p - 1;
1679 /* Check if we parsed just the '$' character.
1680 * That's not a variable so an error is returned
1681 * to tell the state machine to consider this '$' just
1682 * a string. */
1683 if (pc->tstart == pc->p) {
1684 pc->p--;
1685 pc->len++;
1686 return JIM_ERR;
1688 return JIM_OK;
1691 static int JimParseStr(struct JimParserCtx *pc)
1693 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1694 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1695 /* Starting a new word */
1696 if (*pc->p == '{') {
1697 return JimParseBrace(pc);
1699 if (*pc->p == '"') {
1700 pc->state = JIM_PS_QUOTE;
1701 pc->p++;
1702 pc->len--;
1703 /* In case the end quote is missing */
1704 pc->missingline = pc->tline;
1707 pc->tstart = pc->p;
1708 pc->tline = pc->linenr;
1709 while (1) {
1710 if (pc->len == 0) {
1711 if (pc->state == JIM_PS_QUOTE) {
1712 pc->missing = '"';
1714 pc->tend = pc->p - 1;
1715 pc->tt = JIM_TT_ESC;
1716 return JIM_OK;
1718 switch (*pc->p) {
1719 case '\\':
1720 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1721 pc->tend = pc->p - 1;
1722 pc->tt = JIM_TT_ESC;
1723 return JIM_OK;
1725 if (pc->len >= 2) {
1726 if (*(pc->p + 1) == '\n') {
1727 pc->linenr++;
1729 pc->p++;
1730 pc->len--;
1732 break;
1733 case '(':
1734 /* If the following token is not '$' just keep going */
1735 if (pc->len > 1 && pc->p[1] != '$') {
1736 break;
1738 case ')':
1739 /* Only need a separate ')' token if the previous was a var */
1740 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1741 if (pc->p == pc->tstart) {
1742 /* At the start of the token, so just return this char */
1743 pc->p++;
1744 pc->len--;
1746 pc->tend = pc->p - 1;
1747 pc->tt = JIM_TT_ESC;
1748 return JIM_OK;
1750 break;
1752 case '$':
1753 case '[':
1754 pc->tend = pc->p - 1;
1755 pc->tt = JIM_TT_ESC;
1756 return JIM_OK;
1757 case ' ':
1758 case '\t':
1759 case '\n':
1760 case '\r':
1761 case '\f':
1762 case ';':
1763 if (pc->state == JIM_PS_DEF) {
1764 pc->tend = pc->p - 1;
1765 pc->tt = JIM_TT_ESC;
1766 return JIM_OK;
1768 else if (*pc->p == '\n') {
1769 pc->linenr++;
1771 break;
1772 case '"':
1773 if (pc->state == JIM_PS_QUOTE) {
1774 pc->tend = pc->p - 1;
1775 pc->tt = JIM_TT_ESC;
1776 pc->p++;
1777 pc->len--;
1778 pc->state = JIM_PS_DEF;
1779 return JIM_OK;
1781 break;
1783 pc->p++;
1784 pc->len--;
1786 return JIM_OK; /* unreached */
1789 static int JimParseComment(struct JimParserCtx *pc)
1791 while (*pc->p) {
1792 if (*pc->p == '\n') {
1793 pc->linenr++;
1794 if (*(pc->p - 1) != '\\') {
1795 pc->p++;
1796 pc->len--;
1797 return JIM_OK;
1800 pc->p++;
1801 pc->len--;
1803 return JIM_OK;
1806 /* xdigitval and odigitval are helper functions for JimEscape() */
1807 static int xdigitval(int c)
1809 if (c >= '0' && c <= '9')
1810 return c - '0';
1811 if (c >= 'a' && c <= 'f')
1812 return c - 'a' + 10;
1813 if (c >= 'A' && c <= 'F')
1814 return c - 'A' + 10;
1815 return -1;
1818 static int odigitval(int c)
1820 if (c >= '0' && c <= '7')
1821 return c - '0';
1822 return -1;
1825 /* Perform Tcl escape substitution of 's', storing the result
1826 * string into 'dest'. The escaped string is guaranteed to
1827 * be the same length or shorted than the source string.
1828 * Slen is the length of the string at 's', if it's -1 the string
1829 * length will be calculated by the function.
1831 * The function returns the length of the resulting string. */
1832 static int JimEscape(char *dest, const char *s, int slen)
1834 char *p = dest;
1835 int i, len;
1837 if (slen == -1)
1838 slen = strlen(s);
1840 for (i = 0; i < slen; i++) {
1841 switch (s[i]) {
1842 case '\\':
1843 switch (s[i + 1]) {
1844 case 'a':
1845 *p++ = 0x7;
1846 i++;
1847 break;
1848 case 'b':
1849 *p++ = 0x8;
1850 i++;
1851 break;
1852 case 'f':
1853 *p++ = 0xc;
1854 i++;
1855 break;
1856 case 'n':
1857 *p++ = 0xa;
1858 i++;
1859 break;
1860 case 'r':
1861 *p++ = 0xd;
1862 i++;
1863 break;
1864 case 't':
1865 *p++ = 0x9;
1866 i++;
1867 break;
1868 case 'u':
1869 case 'U':
1870 case 'x':
1871 /* A unicode or hex sequence.
1872 * \x Expect 1-2 hex chars and convert to hex.
1873 * \u Expect 1-4 hex chars and convert to utf-8.
1874 * \U Expect 1-8 hex chars and convert to utf-8.
1875 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1876 * An invalid sequence means simply the escaped char.
1879 unsigned val = 0;
1880 int k;
1881 int maxchars = 2;
1883 i++;
1885 if (s[i] == 'U') {
1886 maxchars = 8;
1888 else if (s[i] == 'u') {
1889 if (s[i + 1] == '{') {
1890 maxchars = 6;
1891 i++;
1893 else {
1894 maxchars = 4;
1898 for (k = 0; k < maxchars; k++) {
1899 int c = xdigitval(s[i + k + 1]);
1900 if (c == -1) {
1901 break;
1903 val = (val << 4) | c;
1905 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1906 if (s[i] == '{') {
1907 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1908 /* Back up */
1909 i--;
1910 k = 0;
1912 else {
1913 /* Skip the closing brace */
1914 k++;
1917 if (k) {
1918 /* Got a valid sequence, so convert */
1919 if (s[i] == 'x') {
1920 *p++ = val;
1922 else {
1923 p += utf8_fromunicode(p, val);
1925 i += k;
1926 break;
1928 /* Not a valid codepoint, just an escaped char */
1929 *p++ = s[i];
1931 break;
1932 case 'v':
1933 *p++ = 0xb;
1934 i++;
1935 break;
1936 case '\0':
1937 *p++ = '\\';
1938 i++;
1939 break;
1940 case '\n':
1941 /* Replace all spaces and tabs after backslash newline with a single space*/
1942 *p++ = ' ';
1943 do {
1944 i++;
1945 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1946 break;
1947 case '0':
1948 case '1':
1949 case '2':
1950 case '3':
1951 case '4':
1952 case '5':
1953 case '6':
1954 case '7':
1955 /* octal escape */
1957 int val = 0;
1958 int c = odigitval(s[i + 1]);
1960 val = c;
1961 c = odigitval(s[i + 2]);
1962 if (c == -1) {
1963 *p++ = val;
1964 i++;
1965 break;
1967 val = (val * 8) + c;
1968 c = odigitval(s[i + 3]);
1969 if (c == -1) {
1970 *p++ = val;
1971 i += 2;
1972 break;
1974 val = (val * 8) + c;
1975 *p++ = val;
1976 i += 3;
1978 break;
1979 default:
1980 *p++ = s[i + 1];
1981 i++;
1982 break;
1984 break;
1985 default:
1986 *p++ = s[i];
1987 break;
1990 len = p - dest;
1991 *p = '\0';
1992 return len;
1995 /* Returns a dynamically allocated copy of the current token in the
1996 * parser context. The function performs conversion of escapes if
1997 * the token is of type JIM_TT_ESC.
1999 * Note that after the conversion, tokens that are grouped with
2000 * braces in the source code, are always recognizable from the
2001 * identical string obtained in a different way from the type.
2003 * For example the string:
2005 * {*}$a
2007 * will return as first token "*", of type JIM_TT_STR
2009 * While the string:
2011 * *$a
2013 * will return as first token "*", of type JIM_TT_ESC
2015 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2017 const char *start, *end;
2018 char *token;
2019 int len;
2021 start = pc->tstart;
2022 end = pc->tend;
2023 if (start > end) {
2024 len = 0;
2025 token = Jim_Alloc(1);
2026 token[0] = '\0';
2028 else {
2029 len = (end - start) + 1;
2030 token = Jim_Alloc(len + 1);
2031 if (pc->tt != JIM_TT_ESC) {
2032 /* No escape conversion needed? Just copy it. */
2033 memcpy(token, start, len);
2034 token[len] = '\0';
2036 else {
2037 /* Else convert the escape chars. */
2038 len = JimEscape(token, start, len);
2042 return Jim_NewStringObjNoAlloc(interp, token, len);
2045 /* Parses the given string to determine if it represents a complete script.
2047 * This is useful for interactive shells implementation, for [info complete].
2049 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2050 * '{' on scripts incomplete missing one or more '}' to be balanced.
2051 * '[' on scripts incomplete missing one or more ']' to be balanced.
2052 * '"' on scripts incomplete missing a '"' char.
2054 * If the script is complete, 1 is returned, otherwise 0.
2056 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2058 struct JimParserCtx parser;
2060 JimParserInit(&parser, s, len, 1);
2061 while (!parser.eof) {
2062 JimParseScript(&parser);
2064 if (stateCharPtr) {
2065 *stateCharPtr = parser.missing;
2067 return parser.missing == ' ';
2070 /* -----------------------------------------------------------------------------
2071 * Tcl Lists parsing
2072 * ---------------------------------------------------------------------------*/
2073 static int JimParseListSep(struct JimParserCtx *pc);
2074 static int JimParseListStr(struct JimParserCtx *pc);
2075 static int JimParseListQuote(struct JimParserCtx *pc);
2077 static int JimParseList(struct JimParserCtx *pc)
2079 if (isspace(UCHAR(*pc->p))) {
2080 return JimParseListSep(pc);
2082 switch (*pc->p) {
2083 case '"':
2084 return JimParseListQuote(pc);
2086 case '{':
2087 return JimParseBrace(pc);
2089 default:
2090 if (pc->len) {
2091 return JimParseListStr(pc);
2093 break;
2096 pc->tstart = pc->tend = pc->p;
2097 pc->tline = pc->linenr;
2098 pc->tt = JIM_TT_EOL;
2099 pc->eof = 1;
2100 return JIM_OK;
2103 static int JimParseListSep(struct JimParserCtx *pc)
2105 pc->tstart = pc->p;
2106 pc->tline = pc->linenr;
2107 while (isspace(UCHAR(*pc->p))) {
2108 if (*pc->p == '\n') {
2109 pc->linenr++;
2111 pc->p++;
2112 pc->len--;
2114 pc->tend = pc->p - 1;
2115 pc->tt = JIM_TT_SEP;
2116 return JIM_OK;
2119 static int JimParseListQuote(struct JimParserCtx *pc)
2121 pc->p++;
2122 pc->len--;
2124 pc->tstart = pc->p;
2125 pc->tline = pc->linenr;
2126 pc->tt = JIM_TT_STR;
2128 while (pc->len) {
2129 switch (*pc->p) {
2130 case '\\':
2131 pc->tt = JIM_TT_ESC;
2132 if (--pc->len == 0) {
2133 /* Trailing backslash */
2134 pc->tend = pc->p;
2135 return JIM_OK;
2137 pc->p++;
2138 break;
2139 case '\n':
2140 pc->linenr++;
2141 break;
2142 case '"':
2143 pc->tend = pc->p - 1;
2144 pc->p++;
2145 pc->len--;
2146 return JIM_OK;
2148 pc->p++;
2149 pc->len--;
2152 pc->tend = pc->p - 1;
2153 return JIM_OK;
2156 static int JimParseListStr(struct JimParserCtx *pc)
2158 pc->tstart = pc->p;
2159 pc->tline = pc->linenr;
2160 pc->tt = JIM_TT_STR;
2162 while (pc->len) {
2163 if (isspace(UCHAR(*pc->p))) {
2164 pc->tend = pc->p - 1;
2165 return JIM_OK;
2167 if (*pc->p == '\\') {
2168 if (--pc->len == 0) {
2169 /* Trailing backslash */
2170 pc->tend = pc->p;
2171 return JIM_OK;
2173 pc->tt = JIM_TT_ESC;
2174 pc->p++;
2176 pc->p++;
2177 pc->len--;
2179 pc->tend = pc->p - 1;
2180 return JIM_OK;
2183 /* -----------------------------------------------------------------------------
2184 * Jim_Obj related functions
2185 * ---------------------------------------------------------------------------*/
2187 /* Return a new initialized object. */
2188 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2190 Jim_Obj *objPtr;
2192 /* -- Check if there are objects in the free list -- */
2193 if (interp->freeList != NULL) {
2194 /* -- Unlink the object from the free list -- */
2195 objPtr = interp->freeList;
2196 interp->freeList = objPtr->nextObjPtr;
2198 else {
2199 /* -- No ready to use objects: allocate a new one -- */
2200 objPtr = Jim_Alloc(sizeof(*objPtr));
2203 /* Object is returned with refCount of 0. Every
2204 * kind of GC implemented should take care to don't try
2205 * to scan objects with refCount == 0. */
2206 objPtr->refCount = 0;
2207 /* All the other fields are left not initialized to save time.
2208 * The caller will probably want to set them to the right
2209 * value anyway. */
2211 /* -- Put the object into the live list -- */
2212 objPtr->prevObjPtr = NULL;
2213 objPtr->nextObjPtr = interp->liveList;
2214 if (interp->liveList)
2215 interp->liveList->prevObjPtr = objPtr;
2216 interp->liveList = objPtr;
2218 return objPtr;
2221 /* Free an object. Actually objects are never freed, but
2222 * just moved to the free objects list, where they will be
2223 * reused by Jim_NewObj(). */
2224 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2226 /* Check if the object was already freed, panic. */
2227 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2228 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2230 /* Free the internal representation */
2231 Jim_FreeIntRep(interp, objPtr);
2232 /* Free the string representation */
2233 if (objPtr->bytes != NULL) {
2234 if (objPtr->bytes != JimEmptyStringRep)
2235 Jim_Free(objPtr->bytes);
2237 /* Unlink the object from the live objects list */
2238 if (objPtr->prevObjPtr)
2239 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2240 if (objPtr->nextObjPtr)
2241 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2242 if (interp->liveList == objPtr)
2243 interp->liveList = objPtr->nextObjPtr;
2244 #ifdef JIM_DISABLE_OBJECT_POOL
2245 Jim_Free(objPtr);
2246 #else
2247 /* Link the object into the free objects list */
2248 objPtr->prevObjPtr = NULL;
2249 objPtr->nextObjPtr = interp->freeList;
2250 if (interp->freeList)
2251 interp->freeList->prevObjPtr = objPtr;
2252 interp->freeList = objPtr;
2253 objPtr->refCount = -1;
2254 #endif
2257 /* Invalidate the string representation of an object. */
2258 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2260 if (objPtr->bytes != NULL) {
2261 if (objPtr->bytes != JimEmptyStringRep)
2262 Jim_Free(objPtr->bytes);
2264 objPtr->bytes = NULL;
2267 /* Duplicate an object. The returned object has refcount = 0. */
2268 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2270 Jim_Obj *dupPtr;
2272 dupPtr = Jim_NewObj(interp);
2273 if (objPtr->bytes == NULL) {
2274 /* Object does not have a valid string representation. */
2275 dupPtr->bytes = NULL;
2277 else if (objPtr->length == 0) {
2278 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2279 dupPtr->bytes = JimEmptyStringRep;
2280 dupPtr->length = 0;
2281 dupPtr->typePtr = NULL;
2282 return dupPtr;
2284 else {
2285 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2286 dupPtr->length = objPtr->length;
2287 /* Copy the null byte too */
2288 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2291 /* By default, the new object has the same type as the old object */
2292 dupPtr->typePtr = objPtr->typePtr;
2293 if (objPtr->typePtr != NULL) {
2294 if (objPtr->typePtr->dupIntRepProc == NULL) {
2295 dupPtr->internalRep = objPtr->internalRep;
2297 else {
2298 /* The dup proc may set a different type, e.g. NULL */
2299 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2302 return dupPtr;
2305 /* Return the string representation for objPtr. If the object
2306 * string representation is invalid, calls the method to create
2307 * a new one starting from the internal representation of the object. */
2308 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2310 if (objPtr->bytes == NULL) {
2311 /* Invalid string repr. Generate it. */
2312 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2313 objPtr->typePtr->updateStringProc(objPtr);
2315 if (lenPtr)
2316 *lenPtr = objPtr->length;
2317 return objPtr->bytes;
2320 /* Just returns the length of the object's string rep */
2321 int Jim_Length(Jim_Obj *objPtr)
2323 if (objPtr->bytes == NULL) {
2324 /* Invalid string repr. Generate it. */
2325 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2326 objPtr->typePtr->updateStringProc(objPtr);
2328 return objPtr->length;
2331 /* Just returns the length of the object's string rep */
2332 const char *Jim_String(Jim_Obj *objPtr)
2334 if (objPtr->bytes == NULL) {
2335 /* Invalid string repr. Generate it. */
2336 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2337 objPtr->typePtr->updateStringProc(objPtr);
2339 return objPtr->bytes;
2342 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2343 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2345 static const Jim_ObjType dictSubstObjType = {
2346 "dict-substitution",
2347 FreeDictSubstInternalRep,
2348 DupDictSubstInternalRep,
2349 NULL,
2350 JIM_TYPE_NONE,
2353 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2355 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2358 static const Jim_ObjType interpolatedObjType = {
2359 "interpolated",
2360 FreeInterpolatedInternalRep,
2361 NULL,
2362 NULL,
2363 JIM_TYPE_NONE,
2366 /* -----------------------------------------------------------------------------
2367 * String Object
2368 * ---------------------------------------------------------------------------*/
2369 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2370 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2372 static const Jim_ObjType stringObjType = {
2373 "string",
2374 NULL,
2375 DupStringInternalRep,
2376 NULL,
2377 JIM_TYPE_REFERENCES,
2380 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2382 JIM_NOTUSED(interp);
2384 /* This is a bit subtle: the only caller of this function
2385 * should be Jim_DuplicateObj(), that will copy the
2386 * string representaion. After the copy, the duplicated
2387 * object will not have more room in teh buffer than
2388 * srcPtr->length bytes. So we just set it to length. */
2389 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2391 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2394 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2396 if (objPtr->typePtr != &stringObjType) {
2397 /* Get a fresh string representation. */
2398 if (objPtr->bytes == NULL) {
2399 /* Invalid string repr. Generate it. */
2400 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2401 objPtr->typePtr->updateStringProc(objPtr);
2403 /* Free any other internal representation. */
2404 Jim_FreeIntRep(interp, objPtr);
2405 /* Set it as string, i.e. just set the maxLength field. */
2406 objPtr->typePtr = &stringObjType;
2407 objPtr->internalRep.strValue.maxLength = objPtr->length;
2408 /* Don't know the utf-8 length yet */
2409 objPtr->internalRep.strValue.charLength = -1;
2411 return JIM_OK;
2415 * Returns the length of the object string in chars, not bytes.
2417 * These may be different for a utf-8 string.
2419 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2421 #ifdef JIM_UTF8
2422 SetStringFromAny(interp, objPtr);
2424 if (objPtr->internalRep.strValue.charLength < 0) {
2425 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2427 return objPtr->internalRep.strValue.charLength;
2428 #else
2429 return Jim_Length(objPtr);
2430 #endif
2433 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2434 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2436 Jim_Obj *objPtr = Jim_NewObj(interp);
2438 /* Need to find out how many bytes the string requires */
2439 if (len == -1)
2440 len = strlen(s);
2441 /* Alloc/Set the string rep. */
2442 if (len == 0) {
2443 objPtr->bytes = JimEmptyStringRep;
2444 objPtr->length = 0;
2446 else {
2447 objPtr->bytes = Jim_Alloc(len + 1);
2448 objPtr->length = len;
2449 memcpy(objPtr->bytes, s, len);
2450 objPtr->bytes[len] = '\0';
2453 /* No typePtr field for the vanilla string object. */
2454 objPtr->typePtr = NULL;
2455 return objPtr;
2458 /* charlen is in characters -- see also Jim_NewStringObj() */
2459 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2461 #ifdef JIM_UTF8
2462 /* Need to find out how many bytes the string requires */
2463 int bytelen = utf8_index(s, charlen);
2465 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2467 /* Remember the utf8 length, so set the type */
2468 objPtr->typePtr = &stringObjType;
2469 objPtr->internalRep.strValue.maxLength = bytelen;
2470 objPtr->internalRep.strValue.charLength = charlen;
2472 return objPtr;
2473 #else
2474 return Jim_NewStringObj(interp, s, charlen);
2475 #endif
2478 /* This version does not try to duplicate the 's' pointer, but
2479 * use it directly. */
2480 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2482 Jim_Obj *objPtr = Jim_NewObj(interp);
2484 objPtr->bytes = s;
2485 objPtr->length = len == -1 ? strlen(s) : len;
2486 objPtr->typePtr = NULL;
2487 return objPtr;
2490 /* Low-level string append. Use it only against objects
2491 * of type "string". */
2492 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2494 int needlen;
2496 if (len == -1)
2497 len = strlen(str);
2498 needlen = objPtr->length + len;
2499 if (objPtr->internalRep.strValue.maxLength < needlen ||
2500 objPtr->internalRep.strValue.maxLength == 0) {
2501 needlen *= 2;
2502 /* Inefficient to malloc() for less than 8 bytes */
2503 if (needlen < 7) {
2504 needlen = 7;
2506 if (objPtr->bytes == JimEmptyStringRep) {
2507 objPtr->bytes = Jim_Alloc(needlen + 1);
2509 else {
2510 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2512 objPtr->internalRep.strValue.maxLength = needlen;
2514 memcpy(objPtr->bytes + objPtr->length, str, len);
2515 objPtr->bytes[objPtr->length + len] = '\0';
2516 if (objPtr->internalRep.strValue.charLength >= 0) {
2517 /* Update the utf-8 char length */
2518 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2520 objPtr->length += len;
2523 /* Higher level API to append strings to objects. */
2524 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2526 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2527 SetStringFromAny(interp, objPtr);
2528 StringAppendString(objPtr, str, len);
2531 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2533 int len;
2534 const char *str;
2536 str = Jim_GetString(appendObjPtr, &len);
2537 Jim_AppendString(interp, objPtr, str, len);
2540 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2542 va_list ap;
2544 SetStringFromAny(interp, objPtr);
2545 va_start(ap, objPtr);
2546 while (1) {
2547 char *s = va_arg(ap, char *);
2549 if (s == NULL)
2550 break;
2551 Jim_AppendString(interp, objPtr, s, -1);
2553 va_end(ap);
2556 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2558 const char *aStr, *bStr;
2559 int aLen, bLen;
2561 if (aObjPtr == bObjPtr)
2562 return 1;
2563 aStr = Jim_GetString(aObjPtr, &aLen);
2564 bStr = Jim_GetString(bObjPtr, &bLen);
2565 if (aLen != bLen)
2566 return 0;
2567 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2570 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2572 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2575 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2577 int l1, l2;
2578 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2579 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2581 if (nocase) {
2582 /* Do a character compare for nocase */
2583 return JimStringCompareLen(s1, s2, -1, nocase);
2585 return JimStringCompare(s1, l1, s2, l2);
2589 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2591 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2593 const char *s1 = Jim_String(firstObjPtr);
2594 const char *s2 = Jim_String(secondObjPtr);
2596 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2599 /* Convert a range, as returned by Jim_GetRange(), into
2600 * an absolute index into an object of the specified length.
2601 * This function may return negative values, or values
2602 * bigger or equal to the length of the list if the index
2603 * is out of range. */
2604 static int JimRelToAbsIndex(int len, int idx)
2606 if (idx < 0)
2607 return len + idx;
2608 return idx;
2611 /* Convert a pair of index (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2612 * into form suitable for implementation of commands like [string range] and [lrange].
2614 * The resulting range is guaranteed to address valid elements of
2615 * the structure.
2618 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2620 int rangeLen;
2622 if (*firstPtr > *lastPtr) {
2623 rangeLen = 0;
2625 else {
2626 rangeLen = *lastPtr - *firstPtr + 1;
2627 if (rangeLen) {
2628 if (*firstPtr < 0) {
2629 rangeLen += *firstPtr;
2630 *firstPtr = 0;
2632 if (*lastPtr >= len) {
2633 rangeLen -= (*lastPtr - (len - 1));
2634 *lastPtr = len - 1;
2638 if (rangeLen < 0)
2639 rangeLen = 0;
2641 *rangeLenPtr = rangeLen;
2644 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2645 int len, int *first, int *last, int *range)
2647 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2648 return JIM_ERR;
2650 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2651 return JIM_ERR;
2653 *first = JimRelToAbsIndex(len, *first);
2654 *last = JimRelToAbsIndex(len, *last);
2655 JimRelToAbsRange(len, first, last, range);
2656 return JIM_OK;
2659 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2660 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2662 int first, last;
2663 const char *str;
2664 int rangeLen;
2665 int bytelen;
2667 str = Jim_GetString(strObjPtr, &bytelen);
2669 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2670 return NULL;
2673 if (first == 0 && rangeLen == bytelen) {
2674 return strObjPtr;
2676 return Jim_NewStringObj(interp, str + first, rangeLen);
2679 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2680 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2682 #ifdef JIM_UTF8
2683 int first, last;
2684 const char *str;
2685 int len, rangeLen;
2686 int bytelen;
2688 str = Jim_GetString(strObjPtr, &bytelen);
2689 len = Jim_Utf8Length(interp, strObjPtr);
2691 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2692 return NULL;
2695 if (first == 0 && rangeLen == len) {
2696 return strObjPtr;
2698 if (len == bytelen) {
2699 /* ASCII optimisation */
2700 return Jim_NewStringObj(interp, str + first, rangeLen);
2702 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2703 #else
2704 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2705 #endif
2708 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2709 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2711 int first, last;
2712 const char *str;
2713 int len, rangeLen;
2714 Jim_Obj *objPtr;
2716 len = Jim_Utf8Length(interp, strObjPtr);
2718 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2719 return NULL;
2722 if (last < first) {
2723 return strObjPtr;
2726 str = Jim_String(strObjPtr);
2728 /* Before part */
2729 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2731 /* Replacement */
2732 if (newStrObj) {
2733 Jim_AppendObj(interp, objPtr, newStrObj);
2736 /* After part */
2737 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2739 return objPtr;
2742 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2744 while (*str) {
2745 int c;
2746 str += utf8_tounicode(str, &c);
2747 dest += utf8_fromunicode(dest, uc ? utf8_upper(c) : utf8_lower(c));
2749 *dest = 0;
2752 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2754 char *buf;
2755 int len;
2756 const char *str;
2758 SetStringFromAny(interp, strObjPtr);
2760 str = Jim_GetString(strObjPtr, &len);
2762 #ifdef JIM_UTF8
2763 /* Case mapping can change the utf-8 length of the string.
2764 * But at worst it will be by one extra byte per char
2766 len *= 2;
2767 #endif
2768 buf = Jim_Alloc(len + 1);
2769 JimStrCopyUpperLower(buf, str, 0);
2770 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2773 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2775 char *buf;
2776 const char *str;
2777 int len;
2779 if (strObjPtr->typePtr != &stringObjType) {
2780 SetStringFromAny(interp, strObjPtr);
2783 str = Jim_GetString(strObjPtr, &len);
2785 #ifdef JIM_UTF8
2786 /* Case mapping can change the utf-8 length of the string.
2787 * But at worst it will be by one extra byte per char
2789 len *= 2;
2790 #endif
2791 buf = Jim_Alloc(len + 1);
2792 JimStrCopyUpperLower(buf, str, 1);
2793 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2796 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2798 char *buf, *p;
2799 int len;
2800 int c;
2801 const char *str;
2803 str = Jim_GetString(strObjPtr, &len);
2804 if (len == 0) {
2805 return strObjPtr;
2807 #ifdef JIM_UTF8
2808 /* Case mapping can change the utf-8 length of the string.
2809 * But at worst it will be by one extra byte per char
2811 len *= 2;
2812 #endif
2813 buf = p = Jim_Alloc(len + 1);
2815 str += utf8_tounicode(str, &c);
2816 p += utf8_fromunicode(p, utf8_title(c));
2818 JimStrCopyUpperLower(p, str, 0);
2820 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2823 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2824 * for unicode character 'c'.
2825 * Returns the position if found or NULL if not
2827 static const char *utf8_memchr(const char *str, int len, int c)
2829 #ifdef JIM_UTF8
2830 while (len) {
2831 int sc;
2832 int n = utf8_tounicode(str, &sc);
2833 if (sc == c) {
2834 return str;
2836 str += n;
2837 len -= n;
2839 return NULL;
2840 #else
2841 return memchr(str, c, len);
2842 #endif
2846 * Searches for the first non-trim char in string (str, len)
2848 * If none is found, returns just past the last char.
2850 * Lengths are in bytes.
2852 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2854 while (len) {
2855 int c;
2856 int n = utf8_tounicode(str, &c);
2858 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2859 /* Not a trim char, so stop */
2860 break;
2862 str += n;
2863 len -= n;
2865 return str;
2869 * Searches backwards for a non-trim char in string (str, len).
2871 * Returns a pointer to just after the non-trim char, or NULL if not found.
2873 * Lengths are in bytes.
2875 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2877 str += len;
2879 while (len) {
2880 int c;
2881 int n = utf8_prev_len(str, len);
2883 len -= n;
2884 str -= n;
2886 n = utf8_tounicode(str, &c);
2888 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2889 return str + n;
2893 return NULL;
2896 static const char default_trim_chars[] = " \t\n\r";
2897 /* sizeof() here includes the null byte */
2898 static int default_trim_chars_len = sizeof(default_trim_chars);
2900 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2902 int len;
2903 const char *str = Jim_GetString(strObjPtr, &len);
2904 const char *trimchars = default_trim_chars;
2905 int trimcharslen = default_trim_chars_len;
2906 const char *newstr;
2908 if (trimcharsObjPtr) {
2909 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2912 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2913 if (newstr == str) {
2914 return strObjPtr;
2917 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2920 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2922 int len;
2923 const char *trimchars = default_trim_chars;
2924 int trimcharslen = default_trim_chars_len;
2925 const char *nontrim;
2927 if (trimcharsObjPtr) {
2928 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2931 SetStringFromAny(interp, strObjPtr);
2933 len = Jim_Length(strObjPtr);
2934 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2936 if (nontrim == NULL) {
2937 /* All trim, so return a zero-length string */
2938 return Jim_NewEmptyStringObj(interp);
2940 if (nontrim == strObjPtr->bytes + len) {
2941 return strObjPtr;
2944 if (Jim_IsShared(strObjPtr)) {
2945 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2947 else {
2948 /* Can modify this string in place */
2949 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2950 strObjPtr->length = (nontrim - strObjPtr->bytes);
2953 return strObjPtr;
2956 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2958 /* First trim left. */
2959 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2961 /* Now trim right */
2962 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2964 if (objPtr != strObjPtr) {
2965 /* Note that we don't want this object to be leaked */
2966 Jim_IncrRefCount(objPtr);
2967 Jim_DecrRefCount(interp, objPtr);
2970 return strObjPtr;
2974 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2976 static const char * const strclassnames[] = {
2977 "integer", "alpha", "alnum", "ascii", "digit",
2978 "double", "lower", "upper", "space", "xdigit",
2979 "control", "print", "graph", "punct",
2980 NULL
2982 enum {
2983 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2984 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2985 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2987 int strclass;
2988 int len;
2989 int i;
2990 const char *str;
2991 int (*isclassfunc)(int c) = NULL;
2993 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2994 return JIM_ERR;
2997 str = Jim_GetString(strObjPtr, &len);
2998 if (len == 0) {
2999 Jim_SetResultInt(interp, !strict);
3000 return JIM_OK;
3003 switch (strclass) {
3004 case STR_IS_INTEGER:
3006 jim_wide w;
3007 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3008 return JIM_OK;
3011 case STR_IS_DOUBLE:
3013 double d;
3014 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3015 return JIM_OK;
3018 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3019 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3020 case STR_IS_ASCII: isclassfunc = isascii; break;
3021 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3022 case STR_IS_LOWER: isclassfunc = islower; break;
3023 case STR_IS_UPPER: isclassfunc = isupper; break;
3024 case STR_IS_SPACE: isclassfunc = isspace; break;
3025 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3026 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3027 case STR_IS_PRINT: isclassfunc = isprint; break;
3028 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3029 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3030 default:
3031 return JIM_ERR;
3034 for (i = 0; i < len; i++) {
3035 if (!isclassfunc(str[i])) {
3036 Jim_SetResultInt(interp, 0);
3037 return JIM_OK;
3040 Jim_SetResultInt(interp, 1);
3041 return JIM_OK;
3044 /* -----------------------------------------------------------------------------
3045 * Compared String Object
3046 * ---------------------------------------------------------------------------*/
3048 /* This is strange object that allows to compare a C literal string
3049 * with a Jim object in very short time if the same comparison is done
3050 * multiple times. For example every time the [if] command is executed,
3051 * Jim has to check if a given argument is "else". This comparions if
3052 * the code has no errors are true most of the times, so we can cache
3053 * inside the object the pointer of the string of the last matching
3054 * comparison. Because most C compilers perform literal sharing,
3055 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3056 * this works pretty well even if comparisons are at different places
3057 * inside the C code. */
3059 static const Jim_ObjType comparedStringObjType = {
3060 "compared-string",
3061 NULL,
3062 NULL,
3063 NULL,
3064 JIM_TYPE_REFERENCES,
3067 /* The only way this object is exposed to the API is via the following
3068 * function. Returns true if the string and the object string repr.
3069 * are the same, otherwise zero is returned.
3071 * Note: this isn't binary safe, but it hardly needs to be.*/
3072 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3074 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
3075 return 1;
3076 else {
3077 const char *objStr = Jim_String(objPtr);
3079 if (strcmp(str, objStr) != 0)
3080 return 0;
3081 if (objPtr->typePtr != &comparedStringObjType) {
3082 Jim_FreeIntRep(interp, objPtr);
3083 objPtr->typePtr = &comparedStringObjType;
3085 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3086 return 1;
3090 static int qsortCompareStringPointers(const void *a, const void *b)
3092 char *const *sa = (char *const *)a;
3093 char *const *sb = (char *const *)b;
3095 return strcmp(*sa, *sb);
3099 /* -----------------------------------------------------------------------------
3100 * Source Object
3102 * This object is just a string from the language point of view, but
3103 * in the internal representation it contains the filename and line number
3104 * where this given token was read. This information is used by
3105 * Jim_EvalObj() if the object passed happens to be of type "source".
3107 * This allows to propagate the information about line numbers and file
3108 * names and give error messages with absolute line numbers.
3110 * Note that this object uses shared strings for filenames, and the
3111 * pointer to the filename together with the line number is taken into
3112 * the space for the "inline" internal representation of the Jim_Object,
3113 * so there is almost memory zero-overhead.
3115 * Also the object will be converted to something else if the given
3116 * token it represents in the source file is not something to be
3117 * evaluated (not a script), and will be specialized in some other way,
3118 * so the time overhead is also null.
3119 * ---------------------------------------------------------------------------*/
3121 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3122 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3124 static const Jim_ObjType sourceObjType = {
3125 "source",
3126 FreeSourceInternalRep,
3127 DupSourceInternalRep,
3128 NULL,
3129 JIM_TYPE_REFERENCES,
3132 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3134 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3137 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3139 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3140 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3143 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3144 Jim_Obj *fileNameObj, int lineNumber)
3146 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3147 JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
3148 Jim_IncrRefCount(fileNameObj);
3149 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3150 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3151 objPtr->typePtr = &sourceObjType;
3154 /* -----------------------------------------------------------------------------
3155 * Script Object
3156 * ---------------------------------------------------------------------------*/
3158 static const Jim_ObjType scriptLineObjType = {
3159 "scriptline",
3160 NULL,
3161 NULL,
3162 NULL,
3166 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3168 Jim_Obj *objPtr;
3170 #ifdef DEBUG_SHOW_SCRIPT
3171 char buf[100];
3172 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3173 objPtr = Jim_NewStringObj(interp, buf, -1);
3174 #else
3175 objPtr = Jim_NewEmptyStringObj(interp);
3176 #endif
3177 objPtr->typePtr = &scriptLineObjType;
3178 objPtr->internalRep.scriptLineValue.argc = argc;
3179 objPtr->internalRep.scriptLineValue.line = line;
3181 return objPtr;
3184 #define JIM_CMDSTRUCT_EXPAND -1
3186 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3187 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3188 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3190 static const Jim_ObjType scriptObjType = {
3191 "script",
3192 FreeScriptInternalRep,
3193 DupScriptInternalRep,
3194 NULL,
3195 JIM_TYPE_REFERENCES,
3198 /* The ScriptToken structure represents every token into a scriptObj.
3199 * Every token contains an associated Jim_Obj that can be specialized
3200 * by commands operating on it. */
3201 typedef struct ScriptToken
3203 int type;
3204 Jim_Obj *objPtr;
3205 } ScriptToken;
3207 /* This is the script object internal representation. An array of
3208 * ScriptToken structures, including a pre-computed representation of the
3209 * command length and arguments.
3211 * For example the script:
3213 * puts hello
3214 * set $i $x$y [foo]BAR
3216 * will produce a ScriptObj with the following Tokens:
3218 * LIN 2
3219 * ESC puts
3220 * ESC hello
3221 * LIN 4
3222 * ESC set
3223 * VAR i
3224 * WRD 2
3225 * VAR x
3226 * VAR y
3227 * WRD 2
3228 * CMD foo
3229 * ESC BAR
3231 * "puts hello" has two args (LIN 2), composed of single tokens.
3232 * (Note that the WRD token is omitted for the common case of a single token.)
3234 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3235 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3237 * The precomputation of the command structure makes Jim_Eval() faster,
3238 * and simpler because there aren't dynamic lengths / allocations.
3240 * -- {expand}/{*} handling --
3242 * Expand is handled in a special way.
3244 * If a "word" begins with {*}, the word token count is -ve.
3246 * For example the command:
3248 * list {*}{a b}
3250 * Will produce the following cmdstruct array:
3252 * LIN 2
3253 * ESC list
3254 * WRD -1
3255 * STR a b
3257 * Note that the 'LIN' token also contains the source information for the
3258 * first word of the line for error reporting purposes
3260 * -- the substFlags field of the structure --
3262 * The scriptObj structure is used to represent both "script" objects
3263 * and "subst" objects. In the second case, the there are no LIN and WRD
3264 * tokens. Instead SEP and EOL tokens are added as-is.
3265 * In addition, the field 'substFlags' is used to represent the flags used to turn
3266 * the string into the internal representation used to perform the
3267 * substitution. If this flags are not what the application requires
3268 * the scriptObj is created again. For example the script:
3270 * subst -nocommands $string
3271 * subst -novariables $string
3273 * Will recreate the internal representation of the $string object
3274 * two times.
3276 typedef struct ScriptObj
3278 int len; /* Length as number of tokens. */
3279 ScriptToken *token; /* Tokens array. */
3280 int substFlags; /* flags used for the compilation of "subst" objects */
3281 int inUse; /* Used to share a ScriptObj. Currently
3282 only used by Jim_EvalObj() as protection against
3283 shimmering of the currently evaluated object. */
3284 Jim_Obj *fileNameObj;
3285 int firstline; /* Line number of the first line */
3286 int linenr; /* Line number of the current line */
3287 } ScriptObj;
3289 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3291 int i;
3292 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3294 script->inUse--;
3295 if (script->inUse != 0)
3296 return;
3297 for (i = 0; i < script->len; i++) {
3298 Jim_DecrRefCount(interp, script->token[i].objPtr);
3300 Jim_Free(script->token);
3301 Jim_DecrRefCount(interp, script->fileNameObj);
3302 Jim_Free(script);
3305 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3307 JIM_NOTUSED(interp);
3308 JIM_NOTUSED(srcPtr);
3310 /* Just returns an simple string. */
3311 dupPtr->typePtr = NULL;
3314 /* A simple parser token.
3315 * All the simple tokens for the script point into the same script string rep.
3317 typedef struct
3319 const char *token; /* Pointer to the start of the token */
3320 int len; /* Length of this token */
3321 int type; /* Token type */
3322 int line; /* Line number */
3323 } ParseToken;
3325 /* A list of parsed tokens representing a script.
3326 * Tokens are added to this list as the script is parsed.
3327 * It grows as needed.
3329 typedef struct
3331 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3332 ParseToken *list; /* Array of tokens */
3333 int size; /* Current size of the list */
3334 int count; /* Number of entries used */
3335 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3336 } ParseTokenList;
3338 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3340 tokenlist->list = tokenlist->static_list;
3341 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3342 tokenlist->count = 0;
3345 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3347 if (tokenlist->list != tokenlist->static_list) {
3348 Jim_Free(tokenlist->list);
3353 * Adds the new token to the tokenlist.
3354 * The token has the given length, type and line number.
3355 * The token list is resized as necessary.
3357 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3358 int line)
3360 ParseToken *t;
3362 if (tokenlist->count == tokenlist->size) {
3363 /* Resize the list */
3364 tokenlist->size *= 2;
3365 if (tokenlist->list != tokenlist->static_list) {
3366 tokenlist->list =
3367 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3369 else {
3370 /* The list needs to become allocated */
3371 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3372 memcpy(tokenlist->list, tokenlist->static_list,
3373 tokenlist->count * sizeof(*tokenlist->list));
3376 t = &tokenlist->list[tokenlist->count++];
3377 t->token = token;
3378 t->len = len;
3379 t->type = type;
3380 t->line = line;
3383 /* Counts the number of adjoining non-separator.
3385 * Returns -ve if the first token is the expansion
3386 * operator (in which case the count doesn't include
3387 * that token).
3389 static int JimCountWordTokens(ParseToken *t)
3391 int expand = 1;
3392 int count = 0;
3394 /* Is the first word {*} or {expand}? */
3395 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3396 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3397 /* Create an expand token */
3398 expand = -1;
3399 t++;
3403 /* Now count non-separator words */
3404 while (!TOKEN_IS_SEP(t->type)) {
3405 t++;
3406 count++;
3409 return count * expand;
3413 * Create a script/subst object from the given token.
3415 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3417 Jim_Obj *objPtr;
3419 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3420 /* Convert the backlash escapes . */
3421 int len = t->len;
3422 char *str = Jim_Alloc(len + 1);
3423 len = JimEscape(str, t->token, len);
3424 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3426 else {
3427 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
3428 * with a single space. This is currently not done.
3430 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3432 return objPtr;
3436 * Takes a tokenlist and creates the allocated list of script tokens
3437 * in script->token, of length script->len.
3439 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3440 * as required.
3442 * Also sets script->line to the line number of the first token
3444 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3445 ParseTokenList *tokenlist)
3447 int i;
3448 struct ScriptToken *token;
3449 /* Number of tokens so far for the current command */
3450 int lineargs = 0;
3451 /* This is the first token for the current command */
3452 ScriptToken *linefirst;
3453 int count;
3454 int linenr;
3456 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3457 printf("==== Tokens ====\n");
3458 for (i = 0; i < tokenlist->count; i++) {
3459 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3460 tokenlist->list[i].len, tokenlist->list[i].token);
3462 #endif
3464 /* May need up to one extra script token for each EOL in the worst case */
3465 count = tokenlist->count;
3466 for (i = 0; i < tokenlist->count; i++) {
3467 if (tokenlist->list[i].type == JIM_TT_EOL) {
3468 count++;
3471 linenr = script->firstline = tokenlist->list[0].line;
3473 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3475 /* This is the first token for the current command */
3476 linefirst = token++;
3478 for (i = 0; i < tokenlist->count; ) {
3479 /* Look ahead to find out how many tokens make up the next word */
3480 int wordtokens;
3482 /* Skip any leading separators */
3483 while (tokenlist->list[i].type == JIM_TT_SEP) {
3484 i++;
3487 wordtokens = JimCountWordTokens(tokenlist->list + i);
3489 if (wordtokens == 0) {
3490 /* None, so at end of line */
3491 if (lineargs) {
3492 linefirst->type = JIM_TT_LINE;
3493 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3494 Jim_IncrRefCount(linefirst->objPtr);
3496 /* Reset for new line */
3497 lineargs = 0;
3498 linefirst = token++;
3500 i++;
3501 continue;
3503 else if (wordtokens != 1) {
3504 /* More than 1, or {expand}, so insert a WORD token */
3505 token->type = JIM_TT_WORD;
3506 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3507 Jim_IncrRefCount(token->objPtr);
3508 token++;
3509 if (wordtokens < 0) {
3510 /* Skip the expand token */
3511 i++;
3512 wordtokens = -wordtokens - 1;
3513 lineargs--;
3517 if (lineargs == 0) {
3518 /* First real token on the line, so record the line number */
3519 linenr = tokenlist->list[i].line;
3521 lineargs++;
3523 /* Add each non-separator word token to the line */
3524 while (wordtokens--) {
3525 const ParseToken *t = &tokenlist->list[i++];
3527 token->type = t->type;
3528 token->objPtr = JimMakeScriptObj(interp, t);
3529 Jim_IncrRefCount(token->objPtr);
3531 /* Every object is initially a string, but the
3532 * internal type may be specialized during execution of the
3533 * script. */
3534 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3535 token++;
3539 if (lineargs == 0) {
3540 token--;
3543 script->len = token - script->token;
3545 assert(script->len < count);
3547 #ifdef DEBUG_SHOW_SCRIPT
3548 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3549 for (i = 0; i < script->len; i++) {
3550 const ScriptToken *t = &script->token[i];
3551 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3553 #endif
3558 * Similar to ScriptObjAddTokens(), but for subst objects.
3560 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3561 ParseTokenList *tokenlist)
3563 int i;
3564 struct ScriptToken *token;
3566 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3568 for (i = 0; i < tokenlist->count; i++) {
3569 const ParseToken *t = &tokenlist->list[i];
3571 /* Create a token for 't' */
3572 token->type = t->type;
3573 token->objPtr = JimMakeScriptObj(interp, t);
3574 Jim_IncrRefCount(token->objPtr);
3575 token++;
3578 script->len = i;
3581 /* This method takes the string representation of an object
3582 * as a Tcl script, and generates the pre-parsed internal representation
3583 * of the script. */
3584 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3586 int scriptTextLen;
3587 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3588 struct JimParserCtx parser;
3589 struct ScriptObj *script;
3590 ParseTokenList tokenlist;
3591 int line = 1;
3593 /* Try to get information about filename / line number */
3594 if (objPtr->typePtr == &sourceObjType) {
3595 line = objPtr->internalRep.sourceValue.lineNumber;
3598 /* Initially parse the script into tokens (in tokenlist) */
3599 ScriptTokenListInit(&tokenlist);
3601 JimParserInit(&parser, scriptText, scriptTextLen, line);
3602 while (!parser.eof) {
3603 JimParseScript(&parser);
3604 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3605 parser.tline);
3607 if (result && parser.missing != ' ') {
3608 ScriptTokenListFree(&tokenlist);
3609 result->missing = parser.missing;
3610 result->line = parser.missingline;
3611 return JIM_ERR;
3614 /* Add a final EOF token */
3615 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3617 /* Create the "real" script tokens from the initial token list */
3618 script = Jim_Alloc(sizeof(*script));
3619 memset(script, 0, sizeof(*script));
3620 script->inUse = 1;
3621 if (objPtr->typePtr == &sourceObjType) {
3622 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3624 else {
3625 script->fileNameObj = interp->emptyObj;
3627 Jim_IncrRefCount(script->fileNameObj);
3629 ScriptObjAddTokens(interp, script, &tokenlist);
3631 /* No longer need the token list */
3632 ScriptTokenListFree(&tokenlist);
3634 /* Free the old internal rep and set the new one. */
3635 Jim_FreeIntRep(interp, objPtr);
3636 Jim_SetIntRepPtr(objPtr, script);
3637 objPtr->typePtr = &scriptObjType;
3639 return JIM_OK;
3642 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3644 if (objPtr == interp->emptyObj) {
3645 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3646 objPtr = interp->nullScriptObj;
3649 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3650 SetScriptFromAny(interp, objPtr, NULL);
3652 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3655 /* -----------------------------------------------------------------------------
3656 * Commands
3657 * ---------------------------------------------------------------------------*/
3658 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3660 cmdPtr->inUse++;
3663 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3665 if (--cmdPtr->inUse == 0) {
3666 if (cmdPtr->isproc) {
3667 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3668 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3669 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3670 if (cmdPtr->u.proc.staticVars) {
3671 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3672 Jim_Free(cmdPtr->u.proc.staticVars);
3675 else {
3676 /* native (C) */
3677 if (cmdPtr->u.native.delProc) {
3678 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3681 if (cmdPtr->prevCmd) {
3682 /* Delete any pushed command too */
3683 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3685 Jim_Free(cmdPtr);
3689 /* Variables HashTable Type.
3691 * Keys are dynamic allocated strings, Values are Jim_Var structures.
3694 /* Variables HashTable Type.
3696 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3697 static void JimVariablesHTValDestructor(void *interp, void *val)
3699 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3700 Jim_Free(val);
3703 static const Jim_HashTableType JimVariablesHashTableType = {
3704 JimStringCopyHTHashFunction, /* hash function */
3705 JimStringCopyHTDup, /* key dup */
3706 NULL, /* val dup */
3707 JimStringCopyHTKeyCompare, /* key compare */
3708 JimStringCopyHTKeyDestructor, /* key destructor */
3709 JimVariablesHTValDestructor /* val destructor */
3712 /* Commands HashTable Type.
3714 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3715 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3717 JimDecrCmdRefCount(interp, val);
3720 static const Jim_HashTableType JimCommandsHashTableType = {
3721 JimStringCopyHTHashFunction, /* hash function */
3722 JimStringCopyHTDup, /* key dup */
3723 NULL, /* val dup */
3724 JimStringCopyHTKeyCompare, /* key compare */
3725 JimStringCopyHTKeyDestructor, /* key destructor */
3726 JimCommandsHT_ValDestructor /* val destructor */
3729 /* ------------------------- Commands related functions --------------------- */
3731 #ifdef jim_ext_namespace
3733 * Returns the "unscoped" version of the given namespace.
3734 * That is, the fully qualfied name without the leading ::
3735 * The returned value is either nsObj, or an object with a zero ref count.
3737 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3739 const char *name = Jim_String(nsObj);
3740 if (name[0] == ':' && name[1] == ':') {
3741 /* This command is being defined in the global namespace */
3742 while (*++name == ':') {
3744 nsObj = Jim_NewStringObj(interp, name, -1);
3746 else if (Jim_Length(interp->framePtr->nsObj)) {
3747 /* This command is being defined in a non-global namespace */
3748 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3749 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3751 return nsObj;
3755 * An efficient version of JimQualifyNameObj() where the name is
3756 * available (and needed) as a 'const char *'.
3757 * Avoids creating an object if not necessary.
3758 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3760 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3762 Jim_Obj *objPtr = interp->emptyObj;
3764 if (name[0] == ':' && name[1] == ':') {
3765 /* This command is being defined in the global namespace */
3766 while (*++name == ':') {
3769 else if (Jim_Length(interp->framePtr->nsObj)) {
3770 /* This command is being defined in a non-global namespace */
3771 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3772 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3773 name = Jim_String(objPtr);
3775 Jim_IncrRefCount(objPtr);
3776 *objPtrPtr = objPtr;
3777 return name;
3780 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3782 #else
3783 /* We can be more efficient in the no-namespace case */
3784 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3785 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3786 #endif
3788 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3790 /* It may already exist, so we try to delete the old one.
3791 * Note that reference count means that it won't be deleted yet if
3792 * it exists in the call stack.
3794 * BUT, if 'local' is in force, instead of deleting the existing
3795 * proc, we stash a reference to the old proc here.
3797 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3798 if (he) {
3799 /* There was an old cmd with the same name,
3800 * so this requires a 'proc epoch' update. */
3802 /* If a procedure with the same name didn't exist there is no need
3803 * to increment the 'proc epoch' because creation of a new procedure
3804 * can never affect existing cached commands. We don't do
3805 * negative caching. */
3806 Jim_InterpIncrProcEpoch(interp);
3809 if (he && interp->local) {
3810 /* Push this command over the top of the previous one */
3811 cmd->prevCmd = he->u.val;
3812 he->u.val = cmd;
3814 else {
3815 if (he) {
3816 /* Replace the existing command */
3817 Jim_DeleteHashEntry(&interp->commands, name);
3820 Jim_AddHashEntry(&interp->commands, name, cmd);
3822 return JIM_OK;
3826 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3827 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3829 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3831 /* Store the new details for this command */
3832 memset(cmdPtr, 0, sizeof(*cmdPtr));
3833 cmdPtr->inUse = 1;
3834 cmdPtr->u.native.delProc = delProc;
3835 cmdPtr->u.native.cmdProc = cmdProc;
3836 cmdPtr->u.native.privData = privData;
3838 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3840 return JIM_OK;
3843 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3845 int len, i;
3847 len = Jim_ListLength(interp, staticsListObjPtr);
3848 if (len == 0) {
3849 return JIM_OK;
3852 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3853 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3854 for (i = 0; i < len; i++) {
3855 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3856 Jim_Var *varPtr;
3857 int subLen;
3859 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3860 /* Check if it's composed of two elements. */
3861 subLen = Jim_ListLength(interp, objPtr);
3862 if (subLen == 1 || subLen == 2) {
3863 /* Try to get the variable value from the current
3864 * environment. */
3865 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3866 if (subLen == 1) {
3867 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3868 if (initObjPtr == NULL) {
3869 Jim_SetResultFormatted(interp,
3870 "variable for initialization of static \"%#s\" not found in the local context",
3871 nameObjPtr);
3872 return JIM_ERR;
3875 else {
3876 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3878 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3879 return JIM_ERR;
3882 varPtr = Jim_Alloc(sizeof(*varPtr));
3883 varPtr->objPtr = initObjPtr;
3884 Jim_IncrRefCount(initObjPtr);
3885 varPtr->linkFramePtr = NULL;
3886 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3887 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3888 Jim_SetResultFormatted(interp,
3889 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3890 Jim_DecrRefCount(interp, initObjPtr);
3891 Jim_Free(varPtr);
3892 return JIM_ERR;
3895 else {
3896 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3897 objPtr);
3898 return JIM_ERR;
3901 return JIM_OK;
3904 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3906 #ifdef jim_ext_namespace
3907 if (cmdPtr->isproc) {
3908 /* XXX: Really need JimNamespaceSplit() */
3909 const char *pt = strrchr(cmdname, ':');
3910 if (pt && pt != cmdname && pt[-1] == ':') {
3911 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3912 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3913 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3915 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3916 /* This commands shadows a global command, so a proc epoch update is required */
3917 Jim_InterpIncrProcEpoch(interp);
3921 #endif
3924 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3925 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3927 Jim_Cmd *cmdPtr;
3928 int argListLen;
3929 int i;
3931 argListLen = Jim_ListLength(interp, argListObjPtr);
3933 /* Allocate space for both the command pointer and the arg list */
3934 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3935 memset(cmdPtr, 0, sizeof(*cmdPtr));
3936 cmdPtr->inUse = 1;
3937 cmdPtr->isproc = 1;
3938 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3939 cmdPtr->u.proc.argListLen = argListLen;
3940 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3941 cmdPtr->u.proc.argsPos = -1;
3942 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3943 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
3944 Jim_IncrRefCount(argListObjPtr);
3945 Jim_IncrRefCount(bodyObjPtr);
3946 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3948 /* Create the statics hash table. */
3949 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3950 goto err;
3953 /* Parse the args out into arglist, validating as we go */
3954 /* Examine the argument list for default parameters and 'args' */
3955 for (i = 0; i < argListLen; i++) {
3956 Jim_Obj *argPtr;
3957 Jim_Obj *nameObjPtr;
3958 Jim_Obj *defaultObjPtr;
3959 int len;
3961 /* Examine a parameter */
3962 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3963 len = Jim_ListLength(interp, argPtr);
3964 if (len == 0) {
3965 Jim_SetResultString(interp, "argument with no name", -1);
3966 err:
3967 JimDecrCmdRefCount(interp, cmdPtr);
3968 return NULL;
3970 if (len > 2) {
3971 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
3972 goto err;
3975 if (len == 2) {
3976 /* Optional parameter */
3977 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
3978 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
3980 else {
3981 /* Required parameter */
3982 nameObjPtr = argPtr;
3983 defaultObjPtr = NULL;
3987 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
3988 if (cmdPtr->u.proc.argsPos >= 0) {
3989 Jim_SetResultString(interp, "'args' specified more than once", -1);
3990 goto err;
3992 cmdPtr->u.proc.argsPos = i;
3994 else {
3995 if (len == 2) {
3996 cmdPtr->u.proc.optArity++;
3998 else {
3999 cmdPtr->u.proc.reqArity++;
4003 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4004 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4007 return cmdPtr;
4010 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4012 int ret = JIM_OK;
4013 Jim_Obj *qualifiedNameObj;
4014 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4016 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4017 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4018 ret = JIM_ERR;
4020 else {
4021 Jim_InterpIncrProcEpoch(interp);
4024 JimFreeQualifiedName(interp, qualifiedNameObj);
4026 return ret;
4029 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4031 int ret = JIM_ERR;
4032 Jim_HashEntry *he;
4033 Jim_Cmd *cmdPtr;
4034 Jim_Obj *qualifiedOldNameObj;
4035 Jim_Obj *qualifiedNewNameObj;
4036 const char *fqold;
4037 const char *fqnew;
4039 if (newName[0] == 0) {
4040 return Jim_DeleteCommand(interp, oldName);
4043 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4044 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4046 /* Does it exist? */
4047 he = Jim_FindHashEntry(&interp->commands, fqold);
4048 if (he == NULL) {
4049 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4051 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4052 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4054 else {
4055 /* Add the new name first */
4056 cmdPtr = he->u.val;
4057 JimIncrCmdRefCount(cmdPtr);
4058 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4059 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4061 /* Now remove the old name */
4062 Jim_DeleteHashEntry(&interp->commands, fqold);
4064 /* Increment the epoch */
4065 Jim_InterpIncrProcEpoch(interp);
4067 ret = JIM_OK;
4070 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4071 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4073 return ret;
4076 /* -----------------------------------------------------------------------------
4077 * Command object
4078 * ---------------------------------------------------------------------------*/
4080 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4082 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4085 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4087 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4088 dupPtr->typePtr = srcPtr->typePtr;
4089 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4092 static const Jim_ObjType commandObjType = {
4093 "command",
4094 FreeCommandInternalRep,
4095 DupCommandInternalRep,
4096 NULL,
4097 JIM_TYPE_REFERENCES,
4100 /* This function returns the command structure for the command name
4101 * stored in objPtr. It tries to specialize the objPtr to contain
4102 * a cached info instead to perform the lookup into the hash table
4103 * every time. The information cached may not be uptodate, in such
4104 * a case the lookup is performed and the cache updated.
4106 * Respects the 'upcall' setting
4108 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4110 Jim_Cmd *cmd;
4112 /* In order to be valid, the proc epoch must match and
4113 * the lookup must have occurred in the same namespace
4115 if (objPtr->typePtr != &commandObjType ||
4116 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4117 #ifdef jim_ext_namespace
4118 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4119 #endif
4121 /* Not cached or out of date, so lookup */
4123 /* Do we need to try the local namespace? */
4124 const char *name = Jim_String(objPtr);
4125 Jim_HashEntry *he;
4127 if (name[0] == ':' && name[1] == ':') {
4128 while (*++name == ':') {
4131 #ifdef jim_ext_namespace
4132 else if (Jim_Length(interp->framePtr->nsObj)) {
4133 /* This command is being defined in a non-global namespace */
4134 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4135 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4136 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4137 Jim_FreeNewObj(interp, nameObj);
4138 if (he) {
4139 goto found;
4142 #endif
4144 /* Lookup in the global namespace */
4145 he = Jim_FindHashEntry(&interp->commands, name);
4146 if (he == NULL) {
4147 if (flags & JIM_ERRMSG) {
4148 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4150 return NULL;
4152 #ifdef jim_ext_namespace
4153 found:
4154 #endif
4155 cmd = (Jim_Cmd *)he->u.val;
4157 /* Free the old internal repr and set the new one. */
4158 Jim_FreeIntRep(interp, objPtr);
4159 objPtr->typePtr = &commandObjType;
4160 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4161 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4162 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4163 Jim_IncrRefCount(interp->framePtr->nsObj);
4165 else {
4166 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4168 while (cmd->u.proc.upcall) {
4169 cmd = cmd->prevCmd;
4171 return cmd;
4174 /* -----------------------------------------------------------------------------
4175 * Variables
4176 * ---------------------------------------------------------------------------*/
4178 /* -----------------------------------------------------------------------------
4179 * Variable object
4180 * ---------------------------------------------------------------------------*/
4182 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4184 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4186 static const Jim_ObjType variableObjType = {
4187 "variable",
4188 NULL,
4189 NULL,
4190 NULL,
4191 JIM_TYPE_REFERENCES,
4195 * Check that the name does not contain embedded nulls.
4197 * Variable and procedure names are maniplated as null terminated strings, so
4198 * don't allow names with embedded nulls.
4200 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4202 /* Variable names and proc names can't contain embedded nulls */
4203 if (nameObjPtr->typePtr != &variableObjType) {
4204 int len;
4205 const char *str = Jim_GetString(nameObjPtr, &len);
4206 if (memchr(str, '\0', len)) {
4207 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4208 return JIM_ERR;
4211 return JIM_OK;
4214 /* This method should be called only by the variable API.
4215 * It returns JIM_OK on success (variable already exists),
4216 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4217 * a variable name, but syntax glue for [dict] i.e. the last
4218 * character is ')' */
4219 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4221 const char *varName;
4222 Jim_CallFrame *framePtr;
4223 Jim_HashEntry *he;
4224 int global;
4225 int len;
4227 /* Check if the object is already an uptodate variable */
4228 if (objPtr->typePtr == &variableObjType) {
4229 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4230 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4231 /* nothing to do */
4232 return JIM_OK;
4234 /* Need to re-resolve the variable in the updated callframe */
4236 else if (objPtr->typePtr == &dictSubstObjType) {
4237 return JIM_DICT_SUGAR;
4239 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4240 return JIM_ERR;
4244 varName = Jim_GetString(objPtr, &len);
4246 /* Make sure it's not syntax glue to get/set dict. */
4247 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4248 return JIM_DICT_SUGAR;
4251 if (varName[0] == ':' && varName[1] == ':') {
4252 while (*++varName == ':') {
4254 global = 1;
4255 framePtr = interp->topFramePtr;
4257 else {
4258 global = 0;
4259 framePtr = interp->framePtr;
4262 /* Resolve this name in the variables hash table */
4263 he = Jim_FindHashEntry(&framePtr->vars, varName);
4264 if (he == NULL) {
4265 if (!global && framePtr->staticVars) {
4266 /* Try with static vars. */
4267 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4269 if (he == NULL) {
4270 return JIM_ERR;
4274 /* Free the old internal repr and set the new one. */
4275 Jim_FreeIntRep(interp, objPtr);
4276 objPtr->typePtr = &variableObjType;
4277 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4278 objPtr->internalRep.varValue.varPtr = he->u.val;
4279 objPtr->internalRep.varValue.global = global;
4280 return JIM_OK;
4283 /* -------------------- Variables related functions ------------------------- */
4284 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4285 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4287 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4289 const char *name;
4290 Jim_CallFrame *framePtr;
4291 int global;
4293 /* New variable to create */
4294 Jim_Var *var = Jim_Alloc(sizeof(*var));
4296 var->objPtr = valObjPtr;
4297 Jim_IncrRefCount(valObjPtr);
4298 var->linkFramePtr = NULL;
4300 name = Jim_String(nameObjPtr);
4301 if (name[0] == ':' && name[1] == ':') {
4302 while (*++name == ':') {
4304 framePtr = interp->topFramePtr;
4305 global = 1;
4307 else {
4308 framePtr = interp->framePtr;
4309 global = 0;
4312 /* Insert the new variable */
4313 Jim_AddHashEntry(&framePtr->vars, name, var);
4315 /* Make the object int rep a variable */
4316 Jim_FreeIntRep(interp, nameObjPtr);
4317 nameObjPtr->typePtr = &variableObjType;
4318 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4319 nameObjPtr->internalRep.varValue.varPtr = var;
4320 nameObjPtr->internalRep.varValue.global = global;
4322 return var;
4325 /* For now that's dummy. Variables lookup should be optimized
4326 * in many ways, with caching of lookups, and possibly with
4327 * a table of pre-allocated vars in every CallFrame for local vars.
4328 * All the caching should also have an 'epoch' mechanism similar
4329 * to the one used by Tcl for procedures lookup caching. */
4331 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4333 int err;
4334 Jim_Var *var;
4336 switch (SetVariableFromAny(interp, nameObjPtr)) {
4337 case JIM_DICT_SUGAR:
4338 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4340 case JIM_ERR:
4341 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4342 return JIM_ERR;
4344 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4345 break;
4347 case JIM_OK:
4348 var = nameObjPtr->internalRep.varValue.varPtr;
4349 if (var->linkFramePtr == NULL) {
4350 Jim_IncrRefCount(valObjPtr);
4351 Jim_DecrRefCount(interp, var->objPtr);
4352 var->objPtr = valObjPtr;
4354 else { /* Else handle the link */
4355 Jim_CallFrame *savedCallFrame;
4357 savedCallFrame = interp->framePtr;
4358 interp->framePtr = var->linkFramePtr;
4359 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4360 interp->framePtr = savedCallFrame;
4361 if (err != JIM_OK)
4362 return err;
4365 return JIM_OK;
4368 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4370 Jim_Obj *nameObjPtr;
4371 int result;
4373 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4374 Jim_IncrRefCount(nameObjPtr);
4375 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4376 Jim_DecrRefCount(interp, nameObjPtr);
4377 return result;
4380 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4382 Jim_CallFrame *savedFramePtr;
4383 int result;
4385 savedFramePtr = interp->framePtr;
4386 interp->framePtr = interp->topFramePtr;
4387 result = Jim_SetVariableStr(interp, name, objPtr);
4388 interp->framePtr = savedFramePtr;
4389 return result;
4392 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4394 Jim_Obj *nameObjPtr, *valObjPtr;
4395 int result;
4397 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4398 valObjPtr = Jim_NewStringObj(interp, val, -1);
4399 Jim_IncrRefCount(nameObjPtr);
4400 Jim_IncrRefCount(valObjPtr);
4401 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4402 Jim_DecrRefCount(interp, nameObjPtr);
4403 Jim_DecrRefCount(interp, valObjPtr);
4404 return result;
4407 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4408 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4410 const char *varName;
4411 const char *targetName;
4412 Jim_CallFrame *framePtr;
4413 Jim_Var *varPtr;
4415 /* Check for an existing variable or link */
4416 switch (SetVariableFromAny(interp, nameObjPtr)) {
4417 case JIM_DICT_SUGAR:
4418 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4419 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4420 return JIM_ERR;
4422 case JIM_OK:
4423 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4425 if (varPtr->linkFramePtr == NULL) {
4426 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4427 return JIM_ERR;
4430 /* It exists, but is a link, so first delete the link */
4431 varPtr->linkFramePtr = NULL;
4432 break;
4435 /* Resolve the call frames for both variables */
4436 /* XXX: SetVariableFromAny() already did this! */
4437 varName = Jim_String(nameObjPtr);
4439 if (varName[0] == ':' && varName[1] == ':') {
4440 while (*++varName == ':') {
4442 /* Linking a global var does nothing */
4443 framePtr = interp->topFramePtr;
4445 else {
4446 framePtr = interp->framePtr;
4449 targetName = Jim_String(targetNameObjPtr);
4450 if (targetName[0] == ':' && targetName[1] == ':') {
4451 while (*++targetName == ':') {
4453 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4454 targetCallFrame = interp->topFramePtr;
4456 Jim_IncrRefCount(targetNameObjPtr);
4458 if (framePtr->level < targetCallFrame->level) {
4459 Jim_SetResultFormatted(interp,
4460 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4461 nameObjPtr);
4462 Jim_DecrRefCount(interp, targetNameObjPtr);
4463 return JIM_ERR;
4466 /* Check for cycles. */
4467 if (framePtr == targetCallFrame) {
4468 Jim_Obj *objPtr = targetNameObjPtr;
4470 /* Cycles are only possible with 'uplevel 0' */
4471 while (1) {
4472 if (strcmp(Jim_String(objPtr), varName) == 0) {
4473 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4474 Jim_DecrRefCount(interp, targetNameObjPtr);
4475 return JIM_ERR;
4477 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4478 break;
4479 varPtr = objPtr->internalRep.varValue.varPtr;
4480 if (varPtr->linkFramePtr != targetCallFrame)
4481 break;
4482 objPtr = varPtr->objPtr;
4486 /* Perform the binding */
4487 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4488 /* We are now sure 'nameObjPtr' type is variableObjType */
4489 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4490 Jim_DecrRefCount(interp, targetNameObjPtr);
4491 return JIM_OK;
4494 /* Return the Jim_Obj pointer associated with a variable name,
4495 * or NULL if the variable was not found in the current context.
4496 * The same optimization discussed in the comment to the
4497 * 'SetVariable' function should apply here.
4499 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4500 * in a dictionary which is shared, the array variable value is duplicated first.
4501 * This allows the array element to be updated (e.g. append, lappend) without
4502 * affecting other references to the dictionary.
4504 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4506 switch (SetVariableFromAny(interp, nameObjPtr)) {
4507 case JIM_OK:{
4508 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4510 if (varPtr->linkFramePtr == NULL) {
4511 return varPtr->objPtr;
4513 else {
4514 Jim_Obj *objPtr;
4516 /* The variable is a link? Resolve it. */
4517 Jim_CallFrame *savedCallFrame = interp->framePtr;
4519 interp->framePtr = varPtr->linkFramePtr;
4520 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4521 interp->framePtr = savedCallFrame;
4522 if (objPtr) {
4523 return objPtr;
4525 /* Error, so fall through to the error message */
4528 break;
4530 case JIM_DICT_SUGAR:
4531 /* [dict] syntax sugar. */
4532 return JimDictSugarGet(interp, nameObjPtr, flags);
4534 if (flags & JIM_ERRMSG) {
4535 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4537 return NULL;
4540 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4542 Jim_CallFrame *savedFramePtr;
4543 Jim_Obj *objPtr;
4545 savedFramePtr = interp->framePtr;
4546 interp->framePtr = interp->topFramePtr;
4547 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4548 interp->framePtr = savedFramePtr;
4550 return objPtr;
4553 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4555 Jim_Obj *nameObjPtr, *varObjPtr;
4557 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4558 Jim_IncrRefCount(nameObjPtr);
4559 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4560 Jim_DecrRefCount(interp, nameObjPtr);
4561 return varObjPtr;
4564 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4566 Jim_CallFrame *savedFramePtr;
4567 Jim_Obj *objPtr;
4569 savedFramePtr = interp->framePtr;
4570 interp->framePtr = interp->topFramePtr;
4571 objPtr = Jim_GetVariableStr(interp, name, flags);
4572 interp->framePtr = savedFramePtr;
4574 return objPtr;
4577 /* Unset a variable.
4578 * Note: On success unset invalidates all the variable objects created
4579 * in the current call frame incrementing. */
4580 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4582 Jim_Var *varPtr;
4583 int retval;
4584 Jim_CallFrame *framePtr;
4586 retval = SetVariableFromAny(interp, nameObjPtr);
4587 if (retval == JIM_DICT_SUGAR) {
4588 /* [dict] syntax sugar. */
4589 return JimDictSugarSet(interp, nameObjPtr, NULL);
4591 else if (retval == JIM_OK) {
4592 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4594 /* If it's a link call UnsetVariable recursively */
4595 if (varPtr->linkFramePtr) {
4596 framePtr = interp->framePtr;
4597 interp->framePtr = varPtr->linkFramePtr;
4598 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4599 interp->framePtr = framePtr;
4601 else {
4602 const char *name = Jim_String(nameObjPtr);
4603 if (nameObjPtr->internalRep.varValue.global) {
4604 name += 2;
4605 framePtr = interp->topFramePtr;
4607 else {
4608 framePtr = interp->framePtr;
4611 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4612 if (retval == JIM_OK) {
4613 /* Change the callframe id, invalidating var lookup caching */
4614 JimChangeCallFrameId(interp, framePtr);
4618 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4619 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4621 return retval;
4624 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4626 /* Given a variable name for [dict] operation syntax sugar,
4627 * this function returns two objects, the first with the name
4628 * of the variable to set, and the second with the rispective key.
4629 * For example "foo(bar)" will return objects with string repr. of
4630 * "foo" and "bar".
4632 * The returned objects have refcount = 1. The function can't fail. */
4633 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4634 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4636 const char *str, *p;
4637 int len, keyLen;
4638 Jim_Obj *varObjPtr, *keyObjPtr;
4640 str = Jim_GetString(objPtr, &len);
4642 p = strchr(str, '(');
4643 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4645 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4647 p++;
4648 keyLen = (str + len) - p;
4649 if (str[len - 1] == ')') {
4650 keyLen--;
4653 /* Create the objects with the variable name and key. */
4654 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4656 Jim_IncrRefCount(varObjPtr);
4657 Jim_IncrRefCount(keyObjPtr);
4658 *varPtrPtr = varObjPtr;
4659 *keyPtrPtr = keyObjPtr;
4662 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4663 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4664 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4666 int err;
4668 SetDictSubstFromAny(interp, objPtr);
4670 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4671 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4673 if (err == JIM_OK) {
4674 /* Don't keep an extra ref to the result */
4675 Jim_SetEmptyResult(interp);
4677 else {
4678 if (!valObjPtr) {
4679 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4680 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4681 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4682 objPtr);
4683 return err;
4686 /* Make the error more informative and Tcl-compatible */
4687 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4688 (valObjPtr ? "set" : "unset"), objPtr);
4690 return err;
4694 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4696 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4697 * and stored back to the variable before expansion.
4699 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4700 Jim_Obj *keyObjPtr, int flags)
4702 Jim_Obj *dictObjPtr;
4703 Jim_Obj *resObjPtr = NULL;
4704 int ret;
4706 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4707 if (!dictObjPtr) {
4708 return NULL;
4711 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4712 if (ret != JIM_OK) {
4713 resObjPtr = NULL;
4714 if (ret < 0) {
4715 Jim_SetResultFormatted(interp,
4716 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4718 else {
4719 Jim_SetResultFormatted(interp,
4720 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4723 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4724 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4725 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4726 /* This can probably never happen */
4727 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4729 /* We know that the key exists. Get the result in the now-unshared dictionary */
4730 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4733 return resObjPtr;
4736 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4737 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4739 SetDictSubstFromAny(interp, objPtr);
4741 return JimDictExpandArrayVariable(interp,
4742 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4743 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4746 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4748 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4750 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4751 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4754 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4756 JIM_NOTUSED(interp);
4758 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4759 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4760 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4761 dupPtr->typePtr = &dictSubstObjType;
4764 /* Note: The object *must* be in dict-sugar format */
4765 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4767 if (objPtr->typePtr != &dictSubstObjType) {
4768 Jim_Obj *varObjPtr, *keyObjPtr;
4770 if (objPtr->typePtr == &interpolatedObjType) {
4771 /* An interpolated object in dict-sugar form */
4773 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4774 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4776 Jim_IncrRefCount(varObjPtr);
4777 Jim_IncrRefCount(keyObjPtr);
4779 else {
4780 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4783 Jim_FreeIntRep(interp, objPtr);
4784 objPtr->typePtr = &dictSubstObjType;
4785 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4786 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4790 /* This function is used to expand [dict get] sugar in the form
4791 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4792 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4793 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4794 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4795 * the [dict]ionary contained in variable VARNAME. */
4796 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4798 Jim_Obj *resObjPtr = NULL;
4799 Jim_Obj *substKeyObjPtr = NULL;
4801 SetDictSubstFromAny(interp, objPtr);
4803 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4804 &substKeyObjPtr, JIM_NONE)
4805 != JIM_OK) {
4806 return NULL;
4808 Jim_IncrRefCount(substKeyObjPtr);
4809 resObjPtr =
4810 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4811 substKeyObjPtr, 0);
4812 Jim_DecrRefCount(interp, substKeyObjPtr);
4814 return resObjPtr;
4817 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4819 Jim_Obj *resultObjPtr;
4821 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4822 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4823 resultObjPtr->refCount--;
4824 return resultObjPtr;
4826 return NULL;
4829 /* -----------------------------------------------------------------------------
4830 * CallFrame
4831 * ---------------------------------------------------------------------------*/
4833 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4835 Jim_CallFrame *cf;
4837 if (interp->freeFramesList) {
4838 cf = interp->freeFramesList;
4839 interp->freeFramesList = cf->next;
4841 else {
4842 cf = Jim_Alloc(sizeof(*cf));
4843 cf->vars.table = NULL;
4846 cf->id = interp->callFrameEpoch++;
4847 cf->parent = parent;
4848 cf->level = parent ? parent->level + 1 : 0;
4849 cf->argv = NULL;
4850 cf->argc = 0;
4851 cf->procArgsObjPtr = NULL;
4852 cf->procBodyObjPtr = NULL;
4853 cf->next = NULL;
4854 cf->staticVars = NULL;
4855 cf->localCommands = NULL;
4857 cf->nsObj = nsObj;
4858 Jim_IncrRefCount(nsObj);
4859 if (cf->vars.table == NULL)
4860 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4861 return cf;
4864 /* Used to invalidate every caching related to callframe stability. */
4865 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4867 cf->id = interp->callFrameEpoch++;
4870 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4872 /* Delete any local procs */
4873 if (localCommands) {
4874 Jim_Obj *cmdNameObj;
4876 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4877 Jim_HashEntry *he;
4878 Jim_Obj *fqObjName;
4880 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4882 he = Jim_FindHashEntry(&interp->commands, fqname);
4884 if (he) {
4885 Jim_Cmd *cmd = he->u.val;
4886 if (cmd->prevCmd) {
4887 Jim_Cmd *prevCmd = cmd->prevCmd;
4888 cmd->prevCmd = NULL;
4890 /* Delete the old command */
4891 JimDecrCmdRefCount(interp, cmd);
4893 /* And restore the original */
4894 he->u.val = prevCmd;
4896 else {
4897 Jim_DeleteHashEntry(&interp->commands, fqname);
4898 Jim_InterpIncrProcEpoch(interp);
4901 Jim_DecrRefCount(interp, cmdNameObj);
4902 JimFreeQualifiedName(interp, fqObjName);
4904 Jim_FreeStack(localCommands);
4905 Jim_Free(localCommands);
4907 return JIM_OK;
4911 #define JIM_FCF_NONE 0 /* no flags */
4912 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4913 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4915 if (cf->procArgsObjPtr)
4916 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4917 if (cf->procBodyObjPtr)
4918 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4919 Jim_DecrRefCount(interp, cf->nsObj);
4920 if (!(flags & JIM_FCF_NOHT))
4921 Jim_FreeHashTable(&cf->vars);
4922 else {
4923 int i;
4924 Jim_HashEntry **table = cf->vars.table, *he;
4926 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4927 he = table[i];
4928 while (he != NULL) {
4929 Jim_HashEntry *nextEntry = he->next;
4930 Jim_Var *varPtr = (void *)he->u.val;
4932 Jim_DecrRefCount(interp, varPtr->objPtr);
4933 Jim_Free(he->u.val);
4934 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4935 Jim_Free(he);
4936 table[i] = NULL;
4937 he = nextEntry;
4940 cf->vars.used = 0;
4943 JimDeleteLocalProcs(interp, cf->localCommands);
4945 cf->next = interp->freeFramesList;
4946 interp->freeFramesList = cf;
4951 /* -----------------------------------------------------------------------------
4952 * References
4953 * ---------------------------------------------------------------------------*/
4954 #ifdef JIM_REFERENCES
4956 /* References HashTable Type.
4958 * Keys are unsigned long integers, dynamically allocated for now but in the
4959 * future it's worth to cache this 4 bytes objects. Values are pointers
4960 * to Jim_References. */
4961 static void JimReferencesHTValDestructor(void *interp, void *val)
4963 Jim_Reference *refPtr = (void *)val;
4965 Jim_DecrRefCount(interp, refPtr->objPtr);
4966 if (refPtr->finalizerCmdNamePtr != NULL) {
4967 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4969 Jim_Free(val);
4972 static unsigned int JimReferencesHTHashFunction(const void *key)
4974 /* Only the least significant bits are used. */
4975 const unsigned long *widePtr = key;
4976 unsigned int intValue = (unsigned int)*widePtr;
4978 return Jim_IntHashFunction(intValue);
4981 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
4983 void *copy = Jim_Alloc(sizeof(unsigned long));
4985 JIM_NOTUSED(privdata);
4987 memcpy(copy, key, sizeof(unsigned long));
4988 return copy;
4991 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4993 JIM_NOTUSED(privdata);
4995 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
4998 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5000 JIM_NOTUSED(privdata);
5002 Jim_Free(key);
5005 static const Jim_HashTableType JimReferencesHashTableType = {
5006 JimReferencesHTHashFunction, /* hash function */
5007 JimReferencesHTKeyDup, /* key dup */
5008 NULL, /* val dup */
5009 JimReferencesHTKeyCompare, /* key compare */
5010 JimReferencesHTKeyDestructor, /* key destructor */
5011 JimReferencesHTValDestructor /* val destructor */
5014 /* -----------------------------------------------------------------------------
5015 * Reference object type and References API
5016 * ---------------------------------------------------------------------------*/
5018 /* The string representation of references has two features in order
5019 * to make the GC faster. The first is that every reference starts
5020 * with a non common character '<', in order to make the string matching
5021 * faster. The second is that the reference string rep is 42 characters
5022 * in length, this allows to avoid to check every object with a string
5023 * repr < 42, and usually there aren't many of these objects. */
5025 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5027 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5029 const char *fmt = "<reference.<%s>.%020lu>";
5031 sprintf(buf, fmt, refPtr->tag, id);
5032 return JIM_REFERENCE_SPACE;
5035 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5037 static const Jim_ObjType referenceObjType = {
5038 "reference",
5039 NULL,
5040 NULL,
5041 UpdateStringOfReference,
5042 JIM_TYPE_REFERENCES,
5045 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5047 int len;
5048 char buf[JIM_REFERENCE_SPACE + 1];
5049 Jim_Reference *refPtr;
5051 refPtr = objPtr->internalRep.refValue.refPtr;
5052 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
5053 objPtr->bytes = Jim_Alloc(len + 1);
5054 memcpy(objPtr->bytes, buf, len + 1);
5055 objPtr->length = len;
5058 /* returns true if 'c' is a valid reference tag character.
5059 * i.e. inside the range [_a-zA-Z0-9] */
5060 static int isrefchar(int c)
5062 return (c == '_' || isalnum(c));
5065 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5067 unsigned long value;
5068 int i, len;
5069 const char *str, *start, *end;
5070 char refId[21];
5071 Jim_Reference *refPtr;
5072 Jim_HashEntry *he;
5073 char *endptr;
5075 /* Get the string representation */
5076 str = Jim_GetString(objPtr, &len);
5077 /* Check if it looks like a reference */
5078 if (len < JIM_REFERENCE_SPACE)
5079 goto badformat;
5080 /* Trim spaces */
5081 start = str;
5082 end = str + len - 1;
5083 while (*start == ' ')
5084 start++;
5085 while (*end == ' ' && end > start)
5086 end--;
5087 if (end - start + 1 != JIM_REFERENCE_SPACE)
5088 goto badformat;
5089 /* <reference.<1234567>.%020> */
5090 if (memcmp(start, "<reference.<", 12) != 0)
5091 goto badformat;
5092 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5093 goto badformat;
5094 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5095 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5096 if (!isrefchar(start[12 + i]))
5097 goto badformat;
5099 /* Extract info from the reference. */
5100 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5101 refId[20] = '\0';
5102 /* Try to convert the ID into an unsigned long */
5103 value = strtoul(refId, &endptr, 10);
5104 if (JimCheckConversion(refId, endptr) != JIM_OK)
5105 goto badformat;
5106 /* Check if the reference really exists! */
5107 he = Jim_FindHashEntry(&interp->references, &value);
5108 if (he == NULL) {
5109 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5110 return JIM_ERR;
5112 refPtr = he->u.val;
5113 /* Free the old internal repr and set the new one. */
5114 Jim_FreeIntRep(interp, objPtr);
5115 objPtr->typePtr = &referenceObjType;
5116 objPtr->internalRep.refValue.id = value;
5117 objPtr->internalRep.refValue.refPtr = refPtr;
5118 return JIM_OK;
5120 badformat:
5121 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5122 return JIM_ERR;
5125 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5126 * as finalizer command (or NULL if there is no finalizer).
5127 * The returned reference object has refcount = 0. */
5128 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5130 struct Jim_Reference *refPtr;
5131 unsigned long id;
5132 Jim_Obj *refObjPtr;
5133 const char *tag;
5134 int tagLen, i;
5136 /* Perform the Garbage Collection if needed. */
5137 Jim_CollectIfNeeded(interp);
5139 refPtr = Jim_Alloc(sizeof(*refPtr));
5140 refPtr->objPtr = objPtr;
5141 Jim_IncrRefCount(objPtr);
5142 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5143 if (cmdNamePtr)
5144 Jim_IncrRefCount(cmdNamePtr);
5145 id = interp->referenceNextId++;
5146 Jim_AddHashEntry(&interp->references, &id, refPtr);
5147 refObjPtr = Jim_NewObj(interp);
5148 refObjPtr->typePtr = &referenceObjType;
5149 refObjPtr->bytes = NULL;
5150 refObjPtr->internalRep.refValue.id = id;
5151 refObjPtr->internalRep.refValue.refPtr = refPtr;
5152 interp->referenceNextId++;
5153 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5154 * that does not pass the 'isrefchar' test is replaced with '_' */
5155 tag = Jim_GetString(tagPtr, &tagLen);
5156 if (tagLen > JIM_REFERENCE_TAGLEN)
5157 tagLen = JIM_REFERENCE_TAGLEN;
5158 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5159 if (i < tagLen && isrefchar(tag[i]))
5160 refPtr->tag[i] = tag[i];
5161 else
5162 refPtr->tag[i] = '_';
5164 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5165 return refObjPtr;
5168 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5170 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5171 return NULL;
5172 return objPtr->internalRep.refValue.refPtr;
5175 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5177 Jim_Reference *refPtr;
5179 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5180 return JIM_ERR;
5181 Jim_IncrRefCount(cmdNamePtr);
5182 if (refPtr->finalizerCmdNamePtr)
5183 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5184 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5185 return JIM_OK;
5188 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5190 Jim_Reference *refPtr;
5192 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5193 return JIM_ERR;
5194 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5195 return JIM_OK;
5198 /* -----------------------------------------------------------------------------
5199 * References Garbage Collection
5200 * ---------------------------------------------------------------------------*/
5202 /* This the hash table type for the "MARK" phase of the GC */
5203 static const Jim_HashTableType JimRefMarkHashTableType = {
5204 JimReferencesHTHashFunction, /* hash function */
5205 JimReferencesHTKeyDup, /* key dup */
5206 NULL, /* val dup */
5207 JimReferencesHTKeyCompare, /* key compare */
5208 JimReferencesHTKeyDestructor, /* key destructor */
5209 NULL /* val destructor */
5212 /* Performs the garbage collection. */
5213 int Jim_Collect(Jim_Interp *interp)
5215 int collected = 0;
5216 #ifndef JIM_BOOTSTRAP
5217 Jim_HashTable marks;
5218 Jim_HashTableIterator htiter;
5219 Jim_HashEntry *he;
5220 Jim_Obj *objPtr;
5222 /* Avoid recursive calls */
5223 if (interp->lastCollectId == -1) {
5224 /* Jim_Collect() already running. Return just now. */
5225 return 0;
5227 interp->lastCollectId = -1;
5229 /* Mark all the references found into the 'mark' hash table.
5230 * The references are searched in every live object that
5231 * is of a type that can contain references. */
5232 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5233 objPtr = interp->liveList;
5234 while (objPtr) {
5235 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5236 const char *str, *p;
5237 int len;
5239 /* If the object is of type reference, to get the
5240 * Id is simple... */
5241 if (objPtr->typePtr == &referenceObjType) {
5242 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5243 #ifdef JIM_DEBUG_GC
5244 printf("MARK (reference): %d refcount: %d" JIM_NL,
5245 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5246 #endif
5247 objPtr = objPtr->nextObjPtr;
5248 continue;
5250 /* Get the string repr of the object we want
5251 * to scan for references. */
5252 p = str = Jim_GetString(objPtr, &len);
5253 /* Skip objects too little to contain references. */
5254 if (len < JIM_REFERENCE_SPACE) {
5255 objPtr = objPtr->nextObjPtr;
5256 continue;
5258 /* Extract references from the object string repr. */
5259 while (1) {
5260 int i;
5261 unsigned long id;
5263 if ((p = strstr(p, "<reference.<")) == NULL)
5264 break;
5265 /* Check if it's a valid reference. */
5266 if (len - (p - str) < JIM_REFERENCE_SPACE)
5267 break;
5268 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5269 break;
5270 for (i = 21; i <= 40; i++)
5271 if (!isdigit(UCHAR(p[i])))
5272 break;
5273 /* Get the ID */
5274 id = strtoul(p + 21, NULL, 10);
5276 /* Ok, a reference for the given ID
5277 * was found. Mark it. */
5278 Jim_AddHashEntry(&marks, &id, NULL);
5279 #ifdef JIM_DEBUG_GC
5280 printf("MARK: %d" JIM_NL, (int)id);
5281 #endif
5282 p += JIM_REFERENCE_SPACE;
5285 objPtr = objPtr->nextObjPtr;
5288 /* Run the references hash table to destroy every reference that
5289 * is not referenced outside (not present in the mark HT). */
5290 JimInitHashTableIterator(&interp->references, &htiter);
5291 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5292 const unsigned long *refId;
5293 Jim_Reference *refPtr;
5295 refId = he->key;
5296 /* Check if in the mark phase we encountered
5297 * this reference. */
5298 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5299 #ifdef JIM_DEBUG_GC
5300 printf("COLLECTING %d" JIM_NL, (int)*refId);
5301 #endif
5302 collected++;
5303 /* Drop the reference, but call the
5304 * finalizer first if registered. */
5305 refPtr = he->u.val;
5306 if (refPtr->finalizerCmdNamePtr) {
5307 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5308 Jim_Obj *objv[3], *oldResult;
5310 JimFormatReference(refstr, refPtr, *refId);
5312 objv[0] = refPtr->finalizerCmdNamePtr;
5313 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5314 objv[2] = refPtr->objPtr;
5316 /* Drop the reference itself */
5317 /* Avoid the finaliser being freed here */
5318 Jim_IncrRefCount(objv[0]);
5319 /* Don't remove the reference from the hash table just yet
5320 * since that will free refPtr, and hence refPtr->objPtr
5323 /* Call the finalizer. Errors ignored. */
5324 oldResult = interp->result;
5325 Jim_IncrRefCount(oldResult);
5326 Jim_EvalObjVector(interp, 3, objv);
5327 Jim_SetResult(interp, oldResult);
5328 Jim_DecrRefCount(interp, oldResult);
5329 Jim_DeleteHashEntry(&interp->references, refId);
5331 Jim_DecrRefCount(interp, objv[0]);
5333 else {
5334 Jim_DeleteHashEntry(&interp->references, refId);
5338 Jim_FreeHashTable(&marks);
5339 interp->lastCollectId = interp->referenceNextId;
5340 interp->lastCollectTime = time(NULL);
5341 #endif /* JIM_BOOTSTRAP */
5342 return collected;
5345 #define JIM_COLLECT_ID_PERIOD 5000
5346 #define JIM_COLLECT_TIME_PERIOD 300
5348 void Jim_CollectIfNeeded(Jim_Interp *interp)
5350 unsigned long elapsedId;
5351 int elapsedTime;
5353 elapsedId = interp->referenceNextId - interp->lastCollectId;
5354 elapsedTime = time(NULL) - interp->lastCollectTime;
5357 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5358 Jim_Collect(interp);
5361 #endif
5363 int Jim_IsBigEndian(void)
5365 union {
5366 unsigned short s;
5367 unsigned char c[2];
5368 } uval = {0x0102};
5370 return uval.c[0] == 1;
5373 /* -----------------------------------------------------------------------------
5374 * Interpreter related functions
5375 * ---------------------------------------------------------------------------*/
5377 Jim_Interp *Jim_CreateInterp(void)
5379 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5381 memset(i, 0, sizeof(*i));
5383 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5384 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5385 i->lastCollectTime = time(NULL);
5387 /* Note that we can create objects only after the
5388 * interpreter liveList and freeList pointers are
5389 * initialized to NULL. */
5390 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5391 #ifdef JIM_REFERENCES
5392 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5393 #endif
5394 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5395 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5396 i->emptyObj = Jim_NewEmptyStringObj(i);
5397 i->trueObj = Jim_NewIntObj(i, 1);
5398 i->falseObj = Jim_NewIntObj(i, 0);
5399 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5400 i->errorFileNameObj = i->emptyObj;
5401 i->result = i->emptyObj;
5402 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5403 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5404 i->errorProc = i->emptyObj;
5405 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5406 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5407 Jim_IncrRefCount(i->emptyObj);
5408 Jim_IncrRefCount(i->errorFileNameObj);
5409 Jim_IncrRefCount(i->result);
5410 Jim_IncrRefCount(i->stackTrace);
5411 Jim_IncrRefCount(i->unknown);
5412 Jim_IncrRefCount(i->currentScriptObj);
5413 Jim_IncrRefCount(i->nullScriptObj);
5414 Jim_IncrRefCount(i->errorProc);
5415 Jim_IncrRefCount(i->trueObj);
5416 Jim_IncrRefCount(i->falseObj);
5418 /* Initialize key variables every interpreter should contain */
5419 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5420 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5422 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5423 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5424 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5425 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5426 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5427 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5428 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5430 return i;
5433 void Jim_FreeInterp(Jim_Interp *i)
5435 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5436 Jim_Obj *objPtr, *nextObjPtr;
5438 Jim_DecrRefCount(i, i->emptyObj);
5439 Jim_DecrRefCount(i, i->trueObj);
5440 Jim_DecrRefCount(i, i->falseObj);
5441 Jim_DecrRefCount(i, i->result);
5442 Jim_DecrRefCount(i, i->stackTrace);
5443 Jim_DecrRefCount(i, i->errorProc);
5444 Jim_DecrRefCount(i, i->unknown);
5445 Jim_DecrRefCount(i, i->errorFileNameObj);
5446 Jim_DecrRefCount(i, i->currentScriptObj);
5447 Jim_DecrRefCount(i, i->nullScriptObj);
5448 Jim_FreeHashTable(&i->commands);
5449 #ifdef JIM_REFERENCES
5450 Jim_FreeHashTable(&i->references);
5451 #endif
5452 Jim_FreeHashTable(&i->packages);
5453 Jim_Free(i->prngState);
5454 Jim_FreeHashTable(&i->assocData);
5456 /* Free the call frames list */
5457 while (cf) {
5458 prevcf = cf->parent;
5459 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5460 cf = prevcf;
5462 /* Check that the live object list is empty, otherwise
5463 * there is a memory leak. */
5464 if (i->liveList != NULL) {
5465 objPtr = i->liveList;
5467 printf(JIM_NL "-------------------------------------" JIM_NL);
5468 printf("Objects still in the free list:" JIM_NL);
5469 while (objPtr) {
5470 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5472 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5473 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5474 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5476 else {
5477 printf("%p (%d) %-10s: '%s'" JIM_NL,
5478 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5480 if (objPtr->typePtr == &sourceObjType) {
5481 printf("FILE %s LINE %d" JIM_NL,
5482 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5483 objPtr->internalRep.sourceValue.lineNumber);
5485 objPtr = objPtr->nextObjPtr;
5487 printf("-------------------------------------" JIM_NL JIM_NL);
5488 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5490 /* Free all the freed objects. */
5491 objPtr = i->freeList;
5492 while (objPtr) {
5493 nextObjPtr = objPtr->nextObjPtr;
5494 Jim_Free(objPtr);
5495 objPtr = nextObjPtr;
5497 /* Free cached CallFrame structures */
5498 cf = i->freeFramesList;
5499 while (cf) {
5500 nextcf = cf->next;
5501 if (cf->vars.table != NULL)
5502 Jim_Free(cf->vars.table);
5503 Jim_Free(cf);
5504 cf = nextcf;
5506 #ifdef jim_ext_load
5507 Jim_FreeLoadHandles(i);
5508 #endif
5510 /* Free the interpreter structure. */
5511 Jim_Free(i);
5514 /* Returns the call frame relative to the level represented by
5515 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5517 * This function accepts the 'level' argument in the form
5518 * of the commands [uplevel] and [upvar].
5520 * For a function accepting a relative integer as level suitable
5521 * for implementation of [info level ?level?] check the
5522 * JimGetCallFrameByInteger() function.
5524 * Returns NULL on error.
5526 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5528 long level;
5529 const char *str;
5530 Jim_CallFrame *framePtr;
5532 if (levelObjPtr) {
5533 str = Jim_String(levelObjPtr);
5534 if (str[0] == '#') {
5535 char *endptr;
5537 level = jim_strtol(str + 1, &endptr);
5538 if (str[1] == '\0' || endptr[0] != '\0') {
5539 level = -1;
5542 else {
5543 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5544 level = -1;
5546 else {
5547 /* Convert from a relative to an absolute level */
5548 level = interp->framePtr->level - level;
5552 else {
5553 str = "1"; /* Needed to format the error message. */
5554 level = interp->framePtr->level - 1;
5557 if (level == 0) {
5558 return interp->topFramePtr;
5560 if (level > 0) {
5561 /* Lookup */
5562 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5563 if (framePtr->level == level) {
5564 return framePtr;
5569 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5570 return NULL;
5573 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5574 * as a relative integer like in the [info level ?level?] command.
5576 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5578 long level;
5579 Jim_CallFrame *framePtr;
5581 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5582 if (level <= 0) {
5583 /* Convert from a relative to an absolute level */
5584 level = interp->framePtr->level + level;
5587 if (level == 0) {
5588 return interp->topFramePtr;
5591 /* Lookup */
5592 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5593 if (framePtr->level == level) {
5594 return framePtr;
5599 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5600 return NULL;
5603 static void JimResetStackTrace(Jim_Interp *interp)
5605 Jim_DecrRefCount(interp, interp->stackTrace);
5606 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5607 Jim_IncrRefCount(interp->stackTrace);
5610 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5612 int len;
5614 /* Increment reference first in case these are the same object */
5615 Jim_IncrRefCount(stackTraceObj);
5616 Jim_DecrRefCount(interp, interp->stackTrace);
5617 interp->stackTrace = stackTraceObj;
5618 interp->errorFlag = 1;
5620 /* This is a bit ugly.
5621 * If the filename of the last entry of the stack trace is empty,
5622 * the next stack level should be added.
5624 len = Jim_ListLength(interp, interp->stackTrace);
5625 if (len >= 3) {
5626 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5627 interp->addStackTrace = 1;
5632 /* Returns 1 if the stack trace information was used or 0 if not */
5633 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5634 Jim_Obj *fileNameObj, int linenr)
5636 if (strcmp(procname, "unknown") == 0) {
5637 procname = "";
5639 if (!*procname && !Jim_Length(fileNameObj)) {
5640 /* No useful info here */
5641 return;
5644 if (Jim_IsShared(interp->stackTrace)) {
5645 Jim_DecrRefCount(interp, interp->stackTrace);
5646 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5647 Jim_IncrRefCount(interp->stackTrace);
5650 /* If we have no procname but the previous element did, merge with that frame */
5651 if (!*procname && Jim_Length(fileNameObj)) {
5652 /* Just a filename. Check the previous entry */
5653 int len = Jim_ListLength(interp, interp->stackTrace);
5655 if (len >= 3) {
5656 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5657 if (Jim_Length(objPtr)) {
5658 /* Yes, the previous level had procname */
5659 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5660 if (Jim_Length(objPtr) == 0) {
5661 /* But no filename, so merge the new info with that frame */
5662 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5663 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5664 return;
5670 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5671 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5672 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5675 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5676 void *data)
5678 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5680 assocEntryPtr->delProc = delProc;
5681 assocEntryPtr->data = data;
5682 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5685 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5687 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5689 if (entryPtr != NULL) {
5690 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5692 return assocEntryPtr->data;
5694 return NULL;
5697 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5699 return Jim_DeleteHashEntry(&interp->assocData, key);
5702 int Jim_GetExitCode(Jim_Interp *interp)
5704 return interp->exitCode;
5707 /* -----------------------------------------------------------------------------
5708 * Integer object
5709 * ---------------------------------------------------------------------------*/
5710 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5711 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5713 static const Jim_ObjType intObjType = {
5714 "int",
5715 NULL,
5716 NULL,
5717 UpdateStringOfInt,
5718 JIM_TYPE_NONE,
5721 /* A coerced double is closer to an int than a double.
5722 * It is an int value temporarily masquerading as a double value.
5723 * i.e. it has the same string value as an int and Jim_GetWide()
5724 * succeeds, but also Jim_GetDouble() returns the value directly.
5726 static const Jim_ObjType coercedDoubleObjType = {
5727 "coerced-double",
5728 NULL,
5729 NULL,
5730 UpdateStringOfInt,
5731 JIM_TYPE_NONE,
5735 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5737 int len;
5738 char buf[JIM_INTEGER_SPACE + 1];
5740 len = JimWideToString(buf, JimWideValue(objPtr));
5741 objPtr->bytes = Jim_Alloc(len + 1);
5742 memcpy(objPtr->bytes, buf, len + 1);
5743 objPtr->length = len;
5746 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5748 jim_wide wideValue;
5749 const char *str;
5751 if (objPtr->typePtr == &coercedDoubleObjType) {
5752 /* Simple switcheroo */
5753 objPtr->typePtr = &intObjType;
5754 return JIM_OK;
5757 /* Get the string representation */
5758 str = Jim_String(objPtr);
5759 /* Try to convert into a jim_wide */
5760 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5761 if (flags & JIM_ERRMSG) {
5762 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5764 return JIM_ERR;
5766 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5767 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5768 return JIM_ERR;
5770 /* Free the old internal repr and set the new one. */
5771 Jim_FreeIntRep(interp, objPtr);
5772 objPtr->typePtr = &intObjType;
5773 objPtr->internalRep.wideValue = wideValue;
5774 return JIM_OK;
5777 #ifdef JIM_OPTIMIZATION
5778 static int JimIsWide(Jim_Obj *objPtr)
5780 return objPtr->typePtr == &intObjType;
5782 #endif
5784 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5786 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5787 return JIM_ERR;
5788 *widePtr = JimWideValue(objPtr);
5789 return JIM_OK;
5792 /* Get a wide but does not set an error if the format is bad. */
5793 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5795 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5796 return JIM_ERR;
5797 *widePtr = JimWideValue(objPtr);
5798 return JIM_OK;
5801 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5803 jim_wide wideValue;
5804 int retval;
5806 retval = Jim_GetWide(interp, objPtr, &wideValue);
5807 if (retval == JIM_OK) {
5808 *longPtr = (long)wideValue;
5809 return JIM_OK;
5811 return JIM_ERR;
5814 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5816 Jim_Obj *objPtr;
5818 objPtr = Jim_NewObj(interp);
5819 objPtr->typePtr = &intObjType;
5820 objPtr->bytes = NULL;
5821 objPtr->internalRep.wideValue = wideValue;
5822 return objPtr;
5825 /* -----------------------------------------------------------------------------
5826 * Double object
5827 * ---------------------------------------------------------------------------*/
5828 #define JIM_DOUBLE_SPACE 30
5830 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5831 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5833 static const Jim_ObjType doubleObjType = {
5834 "double",
5835 NULL,
5836 NULL,
5837 UpdateStringOfDouble,
5838 JIM_TYPE_NONE,
5841 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5843 int len;
5844 char buf[JIM_DOUBLE_SPACE + 1];
5846 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
5847 objPtr->bytes = Jim_Alloc(len + 1);
5848 memcpy(objPtr->bytes, buf, len + 1);
5849 objPtr->length = len;
5852 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5854 double doubleValue;
5855 jim_wide wideValue;
5856 const char *str;
5858 /* Preserve the string representation.
5859 * Needed so we can convert back to int without loss
5861 str = Jim_String(objPtr);
5863 #ifdef HAVE_LONG_LONG
5864 /* Assume a 53 bit mantissa */
5865 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5866 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5868 if (objPtr->typePtr == &intObjType
5869 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5870 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5872 /* Direct conversion to coerced double */
5873 objPtr->typePtr = &coercedDoubleObjType;
5874 return JIM_OK;
5876 else
5877 #endif
5878 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5879 /* Managed to convert to an int, so we can use this as a cooerced double */
5880 Jim_FreeIntRep(interp, objPtr);
5881 objPtr->typePtr = &coercedDoubleObjType;
5882 objPtr->internalRep.wideValue = wideValue;
5883 return JIM_OK;
5885 else {
5886 /* Try to convert into a double */
5887 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5888 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5889 return JIM_ERR;
5891 /* Free the old internal repr and set the new one. */
5892 Jim_FreeIntRep(interp, objPtr);
5894 objPtr->typePtr = &doubleObjType;
5895 objPtr->internalRep.doubleValue = doubleValue;
5896 return JIM_OK;
5899 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5901 if (objPtr->typePtr == &coercedDoubleObjType) {
5902 *doublePtr = JimWideValue(objPtr);
5903 return JIM_OK;
5905 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5906 return JIM_ERR;
5908 if (objPtr->typePtr == &coercedDoubleObjType) {
5909 *doublePtr = JimWideValue(objPtr);
5911 else {
5912 *doublePtr = objPtr->internalRep.doubleValue;
5914 return JIM_OK;
5917 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5919 Jim_Obj *objPtr;
5921 objPtr = Jim_NewObj(interp);
5922 objPtr->typePtr = &doubleObjType;
5923 objPtr->bytes = NULL;
5924 objPtr->internalRep.doubleValue = doubleValue;
5925 return objPtr;
5928 /* -----------------------------------------------------------------------------
5929 * List object
5930 * ---------------------------------------------------------------------------*/
5931 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
5932 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5933 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5934 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5935 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5936 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5938 /* Note that while the elements of the list may contain references,
5939 * the list object itself can't. This basically means that the
5940 * list object string representation as a whole can't contain references
5941 * that are not presents in the single elements. */
5942 static const Jim_ObjType listObjType = {
5943 "list",
5944 FreeListInternalRep,
5945 DupListInternalRep,
5946 UpdateStringOfList,
5947 JIM_TYPE_NONE,
5950 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5952 int i;
5954 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5955 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5957 Jim_Free(objPtr->internalRep.listValue.ele);
5960 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5962 int i;
5964 JIM_NOTUSED(interp);
5966 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5967 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5968 dupPtr->internalRep.listValue.ele =
5969 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
5970 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5971 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
5972 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5973 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5975 dupPtr->typePtr = &listObjType;
5978 /* The following function checks if a given string can be encoded
5979 * into a list element without any kind of quoting, surrounded by braces,
5980 * or using escapes to quote. */
5981 #define JIM_ELESTR_SIMPLE 0
5982 #define JIM_ELESTR_BRACE 1
5983 #define JIM_ELESTR_QUOTE 2
5984 static unsigned char ListElementQuotingType(const char *s, int len)
5986 int i, level, blevel, trySimple = 1;
5988 /* Try with the SIMPLE case */
5989 if (len == 0)
5990 return JIM_ELESTR_BRACE;
5991 if (s[0] == '"' || s[0] == '{') {
5992 trySimple = 0;
5993 goto testbrace;
5995 for (i = 0; i < len; i++) {
5996 switch (s[i]) {
5997 case ' ':
5998 case '$':
5999 case '"':
6000 case '[':
6001 case ']':
6002 case ';':
6003 case '\\':
6004 case '\r':
6005 case '\n':
6006 case '\t':
6007 case '\f':
6008 case '\v':
6009 trySimple = 0;
6010 case '{':
6011 case '}':
6012 goto testbrace;
6015 return JIM_ELESTR_SIMPLE;
6017 testbrace:
6018 /* Test if it's possible to do with braces */
6019 if (s[len - 1] == '\\')
6020 return JIM_ELESTR_QUOTE;
6021 level = 0;
6022 blevel = 0;
6023 for (i = 0; i < len; i++) {
6024 switch (s[i]) {
6025 case '{':
6026 level++;
6027 break;
6028 case '}':
6029 level--;
6030 if (level < 0)
6031 return JIM_ELESTR_QUOTE;
6032 break;
6033 case '[':
6034 blevel++;
6035 break;
6036 case ']':
6037 blevel--;
6038 break;
6039 case '\\':
6040 if (s[i + 1] == '\n')
6041 return JIM_ELESTR_QUOTE;
6042 else if (s[i + 1] != '\0')
6043 i++;
6044 break;
6047 if (blevel < 0) {
6048 return JIM_ELESTR_QUOTE;
6051 if (level == 0) {
6052 if (!trySimple)
6053 return JIM_ELESTR_BRACE;
6054 for (i = 0; i < len; i++) {
6055 switch (s[i]) {
6056 case ' ':
6057 case '$':
6058 case '"':
6059 case '[':
6060 case ']':
6061 case ';':
6062 case '\\':
6063 case '\r':
6064 case '\n':
6065 case '\t':
6066 case '\f':
6067 case '\v':
6068 return JIM_ELESTR_BRACE;
6069 break;
6072 return JIM_ELESTR_SIMPLE;
6074 return JIM_ELESTR_QUOTE;
6077 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6078 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6079 * scenario.
6080 * Returns the length of the result.
6082 static int BackslashQuoteString(const char *s, char *q)
6084 char *p = q;
6086 while (*s) {
6087 switch (*s) {
6088 case ' ':
6089 case '$':
6090 case '"':
6091 case '[':
6092 case ']':
6093 case '{':
6094 case '}':
6095 case ';':
6096 case '\\':
6097 *p++ = '\\';
6098 *p++ = *s++;
6099 break;
6100 case '\n':
6101 *p++ = '\\';
6102 *p++ = 'n';
6103 s++;
6104 break;
6105 case '\r':
6106 *p++ = '\\';
6107 *p++ = 'r';
6108 s++;
6109 break;
6110 case '\t':
6111 *p++ = '\\';
6112 *p++ = 't';
6113 s++;
6114 break;
6115 case '\f':
6116 *p++ = '\\';
6117 *p++ = 'f';
6118 s++;
6119 break;
6120 case '\v':
6121 *p++ = '\\';
6122 *p++ = 'v';
6123 s++;
6124 break;
6125 default:
6126 *p++ = *s++;
6127 break;
6130 *p = '\0';
6132 return p - q;
6135 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6137 #define STATIC_QUOTING_LEN 32
6138 int i, bufLen, realLength;
6139 const char *strRep;
6140 char *p;
6141 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6143 /* Estimate the space needed. */
6144 if (objc > STATIC_QUOTING_LEN) {
6145 quotingType = Jim_Alloc(objc);
6147 else {
6148 quotingType = staticQuoting;
6150 bufLen = 0;
6151 for (i = 0; i < objc; i++) {
6152 int len;
6154 strRep = Jim_GetString(objv[i], &len);
6155 quotingType[i] = ListElementQuotingType(strRep, len);
6156 switch (quotingType[i]) {
6157 case JIM_ELESTR_SIMPLE:
6158 if (i != 0 || strRep[0] != '#') {
6159 bufLen += len;
6160 break;
6162 /* Special case '#' on first element needs braces */
6163 quotingType[i] = JIM_ELESTR_BRACE;
6164 /* fall through */
6165 case JIM_ELESTR_BRACE:
6166 bufLen += len + 2;
6167 break;
6168 case JIM_ELESTR_QUOTE:
6169 bufLen += len * 2;
6170 break;
6172 bufLen++; /* elements separator. */
6174 bufLen++;
6176 /* Generate the string rep. */
6177 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6178 realLength = 0;
6179 for (i = 0; i < objc; i++) {
6180 int len, qlen;
6182 strRep = Jim_GetString(objv[i], &len);
6184 switch (quotingType[i]) {
6185 case JIM_ELESTR_SIMPLE:
6186 memcpy(p, strRep, len);
6187 p += len;
6188 realLength += len;
6189 break;
6190 case JIM_ELESTR_BRACE:
6191 *p++ = '{';
6192 memcpy(p, strRep, len);
6193 p += len;
6194 *p++ = '}';
6195 realLength += len + 2;
6196 break;
6197 case JIM_ELESTR_QUOTE:
6198 if (i == 0 && strRep[0] == '#') {
6199 *p++ = '\\';
6200 realLength++;
6202 qlen = BackslashQuoteString(strRep, p);
6203 p += qlen;
6204 realLength += qlen;
6205 break;
6207 /* Add a separating space */
6208 if (i + 1 != objc) {
6209 *p++ = ' ';
6210 realLength++;
6213 *p = '\0'; /* nul term. */
6214 objPtr->length = realLength;
6216 if (quotingType != staticQuoting) {
6217 Jim_Free(quotingType);
6221 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6223 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6226 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6228 struct JimParserCtx parser;
6229 const char *str;
6230 int strLen;
6231 Jim_Obj *fileNameObj;
6232 int linenr;
6234 if (objPtr->typePtr == &listObjType) {
6235 return JIM_OK;
6238 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6239 * it also preserves any source location of the dict elements
6240 * which can be very useful
6242 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6243 Jim_Obj **listObjPtrPtr;
6244 int len;
6245 int i;
6247 listObjPtrPtr = JimDictPairs(objPtr, &len);
6248 for (i = 0; i < len; i++) {
6249 Jim_IncrRefCount(listObjPtrPtr[i]);
6252 /* Now just switch the internal rep */
6253 Jim_FreeIntRep(interp, objPtr);
6254 objPtr->typePtr = &listObjType;
6255 objPtr->internalRep.listValue.len = len;
6256 objPtr->internalRep.listValue.maxLen = len;
6257 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6259 return JIM_OK;
6262 /* Try to preserve information about filename / line number */
6263 if (objPtr->typePtr == &sourceObjType) {
6264 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6265 linenr = objPtr->internalRep.sourceValue.lineNumber;
6267 else {
6268 fileNameObj = interp->emptyObj;
6269 linenr = 1;
6271 Jim_IncrRefCount(fileNameObj);
6273 /* Get the string representation */
6274 str = Jim_GetString(objPtr, &strLen);
6276 /* Free the old internal repr just now and initialize the
6277 * new one just now. The string->list conversion can't fail. */
6278 Jim_FreeIntRep(interp, objPtr);
6279 objPtr->typePtr = &listObjType;
6280 objPtr->internalRep.listValue.len = 0;
6281 objPtr->internalRep.listValue.maxLen = 0;
6282 objPtr->internalRep.listValue.ele = NULL;
6284 /* Convert into a list */
6285 if (strLen) {
6286 JimParserInit(&parser, str, strLen, linenr);
6287 while (!parser.eof) {
6288 Jim_Obj *elementPtr;
6290 JimParseList(&parser);
6291 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6292 continue;
6293 elementPtr = JimParserGetTokenObj(interp, &parser);
6294 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6295 ListAppendElement(objPtr, elementPtr);
6298 Jim_DecrRefCount(interp, fileNameObj);
6299 return JIM_OK;
6302 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6304 Jim_Obj *objPtr;
6306 objPtr = Jim_NewObj(interp);
6307 objPtr->typePtr = &listObjType;
6308 objPtr->bytes = NULL;
6309 objPtr->internalRep.listValue.ele = NULL;
6310 objPtr->internalRep.listValue.len = 0;
6311 objPtr->internalRep.listValue.maxLen = 0;
6313 if (len) {
6314 ListInsertElements(objPtr, 0, len, elements);
6317 return objPtr;
6320 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6321 * length of the vector. Note that the user of this function should make
6322 * sure that the list object can't shimmer while the vector returned
6323 * is in use, this vector is the one stored inside the internal representation
6324 * of the list object. This function is not exported, extensions should
6325 * always access to the List object elements using Jim_ListIndex(). */
6326 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6327 Jim_Obj ***listVec)
6329 *listLen = Jim_ListLength(interp, listObj);
6330 *listVec = listObj->internalRep.listValue.ele;
6333 /* Sorting uses ints, but commands may return wide */
6334 static int JimSign(jim_wide w)
6336 if (w == 0) {
6337 return 0;
6339 else if (w < 0) {
6340 return -1;
6342 return 1;
6345 /* ListSortElements type values */
6346 struct lsort_info {
6347 jmp_buf jmpbuf;
6348 Jim_Obj *command;
6349 Jim_Interp *interp;
6350 enum {
6351 JIM_LSORT_ASCII,
6352 JIM_LSORT_NOCASE,
6353 JIM_LSORT_INTEGER,
6354 JIM_LSORT_COMMAND
6355 } type;
6356 int order;
6357 int index;
6358 int indexed;
6359 int (*subfn)(Jim_Obj **, Jim_Obj **);
6362 static struct lsort_info *sort_info;
6364 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6366 Jim_Obj *lObj, *rObj;
6368 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6369 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6370 longjmp(sort_info->jmpbuf, JIM_ERR);
6372 return sort_info->subfn(&lObj, &rObj);
6375 /* Sort the internal rep of a list. */
6376 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6378 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6381 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6383 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6386 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6388 jim_wide lhs = 0, rhs = 0;
6390 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6391 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6392 longjmp(sort_info->jmpbuf, JIM_ERR);
6395 return JimSign(lhs - rhs) * sort_info->order;
6398 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6400 Jim_Obj *compare_script;
6401 int rc;
6403 jim_wide ret = 0;
6405 /* This must be a valid list */
6406 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6407 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6408 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6410 rc = Jim_EvalObj(sort_info->interp, compare_script);
6412 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6413 longjmp(sort_info->jmpbuf, rc);
6416 return JimSign(ret) * sort_info->order;
6419 /* Sort a list *in place*. MUST be called with non-shared objects. */
6420 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6422 struct lsort_info *prev_info;
6424 typedef int (qsort_comparator) (const void *, const void *);
6425 int (*fn) (Jim_Obj **, Jim_Obj **);
6426 Jim_Obj **vector;
6427 int len;
6428 int rc;
6430 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6431 SetListFromAny(interp, listObjPtr);
6433 /* Allow lsort to be called reentrantly */
6434 prev_info = sort_info;
6435 sort_info = info;
6437 vector = listObjPtr->internalRep.listValue.ele;
6438 len = listObjPtr->internalRep.listValue.len;
6439 switch (info->type) {
6440 case JIM_LSORT_ASCII:
6441 fn = ListSortString;
6442 break;
6443 case JIM_LSORT_NOCASE:
6444 fn = ListSortStringNoCase;
6445 break;
6446 case JIM_LSORT_INTEGER:
6447 fn = ListSortInteger;
6448 break;
6449 case JIM_LSORT_COMMAND:
6450 fn = ListSortCommand;
6451 break;
6452 default:
6453 fn = NULL; /* avoid warning */
6454 JimPanic((1, "ListSort called with invalid sort type"));
6457 if (info->indexed) {
6458 /* Need to interpose a "list index" function */
6459 info->subfn = fn;
6460 fn = ListSortIndexHelper;
6463 if ((rc = setjmp(info->jmpbuf)) == 0) {
6464 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6466 Jim_InvalidateStringRep(listObjPtr);
6467 sort_info = prev_info;
6469 return rc;
6472 /* This is the low-level function to insert elements into a list.
6473 * The higher-level Jim_ListInsertElements() performs shared object
6474 * check and invalidate the string repr. This version is used
6475 * in the internals of the List Object and is not exported.
6477 * NOTE: this function can be called only against objects
6478 * with internal type of List.
6480 * An insertion point (idx) of -1 means end-of-list.
6482 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6484 int currentLen = listPtr->internalRep.listValue.len;
6485 int requiredLen = currentLen + elemc;
6486 int i;
6487 Jim_Obj **point;
6489 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6490 if (requiredLen < 2) {
6491 /* Don't do allocations of under 4 pointers. */
6492 requiredLen = 4;
6494 else {
6495 requiredLen *= 2;
6498 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6499 sizeof(Jim_Obj *) * requiredLen);
6501 listPtr->internalRep.listValue.maxLen = requiredLen;
6503 if (idx < 0) {
6504 idx = currentLen;
6506 point = listPtr->internalRep.listValue.ele + idx;
6507 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6508 for (i = 0; i < elemc; ++i) {
6509 point[i] = elemVec[i];
6510 Jim_IncrRefCount(point[i]);
6512 listPtr->internalRep.listValue.len += elemc;
6515 /* Convenience call to ListInsertElements() to append a single element.
6517 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6519 ListInsertElements(listPtr, -1, 1, &objPtr);
6522 /* Appends every element of appendListPtr into listPtr.
6523 * Both have to be of the list type.
6524 * Convenience call to ListInsertElements()
6526 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6528 ListInsertElements(listPtr, -1,
6529 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6532 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6534 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6535 SetListFromAny(interp, listPtr);
6536 Jim_InvalidateStringRep(listPtr);
6537 ListAppendElement(listPtr, objPtr);
6540 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6542 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6543 SetListFromAny(interp, listPtr);
6544 SetListFromAny(interp, appendListPtr);
6545 Jim_InvalidateStringRep(listPtr);
6546 ListAppendList(listPtr, appendListPtr);
6549 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6551 SetListFromAny(interp, objPtr);
6552 return objPtr->internalRep.listValue.len;
6555 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6556 int objc, Jim_Obj *const *objVec)
6558 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6559 SetListFromAny(interp, listPtr);
6560 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6561 idx = listPtr->internalRep.listValue.len;
6562 else if (idx < 0)
6563 idx = 0;
6564 Jim_InvalidateStringRep(listPtr);
6565 ListInsertElements(listPtr, idx, objc, objVec);
6568 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6570 SetListFromAny(interp, listPtr);
6571 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6572 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6573 return NULL;
6575 if (idx < 0)
6576 idx = listPtr->internalRep.listValue.len + idx;
6577 return listPtr->internalRep.listValue.ele[idx];
6580 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6582 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6583 if (*objPtrPtr == NULL) {
6584 if (flags & JIM_ERRMSG) {
6585 Jim_SetResultString(interp, "list index out of range", -1);
6587 return JIM_ERR;
6589 return JIM_OK;
6592 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6593 Jim_Obj *newObjPtr, int flags)
6595 SetListFromAny(interp, listPtr);
6596 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6597 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6598 if (flags & JIM_ERRMSG) {
6599 Jim_SetResultString(interp, "list index out of range", -1);
6601 return JIM_ERR;
6603 if (idx < 0)
6604 idx = listPtr->internalRep.listValue.len + idx;
6605 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6606 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6607 Jim_IncrRefCount(newObjPtr);
6608 return JIM_OK;
6611 /* Modify the list stored into the variable named 'varNamePtr'
6612 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6613 * with the new element 'newObjptr'. */
6614 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6615 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6617 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6618 int shared, i, idx;
6620 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6621 if (objPtr == NULL)
6622 return JIM_ERR;
6623 if ((shared = Jim_IsShared(objPtr)))
6624 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6625 for (i = 0; i < indexc - 1; i++) {
6626 listObjPtr = objPtr;
6627 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6628 goto err;
6629 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6630 goto err;
6632 if (Jim_IsShared(objPtr)) {
6633 objPtr = Jim_DuplicateObj(interp, objPtr);
6634 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6636 Jim_InvalidateStringRep(listObjPtr);
6638 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6639 goto err;
6640 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6641 goto err;
6642 Jim_InvalidateStringRep(objPtr);
6643 Jim_InvalidateStringRep(varObjPtr);
6644 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6645 goto err;
6646 Jim_SetResult(interp, varObjPtr);
6647 return JIM_OK;
6648 err:
6649 if (shared) {
6650 Jim_FreeNewObj(interp, varObjPtr);
6652 return JIM_ERR;
6655 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6657 int i;
6658 int listLen = Jim_ListLength(interp, listObjPtr);
6659 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6661 for (i = 0; i < listLen; ) {
6662 Jim_Obj *objPtr;
6664 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6665 Jim_AppendObj(interp, resObjPtr, objPtr);
6666 if (++i != listLen) {
6667 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6670 return resObjPtr;
6673 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6675 int i;
6677 /* If all the objects in objv are lists,
6678 * it's possible to return a list as result, that's the
6679 * concatenation of all the lists. */
6680 for (i = 0; i < objc; i++) {
6681 if (!Jim_IsList(objv[i]))
6682 break;
6684 if (i == objc) {
6685 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6687 for (i = 0; i < objc; i++)
6688 ListAppendList(objPtr, objv[i]);
6689 return objPtr;
6691 else {
6692 /* Else... we have to glue strings together */
6693 int len = 0, objLen;
6694 char *bytes, *p;
6696 /* Compute the length */
6697 for (i = 0; i < objc; i++) {
6698 Jim_GetString(objv[i], &objLen);
6699 len += objLen;
6701 if (objc)
6702 len += objc - 1;
6703 /* Create the string rep, and a string object holding it. */
6704 p = bytes = Jim_Alloc(len + 1);
6705 for (i = 0; i < objc; i++) {
6706 const char *s = Jim_GetString(objv[i], &objLen);
6708 /* Remove leading space */
6709 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6710 s++;
6711 objLen--;
6712 len--;
6714 /* And trailing space */
6715 while (objLen && (s[objLen - 1] == ' ' ||
6716 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6717 /* Handle trailing backslash-space case */
6718 if (objLen > 1 && s[objLen - 2] == '\\') {
6719 break;
6721 objLen--;
6722 len--;
6724 memcpy(p, s, objLen);
6725 p += objLen;
6726 if (objLen && i + 1 != objc) {
6727 *p++ = ' ';
6729 else if (i + 1 != objc) {
6730 /* Drop the space calcuated for this
6731 * element that is instead null. */
6732 len--;
6735 *p = '\0';
6736 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6740 /* Returns a list composed of the elements in the specified range.
6741 * first and start are directly accepted as Jim_Objects and
6742 * processed for the end?-index? case. */
6743 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6744 Jim_Obj *lastObjPtr)
6746 int first, last;
6747 int len, rangeLen;
6749 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6750 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6751 return NULL;
6752 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6753 first = JimRelToAbsIndex(len, first);
6754 last = JimRelToAbsIndex(len, last);
6755 JimRelToAbsRange(len, &first, &last, &rangeLen);
6756 if (first == 0 && last == len) {
6757 return listObjPtr;
6759 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6762 /* -----------------------------------------------------------------------------
6763 * Dict object
6764 * ---------------------------------------------------------------------------*/
6765 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6766 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6767 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6768 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6770 /* Dict HashTable Type.
6772 * Keys and Values are Jim objects. */
6774 static unsigned int JimObjectHTHashFunction(const void *key)
6776 int len;
6777 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6778 return Jim_GenHashFunction((const unsigned char *)str, len);
6781 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6783 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6786 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6788 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6791 static const Jim_HashTableType JimDictHashTableType = {
6792 JimObjectHTHashFunction, /* hash function */
6793 NULL, /* key dup */
6794 NULL, /* val dup */
6795 JimObjectHTKeyCompare, /* key compare */
6796 JimObjectHTKeyValDestructor, /* key destructor */
6797 JimObjectHTKeyValDestructor /* val destructor */
6800 /* Note that while the elements of the dict may contain references,
6801 * the list object itself can't. This basically means that the
6802 * dict object string representation as a whole can't contain references
6803 * that are not presents in the single elements. */
6804 static const Jim_ObjType dictObjType = {
6805 "dict",
6806 FreeDictInternalRep,
6807 DupDictInternalRep,
6808 UpdateStringOfDict,
6809 JIM_TYPE_NONE,
6812 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6814 JIM_NOTUSED(interp);
6816 Jim_FreeHashTable(objPtr->internalRep.ptr);
6817 Jim_Free(objPtr->internalRep.ptr);
6820 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6822 Jim_HashTable *ht, *dupHt;
6823 Jim_HashTableIterator htiter;
6824 Jim_HashEntry *he;
6826 /* Create a new hash table */
6827 ht = srcPtr->internalRep.ptr;
6828 dupHt = Jim_Alloc(sizeof(*dupHt));
6829 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6830 if (ht->size != 0)
6831 Jim_ExpandHashTable(dupHt, ht->size);
6832 /* Copy every element from the source to the dup hash table */
6833 JimInitHashTableIterator(ht, &htiter);
6834 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6835 const Jim_Obj *keyObjPtr = he->key;
6836 Jim_Obj *valObjPtr = he->u.val;
6838 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6839 Jim_IncrRefCount(valObjPtr);
6840 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6843 dupPtr->internalRep.ptr = dupHt;
6844 dupPtr->typePtr = &dictObjType;
6847 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6849 Jim_HashTable *ht;
6850 Jim_HashTableIterator htiter;
6851 Jim_HashEntry *he;
6852 Jim_Obj **objv;
6853 int i;
6855 ht = dictPtr->internalRep.ptr;
6857 /* Turn the hash table into a flat vector of Jim_Objects. */
6858 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6859 JimInitHashTableIterator(ht, &htiter);
6860 i = 0;
6861 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6862 objv[i++] = (Jim_Obj *)he->key;
6863 objv[i++] = he->u.val;
6865 *len = i;
6866 return objv;
6869 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
6871 /* Turn the hash table into a flat vector of Jim_Objects. */
6872 int len;
6873 Jim_Obj **objv = JimDictPairs(objPtr, &len);
6875 JimMakeListStringRep(objPtr, objv, len);
6877 Jim_Free(objv);
6880 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6882 int listlen;
6884 if (objPtr->typePtr == &dictObjType) {
6885 return JIM_OK;
6888 /* Get the string representation. Do this first so we don't
6889 * change order in case of fast conversion to dict.
6891 Jim_String(objPtr);
6893 /* For simplicity, convert a non-list object to a list and then to a dict */
6894 listlen = Jim_ListLength(interp, objPtr);
6895 if (listlen % 2) {
6896 Jim_SetResultString(interp, "missing value to go with key", -1);
6897 return JIM_ERR;
6899 else {
6900 /* Now it is easy to convert to a dict from a list, and it can't fail */
6901 Jim_HashTable *ht;
6902 int i;
6904 ht = Jim_Alloc(sizeof(*ht));
6905 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6907 for (i = 0; i < listlen; i += 2) {
6908 Jim_Obj *keyObjPtr;
6909 Jim_Obj *valObjPtr;
6911 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
6912 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
6914 Jim_IncrRefCount(keyObjPtr);
6915 Jim_IncrRefCount(valObjPtr);
6917 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
6918 Jim_HashEntry *he;
6920 he = Jim_FindHashEntry(ht, keyObjPtr);
6921 Jim_DecrRefCount(interp, keyObjPtr);
6922 /* ATTENTION: const cast */
6923 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
6924 he->u.val = valObjPtr;
6928 Jim_FreeIntRep(interp, objPtr);
6929 objPtr->typePtr = &dictObjType;
6930 objPtr->internalRep.ptr = ht;
6932 return JIM_OK;
6936 /* Dict object API */
6938 /* Add an element to a dict. objPtr must be of the "dict" type.
6939 * The higer-level exported function is Jim_DictAddElement().
6940 * If an element with the specified key already exists, the value
6941 * associated is replaced with the new one.
6943 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6944 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6945 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6947 Jim_HashTable *ht = objPtr->internalRep.ptr;
6949 if (valueObjPtr == NULL) { /* unset */
6950 return Jim_DeleteHashEntry(ht, keyObjPtr);
6952 Jim_IncrRefCount(keyObjPtr);
6953 Jim_IncrRefCount(valueObjPtr);
6954 if (Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr)) {
6955 /* Value existed, so need to decrement key ref count */
6956 Jim_DecrRefCount(interp, keyObjPtr);
6958 return JIM_OK;
6961 /* Add an element, higher-level interface for DictAddElement().
6962 * If valueObjPtr == NULL, the key is removed if it exists. */
6963 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6964 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6966 int retcode;
6968 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
6969 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
6970 return JIM_ERR;
6972 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
6973 Jim_InvalidateStringRep(objPtr);
6974 return retcode;
6977 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6979 Jim_Obj *objPtr;
6980 int i;
6982 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
6984 objPtr = Jim_NewObj(interp);
6985 objPtr->typePtr = &dictObjType;
6986 objPtr->bytes = NULL;
6987 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
6988 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
6989 for (i = 0; i < len; i += 2)
6990 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
6991 return objPtr;
6994 /* Return the value associated to the specified dict key
6995 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
6997 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
6998 Jim_Obj **objPtrPtr, int flags)
7000 Jim_HashEntry *he;
7001 Jim_HashTable *ht;
7003 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7004 return -1;
7006 ht = dictPtr->internalRep.ptr;
7007 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7008 if (flags & JIM_ERRMSG) {
7009 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7011 return JIM_ERR;
7013 *objPtrPtr = he->u.val;
7014 return JIM_OK;
7017 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7018 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7020 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7021 return JIM_ERR;
7023 *objPtrPtr = JimDictPairs(dictPtr, len);
7025 return JIM_OK;
7029 /* Return the value associated to the specified dict keys */
7030 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7031 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7033 int i;
7035 if (keyc == 0) {
7036 *objPtrPtr = dictPtr;
7037 return JIM_OK;
7040 for (i = 0; i < keyc; i++) {
7041 Jim_Obj *objPtr;
7043 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7044 if (rc != JIM_OK) {
7045 return rc;
7047 dictPtr = objPtr;
7049 *objPtrPtr = dictPtr;
7050 return JIM_OK;
7053 /* Modify the dict stored into the variable named 'varNamePtr'
7054 * setting the element specified by the 'keyc' keys objects in 'keyv',
7055 * with the new value of the element 'newObjPtr'.
7057 * If newObjPtr == NULL the operation is to remove the given key
7058 * from the dictionary.
7060 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7061 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7063 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7064 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7066 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7067 int shared, i;
7069 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7070 if (objPtr == NULL) {
7071 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7072 /* Cannot remove a key from non existing var */
7073 return JIM_ERR;
7075 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7076 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7077 Jim_FreeNewObj(interp, varObjPtr);
7078 return JIM_ERR;
7081 if ((shared = Jim_IsShared(objPtr)))
7082 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7083 for (i = 0; i < keyc; i++) {
7084 dictObjPtr = objPtr;
7086 /* Check if it's a valid dictionary */
7087 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7088 goto err;
7091 if (i == keyc - 1) {
7092 /* Last key: Note that error on unset with missing last key is OK */
7093 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7094 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7095 goto err;
7098 break;
7101 /* Check if the given key exists. */
7102 Jim_InvalidateStringRep(dictObjPtr);
7103 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7104 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7105 /* This key exists at the current level.
7106 * Make sure it's not shared!. */
7107 if (Jim_IsShared(objPtr)) {
7108 objPtr = Jim_DuplicateObj(interp, objPtr);
7109 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7112 else {
7113 /* Key not found. If it's an [unset] operation
7114 * this is an error. Only the last key may not
7115 * exist. */
7116 if (newObjPtr == NULL) {
7117 goto err;
7119 /* Otherwise set an empty dictionary
7120 * as key's value. */
7121 objPtr = Jim_NewDictObj(interp, NULL, 0);
7122 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7125 Jim_InvalidateStringRep(objPtr);
7126 Jim_InvalidateStringRep(varObjPtr);
7127 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7128 goto err;
7130 Jim_SetResult(interp, varObjPtr);
7131 return JIM_OK;
7132 err:
7133 if (shared) {
7134 Jim_FreeNewObj(interp, varObjPtr);
7136 return JIM_ERR;
7139 /* -----------------------------------------------------------------------------
7140 * Index object
7141 * ---------------------------------------------------------------------------*/
7142 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7143 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7145 static const Jim_ObjType indexObjType = {
7146 "index",
7147 NULL,
7148 NULL,
7149 UpdateStringOfIndex,
7150 JIM_TYPE_NONE,
7153 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7155 int len;
7156 char buf[JIM_INTEGER_SPACE + 1];
7158 if (objPtr->internalRep.intValue >= 0)
7159 len = sprintf(buf, "%d", objPtr->internalRep.intValue);
7160 else if (objPtr->internalRep.intValue == -1)
7161 len = sprintf(buf, "end");
7162 else {
7163 len = sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7165 objPtr->bytes = Jim_Alloc(len + 1);
7166 memcpy(objPtr->bytes, buf, len + 1);
7167 objPtr->length = len;
7170 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7172 int idx, end = 0;
7173 const char *str;
7174 char *endptr;
7176 /* Get the string representation */
7177 str = Jim_String(objPtr);
7179 /* Try to convert into an index */
7180 if (strncmp(str, "end", 3) == 0) {
7181 end = 1;
7182 str += 3;
7183 idx = 0;
7185 else {
7186 idx = jim_strtol(str, &endptr);
7188 if (endptr == str) {
7189 goto badindex;
7191 str = endptr;
7194 /* Now str may include or +<num> or -<num> */
7195 if (*str == '+' || *str == '-') {
7196 int sign = (*str == '+' ? 1 : -1);
7198 idx += sign * jim_strtol(++str, &endptr);
7199 if (str == endptr || *endptr) {
7200 goto badindex;
7202 str = endptr;
7204 /* The only thing left should be spaces */
7205 while (isspace(UCHAR(*str))) {
7206 str++;
7208 if (*str) {
7209 goto badindex;
7211 if (end) {
7212 if (idx > 0) {
7213 idx = INT_MAX;
7215 else {
7216 /* end-1 is repesented as -2 */
7217 idx--;
7220 else if (idx < 0) {
7221 idx = -INT_MAX;
7224 /* Free the old internal repr and set the new one. */
7225 Jim_FreeIntRep(interp, objPtr);
7226 objPtr->typePtr = &indexObjType;
7227 objPtr->internalRep.intValue = idx;
7228 return JIM_OK;
7230 badindex:
7231 Jim_SetResultFormatted(interp,
7232 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7233 return JIM_ERR;
7236 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7238 /* Avoid shimmering if the object is an integer. */
7239 if (objPtr->typePtr == &intObjType) {
7240 jim_wide val = JimWideValue(objPtr);
7242 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7243 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7244 return JIM_OK;
7247 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7248 return JIM_ERR;
7249 *indexPtr = objPtr->internalRep.intValue;
7250 return JIM_OK;
7253 /* -----------------------------------------------------------------------------
7254 * Return Code Object.
7255 * ---------------------------------------------------------------------------*/
7257 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7258 static const char * const jimReturnCodes[] = {
7259 "ok",
7260 "error",
7261 "return",
7262 "break",
7263 "continue",
7264 "signal",
7265 "exit",
7266 "eval",
7267 NULL
7270 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7272 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7274 static const Jim_ObjType returnCodeObjType = {
7275 "return-code",
7276 NULL,
7277 NULL,
7278 NULL,
7279 JIM_TYPE_NONE,
7282 /* Converts a (standard) return code to a string. Returns "?" for
7283 * non-standard return codes.
7285 const char *Jim_ReturnCode(int code)
7287 if (code < 0 || code >= (int)jimReturnCodesSize) {
7288 return "?";
7290 else {
7291 return jimReturnCodes[code];
7295 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7297 int returnCode;
7298 jim_wide wideValue;
7300 /* Try to convert into an integer */
7301 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7302 returnCode = (int)wideValue;
7303 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7304 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7305 return JIM_ERR;
7307 /* Free the old internal repr and set the new one. */
7308 Jim_FreeIntRep(interp, objPtr);
7309 objPtr->typePtr = &returnCodeObjType;
7310 objPtr->internalRep.intValue = returnCode;
7311 return JIM_OK;
7314 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7316 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7317 return JIM_ERR;
7318 *intPtr = objPtr->internalRep.intValue;
7319 return JIM_OK;
7322 /* -----------------------------------------------------------------------------
7323 * Expression Parsing
7324 * ---------------------------------------------------------------------------*/
7325 static int JimParseExprOperator(struct JimParserCtx *pc);
7326 static int JimParseExprNumber(struct JimParserCtx *pc);
7327 static int JimParseExprIrrational(struct JimParserCtx *pc);
7329 /* Exrp's Stack machine operators opcodes. */
7331 /* Binary operators (numbers) */
7332 enum
7334 /* Continues on from the JIM_TT_ space */
7335 /* Operations */
7336 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7337 JIM_EXPROP_DIV,
7338 JIM_EXPROP_MOD,
7339 JIM_EXPROP_SUB,
7340 JIM_EXPROP_ADD,
7341 JIM_EXPROP_LSHIFT,
7342 JIM_EXPROP_RSHIFT,
7343 JIM_EXPROP_ROTL,
7344 JIM_EXPROP_ROTR,
7345 JIM_EXPROP_LT,
7346 JIM_EXPROP_GT,
7347 JIM_EXPROP_LTE,
7348 JIM_EXPROP_GTE,
7349 JIM_EXPROP_NUMEQ,
7350 JIM_EXPROP_NUMNE,
7351 JIM_EXPROP_BITAND, /* 35 */
7352 JIM_EXPROP_BITXOR,
7353 JIM_EXPROP_BITOR,
7355 /* Note must keep these together */
7356 JIM_EXPROP_LOGICAND, /* 38 */
7357 JIM_EXPROP_LOGICAND_LEFT,
7358 JIM_EXPROP_LOGICAND_RIGHT,
7360 /* and these */
7361 JIM_EXPROP_LOGICOR, /* 41 */
7362 JIM_EXPROP_LOGICOR_LEFT,
7363 JIM_EXPROP_LOGICOR_RIGHT,
7365 /* and these */
7366 /* Ternary operators */
7367 JIM_EXPROP_TERNARY, /* 44 */
7368 JIM_EXPROP_TERNARY_LEFT,
7369 JIM_EXPROP_TERNARY_RIGHT,
7371 /* and these */
7372 JIM_EXPROP_COLON, /* 47 */
7373 JIM_EXPROP_COLON_LEFT,
7374 JIM_EXPROP_COLON_RIGHT,
7376 JIM_EXPROP_POW, /* 50 */
7378 /* Binary operators (strings) */
7379 JIM_EXPROP_STREQ, /* 51 */
7380 JIM_EXPROP_STRNE,
7381 JIM_EXPROP_STRIN,
7382 JIM_EXPROP_STRNI,
7384 /* Unary operators (numbers) */
7385 JIM_EXPROP_NOT, /* 55 */
7386 JIM_EXPROP_BITNOT,
7387 JIM_EXPROP_UNARYMINUS,
7388 JIM_EXPROP_UNARYPLUS,
7390 /* Functions */
7391 JIM_EXPROP_FUNC_FIRST, /* 59 */
7392 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7393 JIM_EXPROP_FUNC_ABS,
7394 JIM_EXPROP_FUNC_DOUBLE,
7395 JIM_EXPROP_FUNC_ROUND,
7396 JIM_EXPROP_FUNC_RAND,
7397 JIM_EXPROP_FUNC_SRAND,
7399 /* math functions from libm */
7400 JIM_EXPROP_FUNC_SIN, /* 64 */
7401 JIM_EXPROP_FUNC_COS,
7402 JIM_EXPROP_FUNC_TAN,
7403 JIM_EXPROP_FUNC_ASIN,
7404 JIM_EXPROP_FUNC_ACOS,
7405 JIM_EXPROP_FUNC_ATAN,
7406 JIM_EXPROP_FUNC_SINH,
7407 JIM_EXPROP_FUNC_COSH,
7408 JIM_EXPROP_FUNC_TANH,
7409 JIM_EXPROP_FUNC_CEIL,
7410 JIM_EXPROP_FUNC_FLOOR,
7411 JIM_EXPROP_FUNC_EXP,
7412 JIM_EXPROP_FUNC_LOG,
7413 JIM_EXPROP_FUNC_LOG10,
7414 JIM_EXPROP_FUNC_SQRT,
7415 JIM_EXPROP_FUNC_POW,
7418 struct JimExprState
7420 Jim_Obj **stack;
7421 int stacklen;
7422 int opcode;
7423 int skip;
7426 /* Operators table */
7427 typedef struct Jim_ExprOperator
7429 const char *name;
7430 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7431 unsigned char precedence;
7432 unsigned char arity;
7433 unsigned char lazy;
7434 unsigned char namelen;
7435 } Jim_ExprOperator;
7437 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7439 Jim_IncrRefCount(obj);
7440 e->stack[e->stacklen++] = obj;
7443 static Jim_Obj *ExprPop(struct JimExprState *e)
7445 return e->stack[--e->stacklen];
7448 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7450 int intresult = 0;
7451 int rc = JIM_OK;
7452 Jim_Obj *A = ExprPop(e);
7453 double dA, dC = 0;
7454 jim_wide wA, wC = 0;
7456 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7457 intresult = 1;
7459 switch (e->opcode) {
7460 case JIM_EXPROP_FUNC_INT:
7461 wC = wA;
7462 break;
7463 case JIM_EXPROP_FUNC_ROUND:
7464 wC = wA;
7465 break;
7466 case JIM_EXPROP_FUNC_DOUBLE:
7467 dC = wA;
7468 intresult = 0;
7469 break;
7470 case JIM_EXPROP_FUNC_ABS:
7471 wC = wA >= 0 ? wA : -wA;
7472 break;
7473 case JIM_EXPROP_UNARYMINUS:
7474 wC = -wA;
7475 break;
7476 case JIM_EXPROP_UNARYPLUS:
7477 wC = wA;
7478 break;
7479 case JIM_EXPROP_NOT:
7480 wC = !wA;
7481 break;
7482 default:
7483 abort();
7486 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7487 switch (e->opcode) {
7488 case JIM_EXPROP_FUNC_INT:
7489 wC = dA;
7490 intresult = 1;
7491 break;
7492 case JIM_EXPROP_FUNC_ROUND:
7493 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7494 intresult = 1;
7495 break;
7496 case JIM_EXPROP_FUNC_DOUBLE:
7497 dC = dA;
7498 break;
7499 case JIM_EXPROP_FUNC_ABS:
7500 dC = dA >= 0 ? dA : -dA;
7501 break;
7502 case JIM_EXPROP_UNARYMINUS:
7503 dC = -dA;
7504 break;
7505 case JIM_EXPROP_UNARYPLUS:
7506 dC = dA;
7507 break;
7508 case JIM_EXPROP_NOT:
7509 wC = !dA;
7510 intresult = 1;
7511 break;
7512 default:
7513 abort();
7517 if (rc == JIM_OK) {
7518 if (intresult) {
7519 ExprPush(e, Jim_NewIntObj(interp, wC));
7521 else {
7522 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7526 Jim_DecrRefCount(interp, A);
7528 return rc;
7531 static double JimRandDouble(Jim_Interp *interp)
7533 unsigned long x;
7534 JimRandomBytes(interp, &x, sizeof(x));
7536 return (double)x / (unsigned long)~0;
7539 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7541 Jim_Obj *A = ExprPop(e);
7542 jim_wide wA;
7544 int rc = Jim_GetWide(interp, A, &wA);
7545 if (rc == JIM_OK) {
7546 switch (e->opcode) {
7547 case JIM_EXPROP_BITNOT:
7548 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7549 break;
7550 case JIM_EXPROP_FUNC_SRAND:
7551 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7552 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7553 break;
7554 default:
7555 abort();
7559 Jim_DecrRefCount(interp, A);
7561 return rc;
7564 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7566 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7568 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7570 return JIM_OK;
7573 #ifdef JIM_MATH_FUNCTIONS
7574 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7576 int rc;
7577 Jim_Obj *A = ExprPop(e);
7578 double dA, dC;
7580 rc = Jim_GetDouble(interp, A, &dA);
7581 if (rc == JIM_OK) {
7582 switch (e->opcode) {
7583 case JIM_EXPROP_FUNC_SIN:
7584 dC = sin(dA);
7585 break;
7586 case JIM_EXPROP_FUNC_COS:
7587 dC = cos(dA);
7588 break;
7589 case JIM_EXPROP_FUNC_TAN:
7590 dC = tan(dA);
7591 break;
7592 case JIM_EXPROP_FUNC_ASIN:
7593 dC = asin(dA);
7594 break;
7595 case JIM_EXPROP_FUNC_ACOS:
7596 dC = acos(dA);
7597 break;
7598 case JIM_EXPROP_FUNC_ATAN:
7599 dC = atan(dA);
7600 break;
7601 case JIM_EXPROP_FUNC_SINH:
7602 dC = sinh(dA);
7603 break;
7604 case JIM_EXPROP_FUNC_COSH:
7605 dC = cosh(dA);
7606 break;
7607 case JIM_EXPROP_FUNC_TANH:
7608 dC = tanh(dA);
7609 break;
7610 case JIM_EXPROP_FUNC_CEIL:
7611 dC = ceil(dA);
7612 break;
7613 case JIM_EXPROP_FUNC_FLOOR:
7614 dC = floor(dA);
7615 break;
7616 case JIM_EXPROP_FUNC_EXP:
7617 dC = exp(dA);
7618 break;
7619 case JIM_EXPROP_FUNC_LOG:
7620 dC = log(dA);
7621 break;
7622 case JIM_EXPROP_FUNC_LOG10:
7623 dC = log10(dA);
7624 break;
7625 case JIM_EXPROP_FUNC_SQRT:
7626 dC = sqrt(dA);
7627 break;
7628 default:
7629 abort();
7631 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7634 Jim_DecrRefCount(interp, A);
7636 return rc;
7638 #endif
7640 /* A binary operation on two ints */
7641 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7643 Jim_Obj *B = ExprPop(e);
7644 Jim_Obj *A = ExprPop(e);
7645 jim_wide wA, wB;
7646 int rc = JIM_ERR;
7648 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7649 jim_wide wC;
7651 rc = JIM_OK;
7653 switch (e->opcode) {
7654 case JIM_EXPROP_LSHIFT:
7655 wC = wA << wB;
7656 break;
7657 case JIM_EXPROP_RSHIFT:
7658 wC = wA >> wB;
7659 break;
7660 case JIM_EXPROP_BITAND:
7661 wC = wA & wB;
7662 break;
7663 case JIM_EXPROP_BITXOR:
7664 wC = wA ^ wB;
7665 break;
7666 case JIM_EXPROP_BITOR:
7667 wC = wA | wB;
7668 break;
7669 case JIM_EXPROP_MOD:
7670 if (wB == 0) {
7671 wC = 0;
7672 Jim_SetResultString(interp, "Division by zero", -1);
7673 rc = JIM_ERR;
7675 else {
7677 * From Tcl 8.x
7679 * This code is tricky: C doesn't guarantee much
7680 * about the quotient or remainder, but Tcl does.
7681 * The remainder always has the same sign as the
7682 * divisor and a smaller absolute value.
7684 int negative = 0;
7686 if (wB < 0) {
7687 wB = -wB;
7688 wA = -wA;
7689 negative = 1;
7691 wC = wA % wB;
7692 if (wC < 0) {
7693 wC += wB;
7695 if (negative) {
7696 wC = -wC;
7699 break;
7700 case JIM_EXPROP_ROTL:
7701 case JIM_EXPROP_ROTR:{
7702 /* uint32_t would be better. But not everyone has inttypes.h? */
7703 unsigned long uA = (unsigned long)wA;
7704 unsigned long uB = (unsigned long)wB;
7705 const unsigned int S = sizeof(unsigned long) * 8;
7707 /* Shift left by the word size or more is undefined. */
7708 uB %= S;
7710 if (e->opcode == JIM_EXPROP_ROTR) {
7711 uB = S - uB;
7713 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7714 break;
7716 default:
7717 abort();
7719 ExprPush(e, Jim_NewIntObj(interp, wC));
7723 Jim_DecrRefCount(interp, A);
7724 Jim_DecrRefCount(interp, B);
7726 return rc;
7730 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7731 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7733 int intresult = 0;
7734 int rc = JIM_OK;
7735 double dA, dB, dC = 0;
7736 jim_wide wA, wB, wC = 0;
7738 Jim_Obj *B = ExprPop(e);
7739 Jim_Obj *A = ExprPop(e);
7741 if ((A->typePtr != &doubleObjType || A->bytes) &&
7742 (B->typePtr != &doubleObjType || B->bytes) &&
7743 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7745 /* Both are ints */
7747 intresult = 1;
7749 switch (e->opcode) {
7750 case JIM_EXPROP_POW:
7751 case JIM_EXPROP_FUNC_POW:
7752 wC = JimPowWide(wA, wB);
7753 break;
7754 case JIM_EXPROP_ADD:
7755 wC = wA + wB;
7756 break;
7757 case JIM_EXPROP_SUB:
7758 wC = wA - wB;
7759 break;
7760 case JIM_EXPROP_MUL:
7761 wC = wA * wB;
7762 break;
7763 case JIM_EXPROP_DIV:
7764 if (wB == 0) {
7765 Jim_SetResultString(interp, "Division by zero", -1);
7766 rc = JIM_ERR;
7768 else {
7770 * From Tcl 8.x
7772 * This code is tricky: C doesn't guarantee much
7773 * about the quotient or remainder, but Tcl does.
7774 * The remainder always has the same sign as the
7775 * divisor and a smaller absolute value.
7777 if (wB < 0) {
7778 wB = -wB;
7779 wA = -wA;
7781 wC = wA / wB;
7782 if (wA % wB < 0) {
7783 wC--;
7786 break;
7787 case JIM_EXPROP_LT:
7788 wC = wA < wB;
7789 break;
7790 case JIM_EXPROP_GT:
7791 wC = wA > wB;
7792 break;
7793 case JIM_EXPROP_LTE:
7794 wC = wA <= wB;
7795 break;
7796 case JIM_EXPROP_GTE:
7797 wC = wA >= wB;
7798 break;
7799 case JIM_EXPROP_NUMEQ:
7800 wC = wA == wB;
7801 break;
7802 case JIM_EXPROP_NUMNE:
7803 wC = wA != wB;
7804 break;
7805 default:
7806 abort();
7809 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7810 switch (e->opcode) {
7811 case JIM_EXPROP_POW:
7812 case JIM_EXPROP_FUNC_POW:
7813 #ifdef JIM_MATH_FUNCTIONS
7814 dC = pow(dA, dB);
7815 #else
7816 Jim_SetResultString(interp, "unsupported", -1);
7817 rc = JIM_ERR;
7818 #endif
7819 break;
7820 case JIM_EXPROP_ADD:
7821 dC = dA + dB;
7822 break;
7823 case JIM_EXPROP_SUB:
7824 dC = dA - dB;
7825 break;
7826 case JIM_EXPROP_MUL:
7827 dC = dA * dB;
7828 break;
7829 case JIM_EXPROP_DIV:
7830 if (dB == 0) {
7831 #ifdef INFINITY
7832 dC = dA < 0 ? -INFINITY : INFINITY;
7833 #else
7834 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7835 #endif
7837 else {
7838 dC = dA / dB;
7840 break;
7841 case JIM_EXPROP_LT:
7842 wC = dA < dB;
7843 intresult = 1;
7844 break;
7845 case JIM_EXPROP_GT:
7846 wC = dA > dB;
7847 intresult = 1;
7848 break;
7849 case JIM_EXPROP_LTE:
7850 wC = dA <= dB;
7851 intresult = 1;
7852 break;
7853 case JIM_EXPROP_GTE:
7854 wC = dA >= dB;
7855 intresult = 1;
7856 break;
7857 case JIM_EXPROP_NUMEQ:
7858 wC = dA == dB;
7859 intresult = 1;
7860 break;
7861 case JIM_EXPROP_NUMNE:
7862 wC = dA != dB;
7863 intresult = 1;
7864 break;
7865 default:
7866 abort();
7869 else {
7870 /* Handle the string case */
7872 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7873 int i = Jim_StringCompareObj(interp, A, B, 0);
7875 intresult = 1;
7877 switch (e->opcode) {
7878 case JIM_EXPROP_LT:
7879 wC = i < 0;
7880 break;
7881 case JIM_EXPROP_GT:
7882 wC = i > 0;
7883 break;
7884 case JIM_EXPROP_LTE:
7885 wC = i <= 0;
7886 break;
7887 case JIM_EXPROP_GTE:
7888 wC = i >= 0;
7889 break;
7890 case JIM_EXPROP_NUMEQ:
7891 wC = i == 0;
7892 break;
7893 case JIM_EXPROP_NUMNE:
7894 wC = i != 0;
7895 break;
7896 default:
7897 rc = JIM_ERR;
7898 break;
7902 if (rc == JIM_OK) {
7903 if (intresult) {
7904 ExprPush(e, Jim_NewIntObj(interp, wC));
7906 else {
7907 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7911 Jim_DecrRefCount(interp, A);
7912 Jim_DecrRefCount(interp, B);
7914 return rc;
7917 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
7919 int listlen;
7920 int i;
7922 listlen = Jim_ListLength(interp, listObjPtr);
7923 for (i = 0; i < listlen; i++) {
7924 Jim_Obj *objPtr;
7926 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
7928 if (Jim_StringEqObj(objPtr, valObj)) {
7929 return 1;
7932 return 0;
7935 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
7937 Jim_Obj *B = ExprPop(e);
7938 Jim_Obj *A = ExprPop(e);
7940 jim_wide wC;
7942 switch (e->opcode) {
7943 case JIM_EXPROP_STREQ:
7944 case JIM_EXPROP_STRNE: {
7945 int Alen, Blen;
7946 const char *sA = Jim_GetString(A, &Alen);
7947 const char *sB = Jim_GetString(B, &Blen);
7949 if (e->opcode == JIM_EXPROP_STREQ) {
7950 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7952 else {
7953 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7955 break;
7957 case JIM_EXPROP_STRIN:
7958 wC = JimSearchList(interp, B, A);
7959 break;
7960 case JIM_EXPROP_STRNI:
7961 wC = !JimSearchList(interp, B, A);
7962 break;
7963 default:
7964 abort();
7966 ExprPush(e, Jim_NewIntObj(interp, wC));
7968 Jim_DecrRefCount(interp, A);
7969 Jim_DecrRefCount(interp, B);
7971 return JIM_OK;
7974 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
7976 long l;
7977 double d;
7979 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
7980 return l != 0;
7982 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
7983 return d != 0;
7985 return -1;
7988 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
7990 Jim_Obj *skip = ExprPop(e);
7991 Jim_Obj *A = ExprPop(e);
7992 int rc = JIM_OK;
7994 switch (ExprBool(interp, A)) {
7995 case 0:
7996 /* false, so skip RHS opcodes with a 0 result */
7997 e->skip = JimWideValue(skip);
7998 ExprPush(e, Jim_NewIntObj(interp, 0));
7999 break;
8001 case 1:
8002 /* true so continue */
8003 break;
8005 case -1:
8006 /* Invalid */
8007 rc = JIM_ERR;
8009 Jim_DecrRefCount(interp, A);
8010 Jim_DecrRefCount(interp, skip);
8012 return rc;
8015 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8017 Jim_Obj *skip = ExprPop(e);
8018 Jim_Obj *A = ExprPop(e);
8019 int rc = JIM_OK;
8021 switch (ExprBool(interp, A)) {
8022 case 0:
8023 /* false, so do nothing */
8024 break;
8026 case 1:
8027 /* true so skip RHS opcodes with a 1 result */
8028 e->skip = JimWideValue(skip);
8029 ExprPush(e, Jim_NewIntObj(interp, 1));
8030 break;
8032 case -1:
8033 /* Invalid */
8034 rc = JIM_ERR;
8035 break;
8037 Jim_DecrRefCount(interp, A);
8038 Jim_DecrRefCount(interp, skip);
8040 return rc;
8043 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8045 Jim_Obj *A = ExprPop(e);
8046 int rc = JIM_OK;
8048 switch (ExprBool(interp, A)) {
8049 case 0:
8050 ExprPush(e, Jim_NewIntObj(interp, 0));
8051 break;
8053 case 1:
8054 ExprPush(e, Jim_NewIntObj(interp, 1));
8055 break;
8057 case -1:
8058 /* Invalid */
8059 rc = JIM_ERR;
8060 break;
8062 Jim_DecrRefCount(interp, A);
8064 return rc;
8067 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8069 Jim_Obj *skip = ExprPop(e);
8070 Jim_Obj *A = ExprPop(e);
8071 int rc = JIM_OK;
8073 /* Repush A */
8074 ExprPush(e, A);
8076 switch (ExprBool(interp, A)) {
8077 case 0:
8078 /* false, skip RHS opcodes */
8079 e->skip = JimWideValue(skip);
8080 /* Push a dummy value */
8081 ExprPush(e, Jim_NewIntObj(interp, 0));
8082 break;
8084 case 1:
8085 /* true so do nothing */
8086 break;
8088 case -1:
8089 /* Invalid */
8090 rc = JIM_ERR;
8091 break;
8093 Jim_DecrRefCount(interp, A);
8094 Jim_DecrRefCount(interp, skip);
8096 return rc;
8099 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8101 Jim_Obj *skip = ExprPop(e);
8102 Jim_Obj *B = ExprPop(e);
8103 Jim_Obj *A = ExprPop(e);
8105 /* No need to check for A as non-boolean */
8106 if (ExprBool(interp, A)) {
8107 /* true, so skip RHS opcodes */
8108 e->skip = JimWideValue(skip);
8109 /* Repush B as the answer */
8110 ExprPush(e, B);
8113 Jim_DecrRefCount(interp, skip);
8114 Jim_DecrRefCount(interp, A);
8115 Jim_DecrRefCount(interp, B);
8116 return JIM_OK;
8119 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8121 return JIM_OK;
8124 enum
8126 LAZY_NONE,
8127 LAZY_OP,
8128 LAZY_LEFT,
8129 LAZY_RIGHT
8132 /* name - precedence - arity - opcode
8134 * This array *must* be kept in sync with the JIM_EXPROP enum.
8136 * The following macro pre-computes the string length at compile time.
8138 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8140 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8141 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8142 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8143 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8145 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8146 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8148 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8149 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8151 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8152 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8154 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8155 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8156 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8157 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8159 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8160 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8162 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8163 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8164 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8166 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8167 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8168 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8170 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8171 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8172 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8174 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8175 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8176 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8178 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8179 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8180 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8182 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8184 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8185 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8187 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8188 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8190 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8191 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8192 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8193 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8197 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8198 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8199 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8200 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8201 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8202 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8204 #ifdef JIM_MATH_FUNCTIONS
8205 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8206 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8207 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8208 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8209 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8210 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8211 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8212 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8213 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8214 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8215 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8216 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8217 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8218 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8219 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8220 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8221 #endif
8223 #undef OPRINIT
8225 #define JIM_EXPR_OPERATORS_NUM \
8226 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8228 static int JimParseExpression(struct JimParserCtx *pc)
8230 /* Discard spaces and quoted newline */
8231 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8232 if (*pc->p == '\n') {
8233 pc->linenr++;
8235 pc->p++;
8236 pc->len--;
8239 if (pc->len == 0) {
8240 pc->tstart = pc->tend = pc->p;
8241 pc->tline = pc->linenr;
8242 pc->tt = JIM_TT_EOL;
8243 pc->eof = 1;
8244 return JIM_OK;
8246 switch (*(pc->p)) {
8247 case '(':
8248 pc->tt = JIM_TT_SUBEXPR_START;
8249 goto singlechar;
8250 case ')':
8251 pc->tt = JIM_TT_SUBEXPR_END;
8252 goto singlechar;
8253 case ',':
8254 pc->tt = JIM_TT_SUBEXPR_COMMA;
8255 singlechar:
8256 pc->tstart = pc->tend = pc->p;
8257 pc->tline = pc->linenr;
8258 pc->p++;
8259 pc->len--;
8260 break;
8261 case '[':
8262 return JimParseCmd(pc);
8263 case '$':
8264 if (JimParseVar(pc) == JIM_ERR)
8265 return JimParseExprOperator(pc);
8266 else {
8267 /* Don't allow expr sugar in expressions */
8268 if (pc->tt == JIM_TT_EXPRSUGAR) {
8269 return JIM_ERR;
8271 return JIM_OK;
8273 break;
8274 case '0':
8275 case '1':
8276 case '2':
8277 case '3':
8278 case '4':
8279 case '5':
8280 case '6':
8281 case '7':
8282 case '8':
8283 case '9':
8284 case '.':
8285 return JimParseExprNumber(pc);
8286 case '"':
8287 return JimParseQuote(pc);
8288 case '{':
8289 return JimParseBrace(pc);
8291 case 'N':
8292 case 'I':
8293 case 'n':
8294 case 'i':
8295 if (JimParseExprIrrational(pc) == JIM_ERR)
8296 return JimParseExprOperator(pc);
8297 break;
8298 default:
8299 return JimParseExprOperator(pc);
8300 break;
8302 return JIM_OK;
8305 static int JimParseExprNumber(struct JimParserCtx *pc)
8307 int allowdot = 1;
8308 int base = 10;
8310 /* Assume an integer for now */
8311 pc->tt = JIM_TT_EXPR_INT;
8312 pc->tstart = pc->p;
8313 pc->tline = pc->linenr;
8315 /* Parse initial 0<x> */
8316 if (pc->p[0] == '0') {
8317 switch (pc->p[1]) {
8318 case 'x':
8319 case 'X':
8320 base = 16;
8321 allowdot = 0;
8322 pc->p += 2;
8323 pc->len -= 2;
8324 break;
8325 case 'o':
8326 case 'O':
8327 base = 8;
8328 allowdot = 0;
8329 pc->p += 2;
8330 pc->len -= 2;
8331 break;
8332 case 'b':
8333 case 'B':
8334 base = 2;
8335 allowdot = 0;
8336 pc->p += 2;
8337 pc->len -= 2;
8338 break;
8342 while (isdigit(UCHAR(*pc->p))
8343 || (base == 16 && isxdigit(UCHAR(*pc->p)))
8344 || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
8345 || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
8346 || (allowdot && *pc->p == '.')
8348 if (*pc->p == '.') {
8349 allowdot = 0;
8350 pc->tt = JIM_TT_EXPR_DOUBLE;
8352 pc->p++;
8353 pc->len--;
8354 if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
8355 || isdigit(UCHAR(pc->p[1])))) {
8356 pc->p += 2;
8357 pc->len -= 2;
8358 pc->tt = JIM_TT_EXPR_DOUBLE;
8361 pc->tend = pc->p - 1;
8362 return JIM_OK;
8365 static int JimParseExprIrrational(struct JimParserCtx *pc)
8367 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8368 const char **token;
8370 for (token = Tokens; *token != NULL; token++) {
8371 int len = strlen(*token);
8373 if (strncmp(*token, pc->p, len) == 0) {
8374 pc->tstart = pc->p;
8375 pc->tend = pc->p + len - 1;
8376 pc->p += len;
8377 pc->len -= len;
8378 pc->tline = pc->linenr;
8379 pc->tt = JIM_TT_EXPR_DOUBLE;
8380 return JIM_OK;
8383 return JIM_ERR;
8386 static int JimParseExprOperator(struct JimParserCtx *pc)
8388 int i;
8389 int bestIdx = -1, bestLen = 0;
8391 /* Try to get the longest match. */
8392 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8393 const char * const opname = Jim_ExprOperators[i].name;
8394 const int oplen = Jim_ExprOperators[i].namelen;
8396 if (opname == NULL || opname[0] != pc->p[0]) {
8397 continue;
8400 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8401 bestIdx = i + JIM_TT_EXPR_OP;
8402 bestLen = oplen;
8405 if (bestIdx == -1) {
8406 return JIM_ERR;
8409 /* Validate paretheses around function arguments */
8410 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8411 const char *p = pc->p + bestLen;
8412 int len = pc->len - bestLen;
8414 while (len && isspace(UCHAR(*p))) {
8415 len--;
8416 p++;
8418 if (*p != '(') {
8419 return JIM_ERR;
8422 pc->tstart = pc->p;
8423 pc->tend = pc->p + bestLen - 1;
8424 pc->p += bestLen;
8425 pc->len -= bestLen;
8426 pc->tline = pc->linenr;
8428 pc->tt = bestIdx;
8429 return JIM_OK;
8432 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8434 static Jim_ExprOperator dummy_op;
8435 if (opcode < JIM_TT_EXPR_OP) {
8436 return &dummy_op;
8438 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8441 const char *jim_tt_name(int type)
8443 static const char * const tt_names[JIM_TT_EXPR_OP] =
8444 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8445 "DBL", "$()" };
8446 if (type < JIM_TT_EXPR_OP) {
8447 return tt_names[type];
8449 else {
8450 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8451 static char buf[20];
8453 if (op->name) {
8454 return op->name;
8456 sprintf(buf, "(%d)", type);
8457 return buf;
8461 /* -----------------------------------------------------------------------------
8462 * Expression Object
8463 * ---------------------------------------------------------------------------*/
8464 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8465 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8466 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8468 static const Jim_ObjType exprObjType = {
8469 "expression",
8470 FreeExprInternalRep,
8471 DupExprInternalRep,
8472 NULL,
8473 JIM_TYPE_REFERENCES,
8476 /* Expr bytecode structure */
8477 typedef struct ExprByteCode
8479 ScriptToken *token; /* Tokens array. */
8480 int len; /* Length as number of tokens. */
8481 int inUse; /* Used for sharing. */
8482 } ExprByteCode;
8484 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8486 int i;
8488 for (i = 0; i < expr->len; i++) {
8489 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8491 Jim_Free(expr->token);
8492 Jim_Free(expr);
8495 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8497 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8499 if (expr) {
8500 if (--expr->inUse != 0) {
8501 return;
8504 ExprFreeByteCode(interp, expr);
8508 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8510 JIM_NOTUSED(interp);
8511 JIM_NOTUSED(srcPtr);
8513 /* Just returns an simple string. */
8514 dupPtr->typePtr = NULL;
8517 /* Check if an expr program looks correct. */
8518 static int ExprCheckCorrectness(ExprByteCode * expr)
8520 int i;
8521 int stacklen = 0;
8522 int ternary = 0;
8524 /* Try to check if there are stack underflows,
8525 * and make sure at the end of the program there is
8526 * a single result on the stack. */
8527 for (i = 0; i < expr->len; i++) {
8528 ScriptToken *t = &expr->token[i];
8529 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8531 stacklen -= op->arity;
8532 if (stacklen < 0) {
8533 break;
8535 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8536 ternary++;
8538 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8539 ternary--;
8542 /* All operations and operands add one to the stack */
8543 stacklen++;
8545 if (stacklen != 1 || ternary != 0) {
8546 return JIM_ERR;
8548 return JIM_OK;
8551 /* This procedure converts every occurrence of || and && opereators
8552 * in lazy unary versions.
8554 * a b || is converted into:
8556 * a <offset> |L b |R
8558 * a b && is converted into:
8560 * a <offset> &L b &R
8562 * "|L" checks if 'a' is true:
8563 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8564 * the opcode just after |R.
8565 * 2) if it is false does nothing.
8566 * "|R" checks if 'b' is true:
8567 * 1) if it is true pushes 1, otherwise pushes 0.
8569 * "&L" checks if 'a' is true:
8570 * 1) if it is true does nothing.
8571 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8572 * the opcode just after &R
8573 * "&R" checks if 'a' is true:
8574 * if it is true pushes 1, otherwise pushes 0.
8576 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8578 int i;
8580 int leftindex, arity, offset;
8582 /* Search for the end of the first operator */
8583 leftindex = expr->len - 1;
8585 arity = 1;
8586 while (arity) {
8587 ScriptToken *tt = &expr->token[leftindex];
8589 if (tt->type >= JIM_TT_EXPR_OP) {
8590 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8592 arity--;
8593 if (--leftindex < 0) {
8594 return JIM_ERR;
8597 leftindex++;
8599 /* Move them up */
8600 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8601 sizeof(*expr->token) * (expr->len - leftindex));
8602 expr->len += 2;
8603 offset = (expr->len - leftindex) - 1;
8605 /* Now we rely on the fact the the left and right version have opcodes
8606 * 1 and 2 after the main opcode respectively
8608 expr->token[leftindex + 1].type = t->type + 1;
8609 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8611 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8612 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8614 /* Now add the 'R' operator */
8615 expr->token[expr->len].objPtr = interp->emptyObj;
8616 expr->token[expr->len].type = t->type + 2;
8617 expr->len++;
8619 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8620 for (i = leftindex - 1; i > 0; i--) {
8621 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8622 if (op->lazy == LAZY_LEFT) {
8623 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8624 JimWideValue(expr->token[i - 1].objPtr) += 2;
8628 return JIM_OK;
8631 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8633 struct ScriptToken *token = &expr->token[expr->len];
8634 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8636 if (op->lazy == LAZY_OP) {
8637 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8638 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8639 return JIM_ERR;
8642 else {
8643 token->objPtr = interp->emptyObj;
8644 token->type = t->type;
8645 expr->len++;
8647 return JIM_OK;
8651 * Returns the index of the COLON_LEFT to the left of 'right_index'
8652 * taking into account nesting.
8654 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8656 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8658 int ternary_count = 1;
8660 right_index--;
8662 while (right_index > 1) {
8663 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8664 ternary_count--;
8666 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8667 ternary_count++;
8669 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8670 return right_index;
8672 right_index--;
8675 /*notreached*/
8676 return -1;
8680 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8682 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8683 * Otherwise returns 0.
8685 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8687 int i = right_index - 1;
8688 int ternary_count = 1;
8690 while (i > 1) {
8691 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8692 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8693 *prev_right_index = i - 2;
8694 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8695 return 1;
8698 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8699 if (ternary_count == 0) {
8700 return 0;
8702 ternary_count++;
8704 i--;
8706 return 0;
8710 * ExprTernaryReorderExpression description
8711 * ========================================
8713 * ?: is right-to-left associative which doesn't work with the stack-based
8714 * expression engine. The fix is to reorder the bytecode.
8716 * The expression:
8718 * expr 1?2:0?3:4
8720 * Has initial bytecode:
8722 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8723 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8725 * The fix involves simulating this expression instead:
8727 * expr 1?2:(0?3:4)
8729 * With the following bytecode:
8731 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8732 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8734 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8735 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8736 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8737 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8739 * ExprTernaryReorderExpression works thus as follows :
8740 * - start from the end of the stack
8741 * - while walking towards the beginning of the stack
8742 * if token=JIM_EXPROP_COLON_RIGHT then
8743 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8744 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8745 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8746 * if all found then
8747 * perform the rotation
8748 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8749 * end if
8750 * end if
8752 * Note: care has to be taken for nested ternary constructs!!!
8754 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8756 int i;
8758 for (i = expr->len - 1; i > 1; i--) {
8759 int prev_right_index;
8760 int prev_left_index;
8761 int j;
8762 ScriptToken tmp;
8764 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8765 continue;
8768 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8769 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8770 continue;
8774 ** rotate tokens down
8776 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8777 ** | | |
8778 ** | V V
8779 ** | [...] : ...
8780 ** | | |
8781 ** | V V
8782 ** | [...] : ...
8783 ** | | |
8784 ** | V V
8785 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8787 tmp = expr->token[prev_right_index];
8788 for (j = prev_right_index; j < i; j++) {
8789 expr->token[j] = expr->token[j + 1];
8791 expr->token[i] = tmp;
8793 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8795 * This is 'colon left increment' = i - prev_right_index
8797 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8798 * [prev_left_index-1] : skip_count
8801 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8803 /* Adjust for i-- in the loop */
8804 i++;
8808 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8810 Jim_Stack stack;
8811 ExprByteCode *expr;
8812 int ok = 1;
8813 int i;
8814 int prevtt = JIM_TT_NONE;
8815 int have_ternary = 0;
8817 /* -1 for EOL */
8818 int count = tokenlist->count - 1;
8820 expr = Jim_Alloc(sizeof(*expr));
8821 expr->inUse = 1;
8822 expr->len = 0;
8824 Jim_InitStack(&stack);
8826 /* Need extra bytecodes for lazy operators.
8827 * Also check for the ternary operator
8829 for (i = 0; i < tokenlist->count; i++) {
8830 ParseToken *t = &tokenlist->list[i];
8831 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8833 if (op->lazy == LAZY_OP) {
8834 count += 2;
8835 /* Ternary is a lazy op but also needs reordering */
8836 if (t->type == JIM_EXPROP_TERNARY) {
8837 have_ternary = 1;
8842 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8844 for (i = 0; i < tokenlist->count && ok; i++) {
8845 ParseToken *t = &tokenlist->list[i];
8847 /* Next token will be stored here */
8848 struct ScriptToken *token = &expr->token[expr->len];
8850 if (t->type == JIM_TT_EOL) {
8851 break;
8854 switch (t->type) {
8855 case JIM_TT_STR:
8856 case JIM_TT_ESC:
8857 case JIM_TT_VAR:
8858 case JIM_TT_DICTSUGAR:
8859 case JIM_TT_EXPRSUGAR:
8860 case JIM_TT_CMD:
8861 token->type = t->type;
8862 strexpr:
8863 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8864 if (t->type == JIM_TT_CMD) {
8865 /* Only commands need source info */
8866 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8868 expr->len++;
8869 break;
8871 case JIM_TT_EXPR_INT:
8872 case JIM_TT_EXPR_DOUBLE:
8874 char *endptr;
8875 if (t->type == JIM_TT_EXPR_INT) {
8876 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8878 else {
8879 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8881 if (endptr != t->token + t->len) {
8882 /* Conversion failed, so just store it as a string */
8883 Jim_FreeNewObj(interp, token->objPtr);
8884 token->type = JIM_TT_STR;
8885 goto strexpr;
8887 token->type = t->type;
8888 expr->len++;
8890 break;
8892 case JIM_TT_SUBEXPR_START:
8893 Jim_StackPush(&stack, t);
8894 prevtt = JIM_TT_NONE;
8895 continue;
8897 case JIM_TT_SUBEXPR_COMMA:
8898 /* Simple approach. Comma is simply ignored */
8899 continue;
8901 case JIM_TT_SUBEXPR_END:
8902 ok = 0;
8903 while (Jim_StackLen(&stack)) {
8904 ParseToken *tt = Jim_StackPop(&stack);
8906 if (tt->type == JIM_TT_SUBEXPR_START) {
8907 ok = 1;
8908 break;
8911 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8912 goto err;
8915 if (!ok) {
8916 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8917 goto err;
8919 break;
8922 default:{
8923 /* Must be an operator */
8924 const struct Jim_ExprOperator *op;
8925 ParseToken *tt;
8927 /* Convert -/+ to unary minus or unary plus if necessary */
8928 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
8929 if (t->type == JIM_EXPROP_SUB) {
8930 t->type = JIM_EXPROP_UNARYMINUS;
8932 else if (t->type == JIM_EXPROP_ADD) {
8933 t->type = JIM_EXPROP_UNARYPLUS;
8937 op = JimExprOperatorInfoByOpcode(t->type);
8939 /* Now handle precedence */
8940 while ((tt = Jim_StackPeek(&stack)) != NULL) {
8941 const struct Jim_ExprOperator *tt_op =
8942 JimExprOperatorInfoByOpcode(tt->type);
8944 /* Note that right-to-left associativity of ?: operator is handled later */
8946 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
8947 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8948 ok = 0;
8949 goto err;
8951 Jim_StackPop(&stack);
8953 else {
8954 break;
8957 Jim_StackPush(&stack, t);
8958 break;
8961 prevtt = t->type;
8964 /* Reduce any remaining subexpr */
8965 while (Jim_StackLen(&stack)) {
8966 ParseToken *tt = Jim_StackPop(&stack);
8968 if (tt->type == JIM_TT_SUBEXPR_START) {
8969 ok = 0;
8970 Jim_SetResultString(interp, "Missing close parenthesis", -1);
8971 goto err;
8973 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8974 ok = 0;
8975 goto err;
8979 if (have_ternary) {
8980 ExprTernaryReorderExpression(interp, expr);
8983 err:
8984 /* Free the stack used for the compilation. */
8985 Jim_FreeStack(&stack);
8987 for (i = 0; i < expr->len; i++) {
8988 Jim_IncrRefCount(expr->token[i].objPtr);
8991 if (!ok) {
8992 ExprFreeByteCode(interp, expr);
8993 return NULL;
8996 return expr;
9000 /* This method takes the string representation of an expression
9001 * and generates a program for the Expr's stack-based VM. */
9002 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9004 int exprTextLen;
9005 const char *exprText;
9006 struct JimParserCtx parser;
9007 struct ExprByteCode *expr;
9008 ParseTokenList tokenlist;
9009 int line;
9010 Jim_Obj *fileNameObj;
9011 int rc = JIM_ERR;
9013 /* Try to get information about filename / line number */
9014 if (objPtr->typePtr == &sourceObjType) {
9015 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9016 line = objPtr->internalRep.sourceValue.lineNumber;
9018 else {
9019 fileNameObj = interp->emptyObj;
9020 line = 1;
9022 Jim_IncrRefCount(fileNameObj);
9024 exprText = Jim_GetString(objPtr, &exprTextLen);
9026 /* Initially tokenise the expression into tokenlist */
9027 ScriptTokenListInit(&tokenlist);
9029 JimParserInit(&parser, exprText, exprTextLen, line);
9030 while (!parser.eof) {
9031 if (JimParseExpression(&parser) != JIM_OK) {
9032 ScriptTokenListFree(&tokenlist);
9033 invalidexpr:
9034 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9035 expr = NULL;
9036 goto err;
9039 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9040 parser.tline);
9043 #ifdef DEBUG_SHOW_EXPR_TOKENS
9045 int i;
9046 printf("==== Expr Tokens ====\n");
9047 for (i = 0; i < tokenlist.count; i++) {
9048 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9049 tokenlist.list[i].len, tokenlist.list[i].token);
9052 #endif
9054 /* Now create the expression bytecode from the tokenlist */
9055 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9057 /* No longer need the token list */
9058 ScriptTokenListFree(&tokenlist);
9060 if (!expr) {
9061 goto err;
9064 #ifdef DEBUG_SHOW_EXPR
9066 int i;
9068 printf("==== Expr ====\n");
9069 for (i = 0; i < expr->len; i++) {
9070 ScriptToken *t = &expr->token[i];
9072 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9075 #endif
9077 /* Check program correctness. */
9078 if (ExprCheckCorrectness(expr) != JIM_OK) {
9079 ExprFreeByteCode(interp, expr);
9080 goto invalidexpr;
9083 rc = JIM_OK;
9085 err:
9086 /* Free the old internal rep and set the new one. */
9087 Jim_DecrRefCount(interp, fileNameObj);
9088 Jim_FreeIntRep(interp, objPtr);
9089 Jim_SetIntRepPtr(objPtr, expr);
9090 objPtr->typePtr = &exprObjType;
9091 return rc;
9094 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9096 if (objPtr->typePtr != &exprObjType) {
9097 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9098 return NULL;
9101 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9104 /* -----------------------------------------------------------------------------
9105 * Expressions evaluation.
9106 * Jim uses a specialized stack-based virtual machine for expressions,
9107 * that takes advantage of the fact that expr's operators
9108 * can't be redefined.
9110 * Jim_EvalExpression() uses the bytecode compiled by
9111 * SetExprFromAny() method of the "expression" object.
9113 * On success a Tcl Object containing the result of the evaluation
9114 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9115 * returned.
9116 * On error the function returns a retcode != to JIM_OK and set a suitable
9117 * error on the interp.
9118 * ---------------------------------------------------------------------------*/
9119 #define JIM_EE_STATICSTACK_LEN 10
9121 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9123 ExprByteCode *expr;
9124 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9125 int i;
9126 int retcode = JIM_OK;
9127 struct JimExprState e;
9129 expr = JimGetExpression(interp, exprObjPtr);
9130 if (!expr) {
9131 return JIM_ERR; /* error in expression. */
9134 #ifdef JIM_OPTIMIZATION
9135 /* Check for one of the following common expressions used by while/for
9137 * CONST
9138 * $a
9139 * !$a
9140 * $a < CONST, $a < $b
9141 * $a <= CONST, $a <= $b
9142 * $a > CONST, $a > $b
9143 * $a >= CONST, $a >= $b
9144 * $a != CONST, $a != $b
9145 * $a == CONST, $a == $b
9148 Jim_Obj *objPtr;
9150 /* STEP 1 -- Check if there are the conditions to run the specialized
9151 * version of while */
9153 switch (expr->len) {
9154 case 1:
9155 if (expr->token[0].type == JIM_TT_EXPR_INT) {
9156 *exprResultPtrPtr = expr->token[0].objPtr;
9157 Jim_IncrRefCount(*exprResultPtrPtr);
9158 return JIM_OK;
9160 if (expr->token[0].type == JIM_TT_VAR) {
9161 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
9162 if (objPtr) {
9163 *exprResultPtrPtr = objPtr;
9164 Jim_IncrRefCount(*exprResultPtrPtr);
9165 return JIM_OK;
9168 break;
9170 case 2:
9171 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
9172 jim_wide wideValue;
9174 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9175 if (objPtr && JimIsWide(objPtr)
9176 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
9177 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
9178 Jim_IncrRefCount(*exprResultPtrPtr);
9179 return JIM_OK;
9182 break;
9184 case 3:
9185 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
9186 || expr->token[1].type == JIM_TT_VAR)) {
9187 switch (expr->token[2].type) {
9188 case JIM_EXPROP_LT:
9189 case JIM_EXPROP_LTE:
9190 case JIM_EXPROP_GT:
9191 case JIM_EXPROP_GTE:
9192 case JIM_EXPROP_NUMEQ:
9193 case JIM_EXPROP_NUMNE:{
9194 /* optimise ok */
9195 jim_wide wideValueA;
9196 jim_wide wideValueB;
9198 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9199 if (objPtr && JimIsWide(objPtr)
9200 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
9201 if (expr->token[1].type == JIM_TT_VAR) {
9202 objPtr =
9203 Jim_GetVariable(interp, expr->token[1].objPtr,
9204 JIM_NONE);
9206 else {
9207 objPtr = expr->token[1].objPtr;
9209 if (objPtr && JimIsWide(objPtr)
9210 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
9211 int cmpRes;
9213 switch (expr->token[2].type) {
9214 case JIM_EXPROP_LT:
9215 cmpRes = wideValueA < wideValueB;
9216 break;
9217 case JIM_EXPROP_LTE:
9218 cmpRes = wideValueA <= wideValueB;
9219 break;
9220 case JIM_EXPROP_GT:
9221 cmpRes = wideValueA > wideValueB;
9222 break;
9223 case JIM_EXPROP_GTE:
9224 cmpRes = wideValueA >= wideValueB;
9225 break;
9226 case JIM_EXPROP_NUMEQ:
9227 cmpRes = wideValueA == wideValueB;
9228 break;
9229 case JIM_EXPROP_NUMNE:
9230 cmpRes = wideValueA != wideValueB;
9231 break;
9232 default: /*notreached */
9233 cmpRes = 0;
9235 *exprResultPtrPtr =
9236 cmpRes ? interp->trueObj : interp->falseObj;
9237 Jim_IncrRefCount(*exprResultPtrPtr);
9238 return JIM_OK;
9244 break;
9247 #endif
9249 /* In order to avoid that the internal repr gets freed due to
9250 * shimmering of the exprObjPtr's object, we make the internal rep
9251 * shared. */
9252 expr->inUse++;
9254 /* The stack-based expr VM itself */
9256 /* Stack allocation. Expr programs have the feature that
9257 * a program of length N can't require a stack longer than
9258 * N. */
9259 if (expr->len > JIM_EE_STATICSTACK_LEN)
9260 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9261 else
9262 e.stack = staticStack;
9264 e.stacklen = 0;
9266 /* Execute every instruction */
9267 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9268 Jim_Obj *objPtr;
9270 switch (expr->token[i].type) {
9271 case JIM_TT_EXPR_INT:
9272 case JIM_TT_EXPR_DOUBLE:
9273 case JIM_TT_STR:
9274 ExprPush(&e, expr->token[i].objPtr);
9275 break;
9277 case JIM_TT_VAR:
9278 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9279 if (objPtr) {
9280 ExprPush(&e, objPtr);
9282 else {
9283 retcode = JIM_ERR;
9285 break;
9287 case JIM_TT_DICTSUGAR:
9288 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9289 if (objPtr) {
9290 ExprPush(&e, objPtr);
9292 else {
9293 retcode = JIM_ERR;
9295 break;
9297 case JIM_TT_ESC:
9298 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9299 if (retcode == JIM_OK) {
9300 ExprPush(&e, objPtr);
9302 break;
9304 case JIM_TT_CMD:
9305 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9306 if (retcode == JIM_OK) {
9307 ExprPush(&e, Jim_GetResult(interp));
9309 break;
9311 default:{
9312 /* Find and execute the operation */
9313 e.skip = 0;
9314 e.opcode = expr->token[i].type;
9316 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9317 /* Skip some opcodes if necessary */
9318 i += e.skip;
9319 continue;
9324 expr->inUse--;
9326 if (retcode == JIM_OK) {
9327 *exprResultPtrPtr = ExprPop(&e);
9329 else {
9330 for (i = 0; i < e.stacklen; i++) {
9331 Jim_DecrRefCount(interp, e.stack[i]);
9334 if (e.stack != staticStack) {
9335 Jim_Free(e.stack);
9337 return retcode;
9340 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9342 int retcode;
9343 jim_wide wideValue;
9344 double doubleValue;
9345 Jim_Obj *exprResultPtr;
9347 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9348 if (retcode != JIM_OK)
9349 return retcode;
9351 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9352 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9353 Jim_DecrRefCount(interp, exprResultPtr);
9354 return JIM_ERR;
9356 else {
9357 Jim_DecrRefCount(interp, exprResultPtr);
9358 *boolPtr = doubleValue != 0;
9359 return JIM_OK;
9362 *boolPtr = wideValue != 0;
9364 Jim_DecrRefCount(interp, exprResultPtr);
9365 return JIM_OK;
9368 /* -----------------------------------------------------------------------------
9369 * ScanFormat String Object
9370 * ---------------------------------------------------------------------------*/
9372 /* This Jim_Obj will held a parsed representation of a format string passed to
9373 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9374 * to be parsed in its entirely first and then, if correct, can be used for
9375 * scanning. To avoid endless re-parsing, the parsed representation will be
9376 * stored in an internal representation and re-used for performance reason. */
9378 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9379 * scanformat string. This part will later be used to extract information
9380 * out from the string to be parsed by Jim_ScanString */
9382 typedef struct ScanFmtPartDescr
9384 char *arg; /* Specification of a CHARSET conversion */
9385 char *prefix; /* Prefix to be scanned literally before conversion */
9386 size_t width; /* Maximal width of input to be converted */
9387 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9388 char type; /* Type of conversion (e.g. c, d, f) */
9389 char modifier; /* Modify type (e.g. l - long, h - short */
9390 } ScanFmtPartDescr;
9392 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9393 * string parsed and separated in part descriptions. Furthermore it contains
9394 * the original string representation of the scanformat string to allow for
9395 * fast update of the Jim_Obj's string representation part.
9397 * As an add-on the internal object representation adds some scratch pad area
9398 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9399 * memory for purpose of string scanning.
9401 * The error member points to a static allocated string in case of a mal-
9402 * formed scanformat string or it contains '0' (NULL) in case of a valid
9403 * parse representation.
9405 * The whole memory of the internal representation is allocated as a single
9406 * area of memory that will be internally separated. So freeing and duplicating
9407 * of such an object is cheap */
9409 typedef struct ScanFmtStringObj
9411 jim_wide size; /* Size of internal repr in bytes */
9412 char *stringRep; /* Original string representation */
9413 size_t count; /* Number of ScanFmtPartDescr contained */
9414 size_t convCount; /* Number of conversions that will assign */
9415 size_t maxPos; /* Max position index if XPG3 is used */
9416 const char *error; /* Ptr to error text (NULL if no error */
9417 char *scratch; /* Some scratch pad used by Jim_ScanString */
9418 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9419 } ScanFmtStringObj;
9422 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9423 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9424 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9426 static const Jim_ObjType scanFmtStringObjType = {
9427 "scanformatstring",
9428 FreeScanFmtInternalRep,
9429 DupScanFmtInternalRep,
9430 UpdateStringOfScanFmt,
9431 JIM_TYPE_NONE,
9434 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9436 JIM_NOTUSED(interp);
9437 Jim_Free((char *)objPtr->internalRep.ptr);
9438 objPtr->internalRep.ptr = 0;
9441 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9443 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9444 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9446 JIM_NOTUSED(interp);
9447 memcpy(newVec, srcPtr->internalRep.ptr, size);
9448 dupPtr->internalRep.ptr = newVec;
9449 dupPtr->typePtr = &scanFmtStringObjType;
9452 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9454 char *bytes = ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep;
9456 objPtr->bytes = Jim_StrDup(bytes);
9457 objPtr->length = strlen(bytes);
9460 /* SetScanFmtFromAny will parse a given string and create the internal
9461 * representation of the format specification. In case of an error
9462 * the error data member of the internal representation will be set
9463 * to an descriptive error text and the function will be left with
9464 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9465 * specification */
9467 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9469 ScanFmtStringObj *fmtObj;
9470 char *buffer;
9471 int maxCount, i, approxSize, lastPos = -1;
9472 const char *fmt = objPtr->bytes;
9473 int maxFmtLen = objPtr->length;
9474 const char *fmtEnd = fmt + maxFmtLen;
9475 int curr;
9477 Jim_FreeIntRep(interp, objPtr);
9478 /* Count how many conversions could take place maximally */
9479 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9480 if (fmt[i] == '%')
9481 ++maxCount;
9482 /* Calculate an approximation of the memory necessary */
9483 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9484 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9485 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9486 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9487 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9488 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9489 +1; /* safety byte */
9490 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9491 memset(fmtObj, 0, approxSize);
9492 fmtObj->size = approxSize;
9493 fmtObj->maxPos = 0;
9494 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9495 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9496 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9497 buffer = fmtObj->stringRep + maxFmtLen + 1;
9498 objPtr->internalRep.ptr = fmtObj;
9499 objPtr->typePtr = &scanFmtStringObjType;
9500 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9501 int width = 0, skip;
9502 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9504 fmtObj->count++;
9505 descr->width = 0; /* Assume width unspecified */
9506 /* Overread and store any "literal" prefix */
9507 if (*fmt != '%' || fmt[1] == '%') {
9508 descr->type = 0;
9509 descr->prefix = &buffer[i];
9510 for (; fmt < fmtEnd; ++fmt) {
9511 if (*fmt == '%') {
9512 if (fmt[1] != '%')
9513 break;
9514 ++fmt;
9516 buffer[i++] = *fmt;
9518 buffer[i++] = 0;
9520 /* Skip the conversion introducing '%' sign */
9521 ++fmt;
9522 /* End reached due to non-conversion literal only? */
9523 if (fmt >= fmtEnd)
9524 goto done;
9525 descr->pos = 0; /* Assume "natural" positioning */
9526 if (*fmt == '*') {
9527 descr->pos = -1; /* Okay, conversion will not be assigned */
9528 ++fmt;
9530 else
9531 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9532 /* Check if next token is a number (could be width or pos */
9533 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9534 fmt += skip;
9535 /* Was the number a XPG3 position specifier? */
9536 if (descr->pos != -1 && *fmt == '$') {
9537 int prev;
9539 ++fmt;
9540 descr->pos = width;
9541 width = 0;
9542 /* Look if "natural" postioning and XPG3 one was mixed */
9543 if ((lastPos == 0 && descr->pos > 0)
9544 || (lastPos > 0 && descr->pos == 0)) {
9545 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9546 return JIM_ERR;
9548 /* Look if this position was already used */
9549 for (prev = 0; prev < curr; ++prev) {
9550 if (fmtObj->descr[prev].pos == -1)
9551 continue;
9552 if (fmtObj->descr[prev].pos == descr->pos) {
9553 fmtObj->error =
9554 "variable is assigned by multiple \"%n$\" conversion specifiers";
9555 return JIM_ERR;
9558 /* Try to find a width after the XPG3 specifier */
9559 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9560 descr->width = width;
9561 fmt += skip;
9563 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9564 fmtObj->maxPos = descr->pos;
9566 else {
9567 /* Number was not a XPG3, so it has to be a width */
9568 descr->width = width;
9571 /* If positioning mode was undetermined yet, fix this */
9572 if (lastPos == -1)
9573 lastPos = descr->pos;
9574 /* Handle CHARSET conversion type ... */
9575 if (*fmt == '[') {
9576 int swapped = 1, beg = i, end, j;
9578 descr->type = '[';
9579 descr->arg = &buffer[i];
9580 ++fmt;
9581 if (*fmt == '^')
9582 buffer[i++] = *fmt++;
9583 if (*fmt == ']')
9584 buffer[i++] = *fmt++;
9585 while (*fmt && *fmt != ']')
9586 buffer[i++] = *fmt++;
9587 if (*fmt != ']') {
9588 fmtObj->error = "unmatched [ in format string";
9589 return JIM_ERR;
9591 end = i;
9592 buffer[i++] = 0;
9593 /* In case a range fence was given "backwards", swap it */
9594 while (swapped) {
9595 swapped = 0;
9596 for (j = beg + 1; j < end - 1; ++j) {
9597 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9598 char tmp = buffer[j - 1];
9600 buffer[j - 1] = buffer[j + 1];
9601 buffer[j + 1] = tmp;
9602 swapped = 1;
9607 else {
9608 /* Remember any valid modifier if given */
9609 if (strchr("hlL", *fmt) != 0)
9610 descr->modifier = tolower((int)*fmt++);
9612 descr->type = *fmt;
9613 if (strchr("efgcsndoxui", *fmt) == 0) {
9614 fmtObj->error = "bad scan conversion character";
9615 return JIM_ERR;
9617 else if (*fmt == 'c' && descr->width != 0) {
9618 fmtObj->error = "field width may not be specified in %c " "conversion";
9619 return JIM_ERR;
9621 else if (*fmt == 'u' && descr->modifier == 'l') {
9622 fmtObj->error = "unsigned wide not supported";
9623 return JIM_ERR;
9626 curr++;
9628 done:
9629 return JIM_OK;
9632 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9634 #define FormatGetCnvCount(_fo_) \
9635 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9636 #define FormatGetMaxPos(_fo_) \
9637 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9638 #define FormatGetError(_fo_) \
9639 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9641 /* JimScanAString is used to scan an unspecified string that ends with
9642 * next WS, or a string that is specified via a charset.
9645 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9647 char *buffer = Jim_StrDup(str);
9648 char *p = buffer;
9650 while (*str) {
9651 int c;
9652 int n;
9654 if (!sdescr && isspace(UCHAR(*str)))
9655 break; /* EOS via WS if unspecified */
9657 n = utf8_tounicode(str, &c);
9658 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9659 break;
9660 while (n--)
9661 *p++ = *str++;
9663 *p = 0;
9664 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9667 /* ScanOneEntry will scan one entry out of the string passed as argument.
9668 * It use the sscanf() function for this task. After extracting and
9669 * converting of the value, the count of scanned characters will be
9670 * returned of -1 in case of no conversion tool place and string was
9671 * already scanned thru */
9673 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9674 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9676 const char *tok;
9677 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9678 size_t scanned = 0;
9679 size_t anchor = pos;
9680 int i;
9681 Jim_Obj *tmpObj = NULL;
9683 /* First pessimistically assume, we will not scan anything :-) */
9684 *valObjPtr = 0;
9685 if (descr->prefix) {
9686 /* There was a prefix given before the conversion, skip it and adjust
9687 * the string-to-be-parsed accordingly */
9688 /* XXX: Should be checking strLen, not str[pos] */
9689 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9690 /* If prefix require, skip WS */
9691 if (isspace(UCHAR(descr->prefix[i])))
9692 while (pos < strLen && isspace(UCHAR(str[pos])))
9693 ++pos;
9694 else if (descr->prefix[i] != str[pos])
9695 break; /* Prefix do not match here, leave the loop */
9696 else
9697 ++pos; /* Prefix matched so far, next round */
9699 if (pos >= strLen) {
9700 return -1; /* All of str consumed: EOF condition */
9702 else if (descr->prefix[i] != 0)
9703 return 0; /* Not whole prefix consumed, no conversion possible */
9705 /* For all but following conversion, skip leading WS */
9706 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9707 while (isspace(UCHAR(str[pos])))
9708 ++pos;
9709 /* Determine how much skipped/scanned so far */
9710 scanned = pos - anchor;
9712 /* %c is a special, simple case. no width */
9713 if (descr->type == 'n') {
9714 /* Return pseudo conversion means: how much scanned so far? */
9715 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9717 else if (pos >= strLen) {
9718 /* Cannot scan anything, as str is totally consumed */
9719 return -1;
9721 else if (descr->type == 'c') {
9722 int c;
9723 scanned += utf8_tounicode(&str[pos], &c);
9724 *valObjPtr = Jim_NewIntObj(interp, c);
9725 return scanned;
9727 else {
9728 /* Processing of conversions follows ... */
9729 if (descr->width > 0) {
9730 /* Do not try to scan as fas as possible but only the given width.
9731 * To ensure this, we copy the part that should be scanned. */
9732 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9733 size_t tLen = descr->width > sLen ? sLen : descr->width;
9735 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9736 tok = tmpObj->bytes;
9738 else {
9739 /* As no width was given, simply refer to the original string */
9740 tok = &str[pos];
9742 switch (descr->type) {
9743 case 'd':
9744 case 'o':
9745 case 'x':
9746 case 'u':
9747 case 'i':{
9748 char *endp; /* Position where the number finished */
9749 jim_wide w;
9751 int base = descr->type == 'o' ? 8
9752 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9754 /* Try to scan a number with the given base */
9755 if (base == 0) {
9756 w = jim_strtoull(tok, &endp);
9758 else {
9759 w = strtoull(tok, &endp, base);
9762 if (endp != tok) {
9763 /* There was some number sucessfully scanned! */
9764 *valObjPtr = Jim_NewIntObj(interp, w);
9766 /* Adjust the number-of-chars scanned so far */
9767 scanned += endp - tok;
9769 else {
9770 /* Nothing was scanned. We have to determine if this
9771 * happened due to e.g. prefix mismatch or input str
9772 * exhausted */
9773 scanned = *tok ? 0 : -1;
9775 break;
9777 case 's':
9778 case '[':{
9779 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9780 scanned += Jim_Length(*valObjPtr);
9781 break;
9783 case 'e':
9784 case 'f':
9785 case 'g':{
9786 char *endp;
9787 double value = strtod(tok, &endp);
9789 if (endp != tok) {
9790 /* There was some number sucessfully scanned! */
9791 *valObjPtr = Jim_NewDoubleObj(interp, value);
9792 /* Adjust the number-of-chars scanned so far */
9793 scanned += endp - tok;
9795 else {
9796 /* Nothing was scanned. We have to determine if this
9797 * happened due to e.g. prefix mismatch or input str
9798 * exhausted */
9799 scanned = *tok ? 0 : -1;
9801 break;
9804 /* If a substring was allocated (due to pre-defined width) do not
9805 * forget to free it */
9806 if (tmpObj) {
9807 Jim_FreeNewObj(interp, tmpObj);
9810 return scanned;
9813 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9814 * string and returns all converted (and not ignored) values in a list back
9815 * to the caller. If an error occured, a NULL pointer will be returned */
9817 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9819 size_t i, pos;
9820 int scanned = 1;
9821 const char *str = Jim_String(strObjPtr);
9822 int strLen = Jim_Utf8Length(interp, strObjPtr);
9823 Jim_Obj *resultList = 0;
9824 Jim_Obj **resultVec = 0;
9825 int resultc;
9826 Jim_Obj *emptyStr = 0;
9827 ScanFmtStringObj *fmtObj;
9829 /* This should never happen. The format object should already be of the correct type */
9830 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9832 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9833 /* Check if format specification was valid */
9834 if (fmtObj->error != 0) {
9835 if (flags & JIM_ERRMSG)
9836 Jim_SetResultString(interp, fmtObj->error, -1);
9837 return 0;
9839 /* Allocate a new "shared" empty string for all unassigned conversions */
9840 emptyStr = Jim_NewEmptyStringObj(interp);
9841 Jim_IncrRefCount(emptyStr);
9842 /* Create a list and fill it with empty strings up to max specified XPG3 */
9843 resultList = Jim_NewListObj(interp, NULL, 0);
9844 if (fmtObj->maxPos > 0) {
9845 for (i = 0; i < fmtObj->maxPos; ++i)
9846 Jim_ListAppendElement(interp, resultList, emptyStr);
9847 JimListGetElements(interp, resultList, &resultc, &resultVec);
9849 /* Now handle every partial format description */
9850 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9851 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9852 Jim_Obj *value = 0;
9854 /* Only last type may be "literal" w/o conversion - skip it! */
9855 if (descr->type == 0)
9856 continue;
9857 /* As long as any conversion could be done, we will proceed */
9858 if (scanned > 0)
9859 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9860 /* In case our first try results in EOF, we will leave */
9861 if (scanned == -1 && i == 0)
9862 goto eof;
9863 /* Advance next pos-to-be-scanned for the amount scanned already */
9864 pos += scanned;
9866 /* value == 0 means no conversion took place so take empty string */
9867 if (value == 0)
9868 value = Jim_NewEmptyStringObj(interp);
9869 /* If value is a non-assignable one, skip it */
9870 if (descr->pos == -1) {
9871 Jim_FreeNewObj(interp, value);
9873 else if (descr->pos == 0)
9874 /* Otherwise append it to the result list if no XPG3 was given */
9875 Jim_ListAppendElement(interp, resultList, value);
9876 else if (resultVec[descr->pos - 1] == emptyStr) {
9877 /* But due to given XPG3, put the value into the corr. slot */
9878 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9879 Jim_IncrRefCount(value);
9880 resultVec[descr->pos - 1] = value;
9882 else {
9883 /* Otherwise, the slot was already used - free obj and ERROR */
9884 Jim_FreeNewObj(interp, value);
9885 goto err;
9888 Jim_DecrRefCount(interp, emptyStr);
9889 return resultList;
9890 eof:
9891 Jim_DecrRefCount(interp, emptyStr);
9892 Jim_FreeNewObj(interp, resultList);
9893 return (Jim_Obj *)EOF;
9894 err:
9895 Jim_DecrRefCount(interp, emptyStr);
9896 Jim_FreeNewObj(interp, resultList);
9897 return 0;
9900 /* -----------------------------------------------------------------------------
9901 * Pseudo Random Number Generation
9902 * ---------------------------------------------------------------------------*/
9903 /* Initialize the sbox with the numbers from 0 to 255 */
9904 static void JimPrngInit(Jim_Interp *interp)
9906 #define PRNG_SEED_SIZE 256
9907 int i;
9908 unsigned int *seed;
9909 time_t t = time(NULL);
9911 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9913 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9914 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9915 seed[i] = (rand() ^ t ^ clock());
9917 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9918 Jim_Free(seed);
9921 /* Generates N bytes of random data */
9922 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9924 Jim_PrngState *prng;
9925 unsigned char *destByte = (unsigned char *)dest;
9926 unsigned int si, sj, x;
9928 /* initialization, only needed the first time */
9929 if (interp->prngState == NULL)
9930 JimPrngInit(interp);
9931 prng = interp->prngState;
9932 /* generates 'len' bytes of pseudo-random numbers */
9933 for (x = 0; x < len; x++) {
9934 prng->i = (prng->i + 1) & 0xff;
9935 si = prng->sbox[prng->i];
9936 prng->j = (prng->j + si) & 0xff;
9937 sj = prng->sbox[prng->j];
9938 prng->sbox[prng->i] = sj;
9939 prng->sbox[prng->j] = si;
9940 *destByte++ = prng->sbox[(si + sj) & 0xff];
9944 /* Re-seed the generator with user-provided bytes */
9945 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9947 int i;
9948 Jim_PrngState *prng;
9950 /* initialization, only needed the first time */
9951 if (interp->prngState == NULL)
9952 JimPrngInit(interp);
9953 prng = interp->prngState;
9955 /* Set the sbox[i] with i */
9956 for (i = 0; i < 256; i++)
9957 prng->sbox[i] = i;
9958 /* Now use the seed to perform a random permutation of the sbox */
9959 for (i = 0; i < seedLen; i++) {
9960 unsigned char t;
9962 t = prng->sbox[i & 0xFF];
9963 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9964 prng->sbox[seed[i]] = t;
9966 prng->i = prng->j = 0;
9968 /* discard at least the first 256 bytes of stream.
9969 * borrow the seed buffer for this
9971 for (i = 0; i < 256; i += seedLen) {
9972 JimRandomBytes(interp, seed, seedLen);
9976 /* [incr] */
9977 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9979 jim_wide wideValue, increment = 1;
9980 Jim_Obj *intObjPtr;
9982 if (argc != 2 && argc != 3) {
9983 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9984 return JIM_ERR;
9986 if (argc == 3) {
9987 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9988 return JIM_ERR;
9990 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
9991 if (!intObjPtr) {
9992 /* Set missing variable to 0 */
9993 wideValue = 0;
9995 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
9996 return JIM_ERR;
9998 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
9999 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10000 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10001 Jim_FreeNewObj(interp, intObjPtr);
10002 return JIM_ERR;
10005 else {
10006 /* Can do it the quick way */
10007 Jim_InvalidateStringRep(intObjPtr);
10008 JimWideValue(intObjPtr) = wideValue + increment;
10010 /* The following step is required in order to invalidate the
10011 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10012 if (argv[1]->typePtr != &variableObjType) {
10013 /* Note that this can't fail since GetVariable already succeeded */
10014 Jim_SetVariable(interp, argv[1], intObjPtr);
10017 Jim_SetResult(interp, intObjPtr);
10018 return JIM_OK;
10022 /* -----------------------------------------------------------------------------
10023 * Eval
10024 * ---------------------------------------------------------------------------*/
10025 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10026 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10028 /* Handle calls to the [unknown] command */
10029 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10031 int retcode;
10033 /* If JimUnknown() is recursively called too many times...
10034 * done here
10036 if (interp->unknown_called > 50) {
10037 return JIM_ERR;
10040 /* The object interp->unknown just contains
10041 * the "unknown" string, it is used in order to
10042 * avoid to lookup the unknown command every time
10043 * but instead to cache the result. */
10045 /* If the [unknown] command does not exist ... */
10046 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10047 return JIM_ERR;
10049 interp->unknown_called++;
10050 /* XXX: Are we losing fileNameObj and linenr? */
10051 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10052 interp->unknown_called--;
10054 return retcode;
10057 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10059 int retcode;
10060 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10062 if (cmdPtr == NULL) {
10063 return JimUnknown(interp, objc, objv);
10065 if (interp->evalDepth == interp->maxEvalDepth) {
10066 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10067 return JIM_ERR;
10069 interp->evalDepth++;
10071 /* Call it -- Make sure result is an empty object. */
10072 JimIncrCmdRefCount(cmdPtr);
10073 Jim_SetEmptyResult(interp);
10074 if (cmdPtr->isproc) {
10075 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10077 else {
10078 interp->cmdPrivData = cmdPtr->u.native.privData;
10079 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10081 JimDecrCmdRefCount(interp, cmdPtr);
10082 interp->evalDepth--;
10084 return retcode;
10087 /* Eval the object vector 'objv' composed of 'objc' elements.
10088 * Every element is used as single argument.
10089 * Jim_EvalObj() will call this function every time its object
10090 * argument is of "list" type, with no string representation.
10092 * This is possible because the string representation of a
10093 * list object generated by the UpdateStringOfList is made
10094 * in a way that ensures that every list element is a different
10095 * command argument. */
10096 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10098 int i, retcode;
10100 /* Incr refcount of arguments. */
10101 for (i = 0; i < objc; i++)
10102 Jim_IncrRefCount(objv[i]);
10104 retcode = JimInvokeCommand(interp, objc, objv);
10106 /* Decr refcount of arguments and return the retcode */
10107 for (i = 0; i < objc; i++)
10108 Jim_DecrRefCount(interp, objv[i]);
10110 return retcode;
10114 * Invokes 'prefix' as a command with the objv array as arguments.
10116 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10118 int ret;
10119 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10121 nargv[0] = prefix;
10122 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10123 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10124 Jim_Free(nargv);
10125 return ret;
10128 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10130 int rc = retcode;
10132 if (rc == JIM_ERR && !interp->errorFlag) {
10133 /* This is the first error, so save the file/line information and reset the stack */
10134 interp->errorFlag = 1;
10135 Jim_IncrRefCount(script->fileNameObj);
10136 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10137 interp->errorFileNameObj = script->fileNameObj;
10138 interp->errorLine = script->linenr;
10140 JimResetStackTrace(interp);
10141 /* Always add a level where the error first occurs */
10142 interp->addStackTrace++;
10145 /* Now if this is an "interesting" level, add it to the stack trace */
10146 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10147 /* Add the stack info for the current level */
10149 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10151 /* Note: if we didn't have a filename for this level,
10152 * don't clear the addStackTrace flag
10153 * so we can pick it up at the next level
10155 if (Jim_Length(script->fileNameObj)) {
10156 interp->addStackTrace = 0;
10159 Jim_DecrRefCount(interp, interp->errorProc);
10160 interp->errorProc = interp->emptyObj;
10161 Jim_IncrRefCount(interp->errorProc);
10163 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10164 /* Propagate the addStackTrace value through 'return -code error' */
10166 else {
10167 interp->addStackTrace = 0;
10171 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10173 Jim_Obj *objPtr;
10175 switch (token->type) {
10176 case JIM_TT_STR:
10177 case JIM_TT_ESC:
10178 objPtr = token->objPtr;
10179 break;
10180 case JIM_TT_VAR:
10181 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10182 break;
10183 case JIM_TT_DICTSUGAR:
10184 objPtr = JimExpandDictSugar(interp, token->objPtr);
10185 break;
10186 case JIM_TT_EXPRSUGAR:
10187 objPtr = JimExpandExprSugar(interp, token->objPtr);
10188 break;
10189 case JIM_TT_CMD:
10190 switch (Jim_EvalObj(interp, token->objPtr)) {
10191 case JIM_OK:
10192 case JIM_RETURN:
10193 objPtr = interp->result;
10194 break;
10195 case JIM_BREAK:
10196 /* Stop substituting */
10197 return JIM_BREAK;
10198 case JIM_CONTINUE:
10199 /* just skip this one */
10200 return JIM_CONTINUE;
10201 default:
10202 return JIM_ERR;
10204 break;
10205 default:
10206 JimPanic((1,
10207 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10208 objPtr = NULL;
10209 break;
10211 if (objPtr) {
10212 *objPtrPtr = objPtr;
10213 return JIM_OK;
10215 return JIM_ERR;
10218 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10219 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10220 * The returned object has refcount = 0.
10222 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10224 int totlen = 0, i;
10225 Jim_Obj **intv;
10226 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10227 Jim_Obj *objPtr;
10228 char *s;
10230 if (tokens <= JIM_EVAL_SINTV_LEN)
10231 intv = sintv;
10232 else
10233 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10235 /* Compute every token forming the argument
10236 * in the intv objects vector. */
10237 for (i = 0; i < tokens; i++) {
10238 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10239 case JIM_OK:
10240 case JIM_RETURN:
10241 break;
10242 case JIM_BREAK:
10243 if (flags & JIM_SUBST_FLAG) {
10244 /* Stop here */
10245 tokens = i;
10246 continue;
10248 /* XXX: Should probably set an error about break outside loop */
10249 /* fall through to error */
10250 case JIM_CONTINUE:
10251 if (flags & JIM_SUBST_FLAG) {
10252 intv[i] = NULL;
10253 continue;
10255 /* XXX: Ditto continue outside loop */
10256 /* fall through to error */
10257 default:
10258 while (i--) {
10259 Jim_DecrRefCount(interp, intv[i]);
10261 if (intv != sintv) {
10262 Jim_Free(intv);
10264 return NULL;
10266 Jim_IncrRefCount(intv[i]);
10267 Jim_String(intv[i]);
10268 totlen += intv[i]->length;
10271 /* Fast path return for a single token */
10272 if (tokens == 1 && intv[0] && intv == sintv) {
10273 Jim_DecrRefCount(interp, intv[0]);
10274 return intv[0];
10277 /* Concatenate every token in an unique
10278 * object. */
10279 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10281 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10282 && token[2].type == JIM_TT_VAR) {
10283 /* May be able to do fast interpolated object -> dictSubst */
10284 objPtr->typePtr = &interpolatedObjType;
10285 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10286 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10287 Jim_IncrRefCount(intv[2]);
10290 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10291 objPtr->length = totlen;
10292 for (i = 0; i < tokens; i++) {
10293 if (intv[i]) {
10294 memcpy(s, intv[i]->bytes, intv[i]->length);
10295 s += intv[i]->length;
10296 Jim_DecrRefCount(interp, intv[i]);
10299 objPtr->bytes[totlen] = '\0';
10300 /* Free the intv vector if not static. */
10301 if (intv != sintv) {
10302 Jim_Free(intv);
10305 return objPtr;
10309 /* listPtr *must* be a list.
10310 * The contents of the list is evaluated with the first element as the command and
10311 * the remaining elements as the arguments.
10313 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10315 int retcode = JIM_OK;
10317 if (listPtr->internalRep.listValue.len) {
10318 Jim_IncrRefCount(listPtr);
10319 retcode = JimInvokeCommand(interp,
10320 listPtr->internalRep.listValue.len,
10321 listPtr->internalRep.listValue.ele);
10322 Jim_DecrRefCount(interp, listPtr);
10324 return retcode;
10327 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10329 SetListFromAny(interp, listPtr);
10330 return JimEvalObjList(interp, listPtr);
10333 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10335 int i;
10336 ScriptObj *script;
10337 ScriptToken *token;
10338 int retcode = JIM_OK;
10339 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10340 Jim_Obj *prevScriptObj;
10342 /* If the object is of type "list", with no string rep we can call
10343 * a specialized version of Jim_EvalObj() */
10344 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10345 return JimEvalObjList(interp, scriptObjPtr);
10348 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10349 script = Jim_GetScript(interp, scriptObjPtr);
10351 /* Reset the interpreter result. This is useful to
10352 * return the empty result in the case of empty program. */
10353 Jim_SetEmptyResult(interp);
10355 token = script->token;
10357 #ifdef JIM_OPTIMIZATION
10358 /* Check for one of the following common scripts used by for, while
10360 * {}
10361 * incr a
10363 if (script->len == 0) {
10364 Jim_DecrRefCount(interp, scriptObjPtr);
10365 return JIM_OK;
10367 if (script->len == 3
10368 && token[1].objPtr->typePtr == &commandObjType
10369 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10370 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10371 && token[2].objPtr->typePtr == &variableObjType) {
10373 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10375 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10376 JimWideValue(objPtr)++;
10377 Jim_InvalidateStringRep(objPtr);
10378 Jim_DecrRefCount(interp, scriptObjPtr);
10379 Jim_SetResult(interp, objPtr);
10380 return JIM_OK;
10383 #endif
10385 /* Now we have to make sure the internal repr will not be
10386 * freed on shimmering.
10388 * Think for example to this:
10390 * set x {llength $x; ... some more code ...}; eval $x
10392 * In order to preserve the internal rep, we increment the
10393 * inUse field of the script internal rep structure. */
10394 script->inUse++;
10396 /* Stash the current script */
10397 prevScriptObj = interp->currentScriptObj;
10398 interp->currentScriptObj = scriptObjPtr;
10400 interp->errorFlag = 0;
10401 argv = sargv;
10403 /* Execute every command sequentially until the end of the script
10404 * or an error occurs.
10406 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10407 int argc;
10408 int j;
10410 /* First token of the line is always JIM_TT_LINE */
10411 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10412 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10414 /* Allocate the arguments vector if required */
10415 if (argc > JIM_EVAL_SARGV_LEN)
10416 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10418 /* Skip the JIM_TT_LINE token */
10419 i++;
10421 /* Populate the arguments objects.
10422 * If an error occurs, retcode will be set and
10423 * 'j' will be set to the number of args expanded
10425 for (j = 0; j < argc; j++) {
10426 long wordtokens = 1;
10427 int expand = 0;
10428 Jim_Obj *wordObjPtr = NULL;
10430 if (token[i].type == JIM_TT_WORD) {
10431 wordtokens = JimWideValue(token[i++].objPtr);
10432 if (wordtokens < 0) {
10433 expand = 1;
10434 wordtokens = -wordtokens;
10438 if (wordtokens == 1) {
10439 /* Fast path if the token does not
10440 * need interpolation */
10442 switch (token[i].type) {
10443 case JIM_TT_ESC:
10444 case JIM_TT_STR:
10445 wordObjPtr = token[i].objPtr;
10446 break;
10447 case JIM_TT_VAR:
10448 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10449 break;
10450 case JIM_TT_EXPRSUGAR:
10451 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10452 break;
10453 case JIM_TT_DICTSUGAR:
10454 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10455 break;
10456 case JIM_TT_CMD:
10457 retcode = Jim_EvalObj(interp, token[i].objPtr);
10458 if (retcode == JIM_OK) {
10459 wordObjPtr = Jim_GetResult(interp);
10461 break;
10462 default:
10463 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10466 else {
10467 /* For interpolation we call a helper
10468 * function to do the work for us. */
10469 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10472 if (!wordObjPtr) {
10473 if (retcode == JIM_OK) {
10474 retcode = JIM_ERR;
10476 break;
10479 Jim_IncrRefCount(wordObjPtr);
10480 i += wordtokens;
10482 if (!expand) {
10483 argv[j] = wordObjPtr;
10485 else {
10486 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10487 int len = Jim_ListLength(interp, wordObjPtr);
10488 int newargc = argc + len - 1;
10489 int k;
10491 if (len > 1) {
10492 if (argv == sargv) {
10493 if (newargc > JIM_EVAL_SARGV_LEN) {
10494 argv = Jim_Alloc(sizeof(*argv) * newargc);
10495 memcpy(argv, sargv, sizeof(*argv) * j);
10498 else {
10499 /* Need to realloc to make room for (len - 1) more entries */
10500 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10504 /* Now copy in the expanded version */
10505 for (k = 0; k < len; k++) {
10506 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10507 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10510 /* The original object reference is no longer needed,
10511 * after the expansion it is no longer present on
10512 * the argument vector, but the single elements are
10513 * in its place. */
10514 Jim_DecrRefCount(interp, wordObjPtr);
10516 /* And update the indexes */
10517 j--;
10518 argc += len - 1;
10522 if (retcode == JIM_OK && argc) {
10523 /* Invoke the command */
10524 retcode = JimInvokeCommand(interp, argc, argv);
10525 /* Check for a signal after each command */
10526 if (Jim_CheckSignal(interp)) {
10527 retcode = JIM_SIGNAL;
10531 /* Finished with the command, so decrement ref counts of each argument */
10532 while (j-- > 0) {
10533 Jim_DecrRefCount(interp, argv[j]);
10536 if (argv != sargv) {
10537 Jim_Free(argv);
10538 argv = sargv;
10542 /* Possibly add to the error stack trace */
10543 JimAddErrorToStack(interp, retcode, script);
10545 /* Restore the current script */
10546 interp->currentScriptObj = prevScriptObj;
10548 /* Note that we don't have to decrement inUse, because the
10549 * following code transfers our use of the reference again to
10550 * the script object. */
10551 Jim_FreeIntRep(interp, scriptObjPtr);
10552 scriptObjPtr->typePtr = &scriptObjType;
10553 Jim_SetIntRepPtr(scriptObjPtr, script);
10554 Jim_DecrRefCount(interp, scriptObjPtr);
10556 return retcode;
10559 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10561 int retcode;
10562 /* If argObjPtr begins with '&', do an automatic upvar */
10563 const char *varname = Jim_String(argNameObj);
10564 if (*varname == '&') {
10565 /* First check that the target variable exists */
10566 Jim_Obj *objPtr;
10567 Jim_CallFrame *savedCallFrame = interp->framePtr;
10569 interp->framePtr = interp->framePtr->parent;
10570 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10571 interp->framePtr = savedCallFrame;
10572 if (!objPtr) {
10573 return JIM_ERR;
10576 /* It exists, so perform the binding. */
10577 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10578 Jim_IncrRefCount(objPtr);
10579 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10580 Jim_DecrRefCount(interp, objPtr);
10582 else {
10583 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10585 return retcode;
10589 * Sets the interp result to be an error message indicating the required proc args.
10591 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10593 /* Create a nice error message, consistent with Tcl 8.5 */
10594 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10595 int i;
10597 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10598 Jim_AppendString(interp, argmsg, " ", 1);
10600 if (i == cmd->u.proc.argsPos) {
10601 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10602 /* Renamed args */
10603 Jim_AppendString(interp, argmsg, "?", 1);
10604 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10605 Jim_AppendString(interp, argmsg, " ...?", -1);
10607 else {
10608 /* We have plain args */
10609 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10612 else {
10613 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10614 Jim_AppendString(interp, argmsg, "?", 1);
10615 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10616 Jim_AppendString(interp, argmsg, "?", 1);
10618 else {
10619 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10620 if (*arg == '&') {
10621 arg++;
10623 Jim_AppendString(interp, argmsg, arg, -1);
10627 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10628 Jim_FreeNewObj(interp, argmsg);
10631 #ifdef jim_ext_namespace
10633 * [namespace eval]
10635 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10637 Jim_CallFrame *callFramePtr;
10638 int retcode;
10640 /* Create a new callframe */
10641 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10642 callFramePtr->argv = &interp->emptyObj;
10643 callFramePtr->argc = 0;
10644 callFramePtr->procArgsObjPtr = NULL;
10645 callFramePtr->procBodyObjPtr = scriptObj;
10646 callFramePtr->staticVars = NULL;
10647 callFramePtr->fileNameObj = interp->emptyObj;
10648 callFramePtr->line = 0;
10649 Jim_IncrRefCount(scriptObj);
10650 interp->framePtr = callFramePtr;
10652 /* Check if there are too nested calls */
10653 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10654 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10655 retcode = JIM_ERR;
10657 else {
10658 /* Eval the body */
10659 retcode = Jim_EvalObj(interp, scriptObj);
10662 /* Destroy the callframe */
10663 interp->framePtr = interp->framePtr->parent;
10664 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10665 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10667 else {
10668 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10671 return retcode;
10673 #endif
10675 /* Call a procedure implemented in Tcl.
10676 * It's possible to speed-up a lot this function, currently
10677 * the callframes are not cached, but allocated and
10678 * destroied every time. What is expecially costly is
10679 * to create/destroy the local vars hash table every time.
10681 * This can be fixed just implementing callframes caching
10682 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10683 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10685 Jim_CallFrame *callFramePtr;
10686 int i, d, retcode, optargs;
10687 Jim_Stack *localCommands;
10688 ScriptObj *script;
10690 /* Check arity */
10691 if (argc - 1 < cmd->u.proc.reqArity ||
10692 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10693 JimSetProcWrongArgs(interp, argv[0], cmd);
10694 return JIM_ERR;
10697 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10698 /* Optimise for procedure with no body - useful for optional debugging */
10699 return JIM_OK;
10702 /* Check if there are too nested calls */
10703 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10704 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10705 return JIM_ERR;
10708 /* Create a new callframe */
10709 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10710 callFramePtr->argv = argv;
10711 callFramePtr->argc = argc;
10712 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10713 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10714 callFramePtr->staticVars = cmd->u.proc.staticVars;
10716 /* Remember where we were called from. */
10717 script = Jim_GetScript(interp, interp->currentScriptObj);
10718 callFramePtr->fileNameObj = script->fileNameObj;
10719 callFramePtr->line = script->linenr;
10721 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10722 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10723 interp->framePtr = callFramePtr;
10725 /* How many optional args are available */
10726 optargs = (argc - 1 - cmd->u.proc.reqArity);
10728 /* Step 'i' along the actual args, and step 'd' along the formal args */
10729 i = 1;
10730 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10731 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10732 if (d == cmd->u.proc.argsPos) {
10733 /* assign $args */
10734 Jim_Obj *listObjPtr;
10735 int argsLen = 0;
10736 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10737 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10739 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10741 /* It is possible to rename args. */
10742 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10743 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10745 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10746 if (retcode != JIM_OK) {
10747 goto badargset;
10750 i += argsLen;
10751 continue;
10754 /* Optional or required? */
10755 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10756 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10758 else {
10759 /* Ran out, so use the default */
10760 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10762 if (retcode != JIM_OK) {
10763 goto badargset;
10767 /* Eval the body */
10768 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10770 badargset:
10771 /* Destroy the callframe */
10772 /* But first remove the local commands */
10773 localCommands = callFramePtr->localCommands;
10774 callFramePtr->localCommands = NULL;
10776 interp->framePtr = interp->framePtr->parent;
10777 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10778 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10780 else {
10781 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10784 /* Handle the JIM_EVAL return code */
10785 while (retcode == JIM_EVAL) {
10786 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
10788 Jim_IncrRefCount(resultScriptObjPtr);
10789 /* Result must be a list */
10790 JimPanic((!Jim_IsList(resultScriptObjPtr), "tailcall (JIM_EVAL) returned non-list"));
10792 retcode = JimEvalObjList(interp, resultScriptObjPtr);
10793 if (retcode == JIM_RETURN) {
10794 /* If the result of the tailcall invokes 'return', push
10795 * it up to the caller
10797 interp->returnLevel++;
10799 Jim_DecrRefCount(interp, resultScriptObjPtr);
10801 /* Handle the JIM_RETURN return code */
10802 if (retcode == JIM_RETURN) {
10803 if (--interp->returnLevel <= 0) {
10804 retcode = interp->returnCode;
10805 interp->returnCode = JIM_OK;
10806 interp->returnLevel = 0;
10809 else if (retcode == JIM_ERR) {
10810 interp->addStackTrace++;
10811 Jim_DecrRefCount(interp, interp->errorProc);
10812 interp->errorProc = argv[0];
10813 Jim_IncrRefCount(interp->errorProc);
10816 /* Finally delete local procs */
10817 JimDeleteLocalProcs(interp, localCommands);
10819 return retcode;
10822 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10824 int retval;
10825 Jim_Obj *scriptObjPtr;
10827 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10828 Jim_IncrRefCount(scriptObjPtr);
10830 if (filename) {
10831 Jim_Obj *prevScriptObj;
10833 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10835 prevScriptObj = interp->currentScriptObj;
10836 interp->currentScriptObj = scriptObjPtr;
10838 retval = Jim_EvalObj(interp, scriptObjPtr);
10840 interp->currentScriptObj = prevScriptObj;
10842 else {
10843 retval = Jim_EvalObj(interp, scriptObjPtr);
10845 Jim_DecrRefCount(interp, scriptObjPtr);
10846 return retval;
10849 int Jim_Eval(Jim_Interp *interp, const char *script)
10851 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10854 /* Execute script in the scope of the global level */
10855 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10857 int retval;
10858 Jim_CallFrame *savedFramePtr = interp->framePtr;
10860 interp->framePtr = interp->topFramePtr;
10861 retval = Jim_Eval(interp, script);
10862 interp->framePtr = savedFramePtr;
10864 return retval;
10867 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10869 int retval;
10870 Jim_CallFrame *savedFramePtr = interp->framePtr;
10872 interp->framePtr = interp->topFramePtr;
10873 retval = Jim_EvalFile(interp, filename);
10874 interp->framePtr = savedFramePtr;
10876 return retval;
10879 #include <sys/stat.h>
10881 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10883 FILE *fp;
10884 char *buf;
10885 Jim_Obj *scriptObjPtr;
10886 Jim_Obj *prevScriptObj;
10887 struct stat sb;
10888 int retcode;
10889 int readlen;
10890 struct JimParseResult result;
10892 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10893 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10894 return JIM_ERR;
10896 if (sb.st_size == 0) {
10897 fclose(fp);
10898 return JIM_OK;
10901 buf = Jim_Alloc(sb.st_size + 1);
10902 readlen = fread(buf, 1, sb.st_size, fp);
10903 if (ferror(fp)) {
10904 fclose(fp);
10905 Jim_Free(buf);
10906 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10907 return JIM_ERR;
10909 fclose(fp);
10910 buf[readlen] = 0;
10912 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10913 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10914 Jim_IncrRefCount(scriptObjPtr);
10916 /* Now check the script for unmatched braces, etc. */
10917 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
10918 const char *msg;
10919 char linebuf[20];
10921 switch (result.missing) {
10922 case '[':
10923 msg = "unmatched \"[\"";
10924 break;
10925 case '{':
10926 msg = "missing close-brace";
10927 break;
10928 case '"':
10929 default:
10930 msg = "missing quote";
10931 break;
10934 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
10936 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
10937 msg, filename, linebuf);
10938 Jim_DecrRefCount(interp, scriptObjPtr);
10939 return JIM_ERR;
10942 prevScriptObj = interp->currentScriptObj;
10943 interp->currentScriptObj = scriptObjPtr;
10945 retcode = Jim_EvalObj(interp, scriptObjPtr);
10947 /* Handle the JIM_RETURN return code */
10948 if (retcode == JIM_RETURN) {
10949 if (--interp->returnLevel <= 0) {
10950 retcode = interp->returnCode;
10951 interp->returnCode = JIM_OK;
10952 interp->returnLevel = 0;
10955 if (retcode == JIM_ERR) {
10956 /* EvalFile changes context, so add a stack frame here */
10957 interp->addStackTrace++;
10960 interp->currentScriptObj = prevScriptObj;
10962 Jim_DecrRefCount(interp, scriptObjPtr);
10964 return retcode;
10967 /* -----------------------------------------------------------------------------
10968 * Subst
10969 * ---------------------------------------------------------------------------*/
10970 static void JimParseSubst(struct JimParserCtx *pc, int flags)
10972 pc->tstart = pc->p;
10973 pc->tline = pc->linenr;
10975 if (pc->len == 0) {
10976 pc->tend = pc->p;
10977 pc->tt = JIM_TT_EOL;
10978 pc->eof = 1;
10979 return;
10981 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
10982 JimParseCmd(pc);
10983 return;
10985 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
10986 if (JimParseVar(pc) == JIM_OK) {
10987 return;
10989 /* Not a var, so treat as a string */
10990 pc->tstart = pc->p;
10991 flags |= JIM_SUBST_NOVAR;
10993 while (pc->len) {
10994 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
10995 break;
10997 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
10998 break;
11000 if (*pc->p == '\\' && pc->len > 1) {
11001 pc->p++;
11002 pc->len--;
11004 pc->p++;
11005 pc->len--;
11007 pc->tend = pc->p - 1;
11008 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11011 /* The subst object type reuses most of the data structures and functions
11012 * of the script object. Script's data structures are a bit more complex
11013 * for what is needed for [subst]itution tasks, but the reuse helps to
11014 * deal with a single data structure at the cost of some more memory
11015 * usage for substitutions. */
11017 /* This method takes the string representation of an object
11018 * as a Tcl string where to perform [subst]itution, and generates
11019 * the pre-parsed internal representation. */
11020 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11022 int scriptTextLen;
11023 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11024 struct JimParserCtx parser;
11025 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11026 ParseTokenList tokenlist;
11028 /* Initially parse the subst into tokens (in tokenlist) */
11029 ScriptTokenListInit(&tokenlist);
11031 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11032 while (1) {
11033 JimParseSubst(&parser, flags);
11034 if (parser.eof) {
11035 /* Note that subst doesn't need the EOL token */
11036 break;
11038 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11039 parser.tline);
11042 /* Create the "real" subst/script tokens from the initial token list */
11043 script->inUse = 1;
11044 script->substFlags = flags;
11045 script->fileNameObj = interp->emptyObj;
11046 Jim_IncrRefCount(script->fileNameObj);
11047 SubstObjAddTokens(interp, script, &tokenlist);
11049 /* No longer need the token list */
11050 ScriptTokenListFree(&tokenlist);
11052 #ifdef DEBUG_SHOW_SUBST
11054 int i;
11056 printf("==== Subst ====\n");
11057 for (i = 0; i < script->len; i++) {
11058 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11059 Jim_String(script->token[i].objPtr));
11062 #endif
11064 /* Free the old internal rep and set the new one. */
11065 Jim_FreeIntRep(interp, objPtr);
11066 Jim_SetIntRepPtr(objPtr, script);
11067 objPtr->typePtr = &scriptObjType;
11068 return JIM_OK;
11071 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11073 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11074 SetSubstFromAny(interp, objPtr, flags);
11075 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11078 /* Performs commands,variables,blackslashes substitution,
11079 * storing the result object (with refcount 0) into
11080 * resObjPtrPtr. */
11081 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11083 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11085 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11086 /* In order to preserve the internal rep, we increment the
11087 * inUse field of the script internal rep structure. */
11088 script->inUse++;
11090 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11092 script->inUse--;
11093 Jim_DecrRefCount(interp, substObjPtr);
11094 if (*resObjPtrPtr == NULL) {
11095 return JIM_ERR;
11097 return JIM_OK;
11100 /* -----------------------------------------------------------------------------
11101 * Core commands utility functions
11102 * ---------------------------------------------------------------------------*/
11103 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11105 Jim_Obj *objPtr;
11106 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11108 if (*msg) {
11109 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11111 Jim_IncrRefCount(listObjPtr);
11112 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11113 Jim_DecrRefCount(interp, listObjPtr);
11115 Jim_IncrRefCount(objPtr);
11116 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11117 Jim_DecrRefCount(interp, objPtr);
11121 * May add the key and/or value to the list.
11123 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11124 Jim_HashEntry *he, int type);
11126 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11129 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11130 * invoke the callback to add entries to a list.
11131 * Returns the list.
11133 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11134 JimHashtableIteratorCallbackType *callback, int type)
11136 Jim_HashEntry *he;
11137 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11139 /* Check for the non-pattern case. We can do this much more efficiently. */
11140 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11141 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11142 if (he) {
11143 callback(interp, listObjPtr, he, type);
11146 else {
11147 Jim_HashTableIterator htiter;
11148 JimInitHashTableIterator(ht, &htiter);
11149 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11150 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11151 callback(interp, listObjPtr, he, type);
11155 return listObjPtr;
11158 /* Keep these in order */
11159 #define JIM_CMDLIST_COMMANDS 0
11160 #define JIM_CMDLIST_PROCS 1
11161 #define JIM_CMDLIST_CHANNELS 2
11164 * Adds matching command names (procs, channels) to the list.
11166 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11167 Jim_HashEntry *he, int type)
11169 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11170 Jim_Obj *objPtr;
11172 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11173 /* not a proc */
11174 return;
11177 objPtr = Jim_NewStringObj(interp, he->key, -1);
11178 Jim_IncrRefCount(objPtr);
11180 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11181 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11183 Jim_DecrRefCount(interp, objPtr);
11186 /* type is JIM_CMDLIST_xxx */
11187 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11189 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11192 /* Keep these in order */
11193 #define JIM_VARLIST_GLOBALS 0
11194 #define JIM_VARLIST_LOCALS 1
11195 #define JIM_VARLIST_VARS 2
11197 #define JIM_VARLIST_VALUES 0x1000
11200 * Adds matching variable names to the list.
11202 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11203 Jim_HashEntry *he, int type)
11205 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11207 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11208 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11209 if (type & JIM_VARLIST_VALUES) {
11210 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11215 /* mode is JIM_VARLIST_xxx */
11216 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11218 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11219 /* For [info locals], if we are at top level an emtpy list
11220 * is returned. I don't agree, but we aim at compatibility (SS) */
11221 return interp->emptyObj;
11223 else {
11224 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11225 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11229 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11230 Jim_Obj **objPtrPtr, int info_level_cmd)
11232 Jim_CallFrame *targetCallFrame;
11234 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11235 if (targetCallFrame == NULL) {
11236 return JIM_ERR;
11238 /* No proc call at toplevel callframe */
11239 if (targetCallFrame == interp->topFramePtr) {
11240 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11241 return JIM_ERR;
11243 if (info_level_cmd) {
11244 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11246 else {
11247 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11249 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11250 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11251 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11252 *objPtrPtr = listObj;
11254 return JIM_OK;
11257 /* -----------------------------------------------------------------------------
11258 * Core commands
11259 * ---------------------------------------------------------------------------*/
11261 /* fake [puts] -- not the real puts, just for debugging. */
11262 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11264 if (argc != 2 && argc != 3) {
11265 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11266 return JIM_ERR;
11268 if (argc == 3) {
11269 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11270 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11271 return JIM_ERR;
11273 else {
11274 fputs(Jim_String(argv[2]), stdout);
11277 else {
11278 puts(Jim_String(argv[1]));
11280 return JIM_OK;
11283 /* Helper for [+] and [*] */
11284 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11286 jim_wide wideValue, res;
11287 double doubleValue, doubleRes;
11288 int i;
11290 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11292 for (i = 1; i < argc; i++) {
11293 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11294 goto trydouble;
11295 if (op == JIM_EXPROP_ADD)
11296 res += wideValue;
11297 else
11298 res *= wideValue;
11300 Jim_SetResultInt(interp, res);
11301 return JIM_OK;
11302 trydouble:
11303 doubleRes = (double)res;
11304 for (; i < argc; i++) {
11305 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11306 return JIM_ERR;
11307 if (op == JIM_EXPROP_ADD)
11308 doubleRes += doubleValue;
11309 else
11310 doubleRes *= doubleValue;
11312 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11313 return JIM_OK;
11316 /* Helper for [-] and [/] */
11317 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11319 jim_wide wideValue, res = 0;
11320 double doubleValue, doubleRes = 0;
11321 int i = 2;
11323 if (argc < 2) {
11324 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11325 return JIM_ERR;
11327 else if (argc == 2) {
11328 /* The arity = 2 case is different. For [- x] returns -x,
11329 * while [/ x] returns 1/x. */
11330 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11331 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11332 return JIM_ERR;
11334 else {
11335 if (op == JIM_EXPROP_SUB)
11336 doubleRes = -doubleValue;
11337 else
11338 doubleRes = 1.0 / doubleValue;
11339 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11340 return JIM_OK;
11343 if (op == JIM_EXPROP_SUB) {
11344 res = -wideValue;
11345 Jim_SetResultInt(interp, res);
11347 else {
11348 doubleRes = 1.0 / wideValue;
11349 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11351 return JIM_OK;
11353 else {
11354 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11355 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11356 != JIM_OK) {
11357 return JIM_ERR;
11359 else {
11360 goto trydouble;
11364 for (i = 2; i < argc; i++) {
11365 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11366 doubleRes = (double)res;
11367 goto trydouble;
11369 if (op == JIM_EXPROP_SUB)
11370 res -= wideValue;
11371 else
11372 res /= wideValue;
11374 Jim_SetResultInt(interp, res);
11375 return JIM_OK;
11376 trydouble:
11377 for (; i < argc; i++) {
11378 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11379 return JIM_ERR;
11380 if (op == JIM_EXPROP_SUB)
11381 doubleRes -= doubleValue;
11382 else
11383 doubleRes /= doubleValue;
11385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11386 return JIM_OK;
11390 /* [+] */
11391 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11393 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11396 /* [*] */
11397 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11399 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11402 /* [-] */
11403 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11405 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11408 /* [/] */
11409 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11411 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11414 /* [set] */
11415 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11417 if (argc != 2 && argc != 3) {
11418 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11419 return JIM_ERR;
11421 if (argc == 2) {
11422 Jim_Obj *objPtr;
11424 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11425 if (!objPtr)
11426 return JIM_ERR;
11427 Jim_SetResult(interp, objPtr);
11428 return JIM_OK;
11430 /* argc == 3 case. */
11431 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11432 return JIM_ERR;
11433 Jim_SetResult(interp, argv[2]);
11434 return JIM_OK;
11437 /* [unset]
11439 * unset ?-nocomplain? ?--? ?varName ...?
11441 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11443 int i = 1;
11444 int complain = 1;
11446 while (i < argc) {
11447 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11448 i++;
11449 break;
11451 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11452 complain = 0;
11453 i++;
11454 continue;
11456 break;
11459 while (i < argc) {
11460 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11461 && complain) {
11462 return JIM_ERR;
11464 i++;
11466 return JIM_OK;
11469 /* [while] */
11470 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11472 if (argc != 3) {
11473 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11474 return JIM_ERR;
11477 /* The general purpose implementation of while starts here */
11478 while (1) {
11479 int boolean, retval;
11481 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11482 return retval;
11483 if (!boolean)
11484 break;
11486 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11487 switch (retval) {
11488 case JIM_BREAK:
11489 goto out;
11490 break;
11491 case JIM_CONTINUE:
11492 continue;
11493 break;
11494 default:
11495 return retval;
11499 out:
11500 Jim_SetEmptyResult(interp);
11501 return JIM_OK;
11504 /* [for] */
11505 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11507 int retval;
11508 int boolean = 1;
11509 Jim_Obj *varNamePtr = NULL;
11510 Jim_Obj *stopVarNamePtr = NULL;
11512 if (argc != 5) {
11513 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11514 return JIM_ERR;
11517 /* Do the initialisation */
11518 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11519 return retval;
11522 /* And do the first test now. Better for optimisation
11523 * if we can do next/test at the bottom of the loop
11525 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11527 /* Ready to do the body as follows:
11528 * while (1) {
11529 * body // check retcode
11530 * next // check retcode
11531 * test // check retcode/test bool
11535 #ifdef JIM_OPTIMIZATION
11536 /* Check if the for is on the form:
11537 * for ... {$i < CONST} {incr i}
11538 * for ... {$i < $j} {incr i}
11540 if (retval == JIM_OK && boolean) {
11541 ScriptObj *incrScript;
11542 ExprByteCode *expr;
11543 jim_wide stop, currentVal;
11544 Jim_Obj *objPtr;
11545 int cmpOffset;
11547 /* Do it only if there aren't shared arguments */
11548 expr = JimGetExpression(interp, argv[2]);
11549 incrScript = Jim_GetScript(interp, argv[3]);
11551 /* Ensure proper lengths to start */
11552 if (incrScript->len != 3 || !expr || expr->len != 3) {
11553 goto evalstart;
11555 /* Ensure proper token types. */
11556 if (incrScript->token[1].type != JIM_TT_ESC ||
11557 expr->token[0].type != JIM_TT_VAR ||
11558 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11559 goto evalstart;
11562 if (expr->token[2].type == JIM_EXPROP_LT) {
11563 cmpOffset = 0;
11565 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11566 cmpOffset = 1;
11568 else {
11569 goto evalstart;
11572 /* Update command must be incr */
11573 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11574 goto evalstart;
11577 /* incr, expression must be about the same variable */
11578 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11579 goto evalstart;
11582 /* Get the stop condition (must be a variable or integer) */
11583 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11584 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11585 goto evalstart;
11588 else {
11589 stopVarNamePtr = expr->token[1].objPtr;
11590 Jim_IncrRefCount(stopVarNamePtr);
11591 /* Keep the compiler happy */
11592 stop = 0;
11595 /* Initialization */
11596 varNamePtr = expr->token[0].objPtr;
11597 Jim_IncrRefCount(varNamePtr);
11599 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11600 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11601 goto testcond;
11604 /* --- OPTIMIZED FOR --- */
11605 while (retval == JIM_OK) {
11606 /* === Check condition === */
11607 /* Note that currentVal is already set here */
11609 /* Immediate or Variable? get the 'stop' value if the latter. */
11610 if (stopVarNamePtr) {
11611 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11612 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11613 goto testcond;
11617 if (currentVal >= stop + cmpOffset) {
11618 break;
11621 /* Eval body */
11622 retval = Jim_EvalObj(interp, argv[4]);
11623 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11624 retval = JIM_OK;
11626 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11628 /* Increment */
11629 if (objPtr == NULL) {
11630 retval = JIM_ERR;
11631 goto out;
11633 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11634 currentVal = ++JimWideValue(objPtr);
11635 Jim_InvalidateStringRep(objPtr);
11637 else {
11638 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11639 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11640 ++currentVal)) != JIM_OK) {
11641 goto evalnext;
11646 goto out;
11648 evalstart:
11649 #endif
11651 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11652 /* Body */
11653 retval = Jim_EvalObj(interp, argv[4]);
11655 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11656 /* increment */
11657 evalnext:
11658 retval = Jim_EvalObj(interp, argv[3]);
11659 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11660 /* test */
11661 testcond:
11662 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11666 out:
11667 if (stopVarNamePtr) {
11668 Jim_DecrRefCount(interp, stopVarNamePtr);
11670 if (varNamePtr) {
11671 Jim_DecrRefCount(interp, varNamePtr);
11674 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11675 Jim_SetEmptyResult(interp);
11676 return JIM_OK;
11679 return retval;
11682 /* [loop] */
11683 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11685 int retval;
11686 jim_wide i;
11687 jim_wide limit;
11688 jim_wide incr = 1;
11689 Jim_Obj *bodyObjPtr;
11691 if (argc != 5 && argc != 6) {
11692 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11693 return JIM_ERR;
11696 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11697 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11698 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11699 return JIM_ERR;
11701 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11703 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11705 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11706 retval = Jim_EvalObj(interp, bodyObjPtr);
11707 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11708 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11710 retval = JIM_OK;
11712 /* Increment */
11713 i += incr;
11715 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11716 if (argv[1]->typePtr != &variableObjType) {
11717 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11718 return JIM_ERR;
11721 JimWideValue(objPtr) = i;
11722 Jim_InvalidateStringRep(objPtr);
11724 /* The following step is required in order to invalidate the
11725 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11726 if (argv[1]->typePtr != &variableObjType) {
11727 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11728 retval = JIM_ERR;
11729 break;
11733 else {
11734 objPtr = Jim_NewIntObj(interp, i);
11735 retval = Jim_SetVariable(interp, argv[1], objPtr);
11736 if (retval != JIM_OK) {
11737 Jim_FreeNewObj(interp, objPtr);
11743 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11744 Jim_SetEmptyResult(interp);
11745 return JIM_OK;
11747 return retval;
11750 /* List iterators make it easy to iterate over a list.
11751 * At some point iterators will be expanded to support generators.
11753 typedef struct {
11754 Jim_Obj *objPtr;
11755 int idx;
11756 } Jim_ListIter;
11759 * Initialise the iterator at the start of the list.
11761 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11763 iter->objPtr = objPtr;
11764 iter->idx = 0;
11768 * Returns the next object from the list, or NULL on end-of-list.
11770 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11772 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11773 return NULL;
11775 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11779 * Returns 1 if end-of-list has been reached.
11781 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11783 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11786 /* foreach + lmap implementation. */
11787 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11789 int result = JIM_ERR;
11790 int i, numargs;
11791 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11792 Jim_ListIter *iters;
11793 Jim_Obj *script;
11794 Jim_Obj *resultObj;
11796 if (argc < 4 || argc % 2 != 0) {
11797 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11798 return JIM_ERR;
11800 script = argv[argc - 1]; /* Last argument is a script */
11801 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11803 if (numargs == 2) {
11804 iters = twoiters;
11806 else {
11807 iters = Jim_Alloc(numargs * sizeof(*iters));
11809 for (i = 0; i < numargs; i++) {
11810 JimListIterInit(&iters[i], argv[i + 1]);
11811 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11812 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11813 return JIM_ERR;
11817 if (doMap) {
11818 resultObj = Jim_NewListObj(interp, NULL, 0);
11820 else {
11821 resultObj = interp->emptyObj;
11823 Jim_IncrRefCount(resultObj);
11825 while (1) {
11826 /* Have we expired all lists? */
11827 for (i = 0; i < numargs; i += 2) {
11828 if (!JimListIterDone(interp, &iters[i + 1])) {
11829 break;
11832 if (i == numargs) {
11833 /* All done */
11834 break;
11837 /* For each list */
11838 for (i = 0; i < numargs; i += 2) {
11839 Jim_Obj *varName;
11841 /* foreach var */
11842 JimListIterInit(&iters[i], argv[i + 1]);
11843 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11844 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11845 if (!valObj) {
11846 /* Ran out, so store the empty string */
11847 valObj = interp->emptyObj;
11849 /* Avoid shimmering */
11850 Jim_IncrRefCount(valObj);
11851 result = Jim_SetVariable(interp, varName, valObj);
11852 Jim_DecrRefCount(interp, valObj);
11853 if (result != JIM_OK) {
11854 goto err;
11858 switch (result = Jim_EvalObj(interp, script)) {
11859 case JIM_OK:
11860 if (doMap) {
11861 Jim_ListAppendElement(interp, resultObj, interp->result);
11863 break;
11864 case JIM_CONTINUE:
11865 break;
11866 case JIM_BREAK:
11867 goto out;
11868 default:
11869 goto err;
11872 out:
11873 result = JIM_OK;
11874 Jim_SetResult(interp, resultObj);
11875 err:
11876 Jim_DecrRefCount(interp, resultObj);
11877 if (numargs > 2) {
11878 Jim_Free(iters);
11880 return result;
11883 /* [foreach] */
11884 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11886 return JimForeachMapHelper(interp, argc, argv, 0);
11889 /* [lmap] */
11890 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11892 return JimForeachMapHelper(interp, argc, argv, 1);
11895 /* [lassign] */
11896 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11898 int result = JIM_ERR;
11899 int i;
11900 Jim_ListIter iter;
11901 Jim_Obj *resultObj;
11903 if (argc < 2) {
11904 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11905 return JIM_ERR;
11908 JimListIterInit(&iter, argv[1]);
11910 for (i = 2; i < argc; i++) {
11911 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11912 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11913 if (result != JIM_OK) {
11914 return result;
11918 resultObj = Jim_NewListObj(interp, NULL, 0);
11919 while (!JimListIterDone(interp, &iter)) {
11920 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11923 Jim_SetResult(interp, resultObj);
11925 return JIM_OK;
11928 /* [if] */
11929 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11931 int boolean, retval, current = 1, falsebody = 0;
11933 if (argc >= 3) {
11934 while (1) {
11935 /* Far not enough arguments given! */
11936 if (current >= argc)
11937 goto err;
11938 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11939 != JIM_OK)
11940 return retval;
11941 /* There lacks something, isn't it? */
11942 if (current >= argc)
11943 goto err;
11944 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11945 current++;
11946 /* Tsk tsk, no then-clause? */
11947 if (current >= argc)
11948 goto err;
11949 if (boolean)
11950 return Jim_EvalObj(interp, argv[current]);
11951 /* Ok: no else-clause follows */
11952 if (++current >= argc) {
11953 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11954 return JIM_OK;
11956 falsebody = current++;
11957 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
11958 /* IIICKS - else-clause isn't last cmd? */
11959 if (current != argc - 1)
11960 goto err;
11961 return Jim_EvalObj(interp, argv[current]);
11963 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
11964 /* Ok: elseif follows meaning all the stuff
11965 * again (how boring...) */
11966 continue;
11967 /* OOPS - else-clause is not last cmd? */
11968 else if (falsebody != argc - 1)
11969 goto err;
11970 return Jim_EvalObj(interp, argv[falsebody]);
11972 return JIM_OK;
11974 err:
11975 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11976 return JIM_ERR;
11980 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11981 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
11982 Jim_Obj *stringObj, int nocase)
11984 Jim_Obj *parms[4];
11985 int argc = 0;
11986 long eq;
11987 int rc;
11989 parms[argc++] = commandObj;
11990 if (nocase) {
11991 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
11993 parms[argc++] = patternObj;
11994 parms[argc++] = stringObj;
11996 rc = Jim_EvalObjVector(interp, argc, parms);
11998 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
11999 eq = -rc;
12002 return eq;
12005 enum
12006 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12008 /* [switch] */
12009 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12011 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12012 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12013 Jim_Obj *script = 0;
12015 if (argc < 3) {
12016 wrongnumargs:
12017 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12018 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12019 return JIM_ERR;
12021 for (opt = 1; opt < argc; ++opt) {
12022 const char *option = Jim_String(argv[opt]);
12024 if (*option != '-')
12025 break;
12026 else if (strncmp(option, "--", 2) == 0) {
12027 ++opt;
12028 break;
12030 else if (strncmp(option, "-exact", 2) == 0)
12031 matchOpt = SWITCH_EXACT;
12032 else if (strncmp(option, "-glob", 2) == 0)
12033 matchOpt = SWITCH_GLOB;
12034 else if (strncmp(option, "-regexp", 2) == 0)
12035 matchOpt = SWITCH_RE;
12036 else if (strncmp(option, "-command", 2) == 0) {
12037 matchOpt = SWITCH_CMD;
12038 if ((argc - opt) < 2)
12039 goto wrongnumargs;
12040 command = argv[++opt];
12042 else {
12043 Jim_SetResultFormatted(interp,
12044 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12045 argv[opt]);
12046 return JIM_ERR;
12048 if ((argc - opt) < 2)
12049 goto wrongnumargs;
12051 strObj = argv[opt++];
12052 patCount = argc - opt;
12053 if (patCount == 1) {
12054 Jim_Obj **vector;
12056 JimListGetElements(interp, argv[opt], &patCount, &vector);
12057 caseList = vector;
12059 else
12060 caseList = &argv[opt];
12061 if (patCount == 0 || patCount % 2 != 0)
12062 goto wrongnumargs;
12063 for (i = 0; script == 0 && i < patCount; i += 2) {
12064 Jim_Obj *patObj = caseList[i];
12066 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12067 || i < (patCount - 2)) {
12068 switch (matchOpt) {
12069 case SWITCH_EXACT:
12070 if (Jim_StringEqObj(strObj, patObj))
12071 script = caseList[i + 1];
12072 break;
12073 case SWITCH_GLOB:
12074 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12075 script = caseList[i + 1];
12076 break;
12077 case SWITCH_RE:
12078 command = Jim_NewStringObj(interp, "regexp", -1);
12079 /* Fall thru intentionally */
12080 case SWITCH_CMD:{
12081 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12083 /* After the execution of a command we need to
12084 * make sure to reconvert the object into a list
12085 * again. Only for the single-list style [switch]. */
12086 if (argc - opt == 1) {
12087 Jim_Obj **vector;
12089 JimListGetElements(interp, argv[opt], &patCount, &vector);
12090 caseList = vector;
12092 /* command is here already decref'd */
12093 if (rc < 0) {
12094 return -rc;
12096 if (rc)
12097 script = caseList[i + 1];
12098 break;
12102 else {
12103 script = caseList[i + 1];
12106 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12107 script = caseList[i + 1];
12108 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12109 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12110 return JIM_ERR;
12112 Jim_SetEmptyResult(interp);
12113 if (script) {
12114 return Jim_EvalObj(interp, script);
12116 return JIM_OK;
12119 /* [list] */
12120 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12122 Jim_Obj *listObjPtr;
12124 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12125 Jim_SetResult(interp, listObjPtr);
12126 return JIM_OK;
12129 /* [lindex] */
12130 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12132 Jim_Obj *objPtr, *listObjPtr;
12133 int i;
12134 int idx;
12136 if (argc < 3) {
12137 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12138 return JIM_ERR;
12140 objPtr = argv[1];
12141 Jim_IncrRefCount(objPtr);
12142 for (i = 2; i < argc; i++) {
12143 listObjPtr = objPtr;
12144 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12145 Jim_DecrRefCount(interp, listObjPtr);
12146 return JIM_ERR;
12148 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12149 /* Returns an empty object if the index
12150 * is out of range. */
12151 Jim_DecrRefCount(interp, listObjPtr);
12152 Jim_SetEmptyResult(interp);
12153 return JIM_OK;
12155 Jim_IncrRefCount(objPtr);
12156 Jim_DecrRefCount(interp, listObjPtr);
12158 Jim_SetResult(interp, objPtr);
12159 Jim_DecrRefCount(interp, objPtr);
12160 return JIM_OK;
12163 /* [llength] */
12164 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12166 if (argc != 2) {
12167 Jim_WrongNumArgs(interp, 1, argv, "list");
12168 return JIM_ERR;
12170 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12171 return JIM_OK;
12174 /* [lsearch] */
12175 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12177 static const char * const options[] = {
12178 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12179 NULL
12181 enum
12182 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12183 OPT_COMMAND };
12184 int i;
12185 int opt_bool = 0;
12186 int opt_not = 0;
12187 int opt_nocase = 0;
12188 int opt_all = 0;
12189 int opt_inline = 0;
12190 int opt_match = OPT_EXACT;
12191 int listlen;
12192 int rc = JIM_OK;
12193 Jim_Obj *listObjPtr = NULL;
12194 Jim_Obj *commandObj = NULL;
12196 if (argc < 3) {
12197 wrongargs:
12198 Jim_WrongNumArgs(interp, 1, argv,
12199 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12200 return JIM_ERR;
12203 for (i = 1; i < argc - 2; i++) {
12204 int option;
12206 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12207 return JIM_ERR;
12209 switch (option) {
12210 case OPT_BOOL:
12211 opt_bool = 1;
12212 opt_inline = 0;
12213 break;
12214 case OPT_NOT:
12215 opt_not = 1;
12216 break;
12217 case OPT_NOCASE:
12218 opt_nocase = 1;
12219 break;
12220 case OPT_INLINE:
12221 opt_inline = 1;
12222 opt_bool = 0;
12223 break;
12224 case OPT_ALL:
12225 opt_all = 1;
12226 break;
12227 case OPT_COMMAND:
12228 if (i >= argc - 2) {
12229 goto wrongargs;
12231 commandObj = argv[++i];
12232 /* fallthru */
12233 case OPT_EXACT:
12234 case OPT_GLOB:
12235 case OPT_REGEXP:
12236 opt_match = option;
12237 break;
12241 argv += i;
12243 if (opt_all) {
12244 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12246 if (opt_match == OPT_REGEXP) {
12247 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12249 if (commandObj) {
12250 Jim_IncrRefCount(commandObj);
12253 listlen = Jim_ListLength(interp, argv[0]);
12254 for (i = 0; i < listlen; i++) {
12255 Jim_Obj *objPtr;
12256 int eq = 0;
12258 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12259 switch (opt_match) {
12260 case OPT_EXACT:
12261 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12262 break;
12264 case OPT_GLOB:
12265 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12266 break;
12268 case OPT_REGEXP:
12269 case OPT_COMMAND:
12270 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12271 if (eq < 0) {
12272 if (listObjPtr) {
12273 Jim_FreeNewObj(interp, listObjPtr);
12275 rc = JIM_ERR;
12276 goto done;
12278 break;
12281 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12282 if (!eq && opt_bool && opt_not && !opt_all) {
12283 continue;
12286 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12287 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12288 Jim_Obj *resultObj;
12290 if (opt_bool) {
12291 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12293 else if (!opt_inline) {
12294 resultObj = Jim_NewIntObj(interp, i);
12296 else {
12297 resultObj = objPtr;
12300 if (opt_all) {
12301 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12303 else {
12304 Jim_SetResult(interp, resultObj);
12305 goto done;
12310 if (opt_all) {
12311 Jim_SetResult(interp, listObjPtr);
12313 else {
12314 /* No match */
12315 if (opt_bool) {
12316 Jim_SetResultBool(interp, opt_not);
12318 else if (!opt_inline) {
12319 Jim_SetResultInt(interp, -1);
12323 done:
12324 if (commandObj) {
12325 Jim_DecrRefCount(interp, commandObj);
12327 return rc;
12330 /* [lappend] */
12331 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12333 Jim_Obj *listObjPtr;
12334 int shared, i;
12336 if (argc < 2) {
12337 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12338 return JIM_ERR;
12340 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12341 if (!listObjPtr) {
12342 /* Create the list if it does not exists */
12343 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12344 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12345 Jim_FreeNewObj(interp, listObjPtr);
12346 return JIM_ERR;
12349 shared = Jim_IsShared(listObjPtr);
12350 if (shared)
12351 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12352 for (i = 2; i < argc; i++)
12353 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12354 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12355 if (shared)
12356 Jim_FreeNewObj(interp, listObjPtr);
12357 return JIM_ERR;
12359 Jim_SetResult(interp, listObjPtr);
12360 return JIM_OK;
12363 /* [linsert] */
12364 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12366 int idx, len;
12367 Jim_Obj *listPtr;
12369 if (argc < 3) {
12370 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12371 return JIM_ERR;
12373 listPtr = argv[1];
12374 if (Jim_IsShared(listPtr))
12375 listPtr = Jim_DuplicateObj(interp, listPtr);
12376 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12377 goto err;
12378 len = Jim_ListLength(interp, listPtr);
12379 if (idx >= len)
12380 idx = len;
12381 else if (idx < 0)
12382 idx = len + idx + 1;
12383 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12384 Jim_SetResult(interp, listPtr);
12385 return JIM_OK;
12386 err:
12387 if (listPtr != argv[1]) {
12388 Jim_FreeNewObj(interp, listPtr);
12390 return JIM_ERR;
12393 /* [lreplace] */
12394 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12396 int first, last, len, rangeLen;
12397 Jim_Obj *listObj;
12398 Jim_Obj *newListObj;
12400 if (argc < 4) {
12401 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12402 return JIM_ERR;
12404 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12405 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12406 return JIM_ERR;
12409 listObj = argv[1];
12410 len = Jim_ListLength(interp, listObj);
12412 first = JimRelToAbsIndex(len, first);
12413 last = JimRelToAbsIndex(len, last);
12414 JimRelToAbsRange(len, &first, &last, &rangeLen);
12416 /* Now construct a new list which consists of:
12417 * <elements before first> <supplied elements> <elements after last>
12420 /* Check to see if trying to replace past the end of the list */
12421 if (first < len) {
12422 /* OK. Not past the end */
12424 else if (len == 0) {
12425 /* Special for empty list, adjust first to 0 */
12426 first = 0;
12428 else {
12429 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12430 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12431 return JIM_ERR;
12434 /* Add the first set of elements */
12435 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12437 /* Add supplied elements */
12438 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12440 /* Add the remaining elements */
12441 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12443 Jim_SetResult(interp, newListObj);
12444 return JIM_OK;
12447 /* [lset] */
12448 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12450 if (argc < 3) {
12451 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12452 return JIM_ERR;
12454 else if (argc == 3) {
12455 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12456 return JIM_ERR;
12457 Jim_SetResult(interp, argv[2]);
12458 return JIM_OK;
12460 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12461 == JIM_ERR)
12462 return JIM_ERR;
12463 return JIM_OK;
12466 /* [lsort] */
12467 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12469 static const char * const options[] = {
12470 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-index", NULL
12472 enum
12473 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_INDEX };
12474 Jim_Obj *resObj;
12475 int i;
12476 int retCode;
12478 struct lsort_info info;
12480 if (argc < 2) {
12481 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12482 return JIM_ERR;
12485 info.type = JIM_LSORT_ASCII;
12486 info.order = 1;
12487 info.indexed = 0;
12488 info.command = NULL;
12489 info.interp = interp;
12491 for (i = 1; i < (argc - 1); i++) {
12492 int option;
12494 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
12495 != JIM_OK)
12496 return JIM_ERR;
12497 switch (option) {
12498 case OPT_ASCII:
12499 info.type = JIM_LSORT_ASCII;
12500 break;
12501 case OPT_NOCASE:
12502 info.type = JIM_LSORT_NOCASE;
12503 break;
12504 case OPT_INTEGER:
12505 info.type = JIM_LSORT_INTEGER;
12506 break;
12507 case OPT_INCREASING:
12508 info.order = 1;
12509 break;
12510 case OPT_DECREASING:
12511 info.order = -1;
12512 break;
12513 case OPT_COMMAND:
12514 if (i >= (argc - 2)) {
12515 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12516 return JIM_ERR;
12518 info.type = JIM_LSORT_COMMAND;
12519 info.command = argv[i + 1];
12520 i++;
12521 break;
12522 case OPT_INDEX:
12523 if (i >= (argc - 2)) {
12524 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12525 return JIM_ERR;
12527 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12528 return JIM_ERR;
12530 info.indexed = 1;
12531 i++;
12532 break;
12535 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12536 retCode = ListSortElements(interp, resObj, &info);
12537 if (retCode == JIM_OK) {
12538 Jim_SetResult(interp, resObj);
12540 else {
12541 Jim_FreeNewObj(interp, resObj);
12543 return retCode;
12546 /* [append] */
12547 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12549 Jim_Obj *stringObjPtr;
12550 int i;
12552 if (argc < 2) {
12553 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12554 return JIM_ERR;
12556 if (argc == 2) {
12557 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12558 if (!stringObjPtr)
12559 return JIM_ERR;
12561 else {
12562 int freeobj = 0;
12563 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12564 if (!stringObjPtr) {
12565 /* Create the string if it doesn't exist */
12566 stringObjPtr = Jim_NewEmptyStringObj(interp);
12567 freeobj = 1;
12569 else if (Jim_IsShared(stringObjPtr)) {
12570 freeobj = 1;
12571 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12573 for (i = 2; i < argc; i++) {
12574 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12576 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12577 if (freeobj) {
12578 Jim_FreeNewObj(interp, stringObjPtr);
12580 return JIM_ERR;
12583 Jim_SetResult(interp, stringObjPtr);
12584 return JIM_OK;
12587 /* [debug] */
12588 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12590 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12591 static const char * const options[] = {
12592 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12593 "exprbc", "show",
12594 NULL
12596 enum
12598 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12599 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12601 int option;
12603 if (argc < 2) {
12604 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12605 return JIM_ERR;
12607 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12608 return JIM_ERR;
12609 if (option == OPT_REFCOUNT) {
12610 if (argc != 3) {
12611 Jim_WrongNumArgs(interp, 2, argv, "object");
12612 return JIM_ERR;
12614 Jim_SetResultInt(interp, argv[2]->refCount);
12615 return JIM_OK;
12617 else if (option == OPT_OBJCOUNT) {
12618 int freeobj = 0, liveobj = 0;
12619 char buf[256];
12620 Jim_Obj *objPtr;
12622 if (argc != 2) {
12623 Jim_WrongNumArgs(interp, 2, argv, "");
12624 return JIM_ERR;
12626 /* Count the number of free objects. */
12627 objPtr = interp->freeList;
12628 while (objPtr) {
12629 freeobj++;
12630 objPtr = objPtr->nextObjPtr;
12632 /* Count the number of live objects. */
12633 objPtr = interp->liveList;
12634 while (objPtr) {
12635 liveobj++;
12636 objPtr = objPtr->nextObjPtr;
12638 /* Set the result string and return. */
12639 sprintf(buf, "free %d used %d", freeobj, liveobj);
12640 Jim_SetResultString(interp, buf, -1);
12641 return JIM_OK;
12643 else if (option == OPT_OBJECTS) {
12644 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12646 /* Count the number of live objects. */
12647 objPtr = interp->liveList;
12648 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12649 while (objPtr) {
12650 char buf[128];
12651 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12653 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12654 sprintf(buf, "%p", objPtr);
12655 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12656 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12657 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12658 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12659 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12660 objPtr = objPtr->nextObjPtr;
12662 Jim_SetResult(interp, listObjPtr);
12663 return JIM_OK;
12665 else if (option == OPT_INVSTR) {
12666 Jim_Obj *objPtr;
12668 if (argc != 3) {
12669 Jim_WrongNumArgs(interp, 2, argv, "object");
12670 return JIM_ERR;
12672 objPtr = argv[2];
12673 if (objPtr->typePtr != NULL)
12674 Jim_InvalidateStringRep(objPtr);
12675 Jim_SetEmptyResult(interp);
12676 return JIM_OK;
12678 else if (option == OPT_SHOW) {
12679 const char *s;
12680 int len, charlen;
12682 if (argc != 3) {
12683 Jim_WrongNumArgs(interp, 2, argv, "object");
12684 return JIM_ERR;
12686 s = Jim_GetString(argv[2], &len);
12687 #ifdef JIM_UTF8
12688 charlen = utf8_strlen(s, len);
12689 #else
12690 charlen = len;
12691 #endif
12692 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12693 printf("chars (%d): <<%s>>\n", charlen, s);
12694 printf("bytes (%d):", len);
12695 while (len--) {
12696 printf(" %02x", (unsigned char)*s++);
12698 printf("\n");
12699 return JIM_OK;
12701 else if (option == OPT_SCRIPTLEN) {
12702 ScriptObj *script;
12704 if (argc != 3) {
12705 Jim_WrongNumArgs(interp, 2, argv, "script");
12706 return JIM_ERR;
12708 script = Jim_GetScript(interp, argv[2]);
12709 Jim_SetResultInt(interp, script->len);
12710 return JIM_OK;
12712 else if (option == OPT_EXPRLEN) {
12713 ExprByteCode *expr;
12715 if (argc != 3) {
12716 Jim_WrongNumArgs(interp, 2, argv, "expression");
12717 return JIM_ERR;
12719 expr = JimGetExpression(interp, argv[2]);
12720 if (expr == NULL)
12721 return JIM_ERR;
12722 Jim_SetResultInt(interp, expr->len);
12723 return JIM_OK;
12725 else if (option == OPT_EXPRBC) {
12726 Jim_Obj *objPtr;
12727 ExprByteCode *expr;
12728 int i;
12730 if (argc != 3) {
12731 Jim_WrongNumArgs(interp, 2, argv, "expression");
12732 return JIM_ERR;
12734 expr = JimGetExpression(interp, argv[2]);
12735 if (expr == NULL)
12736 return JIM_ERR;
12737 objPtr = Jim_NewListObj(interp, NULL, 0);
12738 for (i = 0; i < expr->len; i++) {
12739 const char *type;
12740 const Jim_ExprOperator *op;
12741 Jim_Obj *obj = expr->token[i].objPtr;
12743 switch (expr->token[i].type) {
12744 case JIM_TT_EXPR_INT:
12745 type = "int";
12746 break;
12747 case JIM_TT_EXPR_DOUBLE:
12748 type = "double";
12749 break;
12750 case JIM_TT_CMD:
12751 type = "command";
12752 break;
12753 case JIM_TT_VAR:
12754 type = "variable";
12755 break;
12756 case JIM_TT_DICTSUGAR:
12757 type = "dictsugar";
12758 break;
12759 case JIM_TT_EXPRSUGAR:
12760 type = "exprsugar";
12761 break;
12762 case JIM_TT_ESC:
12763 type = "subst";
12764 break;
12765 case JIM_TT_STR:
12766 type = "string";
12767 break;
12768 default:
12769 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12770 if (op == NULL) {
12771 type = "private";
12773 else {
12774 type = "operator";
12776 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12777 break;
12779 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12780 Jim_ListAppendElement(interp, objPtr, obj);
12782 Jim_SetResult(interp, objPtr);
12783 return JIM_OK;
12785 else {
12786 Jim_SetResultString(interp,
12787 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12788 return JIM_ERR;
12790 /* unreached */
12791 #endif /* JIM_BOOTSTRAP */
12792 #if !defined(JIM_DEBUG_COMMAND)
12793 Jim_SetResultString(interp, "unsupported", -1);
12794 return JIM_ERR;
12795 #endif
12798 /* [eval] */
12799 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12801 int rc;
12803 if (argc < 2) {
12804 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12805 return JIM_ERR;
12808 if (argc == 2) {
12809 rc = Jim_EvalObj(interp, argv[1]);
12811 else {
12812 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12815 if (rc == JIM_ERR) {
12816 /* eval is "interesting", so add a stack frame here */
12817 interp->addStackTrace++;
12819 return rc;
12822 /* [uplevel] */
12823 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12825 if (argc >= 2) {
12826 int retcode;
12827 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12828 Jim_Obj *objPtr;
12829 const char *str;
12831 /* Save the old callframe pointer */
12832 savedCallFrame = interp->framePtr;
12834 /* Lookup the target frame pointer */
12835 str = Jim_String(argv[1]);
12836 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12837 targetCallFrame =Jim_GetCallFrameByLevel(interp, argv[1]);
12838 argc--;
12839 argv++;
12841 else {
12842 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12844 if (targetCallFrame == NULL) {
12845 return JIM_ERR;
12847 if (argc < 2) {
12848 argv--;
12849 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12850 return JIM_ERR;
12852 /* Eval the code in the target callframe. */
12853 interp->framePtr = targetCallFrame;
12854 if (argc == 2) {
12855 retcode = Jim_EvalObj(interp, argv[1]);
12857 else {
12858 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12859 Jim_IncrRefCount(objPtr);
12860 retcode = Jim_EvalObj(interp, objPtr);
12861 Jim_DecrRefCount(interp, objPtr);
12863 interp->framePtr = savedCallFrame;
12864 return retcode;
12866 else {
12867 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12868 return JIM_ERR;
12872 /* [expr] */
12873 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12875 Jim_Obj *exprResultPtr;
12876 int retcode;
12878 if (argc == 2) {
12879 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12881 else if (argc > 2) {
12882 Jim_Obj *objPtr;
12884 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12885 Jim_IncrRefCount(objPtr);
12886 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12887 Jim_DecrRefCount(interp, objPtr);
12889 else {
12890 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12891 return JIM_ERR;
12893 if (retcode != JIM_OK)
12894 return retcode;
12895 Jim_SetResult(interp, exprResultPtr);
12896 Jim_DecrRefCount(interp, exprResultPtr);
12897 return JIM_OK;
12900 /* [break] */
12901 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12903 if (argc != 1) {
12904 Jim_WrongNumArgs(interp, 1, argv, "");
12905 return JIM_ERR;
12907 return JIM_BREAK;
12910 /* [continue] */
12911 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12913 if (argc != 1) {
12914 Jim_WrongNumArgs(interp, 1, argv, "");
12915 return JIM_ERR;
12917 return JIM_CONTINUE;
12920 /* [return] */
12921 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12923 int i;
12924 Jim_Obj *stackTraceObj = NULL;
12925 Jim_Obj *errorCodeObj = NULL;
12926 int returnCode = JIM_OK;
12927 long level = 1;
12929 for (i = 1; i < argc - 1; i += 2) {
12930 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12931 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12932 return JIM_ERR;
12935 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12936 stackTraceObj = argv[i + 1];
12938 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12939 errorCodeObj = argv[i + 1];
12941 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12942 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12943 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12944 return JIM_ERR;
12947 else {
12948 break;
12952 if (i != argc - 1 && i != argc) {
12953 Jim_WrongNumArgs(interp, 1, argv,
12954 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12957 /* If a stack trace is supplied and code is error, set the stack trace */
12958 if (stackTraceObj && returnCode == JIM_ERR) {
12959 JimSetStackTrace(interp, stackTraceObj);
12961 /* If an error code list is supplied, set the global $errorCode */
12962 if (errorCodeObj && returnCode == JIM_ERR) {
12963 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12965 interp->returnCode = returnCode;
12966 interp->returnLevel = level;
12968 if (i == argc - 1) {
12969 Jim_SetResult(interp, argv[i]);
12971 return JIM_RETURN;
12974 /* [tailcall] */
12975 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12977 Jim_SetResult(interp, Jim_NewListObj(interp, argv + 1, argc - 1));
12978 return JIM_EVAL;
12981 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12983 Jim_Obj *cmdList;
12984 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
12986 /* prefixListObj is a list to which the args need to be appended */
12987 cmdList = Jim_DuplicateObj(interp, prefixListObj);
12988 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
12990 return JimEvalObjList(interp, cmdList);
12993 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
12995 Jim_Obj *prefixListObj = privData;
12996 Jim_DecrRefCount(interp, prefixListObj);
12999 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13001 Jim_Obj *prefixListObj;
13002 const char *newname;
13004 if (argc < 3) {
13005 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13006 return JIM_ERR;
13009 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13010 Jim_IncrRefCount(prefixListObj);
13011 newname = Jim_String(argv[1]);
13012 if (newname[0] == ':' && newname[1] == ':') {
13013 while (*++newname == ':') {
13017 Jim_SetResult(interp, argv[1]);
13019 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13022 /* [proc] */
13023 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13025 Jim_Cmd *cmd;
13027 if (argc != 4 && argc != 5) {
13028 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13029 return JIM_ERR;
13032 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13033 return JIM_ERR;
13036 if (argc == 4) {
13037 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13039 else {
13040 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13043 if (cmd) {
13044 /* Add the new command */
13045 Jim_Obj *qualifiedCmdNameObj;
13046 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13048 JimCreateCommand(interp, cmdname, cmd);
13050 /* Calculate and set the namespace for this proc */
13051 JimUpdateProcNamespace(interp, cmd, cmdname);
13053 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13055 /* Unlike Tcl, set the name of the proc as the result */
13056 Jim_SetResult(interp, argv[1]);
13057 return JIM_OK;
13059 return JIM_ERR;
13062 /* [local] */
13063 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13065 int retcode;
13067 if (argc < 2) {
13068 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13069 return JIM_ERR;
13072 /* Evaluate the arguments with 'local' in force */
13073 interp->local++;
13074 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13075 interp->local--;
13078 /* If OK, and the result is a proc, add it to the list of local procs */
13079 if (retcode == 0) {
13080 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13082 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13083 return JIM_ERR;
13085 if (interp->framePtr->localCommands == NULL) {
13086 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13087 Jim_InitStack(interp->framePtr->localCommands);
13089 Jim_IncrRefCount(cmdNameObj);
13090 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13093 return retcode;
13096 /* [upcall] */
13097 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13099 if (argc < 2) {
13100 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13101 return JIM_ERR;
13103 else {
13104 int retcode;
13106 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13107 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13108 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13109 return JIM_ERR;
13111 /* OK. Mark this command as being in an upcall */
13112 cmdPtr->u.proc.upcall++;
13113 JimIncrCmdRefCount(cmdPtr);
13115 /* Invoke the command as normal */
13116 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13118 /* No longer in an upcall */
13119 cmdPtr->u.proc.upcall--;
13120 JimDecrCmdRefCount(interp, cmdPtr);
13122 return retcode;
13126 /* [apply] */
13127 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13129 if (argc < 2) {
13130 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13131 return JIM_ERR;
13133 else {
13134 int ret;
13135 Jim_Cmd *cmd;
13136 Jim_Obj *argListObjPtr;
13137 Jim_Obj *bodyObjPtr;
13138 Jim_Obj *nsObj = NULL;
13139 Jim_Obj **nargv;
13141 int len = Jim_ListLength(interp, argv[1]);
13142 if (len != 2 && len != 3) {
13143 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13144 return JIM_ERR;
13147 if (len == 3) {
13148 #ifdef jim_ext_namespace
13149 /* Need to canonicalise the given namespace. */
13150 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13151 #else
13152 Jim_SetResultString(interp, "namespaces not enabled", -1);
13153 return JIM_ERR;
13154 #endif
13156 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13157 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13159 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13161 if (cmd) {
13162 /* Create a new argv array with a dummy argv[0], for error messages */
13163 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13164 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13165 Jim_IncrRefCount(nargv[0]);
13166 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13167 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13168 Jim_DecrRefCount(interp, nargv[0]);
13169 Jim_Free(nargv);
13171 JimDecrCmdRefCount(interp, cmd);
13172 return ret;
13174 return JIM_ERR;
13179 /* [concat] */
13180 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13182 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13183 return JIM_OK;
13186 /* [upvar] */
13187 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13189 int i;
13190 Jim_CallFrame *targetCallFrame;
13192 /* Lookup the target frame pointer */
13193 if (argc > 3 && (argc % 2 == 0)) {
13194 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13195 argc--;
13196 argv++;
13198 else {
13199 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13201 if (targetCallFrame == NULL) {
13202 return JIM_ERR;
13205 /* Check for arity */
13206 if (argc < 3) {
13207 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13208 return JIM_ERR;
13211 /* Now... for every other/local couple: */
13212 for (i = 1; i < argc; i += 2) {
13213 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13214 return JIM_ERR;
13216 return JIM_OK;
13219 /* [global] */
13220 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13222 int i;
13224 if (argc < 2) {
13225 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13226 return JIM_ERR;
13228 /* Link every var to the toplevel having the same name */
13229 if (interp->framePtr->level == 0)
13230 return JIM_OK; /* global at toplevel... */
13231 for (i = 1; i < argc; i++) {
13232 /* global ::blah does nothing */
13233 const char *name = Jim_String(argv[i]);
13234 if (name[0] != ':' || name[1] != ':') {
13235 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13236 return JIM_ERR;
13239 return JIM_OK;
13242 /* does the [string map] operation. On error NULL is returned,
13243 * otherwise a new string object with the result, having refcount = 0,
13244 * is returned. */
13245 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13246 Jim_Obj *objPtr, int nocase)
13248 int numMaps;
13249 const char *str, *noMatchStart = NULL;
13250 int strLen, i;
13251 Jim_Obj *resultObjPtr;
13253 numMaps = Jim_ListLength(interp, mapListObjPtr);
13254 if (numMaps % 2) {
13255 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13256 return NULL;
13259 str = Jim_String(objPtr);
13260 strLen = Jim_Utf8Length(interp, objPtr);
13262 /* Map it */
13263 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13264 while (strLen) {
13265 for (i = 0; i < numMaps; i += 2) {
13266 Jim_Obj *objPtr;
13267 const char *k;
13268 int kl;
13270 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13271 k = Jim_String(objPtr);
13272 kl = Jim_Utf8Length(interp, objPtr);
13274 if (strLen >= kl && kl) {
13275 int rc;
13276 rc = JimStringCompareLen(str, k, kl, nocase);
13277 if (rc == 0) {
13278 if (noMatchStart) {
13279 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13280 noMatchStart = NULL;
13282 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13283 Jim_AppendObj(interp, resultObjPtr, objPtr);
13284 str += utf8_index(str, kl);
13285 strLen -= kl;
13286 break;
13290 if (i == numMaps) { /* no match */
13291 int c;
13292 if (noMatchStart == NULL)
13293 noMatchStart = str;
13294 str += utf8_tounicode(str, &c);
13295 strLen--;
13298 if (noMatchStart) {
13299 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13301 return resultObjPtr;
13304 /* [string] */
13305 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13307 int len;
13308 int opt_case = 1;
13309 int option;
13310 static const char * const options[] = {
13311 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13312 "map", "repeat", "reverse", "index", "first", "last",
13313 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13315 enum
13317 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13318 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13319 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13321 static const char * const nocase_options[] = {
13322 "-nocase", NULL
13324 static const char * const nocase_length_options[] = {
13325 "-nocase", "-length", NULL
13328 if (argc < 2) {
13329 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13330 return JIM_ERR;
13332 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13333 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13334 return JIM_ERR;
13336 switch (option) {
13337 case OPT_LENGTH:
13338 case OPT_BYTELENGTH:
13339 if (argc != 3) {
13340 Jim_WrongNumArgs(interp, 2, argv, "string");
13341 return JIM_ERR;
13343 if (option == OPT_LENGTH) {
13344 len = Jim_Utf8Length(interp, argv[2]);
13346 else {
13347 len = Jim_Length(argv[2]);
13349 Jim_SetResultInt(interp, len);
13350 return JIM_OK;
13352 case OPT_COMPARE:
13353 case OPT_EQUAL:
13355 /* n is the number of remaining option args */
13356 long opt_length = -1;
13357 int n = argc - 4;
13358 int i = 2;
13359 while (n > 0) {
13360 int subopt;
13361 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13362 JIM_ENUM_ABBREV) != JIM_OK) {
13363 badcompareargs:
13364 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13365 return JIM_ERR;
13367 if (subopt == 0) {
13368 /* -nocase */
13369 opt_case = 0;
13370 n--;
13372 else {
13373 /* -length */
13374 if (n < 2) {
13375 goto badcompareargs;
13377 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13378 return JIM_ERR;
13380 n -= 2;
13383 if (n) {
13384 goto badcompareargs;
13386 argv += argc - 2;
13387 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13388 /* Fast version - [string equal], case sensitive, no length */
13389 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13391 else {
13392 if (opt_length >= 0) {
13393 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13395 else {
13396 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13398 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13400 return JIM_OK;
13403 case OPT_MATCH:
13404 if (argc != 4 &&
13405 (argc != 5 ||
13406 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13407 JIM_ENUM_ABBREV) != JIM_OK)) {
13408 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13409 return JIM_ERR;
13411 if (opt_case == 0) {
13412 argv++;
13414 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13415 return JIM_OK;
13417 case OPT_MAP:{
13418 Jim_Obj *objPtr;
13420 if (argc != 4 &&
13421 (argc != 5 ||
13422 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13423 JIM_ENUM_ABBREV) != JIM_OK)) {
13424 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13425 return JIM_ERR;
13428 if (opt_case == 0) {
13429 argv++;
13431 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13432 if (objPtr == NULL) {
13433 return JIM_ERR;
13435 Jim_SetResult(interp, objPtr);
13436 return JIM_OK;
13439 case OPT_RANGE:
13440 case OPT_BYTERANGE:{
13441 Jim_Obj *objPtr;
13443 if (argc != 5) {
13444 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13445 return JIM_ERR;
13447 if (option == OPT_RANGE) {
13448 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13450 else
13452 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13455 if (objPtr == NULL) {
13456 return JIM_ERR;
13458 Jim_SetResult(interp, objPtr);
13459 return JIM_OK;
13462 case OPT_REPLACE:{
13463 Jim_Obj *objPtr;
13465 if (argc != 5 && argc != 6) {
13466 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13467 return JIM_ERR;
13469 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13470 if (objPtr == NULL) {
13471 return JIM_ERR;
13473 Jim_SetResult(interp, objPtr);
13474 return JIM_OK;
13478 case OPT_REPEAT:{
13479 Jim_Obj *objPtr;
13480 jim_wide count;
13482 if (argc != 4) {
13483 Jim_WrongNumArgs(interp, 2, argv, "string count");
13484 return JIM_ERR;
13486 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13487 return JIM_ERR;
13489 objPtr = Jim_NewStringObj(interp, "", 0);
13490 if (count > 0) {
13491 while (count--) {
13492 Jim_AppendObj(interp, objPtr, argv[2]);
13495 Jim_SetResult(interp, objPtr);
13496 return JIM_OK;
13499 case OPT_REVERSE:{
13500 char *buf, *p;
13501 const char *str;
13502 int len;
13503 int i;
13505 if (argc != 3) {
13506 Jim_WrongNumArgs(interp, 2, argv, "string");
13507 return JIM_ERR;
13510 str = Jim_GetString(argv[2], &len);
13511 buf = Jim_Alloc(len + 1);
13512 p = buf + len;
13513 *p = 0;
13514 for (i = 0; i < len; ) {
13515 int c;
13516 int l = utf8_tounicode(str, &c);
13517 memcpy(p - l, str, l);
13518 p -= l;
13519 i += l;
13520 str += l;
13522 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13523 return JIM_OK;
13526 case OPT_INDEX:{
13527 int idx;
13528 const char *str;
13530 if (argc != 4) {
13531 Jim_WrongNumArgs(interp, 2, argv, "string index");
13532 return JIM_ERR;
13534 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13535 return JIM_ERR;
13537 str = Jim_String(argv[2]);
13538 len = Jim_Utf8Length(interp, argv[2]);
13539 if (idx != INT_MIN && idx != INT_MAX) {
13540 idx = JimRelToAbsIndex(len, idx);
13542 if (idx < 0 || idx >= len || str == NULL) {
13543 Jim_SetResultString(interp, "", 0);
13545 else if (len == Jim_Length(argv[2])) {
13546 /* ASCII optimisation */
13547 Jim_SetResultString(interp, str + idx, 1);
13549 else {
13550 int c;
13551 int i = utf8_index(str, idx);
13552 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13554 return JIM_OK;
13557 case OPT_FIRST:
13558 case OPT_LAST:{
13559 int idx = 0, l1, l2;
13560 const char *s1, *s2;
13562 if (argc != 4 && argc != 5) {
13563 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13564 return JIM_ERR;
13566 s1 = Jim_String(argv[2]);
13567 s2 = Jim_String(argv[3]);
13568 l1 = Jim_Utf8Length(interp, argv[2]);
13569 l2 = Jim_Utf8Length(interp, argv[3]);
13570 if (argc == 5) {
13571 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13572 return JIM_ERR;
13574 idx = JimRelToAbsIndex(l2, idx);
13576 else if (option == OPT_LAST) {
13577 idx = l2;
13579 if (option == OPT_FIRST) {
13580 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13582 else {
13583 #ifdef JIM_UTF8
13584 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13585 #else
13586 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13587 #endif
13589 return JIM_OK;
13592 case OPT_TRIM:
13593 case OPT_TRIMLEFT:
13594 case OPT_TRIMRIGHT:{
13595 Jim_Obj *trimchars;
13597 if (argc != 3 && argc != 4) {
13598 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13599 return JIM_ERR;
13601 trimchars = (argc == 4 ? argv[3] : NULL);
13602 if (option == OPT_TRIM) {
13603 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13605 else if (option == OPT_TRIMLEFT) {
13606 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13608 else if (option == OPT_TRIMRIGHT) {
13609 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13611 return JIM_OK;
13614 case OPT_TOLOWER:
13615 case OPT_TOUPPER:
13616 case OPT_TOTITLE:
13617 if (argc != 3) {
13618 Jim_WrongNumArgs(interp, 2, argv, "string");
13619 return JIM_ERR;
13621 if (option == OPT_TOLOWER) {
13622 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13624 else if (option == OPT_TOUPPER) {
13625 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13627 else {
13628 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13630 return JIM_OK;
13632 case OPT_IS:
13633 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13634 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13636 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13637 return JIM_ERR;
13639 return JIM_OK;
13642 /* [time] */
13643 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13645 long i, count = 1;
13646 jim_wide start, elapsed;
13647 char buf[60];
13648 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13650 if (argc < 2) {
13651 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13652 return JIM_ERR;
13654 if (argc == 3) {
13655 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13656 return JIM_ERR;
13658 if (count < 0)
13659 return JIM_OK;
13660 i = count;
13661 start = JimClock();
13662 while (i-- > 0) {
13663 int retval;
13665 retval = Jim_EvalObj(interp, argv[1]);
13666 if (retval != JIM_OK) {
13667 return retval;
13670 elapsed = JimClock() - start;
13671 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13672 Jim_SetResultString(interp, buf, -1);
13673 return JIM_OK;
13676 /* [exit] */
13677 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13679 long exitCode = 0;
13681 if (argc > 2) {
13682 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13683 return JIM_ERR;
13685 if (argc == 2) {
13686 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13687 return JIM_ERR;
13689 interp->exitCode = exitCode;
13690 return JIM_EXIT;
13693 /* [catch] */
13694 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13696 int exitCode = 0;
13697 int i;
13698 int sig = 0;
13700 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13701 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13702 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13704 /* Reset the error code before catch.
13705 * Note that this is not strictly correct.
13707 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13709 for (i = 1; i < argc - 1; i++) {
13710 const char *arg = Jim_String(argv[i]);
13711 jim_wide option;
13712 int ignore;
13714 /* It's a pity we can't use Jim_GetEnum here :-( */
13715 if (strcmp(arg, "--") == 0) {
13716 i++;
13717 break;
13719 if (*arg != '-') {
13720 break;
13723 if (strncmp(arg, "-no", 3) == 0) {
13724 arg += 3;
13725 ignore = 1;
13727 else {
13728 arg++;
13729 ignore = 0;
13732 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13733 option = -1;
13735 if (option < 0) {
13736 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13738 if (option < 0) {
13739 goto wrongargs;
13742 if (ignore) {
13743 ignore_mask |= (1 << option);
13745 else {
13746 ignore_mask &= ~(1 << option);
13750 argc -= i;
13751 if (argc < 1 || argc > 3) {
13752 wrongargs:
13753 Jim_WrongNumArgs(interp, 1, argv,
13754 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13755 return JIM_ERR;
13757 argv += i;
13759 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13760 sig++;
13763 interp->signal_level += sig;
13764 if (Jim_CheckSignal(interp)) {
13765 /* If a signal is set, don't even try to execute the body */
13766 exitCode = JIM_SIGNAL;
13768 else {
13769 exitCode = Jim_EvalObj(interp, argv[0]);
13771 interp->signal_level -= sig;
13773 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13774 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13775 /* Not caught, pass it up */
13776 return exitCode;
13779 if (sig && exitCode == JIM_SIGNAL) {
13780 /* Catch the signal at this level */
13781 if (interp->signal_set_result) {
13782 interp->signal_set_result(interp, interp->sigmask);
13784 else {
13785 Jim_SetResultInt(interp, interp->sigmask);
13787 interp->sigmask = 0;
13790 if (argc >= 2) {
13791 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13792 return JIM_ERR;
13794 if (argc == 3) {
13795 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13797 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13798 Jim_ListAppendElement(interp, optListObj,
13799 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13800 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13801 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13802 if (exitCode == JIM_ERR) {
13803 Jim_Obj *errorCode;
13804 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13805 -1));
13806 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13808 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13809 if (errorCode) {
13810 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13811 Jim_ListAppendElement(interp, optListObj, errorCode);
13814 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13815 return JIM_ERR;
13819 Jim_SetResultInt(interp, exitCode);
13820 return JIM_OK;
13823 #ifdef JIM_REFERENCES
13825 /* [ref] */
13826 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13828 if (argc != 3 && argc != 4) {
13829 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13830 return JIM_ERR;
13832 if (argc == 3) {
13833 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13835 else {
13836 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13838 return JIM_OK;
13841 /* [getref] */
13842 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13844 Jim_Reference *refPtr;
13846 if (argc != 2) {
13847 Jim_WrongNumArgs(interp, 1, argv, "reference");
13848 return JIM_ERR;
13850 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13851 return JIM_ERR;
13852 Jim_SetResult(interp, refPtr->objPtr);
13853 return JIM_OK;
13856 /* [setref] */
13857 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13859 Jim_Reference *refPtr;
13861 if (argc != 3) {
13862 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13863 return JIM_ERR;
13865 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13866 return JIM_ERR;
13867 Jim_IncrRefCount(argv[2]);
13868 Jim_DecrRefCount(interp, refPtr->objPtr);
13869 refPtr->objPtr = argv[2];
13870 Jim_SetResult(interp, argv[2]);
13871 return JIM_OK;
13874 /* [collect] */
13875 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13877 if (argc != 1) {
13878 Jim_WrongNumArgs(interp, 1, argv, "");
13879 return JIM_ERR;
13881 Jim_SetResultInt(interp, Jim_Collect(interp));
13883 /* Free all the freed objects. */
13884 while (interp->freeList) {
13885 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13886 Jim_Free(interp->freeList);
13887 interp->freeList = nextObjPtr;
13890 return JIM_OK;
13893 /* [finalize] reference ?newValue? */
13894 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13896 if (argc != 2 && argc != 3) {
13897 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13898 return JIM_ERR;
13900 if (argc == 2) {
13901 Jim_Obj *cmdNamePtr;
13903 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13904 return JIM_ERR;
13905 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13906 Jim_SetResult(interp, cmdNamePtr);
13908 else {
13909 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13910 return JIM_ERR;
13911 Jim_SetResult(interp, argv[2]);
13913 return JIM_OK;
13916 /* [info references] */
13917 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13919 Jim_Obj *listObjPtr;
13920 Jim_HashTableIterator htiter;
13921 Jim_HashEntry *he;
13923 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13925 JimInitHashTableIterator(&interp->references, &htiter);
13926 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13927 char buf[JIM_REFERENCE_SPACE + 1];
13928 Jim_Reference *refPtr = he->u.val;
13929 const unsigned long *refId = he->key;
13931 JimFormatReference(buf, refPtr, *refId);
13932 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
13934 Jim_SetResult(interp, listObjPtr);
13935 return JIM_OK;
13937 #endif
13939 /* [rename] */
13940 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13942 if (argc != 3) {
13943 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
13944 return JIM_ERR;
13947 if (JimValidName(interp, "new procedure", argv[2])) {
13948 return JIM_ERR;
13951 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
13954 #define JIM_DICTMATCH_VALUES 0x0001
13956 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
13958 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
13960 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
13961 if (type & JIM_DICTMATCH_VALUES) {
13962 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
13967 * Like JimHashtablePatternMatch, but for dictionaries.
13969 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
13970 JimDictMatchCallbackType *callback, int type)
13972 Jim_HashEntry *he;
13973 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13975 /* Check for the non-pattern case. We can do this much more efficiently. */
13976 Jim_HashTableIterator htiter;
13977 JimInitHashTableIterator(ht, &htiter);
13978 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13979 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
13980 callback(interp, listObjPtr, he, type);
13984 return listObjPtr;
13988 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
13990 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
13991 return JIM_ERR;
13993 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
13994 return JIM_OK;
13997 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
13999 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14000 return JIM_ERR;
14002 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14003 return JIM_OK;
14006 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14008 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14009 return -1;
14011 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14014 /* [dict] */
14015 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14017 Jim_Obj *objPtr;
14018 int option;
14019 static const char * const options[] = {
14020 "create", "get", "set", "unset", "exists", "keys", "merge", "size", "with", NULL
14022 enum
14024 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST, OPT_KEYS, OPT_MERGE, OPT_SIZE, OPT_WITH,
14027 if (argc < 2) {
14028 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14029 return JIM_ERR;
14032 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14033 return JIM_ERR;
14036 switch (option) {
14037 case OPT_GET:
14038 if (argc < 3) {
14039 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
14040 return JIM_ERR;
14042 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14043 JIM_ERRMSG) != JIM_OK) {
14044 return JIM_ERR;
14046 Jim_SetResult(interp, objPtr);
14047 return JIM_OK;
14049 case OPT_SET:
14050 if (argc < 5) {
14051 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14052 return JIM_ERR;
14054 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14056 case OPT_EXIST:
14057 if (argc < 3) {
14058 Jim_WrongNumArgs(interp, 2, argv, "varName ?key ...?");
14059 return JIM_ERR;
14061 Jim_SetResultBool(interp, Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3,
14062 &objPtr, JIM_ERRMSG) == JIM_OK);
14063 return JIM_OK;
14065 case OPT_UNSET:
14066 if (argc < 4) {
14067 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14068 return JIM_ERR;
14070 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE);
14072 case OPT_KEYS:
14073 if (argc != 3 && argc != 4) {
14074 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?pattern?");
14075 return JIM_ERR;
14077 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14079 case OPT_SIZE: {
14080 int size;
14082 if (argc != 3) {
14083 Jim_WrongNumArgs(interp, 2, argv, "dictVar");
14084 return JIM_ERR;
14087 size = Jim_DictSize(interp, argv[2]);
14088 if (size < 0) {
14089 return JIM_ERR;
14091 Jim_SetResultInt(interp, size);
14092 return JIM_OK;
14095 case OPT_MERGE:
14096 if (argc == 2) {
14097 return JIM_OK;
14099 else if (SetDictFromAny(interp, argv[2]) != JIM_OK) {
14100 return JIM_ERR;
14102 else {
14103 return Jim_EvalPrefix(interp, "dict merge", argc - 2, argv + 2);
14106 case OPT_WITH:
14107 if (argc < 4) {
14108 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14109 return JIM_ERR;
14111 else if (Jim_GetVariable(interp, argv[2], JIM_ERRMSG) == NULL) {
14112 return JIM_ERR;
14114 else {
14115 return Jim_EvalPrefix(interp, "dict with", argc - 2, argv + 2);
14118 case OPT_CREATE:
14119 if (argc % 2) {
14120 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14121 return JIM_ERR;
14123 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14124 Jim_SetResult(interp, objPtr);
14125 return JIM_OK;
14127 return JIM_ERR;
14130 /* [subst] */
14131 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14133 static const char * const options[] = {
14134 "-nobackslashes", "-nocommands", "-novariables", NULL
14136 enum
14137 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14138 int i;
14139 int flags = JIM_SUBST_FLAG;
14140 Jim_Obj *objPtr;
14142 if (argc < 2) {
14143 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14144 return JIM_ERR;
14146 for (i = 1; i < (argc - 1); i++) {
14147 int option;
14149 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14150 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14151 return JIM_ERR;
14153 switch (option) {
14154 case OPT_NOBACKSLASHES:
14155 flags |= JIM_SUBST_NOESC;
14156 break;
14157 case OPT_NOCOMMANDS:
14158 flags |= JIM_SUBST_NOCMD;
14159 break;
14160 case OPT_NOVARIABLES:
14161 flags |= JIM_SUBST_NOVAR;
14162 break;
14165 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14166 return JIM_ERR;
14168 Jim_SetResult(interp, objPtr);
14169 return JIM_OK;
14172 /* [info] */
14173 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14175 int cmd;
14176 Jim_Obj *objPtr;
14177 int mode = 0;
14179 static const char * const commands[] = {
14180 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14181 "vars", "version", "patchlevel", "complete", "args", "hostname",
14182 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14183 "references", "alias", NULL
14185 enum
14186 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14187 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14188 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14189 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS
14192 #ifdef jim_ext_namespace
14193 int nons = 0;
14195 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14196 /* This is for internal use only */
14197 argc--;
14198 argv++;
14199 nons = 1;
14201 #endif
14203 if (argc < 2) {
14204 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14205 return JIM_ERR;
14207 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14208 != JIM_OK) {
14209 return JIM_ERR;
14212 /* Test for the the most common commands first, just in case it makes a difference */
14213 switch (cmd) {
14214 case INFO_EXISTS:
14215 if (argc != 3) {
14216 Jim_WrongNumArgs(interp, 2, argv, "varName");
14217 return JIM_ERR;
14219 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14220 break;
14222 case INFO_ALIAS:{
14223 Jim_Cmd *cmdPtr;
14225 if (argc != 3) {
14226 Jim_WrongNumArgs(interp, 2, argv, "command");
14227 return JIM_ERR;
14229 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14230 return JIM_ERR;
14232 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14233 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14234 return JIM_ERR;
14236 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14237 return JIM_OK;
14240 case INFO_CHANNELS:
14241 mode++; /* JIM_CMDLIST_CHANNELS */
14242 #ifndef jim_ext_aio
14243 Jim_SetResultString(interp, "aio not enabled", -1);
14244 return JIM_ERR;
14245 #endif
14246 case INFO_PROCS:
14247 mode++; /* JIM_CMDLIST_PROCS */
14248 case INFO_COMMANDS:
14249 /* mode 0 => JIM_CMDLIST_COMMANDS */
14250 if (argc != 2 && argc != 3) {
14251 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14252 return JIM_ERR;
14254 #ifdef jim_ext_namespace
14255 if (!nons) {
14256 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14257 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14260 #endif
14261 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14262 break;
14264 case INFO_VARS:
14265 mode++; /* JIM_VARLIST_VARS */
14266 case INFO_LOCALS:
14267 mode++; /* JIM_VARLIST_LOCALS */
14268 case INFO_GLOBALS:
14269 /* mode 0 => JIM_VARLIST_GLOBALS */
14270 if (argc != 2 && argc != 3) {
14271 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14272 return JIM_ERR;
14274 #ifdef jim_ext_namespace
14275 if (!nons) {
14276 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14277 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14280 #endif
14281 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14282 break;
14284 case INFO_SCRIPT:
14285 if (argc != 2) {
14286 Jim_WrongNumArgs(interp, 2, argv, "");
14287 return JIM_ERR;
14289 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14290 break;
14292 case INFO_SOURCE:{
14293 int line;
14294 Jim_Obj *resObjPtr;
14295 Jim_Obj *fileNameObj;
14297 if (argc != 3) {
14298 Jim_WrongNumArgs(interp, 2, argv, "source");
14299 return JIM_ERR;
14301 if (argv[2]->typePtr == &sourceObjType) {
14302 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14303 line = argv[2]->internalRep.sourceValue.lineNumber;
14305 else if (argv[2]->typePtr == &scriptObjType) {
14306 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14307 fileNameObj = script->fileNameObj;
14308 line = script->firstline;
14310 else {
14311 fileNameObj = interp->emptyObj;
14312 line = 1;
14314 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14315 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14316 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14317 Jim_SetResult(interp, resObjPtr);
14318 break;
14321 case INFO_STACKTRACE:
14322 Jim_SetResult(interp, interp->stackTrace);
14323 break;
14325 case INFO_LEVEL:
14326 case INFO_FRAME:
14327 switch (argc) {
14328 case 2:
14329 Jim_SetResultInt(interp, interp->framePtr->level);
14330 break;
14332 case 3:
14333 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14334 return JIM_ERR;
14336 Jim_SetResult(interp, objPtr);
14337 break;
14339 default:
14340 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14341 return JIM_ERR;
14343 break;
14345 case INFO_BODY:
14346 case INFO_STATICS:
14347 case INFO_ARGS:{
14348 Jim_Cmd *cmdPtr;
14350 if (argc != 3) {
14351 Jim_WrongNumArgs(interp, 2, argv, "procname");
14352 return JIM_ERR;
14354 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14355 return JIM_ERR;
14357 if (!cmdPtr->isproc) {
14358 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14359 return JIM_ERR;
14361 switch (cmd) {
14362 case INFO_BODY:
14363 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14364 break;
14365 case INFO_ARGS:
14366 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14367 break;
14368 case INFO_STATICS:
14369 if (cmdPtr->u.proc.staticVars) {
14370 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14371 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14372 NULL, JimVariablesMatch, mode));
14374 break;
14376 break;
14379 case INFO_VERSION:
14380 case INFO_PATCHLEVEL:{
14381 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14383 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14384 Jim_SetResultString(interp, buf, -1);
14385 break;
14388 case INFO_COMPLETE:
14389 if (argc != 3 && argc != 4) {
14390 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14391 return JIM_ERR;
14393 else {
14394 int len;
14395 const char *s = Jim_GetString(argv[2], &len);
14396 char missing;
14398 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14399 if (missing != ' ' && argc == 4) {
14400 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14403 break;
14405 case INFO_HOSTNAME:
14406 /* Redirect to os.gethostname if it exists */
14407 return Jim_Eval(interp, "os.gethostname");
14409 case INFO_NAMEOFEXECUTABLE:
14410 /* Redirect to Tcl proc */
14411 return Jim_Eval(interp, "{info nameofexecutable}");
14413 case INFO_RETURNCODES:
14414 if (argc == 2) {
14415 int i;
14416 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14418 for (i = 0; jimReturnCodes[i]; i++) {
14419 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14420 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14421 jimReturnCodes[i], -1));
14424 Jim_SetResult(interp, listObjPtr);
14426 else if (argc == 3) {
14427 long code;
14428 const char *name;
14430 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14431 return JIM_ERR;
14433 name = Jim_ReturnCode(code);
14434 if (*name == '?') {
14435 Jim_SetResultInt(interp, code);
14437 else {
14438 Jim_SetResultString(interp, name, -1);
14441 else {
14442 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14443 return JIM_ERR;
14445 break;
14446 case INFO_REFERENCES:
14447 #ifdef JIM_REFERENCES
14448 return JimInfoReferences(interp, argc, argv);
14449 #else
14450 Jim_SetResultString(interp, "not supported", -1);
14451 return JIM_ERR;
14452 #endif
14454 return JIM_OK;
14457 /* [exists] */
14458 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14460 Jim_Obj *objPtr;
14461 int result = 0;
14463 static const char * const options[] = {
14464 "-command", "-proc", "-alias", "-var", NULL
14466 enum
14468 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14470 int option;
14472 if (argc == 2) {
14473 option = OPT_VAR;
14474 objPtr = argv[1];
14476 else if (argc == 3) {
14477 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14478 return JIM_ERR;
14480 objPtr = argv[2];
14482 else {
14483 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14484 return JIM_ERR;
14487 if (option == OPT_VAR) {
14488 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14490 else {
14491 /* Now different kinds of commands */
14492 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14494 if (cmd) {
14495 switch (option) {
14496 case OPT_COMMAND:
14497 result = 1;
14498 break;
14500 case OPT_ALIAS:
14501 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14502 break;
14504 case OPT_PROC:
14505 result = cmd->isproc;
14506 break;
14510 Jim_SetResultBool(interp, result);
14511 return JIM_OK;
14514 /* [split] */
14515 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14517 const char *str, *splitChars, *noMatchStart;
14518 int splitLen, strLen;
14519 Jim_Obj *resObjPtr;
14520 int c;
14521 int len;
14523 if (argc != 2 && argc != 3) {
14524 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14525 return JIM_ERR;
14528 str = Jim_GetString(argv[1], &len);
14529 if (len == 0) {
14530 return JIM_OK;
14532 strLen = Jim_Utf8Length(interp, argv[1]);
14534 /* Init */
14535 if (argc == 2) {
14536 splitChars = " \n\t\r";
14537 splitLen = 4;
14539 else {
14540 splitChars = Jim_String(argv[2]);
14541 splitLen = Jim_Utf8Length(interp, argv[2]);
14544 noMatchStart = str;
14545 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14547 /* Split */
14548 if (splitLen) {
14549 Jim_Obj *objPtr;
14550 while (strLen--) {
14551 const char *sc = splitChars;
14552 int scLen = splitLen;
14553 int sl = utf8_tounicode(str, &c);
14554 while (scLen--) {
14555 int pc;
14556 sc += utf8_tounicode(sc, &pc);
14557 if (c == pc) {
14558 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14559 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14560 noMatchStart = str + sl;
14561 break;
14564 str += sl;
14566 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14567 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14569 else {
14570 /* This handles the special case of splitchars eq {}
14571 * Optimise by sharing common (ASCII) characters
14573 Jim_Obj **commonObj = NULL;
14574 #define NUM_COMMON (128 - 9)
14575 while (strLen--) {
14576 int n = utf8_tounicode(str, &c);
14577 #ifdef JIM_OPTIMIZATION
14578 if (c >= 9 && c < 128) {
14579 /* Common ASCII char. Note that 9 is the tab character */
14580 c -= 9;
14581 if (!commonObj) {
14582 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14583 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14585 if (!commonObj[c]) {
14586 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14588 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14589 str++;
14590 continue;
14592 #endif
14593 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14594 str += n;
14596 Jim_Free(commonObj);
14599 Jim_SetResult(interp, resObjPtr);
14600 return JIM_OK;
14603 /* [join] */
14604 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14606 const char *joinStr;
14607 int joinStrLen;
14609 if (argc != 2 && argc != 3) {
14610 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14611 return JIM_ERR;
14613 /* Init */
14614 if (argc == 2) {
14615 joinStr = " ";
14616 joinStrLen = 1;
14618 else {
14619 joinStr = Jim_GetString(argv[2], &joinStrLen);
14621 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14622 return JIM_OK;
14625 /* [format] */
14626 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14628 Jim_Obj *objPtr;
14630 if (argc < 2) {
14631 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14632 return JIM_ERR;
14634 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14635 if (objPtr == NULL)
14636 return JIM_ERR;
14637 Jim_SetResult(interp, objPtr);
14638 return JIM_OK;
14641 /* [scan] */
14642 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14644 Jim_Obj *listPtr, **outVec;
14645 int outc, i;
14647 if (argc < 3) {
14648 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14649 return JIM_ERR;
14651 if (argv[2]->typePtr != &scanFmtStringObjType)
14652 SetScanFmtFromAny(interp, argv[2]);
14653 if (FormatGetError(argv[2]) != 0) {
14654 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14655 return JIM_ERR;
14657 if (argc > 3) {
14658 int maxPos = FormatGetMaxPos(argv[2]);
14659 int count = FormatGetCnvCount(argv[2]);
14661 if (maxPos > argc - 3) {
14662 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14663 return JIM_ERR;
14665 else if (count > argc - 3) {
14666 Jim_SetResultString(interp, "different numbers of variable names and "
14667 "field specifiers", -1);
14668 return JIM_ERR;
14670 else if (count < argc - 3) {
14671 Jim_SetResultString(interp, "variable is not assigned by any "
14672 "conversion specifiers", -1);
14673 return JIM_ERR;
14676 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14677 if (listPtr == 0)
14678 return JIM_ERR;
14679 if (argc > 3) {
14680 int rc = JIM_OK;
14681 int count = 0;
14683 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14684 int len = Jim_ListLength(interp, listPtr);
14686 if (len != 0) {
14687 JimListGetElements(interp, listPtr, &outc, &outVec);
14688 for (i = 0; i < outc; ++i) {
14689 if (Jim_Length(outVec[i]) > 0) {
14690 ++count;
14691 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14692 rc = JIM_ERR;
14697 Jim_FreeNewObj(interp, listPtr);
14699 else {
14700 count = -1;
14702 if (rc == JIM_OK) {
14703 Jim_SetResultInt(interp, count);
14705 return rc;
14707 else {
14708 if (listPtr == (Jim_Obj *)EOF) {
14709 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14710 return JIM_OK;
14712 Jim_SetResult(interp, listPtr);
14714 return JIM_OK;
14717 /* [error] */
14718 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14720 if (argc != 2 && argc != 3) {
14721 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14722 return JIM_ERR;
14724 Jim_SetResult(interp, argv[1]);
14725 if (argc == 3) {
14726 JimSetStackTrace(interp, argv[2]);
14727 return JIM_ERR;
14729 interp->addStackTrace++;
14730 return JIM_ERR;
14733 /* [lrange] */
14734 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14736 Jim_Obj *objPtr;
14738 if (argc != 4) {
14739 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14740 return JIM_ERR;
14742 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14743 return JIM_ERR;
14744 Jim_SetResult(interp, objPtr);
14745 return JIM_OK;
14748 /* [lrepeat] */
14749 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14751 Jim_Obj *objPtr;
14752 long count;
14754 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14755 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14756 return JIM_ERR;
14759 if (count == 0 || argc == 2) {
14760 return JIM_OK;
14763 argc -= 2;
14764 argv += 2;
14766 objPtr = Jim_NewListObj(interp, argv, argc);
14767 while (--count) {
14768 ListInsertElements(objPtr, -1, argc, argv);
14771 Jim_SetResult(interp, objPtr);
14772 return JIM_OK;
14775 char **Jim_GetEnviron(void)
14777 #if defined(HAVE__NSGETENVIRON)
14778 return *_NSGetEnviron();
14779 #else
14780 #if !defined(NO_ENVIRON_EXTERN)
14781 extern char **environ;
14782 #endif
14784 return environ;
14785 #endif
14788 void Jim_SetEnviron(char **env)
14790 #if defined(HAVE__NSGETENVIRON)
14791 *_NSGetEnviron() = env;
14792 #else
14793 #if !defined(NO_ENVIRON_EXTERN)
14794 extern char **environ;
14795 #endif
14797 environ = env;
14798 #endif
14801 /* [env] */
14802 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14804 const char *key;
14805 const char *val;
14807 if (argc == 1) {
14808 char **e = Jim_GetEnviron();
14810 int i;
14811 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14813 for (i = 0; e[i]; i++) {
14814 const char *equals = strchr(e[i], '=');
14816 if (equals) {
14817 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14818 equals - e[i]));
14819 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14823 Jim_SetResult(interp, listObjPtr);
14824 return JIM_OK;
14827 if (argc < 2) {
14828 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14829 return JIM_ERR;
14831 key = Jim_String(argv[1]);
14832 val = getenv(key);
14833 if (val == NULL) {
14834 if (argc < 3) {
14835 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14836 return JIM_ERR;
14838 val = Jim_String(argv[2]);
14840 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
14841 return JIM_OK;
14844 /* [source] */
14845 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14847 int retval;
14849 if (argc != 2) {
14850 Jim_WrongNumArgs(interp, 1, argv, "fileName");
14851 return JIM_ERR;
14853 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
14854 if (retval == JIM_RETURN)
14855 return JIM_OK;
14856 return retval;
14859 /* [lreverse] */
14860 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14862 Jim_Obj *revObjPtr, **ele;
14863 int len;
14865 if (argc != 2) {
14866 Jim_WrongNumArgs(interp, 1, argv, "list");
14867 return JIM_ERR;
14869 JimListGetElements(interp, argv[1], &len, &ele);
14870 len--;
14871 revObjPtr = Jim_NewListObj(interp, NULL, 0);
14872 while (len >= 0)
14873 ListAppendElement(revObjPtr, ele[len--]);
14874 Jim_SetResult(interp, revObjPtr);
14875 return JIM_OK;
14878 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
14880 jim_wide len;
14882 if (step == 0)
14883 return -1;
14884 if (start == end)
14885 return 0;
14886 else if (step > 0 && start > end)
14887 return -1;
14888 else if (step < 0 && end > start)
14889 return -1;
14890 len = end - start;
14891 if (len < 0)
14892 len = -len; /* abs(len) */
14893 if (step < 0)
14894 step = -step; /* abs(step) */
14895 len = 1 + ((len - 1) / step);
14896 /* We can truncate safely to INT_MAX, the range command
14897 * will always return an error for a such long range
14898 * because Tcl lists can't be so long. */
14899 if (len > INT_MAX)
14900 len = INT_MAX;
14901 return (int)((len < 0) ? -1 : len);
14904 /* [range] */
14905 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14907 jim_wide start = 0, end, step = 1;
14908 int len, i;
14909 Jim_Obj *objPtr;
14911 if (argc < 2 || argc > 4) {
14912 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
14913 return JIM_ERR;
14915 if (argc == 2) {
14916 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
14917 return JIM_ERR;
14919 else {
14920 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
14921 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
14922 return JIM_ERR;
14923 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
14924 return JIM_ERR;
14926 if ((len = JimRangeLen(start, end, step)) == -1) {
14927 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
14928 return JIM_ERR;
14930 objPtr = Jim_NewListObj(interp, NULL, 0);
14931 for (i = 0; i < len; i++)
14932 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
14933 Jim_SetResult(interp, objPtr);
14934 return JIM_OK;
14937 /* [rand] */
14938 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14940 jim_wide min = 0, max = 0, len, maxMul;
14942 if (argc < 1 || argc > 3) {
14943 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
14944 return JIM_ERR;
14946 if (argc == 1) {
14947 max = JIM_WIDE_MAX;
14948 } else if (argc == 2) {
14949 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
14950 return JIM_ERR;
14951 } else if (argc == 3) {
14952 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
14953 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
14954 return JIM_ERR;
14956 len = max-min;
14957 if (len < 0) {
14958 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
14959 return JIM_ERR;
14961 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
14962 while (1) {
14963 jim_wide r;
14965 JimRandomBytes(interp, &r, sizeof(jim_wide));
14966 if (r < 0 || r >= maxMul) continue;
14967 r = (len == 0) ? 0 : r%len;
14968 Jim_SetResultInt(interp, min+r);
14969 return JIM_OK;
14973 static const struct {
14974 const char *name;
14975 Jim_CmdProc cmdProc;
14976 } Jim_CoreCommandsTable[] = {
14977 {"alias", Jim_AliasCoreCommand},
14978 {"set", Jim_SetCoreCommand},
14979 {"unset", Jim_UnsetCoreCommand},
14980 {"puts", Jim_PutsCoreCommand},
14981 {"+", Jim_AddCoreCommand},
14982 {"*", Jim_MulCoreCommand},
14983 {"-", Jim_SubCoreCommand},
14984 {"/", Jim_DivCoreCommand},
14985 {"incr", Jim_IncrCoreCommand},
14986 {"while", Jim_WhileCoreCommand},
14987 {"loop", Jim_LoopCoreCommand},
14988 {"for", Jim_ForCoreCommand},
14989 {"foreach", Jim_ForeachCoreCommand},
14990 {"lmap", Jim_LmapCoreCommand},
14991 {"lassign", Jim_LassignCoreCommand},
14992 {"if", Jim_IfCoreCommand},
14993 {"switch", Jim_SwitchCoreCommand},
14994 {"list", Jim_ListCoreCommand},
14995 {"lindex", Jim_LindexCoreCommand},
14996 {"lset", Jim_LsetCoreCommand},
14997 {"lsearch", Jim_LsearchCoreCommand},
14998 {"llength", Jim_LlengthCoreCommand},
14999 {"lappend", Jim_LappendCoreCommand},
15000 {"linsert", Jim_LinsertCoreCommand},
15001 {"lreplace", Jim_LreplaceCoreCommand},
15002 {"lsort", Jim_LsortCoreCommand},
15003 {"append", Jim_AppendCoreCommand},
15004 {"debug", Jim_DebugCoreCommand},
15005 {"eval", Jim_EvalCoreCommand},
15006 {"uplevel", Jim_UplevelCoreCommand},
15007 {"expr", Jim_ExprCoreCommand},
15008 {"break", Jim_BreakCoreCommand},
15009 {"continue", Jim_ContinueCoreCommand},
15010 {"proc", Jim_ProcCoreCommand},
15011 {"concat", Jim_ConcatCoreCommand},
15012 {"return", Jim_ReturnCoreCommand},
15013 {"upvar", Jim_UpvarCoreCommand},
15014 {"global", Jim_GlobalCoreCommand},
15015 {"string", Jim_StringCoreCommand},
15016 {"time", Jim_TimeCoreCommand},
15017 {"exit", Jim_ExitCoreCommand},
15018 {"catch", Jim_CatchCoreCommand},
15019 #ifdef JIM_REFERENCES
15020 {"ref", Jim_RefCoreCommand},
15021 {"getref", Jim_GetrefCoreCommand},
15022 {"setref", Jim_SetrefCoreCommand},
15023 {"finalize", Jim_FinalizeCoreCommand},
15024 {"collect", Jim_CollectCoreCommand},
15025 #endif
15026 {"rename", Jim_RenameCoreCommand},
15027 {"dict", Jim_DictCoreCommand},
15028 {"subst", Jim_SubstCoreCommand},
15029 {"info", Jim_InfoCoreCommand},
15030 {"exists", Jim_ExistsCoreCommand},
15031 {"split", Jim_SplitCoreCommand},
15032 {"join", Jim_JoinCoreCommand},
15033 {"format", Jim_FormatCoreCommand},
15034 {"scan", Jim_ScanCoreCommand},
15035 {"error", Jim_ErrorCoreCommand},
15036 {"lrange", Jim_LrangeCoreCommand},
15037 {"lrepeat", Jim_LrepeatCoreCommand},
15038 {"env", Jim_EnvCoreCommand},
15039 {"source", Jim_SourceCoreCommand},
15040 {"lreverse", Jim_LreverseCoreCommand},
15041 {"range", Jim_RangeCoreCommand},
15042 {"rand", Jim_RandCoreCommand},
15043 {"tailcall", Jim_TailcallCoreCommand},
15044 {"local", Jim_LocalCoreCommand},
15045 {"upcall", Jim_UpcallCoreCommand},
15046 {"apply", Jim_ApplyCoreCommand},
15047 {NULL, NULL},
15050 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15052 int i = 0;
15054 while (Jim_CoreCommandsTable[i].name != NULL) {
15055 Jim_CreateCommand(interp,
15056 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15057 i++;
15061 /* -----------------------------------------------------------------------------
15062 * Interactive prompt
15063 * ---------------------------------------------------------------------------*/
15064 void Jim_MakeErrorMessage(Jim_Interp *interp)
15066 Jim_Obj *argv[2];
15068 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15069 argv[1] = interp->result;
15071 Jim_EvalObjVector(interp, 2, argv);
15074 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15075 const char *prefix, const char *const *tablePtr, const char *name)
15077 int count;
15078 char **tablePtrSorted;
15079 int i;
15081 for (count = 0; tablePtr[count]; count++) {
15084 if (name == NULL) {
15085 name = "option";
15088 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15089 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15090 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15091 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15092 for (i = 0; i < count; i++) {
15093 if (i + 1 == count && count > 1) {
15094 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15096 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15097 if (i + 1 != count) {
15098 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15101 Jim_Free(tablePtrSorted);
15104 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15105 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15107 const char *bad = "bad ";
15108 const char *const *entryPtr = NULL;
15109 int i;
15110 int match = -1;
15111 int arglen;
15112 const char *arg = Jim_GetString(objPtr, &arglen);
15114 *indexPtr = -1;
15116 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15117 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15118 /* Found an exact match */
15119 *indexPtr = i;
15120 return JIM_OK;
15122 if (flags & JIM_ENUM_ABBREV) {
15123 /* Accept an unambiguous abbreviation.
15124 * Note that '-' doesnt' consitute a valid abbreviation
15126 if (strncmp(arg, *entryPtr, arglen) == 0) {
15127 if (*arg == '-' && arglen == 1) {
15128 break;
15130 if (match >= 0) {
15131 bad = "ambiguous ";
15132 goto ambiguous;
15134 match = i;
15139 /* If we had an unambiguous partial match */
15140 if (match >= 0) {
15141 *indexPtr = match;
15142 return JIM_OK;
15145 ambiguous:
15146 if (flags & JIM_ERRMSG) {
15147 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15149 return JIM_ERR;
15152 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15154 int i;
15156 for (i = 0; i < (int)len; i++) {
15157 if (array[i] && strcmp(array[i], name) == 0) {
15158 return i;
15161 return -1;
15164 int Jim_IsDict(Jim_Obj *objPtr)
15166 return objPtr->typePtr == &dictObjType;
15169 int Jim_IsList(Jim_Obj *objPtr)
15171 return objPtr->typePtr == &listObjType;
15175 * Very simple printf-like formatting, designed for error messages.
15177 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15178 * The resulting string is created and set as the result.
15180 * Each '%s' should correspond to a regular string parameter.
15181 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15182 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15184 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15186 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15188 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15190 /* Initial space needed */
15191 int len = strlen(format);
15192 int extra = 0;
15193 int n = 0;
15194 const char *params[5];
15195 char *buf;
15196 va_list args;
15197 int i;
15199 va_start(args, format);
15201 for (i = 0; i < len && n < 5; i++) {
15202 int l;
15204 if (strncmp(format + i, "%s", 2) == 0) {
15205 params[n] = va_arg(args, char *);
15207 l = strlen(params[n]);
15209 else if (strncmp(format + i, "%#s", 3) == 0) {
15210 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15212 params[n] = Jim_GetString(objPtr, &l);
15214 else {
15215 if (format[i] == '%') {
15216 i++;
15218 continue;
15220 n++;
15221 extra += l;
15224 len += extra;
15225 buf = Jim_Alloc(len + 1);
15226 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15228 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15231 /* stubs */
15232 #ifndef jim_ext_package
15233 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15235 return JIM_OK;
15237 #endif
15238 #ifndef jim_ext_aio
15239 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15241 Jim_SetResultString(interp, "aio not enabled", -1);
15242 return NULL;
15244 #endif
15248 * Local Variables: ***
15249 * c-basic-offset: 4 ***
15250 * tab-width: 4 ***
15251 * End: ***