1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
58 #include "jimautoconf.h"
61 #ifdef HAVE_SYS_TIME_H
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
71 /* For INFINITY, even if math functions are not enabled */
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
79 #define TCL_LIBRARY "."
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type
);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition
, const char *fmt
, ...);
113 #define JimPanic(X) JimPanicDump X
118 /* -----------------------------------------------------------------------------
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep
[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
);
130 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int listindex
, Jim_Obj
*newObjPtr
,
132 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
);
133 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
134 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
135 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
);
136 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
137 const char *prefix
, const char *const *tablePtr
, const char *name
);
138 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
);
139 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
140 static int JimSign(jim_wide w
);
141 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
);
142 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
);
143 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s
, int *uc
, int upper
)
153 int l
= utf8_tounicode(s
, uc
);
155 *uc
= utf8_upper(*uc
);
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern
, int c
, int flags
)
187 if (flags
& JIM_NOCASE
) {
192 if (flags
& JIM_CHARSET_SCAN
) {
193 if (*pattern
== '^') {
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern
== ']') {
204 while (*pattern
&& *pattern
!= ']') {
206 if (pattern
[0] == '\\') {
208 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
211 /* Is this a range? a-z */
215 pattern
+= utf8_tounicode_case(pattern
, &start
, nocase
);
216 if (pattern
[0] == '-' && pattern
[1]) {
218 pattern
+= utf8_tounicode(pattern
, &pchar
);
219 pattern
+= utf8_tounicode_case(pattern
, &end
, nocase
);
221 /* Handle reversed range too */
222 if ((c
>= start
&& c
<= end
) || (c
>= end
&& c
<= start
)) {
238 return match
? pattern
: NULL
;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern
, const char *string
, int nocase
)
250 switch (pattern
[0]) {
252 while (pattern
[1] == '*') {
257 return 1; /* match */
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern
, string
, nocase
))
262 return 1; /* match */
263 string
+= utf8_tounicode(string
, &c
);
265 return 0; /* no match */
268 string
+= utf8_tounicode(string
, &c
);
272 string
+= utf8_tounicode(string
, &c
);
273 pattern
= JimCharsetMatch(pattern
+ 1, c
, nocase
? JIM_NOCASE
: 0);
278 /* Ran out of pattern (no ']') */
289 string
+= utf8_tounicode_case(string
, &c
, nocase
);
290 utf8_tounicode_case(pattern
, &pchar
, nocase
);
296 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
298 while (*pattern
== '*') {
304 if (!*pattern
&& !*string
) {
311 * 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
)
320 return memcmp(s1
, s2
, l1
) <= 0 ? -1 : 1;
323 return memcmp(s1
, s2
, l2
) >= 0 ? 1 : -1;
326 return JimSign(memcmp(s1
, s2
, l1
));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1
, const char *s2
, int maxchars
, int nocase
)
340 while (*s1
&& *s2
&& maxchars
) {
342 s1
+= utf8_tounicode_case(s1
, &c1
, nocase
);
343 s2
+= utf8_tounicode_case(s2
, &c2
, nocase
);
345 return JimSign(c1
- c2
);
352 /* One string or both terminated */
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int idx
)
370 if (!l1
|| !l2
|| l1
> l2
) {
375 s2
+= utf8_index(s2
, idx
);
377 l1bytelen
= utf8_index(s1
, l1
);
379 for (i
= idx
; i
<= l2
- l1
; i
++) {
381 if (memcmp(s2
, s1
, l1bytelen
) == 0) {
384 s2
+= utf8_tounicode(s2
, &c
);
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
396 if (!l1
|| !l2
|| l1
> l2
)
399 /* Now search for the needle */
400 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
401 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1
, int l1
, const char *s2
, int l2
)
414 int n
= JimStringLast(s1
, utf8_index(s1
, l1
), s2
, utf8_index(s2
, l2
));
416 n
= utf8_strlen(s2
, n
);
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str
, const char *endptr
)
431 if (str
[0] == '\0' || str
== endptr
) {
435 if (endptr
[0] != '\0') {
437 if (!isspace(UCHAR(*endptr
))) {
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str
, int *base
, int *sign
)
455 while (isspace(UCHAR(str
[i
]))) {
475 /* We have 0<x>, so see if we can convert it */
476 switch (str
[i
+ 1]) {
477 case 'x': case 'X': *base
= 16; break;
478 case 'o': case 'O': *base
= 8; break;
479 case 'b': case 'B': *base
= 2; break;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str
[i
] != '-' && str
[i
] != '+' && !isspace(UCHAR(str
[i
]))) {
485 /* Parse according to this base */
488 /* Parse as base 10 */
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str
, char **endptr
)
500 int i
= JimNumberBase(str
, &base
, &sign
);
503 long value
= strtol(str
+ i
, endptr
, base
);
504 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
509 /* Can just do a regular base-10 conversion */
510 return strtol(str
, endptr
, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide
jim_strtoull(const char *str
, char **endptr
)
519 #ifdef HAVE_LONG_LONG
522 int i
= JimNumberBase(str
, &base
, &sign
);
525 jim_wide value
= strtoull(str
+ i
, endptr
, base
);
526 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str
, endptr
, 10);
534 return (unsigned long)jim_strtol(str
, endptr
);
538 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
543 *widePtr
= strtoull(str
, &endptr
, base
);
546 *widePtr
= jim_strtoull(str
, &endptr
);
549 return JimCheckConversion(str
, endptr
);
552 int Jim_StringToDouble(const char *str
, double *doublePtr
)
556 /* Callers can check for underflow via ERANGE */
559 *doublePtr
= strtod(str
, &endptr
);
561 return JimCheckConversion(str
, endptr
);
564 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
577 /* Only special case is -1 ^ -n
595 /* -----------------------------------------------------------------------------
597 * ---------------------------------------------------------------------------*/
598 #ifdef JIM_DEBUG_PANIC
599 static void JimPanicDump(int condition
, const char *fmt
, ...)
609 fprintf(stderr
, "\nJIM INTERPRETER PANIC: ");
610 vfprintf(stderr
, fmt
, ap
);
611 fprintf(stderr
, "\n\n");
614 #ifdef HAVE_BACKTRACE
620 size
= backtrace(array
, 40);
621 strings
= backtrace_symbols(array
, size
);
622 for (i
= 0; i
< size
; i
++)
623 fprintf(stderr
, "[backtrace] %s\n", strings
[i
]);
624 fprintf(stderr
, "[backtrace] Include the above lines and the output\n");
625 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report.\n");
633 /* -----------------------------------------------------------------------------
635 * ---------------------------------------------------------------------------*/
637 void *Jim_Alloc(int size
)
639 return size
? malloc(size
) : NULL
;
642 void Jim_Free(void *ptr
)
647 void *Jim_Realloc(void *ptr
, int size
)
649 return realloc(ptr
, size
);
652 char *Jim_StrDup(const char *s
)
657 char *Jim_StrDupLen(const char *s
, int l
)
659 char *copy
= Jim_Alloc(l
+ 1);
661 memcpy(copy
, s
, l
+ 1);
662 copy
[l
] = 0; /* Just to be sure, original could be substring */
666 /* -----------------------------------------------------------------------------
667 * Time related functions
668 * ---------------------------------------------------------------------------*/
670 /* Returns current time in microseconds */
671 static jim_wide
JimClock(void)
675 gettimeofday(&tv
, NULL
);
676 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
679 /* -----------------------------------------------------------------------------
681 * ---------------------------------------------------------------------------*/
683 /* -------------------------- private prototypes ---------------------------- */
684 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
685 static unsigned int JimHashTableNextPower(unsigned int size
);
686 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
);
688 /* -------------------------- hash functions -------------------------------- */
690 /* Thomas Wang's 32 bit Mix Function */
691 unsigned int Jim_IntHashFunction(unsigned int key
)
702 /* Generic hash function (we are using to multiply by 9 and add the byte
704 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
709 h
+= (h
<< 3) + *buf
++;
713 /* ----------------------------- API implementation ------------------------- */
715 /* reset a hashtable already initialized */
716 static void JimResetHashTable(Jim_HashTable
*ht
)
723 #ifdef JIM_RANDOMISE_HASH
724 /* This is initialised to a random value to avoid a hash collision attack.
725 * See: n.runs-SA-2011.004
727 ht
->uniq
= (rand() ^ time(NULL
) ^ clock());
733 static void JimInitHashTableIterator(Jim_HashTable
*ht
, Jim_HashTableIterator
*iter
)
738 iter
->nextEntry
= NULL
;
741 /* Initialize the hash table */
742 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
744 JimResetHashTable(ht
);
746 ht
->privdata
= privDataPtr
;
750 /* Resize the table to the minimal size that contains all the elements,
751 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
752 void Jim_ResizeHashTable(Jim_HashTable
*ht
)
754 int minimal
= ht
->used
;
756 if (minimal
< JIM_HT_INITIAL_SIZE
)
757 minimal
= JIM_HT_INITIAL_SIZE
;
758 Jim_ExpandHashTable(ht
, minimal
);
761 /* Expand or create the hashtable */
762 void Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
764 Jim_HashTable n
; /* the new hashtable */
765 unsigned int realsize
= JimHashTableNextPower(size
), i
;
767 /* the size is invalid if it is smaller than the number of
768 * elements already inside the hashtable */
769 if (size
<= ht
->used
)
772 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
774 n
.sizemask
= realsize
- 1;
775 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
776 /* Keep the same 'uniq' as the original */
779 /* Initialize all the pointers to NULL */
780 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
782 /* Copy all the elements from the old to the new table:
783 * note that if the old hash table is empty ht->used is zero,
784 * so Jim_ExpandHashTable just creates an empty hash table. */
786 for (i
= 0; ht
->used
> 0; i
++) {
787 Jim_HashEntry
*he
, *nextHe
;
789 if (ht
->table
[i
] == NULL
)
792 /* For each hash entry on this slot... */
798 /* Get the new element index */
799 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
800 he
->next
= n
.table
[h
];
803 /* Pass to the next element */
807 assert(ht
->used
== 0);
810 /* Remap the new hashtable in the old */
814 /* Add an element to the target hash table */
815 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
817 Jim_HashEntry
*entry
;
819 /* Get the index of the new element, or -1 if
820 * the element already exists. */
821 entry
= JimInsertHashEntry(ht
, key
, 0);
825 /* Set the hash entry fields. */
826 Jim_SetHashKey(ht
, entry
, key
);
827 Jim_SetHashVal(ht
, entry
, val
);
831 /* Add an element, discarding the old if the key already exists */
832 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
835 Jim_HashEntry
*entry
;
837 /* Get the index of the new element, or -1 if
838 * the element already exists. */
839 entry
= JimInsertHashEntry(ht
, key
, 1);
841 /* It already exists, so only replace the value.
842 * Note if both a destructor and a duplicate function exist,
843 * need to dup before destroy. perhaps they are the same
844 * reference counted object
846 if (ht
->type
->valDestructor
&& ht
->type
->valDup
) {
847 void *newval
= ht
->type
->valDup(ht
->privdata
, val
);
848 ht
->type
->valDestructor(ht
->privdata
, entry
->u
.val
);
849 entry
->u
.val
= newval
;
852 Jim_FreeEntryVal(ht
, entry
);
853 Jim_SetHashVal(ht
, entry
, val
);
858 /* Doesn't exist, so set the key */
859 Jim_SetHashKey(ht
, entry
, key
);
860 Jim_SetHashVal(ht
, entry
, val
);
867 /* Search and remove an element */
868 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
871 Jim_HashEntry
*he
, *prevHe
;
875 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
880 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
881 /* Unlink the element from the list */
883 prevHe
->next
= he
->next
;
885 ht
->table
[h
] = he
->next
;
886 Jim_FreeEntryKey(ht
, he
);
887 Jim_FreeEntryVal(ht
, he
);
895 return JIM_ERR
; /* not found */
898 /* Destroy an entire hash table and leave it ready for reuse */
899 int Jim_FreeHashTable(Jim_HashTable
*ht
)
903 /* Free all the elements */
904 for (i
= 0; ht
->used
> 0; i
++) {
905 Jim_HashEntry
*he
, *nextHe
;
907 if ((he
= ht
->table
[i
]) == NULL
)
911 Jim_FreeEntryKey(ht
, he
);
912 Jim_FreeEntryVal(ht
, he
);
918 /* Free the table and the allocated cache structure */
920 /* Re-initialize the table */
921 JimResetHashTable(ht
);
922 return JIM_OK
; /* never fails */
925 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
932 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
935 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
942 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
944 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
945 JimInitHashTableIterator(ht
, iter
);
949 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
952 if (iter
->entry
== NULL
) {
954 if (iter
->index
>= (signed)iter
->ht
->size
)
956 iter
->entry
= iter
->ht
->table
[iter
->index
];
959 iter
->entry
= iter
->nextEntry
;
962 /* We need to save the 'next' here, the iterator user
963 * may delete the entry we are returning. */
964 iter
->nextEntry
= iter
->entry
->next
;
971 /* ------------------------- private functions ------------------------------ */
973 /* Expand the hash table if needed */
974 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
976 /* If the hash table is empty expand it to the intial size,
977 * if the table is "full" dobule its size. */
979 Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
980 if (ht
->size
== ht
->used
)
981 Jim_ExpandHashTable(ht
, ht
->size
* 2);
984 /* Our hash table capability is a power of two */
985 static unsigned int JimHashTableNextPower(unsigned int size
)
987 unsigned int i
= JIM_HT_INITIAL_SIZE
;
989 if (size
>= 2147483648U)
998 /* Returns the index of a free slot that can be populated with
999 * a hash entry for the given 'key'.
1000 * If the key already exists, -1 is returned. */
1001 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
)
1006 /* Expand the hashtable if needed */
1007 JimExpandHashTableIfNeeded(ht
);
1009 /* Compute the key hash value */
1010 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
1011 /* Search if this slot does not already contain the given key */
1014 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
1015 return replace
? he
: NULL
;
1019 /* Allocates the memory and stores key */
1020 he
= Jim_Alloc(sizeof(*he
));
1021 he
->next
= ht
->table
[h
];
1029 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1031 static unsigned int JimStringCopyHTHashFunction(const void *key
)
1033 return Jim_GenHashFunction(key
, strlen(key
));
1036 static void *JimStringCopyHTDup(void *privdata
, const void *key
)
1038 return Jim_StrDup(key
);
1041 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
1043 return strcmp(key1
, key2
) == 0;
1046 static void JimStringCopyHTKeyDestructor(void *privdata
, void *key
)
1051 static const Jim_HashTableType JimPackageHashTableType
= {
1052 JimStringCopyHTHashFunction
, /* hash function */
1053 JimStringCopyHTDup
, /* key dup */
1055 JimStringCopyHTKeyCompare
, /* key compare */
1056 JimStringCopyHTKeyDestructor
, /* key destructor */
1057 NULL
/* val destructor */
1060 typedef struct AssocDataValue
1062 Jim_InterpDeleteProc
*delProc
;
1066 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1068 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
1070 if (assocPtr
->delProc
!= NULL
)
1071 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1075 static const Jim_HashTableType JimAssocDataHashTableType
= {
1076 JimStringCopyHTHashFunction
, /* hash function */
1077 JimStringCopyHTDup
, /* key dup */
1079 JimStringCopyHTKeyCompare
, /* key compare */
1080 JimStringCopyHTKeyDestructor
, /* key destructor */
1081 JimAssocDataHashTableValueDestructor
/* val destructor */
1084 /* -----------------------------------------------------------------------------
1085 * Stack - This is a simple generic stack implementation. It is used for
1086 * example in the 'expr' expression compiler.
1087 * ---------------------------------------------------------------------------*/
1088 void Jim_InitStack(Jim_Stack
*stack
)
1092 stack
->vector
= NULL
;
1095 void Jim_FreeStack(Jim_Stack
*stack
)
1097 Jim_Free(stack
->vector
);
1100 int Jim_StackLen(Jim_Stack
*stack
)
1105 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
1107 int neededLen
= stack
->len
+ 1;
1109 if (neededLen
> stack
->maxlen
) {
1110 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
1111 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
1113 stack
->vector
[stack
->len
] = element
;
1117 void *Jim_StackPop(Jim_Stack
*stack
)
1119 if (stack
->len
== 0)
1122 return stack
->vector
[stack
->len
];
1125 void *Jim_StackPeek(Jim_Stack
*stack
)
1127 if (stack
->len
== 0)
1129 return stack
->vector
[stack
->len
- 1];
1132 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
1136 for (i
= 0; i
< stack
->len
; i
++)
1137 freeFunc(stack
->vector
[i
]);
1140 /* -----------------------------------------------------------------------------
1142 * ---------------------------------------------------------------------------*/
1145 #define JIM_TT_NONE 0 /* No token returned */
1146 #define JIM_TT_STR 1 /* simple string */
1147 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1148 #define JIM_TT_VAR 3 /* var substitution */
1149 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1150 #define JIM_TT_CMD 5 /* command substitution */
1151 /* Note: Keep these three together for TOKEN_IS_SEP() */
1152 #define JIM_TT_SEP 6 /* word separator (white space) */
1153 #define JIM_TT_EOL 7 /* line separator */
1154 #define JIM_TT_EOF 8 /* end of script */
1156 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1157 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1159 /* Additional token types needed for expressions */
1160 #define JIM_TT_SUBEXPR_START 11
1161 #define JIM_TT_SUBEXPR_END 12
1162 #define JIM_TT_SUBEXPR_COMMA 13
1163 #define JIM_TT_EXPR_INT 14
1164 #define JIM_TT_EXPR_DOUBLE 15
1165 #define JIM_TT_EXPR_BOOLEAN 16
1167 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1169 /* Operator token types start here */
1170 #define JIM_TT_EXPR_OP 20
1172 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1173 /* Can this token start an expression? */
1174 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1175 /* Is this token an expression operator? */
1176 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1179 * Results of missing quotes, braces, etc. from parsing.
1181 struct JimParseMissing
{
1182 int ch
; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1183 int line
; /* Line number starting the missing token */
1186 /* Parser context structure. The same context is used both to parse
1187 * Tcl scripts and lists. */
1190 const char *p
; /* Pointer to the point of the program we are parsing */
1191 int len
; /* Remaining length */
1192 int linenr
; /* Current line number */
1194 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1195 int tline
; /* Line number of the returned token */
1196 int tt
; /* Token type */
1197 int eof
; /* Non zero if EOF condition is true. */
1198 int inquote
; /* Parsing a quoted string */
1199 int comment
; /* Non zero if the next chars may be a comment. */
1200 struct JimParseMissing missing
; /* Details of any missing quotes, etc. */
1203 static int JimParseScript(struct JimParserCtx
*pc
);
1204 static int JimParseSep(struct JimParserCtx
*pc
);
1205 static int JimParseEol(struct JimParserCtx
*pc
);
1206 static int JimParseCmd(struct JimParserCtx
*pc
);
1207 static int JimParseQuote(struct JimParserCtx
*pc
);
1208 static int JimParseVar(struct JimParserCtx
*pc
);
1209 static int JimParseBrace(struct JimParserCtx
*pc
);
1210 static int JimParseStr(struct JimParserCtx
*pc
);
1211 static int JimParseComment(struct JimParserCtx
*pc
);
1212 static void JimParseSubCmd(struct JimParserCtx
*pc
);
1213 static int JimParseSubQuote(struct JimParserCtx
*pc
);
1214 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
1216 /* Initialize a parser context.
1217 * 'prg' is a pointer to the program text, linenr is the line
1218 * number of the first line contained in the program. */
1219 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1226 pc
->tt
= JIM_TT_NONE
;
1229 pc
->linenr
= linenr
;
1231 pc
->missing
.ch
= ' ';
1232 pc
->missing
.line
= linenr
;
1235 static int JimParseScript(struct JimParserCtx
*pc
)
1237 while (1) { /* the while is used to reiterate with continue if needed */
1240 pc
->tend
= pc
->p
- 1;
1241 pc
->tline
= pc
->linenr
;
1242 pc
->tt
= JIM_TT_EOL
;
1248 if (*(pc
->p
+ 1) == '\n' && !pc
->inquote
) {
1249 return JimParseSep(pc
);
1252 return JimParseStr(pc
);
1258 return JimParseSep(pc
);
1260 return JimParseStr(pc
);
1265 return JimParseEol(pc
);
1266 return JimParseStr(pc
);
1269 return JimParseCmd(pc
);
1272 if (JimParseVar(pc
) == JIM_ERR
) {
1273 /* An orphan $. Create as a separate token */
1274 pc
->tstart
= pc
->tend
= pc
->p
++;
1276 pc
->tt
= JIM_TT_ESC
;
1281 JimParseComment(pc
);
1284 return JimParseStr(pc
);
1287 return JimParseStr(pc
);
1293 static int JimParseSep(struct JimParserCtx
*pc
)
1296 pc
->tline
= pc
->linenr
;
1297 while (isspace(UCHAR(*pc
->p
)) || (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1298 if (*pc
->p
== '\n') {
1301 if (*pc
->p
== '\\') {
1309 pc
->tend
= pc
->p
- 1;
1310 pc
->tt
= JIM_TT_SEP
;
1314 static int JimParseEol(struct JimParserCtx
*pc
)
1317 pc
->tline
= pc
->linenr
;
1318 while (isspace(UCHAR(*pc
->p
)) || *pc
->p
== ';') {
1324 pc
->tend
= pc
->p
- 1;
1325 pc
->tt
= JIM_TT_EOL
;
1330 ** Here are the rules for parsing:
1331 ** {braced expression}
1332 ** - Count open and closing braces
1333 ** - Backslash escapes meaning of braces
1335 ** "quoted expression"
1336 ** - First double quote at start of word terminates the expression
1337 ** - Backslash escapes quote and bracket
1338 ** - [commands brackets] are counted/nested
1339 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1341 ** [command expression]
1342 ** - Count open and closing brackets
1343 ** - Backslash escapes quote, bracket and brace
1344 ** - [commands brackets] are counted/nested
1345 ** - "quoted expressions" are parsed according to quoting rules
1346 ** - {braced expressions} are parsed according to brace rules
1348 ** For everything, backslash escapes the next char, newline increments current line
1352 * Parses a braced expression starting at pc->p.
1354 * Positions the parser at the end of the braced expression,
1355 * sets pc->tend and possibly pc->missing.
1357 static void JimParseSubBrace(struct JimParserCtx
*pc
)
1361 /* Skip the brace */
1368 if (*++pc
->p
== '\n') {
1381 pc
->tend
= pc
->p
- 1;
1395 pc
->missing
.ch
= '{';
1396 pc
->missing
.line
= pc
->tline
;
1397 pc
->tend
= pc
->p
- 1;
1401 * Parses a quoted expression starting at pc->p.
1403 * Positions the parser at the end of the quoted expression,
1404 * sets pc->tend and possibly pc->missing.
1406 * Returns the type of the token of the string,
1407 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1410 static int JimParseSubQuote(struct JimParserCtx
*pc
)
1412 int tt
= JIM_TT_STR
;
1413 int line
= pc
->tline
;
1415 /* Skip the quote */
1422 if (*++pc
->p
== '\n') {
1431 pc
->tend
= pc
->p
- 1;
1452 pc
->missing
.ch
= '"';
1453 pc
->missing
.line
= line
;
1454 pc
->tend
= pc
->p
- 1;
1459 * Parses a [command] expression starting at pc->p.
1461 * Positions the parser at the end of the command expression,
1462 * sets pc->tend and possibly pc->missing.
1464 static void JimParseSubCmd(struct JimParserCtx
*pc
)
1467 int startofword
= 1;
1468 int line
= pc
->tline
;
1470 /* Skip the bracket */
1477 if (*++pc
->p
== '\n') {
1490 pc
->tend
= pc
->p
- 1;
1499 JimParseSubQuote(pc
);
1505 JimParseSubBrace(pc
);
1513 startofword
= isspace(UCHAR(*pc
->p
));
1517 pc
->missing
.ch
= '[';
1518 pc
->missing
.line
= line
;
1519 pc
->tend
= pc
->p
- 1;
1522 static int JimParseBrace(struct JimParserCtx
*pc
)
1524 pc
->tstart
= pc
->p
+ 1;
1525 pc
->tline
= pc
->linenr
;
1526 pc
->tt
= JIM_TT_STR
;
1527 JimParseSubBrace(pc
);
1531 static int JimParseCmd(struct JimParserCtx
*pc
)
1533 pc
->tstart
= pc
->p
+ 1;
1534 pc
->tline
= pc
->linenr
;
1535 pc
->tt
= JIM_TT_CMD
;
1540 static int JimParseQuote(struct JimParserCtx
*pc
)
1542 pc
->tstart
= pc
->p
+ 1;
1543 pc
->tline
= pc
->linenr
;
1544 pc
->tt
= JimParseSubQuote(pc
);
1548 static int JimParseVar(struct JimParserCtx
*pc
)
1554 #ifdef EXPRSUGAR_BRACKET
1555 if (*pc
->p
== '[') {
1556 /* Parse $[...] expr shorthand syntax */
1558 pc
->tt
= JIM_TT_EXPRSUGAR
;
1564 pc
->tt
= JIM_TT_VAR
;
1565 pc
->tline
= pc
->linenr
;
1567 if (*pc
->p
== '{') {
1568 pc
->tstart
= ++pc
->p
;
1571 while (pc
->len
&& *pc
->p
!= '}') {
1572 if (*pc
->p
== '\n') {
1578 pc
->tend
= pc
->p
- 1;
1586 /* Skip double colon, but not single colon! */
1587 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
1588 while (*pc
->p
== ':') {
1594 /* Note that any char >= 0x80 must be part of a utf-8 char.
1595 * We consider all unicode points outside of ASCII as letters
1597 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_' || UCHAR(*pc
->p
) >= 0x80) {
1604 /* Parse [dict get] syntax sugar. */
1605 if (*pc
->p
== '(') {
1607 const char *paren
= NULL
;
1609 pc
->tt
= JIM_TT_DICTSUGAR
;
1611 while (count
&& pc
->len
) {
1614 if (*pc
->p
== '\\' && pc
->len
>= 1) {
1618 else if (*pc
->p
== '(') {
1621 else if (*pc
->p
== ')') {
1631 /* Did not find a matching paren. Back up */
1633 pc
->len
+= (pc
->p
- paren
);
1636 #ifndef EXPRSUGAR_BRACKET
1637 if (*pc
->tstart
== '(') {
1638 pc
->tt
= JIM_TT_EXPRSUGAR
;
1642 pc
->tend
= pc
->p
- 1;
1644 /* Check if we parsed just the '$' character.
1645 * That's not a variable so an error is returned
1646 * to tell the state machine to consider this '$' just
1648 if (pc
->tstart
== pc
->p
) {
1656 static int JimParseStr(struct JimParserCtx
*pc
)
1658 if (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1659 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
) {
1660 /* Starting a new word */
1661 if (*pc
->p
== '{') {
1662 return JimParseBrace(pc
);
1664 if (*pc
->p
== '"') {
1668 /* In case the end quote is missing */
1669 pc
->missing
.line
= pc
->tline
;
1673 pc
->tline
= pc
->linenr
;
1677 pc
->missing
.ch
= '"';
1679 pc
->tend
= pc
->p
- 1;
1680 pc
->tt
= JIM_TT_ESC
;
1685 if (!pc
->inquote
&& *(pc
->p
+ 1) == '\n') {
1686 pc
->tend
= pc
->p
- 1;
1687 pc
->tt
= JIM_TT_ESC
;
1691 if (*(pc
->p
+ 1) == '\n') {
1697 else if (pc
->len
== 1) {
1698 /* End of script with trailing backslash */
1699 pc
->missing
.ch
= '\\';
1703 /* If the following token is not '$' just keep going */
1704 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1709 /* Only need a separate ')' token if the previous was a var */
1710 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1711 if (pc
->p
== pc
->tstart
) {
1712 /* At the start of the token, so just return this char */
1716 pc
->tend
= pc
->p
- 1;
1717 pc
->tt
= JIM_TT_ESC
;
1724 pc
->tend
= pc
->p
- 1;
1725 pc
->tt
= JIM_TT_ESC
;
1734 pc
->tend
= pc
->p
- 1;
1735 pc
->tt
= JIM_TT_ESC
;
1738 else if (*pc
->p
== '\n') {
1744 pc
->tend
= pc
->p
- 1;
1745 pc
->tt
= JIM_TT_ESC
;
1756 return JIM_OK
; /* unreached */
1759 static int JimParseComment(struct JimParserCtx
*pc
)
1762 if (*pc
->p
== '\\') {
1766 pc
->missing
.ch
= '\\';
1769 if (*pc
->p
== '\n') {
1773 else if (*pc
->p
== '\n') {
1785 /* xdigitval and odigitval are helper functions for JimEscape() */
1786 static int xdigitval(int c
)
1788 if (c
>= '0' && c
<= '9')
1790 if (c
>= 'a' && c
<= 'f')
1791 return c
- 'a' + 10;
1792 if (c
>= 'A' && c
<= 'F')
1793 return c
- 'A' + 10;
1797 static int odigitval(int c
)
1799 if (c
>= '0' && c
<= '7')
1804 /* Perform Tcl escape substitution of 's', storing the result
1805 * string into 'dest'. The escaped string is guaranteed to
1806 * be the same length or shorted than the source string.
1807 * Slen is the length of the string at 's'.
1809 * The function returns the length of the resulting string. */
1810 static int JimEscape(char *dest
, const char *s
, int slen
)
1815 for (i
= 0; i
< slen
; i
++) {
1846 /* A unicode or hex sequence.
1847 * \x Expect 1-2 hex chars and convert to hex.
1848 * \u Expect 1-4 hex chars and convert to utf-8.
1849 * \U Expect 1-8 hex chars and convert to utf-8.
1850 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1851 * An invalid sequence means simply the escaped char.
1863 else if (s
[i
] == 'u') {
1864 if (s
[i
+ 1] == '{') {
1873 for (k
= 0; k
< maxchars
; k
++) {
1874 int c
= xdigitval(s
[i
+ k
+ 1]);
1878 val
= (val
<< 4) | c
;
1880 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1882 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1888 /* Skip the closing brace */
1893 /* Got a valid sequence, so convert */
1898 p
+= utf8_fromunicode(p
, val
);
1903 /* Not a valid codepoint, just an escaped char */
1916 /* Replace all spaces and tabs after backslash newline with a single space*/
1920 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1933 int c
= odigitval(s
[i
+ 1]);
1936 c
= odigitval(s
[i
+ 2]);
1942 val
= (val
* 8) + c
;
1943 c
= odigitval(s
[i
+ 3]);
1949 val
= (val
* 8) + c
;
1970 /* Returns a dynamically allocated copy of the current token in the
1971 * parser context. The function performs conversion of escapes if
1972 * the token is of type JIM_TT_ESC.
1974 * Note that after the conversion, tokens that are grouped with
1975 * braces in the source code, are always recognizable from the
1976 * identical string obtained in a different way from the type.
1978 * For example the string:
1982 * will return as first token "*", of type JIM_TT_STR
1988 * will return as first token "*", of type JIM_TT_ESC
1990 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
1992 const char *start
, *end
;
2000 token
= Jim_Alloc(1);
2004 len
= (end
- start
) + 1;
2005 token
= Jim_Alloc(len
+ 1);
2006 if (pc
->tt
!= JIM_TT_ESC
) {
2007 /* No escape conversion needed? Just copy it. */
2008 memcpy(token
, start
, len
);
2012 /* Else convert the escape chars. */
2013 len
= JimEscape(token
, start
, len
);
2017 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
2020 /* -----------------------------------------------------------------------------
2022 * ---------------------------------------------------------------------------*/
2023 static int JimParseListSep(struct JimParserCtx
*pc
);
2024 static int JimParseListStr(struct JimParserCtx
*pc
);
2025 static int JimParseListQuote(struct JimParserCtx
*pc
);
2027 static int JimParseList(struct JimParserCtx
*pc
)
2029 if (isspace(UCHAR(*pc
->p
))) {
2030 return JimParseListSep(pc
);
2034 return JimParseListQuote(pc
);
2037 return JimParseBrace(pc
);
2041 return JimParseListStr(pc
);
2046 pc
->tstart
= pc
->tend
= pc
->p
;
2047 pc
->tline
= pc
->linenr
;
2048 pc
->tt
= JIM_TT_EOL
;
2053 static int JimParseListSep(struct JimParserCtx
*pc
)
2056 pc
->tline
= pc
->linenr
;
2057 while (isspace(UCHAR(*pc
->p
))) {
2058 if (*pc
->p
== '\n') {
2064 pc
->tend
= pc
->p
- 1;
2065 pc
->tt
= JIM_TT_SEP
;
2069 static int JimParseListQuote(struct JimParserCtx
*pc
)
2075 pc
->tline
= pc
->linenr
;
2076 pc
->tt
= JIM_TT_STR
;
2081 pc
->tt
= JIM_TT_ESC
;
2082 if (--pc
->len
== 0) {
2083 /* Trailing backslash */
2093 pc
->tend
= pc
->p
- 1;
2102 pc
->tend
= pc
->p
- 1;
2106 static int JimParseListStr(struct JimParserCtx
*pc
)
2109 pc
->tline
= pc
->linenr
;
2110 pc
->tt
= JIM_TT_STR
;
2113 if (isspace(UCHAR(*pc
->p
))) {
2114 pc
->tend
= pc
->p
- 1;
2117 if (*pc
->p
== '\\') {
2118 if (--pc
->len
== 0) {
2119 /* Trailing backslash */
2123 pc
->tt
= JIM_TT_ESC
;
2129 pc
->tend
= pc
->p
- 1;
2133 /* -----------------------------------------------------------------------------
2134 * Jim_Obj related functions
2135 * ---------------------------------------------------------------------------*/
2137 /* Return a new initialized object. */
2138 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2142 /* -- Check if there are objects in the free list -- */
2143 if (interp
->freeList
!= NULL
) {
2144 /* -- Unlink the object from the free list -- */
2145 objPtr
= interp
->freeList
;
2146 interp
->freeList
= objPtr
->nextObjPtr
;
2149 /* -- No ready to use objects: allocate a new one -- */
2150 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2153 /* Object is returned with refCount of 0. Every
2154 * kind of GC implemented should take care to don't try
2155 * to scan objects with refCount == 0. */
2156 objPtr
->refCount
= 0;
2157 /* All the other fields are left not initialized to save time.
2158 * The caller will probably want to set them to the right
2161 /* -- Put the object into the live list -- */
2162 objPtr
->prevObjPtr
= NULL
;
2163 objPtr
->nextObjPtr
= interp
->liveList
;
2164 if (interp
->liveList
)
2165 interp
->liveList
->prevObjPtr
= objPtr
;
2166 interp
->liveList
= objPtr
;
2171 /* Free an object. Actually objects are never freed, but
2172 * just moved to the free objects list, where they will be
2173 * reused by Jim_NewObj(). */
2174 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2176 /* Check if the object was already freed, panic. */
2177 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2178 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2180 /* Free the internal representation */
2181 Jim_FreeIntRep(interp
, objPtr
);
2182 /* Free the string representation */
2183 if (objPtr
->bytes
!= NULL
) {
2184 if (objPtr
->bytes
!= JimEmptyStringRep
)
2185 Jim_Free(objPtr
->bytes
);
2187 /* Unlink the object from the live objects list */
2188 if (objPtr
->prevObjPtr
)
2189 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2190 if (objPtr
->nextObjPtr
)
2191 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2192 if (interp
->liveList
== objPtr
)
2193 interp
->liveList
= objPtr
->nextObjPtr
;
2194 #ifdef JIM_DISABLE_OBJECT_POOL
2197 /* Link the object into the free objects list */
2198 objPtr
->prevObjPtr
= NULL
;
2199 objPtr
->nextObjPtr
= interp
->freeList
;
2200 if (interp
->freeList
)
2201 interp
->freeList
->prevObjPtr
= objPtr
;
2202 interp
->freeList
= objPtr
;
2203 objPtr
->refCount
= -1;
2207 /* Invalidate the string representation of an object. */
2208 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2210 if (objPtr
->bytes
!= NULL
) {
2211 if (objPtr
->bytes
!= JimEmptyStringRep
)
2212 Jim_Free(objPtr
->bytes
);
2214 objPtr
->bytes
= NULL
;
2217 /* Duplicate an object. The returned object has refcount = 0. */
2218 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2222 dupPtr
= Jim_NewObj(interp
);
2223 if (objPtr
->bytes
== NULL
) {
2224 /* Object does not have a valid string representation. */
2225 dupPtr
->bytes
= NULL
;
2227 else if (objPtr
->length
== 0) {
2228 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2229 dupPtr
->bytes
= JimEmptyStringRep
;
2231 dupPtr
->typePtr
= NULL
;
2235 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2236 dupPtr
->length
= objPtr
->length
;
2237 /* Copy the null byte too */
2238 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2241 /* By default, the new object has the same type as the old object */
2242 dupPtr
->typePtr
= objPtr
->typePtr
;
2243 if (objPtr
->typePtr
!= NULL
) {
2244 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2245 dupPtr
->internalRep
= objPtr
->internalRep
;
2248 /* The dup proc may set a different type, e.g. NULL */
2249 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2255 /* Return the string representation for objPtr. If the object's
2256 * string representation is invalid, calls the updateStringProc method to create
2257 * a new one from the internal representation of the object.
2259 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2261 if (objPtr
->bytes
== NULL
) {
2262 /* Invalid string repr. Generate it. */
2263 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2264 objPtr
->typePtr
->updateStringProc(objPtr
);
2267 *lenPtr
= objPtr
->length
;
2268 return objPtr
->bytes
;
2271 /* Just returns the length of the object's string rep */
2272 int Jim_Length(Jim_Obj
*objPtr
)
2274 if (objPtr
->bytes
== NULL
) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2277 objPtr
->typePtr
->updateStringProc(objPtr
);
2279 return objPtr
->length
;
2282 /* Just returns object's string rep */
2283 const char *Jim_String(Jim_Obj
*objPtr
)
2285 if (objPtr
->bytes
== NULL
) {
2286 /* Invalid string repr. Generate it. */
2287 JimPanic((objPtr
->typePtr
== NULL
, "UpdateStringProc called against typeless value."));
2288 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2289 objPtr
->typePtr
->updateStringProc(objPtr
);
2291 return objPtr
->bytes
;
2294 static void JimSetStringBytes(Jim_Obj
*objPtr
, const char *str
)
2296 objPtr
->bytes
= Jim_StrDup(str
);
2297 objPtr
->length
= strlen(str
);
2300 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2301 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2303 static const Jim_ObjType dictSubstObjType
= {
2304 "dict-substitution",
2305 FreeDictSubstInternalRep
,
2306 DupDictSubstInternalRep
,
2311 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2313 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
2316 static const Jim_ObjType interpolatedObjType
= {
2318 FreeInterpolatedInternalRep
,
2324 /* -----------------------------------------------------------------------------
2326 * ---------------------------------------------------------------------------*/
2327 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2328 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2330 static const Jim_ObjType stringObjType
= {
2333 DupStringInternalRep
,
2335 JIM_TYPE_REFERENCES
,
2338 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2340 JIM_NOTUSED(interp
);
2342 /* This is a bit subtle: the only caller of this function
2343 * should be Jim_DuplicateObj(), that will copy the
2344 * string representaion. After the copy, the duplicated
2345 * object will not have more room in the buffer than
2346 * srcPtr->length bytes. So we just set it to length. */
2347 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
2348 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
2351 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2353 if (objPtr
->typePtr
!= &stringObjType
) {
2354 /* Get a fresh string representation. */
2355 if (objPtr
->bytes
== NULL
) {
2356 /* Invalid string repr. Generate it. */
2357 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2358 objPtr
->typePtr
->updateStringProc(objPtr
);
2360 /* Free any other internal representation. */
2361 Jim_FreeIntRep(interp
, objPtr
);
2362 /* Set it as string, i.e. just set the maxLength field. */
2363 objPtr
->typePtr
= &stringObjType
;
2364 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
2365 /* Don't know the utf-8 length yet */
2366 objPtr
->internalRep
.strValue
.charLength
= -1;
2372 * Returns the length of the object string in chars, not bytes.
2374 * These may be different for a utf-8 string.
2376 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2379 SetStringFromAny(interp
, objPtr
);
2381 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
2382 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
2384 return objPtr
->internalRep
.strValue
.charLength
;
2386 return Jim_Length(objPtr
);
2390 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2391 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
2393 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2395 /* Need to find out how many bytes the string requires */
2398 /* Alloc/Set the string rep. */
2400 objPtr
->bytes
= JimEmptyStringRep
;
2403 objPtr
->bytes
= Jim_Alloc(len
+ 1);
2404 memcpy(objPtr
->bytes
, s
, len
);
2405 objPtr
->bytes
[len
] = '\0';
2407 objPtr
->length
= len
;
2409 /* No typePtr field for the vanilla string object. */
2410 objPtr
->typePtr
= NULL
;
2414 /* charlen is in characters -- see also Jim_NewStringObj() */
2415 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
2418 /* Need to find out how many bytes the string requires */
2419 int bytelen
= utf8_index(s
, charlen
);
2421 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
2423 /* Remember the utf8 length, so set the type */
2424 objPtr
->typePtr
= &stringObjType
;
2425 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
2426 objPtr
->internalRep
.strValue
.charLength
= charlen
;
2430 return Jim_NewStringObj(interp
, s
, charlen
);
2434 /* This version does not try to duplicate the 's' pointer, but
2435 * use it directly. */
2436 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2438 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2441 objPtr
->length
= (len
== -1) ? strlen(s
) : len
;
2442 objPtr
->typePtr
= NULL
;
2446 /* Low-level string append. Use it only against unshared objects
2447 * of type "string". */
2448 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2454 needlen
= objPtr
->length
+ len
;
2455 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2456 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2458 /* Inefficient to malloc() for less than 8 bytes */
2462 if (objPtr
->bytes
== JimEmptyStringRep
) {
2463 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
2466 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
2468 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
2470 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2471 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2473 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
2474 /* Update the utf-8 char length */
2475 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
2477 objPtr
->length
+= len
;
2480 /* Higher level API to append strings to objects.
2481 * Object must not be unshared for each of these.
2483 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2485 JimPanic((Jim_IsShared(objPtr
), "Jim_AppendString called with shared object"));
2486 SetStringFromAny(interp
, objPtr
);
2487 StringAppendString(objPtr
, str
, len
);
2490 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2493 const char *str
= Jim_GetString(appendObjPtr
, &len
);
2494 Jim_AppendString(interp
, objPtr
, str
, len
);
2497 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2501 SetStringFromAny(interp
, objPtr
);
2502 va_start(ap
, objPtr
);
2504 const char *s
= va_arg(ap
, const char *);
2508 Jim_AppendString(interp
, objPtr
, s
, -1);
2513 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
2515 if (aObjPtr
== bObjPtr
) {
2520 const char *sA
= Jim_GetString(aObjPtr
, &Alen
);
2521 const char *sB
= Jim_GetString(bObjPtr
, &Blen
);
2523 return Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0;
2528 * Note. Does not support embedded nulls in either the pattern or the object.
2530 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2532 return JimGlobMatch(Jim_String(patternObjPtr
), Jim_String(objPtr
), nocase
);
2536 * Note: does not support embedded nulls for the nocase option.
2538 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2541 const char *s1
= Jim_GetString(firstObjPtr
, &l1
);
2542 const char *s2
= Jim_GetString(secondObjPtr
, &l2
);
2545 /* Do a character compare for nocase */
2546 return JimStringCompareLen(s1
, s2
, -1, nocase
);
2548 return JimStringCompare(s1
, l1
, s2
, l2
);
2552 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2554 * Note: does not support embedded nulls
2556 int Jim_StringCompareLenObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2558 const char *s1
= Jim_String(firstObjPtr
);
2559 const char *s2
= Jim_String(secondObjPtr
);
2561 return JimStringCompareLen(s1
, s2
, Jim_Utf8Length(interp
, firstObjPtr
), nocase
);
2564 /* Convert a range, as returned by Jim_GetRange(), into
2565 * an absolute index into an object of the specified length.
2566 * This function may return negative values, or values
2567 * greater than or equal to the length of the list if the index
2568 * is out of range. */
2569 static int JimRelToAbsIndex(int len
, int idx
)
2576 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2577 * into a form suitable for implementation of commands like [string range] and [lrange].
2579 * The resulting range is guaranteed to address valid elements of
2582 static void JimRelToAbsRange(int len
, int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2586 if (*firstPtr
> *lastPtr
) {
2590 rangeLen
= *lastPtr
- *firstPtr
+ 1;
2592 if (*firstPtr
< 0) {
2593 rangeLen
+= *firstPtr
;
2596 if (*lastPtr
>= len
) {
2597 rangeLen
-= (*lastPtr
- (len
- 1));
2605 *rangeLenPtr
= rangeLen
;
2608 static int JimStringGetRange(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
,
2609 int len
, int *first
, int *last
, int *range
)
2611 if (Jim_GetIndex(interp
, firstObjPtr
, first
) != JIM_OK
) {
2614 if (Jim_GetIndex(interp
, lastObjPtr
, last
) != JIM_OK
) {
2617 *first
= JimRelToAbsIndex(len
, *first
);
2618 *last
= JimRelToAbsIndex(len
, *last
);
2619 JimRelToAbsRange(len
, first
, last
, range
);
2623 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
2624 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2631 str
= Jim_GetString(strObjPtr
, &bytelen
);
2633 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, bytelen
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2637 if (first
== 0 && rangeLen
== bytelen
) {
2640 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2643 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2644 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2652 str
= Jim_GetString(strObjPtr
, &bytelen
);
2653 len
= Jim_Utf8Length(interp
, strObjPtr
);
2655 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2659 if (first
== 0 && rangeLen
== len
) {
2662 if (len
== bytelen
) {
2663 /* ASCII optimisation */
2664 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2666 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
2668 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
2672 Jim_Obj
*JimStringReplaceObj(Jim_Interp
*interp
,
2673 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
, Jim_Obj
*newStrObj
)
2680 len
= Jim_Utf8Length(interp
, strObjPtr
);
2682 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2690 str
= Jim_String(strObjPtr
);
2693 objPtr
= Jim_NewStringObjUtf8(interp
, str
, first
);
2697 Jim_AppendObj(interp
, objPtr
, newStrObj
);
2701 Jim_AppendString(interp
, objPtr
, str
+ utf8_index(str
, last
+ 1), len
- last
- 1);
2707 * Note: does not support embedded nulls.
2709 static void JimStrCopyUpperLower(char *dest
, const char *str
, int uc
)
2713 str
+= utf8_tounicode(str
, &c
);
2714 dest
+= utf8_getchars(dest
, uc
? utf8_upper(c
) : utf8_lower(c
));
2720 * Note: does not support embedded nulls.
2722 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2728 SetStringFromAny(interp
, strObjPtr
);
2730 str
= Jim_GetString(strObjPtr
, &len
);
2733 /* Case mapping can change the utf-8 length of the string.
2734 * But at worst it will be by one extra byte per char
2738 buf
= Jim_Alloc(len
+ 1);
2739 JimStrCopyUpperLower(buf
, str
, 0);
2740 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2744 * Note: does not support embedded nulls.
2746 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2752 if (strObjPtr
->typePtr
!= &stringObjType
) {
2753 SetStringFromAny(interp
, strObjPtr
);
2756 str
= Jim_GetString(strObjPtr
, &len
);
2759 /* Case mapping can change the utf-8 length of the string.
2760 * But at worst it will be by one extra byte per char
2764 buf
= Jim_Alloc(len
+ 1);
2765 JimStrCopyUpperLower(buf
, str
, 1);
2766 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2770 * Note: does not support embedded nulls.
2772 static Jim_Obj
*JimStringToTitle(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2779 str
= Jim_GetString(strObjPtr
, &len
);
2784 /* Case mapping can change the utf-8 length of the string.
2785 * But at worst it will be by one extra byte per char
2789 buf
= p
= Jim_Alloc(len
+ 1);
2791 str
+= utf8_tounicode(str
, &c
);
2792 p
+= utf8_getchars(p
, utf8_title(c
));
2794 JimStrCopyUpperLower(p
, str
, 0);
2796 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2799 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2800 * for unicode character 'c'.
2801 * Returns the position if found or NULL if not
2803 static const char *utf8_memchr(const char *str
, int len
, int c
)
2808 int n
= utf8_tounicode(str
, &sc
);
2817 return memchr(str
, c
, len
);
2822 * Searches for the first non-trim char in string (str, len)
2824 * If none is found, returns just past the last char.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
2832 int n
= utf8_tounicode(str
, &c
);
2834 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2835 /* Not a trim char, so stop */
2845 * Searches backwards for a non-trim char in string (str, len).
2847 * Returns a pointer to just after the non-trim char, or NULL if not found.
2849 * Lengths are in bytes.
2851 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
2857 int n
= utf8_prev_len(str
, len
);
2862 n
= utf8_tounicode(str
, &c
);
2864 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2872 static const char default_trim_chars
[] = " \t\n\r";
2873 /* sizeof() here includes the null byte */
2874 static int default_trim_chars_len
= sizeof(default_trim_chars
);
2876 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2879 const char *str
= Jim_GetString(strObjPtr
, &len
);
2880 const char *trimchars
= default_trim_chars
;
2881 int trimcharslen
= default_trim_chars_len
;
2884 if (trimcharsObjPtr
) {
2885 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2888 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
2889 if (newstr
== str
) {
2893 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
2896 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2899 const char *trimchars
= default_trim_chars
;
2900 int trimcharslen
= default_trim_chars_len
;
2901 const char *nontrim
;
2903 if (trimcharsObjPtr
) {
2904 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2907 SetStringFromAny(interp
, strObjPtr
);
2909 len
= Jim_Length(strObjPtr
);
2910 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
2912 if (nontrim
== NULL
) {
2913 /* All trim, so return a zero-length string */
2914 return Jim_NewEmptyStringObj(interp
);
2916 if (nontrim
== strObjPtr
->bytes
+ len
) {
2917 /* All non-trim, so return the original object */
2921 if (Jim_IsShared(strObjPtr
)) {
2922 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
2925 /* Can modify this string in place */
2926 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
2927 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
2933 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2935 /* First trim left. */
2936 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
2938 /* Now trim right */
2939 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
2941 /* Note: refCount check is needed since objPtr may be emptyObj */
2942 if (objPtr
!= strObjPtr
&& objPtr
->refCount
== 0) {
2943 /* We don't want this object to be leaked */
2944 Jim_FreeNewObj(interp
, objPtr
);
2950 /* Some platforms don't have isascii - need a non-macro version */
2952 #define jim_isascii isascii
2954 static int jim_isascii(int c
)
2956 return !(c
& ~0x7f);
2960 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2962 static const char * const strclassnames
[] = {
2963 "integer", "alpha", "alnum", "ascii", "digit",
2964 "double", "lower", "upper", "space", "xdigit",
2965 "control", "print", "graph", "punct", "boolean",
2969 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2970 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2971 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
, STR_IS_BOOLEAN
,
2977 int (*isclassfunc
)(int c
) = NULL
;
2979 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2983 str
= Jim_GetString(strObjPtr
, &len
);
2985 Jim_SetResultBool(interp
, !strict
);
2990 case STR_IS_INTEGER
:
2993 Jim_SetResultBool(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
3000 Jim_SetResultBool(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
3004 case STR_IS_BOOLEAN
:
3007 Jim_SetResultBool(interp
, Jim_GetBoolean(interp
, strObjPtr
, &b
) == JIM_OK
);
3011 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
3012 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
3013 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
3014 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
3015 case STR_IS_LOWER
: isclassfunc
= islower
; break;
3016 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
3017 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
3018 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
3019 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
3020 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
3021 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
3022 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3027 for (i
= 0; i
< len
; i
++) {
3028 if (!isclassfunc(str
[i
])) {
3029 Jim_SetResultBool(interp
, 0);
3033 Jim_SetResultBool(interp
, 1);
3037 /* -----------------------------------------------------------------------------
3038 * Compared String Object
3039 * ---------------------------------------------------------------------------*/
3041 /* This is strange object that allows comparison of a C literal string
3042 * with a Jim object in a very short time if the same comparison is done
3043 * multiple times. For example every time the [if] command is executed,
3044 * Jim has to check if a given argument is "else".
3045 * If the code has no errors, this comparison is true most of the time,
3046 * so we can cache the pointer of the string of the last matching
3047 * comparison inside the object. Because most C compilers perform literal sharing,
3048 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3049 * this works pretty well even if comparisons are at different places
3050 * inside the C code. */
3052 static const Jim_ObjType comparedStringObjType
= {
3057 JIM_TYPE_REFERENCES
,
3060 /* The only way this object is exposed to the API is via the following
3061 * function. Returns true if the string and the object string repr.
3062 * are the same, otherwise zero is returned.
3064 * Note: this isn't binary safe, but it hardly needs to be.*/
3065 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3067 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3071 const char *objStr
= Jim_String(objPtr
);
3073 if (strcmp(str
, objStr
) != 0)
3076 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3077 Jim_FreeIntRep(interp
, objPtr
);
3078 objPtr
->typePtr
= &comparedStringObjType
;
3080 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3085 static int qsortCompareStringPointers(const void *a
, const void *b
)
3087 char *const *sa
= (char *const *)a
;
3088 char *const *sb
= (char *const *)b
;
3090 return strcmp(*sa
, *sb
);
3094 /* -----------------------------------------------------------------------------
3097 * This object is just a string from the language point of view, but
3098 * the internal representation contains the filename and line number
3099 * where this token was read. This information is used by
3100 * Jim_EvalObj() if the object passed happens to be of type "source".
3102 * This allows propagation of the information about line numbers and file
3103 * names and gives error messages with absolute line numbers.
3105 * Note that this object uses the internal representation of the Jim_Object,
3106 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3108 * Also the object will be converted to something else if the given
3109 * token it represents in the source file is not something to be
3110 * evaluated (not a script), and will be specialized in some other way,
3111 * so the time overhead is also almost zero.
3112 * ---------------------------------------------------------------------------*/
3114 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3115 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3117 static const Jim_ObjType sourceObjType
= {
3119 FreeSourceInternalRep
,
3120 DupSourceInternalRep
,
3122 JIM_TYPE_REFERENCES
,
3125 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3127 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3130 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3132 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3133 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3136 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3137 Jim_Obj
*fileNameObj
, int lineNumber
)
3139 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3140 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3141 Jim_IncrRefCount(fileNameObj
);
3142 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3143 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3144 objPtr
->typePtr
= &sourceObjType
;
3147 /* -----------------------------------------------------------------------------
3150 * This object is used only in the Script internal represenation.
3151 * For each line of the script, it holds the number of tokens on the line
3152 * and the source line number.
3154 static const Jim_ObjType scriptLineObjType
= {
3162 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3166 #ifdef DEBUG_SHOW_SCRIPT
3168 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3169 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3171 objPtr
= Jim_NewEmptyStringObj(interp
);
3173 objPtr
->typePtr
= &scriptLineObjType
;
3174 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3175 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3180 /* -----------------------------------------------------------------------------
3183 * This object holds the parsed internal representation of a script.
3184 * This representation is help within an allocated ScriptObj (see below)
3186 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3187 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3189 static const Jim_ObjType scriptObjType
= {
3191 FreeScriptInternalRep
,
3192 DupScriptInternalRep
,
3194 JIM_TYPE_REFERENCES
,
3197 /* Each token of a script is represented by a ScriptToken.
3198 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3199 * can be specialized by commands operating on it.
3201 typedef struct 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:
3214 * set $i $x$y [foo]BAR
3216 * will produce a ScriptObj with the following ScriptToken's:
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:
3250 * Will produce the following cmdstruct array:
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, 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.
3267 * If these flags do not match what the application requires,
3268 * the scriptObj is created again. For example the script:
3270 * subst -nocommands $string
3271 * subst -novariables $string
3273 * Will (re)create the internal representation of the $string object
3276 typedef struct ScriptObj
3278 ScriptToken
*token
; /* Tokens array. */
3279 Jim_Obj
*fileNameObj
; /* Filename */
3280 int len
; /* Length of token[] */
3281 int substFlags
; /* flags used for the compilation of "subst" objects */
3282 int inUse
; /* Used to share a ScriptObj. Currently
3283 only used by Jim_EvalObj() as protection against
3284 shimmering of the currently evaluated object. */
3285 int firstline
; /* Line number of the first line */
3286 int linenr
; /* Error line number, if any */
3287 int missing
; /* Missing char if script failed to parse, (or space or backslash if OK) */
3290 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3291 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3292 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3294 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3297 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3299 if (--script
->inUse
!= 0)
3301 for (i
= 0; i
< script
->len
; i
++) {
3302 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3304 Jim_Free(script
->token
);
3305 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3309 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3311 JIM_NOTUSED(interp
);
3312 JIM_NOTUSED(srcPtr
);
3314 /* Just return a simple string. We don't try to preserve the source info
3315 * since in practice scripts are never duplicated
3317 dupPtr
->typePtr
= NULL
;
3320 /* A simple parse token.
3321 * As the script is parsed, the created tokens point into the script string rep.
3325 const char *token
; /* Pointer to the start of the token */
3326 int len
; /* Length of this token */
3327 int type
; /* Token type */
3328 int line
; /* Line number */
3331 /* A list of parsed tokens representing a script.
3332 * Tokens are added to this list as the script is parsed.
3333 * It grows as needed.
3337 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3338 ParseToken
*list
; /* Array of tokens */
3339 int size
; /* Current size of the list */
3340 int count
; /* Number of entries used */
3341 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3344 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3346 tokenlist
->list
= tokenlist
->static_list
;
3347 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3348 tokenlist
->count
= 0;
3351 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3353 if (tokenlist
->list
!= tokenlist
->static_list
) {
3354 Jim_Free(tokenlist
->list
);
3359 * Adds the new token to the tokenlist.
3360 * The token has the given length, type and line number.
3361 * The token list is resized as necessary.
3363 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3368 if (tokenlist
->count
== tokenlist
->size
) {
3369 /* Resize the list */
3370 tokenlist
->size
*= 2;
3371 if (tokenlist
->list
!= tokenlist
->static_list
) {
3373 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3376 /* The list needs to become allocated */
3377 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3378 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3379 tokenlist
->count
* sizeof(*tokenlist
->list
));
3382 t
= &tokenlist
->list
[tokenlist
->count
++];
3389 /* Counts the number of adjoining non-separator tokens.
3391 * Returns -ve if the first token is the expansion
3392 * operator (in which case the count doesn't include
3395 static int JimCountWordTokens(ParseToken
*t
)
3400 /* Is the first word {*} or {expand}? */
3401 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3402 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3403 /* Create an expand token */
3409 /* Now count non-separator words */
3410 while (!TOKEN_IS_SEP(t
->type
)) {
3415 return count
* expand
;
3419 * Create a script/subst object from the given token.
3421 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3425 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3426 /* Convert backlash escapes. The result will never be longer than the original */
3428 char *str
= Jim_Alloc(len
+ 1);
3429 len
= JimEscape(str
, t
->token
, len
);
3430 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3433 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3434 * with a single space.
3436 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3442 * Takes a tokenlist and creates the allocated list of script tokens
3443 * in script->token, of length script->len.
3445 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3448 * Also sets script->line to the line number of the first token
3450 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3451 ParseTokenList
*tokenlist
)
3454 struct ScriptToken
*token
;
3455 /* Number of tokens so far for the current command */
3457 /* This is the first token for the current command */
3458 ScriptToken
*linefirst
;
3462 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3463 printf("==== Tokens ====\n");
3464 for (i
= 0; i
< tokenlist
->count
; i
++) {
3465 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3466 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3470 /* May need up to one extra script token for each EOL in the worst case */
3471 count
= tokenlist
->count
;
3472 for (i
= 0; i
< tokenlist
->count
; i
++) {
3473 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3477 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3479 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3481 /* This is the first token for the current command */
3482 linefirst
= token
++;
3484 for (i
= 0; i
< tokenlist
->count
; ) {
3485 /* Look ahead to find out how many tokens make up the next word */
3488 /* Skip any leading separators */
3489 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3493 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3495 if (wordtokens
== 0) {
3496 /* None, so at end of line */
3498 linefirst
->type
= JIM_TT_LINE
;
3499 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3500 Jim_IncrRefCount(linefirst
->objPtr
);
3502 /* Reset for new line */
3504 linefirst
= token
++;
3509 else if (wordtokens
!= 1) {
3510 /* More than 1, or {*}, so insert a WORD token */
3511 token
->type
= JIM_TT_WORD
;
3512 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3513 Jim_IncrRefCount(token
->objPtr
);
3515 if (wordtokens
< 0) {
3516 /* Skip the expand token */
3518 wordtokens
= -wordtokens
- 1;
3523 if (lineargs
== 0) {
3524 /* First real token on the line, so record the line number */
3525 linenr
= tokenlist
->list
[i
].line
;
3529 /* Add each non-separator word token to the line */
3530 while (wordtokens
--) {
3531 const ParseToken
*t
= &tokenlist
->list
[i
++];
3533 token
->type
= t
->type
;
3534 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3535 Jim_IncrRefCount(token
->objPtr
);
3537 /* Every object is initially a string of type 'source', but the
3538 * internal type may be specialized during execution of the
3540 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3545 if (lineargs
== 0) {
3549 script
->len
= token
- script
->token
;
3551 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3553 #ifdef DEBUG_SHOW_SCRIPT
3554 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3555 for (i
= 0; i
< script
->len
; i
++) {
3556 const ScriptToken
*t
= &script
->token
[i
];
3557 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3563 /* Parses the given string object to determine if it represents a complete script.
3565 * This is useful for interactive shells implementation, for [info complete].
3567 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3568 * '{' on scripts incomplete missing one or more '}' to be balanced.
3569 * '[' on scripts incomplete missing one or more ']' to be balanced.
3570 * '"' on scripts incomplete missing a '"' char.
3571 * '\\' on scripts with a trailing backslash.
3573 * If the script is complete, 1 is returned, otherwise 0.
3575 int Jim_ScriptIsComplete(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, char *stateCharPtr
)
3577 ScriptObj
*script
= JimGetScript(interp
, scriptObj
);
3579 *stateCharPtr
= script
->missing
;
3581 return (script
->missing
== ' ');
3585 * Sets an appropriate error message for a missing script/expression terminator.
3587 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3589 * Note that a trailing backslash is not considered to be an error.
3591 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3601 msg
= "unmatched \"[\"";
3604 msg
= "missing close-brace";
3608 msg
= "missing quote";
3612 Jim_SetResultString(interp
, msg
, -1);
3617 * Similar to ScriptObjAddTokens(), but for subst objects.
3619 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3620 ParseTokenList
*tokenlist
)
3623 struct ScriptToken
*token
;
3625 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3627 for (i
= 0; i
< tokenlist
->count
; i
++) {
3628 const ParseToken
*t
= &tokenlist
->list
[i
];
3630 /* Create a token for 't' */
3631 token
->type
= t
->type
;
3632 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3633 Jim_IncrRefCount(token
->objPtr
);
3640 /* This method takes the string representation of an object
3641 * as a Tcl script, and generates the pre-parsed internal representation
3644 * On parse error, sets an error message and returns JIM_ERR
3645 * (Note: the object is still converted to a script, even if an error occurs)
3647 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3650 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3651 struct JimParserCtx parser
;
3652 struct ScriptObj
*script
;
3653 ParseTokenList tokenlist
;
3656 /* Try to get information about filename / line number */
3657 if (objPtr
->typePtr
== &sourceObjType
) {
3658 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3661 /* Initially parse the script into tokens (in tokenlist) */
3662 ScriptTokenListInit(&tokenlist
);
3664 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3665 while (!parser
.eof
) {
3666 JimParseScript(&parser
);
3667 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3671 /* Add a final EOF token */
3672 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3674 /* Create the "real" script tokens from the parsed tokens */
3675 script
= Jim_Alloc(sizeof(*script
));
3676 memset(script
, 0, sizeof(*script
));
3678 if (objPtr
->typePtr
== &sourceObjType
) {
3679 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3682 script
->fileNameObj
= interp
->emptyObj
;
3684 Jim_IncrRefCount(script
->fileNameObj
);
3685 script
->missing
= parser
.missing
.ch
;
3686 script
->linenr
= parser
.missing
.line
;
3688 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3690 /* No longer need the token list */
3691 ScriptTokenListFree(&tokenlist
);
3693 /* Free the old internal rep and set the new one. */
3694 Jim_FreeIntRep(interp
, objPtr
);
3695 Jim_SetIntRepPtr(objPtr
, script
);
3696 objPtr
->typePtr
= &scriptObjType
;
3699 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
);
3702 * Returns the parsed script.
3703 * Note that if there is any possibility that the script is not valid,
3704 * call JimScriptValid() to check
3706 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3708 if (objPtr
== interp
->emptyObj
) {
3709 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3710 objPtr
= interp
->nullScriptObj
;
3713 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3714 JimSetScriptFromAny(interp
, objPtr
);
3717 return (ScriptObj
*)Jim_GetIntRepPtr(objPtr
);
3721 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3722 * and leaves an error message in the interp result.
3725 static int JimScriptValid(Jim_Interp
*interp
, ScriptObj
*script
)
3727 if (JimParseCheckMissing(interp
, script
->missing
) == JIM_ERR
) {
3728 JimAddErrorToStack(interp
, script
);
3735 /* -----------------------------------------------------------------------------
3737 * ---------------------------------------------------------------------------*/
3738 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3743 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3745 if (--cmdPtr
->inUse
== 0) {
3746 if (cmdPtr
->isproc
) {
3747 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3748 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3749 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3750 if (cmdPtr
->u
.proc
.staticVars
) {
3751 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3752 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3757 if (cmdPtr
->u
.native
.delProc
) {
3758 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3761 if (cmdPtr
->prevCmd
) {
3762 /* Delete any pushed command too */
3763 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3769 /* Variables HashTable Type.
3771 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3774 /* Variables HashTable Type.
3776 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3777 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3779 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3783 static const Jim_HashTableType JimVariablesHashTableType
= {
3784 JimStringCopyHTHashFunction
, /* hash function */
3785 JimStringCopyHTDup
, /* key dup */
3787 JimStringCopyHTKeyCompare
, /* key compare */
3788 JimStringCopyHTKeyDestructor
, /* key destructor */
3789 JimVariablesHTValDestructor
/* val destructor */
3792 /* Commands HashTable Type.
3794 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3796 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3798 JimDecrCmdRefCount(interp
, val
);
3801 static const Jim_HashTableType JimCommandsHashTableType
= {
3802 JimStringCopyHTHashFunction
, /* hash function */
3803 JimStringCopyHTDup
, /* key dup */
3805 JimStringCopyHTKeyCompare
, /* key compare */
3806 JimStringCopyHTKeyDestructor
, /* key destructor */
3807 JimCommandsHT_ValDestructor
/* val destructor */
3810 /* ------------------------- Commands related functions --------------------- */
3812 #ifdef jim_ext_namespace
3814 * Returns the "unscoped" version of the given namespace.
3815 * That is, the fully qualified name without the leading ::
3816 * The returned value is either nsObj, or an object with a zero ref count.
3818 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3820 const char *name
= Jim_String(nsObj
);
3821 if (name
[0] == ':' && name
[1] == ':') {
3822 /* This command is being defined in the global namespace */
3823 while (*++name
== ':') {
3825 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3827 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3828 /* This command is being defined in a non-global namespace */
3829 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3830 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3835 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3839 const char *name
= Jim_String(nameObjPtr
);
3840 if (name
[0] == ':' && name
[1] == ':') {
3843 Jim_IncrRefCount(nameObjPtr
);
3844 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3845 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3846 Jim_DecrRefCount(interp
, nameObjPtr
);
3852 * An efficient version of JimQualifyNameObj() where the name is
3853 * available (and needed) as a 'const char *'.
3854 * Avoids creating an object if not necessary.
3855 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3857 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3859 Jim_Obj
*objPtr
= interp
->emptyObj
;
3861 if (name
[0] == ':' && name
[1] == ':') {
3862 /* This command is being defined in the global namespace */
3863 while (*++name
== ':') {
3866 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3867 /* This command is being defined in a non-global namespace */
3868 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3869 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3870 name
= Jim_String(objPtr
);
3872 Jim_IncrRefCount(objPtr
);
3873 *objPtrPtr
= objPtr
;
3877 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3880 /* We can be more efficient in the no-namespace case */
3881 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3882 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3884 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3890 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3892 /* It may already exist, so we try to delete the old one.
3893 * Note that reference count means that it won't be deleted yet if
3894 * it exists in the call stack.
3896 * BUT, if 'local' is in force, instead of deleting the existing
3897 * proc, we stash a reference to the old proc here.
3899 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3901 /* There was an old cmd with the same name,
3902 * so this requires a 'proc epoch' update. */
3904 /* If a procedure with the same name didn't exist there is no need
3905 * to increment the 'proc epoch' because creation of a new procedure
3906 * can never affect existing cached commands. We don't do
3907 * negative caching. */
3908 Jim_InterpIncrProcEpoch(interp
);
3911 if (he
&& interp
->local
) {
3912 /* Push this command over the top of the previous one */
3913 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3914 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3918 /* Replace the existing command */
3919 Jim_DeleteHashEntry(&interp
->commands
, name
);
3922 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3928 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3929 Jim_CmdProc
*cmdProc
, void *privData
, Jim_DelCmdProc
*delProc
)
3931 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3933 /* Store the new details for this command */
3934 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3936 cmdPtr
->u
.native
.delProc
= delProc
;
3937 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3938 cmdPtr
->u
.native
.privData
= privData
;
3940 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3945 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3949 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3954 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3955 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3956 for (i
= 0; i
< len
; i
++) {
3957 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3961 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3962 /* Check if it's composed of two elements. */
3963 subLen
= Jim_ListLength(interp
, objPtr
);
3964 if (subLen
== 1 || subLen
== 2) {
3965 /* Try to get the variable value from the current
3967 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3969 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3970 if (initObjPtr
== NULL
) {
3971 Jim_SetResultFormatted(interp
,
3972 "variable for initialization of static \"%#s\" not found in the local context",
3978 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3980 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3984 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3985 varPtr
->objPtr
= initObjPtr
;
3986 Jim_IncrRefCount(initObjPtr
);
3987 varPtr
->linkFramePtr
= NULL
;
3988 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3989 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3990 Jim_SetResultFormatted(interp
,
3991 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3992 Jim_DecrRefCount(interp
, initObjPtr
);
3998 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
4006 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
4008 #ifdef jim_ext_namespace
4009 if (cmdPtr
->isproc
) {
4010 /* XXX: Really need JimNamespaceSplit() */
4011 const char *pt
= strrchr(cmdname
, ':');
4012 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
4013 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
4014 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
4015 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4017 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
4018 /* This commands shadows a global command, so a proc epoch update is required */
4019 Jim_InterpIncrProcEpoch(interp
);
4026 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
4027 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4033 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4035 /* Allocate space for both the command pointer and the arg list */
4036 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4037 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4040 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4041 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4042 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4043 cmdPtr
->u
.proc
.argsPos
= -1;
4044 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4045 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4046 Jim_IncrRefCount(argListObjPtr
);
4047 Jim_IncrRefCount(bodyObjPtr
);
4048 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4050 /* Create the statics hash table. */
4051 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4055 /* Parse the args out into arglist, validating as we go */
4056 /* Examine the argument list for default parameters and 'args' */
4057 for (i
= 0; i
< argListLen
; i
++) {
4059 Jim_Obj
*nameObjPtr
;
4060 Jim_Obj
*defaultObjPtr
;
4063 /* Examine a parameter */
4064 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4065 len
= Jim_ListLength(interp
, argPtr
);
4067 Jim_SetResultString(interp
, "argument with no name", -1);
4069 JimDecrCmdRefCount(interp
, cmdPtr
);
4073 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4078 /* Optional parameter */
4079 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4080 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4083 /* Required parameter */
4084 nameObjPtr
= argPtr
;
4085 defaultObjPtr
= NULL
;
4089 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4090 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4091 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4094 cmdPtr
->u
.proc
.argsPos
= i
;
4098 cmdPtr
->u
.proc
.optArity
++;
4101 cmdPtr
->u
.proc
.reqArity
++;
4105 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4106 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4112 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4115 Jim_Obj
*qualifiedNameObj
;
4116 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4118 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4119 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4123 Jim_InterpIncrProcEpoch(interp
);
4126 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4131 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4136 Jim_Obj
*qualifiedOldNameObj
;
4137 Jim_Obj
*qualifiedNewNameObj
;
4141 if (newName
[0] == 0) {
4142 return Jim_DeleteCommand(interp
, oldName
);
4145 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4146 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4148 /* Does it exist? */
4149 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4151 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4153 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4154 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4157 /* Add the new name first */
4158 cmdPtr
= Jim_GetHashEntryVal(he
);
4159 JimIncrCmdRefCount(cmdPtr
);
4160 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4161 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4163 /* Now remove the old name */
4164 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4166 /* Increment the epoch */
4167 Jim_InterpIncrProcEpoch(interp
);
4172 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4173 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4178 /* -----------------------------------------------------------------------------
4180 * ---------------------------------------------------------------------------*/
4182 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4184 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4187 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4189 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4190 dupPtr
->typePtr
= srcPtr
->typePtr
;
4191 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4194 static const Jim_ObjType commandObjType
= {
4196 FreeCommandInternalRep
,
4197 DupCommandInternalRep
,
4199 JIM_TYPE_REFERENCES
,
4202 /* This function returns the command structure for the command name
4203 * stored in objPtr. It tries to specialize the objPtr to contain
4204 * a cached info instead to perform the lookup into the hash table
4205 * every time. The information cached may not be uptodate, in such
4206 * a case the lookup is performed and the cache updated.
4208 * Respects the 'upcall' setting
4210 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4214 /* In order to be valid, the proc epoch must match and
4215 * the lookup must have occurred in the same namespace
4217 if (objPtr
->typePtr
!= &commandObjType
||
4218 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4219 #ifdef jim_ext_namespace
4220 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4223 /* Not cached or out of date, so lookup */
4225 /* Do we need to try the local namespace? */
4226 const char *name
= Jim_String(objPtr
);
4229 if (name
[0] == ':' && name
[1] == ':') {
4230 while (*++name
== ':') {
4233 #ifdef jim_ext_namespace
4234 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4235 /* This command is being defined in a non-global namespace */
4236 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4237 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4238 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4239 Jim_FreeNewObj(interp
, nameObj
);
4246 /* Lookup in the global namespace */
4247 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4249 if (flags
& JIM_ERRMSG
) {
4250 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4254 #ifdef jim_ext_namespace
4257 cmd
= Jim_GetHashEntryVal(he
);
4259 /* Free the old internal repr and set the new one. */
4260 Jim_FreeIntRep(interp
, objPtr
);
4261 objPtr
->typePtr
= &commandObjType
;
4262 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4263 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4264 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4265 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4268 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4270 while (cmd
->u
.proc
.upcall
) {
4276 /* -----------------------------------------------------------------------------
4278 * ---------------------------------------------------------------------------*/
4280 /* -----------------------------------------------------------------------------
4282 * ---------------------------------------------------------------------------*/
4284 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4286 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4288 static const Jim_ObjType variableObjType
= {
4293 JIM_TYPE_REFERENCES
,
4297 * Check that the name does not contain embedded nulls.
4299 * Variable and procedure names are manipulated as null terminated strings, so
4300 * don't allow names with embedded nulls.
4302 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4304 /* Variable names and proc names can't contain embedded nulls */
4305 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4307 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4308 if (memchr(str
, '\0', len
)) {
4309 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4316 /* This method should be called only by the variable API.
4317 * It returns JIM_OK on success (variable already exists),
4318 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4319 * a variable name, but syntax glue for [dict] i.e. the last
4320 * character is ')' */
4321 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4323 const char *varName
;
4324 Jim_CallFrame
*framePtr
;
4329 /* Check if the object is already an uptodate variable */
4330 if (objPtr
->typePtr
== &variableObjType
) {
4331 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4332 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4336 /* Need to re-resolve the variable in the updated callframe */
4338 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4339 return JIM_DICT_SUGAR
;
4341 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4346 varName
= Jim_GetString(objPtr
, &len
);
4348 /* Make sure it's not syntax glue to get/set dict. */
4349 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4350 return JIM_DICT_SUGAR
;
4353 if (varName
[0] == ':' && varName
[1] == ':') {
4354 while (*++varName
== ':') {
4357 framePtr
= interp
->topFramePtr
;
4361 framePtr
= interp
->framePtr
;
4364 /* Resolve this name in the variables hash table */
4365 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4367 if (!global
&& framePtr
->staticVars
) {
4368 /* Try with static vars. */
4369 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4376 /* Free the old internal repr and set the new one. */
4377 Jim_FreeIntRep(interp
, objPtr
);
4378 objPtr
->typePtr
= &variableObjType
;
4379 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4380 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4381 objPtr
->internalRep
.varValue
.global
= global
;
4385 /* -------------------- Variables related functions ------------------------- */
4386 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4387 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4389 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4392 Jim_CallFrame
*framePtr
;
4395 /* New variable to create */
4396 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4398 var
->objPtr
= valObjPtr
;
4399 Jim_IncrRefCount(valObjPtr
);
4400 var
->linkFramePtr
= NULL
;
4402 name
= Jim_String(nameObjPtr
);
4403 if (name
[0] == ':' && name
[1] == ':') {
4404 while (*++name
== ':') {
4406 framePtr
= interp
->topFramePtr
;
4410 framePtr
= interp
->framePtr
;
4414 /* Insert the new variable */
4415 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4417 /* Make the object int rep a variable */
4418 Jim_FreeIntRep(interp
, nameObjPtr
);
4419 nameObjPtr
->typePtr
= &variableObjType
;
4420 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4421 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4422 nameObjPtr
->internalRep
.varValue
.global
= global
;
4427 /* For now that's dummy. Variables lookup should be optimized
4428 * in many ways, with caching of lookups, and possibly with
4429 * a table of pre-allocated vars in every CallFrame for local vars.
4430 * All the caching should also have an 'epoch' mechanism similar
4431 * to the one used by Tcl for procedures lookup caching. */
4433 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4438 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4439 case JIM_DICT_SUGAR
:
4440 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4443 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4446 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4450 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4451 if (var
->linkFramePtr
== NULL
) {
4452 Jim_IncrRefCount(valObjPtr
);
4453 Jim_DecrRefCount(interp
, var
->objPtr
);
4454 var
->objPtr
= valObjPtr
;
4456 else { /* Else handle the link */
4457 Jim_CallFrame
*savedCallFrame
;
4459 savedCallFrame
= interp
->framePtr
;
4460 interp
->framePtr
= var
->linkFramePtr
;
4461 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4462 interp
->framePtr
= savedCallFrame
;
4470 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4472 Jim_Obj
*nameObjPtr
;
4475 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4476 Jim_IncrRefCount(nameObjPtr
);
4477 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4478 Jim_DecrRefCount(interp
, nameObjPtr
);
4482 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4484 Jim_CallFrame
*savedFramePtr
;
4487 savedFramePtr
= interp
->framePtr
;
4488 interp
->framePtr
= interp
->topFramePtr
;
4489 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4490 interp
->framePtr
= savedFramePtr
;
4494 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4496 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4499 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4500 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4501 Jim_IncrRefCount(nameObjPtr
);
4502 Jim_IncrRefCount(valObjPtr
);
4503 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4504 Jim_DecrRefCount(interp
, nameObjPtr
);
4505 Jim_DecrRefCount(interp
, valObjPtr
);
4509 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4510 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4512 const char *varName
;
4513 const char *targetName
;
4514 Jim_CallFrame
*framePtr
;
4517 /* Check for an existing variable or link */
4518 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4519 case JIM_DICT_SUGAR
:
4520 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4521 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4525 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4527 if (varPtr
->linkFramePtr
== NULL
) {
4528 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4532 /* It exists, but is a link, so first delete the link */
4533 varPtr
->linkFramePtr
= NULL
;
4537 /* Resolve the call frames for both variables */
4538 /* XXX: SetVariableFromAny() already did this! */
4539 varName
= Jim_String(nameObjPtr
);
4541 if (varName
[0] == ':' && varName
[1] == ':') {
4542 while (*++varName
== ':') {
4544 /* Linking a global var does nothing */
4545 framePtr
= interp
->topFramePtr
;
4548 framePtr
= interp
->framePtr
;
4551 targetName
= Jim_String(targetNameObjPtr
);
4552 if (targetName
[0] == ':' && targetName
[1] == ':') {
4553 while (*++targetName
== ':') {
4555 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4556 targetCallFrame
= interp
->topFramePtr
;
4558 Jim_IncrRefCount(targetNameObjPtr
);
4560 if (framePtr
->level
< targetCallFrame
->level
) {
4561 Jim_SetResultFormatted(interp
,
4562 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4564 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4568 /* Check for cycles. */
4569 if (framePtr
== targetCallFrame
) {
4570 Jim_Obj
*objPtr
= targetNameObjPtr
;
4572 /* Cycles are only possible with 'uplevel 0' */
4574 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4575 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4576 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4579 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4581 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4582 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4584 objPtr
= varPtr
->objPtr
;
4588 /* Perform the binding */
4589 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4590 /* We are now sure 'nameObjPtr' type is variableObjType */
4591 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4592 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4596 /* Return the Jim_Obj pointer associated with a variable name,
4597 * or NULL if the variable was not found in the current context.
4598 * The same optimization discussed in the comment to the
4599 * 'SetVariable' function should apply here.
4601 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4602 * in a dictionary which is shared, the array variable value is duplicated first.
4603 * This allows the array element to be updated (e.g. append, lappend) without
4604 * affecting other references to the dictionary.
4606 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4608 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4610 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4612 if (varPtr
->linkFramePtr
== NULL
) {
4613 return varPtr
->objPtr
;
4618 /* The variable is a link? Resolve it. */
4619 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4621 interp
->framePtr
= varPtr
->linkFramePtr
;
4622 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4623 interp
->framePtr
= savedCallFrame
;
4627 /* Error, so fall through to the error message */
4632 case JIM_DICT_SUGAR
:
4633 /* [dict] syntax sugar. */
4634 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4636 if (flags
& JIM_ERRMSG
) {
4637 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4642 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4644 Jim_CallFrame
*savedFramePtr
;
4647 savedFramePtr
= interp
->framePtr
;
4648 interp
->framePtr
= interp
->topFramePtr
;
4649 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4650 interp
->framePtr
= savedFramePtr
;
4655 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4657 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4659 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4660 Jim_IncrRefCount(nameObjPtr
);
4661 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4662 Jim_DecrRefCount(interp
, nameObjPtr
);
4666 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4668 Jim_CallFrame
*savedFramePtr
;
4671 savedFramePtr
= interp
->framePtr
;
4672 interp
->framePtr
= interp
->topFramePtr
;
4673 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4674 interp
->framePtr
= savedFramePtr
;
4679 /* Unset a variable.
4680 * Note: On success unset invalidates all the variable objects created
4681 * in the current call frame incrementing. */
4682 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4686 Jim_CallFrame
*framePtr
;
4688 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4689 if (retval
== JIM_DICT_SUGAR
) {
4690 /* [dict] syntax sugar. */
4691 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4693 else if (retval
== JIM_OK
) {
4694 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4696 /* If it's a link call UnsetVariable recursively */
4697 if (varPtr
->linkFramePtr
) {
4698 framePtr
= interp
->framePtr
;
4699 interp
->framePtr
= varPtr
->linkFramePtr
;
4700 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4701 interp
->framePtr
= framePtr
;
4704 const char *name
= Jim_String(nameObjPtr
);
4705 if (nameObjPtr
->internalRep
.varValue
.global
) {
4707 framePtr
= interp
->topFramePtr
;
4710 framePtr
= interp
->framePtr
;
4713 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4714 if (retval
== JIM_OK
) {
4715 /* Change the callframe id, invalidating var lookup caching */
4716 framePtr
->id
= interp
->callFrameEpoch
++;
4720 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4721 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4726 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4728 /* Given a variable name for [dict] operation syntax sugar,
4729 * this function returns two objects, the first with the name
4730 * of the variable to set, and the second with the respective key.
4731 * For example "foo(bar)" will return objects with string repr. of
4734 * The returned objects have refcount = 1. The function can't fail. */
4735 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4736 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4738 const char *str
, *p
;
4740 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4742 str
= Jim_GetString(objPtr
, &len
);
4744 p
= strchr(str
, '(');
4745 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4747 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4750 keyLen
= (str
+ len
) - p
;
4751 if (str
[len
- 1] == ')') {
4755 /* Create the objects with the variable name and key. */
4756 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4758 Jim_IncrRefCount(varObjPtr
);
4759 Jim_IncrRefCount(keyObjPtr
);
4760 *varPtrPtr
= varObjPtr
;
4761 *keyPtrPtr
= keyObjPtr
;
4764 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4765 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4766 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4770 SetDictSubstFromAny(interp
, objPtr
);
4772 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4773 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4775 if (err
== JIM_OK
) {
4776 /* Don't keep an extra ref to the result */
4777 Jim_SetEmptyResult(interp
);
4781 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4782 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4783 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4788 /* Make the error more informative and Tcl-compatible */
4789 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4790 (valObjPtr
? "set" : "unset"), objPtr
);
4796 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4798 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4799 * and stored back to the variable before expansion.
4801 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4802 Jim_Obj
*keyObjPtr
, int flags
)
4804 Jim_Obj
*dictObjPtr
;
4805 Jim_Obj
*resObjPtr
= NULL
;
4808 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4813 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4814 if (ret
!= JIM_OK
) {
4815 Jim_SetResultFormatted(interp
,
4816 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4817 ret
< 0 ? "variable isn't" : "no such element in");
4819 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4820 /* Update the variable to have an unshared copy */
4821 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4827 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4828 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4830 SetDictSubstFromAny(interp
, objPtr
);
4832 return JimDictExpandArrayVariable(interp
,
4833 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4834 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4837 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4839 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4841 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4842 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4845 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4847 JIM_NOTUSED(interp
);
4849 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4850 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4851 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4852 dupPtr
->typePtr
= &dictSubstObjType
;
4855 /* Note: The object *must* be in dict-sugar format */
4856 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4858 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4859 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4861 if (objPtr
->typePtr
== &interpolatedObjType
) {
4862 /* An interpolated object in dict-sugar form */
4864 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4865 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4867 Jim_IncrRefCount(varObjPtr
);
4868 Jim_IncrRefCount(keyObjPtr
);
4871 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4874 Jim_FreeIntRep(interp
, objPtr
);
4875 objPtr
->typePtr
= &dictSubstObjType
;
4876 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4877 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4881 /* This function is used to expand [dict get] sugar in the form
4882 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4883 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4884 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4885 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4886 * the [dict]ionary contained in variable VARNAME. */
4887 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4889 Jim_Obj
*resObjPtr
= NULL
;
4890 Jim_Obj
*substKeyObjPtr
= NULL
;
4892 SetDictSubstFromAny(interp
, objPtr
);
4894 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4895 &substKeyObjPtr
, JIM_NONE
)
4899 Jim_IncrRefCount(substKeyObjPtr
);
4901 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4903 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4908 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4910 Jim_Obj
*resultObjPtr
;
4912 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4913 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4914 resultObjPtr
->refCount
--;
4915 return resultObjPtr
;
4920 /* -----------------------------------------------------------------------------
4922 * ---------------------------------------------------------------------------*/
4924 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4928 if (interp
->freeFramesList
) {
4929 cf
= interp
->freeFramesList
;
4930 interp
->freeFramesList
= cf
->next
;
4934 cf
->procArgsObjPtr
= NULL
;
4935 cf
->procBodyObjPtr
= NULL
;
4937 cf
->staticVars
= NULL
;
4938 cf
->localCommands
= NULL
;
4939 cf
->tailcallObj
= NULL
;
4940 cf
->tailcallCmd
= NULL
;
4943 cf
= Jim_Alloc(sizeof(*cf
));
4944 memset(cf
, 0, sizeof(*cf
));
4946 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4949 cf
->id
= interp
->callFrameEpoch
++;
4950 cf
->parent
= parent
;
4951 cf
->level
= parent
? parent
->level
+ 1 : 0;
4953 Jim_IncrRefCount(nsObj
);
4958 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
)
4960 /* Delete any local procs */
4961 if (localCommands
) {
4962 Jim_Obj
*cmdNameObj
;
4964 while ((cmdNameObj
= Jim_StackPop(localCommands
)) != NULL
) {
4967 Jim_HashTable
*ht
= &interp
->commands
;
4969 const char *fqname
= JimQualifyName(interp
, Jim_String(cmdNameObj
), &fqObjName
);
4971 he
= Jim_FindHashEntry(ht
, fqname
);
4974 Jim_Cmd
*cmd
= Jim_GetHashEntryVal(he
);
4976 Jim_Cmd
*prevCmd
= cmd
->prevCmd
;
4977 cmd
->prevCmd
= NULL
;
4979 /* Delete the old command */
4980 JimDecrCmdRefCount(interp
, cmd
);
4982 /* And restore the original */
4983 Jim_SetHashVal(ht
, he
, prevCmd
);
4986 Jim_DeleteHashEntry(ht
, fqname
);
4987 Jim_InterpIncrProcEpoch(interp
);
4990 Jim_DecrRefCount(interp
, cmdNameObj
);
4991 JimFreeQualifiedName(interp
, fqObjName
);
4993 Jim_FreeStack(localCommands
);
4994 Jim_Free(localCommands
);
5000 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5001 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5002 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
)
5004 JimDeleteLocalProcs(interp
, cf
->localCommands
);
5006 if (cf
->procArgsObjPtr
)
5007 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
5008 if (cf
->procBodyObjPtr
)
5009 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
5010 Jim_DecrRefCount(interp
, cf
->nsObj
);
5011 if (action
== JIM_FCF_FULL
|| cf
->vars
.size
!= JIM_HT_INITIAL_SIZE
)
5012 Jim_FreeHashTable(&cf
->vars
);
5015 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
5017 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
5019 while (he
!= NULL
) {
5020 Jim_HashEntry
*nextEntry
= he
->next
;
5021 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
5023 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
5024 Jim_Free(Jim_GetHashEntryKey(he
));
5033 cf
->next
= interp
->freeFramesList
;
5034 interp
->freeFramesList
= cf
;
5038 /* -----------------------------------------------------------------------------
5040 * ---------------------------------------------------------------------------*/
5041 #ifdef JIM_REFERENCES
5043 /* References HashTable Type.
5045 * Keys are unsigned long integers, dynamically allocated for now but in the
5046 * future it's worth to cache this 4 bytes objects. Values are pointers
5047 * to Jim_References. */
5048 static void JimReferencesHTValDestructor(void *interp
, void *val
)
5050 Jim_Reference
*refPtr
= (void *)val
;
5052 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
5053 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
5054 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5059 static unsigned int JimReferencesHTHashFunction(const void *key
)
5061 /* Only the least significant bits are used. */
5062 const unsigned long *widePtr
= key
;
5063 unsigned int intValue
= (unsigned int)*widePtr
;
5065 return Jim_IntHashFunction(intValue
);
5068 static void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
5070 void *copy
= Jim_Alloc(sizeof(unsigned long));
5072 JIM_NOTUSED(privdata
);
5074 memcpy(copy
, key
, sizeof(unsigned long));
5078 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5080 JIM_NOTUSED(privdata
);
5082 return memcmp(key1
, key2
, sizeof(unsigned long)) == 0;
5085 static void JimReferencesHTKeyDestructor(void *privdata
, void *key
)
5087 JIM_NOTUSED(privdata
);
5092 static const Jim_HashTableType JimReferencesHashTableType
= {
5093 JimReferencesHTHashFunction
, /* hash function */
5094 JimReferencesHTKeyDup
, /* key dup */
5096 JimReferencesHTKeyCompare
, /* key compare */
5097 JimReferencesHTKeyDestructor
, /* key destructor */
5098 JimReferencesHTValDestructor
/* val destructor */
5101 /* -----------------------------------------------------------------------------
5102 * Reference object type and References API
5103 * ---------------------------------------------------------------------------*/
5105 /* The string representation of references has two features in order
5106 * to make the GC faster. The first is that every reference starts
5107 * with a non common character '<', in order to make the string matching
5108 * faster. The second is that the reference string rep is 42 characters
5109 * in length, this means that it is not necessary to check any object with a string
5110 * repr < 42, and usually there aren't many of these objects. */
5112 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5114 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, unsigned long id
)
5116 const char *fmt
= "<reference.<%s>.%020lu>";
5118 sprintf(buf
, fmt
, refPtr
->tag
, id
);
5119 return JIM_REFERENCE_SPACE
;
5122 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
5124 static const Jim_ObjType referenceObjType
= {
5128 UpdateStringOfReference
,
5129 JIM_TYPE_REFERENCES
,
5132 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
5134 char buf
[JIM_REFERENCE_SPACE
+ 1];
5136 JimFormatReference(buf
, objPtr
->internalRep
.refValue
.refPtr
, objPtr
->internalRep
.refValue
.id
);
5137 JimSetStringBytes(objPtr
, buf
);
5140 /* returns true if 'c' is a valid reference tag character.
5141 * i.e. inside the range [_a-zA-Z0-9] */
5142 static int isrefchar(int c
)
5144 return (c
== '_' || isalnum(c
));
5147 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5149 unsigned long value
;
5151 const char *str
, *start
, *end
;
5153 Jim_Reference
*refPtr
;
5157 /* Get the string representation */
5158 str
= Jim_GetString(objPtr
, &len
);
5159 /* Check if it looks like a reference */
5160 if (len
< JIM_REFERENCE_SPACE
)
5164 end
= str
+ len
- 1;
5165 while (*start
== ' ')
5167 while (*end
== ' ' && end
> start
)
5169 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
5171 /* <reference.<1234567>.%020> */
5172 if (memcmp(start
, "<reference.<", 12) != 0)
5174 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
5176 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5177 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5178 if (!isrefchar(start
[12 + i
]))
5181 /* Extract info from the reference. */
5182 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
5184 /* Try to convert the ID into an unsigned long */
5185 value
= strtoul(refId
, &endptr
, 10);
5186 if (JimCheckConversion(refId
, endptr
) != JIM_OK
)
5188 /* Check if the reference really exists! */
5189 he
= Jim_FindHashEntry(&interp
->references
, &value
);
5191 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
5194 refPtr
= Jim_GetHashEntryVal(he
);
5195 /* Free the old internal repr and set the new one. */
5196 Jim_FreeIntRep(interp
, objPtr
);
5197 objPtr
->typePtr
= &referenceObjType
;
5198 objPtr
->internalRep
.refValue
.id
= value
;
5199 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5203 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
5207 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5208 * as finalizer command (or NULL if there is no finalizer).
5209 * The returned reference object has refcount = 0. */
5210 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
5212 struct Jim_Reference
*refPtr
;
5218 /* Perform the Garbage Collection if needed. */
5219 Jim_CollectIfNeeded(interp
);
5221 refPtr
= Jim_Alloc(sizeof(*refPtr
));
5222 refPtr
->objPtr
= objPtr
;
5223 Jim_IncrRefCount(objPtr
);
5224 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5226 Jim_IncrRefCount(cmdNamePtr
);
5227 id
= interp
->referenceNextId
++;
5228 Jim_AddHashEntry(&interp
->references
, &id
, refPtr
);
5229 refObjPtr
= Jim_NewObj(interp
);
5230 refObjPtr
->typePtr
= &referenceObjType
;
5231 refObjPtr
->bytes
= NULL
;
5232 refObjPtr
->internalRep
.refValue
.id
= id
;
5233 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5234 interp
->referenceNextId
++;
5235 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5236 * that does not pass the 'isrefchar' test is replaced with '_' */
5237 tag
= Jim_GetString(tagPtr
, &tagLen
);
5238 if (tagLen
> JIM_REFERENCE_TAGLEN
)
5239 tagLen
= JIM_REFERENCE_TAGLEN
;
5240 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5241 if (i
< tagLen
&& isrefchar(tag
[i
]))
5242 refPtr
->tag
[i
] = tag
[i
];
5244 refPtr
->tag
[i
] = '_';
5246 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
5250 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5252 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
5254 return objPtr
->internalRep
.refValue
.refPtr
;
5257 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
5259 Jim_Reference
*refPtr
;
5261 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5263 Jim_IncrRefCount(cmdNamePtr
);
5264 if (refPtr
->finalizerCmdNamePtr
)
5265 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5266 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5270 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
5272 Jim_Reference
*refPtr
;
5274 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5276 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
5280 /* -----------------------------------------------------------------------------
5281 * References Garbage Collection
5282 * ---------------------------------------------------------------------------*/
5284 /* This the hash table type for the "MARK" phase of the GC */
5285 static const Jim_HashTableType JimRefMarkHashTableType
= {
5286 JimReferencesHTHashFunction
, /* hash function */
5287 JimReferencesHTKeyDup
, /* key dup */
5289 JimReferencesHTKeyCompare
, /* key compare */
5290 JimReferencesHTKeyDestructor
, /* key destructor */
5291 NULL
/* val destructor */
5294 /* Performs the garbage collection. */
5295 int Jim_Collect(Jim_Interp
*interp
)
5298 #ifndef JIM_BOOTSTRAP
5299 Jim_HashTable marks
;
5300 Jim_HashTableIterator htiter
;
5304 /* Avoid recursive calls */
5305 if (interp
->lastCollectId
== -1) {
5306 /* Jim_Collect() already running. Return just now. */
5309 interp
->lastCollectId
= -1;
5311 /* Mark all the references found into the 'mark' hash table.
5312 * The references are searched in every live object that
5313 * is of a type that can contain references. */
5314 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
5315 objPtr
= interp
->liveList
;
5317 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
5318 const char *str
, *p
;
5321 /* If the object is of type reference, to get the
5322 * Id is simple... */
5323 if (objPtr
->typePtr
== &referenceObjType
) {
5324 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
5326 printf("MARK (reference): %d refcount: %d\n",
5327 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
5329 objPtr
= objPtr
->nextObjPtr
;
5332 /* Get the string repr of the object we want
5333 * to scan for references. */
5334 p
= str
= Jim_GetString(objPtr
, &len
);
5335 /* Skip objects too little to contain references. */
5336 if (len
< JIM_REFERENCE_SPACE
) {
5337 objPtr
= objPtr
->nextObjPtr
;
5340 /* Extract references from the object string repr. */
5345 if ((p
= strstr(p
, "<reference.<")) == NULL
)
5347 /* Check if it's a valid reference. */
5348 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
5350 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
5352 for (i
= 21; i
<= 40; i
++)
5353 if (!isdigit(UCHAR(p
[i
])))
5356 id
= strtoul(p
+ 21, NULL
, 10);
5358 /* Ok, a reference for the given ID
5359 * was found. Mark it. */
5360 Jim_AddHashEntry(&marks
, &id
, NULL
);
5362 printf("MARK: %d\n", (int)id
);
5364 p
+= JIM_REFERENCE_SPACE
;
5367 objPtr
= objPtr
->nextObjPtr
;
5370 /* Run the references hash table to destroy every reference that
5371 * is not referenced outside (not present in the mark HT). */
5372 JimInitHashTableIterator(&interp
->references
, &htiter
);
5373 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
5374 const unsigned long *refId
;
5375 Jim_Reference
*refPtr
;
5378 /* Check if in the mark phase we encountered
5379 * this reference. */
5380 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
5382 printf("COLLECTING %d\n", (int)*refId
);
5385 /* Drop the reference, but call the
5386 * finalizer first if registered. */
5387 refPtr
= Jim_GetHashEntryVal(he
);
5388 if (refPtr
->finalizerCmdNamePtr
) {
5389 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
5390 Jim_Obj
*objv
[3], *oldResult
;
5392 JimFormatReference(refstr
, refPtr
, *refId
);
5394 objv
[0] = refPtr
->finalizerCmdNamePtr
;
5395 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, JIM_REFERENCE_SPACE
);
5396 objv
[2] = refPtr
->objPtr
;
5398 /* Drop the reference itself */
5399 /* Avoid the finaliser being freed here */
5400 Jim_IncrRefCount(objv
[0]);
5401 /* Don't remove the reference from the hash table just yet
5402 * since that will free refPtr, and hence refPtr->objPtr
5405 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5406 oldResult
= interp
->result
;
5407 Jim_IncrRefCount(oldResult
);
5408 Jim_EvalObjVector(interp
, 3, objv
);
5409 Jim_SetResult(interp
, oldResult
);
5410 Jim_DecrRefCount(interp
, oldResult
);
5412 Jim_DecrRefCount(interp
, objv
[0]);
5414 Jim_DeleteHashEntry(&interp
->references
, refId
);
5417 Jim_FreeHashTable(&marks
);
5418 interp
->lastCollectId
= interp
->referenceNextId
;
5419 interp
->lastCollectTime
= time(NULL
);
5420 #endif /* JIM_BOOTSTRAP */
5424 #define JIM_COLLECT_ID_PERIOD 5000
5425 #define JIM_COLLECT_TIME_PERIOD 300
5427 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
5429 unsigned long elapsedId
;
5432 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
5433 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
5436 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
5437 Jim_Collect(interp
);
5442 int Jim_IsBigEndian(void)
5449 return uval
.c
[0] == 1;
5452 /* -----------------------------------------------------------------------------
5453 * Interpreter related functions
5454 * ---------------------------------------------------------------------------*/
5456 Jim_Interp
*Jim_CreateInterp(void)
5458 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
5460 memset(i
, 0, sizeof(*i
));
5462 i
->maxCallFrameDepth
= JIM_MAX_CALLFRAME_DEPTH
;
5463 i
->maxEvalDepth
= JIM_MAX_EVAL_DEPTH
;
5464 i
->lastCollectTime
= time(NULL
);
5466 /* Note that we can create objects only after the
5467 * interpreter liveList and freeList pointers are
5468 * initialized to NULL. */
5469 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
5470 #ifdef JIM_REFERENCES
5471 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
5473 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
5474 Jim_InitHashTable(&i
->packages
, &JimPackageHashTableType
, NULL
);
5475 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
5476 i
->trueObj
= Jim_NewIntObj(i
, 1);
5477 i
->falseObj
= Jim_NewIntObj(i
, 0);
5478 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
, i
->emptyObj
);
5479 i
->errorFileNameObj
= i
->emptyObj
;
5480 i
->result
= i
->emptyObj
;
5481 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
5482 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
5483 i
->errorProc
= i
->emptyObj
;
5484 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
5485 i
->nullScriptObj
= Jim_NewEmptyStringObj(i
);
5486 Jim_IncrRefCount(i
->emptyObj
);
5487 Jim_IncrRefCount(i
->errorFileNameObj
);
5488 Jim_IncrRefCount(i
->result
);
5489 Jim_IncrRefCount(i
->stackTrace
);
5490 Jim_IncrRefCount(i
->unknown
);
5491 Jim_IncrRefCount(i
->currentScriptObj
);
5492 Jim_IncrRefCount(i
->nullScriptObj
);
5493 Jim_IncrRefCount(i
->errorProc
);
5494 Jim_IncrRefCount(i
->trueObj
);
5495 Jim_IncrRefCount(i
->falseObj
);
5497 /* Initialize key variables every interpreter should contain */
5498 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
5499 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
5501 Jim_SetVariableStrWithStr(i
, "tcl_platform(engine)", "Jim");
5502 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5503 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5504 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5505 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5506 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5507 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5508 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5513 void Jim_FreeInterp(Jim_Interp
*i
)
5515 Jim_CallFrame
*cf
, *cfx
;
5517 Jim_Obj
*objPtr
, *nextObjPtr
;
5519 /* Free the active call frames list - must be done before i->commands is destroyed */
5520 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5522 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5525 Jim_DecrRefCount(i
, i
->emptyObj
);
5526 Jim_DecrRefCount(i
, i
->trueObj
);
5527 Jim_DecrRefCount(i
, i
->falseObj
);
5528 Jim_DecrRefCount(i
, i
->result
);
5529 Jim_DecrRefCount(i
, i
->stackTrace
);
5530 Jim_DecrRefCount(i
, i
->errorProc
);
5531 Jim_DecrRefCount(i
, i
->unknown
);
5532 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5533 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5534 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5535 Jim_FreeHashTable(&i
->commands
);
5536 #ifdef JIM_REFERENCES
5537 Jim_FreeHashTable(&i
->references
);
5539 Jim_FreeHashTable(&i
->packages
);
5540 Jim_Free(i
->prngState
);
5541 Jim_FreeHashTable(&i
->assocData
);
5543 /* Check that the live object list is empty, otherwise
5544 * there is a memory leak. */
5545 #ifdef JIM_MAINTAINER
5546 if (i
->liveList
!= NULL
) {
5547 objPtr
= i
->liveList
;
5549 printf("\n-------------------------------------\n");
5550 printf("Objects still in the free list:\n");
5552 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5554 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5555 printf("%p (%d) %-10s: '%.20s...'\n",
5556 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5559 printf("%p (%d) %-10s: '%s'\n",
5560 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5562 if (objPtr
->typePtr
== &sourceObjType
) {
5563 printf("FILE %s LINE %d\n",
5564 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5565 objPtr
->internalRep
.sourceValue
.lineNumber
);
5567 objPtr
= objPtr
->nextObjPtr
;
5569 printf("-------------------------------------\n\n");
5570 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5574 /* Free all the freed objects. */
5575 objPtr
= i
->freeList
;
5577 nextObjPtr
= objPtr
->nextObjPtr
;
5579 objPtr
= nextObjPtr
;
5582 /* Free the free call frames list */
5583 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5586 Jim_FreeHashTable(&cf
->vars
);
5590 /* Free the interpreter structure. */
5594 /* Returns the call frame relative to the level represented by
5595 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5597 * This function accepts the 'level' argument in the form
5598 * of the commands [uplevel] and [upvar].
5600 * Returns NULL on error.
5602 * Note: for a function accepting a relative integer as level suitable
5603 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5605 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5609 Jim_CallFrame
*framePtr
;
5612 str
= Jim_String(levelObjPtr
);
5613 if (str
[0] == '#') {
5616 level
= jim_strtol(str
+ 1, &endptr
);
5617 if (str
[1] == '\0' || endptr
[0] != '\0') {
5622 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5626 /* Convert from a relative to an absolute level */
5627 level
= interp
->framePtr
->level
- level
;
5632 str
= "1"; /* Needed to format the error message. */
5633 level
= interp
->framePtr
->level
- 1;
5637 return interp
->topFramePtr
;
5641 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5642 if (framePtr
->level
== level
) {
5648 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5652 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5653 * as a relative integer like in the [info level ?level?] command.
5655 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5658 Jim_CallFrame
*framePtr
;
5660 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5662 /* Convert from a relative to an absolute level */
5663 level
= interp
->framePtr
->level
+ level
;
5667 return interp
->topFramePtr
;
5671 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5672 if (framePtr
->level
== level
) {
5678 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5682 static void JimResetStackTrace(Jim_Interp
*interp
)
5684 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5685 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5686 Jim_IncrRefCount(interp
->stackTrace
);
5689 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5693 /* Increment reference first in case these are the same object */
5694 Jim_IncrRefCount(stackTraceObj
);
5695 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5696 interp
->stackTrace
= stackTraceObj
;
5697 interp
->errorFlag
= 1;
5699 /* This is a bit ugly.
5700 * If the filename of the last entry of the stack trace is empty,
5701 * the next stack level should be added.
5703 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5705 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5706 interp
->addStackTrace
= 1;
5711 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5712 Jim_Obj
*fileNameObj
, int linenr
)
5714 if (strcmp(procname
, "unknown") == 0) {
5717 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5718 /* No useful info here */
5722 if (Jim_IsShared(interp
->stackTrace
)) {
5723 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5724 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5725 Jim_IncrRefCount(interp
->stackTrace
);
5728 /* If we have no procname but the previous element did, merge with that frame */
5729 if (!*procname
&& Jim_Length(fileNameObj
)) {
5730 /* Just a filename. Check the previous entry */
5731 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5734 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5735 if (Jim_Length(objPtr
)) {
5736 /* Yes, the previous level had procname */
5737 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5738 if (Jim_Length(objPtr
) == 0) {
5739 /* But no filename, so merge the new info with that frame */
5740 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5741 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5748 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5749 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5750 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5753 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5756 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5758 assocEntryPtr
->delProc
= delProc
;
5759 assocEntryPtr
->data
= data
;
5760 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5763 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5765 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5767 if (entryPtr
!= NULL
) {
5768 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5769 return assocEntryPtr
->data
;
5774 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5776 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5779 int Jim_GetExitCode(Jim_Interp
*interp
)
5781 return interp
->exitCode
;
5784 /* -----------------------------------------------------------------------------
5786 * ---------------------------------------------------------------------------*/
5787 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5788 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5790 static const Jim_ObjType intObjType
= {
5798 /* A coerced double is closer to an int than a double.
5799 * It is an int value temporarily masquerading as a double value.
5800 * i.e. it has the same string value as an int and Jim_GetWide()
5801 * succeeds, but also Jim_GetDouble() returns the value directly.
5803 static const Jim_ObjType coercedDoubleObjType
= {
5812 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5814 char buf
[JIM_INTEGER_SPACE
+ 1];
5815 jim_wide wideValue
= JimWideValue(objPtr
);
5818 if (wideValue
== 0) {
5822 char tmp
[JIM_INTEGER_SPACE
];
5826 if (wideValue
< 0) {
5829 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5830 * whereas C99 is always -6
5831 * coverity[dead_error_line]
5833 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5838 tmp
[num
++] = wideValue
% 10;
5842 for (i
= 0; i
< num
; i
++) {
5843 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5848 JimSetStringBytes(objPtr
, buf
);
5851 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5856 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5858 objPtr
->typePtr
= &intObjType
;
5862 /* Get the string representation */
5863 str
= Jim_String(objPtr
);
5864 /* Try to convert into a jim_wide */
5865 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5866 if (flags
& JIM_ERRMSG
) {
5867 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5871 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5872 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5875 /* Free the old internal repr and set the new one. */
5876 Jim_FreeIntRep(interp
, objPtr
);
5877 objPtr
->typePtr
= &intObjType
;
5878 objPtr
->internalRep
.wideValue
= wideValue
;
5882 #ifdef JIM_OPTIMIZATION
5883 static int JimIsWide(Jim_Obj
*objPtr
)
5885 return objPtr
->typePtr
== &intObjType
;
5889 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5891 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5893 *widePtr
= JimWideValue(objPtr
);
5897 /* Get a wide but does not set an error if the format is bad. */
5898 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5900 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5902 *widePtr
= JimWideValue(objPtr
);
5906 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5911 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5912 if (retval
== JIM_OK
) {
5913 *longPtr
= (long)wideValue
;
5919 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5923 objPtr
= Jim_NewObj(interp
);
5924 objPtr
->typePtr
= &intObjType
;
5925 objPtr
->bytes
= NULL
;
5926 objPtr
->internalRep
.wideValue
= wideValue
;
5930 /* -----------------------------------------------------------------------------
5932 * ---------------------------------------------------------------------------*/
5933 #define JIM_DOUBLE_SPACE 30
5935 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5936 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5938 static const Jim_ObjType doubleObjType
= {
5942 UpdateStringOfDouble
,
5948 #define isnan(X) ((X) != (X))
5952 #define isinf(X) (1.0 / (X) == 0.0)
5955 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5957 double value
= objPtr
->internalRep
.doubleValue
;
5960 JimSetStringBytes(objPtr
, "NaN");
5965 JimSetStringBytes(objPtr
, "-Inf");
5968 JimSetStringBytes(objPtr
, "Inf");
5973 char buf
[JIM_DOUBLE_SPACE
+ 1];
5975 int len
= sprintf(buf
, "%.12g", value
);
5977 /* Add a final ".0" if necessary */
5978 for (i
= 0; i
< len
; i
++) {
5979 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5980 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5981 /* If 'buf' ends in e-0nn or e+0nn, remove
5982 * the 0 after the + or - and reduce the length by 1
5984 char *e
= strchr(buf
, 'e');
5985 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5988 memmove(e
, e
+ 1, len
- (e
- buf
));
5994 if (buf
[i
] == '\0') {
5999 JimSetStringBytes(objPtr
, buf
);
6003 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6009 /* Preserve the string representation.
6010 * Needed so we can convert back to int without loss
6012 str
= Jim_String(objPtr
);
6014 #ifdef HAVE_LONG_LONG
6015 /* Assume a 53 bit mantissa */
6016 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6017 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6019 if (objPtr
->typePtr
== &intObjType
6020 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
6021 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6023 /* Direct conversion to coerced double */
6024 objPtr
->typePtr
= &coercedDoubleObjType
;
6029 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6030 /* Managed to convert to an int, so we can use this as a cooerced double */
6031 Jim_FreeIntRep(interp
, objPtr
);
6032 objPtr
->typePtr
= &coercedDoubleObjType
;
6033 objPtr
->internalRep
.wideValue
= wideValue
;
6037 /* Try to convert into a double */
6038 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6039 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6042 /* Free the old internal repr and set the new one. */
6043 Jim_FreeIntRep(interp
, objPtr
);
6045 objPtr
->typePtr
= &doubleObjType
;
6046 objPtr
->internalRep
.doubleValue
= doubleValue
;
6050 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6052 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6053 *doublePtr
= JimWideValue(objPtr
);
6056 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6059 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6060 *doublePtr
= JimWideValue(objPtr
);
6063 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6068 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6072 objPtr
= Jim_NewObj(interp
);
6073 objPtr
->typePtr
= &doubleObjType
;
6074 objPtr
->bytes
= NULL
;
6075 objPtr
->internalRep
.doubleValue
= doubleValue
;
6079 /* -----------------------------------------------------------------------------
6080 * Boolean conversion
6081 * ---------------------------------------------------------------------------*/
6082 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
6084 int Jim_GetBoolean(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int * booleanPtr
)
6086 if (objPtr
->typePtr
!= &intObjType
&& SetBooleanFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
6088 *booleanPtr
= (int) JimWideValue(objPtr
);
6092 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
6094 static const char * const falses
[] = {
6095 "0", "false", "no", "off", NULL
6097 static const char * const trues
[] = {
6098 "1", "true", "yes", "on", NULL
6104 if (Jim_GetEnum(interp
, objPtr
, falses
, &index
, NULL
, 0) == JIM_OK
) {
6106 } else if (Jim_GetEnum(interp
, objPtr
, trues
, &index
, NULL
, 0) == JIM_OK
) {
6109 if (flags
& JIM_ERRMSG
) {
6110 Jim_SetResultFormatted(interp
, "expected boolean but got \"%#s\"", objPtr
);
6115 /* Free the old internal repr and set the new one. */
6116 Jim_FreeIntRep(interp
, objPtr
);
6117 objPtr
->typePtr
= &intObjType
;
6118 objPtr
->internalRep
.wideValue
= boolean
;
6122 /* -----------------------------------------------------------------------------
6124 * ---------------------------------------------------------------------------*/
6125 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6126 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6127 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6128 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6129 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6130 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6132 /* Note that while the elements of the list may contain references,
6133 * the list object itself can't. This basically means that the
6134 * list object string representation as a whole can't contain references
6135 * that are not presents in the single elements. */
6136 static const Jim_ObjType listObjType
= {
6138 FreeListInternalRep
,
6144 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6148 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6149 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6151 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6154 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6158 JIM_NOTUSED(interp
);
6160 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6161 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6162 dupPtr
->internalRep
.listValue
.ele
=
6163 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6164 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6165 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6166 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6167 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6169 dupPtr
->typePtr
= &listObjType
;
6172 /* The following function checks if a given string can be encoded
6173 * into a list element without any kind of quoting, surrounded by braces,
6174 * or using escapes to quote. */
6175 #define JIM_ELESTR_SIMPLE 0
6176 #define JIM_ELESTR_BRACE 1
6177 #define JIM_ELESTR_QUOTE 2
6178 static unsigned char ListElementQuotingType(const char *s
, int len
)
6180 int i
, level
, blevel
, trySimple
= 1;
6182 /* Try with the SIMPLE case */
6184 return JIM_ELESTR_BRACE
;
6185 if (s
[0] == '"' || s
[0] == '{') {
6189 for (i
= 0; i
< len
; i
++) {
6210 return JIM_ELESTR_SIMPLE
;
6213 /* Test if it's possible to do with braces */
6214 if (s
[len
- 1] == '\\')
6215 return JIM_ELESTR_QUOTE
;
6218 for (i
= 0; i
< len
; i
++) {
6226 return JIM_ELESTR_QUOTE
;
6235 if (s
[i
+ 1] == '\n')
6236 return JIM_ELESTR_QUOTE
;
6237 else if (s
[i
+ 1] != '\0')
6243 return JIM_ELESTR_QUOTE
;
6248 return JIM_ELESTR_BRACE
;
6249 for (i
= 0; i
< len
; i
++) {
6263 return JIM_ELESTR_BRACE
;
6267 return JIM_ELESTR_SIMPLE
;
6269 return JIM_ELESTR_QUOTE
;
6272 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6273 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6275 * Returns the length of the result.
6277 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6330 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6332 #define STATIC_QUOTING_LEN 32
6333 int i
, bufLen
, realLength
;
6336 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6338 /* Estimate the space needed. */
6339 if (objc
> STATIC_QUOTING_LEN
) {
6340 quotingType
= Jim_Alloc(objc
);
6343 quotingType
= staticQuoting
;
6346 for (i
= 0; i
< objc
; i
++) {
6349 strRep
= Jim_GetString(objv
[i
], &len
);
6350 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6351 switch (quotingType
[i
]) {
6352 case JIM_ELESTR_SIMPLE
:
6353 if (i
!= 0 || strRep
[0] != '#') {
6357 /* Special case '#' on first element needs braces */
6358 quotingType
[i
] = JIM_ELESTR_BRACE
;
6360 case JIM_ELESTR_BRACE
:
6363 case JIM_ELESTR_QUOTE
:
6367 bufLen
++; /* elements separator. */
6371 /* Generate the string rep. */
6372 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6374 for (i
= 0; i
< objc
; i
++) {
6377 strRep
= Jim_GetString(objv
[i
], &len
);
6379 switch (quotingType
[i
]) {
6380 case JIM_ELESTR_SIMPLE
:
6381 memcpy(p
, strRep
, len
);
6385 case JIM_ELESTR_BRACE
:
6387 memcpy(p
, strRep
, len
);
6390 realLength
+= len
+ 2;
6392 case JIM_ELESTR_QUOTE
:
6393 if (i
== 0 && strRep
[0] == '#') {
6397 qlen
= BackslashQuoteString(strRep
, len
, p
);
6402 /* Add a separating space */
6403 if (i
+ 1 != objc
) {
6408 *p
= '\0'; /* nul term. */
6409 objPtr
->length
= realLength
;
6411 if (quotingType
!= staticQuoting
) {
6412 Jim_Free(quotingType
);
6416 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6418 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6421 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6423 struct JimParserCtx parser
;
6426 Jim_Obj
*fileNameObj
;
6429 if (objPtr
->typePtr
== &listObjType
) {
6433 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6434 * it also preserves any source location of the dict elements
6435 * which can be very useful
6437 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6438 Jim_Obj
**listObjPtrPtr
;
6442 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6443 for (i
= 0; i
< len
; i
++) {
6444 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6447 /* Now just switch the internal rep */
6448 Jim_FreeIntRep(interp
, objPtr
);
6449 objPtr
->typePtr
= &listObjType
;
6450 objPtr
->internalRep
.listValue
.len
= len
;
6451 objPtr
->internalRep
.listValue
.maxLen
= len
;
6452 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6457 /* Try to preserve information about filename / line number */
6458 if (objPtr
->typePtr
== &sourceObjType
) {
6459 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6460 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6463 fileNameObj
= interp
->emptyObj
;
6466 Jim_IncrRefCount(fileNameObj
);
6468 /* Get the string representation */
6469 str
= Jim_GetString(objPtr
, &strLen
);
6471 /* Free the old internal repr just now and initialize the
6472 * new one just now. The string->list conversion can't fail. */
6473 Jim_FreeIntRep(interp
, objPtr
);
6474 objPtr
->typePtr
= &listObjType
;
6475 objPtr
->internalRep
.listValue
.len
= 0;
6476 objPtr
->internalRep
.listValue
.maxLen
= 0;
6477 objPtr
->internalRep
.listValue
.ele
= NULL
;
6479 /* Convert into a list */
6481 JimParserInit(&parser
, str
, strLen
, linenr
);
6482 while (!parser
.eof
) {
6483 Jim_Obj
*elementPtr
;
6485 JimParseList(&parser
);
6486 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6488 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6489 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6490 ListAppendElement(objPtr
, elementPtr
);
6493 Jim_DecrRefCount(interp
, fileNameObj
);
6497 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6501 objPtr
= Jim_NewObj(interp
);
6502 objPtr
->typePtr
= &listObjType
;
6503 objPtr
->bytes
= NULL
;
6504 objPtr
->internalRep
.listValue
.ele
= NULL
;
6505 objPtr
->internalRep
.listValue
.len
= 0;
6506 objPtr
->internalRep
.listValue
.maxLen
= 0;
6509 ListInsertElements(objPtr
, 0, len
, elements
);
6515 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6516 * length of the vector. Note that the user of this function should make
6517 * sure that the list object can't shimmer while the vector returned
6518 * is in use, this vector is the one stored inside the internal representation
6519 * of the list object. This function is not exported, extensions should
6520 * always access to the List object elements using Jim_ListIndex(). */
6521 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6524 *listLen
= Jim_ListLength(interp
, listObj
);
6525 *listVec
= listObj
->internalRep
.listValue
.ele
;
6528 /* Sorting uses ints, but commands may return wide */
6529 static int JimSign(jim_wide w
)
6540 /* ListSortElements type values */
6556 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6559 static struct lsort_info
*sort_info
;
6561 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6563 Jim_Obj
*lObj
, *rObj
;
6565 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6566 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6567 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6569 return sort_info
->subfn(&lObj
, &rObj
);
6572 /* Sort the internal rep of a list. */
6573 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6575 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6578 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6580 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6583 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6585 jim_wide lhs
= 0, rhs
= 0;
6587 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6588 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6589 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6592 return JimSign(lhs
- rhs
) * sort_info
->order
;
6595 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6597 double lhs
= 0, rhs
= 0;
6599 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6600 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6601 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6607 return sort_info
->order
;
6609 return -sort_info
->order
;
6612 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6614 Jim_Obj
*compare_script
;
6619 /* This must be a valid list */
6620 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6621 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6622 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6624 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6626 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6627 longjmp(sort_info
->jmpbuf
, rc
);
6630 return JimSign(ret
) * sort_info
->order
;
6633 /* Remove duplicate elements from the (sorted) list in-place, according to the
6634 * comparison function, comp.
6636 * Note that the last unique value is kept, not the first
6638 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6642 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6644 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6645 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6646 /* Match, so replace the dest with the current source */
6647 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6650 /* No match, so keep the current source and move to the next destination */
6653 ele
[dst
] = ele
[src
];
6655 /* At end of list, keep the final element */
6656 ele
[++dst
] = ele
[src
];
6658 /* Set the new length */
6659 listObjPtr
->internalRep
.listValue
.len
= dst
;
6662 /* Sort a list *in place*. MUST be called with a non-shared list. */
6663 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6665 struct lsort_info
*prev_info
;
6667 typedef int (qsort_comparator
) (const void *, const void *);
6668 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6673 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6674 SetListFromAny(interp
, listObjPtr
);
6676 /* Allow lsort to be called reentrantly */
6677 prev_info
= sort_info
;
6680 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6681 len
= listObjPtr
->internalRep
.listValue
.len
;
6682 switch (info
->type
) {
6683 case JIM_LSORT_ASCII
:
6684 fn
= ListSortString
;
6686 case JIM_LSORT_NOCASE
:
6687 fn
= ListSortStringNoCase
;
6689 case JIM_LSORT_INTEGER
:
6690 fn
= ListSortInteger
;
6692 case JIM_LSORT_REAL
:
6695 case JIM_LSORT_COMMAND
:
6696 fn
= ListSortCommand
;
6699 fn
= NULL
; /* avoid warning */
6700 JimPanic((1, "ListSort called with invalid sort type"));
6701 return -1; /* Should not be run but keeps static analysers happy */
6704 if (info
->indexed
) {
6705 /* Need to interpose a "list index" function */
6707 fn
= ListSortIndexHelper
;
6710 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6711 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6713 if (info
->unique
&& len
> 1) {
6714 ListRemoveDuplicates(listObjPtr
, fn
);
6717 Jim_InvalidateStringRep(listObjPtr
);
6719 sort_info
= prev_info
;
6724 /* This is the low-level function to insert elements into a list.
6725 * The higher-level Jim_ListInsertElements() performs shared object
6726 * check and invalidates the string repr. This version is used
6727 * in the internals of the List Object and is not exported.
6729 * NOTE: this function can be called only against objects
6730 * with internal type of List.
6732 * An insertion point (idx) of -1 means end-of-list.
6734 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6736 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6737 int requiredLen
= currentLen
+ elemc
;
6741 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6742 if (requiredLen
< 2) {
6743 /* Don't do allocations of under 4 pointers. */
6750 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6751 sizeof(Jim_Obj
*) * requiredLen
);
6753 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6758 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6759 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6760 for (i
= 0; i
< elemc
; ++i
) {
6761 point
[i
] = elemVec
[i
];
6762 Jim_IncrRefCount(point
[i
]);
6764 listPtr
->internalRep
.listValue
.len
+= elemc
;
6767 /* Convenience call to ListInsertElements() to append a single element.
6769 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6771 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6774 /* Appends every element of appendListPtr into listPtr.
6775 * Both have to be of the list type.
6776 * Convenience call to ListInsertElements()
6778 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6780 ListInsertElements(listPtr
, -1,
6781 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6784 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6786 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6787 SetListFromAny(interp
, listPtr
);
6788 Jim_InvalidateStringRep(listPtr
);
6789 ListAppendElement(listPtr
, objPtr
);
6792 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6794 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6795 SetListFromAny(interp
, listPtr
);
6796 SetListFromAny(interp
, appendListPtr
);
6797 Jim_InvalidateStringRep(listPtr
);
6798 ListAppendList(listPtr
, appendListPtr
);
6801 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6803 SetListFromAny(interp
, objPtr
);
6804 return objPtr
->internalRep
.listValue
.len
;
6807 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6808 int objc
, Jim_Obj
*const *objVec
)
6810 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6811 SetListFromAny(interp
, listPtr
);
6812 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6813 idx
= listPtr
->internalRep
.listValue
.len
;
6816 Jim_InvalidateStringRep(listPtr
);
6817 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6820 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6822 SetListFromAny(interp
, listPtr
);
6823 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6824 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6828 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6829 return listPtr
->internalRep
.listValue
.ele
[idx
];
6832 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6834 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6835 if (*objPtrPtr
== NULL
) {
6836 if (flags
& JIM_ERRMSG
) {
6837 Jim_SetResultString(interp
, "list index out of range", -1);
6844 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6845 Jim_Obj
*newObjPtr
, int flags
)
6847 SetListFromAny(interp
, listPtr
);
6848 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6849 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6850 if (flags
& JIM_ERRMSG
) {
6851 Jim_SetResultString(interp
, "list index out of range", -1);
6856 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6857 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6858 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6859 Jim_IncrRefCount(newObjPtr
);
6863 /* Modify the list stored in the variable named 'varNamePtr'
6864 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6865 * with the new element 'newObjptr'. (implements the [lset] command) */
6866 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6867 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6869 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6872 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6875 if ((shared
= Jim_IsShared(objPtr
)))
6876 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6877 for (i
= 0; i
< indexc
- 1; i
++) {
6878 listObjPtr
= objPtr
;
6879 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6881 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6884 if (Jim_IsShared(objPtr
)) {
6885 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6886 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6888 Jim_InvalidateStringRep(listObjPtr
);
6890 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6892 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6894 Jim_InvalidateStringRep(objPtr
);
6895 Jim_InvalidateStringRep(varObjPtr
);
6896 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6898 Jim_SetResult(interp
, varObjPtr
);
6902 Jim_FreeNewObj(interp
, varObjPtr
);
6907 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6910 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6911 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6913 for (i
= 0; i
< listLen
; ) {
6914 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6915 if (++i
!= listLen
) {
6916 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6922 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6926 /* If all the objects in objv are lists,
6927 * it's possible to return a list as result, that's the
6928 * concatenation of all the lists. */
6929 for (i
= 0; i
< objc
; i
++) {
6930 if (!Jim_IsList(objv
[i
]))
6934 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6936 for (i
= 0; i
< objc
; i
++)
6937 ListAppendList(objPtr
, objv
[i
]);
6941 /* Else... we have to glue strings together */
6942 int len
= 0, objLen
;
6945 /* Compute the length */
6946 for (i
= 0; i
< objc
; i
++) {
6947 len
+= Jim_Length(objv
[i
]);
6951 /* Create the string rep, and a string object holding it. */
6952 p
= bytes
= Jim_Alloc(len
+ 1);
6953 for (i
= 0; i
< objc
; i
++) {
6954 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6956 /* Remove leading space */
6957 while (objLen
&& isspace(UCHAR(*s
))) {
6962 /* And trailing space */
6963 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6964 /* Handle trailing backslash-space case */
6965 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6971 memcpy(p
, s
, objLen
);
6973 if (i
+ 1 != objc
) {
6977 /* Drop the space calculated for this
6978 * element that is instead null. */
6984 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6988 /* Returns a list composed of the elements in the specified range.
6989 * first and start are directly accepted as Jim_Objects and
6990 * processed for the end?-index? case. */
6991 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6992 Jim_Obj
*lastObjPtr
)
6997 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6998 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
7000 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
7001 first
= JimRelToAbsIndex(len
, first
);
7002 last
= JimRelToAbsIndex(len
, last
);
7003 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
7004 if (first
== 0 && last
== len
) {
7007 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
7010 /* -----------------------------------------------------------------------------
7012 * ---------------------------------------------------------------------------*/
7013 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
7014 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
7015 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
7016 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7018 /* Dict HashTable Type.
7020 * Keys and Values are Jim objects. */
7022 static unsigned int JimObjectHTHashFunction(const void *key
)
7025 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
7026 return Jim_GenHashFunction((const unsigned char *)str
, len
);
7029 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
7031 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
7034 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
7036 Jim_IncrRefCount((Jim_Obj
*)val
);
7040 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
7042 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
7045 static const Jim_HashTableType JimDictHashTableType
= {
7046 JimObjectHTHashFunction
, /* hash function */
7047 JimObjectHTKeyValDup
, /* key dup */
7048 JimObjectHTKeyValDup
, /* val dup */
7049 JimObjectHTKeyCompare
, /* key compare */
7050 JimObjectHTKeyValDestructor
, /* key destructor */
7051 JimObjectHTKeyValDestructor
/* val destructor */
7054 /* Note that while the elements of the dict may contain references,
7055 * the list object itself can't. This basically means that the
7056 * dict object string representation as a whole can't contain references
7057 * that are not presents in the single elements. */
7058 static const Jim_ObjType dictObjType
= {
7060 FreeDictInternalRep
,
7066 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7068 JIM_NOTUSED(interp
);
7070 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7071 Jim_Free(objPtr
->internalRep
.ptr
);
7074 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7076 Jim_HashTable
*ht
, *dupHt
;
7077 Jim_HashTableIterator htiter
;
7080 /* Create a new hash table */
7081 ht
= srcPtr
->internalRep
.ptr
;
7082 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7083 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7085 Jim_ExpandHashTable(dupHt
, ht
->size
);
7086 /* Copy every element from the source to the dup hash table */
7087 JimInitHashTableIterator(ht
, &htiter
);
7088 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7089 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7092 dupPtr
->internalRep
.ptr
= dupHt
;
7093 dupPtr
->typePtr
= &dictObjType
;
7096 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7099 Jim_HashTableIterator htiter
;
7104 ht
= dictPtr
->internalRep
.ptr
;
7106 /* Turn the hash table into a flat vector of Jim_Objects. */
7107 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7108 JimInitHashTableIterator(ht
, &htiter
);
7110 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7111 objv
[i
++] = Jim_GetHashEntryKey(he
);
7112 objv
[i
++] = Jim_GetHashEntryVal(he
);
7118 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7120 /* Turn the hash table into a flat vector of Jim_Objects. */
7122 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7124 /* And now generate the string rep as a list */
7125 JimMakeListStringRep(objPtr
, objv
, len
);
7130 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7134 if (objPtr
->typePtr
== &dictObjType
) {
7138 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7139 /* A shared list, so get the string representation now to avoid
7140 * changing the order in case of fast conversion to dict.
7145 /* For simplicity, convert a non-list object to a list and then to a dict */
7146 listlen
= Jim_ListLength(interp
, objPtr
);
7148 Jim_SetResultString(interp
, "missing value to go with key", -1);
7152 /* Converting from a list to a dict can't fail */
7156 ht
= Jim_Alloc(sizeof(*ht
));
7157 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7159 for (i
= 0; i
< listlen
; i
+= 2) {
7160 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7161 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7163 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7166 Jim_FreeIntRep(interp
, objPtr
);
7167 objPtr
->typePtr
= &dictObjType
;
7168 objPtr
->internalRep
.ptr
= ht
;
7174 /* Dict object API */
7176 /* Add an element to a dict. objPtr must be of the "dict" type.
7177 * The higher-level exported function is Jim_DictAddElement().
7178 * If an element with the specified key already exists, the value
7179 * associated is replaced with the new one.
7181 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7182 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7183 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7185 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7187 if (valueObjPtr
== NULL
) { /* unset */
7188 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7190 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7194 /* Add an element, higher-level interface for DictAddElement().
7195 * If valueObjPtr == NULL, the key is removed if it exists. */
7196 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7197 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7199 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7200 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7203 Jim_InvalidateStringRep(objPtr
);
7204 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7207 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7212 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7214 objPtr
= Jim_NewObj(interp
);
7215 objPtr
->typePtr
= &dictObjType
;
7216 objPtr
->bytes
= NULL
;
7217 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7218 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7219 for (i
= 0; i
< len
; i
+= 2)
7220 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7224 /* Return the value associated to the specified dict key
7225 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7227 * Sets *objPtrPtr to non-NULL only upon success.
7229 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7230 Jim_Obj
**objPtrPtr
, int flags
)
7235 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7238 ht
= dictPtr
->internalRep
.ptr
;
7239 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7240 if (flags
& JIM_ERRMSG
) {
7241 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7245 *objPtrPtr
= he
->u
.val
;
7249 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7250 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7252 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7255 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7261 /* Return the value associated to the specified dict keys */
7262 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7263 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7268 *objPtrPtr
= dictPtr
;
7272 for (i
= 0; i
< keyc
; i
++) {
7275 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7281 *objPtrPtr
= dictPtr
;
7285 /* Modify the dict stored into the variable named 'varNamePtr'
7286 * setting the element specified by the 'keyc' keys objects in 'keyv',
7287 * with the new value of the element 'newObjPtr'.
7289 * If newObjPtr == NULL the operation is to remove the given key
7290 * from the dictionary.
7292 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7293 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7295 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7296 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7298 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7301 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7302 if (objPtr
== NULL
) {
7303 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7304 /* Cannot remove a key from non existing var */
7307 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7308 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7309 Jim_FreeNewObj(interp
, varObjPtr
);
7313 if ((shared
= Jim_IsShared(objPtr
)))
7314 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7315 for (i
= 0; i
< keyc
; i
++) {
7316 dictObjPtr
= objPtr
;
7318 /* Check if it's a valid dictionary */
7319 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7323 if (i
== keyc
- 1) {
7324 /* Last key: Note that error on unset with missing last key is OK */
7325 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7326 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7333 /* Check if the given key exists. */
7334 Jim_InvalidateStringRep(dictObjPtr
);
7335 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7336 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7337 /* This key exists at the current level.
7338 * Make sure it's not shared!. */
7339 if (Jim_IsShared(objPtr
)) {
7340 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7341 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7345 /* Key not found. If it's an [unset] operation
7346 * this is an error. Only the last key may not
7348 if (newObjPtr
== NULL
) {
7351 /* Otherwise set an empty dictionary
7352 * as key's value. */
7353 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7354 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7357 /* XXX: Is this necessary? */
7358 Jim_InvalidateStringRep(objPtr
);
7359 Jim_InvalidateStringRep(varObjPtr
);
7360 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7363 Jim_SetResult(interp
, varObjPtr
);
7367 Jim_FreeNewObj(interp
, varObjPtr
);
7372 /* -----------------------------------------------------------------------------
7374 * ---------------------------------------------------------------------------*/
7375 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7376 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7378 static const Jim_ObjType indexObjType
= {
7382 UpdateStringOfIndex
,
7386 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7388 if (objPtr
->internalRep
.intValue
== -1) {
7389 JimSetStringBytes(objPtr
, "end");
7392 char buf
[JIM_INTEGER_SPACE
+ 1];
7393 if (objPtr
->internalRep
.intValue
>= 0) {
7394 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7398 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7400 JimSetStringBytes(objPtr
, buf
);
7404 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7410 /* Get the string representation */
7411 str
= Jim_String(objPtr
);
7413 /* Try to convert into an index */
7414 if (strncmp(str
, "end", 3) == 0) {
7420 idx
= jim_strtol(str
, &endptr
);
7422 if (endptr
== str
) {
7428 /* Now str may include or +<num> or -<num> */
7429 if (*str
== '+' || *str
== '-') {
7430 int sign
= (*str
== '+' ? 1 : -1);
7432 idx
+= sign
* jim_strtol(++str
, &endptr
);
7433 if (str
== endptr
|| *endptr
) {
7438 /* The only thing left should be spaces */
7439 while (isspace(UCHAR(*str
))) {
7450 /* end-1 is repesented as -2 */
7458 /* Free the old internal repr and set the new one. */
7459 Jim_FreeIntRep(interp
, objPtr
);
7460 objPtr
->typePtr
= &indexObjType
;
7461 objPtr
->internalRep
.intValue
= idx
;
7465 Jim_SetResultFormatted(interp
,
7466 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7470 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7472 /* Avoid shimmering if the object is an integer. */
7473 if (objPtr
->typePtr
== &intObjType
) {
7474 jim_wide val
= JimWideValue(objPtr
);
7477 *indexPtr
= -INT_MAX
;
7478 else if (val
> INT_MAX
)
7479 *indexPtr
= INT_MAX
;
7481 *indexPtr
= (int)val
;
7484 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7486 *indexPtr
= objPtr
->internalRep
.intValue
;
7490 /* -----------------------------------------------------------------------------
7491 * Return Code Object.
7492 * ---------------------------------------------------------------------------*/
7494 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7495 static const char * const jimReturnCodes
[] = {
7507 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7509 static const Jim_ObjType returnCodeObjType
= {
7517 /* Converts a (standard) return code to a string. Returns "?" for
7518 * non-standard return codes.
7520 const char *Jim_ReturnCode(int code
)
7522 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7526 return jimReturnCodes
[code
];
7530 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7535 /* Try to convert into an integer */
7536 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7537 returnCode
= (int)wideValue
;
7538 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7539 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7542 /* Free the old internal repr and set the new one. */
7543 Jim_FreeIntRep(interp
, objPtr
);
7544 objPtr
->typePtr
= &returnCodeObjType
;
7545 objPtr
->internalRep
.intValue
= returnCode
;
7549 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7551 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7553 *intPtr
= objPtr
->internalRep
.intValue
;
7557 /* -----------------------------------------------------------------------------
7558 * Expression Parsing
7559 * ---------------------------------------------------------------------------*/
7560 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7561 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7562 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7563 static int JimParseExprBoolean(struct JimParserCtx
*pc
);
7565 /* Exrp's Stack machine operators opcodes. */
7567 /* Binary operators (numbers) */
7570 /* Continues on from the JIM_TT_ space */
7572 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7587 JIM_EXPROP_BITAND
, /* 35 */
7591 /* Note must keep these together */
7592 JIM_EXPROP_LOGICAND
, /* 38 */
7593 JIM_EXPROP_LOGICAND_LEFT
,
7594 JIM_EXPROP_LOGICAND_RIGHT
,
7597 JIM_EXPROP_LOGICOR
, /* 41 */
7598 JIM_EXPROP_LOGICOR_LEFT
,
7599 JIM_EXPROP_LOGICOR_RIGHT
,
7602 /* Ternary operators */
7603 JIM_EXPROP_TERNARY
, /* 44 */
7604 JIM_EXPROP_TERNARY_LEFT
,
7605 JIM_EXPROP_TERNARY_RIGHT
,
7608 JIM_EXPROP_COLON
, /* 47 */
7609 JIM_EXPROP_COLON_LEFT
,
7610 JIM_EXPROP_COLON_RIGHT
,
7612 JIM_EXPROP_POW
, /* 50 */
7614 /* Binary operators (strings) */
7615 JIM_EXPROP_STREQ
, /* 51 */
7620 /* Unary operators (numbers) */
7621 JIM_EXPROP_NOT
, /* 55 */
7623 JIM_EXPROP_UNARYMINUS
,
7624 JIM_EXPROP_UNARYPLUS
,
7627 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7628 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7629 JIM_EXPROP_FUNC_WIDE
,
7630 JIM_EXPROP_FUNC_ABS
,
7631 JIM_EXPROP_FUNC_DOUBLE
,
7632 JIM_EXPROP_FUNC_ROUND
,
7633 JIM_EXPROP_FUNC_RAND
,
7634 JIM_EXPROP_FUNC_SRAND
,
7636 /* math functions from libm */
7637 JIM_EXPROP_FUNC_SIN
, /* 65 */
7638 JIM_EXPROP_FUNC_COS
,
7639 JIM_EXPROP_FUNC_TAN
,
7640 JIM_EXPROP_FUNC_ASIN
,
7641 JIM_EXPROP_FUNC_ACOS
,
7642 JIM_EXPROP_FUNC_ATAN
,
7643 JIM_EXPROP_FUNC_ATAN2
,
7644 JIM_EXPROP_FUNC_SINH
,
7645 JIM_EXPROP_FUNC_COSH
,
7646 JIM_EXPROP_FUNC_TANH
,
7647 JIM_EXPROP_FUNC_CEIL
,
7648 JIM_EXPROP_FUNC_FLOOR
,
7649 JIM_EXPROP_FUNC_EXP
,
7650 JIM_EXPROP_FUNC_LOG
,
7651 JIM_EXPROP_FUNC_LOG10
,
7652 JIM_EXPROP_FUNC_SQRT
,
7653 JIM_EXPROP_FUNC_POW
,
7654 JIM_EXPROP_FUNC_HYPOT
,
7655 JIM_EXPROP_FUNC_FMOD
,
7666 /* Operators table */
7667 typedef struct Jim_ExprOperator
7670 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7671 unsigned char precedence
;
7672 unsigned char arity
;
7674 unsigned char namelen
;
7677 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7679 Jim_IncrRefCount(obj
);
7680 e
->stack
[e
->stacklen
++] = obj
;
7683 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7685 return e
->stack
[--e
->stacklen
];
7688 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7692 Jim_Obj
*A
= ExprPop(e
);
7694 jim_wide wA
, wC
= 0;
7696 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7697 switch (e
->opcode
) {
7698 case JIM_EXPROP_FUNC_INT
:
7699 case JIM_EXPROP_FUNC_WIDE
:
7700 case JIM_EXPROP_FUNC_ROUND
:
7701 case JIM_EXPROP_UNARYPLUS
:
7704 case JIM_EXPROP_FUNC_DOUBLE
:
7708 case JIM_EXPROP_FUNC_ABS
:
7709 wC
= wA
>= 0 ? wA
: -wA
;
7711 case JIM_EXPROP_UNARYMINUS
:
7714 case JIM_EXPROP_NOT
:
7721 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7722 switch (e
->opcode
) {
7723 case JIM_EXPROP_FUNC_INT
:
7724 case JIM_EXPROP_FUNC_WIDE
:
7727 case JIM_EXPROP_FUNC_ROUND
:
7728 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7730 case JIM_EXPROP_FUNC_DOUBLE
:
7731 case JIM_EXPROP_UNARYPLUS
:
7735 case JIM_EXPROP_FUNC_ABS
:
7736 dC
= dA
>= 0 ? dA
: -dA
;
7739 case JIM_EXPROP_UNARYMINUS
:
7743 case JIM_EXPROP_NOT
:
7753 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7756 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7760 Jim_DecrRefCount(interp
, A
);
7765 static double JimRandDouble(Jim_Interp
*interp
)
7768 JimRandomBytes(interp
, &x
, sizeof(x
));
7770 return (double)x
/ (unsigned long)~0;
7773 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7775 Jim_Obj
*A
= ExprPop(e
);
7778 int rc
= Jim_GetWide(interp
, A
, &wA
);
7780 switch (e
->opcode
) {
7781 case JIM_EXPROP_BITNOT
:
7782 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7784 case JIM_EXPROP_FUNC_SRAND
:
7785 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7786 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7793 Jim_DecrRefCount(interp
, A
);
7798 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7800 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7802 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7807 #ifdef JIM_MATH_FUNCTIONS
7808 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7811 Jim_Obj
*A
= ExprPop(e
);
7814 rc
= Jim_GetDouble(interp
, A
, &dA
);
7816 switch (e
->opcode
) {
7817 case JIM_EXPROP_FUNC_SIN
:
7820 case JIM_EXPROP_FUNC_COS
:
7823 case JIM_EXPROP_FUNC_TAN
:
7826 case JIM_EXPROP_FUNC_ASIN
:
7829 case JIM_EXPROP_FUNC_ACOS
:
7832 case JIM_EXPROP_FUNC_ATAN
:
7835 case JIM_EXPROP_FUNC_SINH
:
7838 case JIM_EXPROP_FUNC_COSH
:
7841 case JIM_EXPROP_FUNC_TANH
:
7844 case JIM_EXPROP_FUNC_CEIL
:
7847 case JIM_EXPROP_FUNC_FLOOR
:
7850 case JIM_EXPROP_FUNC_EXP
:
7853 case JIM_EXPROP_FUNC_LOG
:
7856 case JIM_EXPROP_FUNC_LOG10
:
7859 case JIM_EXPROP_FUNC_SQRT
:
7865 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7868 Jim_DecrRefCount(interp
, A
);
7874 /* A binary operation on two ints */
7875 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7877 Jim_Obj
*B
= ExprPop(e
);
7878 Jim_Obj
*A
= ExprPop(e
);
7882 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7887 switch (e
->opcode
) {
7888 case JIM_EXPROP_LSHIFT
:
7891 case JIM_EXPROP_RSHIFT
:
7894 case JIM_EXPROP_BITAND
:
7897 case JIM_EXPROP_BITXOR
:
7900 case JIM_EXPROP_BITOR
:
7903 case JIM_EXPROP_MOD
:
7906 Jim_SetResultString(interp
, "Division by zero", -1);
7913 * This code is tricky: C doesn't guarantee much
7914 * about the quotient or remainder, but Tcl does.
7915 * The remainder always has the same sign as the
7916 * divisor and a smaller absolute value.
7934 case JIM_EXPROP_ROTL
:
7935 case JIM_EXPROP_ROTR
:{
7936 /* uint32_t would be better. But not everyone has inttypes.h? */
7937 unsigned long uA
= (unsigned long)wA
;
7938 unsigned long uB
= (unsigned long)wB
;
7939 const unsigned int S
= sizeof(unsigned long) * 8;
7941 /* Shift left by the word size or more is undefined. */
7944 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7947 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7953 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7957 Jim_DecrRefCount(interp
, A
);
7958 Jim_DecrRefCount(interp
, B
);
7964 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7965 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7968 double dA
, dB
, dC
= 0;
7969 jim_wide wA
, wB
, wC
= 0;
7971 Jim_Obj
*B
= ExprPop(e
);
7972 Jim_Obj
*A
= ExprPop(e
);
7974 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7975 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7976 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7980 switch (e
->opcode
) {
7981 case JIM_EXPROP_POW
:
7982 case JIM_EXPROP_FUNC_POW
:
7983 if (wA
== 0 && wB
< 0) {
7984 Jim_SetResultString(interp
, "exponentiation of zero by negative power", -1);
7988 wC
= JimPowWide(wA
, wB
);
7990 case JIM_EXPROP_ADD
:
7993 case JIM_EXPROP_SUB
:
7996 case JIM_EXPROP_MUL
:
7999 case JIM_EXPROP_DIV
:
8001 Jim_SetResultString(interp
, "Division by zero", -1);
8009 * This code is tricky: C doesn't guarantee much
8010 * about the quotient or remainder, but Tcl does.
8011 * The remainder always has the same sign as the
8012 * divisor and a smaller absolute value.
8030 case JIM_EXPROP_LTE
:
8033 case JIM_EXPROP_GTE
:
8036 case JIM_EXPROP_NUMEQ
:
8039 case JIM_EXPROP_NUMNE
:
8044 if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
8045 switch (e
->opcode
) {
8046 #ifndef JIM_MATH_FUNCTIONS
8047 case JIM_EXPROP_POW
:
8048 case JIM_EXPROP_FUNC_POW
:
8049 case JIM_EXPROP_FUNC_ATAN2
:
8050 case JIM_EXPROP_FUNC_HYPOT
:
8051 case JIM_EXPROP_FUNC_FMOD
:
8052 Jim_SetResultString(interp
, "unsupported", -1);
8056 case JIM_EXPROP_POW
:
8057 case JIM_EXPROP_FUNC_POW
:
8060 case JIM_EXPROP_FUNC_ATAN2
:
8063 case JIM_EXPROP_FUNC_HYPOT
:
8066 case JIM_EXPROP_FUNC_FMOD
:
8070 case JIM_EXPROP_ADD
:
8073 case JIM_EXPROP_SUB
:
8076 case JIM_EXPROP_MUL
:
8079 case JIM_EXPROP_DIV
:
8082 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
8084 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8097 case JIM_EXPROP_LTE
:
8100 case JIM_EXPROP_GTE
:
8103 case JIM_EXPROP_NUMEQ
:
8106 case JIM_EXPROP_NUMNE
:
8112 /* Handle the string case */
8114 /* XXX: Could optimise the eq/ne case by checking lengths */
8115 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8117 switch (e
->opcode
) {
8124 case JIM_EXPROP_LTE
:
8127 case JIM_EXPROP_GTE
:
8130 case JIM_EXPROP_NUMEQ
:
8133 case JIM_EXPROP_NUMNE
:
8138 /* If we get here, it is an error */
8141 Jim_DecrRefCount(interp
, A
);
8142 Jim_DecrRefCount(interp
, B
);
8145 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8148 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8152 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8157 listlen
= Jim_ListLength(interp
, listObjPtr
);
8158 for (i
= 0; i
< listlen
; i
++) {
8159 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8166 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8168 Jim_Obj
*B
= ExprPop(e
);
8169 Jim_Obj
*A
= ExprPop(e
);
8173 switch (e
->opcode
) {
8174 case JIM_EXPROP_STREQ
:
8175 case JIM_EXPROP_STRNE
:
8176 wC
= Jim_StringEqObj(A
, B
);
8177 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8181 case JIM_EXPROP_STRIN
:
8182 wC
= JimSearchList(interp
, B
, A
);
8184 case JIM_EXPROP_STRNI
:
8185 wC
= !JimSearchList(interp
, B
, A
);
8190 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8192 Jim_DecrRefCount(interp
, A
);
8193 Jim_DecrRefCount(interp
, B
);
8198 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8204 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8207 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8210 if (Jim_GetBoolean(interp
, obj
, &b
) == JIM_OK
) {
8216 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8218 Jim_Obj
*skip
= ExprPop(e
);
8219 Jim_Obj
*A
= ExprPop(e
);
8222 switch (ExprBool(interp
, A
)) {
8224 /* false, so skip RHS opcodes with a 0 result */
8225 e
->skip
= JimWideValue(skip
);
8226 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8230 /* true so continue */
8237 Jim_DecrRefCount(interp
, A
);
8238 Jim_DecrRefCount(interp
, skip
);
8243 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8245 Jim_Obj
*skip
= ExprPop(e
);
8246 Jim_Obj
*A
= ExprPop(e
);
8249 switch (ExprBool(interp
, A
)) {
8251 /* false, so do nothing */
8255 /* true so skip RHS opcodes with a 1 result */
8256 e
->skip
= JimWideValue(skip
);
8257 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8265 Jim_DecrRefCount(interp
, A
);
8266 Jim_DecrRefCount(interp
, skip
);
8271 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8273 Jim_Obj
*A
= ExprPop(e
);
8276 switch (ExprBool(interp
, A
)) {
8278 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8282 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8290 Jim_DecrRefCount(interp
, A
);
8295 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8297 Jim_Obj
*skip
= ExprPop(e
);
8298 Jim_Obj
*A
= ExprPop(e
);
8304 switch (ExprBool(interp
, A
)) {
8306 /* false, skip RHS opcodes */
8307 e
->skip
= JimWideValue(skip
);
8308 /* Push a dummy value */
8309 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8313 /* true so do nothing */
8321 Jim_DecrRefCount(interp
, A
);
8322 Jim_DecrRefCount(interp
, skip
);
8327 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8329 Jim_Obj
*skip
= ExprPop(e
);
8330 Jim_Obj
*B
= ExprPop(e
);
8331 Jim_Obj
*A
= ExprPop(e
);
8333 /* No need to check for A as non-boolean */
8334 if (ExprBool(interp
, A
)) {
8335 /* true, so skip RHS opcodes */
8336 e
->skip
= JimWideValue(skip
);
8337 /* Repush B as the answer */
8341 Jim_DecrRefCount(interp
, skip
);
8342 Jim_DecrRefCount(interp
, A
);
8343 Jim_DecrRefCount(interp
, B
);
8347 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8358 RIGHT_ASSOC
, /* reuse this field for right associativity too */
8361 /* name - precedence - arity - opcode
8363 * This array *must* be kept in sync with the JIM_EXPROP enum.
8365 * The following macros pre-compute the string length at compile time.
8367 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8368 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8370 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8371 OPRINIT("*", 110, 2, JimExprOpBin
),
8372 OPRINIT("/", 110, 2, JimExprOpBin
),
8373 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8375 OPRINIT("-", 100, 2, JimExprOpBin
),
8376 OPRINIT("+", 100, 2, JimExprOpBin
),
8378 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8379 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8381 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8382 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8384 OPRINIT("<", 80, 2, JimExprOpBin
),
8385 OPRINIT(">", 80, 2, JimExprOpBin
),
8386 OPRINIT("<=", 80, 2, JimExprOpBin
),
8387 OPRINIT(">=", 80, 2, JimExprOpBin
),
8389 OPRINIT("==", 70, 2, JimExprOpBin
),
8390 OPRINIT("!=", 70, 2, JimExprOpBin
),
8392 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8393 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8394 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8396 OPRINIT_ATTR("&&", 10, 2, NULL
, LAZY_OP
),
8397 OPRINIT_ATTR(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8398 OPRINIT_ATTR(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8400 OPRINIT_ATTR("||", 9, 2, NULL
, LAZY_OP
),
8401 OPRINIT_ATTR(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8402 OPRINIT_ATTR(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8404 OPRINIT_ATTR("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8405 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8406 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8408 OPRINIT_ATTR(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8409 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8410 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8412 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8413 OPRINIT_ATTR("**", 120, 2, JimExprOpBin
, RIGHT_ASSOC
),
8415 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8416 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8418 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8419 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8421 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8422 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8423 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8424 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8428 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8429 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8430 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8431 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8432 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8433 OPRINIT("rand", 200, 0, JimExprOpNone
),
8434 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8436 #ifdef JIM_MATH_FUNCTIONS
8437 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8438 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8439 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8440 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8441 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8442 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8443 OPRINIT("atan2", 200, 2, JimExprOpBin
),
8444 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8445 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8446 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8447 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8448 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8449 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8450 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8451 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8452 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8453 OPRINIT("pow", 200, 2, JimExprOpBin
),
8454 OPRINIT("hypot", 200, 2, JimExprOpBin
),
8455 OPRINIT("fmod", 200, 2, JimExprOpBin
),
8461 #define JIM_EXPR_OPERATORS_NUM \
8462 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8464 static int JimParseExpression(struct JimParserCtx
*pc
)
8466 /* Discard spaces and quoted newline */
8467 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8468 if (*pc
->p
== '\n') {
8476 pc
->tline
= pc
->linenr
;
8481 pc
->tt
= JIM_TT_EOL
;
8487 pc
->tt
= JIM_TT_SUBEXPR_START
;
8490 pc
->tt
= JIM_TT_SUBEXPR_END
;
8493 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8500 return JimParseCmd(pc
);
8502 if (JimParseVar(pc
) == JIM_ERR
)
8503 return JimParseExprOperator(pc
);
8505 /* Don't allow expr sugar in expressions */
8506 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8523 return JimParseExprNumber(pc
);
8525 return JimParseQuote(pc
);
8527 return JimParseBrace(pc
);
8533 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8534 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8535 return JimParseExprOperator(pc
);
8541 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8542 return JimParseExprOperator(pc
);
8545 return JimParseExprOperator(pc
);
8551 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8555 /* Assume an integer for now */
8556 pc
->tt
= JIM_TT_EXPR_INT
;
8558 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8559 /* Tried as an integer, but perhaps it parses as a double */
8560 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8561 /* Some stupid compilers insist they are cleverer that
8562 * we are. Even a (void) cast doesn't prevent this warning!
8564 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8565 if (end
== pc
->tstart
)
8568 /* Yes, double captured more chars */
8569 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8573 pc
->tend
= pc
->p
- 1;
8574 pc
->len
-= (pc
->p
- pc
->tstart
);
8578 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8580 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8583 for (i
= 0; irrationals
[i
]; i
++) {
8584 const char *irr
= irrationals
[i
];
8586 if (strncmp(irr
, pc
->p
, 3) == 0) {
8589 pc
->tend
= pc
->p
- 1;
8590 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8597 static int JimParseExprBoolean(struct JimParserCtx
*pc
)
8599 const char *booleans
[] = { "false", "no", "off", "true", "yes", "on", NULL
};
8600 const int lengths
[] = { 5, 2, 3, 4, 3, 2, 0 };
8603 for (i
= 0; booleans
[i
]; i
++) {
8604 const char *boolean
= booleans
[i
];
8605 int length
= lengths
[i
];
8607 if (strncmp(boolean
, pc
->p
, length
) == 0) {
8610 pc
->tend
= pc
->p
- 1;
8611 pc
->tt
= JIM_TT_EXPR_BOOLEAN
;
8618 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8621 int bestIdx
= -1, bestLen
= 0;
8623 /* Try to get the longest match. */
8624 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8625 const char * const opname
= Jim_ExprOperators
[i
].name
;
8626 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8628 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8632 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8633 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8637 if (bestIdx
== -1) {
8641 /* Validate paretheses around function arguments */
8642 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8643 const char *p
= pc
->p
+ bestLen
;
8644 int len
= pc
->len
- bestLen
;
8646 while (len
&& isspace(UCHAR(*p
))) {
8654 pc
->tend
= pc
->p
+ bestLen
- 1;
8662 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8664 static Jim_ExprOperator dummy_op
;
8665 if (opcode
< JIM_TT_EXPR_OP
) {
8668 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8671 const char *jim_tt_name(int type
)
8673 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8674 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8675 "DBL", "BOO", "$()" };
8676 if (type
< JIM_TT_EXPR_OP
) {
8677 return tt_names
[type
];
8679 else if (type
== JIM_EXPROP_UNARYMINUS
) {
8682 else if (type
== JIM_EXPROP_UNARYPLUS
) {
8686 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8687 static char buf
[20];
8692 sprintf(buf
, "(%d)", type
);
8697 /* -----------------------------------------------------------------------------
8699 * ---------------------------------------------------------------------------*/
8700 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8701 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8702 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8704 static const Jim_ObjType exprObjType
= {
8706 FreeExprInternalRep
,
8709 JIM_TYPE_REFERENCES
,
8712 /* Expr bytecode structure */
8713 typedef struct ExprByteCode
8715 ScriptToken
*token
; /* Tokens array. */
8716 int len
; /* Length as number of tokens. */
8717 int inUse
; /* Used for sharing. */
8720 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8724 for (i
= 0; i
< expr
->len
; i
++) {
8725 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8727 Jim_Free(expr
->token
);
8731 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8733 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8736 if (--expr
->inUse
!= 0) {
8740 ExprFreeByteCode(interp
, expr
);
8744 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8746 JIM_NOTUSED(interp
);
8747 JIM_NOTUSED(srcPtr
);
8749 /* Just returns an simple string. */
8750 dupPtr
->typePtr
= NULL
;
8753 /* Check if an expr program looks correct
8754 * Sets an error result on invalid
8756 static int ExprCheckCorrectness(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, ExprByteCode
* expr
)
8761 int lasttt
= JIM_TT_NONE
;
8764 /* Try to check if there are stack underflows,
8765 * and make sure at the end of the program there is
8766 * a single result on the stack. */
8767 for (i
= 0; i
< expr
->len
; i
++) {
8768 ScriptToken
*t
= &expr
->token
[i
];
8769 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8772 stacklen
-= op
->arity
;
8777 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8780 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8784 /* All operations and operands add one to the stack */
8787 if (stacklen
== 1 && ternary
== 0) {
8791 if (stacklen
<= 0) {
8793 if (lasttt
>= JIM_EXPROP_FUNC_FIRST
) {
8794 errmsg
= "too few arguments for math function";
8795 Jim_SetResultString(interp
, "too few arguments for math function", -1);
8797 errmsg
= "premature end of expression";
8800 else if (stacklen
> 1) {
8801 if (lasttt
>= JIM_EXPROP_FUNC_FIRST
) {
8802 errmsg
= "too many arguments for math function";
8804 errmsg
= "extra tokens at end of expression";
8808 errmsg
= "invalid ternary expression";
8810 Jim_SetResultFormatted(interp
, "syntax error in expression \"%#s\": %s", exprObjPtr
, errmsg
);
8814 /* This procedure converts every occurrence of || and && opereators
8815 * in lazy unary versions.
8817 * a b || is converted into:
8819 * a <offset> |L b |R
8821 * a b && is converted into:
8823 * a <offset> &L b &R
8825 * "|L" checks if 'a' is true:
8826 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8827 * the opcode just after |R.
8828 * 2) if it is false does nothing.
8829 * "|R" checks if 'b' is true:
8830 * 1) if it is true pushes 1, otherwise pushes 0.
8832 * "&L" checks if 'a' is true:
8833 * 1) if it is true does nothing.
8834 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8835 * the opcode just after &R
8836 * "&R" checks if 'a' is true:
8837 * if it is true pushes 1, otherwise pushes 0.
8839 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8843 int leftindex
, arity
, offset
;
8845 /* Search for the end of the first operator */
8846 leftindex
= expr
->len
- 1;
8850 ScriptToken
*tt
= &expr
->token
[leftindex
];
8852 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8853 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8856 if (--leftindex
< 0) {
8863 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8864 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8866 offset
= (expr
->len
- leftindex
) - 1;
8868 /* Now we rely on the fact that the left and right version have opcodes
8869 * 1 and 2 after the main opcode respectively
8871 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8872 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8874 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8875 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8877 /* Now add the 'R' operator */
8878 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8879 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8882 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8883 for (i
= leftindex
- 1; i
> 0; i
--) {
8884 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8885 if (op
->lazy
== LAZY_LEFT
) {
8886 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8887 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8894 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8896 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8897 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8899 if (op
->lazy
== LAZY_OP
) {
8900 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8901 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8906 token
->objPtr
= interp
->emptyObj
;
8907 token
->type
= t
->type
;
8914 * Returns the index of the COLON_LEFT to the left of 'right_index'
8915 * taking into account nesting.
8917 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8919 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8921 int ternary_count
= 1;
8925 while (right_index
> 1) {
8926 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8929 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8932 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8943 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8945 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8946 * Otherwise returns 0.
8948 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8950 int i
= right_index
- 1;
8951 int ternary_count
= 1;
8954 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8955 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8956 *prev_right_index
= i
- 2;
8957 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8961 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8962 if (ternary_count
== 0) {
8973 * ExprTernaryReorderExpression description
8974 * ========================================
8976 * ?: is right-to-left associative which doesn't work with the stack-based
8977 * expression engine. The fix is to reorder the bytecode.
8983 * Has initial bytecode:
8985 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8986 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8988 * The fix involves simulating this expression instead:
8992 * With the following bytecode:
8994 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8995 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8997 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8998 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8999 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9000 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9002 * ExprTernaryReorderExpression works thus as follows :
9003 * - start from the end of the stack
9004 * - while walking towards the beginning of the stack
9005 * if token=JIM_EXPROP_COLON_RIGHT then
9006 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9007 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9008 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9010 * perform the rotation
9011 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9015 * Note: care has to be taken for nested ternary constructs!!!
9017 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
9021 for (i
= expr
->len
- 1; i
> 1; i
--) {
9022 int prev_right_index
;
9023 int prev_left_index
;
9027 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
9031 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9032 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
9037 ** rotate tokens down
9039 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9048 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9050 tmp
= expr
->token
[prev_right_index
];
9051 for (j
= prev_right_index
; j
< i
; j
++) {
9052 expr
->token
[j
] = expr
->token
[j
+ 1];
9054 expr
->token
[i
] = tmp
;
9056 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9058 * This is 'colon left increment' = i - prev_right_index
9060 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9061 * [prev_left_index-1] : skip_count
9064 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
9066 /* Adjust for i-- in the loop */
9071 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*exprObjPtr
, Jim_Obj
*fileNameObj
)
9077 int prevtt
= JIM_TT_NONE
;
9078 int have_ternary
= 0;
9081 int count
= tokenlist
->count
- 1;
9083 expr
= Jim_Alloc(sizeof(*expr
));
9087 Jim_InitStack(&stack
);
9089 /* Need extra bytecodes for lazy operators.
9090 * Also check for the ternary operator
9092 for (i
= 0; i
< tokenlist
->count
; i
++) {
9093 ParseToken
*t
= &tokenlist
->list
[i
];
9094 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
9096 if (op
->lazy
== LAZY_OP
) {
9098 /* Ternary is a lazy op but also needs reordering */
9099 if (t
->type
== JIM_EXPROP_TERNARY
) {
9105 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
9107 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
9108 ParseToken
*t
= &tokenlist
->list
[i
];
9110 /* Next token will be stored here */
9111 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
9113 if (t
->type
== JIM_TT_EOL
) {
9117 if (TOKEN_IS_EXPR_OP(t
->type
)) {
9118 const struct Jim_ExprOperator
*op
;
9121 /* Convert -/+ to unary minus or unary plus if necessary */
9122 if (prevtt
== JIM_TT_NONE
|| prevtt
== JIM_TT_SUBEXPR_START
|| prevtt
== JIM_TT_SUBEXPR_COMMA
|| prevtt
>= JIM_TT_EXPR_OP
) {
9123 if (t
->type
== JIM_EXPROP_SUB
) {
9124 t
->type
= JIM_EXPROP_UNARYMINUS
;
9126 else if (t
->type
== JIM_EXPROP_ADD
) {
9127 t
->type
= JIM_EXPROP_UNARYPLUS
;
9131 op
= JimExprOperatorInfoByOpcode(t
->type
);
9133 /* Handle precedence */
9134 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9135 const struct Jim_ExprOperator
*tt_op
=
9136 JimExprOperatorInfoByOpcode(tt
->type
);
9138 /* Note that right-to-left associativity of ?: operator is handled later.
9141 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9142 /* Don't reduce if right associative with equal precedence? */
9143 if (tt_op
->precedence
== op
->precedence
&& tt_op
->lazy
== RIGHT_ASSOC
) {
9146 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9150 Jim_StackPop(&stack
);
9156 Jim_StackPush(&stack
, t
);
9158 else if (t
->type
== JIM_TT_SUBEXPR_START
) {
9159 Jim_StackPush(&stack
, t
);
9161 else if (t
->type
== JIM_TT_SUBEXPR_END
|| t
->type
== JIM_TT_SUBEXPR_COMMA
) {
9162 /* Reduce the expression back to the previous ( or , */
9164 while (Jim_StackLen(&stack
)) {
9165 ParseToken
*tt
= Jim_StackPop(&stack
);
9167 if (tt
->type
== JIM_TT_SUBEXPR_START
|| tt
->type
== JIM_TT_SUBEXPR_COMMA
) {
9168 if (t
->type
== JIM_TT_SUBEXPR_COMMA
) {
9169 /* Need to push back the previous START or COMMA in the case of comma */
9170 Jim_StackPush(&stack
, tt
);
9175 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9180 Jim_SetResultFormatted(interp
, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr
);
9185 Jim_Obj
*objPtr
= NULL
;
9187 /* This is a simple non-operator term, so create and push the appropriate object */
9188 token
->type
= t
->type
;
9190 /* Two consecutive terms without an operator is invalid */
9191 if (!TOKEN_IS_EXPR_START(prevtt
) && !TOKEN_IS_EXPR_OP(prevtt
)) {
9192 Jim_SetResultFormatted(interp
, "missing operator in expression: \"%#s\"", exprObjPtr
);
9197 /* Immediately create a double or int object? */
9198 if (t
->type
== JIM_TT_EXPR_INT
|| t
->type
== JIM_TT_EXPR_DOUBLE
) {
9200 if (t
->type
== JIM_TT_EXPR_INT
) {
9201 objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
9204 objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9206 if (endptr
!= t
->token
+ t
->len
) {
9207 /* Conversion failed, so just store it as a string */
9208 Jim_FreeNewObj(interp
, objPtr
);
9214 token
->objPtr
= objPtr
;
9217 /* Everything else is stored a simple string term */
9218 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
9219 if (t
->type
== JIM_TT_CMD
) {
9220 /* Only commands need source info */
9221 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
9229 /* Reduce any remaining subexpr */
9230 while (Jim_StackLen(&stack
)) {
9231 ParseToken
*tt
= Jim_StackPop(&stack
);
9233 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9235 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9238 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9245 ExprTernaryReorderExpression(interp
, expr
);
9249 /* Free the stack used for the compilation. */
9250 Jim_FreeStack(&stack
);
9252 for (i
= 0; i
< expr
->len
; i
++) {
9253 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9257 ExprFreeByteCode(interp
, expr
);
9265 /* This method takes the string representation of an expression
9266 * and generates a program for the Expr's stack-based VM. */
9267 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9270 const char *exprText
;
9271 struct JimParserCtx parser
;
9272 struct ExprByteCode
*expr
;
9273 ParseTokenList tokenlist
;
9275 Jim_Obj
*fileNameObj
;
9278 /* Try to get information about filename / line number */
9279 if (objPtr
->typePtr
== &sourceObjType
) {
9280 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9281 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9284 fileNameObj
= interp
->emptyObj
;
9287 Jim_IncrRefCount(fileNameObj
);
9289 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9291 /* Initially tokenise the expression into tokenlist */
9292 ScriptTokenListInit(&tokenlist
);
9294 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9295 while (!parser
.eof
) {
9296 if (JimParseExpression(&parser
) != JIM_OK
) {
9297 ScriptTokenListFree(&tokenlist
);
9298 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9303 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9307 #ifdef DEBUG_SHOW_EXPR_TOKENS
9310 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9311 for (i
= 0; i
< tokenlist
.count
; i
++) {
9312 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9313 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9318 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9319 ScriptTokenListFree(&tokenlist
);
9320 Jim_DecrRefCount(interp
, fileNameObj
);
9324 /* Now create the expression bytecode from the tokenlist */
9325 expr
= ExprCreateByteCode(interp
, &tokenlist
, objPtr
, fileNameObj
);
9327 /* No longer need the token list */
9328 ScriptTokenListFree(&tokenlist
);
9334 #ifdef DEBUG_SHOW_EXPR
9338 printf("==== Expr ====\n");
9339 for (i
= 0; i
< expr
->len
; i
++) {
9340 ScriptToken
*t
= &expr
->token
[i
];
9342 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9347 /* Check program correctness. */
9348 if (ExprCheckCorrectness(interp
, objPtr
, expr
) != JIM_OK
) {
9349 /* ExprCheckCorrectness set an error in this case */
9350 ExprFreeByteCode(interp
, expr
);
9358 /* Free the old internal rep and set the new one. */
9359 Jim_DecrRefCount(interp
, fileNameObj
);
9360 Jim_FreeIntRep(interp
, objPtr
);
9361 Jim_SetIntRepPtr(objPtr
, expr
);
9362 objPtr
->typePtr
= &exprObjType
;
9366 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9368 if (objPtr
->typePtr
!= &exprObjType
) {
9369 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9373 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9376 #ifdef JIM_OPTIMIZATION
9377 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9379 if (token
->type
== JIM_TT_EXPR_INT
)
9380 return token
->objPtr
;
9381 else if (token
->type
== JIM_TT_VAR
)
9382 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9383 else if (token
->type
== JIM_TT_DICTSUGAR
)
9384 return JimExpandDictSugar(interp
, token
->objPtr
);
9390 /* -----------------------------------------------------------------------------
9391 * Expressions evaluation.
9392 * Jim uses a specialized stack-based virtual machine for expressions,
9393 * that takes advantage of the fact that expr's operators
9394 * can't be redefined.
9396 * Jim_EvalExpression() uses the bytecode compiled by
9397 * SetExprFromAny() method of the "expression" object.
9399 * On success a Tcl Object containing the result of the evaluation
9400 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9402 * On error the function returns a retcode != to JIM_OK and set a suitable
9403 * error on the interp.
9404 * ---------------------------------------------------------------------------*/
9405 #define JIM_EE_STATICSTACK_LEN 10
9407 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9410 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9412 int retcode
= JIM_OK
;
9413 struct JimExprState e
;
9415 expr
= JimGetExpression(interp
, exprObjPtr
);
9417 return JIM_ERR
; /* error in expression. */
9420 #ifdef JIM_OPTIMIZATION
9421 /* Check for one of the following common expressions used by while/for
9426 * $a < CONST, $a < $b
9427 * $a <= CONST, $a <= $b
9428 * $a > CONST, $a > $b
9429 * $a >= CONST, $a >= $b
9430 * $a != CONST, $a != $b
9431 * $a == CONST, $a == $b
9436 /* STEP 1 -- Check if there are the conditions to run the specialized
9437 * version of while */
9439 switch (expr
->len
) {
9441 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9443 Jim_IncrRefCount(objPtr
);
9444 *exprResultPtrPtr
= objPtr
;
9450 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9451 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9453 if (objPtr
&& JimIsWide(objPtr
)) {
9454 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9455 Jim_IncrRefCount(*exprResultPtrPtr
);
9462 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9463 if (objPtr
&& JimIsWide(objPtr
)) {
9464 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9465 if (objPtr2
&& JimIsWide(objPtr2
)) {
9466 jim_wide wideValueA
= JimWideValue(objPtr
);
9467 jim_wide wideValueB
= JimWideValue(objPtr2
);
9469 switch (expr
->token
[2].type
) {
9471 cmpRes
= wideValueA
< wideValueB
;
9473 case JIM_EXPROP_LTE
:
9474 cmpRes
= wideValueA
<= wideValueB
;
9477 cmpRes
= wideValueA
> wideValueB
;
9479 case JIM_EXPROP_GTE
:
9480 cmpRes
= wideValueA
>= wideValueB
;
9482 case JIM_EXPROP_NUMEQ
:
9483 cmpRes
= wideValueA
== wideValueB
;
9485 case JIM_EXPROP_NUMNE
:
9486 cmpRes
= wideValueA
!= wideValueB
;
9491 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9492 Jim_IncrRefCount(*exprResultPtrPtr
);
9502 /* In order to avoid that the internal repr gets freed due to
9503 * shimmering of the exprObjPtr's object, we make the internal rep
9507 /* The stack-based expr VM itself */
9509 /* Stack allocation. Expr programs have the feature that
9510 * a program of length N can't require a stack longer than
9512 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9513 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9515 e
.stack
= staticStack
;
9519 /* Execute every instruction */
9520 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9523 switch (expr
->token
[i
].type
) {
9524 case JIM_TT_EXPR_INT
:
9525 case JIM_TT_EXPR_DOUBLE
:
9526 case JIM_TT_EXPR_BOOLEAN
:
9528 ExprPush(&e
, expr
->token
[i
].objPtr
);
9532 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9534 ExprPush(&e
, objPtr
);
9541 case JIM_TT_DICTSUGAR
:
9542 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9544 ExprPush(&e
, objPtr
);
9552 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9553 if (retcode
== JIM_OK
) {
9554 ExprPush(&e
, objPtr
);
9559 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9560 if (retcode
== JIM_OK
) {
9561 ExprPush(&e
, Jim_GetResult(interp
));
9566 /* Find and execute the operation */
9568 e
.opcode
= expr
->token
[i
].type
;
9570 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9571 /* Skip some opcodes if necessary */
9580 if (retcode
== JIM_OK
) {
9581 *exprResultPtrPtr
= ExprPop(&e
);
9584 for (i
= 0; i
< e
.stacklen
; i
++) {
9585 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9588 if (e
.stack
!= staticStack
) {
9594 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9600 Jim_Obj
*exprResultPtr
;
9602 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9603 if (retcode
!= JIM_OK
)
9606 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9607 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9608 if (Jim_GetBoolean(interp
, exprResultPtr
, &booleanValue
) != JIM_OK
) {
9609 Jim_DecrRefCount(interp
, exprResultPtr
);
9612 Jim_DecrRefCount(interp
, exprResultPtr
);
9613 *boolPtr
= booleanValue
;
9618 Jim_DecrRefCount(interp
, exprResultPtr
);
9619 *boolPtr
= doubleValue
!= 0;
9623 *boolPtr
= wideValue
!= 0;
9625 Jim_DecrRefCount(interp
, exprResultPtr
);
9629 /* -----------------------------------------------------------------------------
9630 * ScanFormat String Object
9631 * ---------------------------------------------------------------------------*/
9633 /* This Jim_Obj will held a parsed representation of a format string passed to
9634 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9635 * to be parsed in its entirely first and then, if correct, can be used for
9636 * scanning. To avoid endless re-parsing, the parsed representation will be
9637 * stored in an internal representation and re-used for performance reason. */
9639 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9640 * scanformat string. This part will later be used to extract information
9641 * out from the string to be parsed by Jim_ScanString */
9643 typedef struct ScanFmtPartDescr
9645 char *arg
; /* Specification of a CHARSET conversion */
9646 char *prefix
; /* Prefix to be scanned literally before conversion */
9647 size_t width
; /* Maximal width of input to be converted */
9648 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9649 char type
; /* Type of conversion (e.g. c, d, f) */
9650 char modifier
; /* Modify type (e.g. l - long, h - short */
9653 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9654 * string parsed and separated in part descriptions. Furthermore it contains
9655 * the original string representation of the scanformat string to allow for
9656 * fast update of the Jim_Obj's string representation part.
9658 * As an add-on the internal object representation adds some scratch pad area
9659 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9660 * memory for purpose of string scanning.
9662 * The error member points to a static allocated string in case of a mal-
9663 * formed scanformat string or it contains '0' (NULL) in case of a valid
9664 * parse representation.
9666 * The whole memory of the internal representation is allocated as a single
9667 * area of memory that will be internally separated. So freeing and duplicating
9668 * of such an object is cheap */
9670 typedef struct ScanFmtStringObj
9672 jim_wide size
; /* Size of internal repr in bytes */
9673 char *stringRep
; /* Original string representation */
9674 size_t count
; /* Number of ScanFmtPartDescr contained */
9675 size_t convCount
; /* Number of conversions that will assign */
9676 size_t maxPos
; /* Max position index if XPG3 is used */
9677 const char *error
; /* Ptr to error text (NULL if no error */
9678 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9679 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9683 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9684 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9685 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9687 static const Jim_ObjType scanFmtStringObjType
= {
9689 FreeScanFmtInternalRep
,
9690 DupScanFmtInternalRep
,
9691 UpdateStringOfScanFmt
,
9695 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9697 JIM_NOTUSED(interp
);
9698 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9699 objPtr
->internalRep
.ptr
= 0;
9702 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9704 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9705 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9707 JIM_NOTUSED(interp
);
9708 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9709 dupPtr
->internalRep
.ptr
= newVec
;
9710 dupPtr
->typePtr
= &scanFmtStringObjType
;
9713 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9715 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9718 /* SetScanFmtFromAny will parse a given string and create the internal
9719 * representation of the format specification. In case of an error
9720 * the error data member of the internal representation will be set
9721 * to an descriptive error text and the function will be left with
9722 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9725 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9727 ScanFmtStringObj
*fmtObj
;
9729 int maxCount
, i
, approxSize
, lastPos
= -1;
9730 const char *fmt
= objPtr
->bytes
;
9731 int maxFmtLen
= objPtr
->length
;
9732 const char *fmtEnd
= fmt
+ maxFmtLen
;
9735 Jim_FreeIntRep(interp
, objPtr
);
9736 /* Count how many conversions could take place maximally */
9737 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9740 /* Calculate an approximation of the memory necessary */
9741 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9742 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9743 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9744 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9745 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9746 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9747 +1; /* safety byte */
9748 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9749 memset(fmtObj
, 0, approxSize
);
9750 fmtObj
->size
= approxSize
;
9752 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9753 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9754 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9755 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9756 objPtr
->internalRep
.ptr
= fmtObj
;
9757 objPtr
->typePtr
= &scanFmtStringObjType
;
9758 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9759 int width
= 0, skip
;
9760 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9763 descr
->width
= 0; /* Assume width unspecified */
9764 /* Overread and store any "literal" prefix */
9765 if (*fmt
!= '%' || fmt
[1] == '%') {
9767 descr
->prefix
= &buffer
[i
];
9768 for (; fmt
< fmtEnd
; ++fmt
) {
9778 /* Skip the conversion introducing '%' sign */
9780 /* End reached due to non-conversion literal only? */
9783 descr
->pos
= 0; /* Assume "natural" positioning */
9785 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9789 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9790 /* Check if next token is a number (could be width or pos */
9791 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9793 /* Was the number a XPG3 position specifier? */
9794 if (descr
->pos
!= -1 && *fmt
== '$') {
9800 /* Look if "natural" postioning and XPG3 one was mixed */
9801 if ((lastPos
== 0 && descr
->pos
> 0)
9802 || (lastPos
> 0 && descr
->pos
== 0)) {
9803 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9806 /* Look if this position was already used */
9807 for (prev
= 0; prev
< curr
; ++prev
) {
9808 if (fmtObj
->descr
[prev
].pos
== -1)
9810 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9812 "variable is assigned by multiple \"%n$\" conversion specifiers";
9816 /* Try to find a width after the XPG3 specifier */
9817 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9818 descr
->width
= width
;
9821 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9822 fmtObj
->maxPos
= descr
->pos
;
9825 /* Number was not a XPG3, so it has to be a width */
9826 descr
->width
= width
;
9829 /* If positioning mode was undetermined yet, fix this */
9831 lastPos
= descr
->pos
;
9832 /* Handle CHARSET conversion type ... */
9834 int swapped
= 1, beg
= i
, end
, j
;
9837 descr
->arg
= &buffer
[i
];
9840 buffer
[i
++] = *fmt
++;
9842 buffer
[i
++] = *fmt
++;
9843 while (*fmt
&& *fmt
!= ']')
9844 buffer
[i
++] = *fmt
++;
9846 fmtObj
->error
= "unmatched [ in format string";
9851 /* In case a range fence was given "backwards", swap it */
9854 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9855 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9856 char tmp
= buffer
[j
- 1];
9858 buffer
[j
- 1] = buffer
[j
+ 1];
9859 buffer
[j
+ 1] = tmp
;
9866 /* Remember any valid modifier if given */
9867 if (strchr("hlL", *fmt
) != 0)
9868 descr
->modifier
= tolower((int)*fmt
++);
9871 if (strchr("efgcsndoxui", *fmt
) == 0) {
9872 fmtObj
->error
= "bad scan conversion character";
9875 else if (*fmt
== 'c' && descr
->width
!= 0) {
9876 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9879 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9880 fmtObj
->error
= "unsigned wide not supported";
9890 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9892 #define FormatGetCnvCount(_fo_) \
9893 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9894 #define FormatGetMaxPos(_fo_) \
9895 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9896 #define FormatGetError(_fo_) \
9897 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9899 /* JimScanAString is used to scan an unspecified string that ends with
9900 * next WS, or a string that is specified via a charset.
9903 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9905 char *buffer
= Jim_StrDup(str
);
9912 if (!sdescr
&& isspace(UCHAR(*str
)))
9913 break; /* EOS via WS if unspecified */
9915 n
= utf8_tounicode(str
, &c
);
9916 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9922 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9925 /* ScanOneEntry will scan one entry out of the string passed as argument.
9926 * It use the sscanf() function for this task. After extracting and
9927 * converting of the value, the count of scanned characters will be
9928 * returned of -1 in case of no conversion tool place and string was
9929 * already scanned thru */
9931 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9932 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9935 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9937 size_t anchor
= pos
;
9939 Jim_Obj
*tmpObj
= NULL
;
9941 /* First pessimistically assume, we will not scan anything :-) */
9943 if (descr
->prefix
) {
9944 /* There was a prefix given before the conversion, skip it and adjust
9945 * the string-to-be-parsed accordingly */
9946 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9947 /* If prefix require, skip WS */
9948 if (isspace(UCHAR(descr
->prefix
[i
])))
9949 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9951 else if (descr
->prefix
[i
] != str
[pos
])
9952 break; /* Prefix do not match here, leave the loop */
9954 ++pos
; /* Prefix matched so far, next round */
9956 if (pos
>= strLen
) {
9957 return -1; /* All of str consumed: EOF condition */
9959 else if (descr
->prefix
[i
] != 0)
9960 return 0; /* Not whole prefix consumed, no conversion possible */
9962 /* For all but following conversion, skip leading WS */
9963 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9964 while (isspace(UCHAR(str
[pos
])))
9966 /* Determine how much skipped/scanned so far */
9967 scanned
= pos
- anchor
;
9969 /* %c is a special, simple case. no width */
9970 if (descr
->type
== 'n') {
9971 /* Return pseudo conversion means: how much scanned so far? */
9972 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9974 else if (pos
>= strLen
) {
9975 /* Cannot scan anything, as str is totally consumed */
9978 else if (descr
->type
== 'c') {
9980 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9981 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9985 /* Processing of conversions follows ... */
9986 if (descr
->width
> 0) {
9987 /* Do not try to scan as fas as possible but only the given width.
9988 * To ensure this, we copy the part that should be scanned. */
9989 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9990 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9992 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9993 tok
= tmpObj
->bytes
;
9996 /* As no width was given, simply refer to the original string */
9999 switch (descr
->type
) {
10005 char *endp
; /* Position where the number finished */
10008 int base
= descr
->type
== 'o' ? 8
10009 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
10011 /* Try to scan a number with the given base */
10013 w
= jim_strtoull(tok
, &endp
);
10016 w
= strtoull(tok
, &endp
, base
);
10020 /* There was some number sucessfully scanned! */
10021 *valObjPtr
= Jim_NewIntObj(interp
, w
);
10023 /* Adjust the number-of-chars scanned so far */
10024 scanned
+= endp
- tok
;
10027 /* Nothing was scanned. We have to determine if this
10028 * happened due to e.g. prefix mismatch or input str
10030 scanned
= *tok
? 0 : -1;
10036 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
10037 scanned
+= Jim_Length(*valObjPtr
);
10044 double value
= strtod(tok
, &endp
);
10047 /* There was some number sucessfully scanned! */
10048 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
10049 /* Adjust the number-of-chars scanned so far */
10050 scanned
+= endp
- tok
;
10053 /* Nothing was scanned. We have to determine if this
10054 * happened due to e.g. prefix mismatch or input str
10056 scanned
= *tok
? 0 : -1;
10061 /* If a substring was allocated (due to pre-defined width) do not
10062 * forget to free it */
10064 Jim_FreeNewObj(interp
, tmpObj
);
10070 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10071 * string and returns all converted (and not ignored) values in a list back
10072 * to the caller. If an error occured, a NULL pointer will be returned */
10074 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
10078 const char *str
= Jim_String(strObjPtr
);
10079 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
10080 Jim_Obj
*resultList
= 0;
10081 Jim_Obj
**resultVec
= 0;
10083 Jim_Obj
*emptyStr
= 0;
10084 ScanFmtStringObj
*fmtObj
;
10086 /* This should never happen. The format object should already be of the correct type */
10087 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
10089 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
10090 /* Check if format specification was valid */
10091 if (fmtObj
->error
!= 0) {
10092 if (flags
& JIM_ERRMSG
)
10093 Jim_SetResultString(interp
, fmtObj
->error
, -1);
10096 /* Allocate a new "shared" empty string for all unassigned conversions */
10097 emptyStr
= Jim_NewEmptyStringObj(interp
);
10098 Jim_IncrRefCount(emptyStr
);
10099 /* Create a list and fill it with empty strings up to max specified XPG3 */
10100 resultList
= Jim_NewListObj(interp
, NULL
, 0);
10101 if (fmtObj
->maxPos
> 0) {
10102 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
10103 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
10104 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
10106 /* Now handle every partial format description */
10107 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
10108 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
10109 Jim_Obj
*value
= 0;
10111 /* Only last type may be "literal" w/o conversion - skip it! */
10112 if (descr
->type
== 0)
10114 /* As long as any conversion could be done, we will proceed */
10116 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
10117 /* In case our first try results in EOF, we will leave */
10118 if (scanned
== -1 && i
== 0)
10120 /* Advance next pos-to-be-scanned for the amount scanned already */
10123 /* value == 0 means no conversion took place so take empty string */
10125 value
= Jim_NewEmptyStringObj(interp
);
10126 /* If value is a non-assignable one, skip it */
10127 if (descr
->pos
== -1) {
10128 Jim_FreeNewObj(interp
, value
);
10130 else if (descr
->pos
== 0)
10131 /* Otherwise append it to the result list if no XPG3 was given */
10132 Jim_ListAppendElement(interp
, resultList
, value
);
10133 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
10134 /* But due to given XPG3, put the value into the corr. slot */
10135 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
10136 Jim_IncrRefCount(value
);
10137 resultVec
[descr
->pos
- 1] = value
;
10140 /* Otherwise, the slot was already used - free obj and ERROR */
10141 Jim_FreeNewObj(interp
, value
);
10145 Jim_DecrRefCount(interp
, emptyStr
);
10148 Jim_DecrRefCount(interp
, emptyStr
);
10149 Jim_FreeNewObj(interp
, resultList
);
10150 return (Jim_Obj
*)EOF
;
10152 Jim_DecrRefCount(interp
, emptyStr
);
10153 Jim_FreeNewObj(interp
, resultList
);
10157 /* -----------------------------------------------------------------------------
10158 * Pseudo Random Number Generation
10159 * ---------------------------------------------------------------------------*/
10160 /* Initialize the sbox with the numbers from 0 to 255 */
10161 static void JimPrngInit(Jim_Interp
*interp
)
10163 #define PRNG_SEED_SIZE 256
10165 unsigned int *seed
;
10166 time_t t
= time(NULL
);
10168 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10170 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10171 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10172 seed
[i
] = (rand() ^ t
^ clock());
10174 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10178 /* Generates N bytes of random data */
10179 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10181 Jim_PrngState
*prng
;
10182 unsigned char *destByte
= (unsigned char *)dest
;
10183 unsigned int si
, sj
, x
;
10185 /* initialization, only needed the first time */
10186 if (interp
->prngState
== NULL
)
10187 JimPrngInit(interp
);
10188 prng
= interp
->prngState
;
10189 /* generates 'len' bytes of pseudo-random numbers */
10190 for (x
= 0; x
< len
; x
++) {
10191 prng
->i
= (prng
->i
+ 1) & 0xff;
10192 si
= prng
->sbox
[prng
->i
];
10193 prng
->j
= (prng
->j
+ si
) & 0xff;
10194 sj
= prng
->sbox
[prng
->j
];
10195 prng
->sbox
[prng
->i
] = sj
;
10196 prng
->sbox
[prng
->j
] = si
;
10197 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10201 /* Re-seed the generator with user-provided bytes */
10202 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10205 Jim_PrngState
*prng
;
10207 /* initialization, only needed the first time */
10208 if (interp
->prngState
== NULL
)
10209 JimPrngInit(interp
);
10210 prng
= interp
->prngState
;
10212 /* Set the sbox[i] with i */
10213 for (i
= 0; i
< 256; i
++)
10215 /* Now use the seed to perform a random permutation of the sbox */
10216 for (i
= 0; i
< seedLen
; i
++) {
10219 t
= prng
->sbox
[i
& 0xFF];
10220 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10221 prng
->sbox
[seed
[i
]] = t
;
10223 prng
->i
= prng
->j
= 0;
10225 /* discard at least the first 256 bytes of stream.
10226 * borrow the seed buffer for this
10228 for (i
= 0; i
< 256; i
+= seedLen
) {
10229 JimRandomBytes(interp
, seed
, seedLen
);
10234 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10236 jim_wide wideValue
, increment
= 1;
10237 Jim_Obj
*intObjPtr
;
10239 if (argc
!= 2 && argc
!= 3) {
10240 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10244 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10247 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10249 /* Set missing variable to 0 */
10252 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10255 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10256 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10257 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10258 Jim_FreeNewObj(interp
, intObjPtr
);
10263 /* Can do it the quick way */
10264 Jim_InvalidateStringRep(intObjPtr
);
10265 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10267 /* The following step is required in order to invalidate the
10268 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10269 if (argv
[1]->typePtr
!= &variableObjType
) {
10270 /* Note that this can't fail since GetVariable already succeeded */
10271 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10274 Jim_SetResult(interp
, intObjPtr
);
10279 /* -----------------------------------------------------------------------------
10281 * ---------------------------------------------------------------------------*/
10282 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10283 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10285 /* Handle calls to the [unknown] command */
10286 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10290 /* If JimUnknown() is recursively called too many times...
10293 if (interp
->unknown_called
> 50) {
10297 /* The object interp->unknown just contains
10298 * the "unknown" string, it is used in order to
10299 * avoid to lookup the unknown command every time
10300 * but instead to cache the result. */
10302 /* If the [unknown] command does not exist ... */
10303 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10306 interp
->unknown_called
++;
10307 /* XXX: Are we losing fileNameObj and linenr? */
10308 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10309 interp
->unknown_called
--;
10314 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10322 for (j
= 0; j
< objc
; j
++) {
10323 printf(" '%s'", Jim_String(objv
[j
]));
10328 if (interp
->framePtr
->tailcallCmd
) {
10329 /* Special tailcall command was pre-resolved */
10330 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10331 interp
->framePtr
->tailcallCmd
= NULL
;
10334 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10335 if (cmdPtr
== NULL
) {
10336 return JimUnknown(interp
, objc
, objv
);
10338 JimIncrCmdRefCount(cmdPtr
);
10341 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10342 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10346 interp
->evalDepth
++;
10348 /* Call it -- Make sure result is an empty object. */
10349 Jim_SetEmptyResult(interp
);
10350 if (cmdPtr
->isproc
) {
10351 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10354 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10355 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10357 interp
->evalDepth
--;
10360 JimDecrCmdRefCount(interp
, cmdPtr
);
10365 /* Eval the object vector 'objv' composed of 'objc' elements.
10366 * Every element is used as single argument.
10367 * Jim_EvalObj() will call this function every time its object
10368 * argument is of "list" type, with no string representation.
10370 * This is possible because the string representation of a
10371 * list object generated by the UpdateStringOfList is made
10372 * in a way that ensures that every list element is a different
10373 * command argument. */
10374 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10378 /* Incr refcount of arguments. */
10379 for (i
= 0; i
< objc
; i
++)
10380 Jim_IncrRefCount(objv
[i
]);
10382 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10384 /* Decr refcount of arguments and return the retcode */
10385 for (i
= 0; i
< objc
; i
++)
10386 Jim_DecrRefCount(interp
, objv
[i
]);
10392 * Invokes 'prefix' as a command with the objv array as arguments.
10394 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10397 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10400 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10401 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10406 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10408 if (!interp
->errorFlag
) {
10409 /* This is the first error, so save the file/line information and reset the stack */
10410 interp
->errorFlag
= 1;
10411 Jim_IncrRefCount(script
->fileNameObj
);
10412 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10413 interp
->errorFileNameObj
= script
->fileNameObj
;
10414 interp
->errorLine
= script
->linenr
;
10416 JimResetStackTrace(interp
);
10417 /* Always add a level where the error first occurs */
10418 interp
->addStackTrace
++;
10421 /* Now if this is an "interesting" level, add it to the stack trace */
10422 if (interp
->addStackTrace
> 0) {
10423 /* Add the stack info for the current level */
10425 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10427 /* Note: if we didn't have a filename for this level,
10428 * don't clear the addStackTrace flag
10429 * so we can pick it up at the next level
10431 if (Jim_Length(script
->fileNameObj
)) {
10432 interp
->addStackTrace
= 0;
10435 Jim_DecrRefCount(interp
, interp
->errorProc
);
10436 interp
->errorProc
= interp
->emptyObj
;
10437 Jim_IncrRefCount(interp
->errorProc
);
10441 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10445 switch (token
->type
) {
10448 objPtr
= token
->objPtr
;
10451 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10453 case JIM_TT_DICTSUGAR
:
10454 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10456 case JIM_TT_EXPRSUGAR
:
10457 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10460 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10463 objPtr
= interp
->result
;
10466 /* Stop substituting */
10469 /* just skip this one */
10470 return JIM_CONTINUE
;
10477 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10482 *objPtrPtr
= objPtr
;
10488 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10489 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10490 * The returned object has refcount = 0.
10492 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10496 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10500 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10503 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10505 /* Compute every token forming the argument
10506 * in the intv objects vector. */
10507 for (i
= 0; i
< tokens
; i
++) {
10508 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10513 if (flags
& JIM_SUBST_FLAG
) {
10518 /* XXX: Should probably set an error about break outside loop */
10519 /* fall through to error */
10521 if (flags
& JIM_SUBST_FLAG
) {
10525 /* XXX: Ditto continue outside loop */
10526 /* fall through to error */
10529 Jim_DecrRefCount(interp
, intv
[i
]);
10531 if (intv
!= sintv
) {
10536 Jim_IncrRefCount(intv
[i
]);
10537 Jim_String(intv
[i
]);
10538 totlen
+= intv
[i
]->length
;
10541 /* Fast path return for a single token */
10542 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10543 Jim_DecrRefCount(interp
, intv
[0]);
10547 /* Concatenate every token in an unique
10549 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10551 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10552 && token
[2].type
== JIM_TT_VAR
) {
10553 /* May be able to do fast interpolated object -> dictSubst */
10554 objPtr
->typePtr
= &interpolatedObjType
;
10555 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10556 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10557 Jim_IncrRefCount(intv
[2]);
10559 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10560 /* The first interpolated token is source, so preserve the source info */
10561 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10565 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10566 objPtr
->length
= totlen
;
10567 for (i
= 0; i
< tokens
; i
++) {
10569 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10570 s
+= intv
[i
]->length
;
10571 Jim_DecrRefCount(interp
, intv
[i
]);
10574 objPtr
->bytes
[totlen
] = '\0';
10575 /* Free the intv vector if not static. */
10576 if (intv
!= sintv
) {
10584 /* listPtr *must* be a list.
10585 * The contents of the list is evaluated with the first element as the command and
10586 * the remaining elements as the arguments.
10588 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10590 int retcode
= JIM_OK
;
10592 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10594 if (listPtr
->internalRep
.listValue
.len
) {
10595 Jim_IncrRefCount(listPtr
);
10596 retcode
= JimInvokeCommand(interp
,
10597 listPtr
->internalRep
.listValue
.len
,
10598 listPtr
->internalRep
.listValue
.ele
);
10599 Jim_DecrRefCount(interp
, listPtr
);
10604 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10606 SetListFromAny(interp
, listPtr
);
10607 return JimEvalObjList(interp
, listPtr
);
10610 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10614 ScriptToken
*token
;
10615 int retcode
= JIM_OK
;
10616 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10617 Jim_Obj
*prevScriptObj
;
10619 /* If the object is of type "list", with no string rep we can call
10620 * a specialized version of Jim_EvalObj() */
10621 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10622 return JimEvalObjList(interp
, scriptObjPtr
);
10625 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10626 script
= JimGetScript(interp
, scriptObjPtr
);
10627 if (!JimScriptValid(interp
, script
)) {
10628 Jim_DecrRefCount(interp
, scriptObjPtr
);
10632 /* Reset the interpreter result. This is useful to
10633 * return the empty result in the case of empty program. */
10634 Jim_SetEmptyResult(interp
);
10636 token
= script
->token
;
10638 #ifdef JIM_OPTIMIZATION
10639 /* Check for one of the following common scripts used by for, while
10644 if (script
->len
== 0) {
10645 Jim_DecrRefCount(interp
, scriptObjPtr
);
10648 if (script
->len
== 3
10649 && token
[1].objPtr
->typePtr
== &commandObjType
10650 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10651 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10652 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10654 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10656 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10657 JimWideValue(objPtr
)++;
10658 Jim_InvalidateStringRep(objPtr
);
10659 Jim_DecrRefCount(interp
, scriptObjPtr
);
10660 Jim_SetResult(interp
, objPtr
);
10666 /* Now we have to make sure the internal repr will not be
10667 * freed on shimmering.
10669 * Think for example to this:
10671 * set x {llength $x; ... some more code ...}; eval $x
10673 * In order to preserve the internal rep, we increment the
10674 * inUse field of the script internal rep structure. */
10677 /* Stash the current script */
10678 prevScriptObj
= interp
->currentScriptObj
;
10679 interp
->currentScriptObj
= scriptObjPtr
;
10681 interp
->errorFlag
= 0;
10684 /* Execute every command sequentially until the end of the script
10685 * or an error occurs.
10687 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10691 /* First token of the line is always JIM_TT_LINE */
10692 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10693 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10695 /* Allocate the arguments vector if required */
10696 if (argc
> JIM_EVAL_SARGV_LEN
)
10697 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10699 /* Skip the JIM_TT_LINE token */
10702 /* Populate the arguments objects.
10703 * If an error occurs, retcode will be set and
10704 * 'j' will be set to the number of args expanded
10706 for (j
= 0; j
< argc
; j
++) {
10707 long wordtokens
= 1;
10709 Jim_Obj
*wordObjPtr
= NULL
;
10711 if (token
[i
].type
== JIM_TT_WORD
) {
10712 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10713 if (wordtokens
< 0) {
10715 wordtokens
= -wordtokens
;
10719 if (wordtokens
== 1) {
10720 /* Fast path if the token does not
10721 * need interpolation */
10723 switch (token
[i
].type
) {
10726 wordObjPtr
= token
[i
].objPtr
;
10729 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10731 case JIM_TT_EXPRSUGAR
:
10732 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10734 case JIM_TT_DICTSUGAR
:
10735 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10738 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10739 if (retcode
== JIM_OK
) {
10740 wordObjPtr
= Jim_GetResult(interp
);
10744 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10748 /* For interpolation we call a helper
10749 * function to do the work for us. */
10750 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10754 if (retcode
== JIM_OK
) {
10760 Jim_IncrRefCount(wordObjPtr
);
10764 argv
[j
] = wordObjPtr
;
10767 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10768 int len
= Jim_ListLength(interp
, wordObjPtr
);
10769 int newargc
= argc
+ len
- 1;
10773 if (argv
== sargv
) {
10774 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10775 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10776 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10780 /* Need to realloc to make room for (len - 1) more entries */
10781 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10785 /* Now copy in the expanded version */
10786 for (k
= 0; k
< len
; k
++) {
10787 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10788 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10791 /* The original object reference is no longer needed,
10792 * after the expansion it is no longer present on
10793 * the argument vector, but the single elements are
10795 Jim_DecrRefCount(interp
, wordObjPtr
);
10797 /* And update the indexes */
10803 if (retcode
== JIM_OK
&& argc
) {
10804 /* Invoke the command */
10805 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10806 /* Check for a signal after each command */
10807 if (Jim_CheckSignal(interp
)) {
10808 retcode
= JIM_SIGNAL
;
10812 /* Finished with the command, so decrement ref counts of each argument */
10814 Jim_DecrRefCount(interp
, argv
[j
]);
10817 if (argv
!= sargv
) {
10823 /* Possibly add to the error stack trace */
10824 if (retcode
== JIM_ERR
) {
10825 JimAddErrorToStack(interp
, script
);
10827 /* Propagate the addStackTrace value through 'return -code error' */
10828 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10829 /* No need to add stack trace */
10830 interp
->addStackTrace
= 0;
10833 /* Restore the current script */
10834 interp
->currentScriptObj
= prevScriptObj
;
10836 /* Note that we don't have to decrement inUse, because the
10837 * following code transfers our use of the reference again to
10838 * the script object. */
10839 Jim_FreeIntRep(interp
, scriptObjPtr
);
10840 scriptObjPtr
->typePtr
= &scriptObjType
;
10841 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10842 Jim_DecrRefCount(interp
, scriptObjPtr
);
10847 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10850 /* If argObjPtr begins with '&', do an automatic upvar */
10851 const char *varname
= Jim_String(argNameObj
);
10852 if (*varname
== '&') {
10853 /* First check that the target variable exists */
10855 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10857 interp
->framePtr
= interp
->framePtr
->parent
;
10858 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10859 interp
->framePtr
= savedCallFrame
;
10864 /* It exists, so perform the binding. */
10865 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10866 Jim_IncrRefCount(objPtr
);
10867 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10868 Jim_DecrRefCount(interp
, objPtr
);
10871 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10877 * Sets the interp result to be an error message indicating the required proc args.
10879 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10881 /* Create a nice error message, consistent with Tcl 8.5 */
10882 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10885 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10886 Jim_AppendString(interp
, argmsg
, " ", 1);
10888 if (i
== cmd
->u
.proc
.argsPos
) {
10889 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10891 Jim_AppendString(interp
, argmsg
, "?", 1);
10892 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10893 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10896 /* We have plain args */
10897 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10901 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10902 Jim_AppendString(interp
, argmsg
, "?", 1);
10903 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10904 Jim_AppendString(interp
, argmsg
, "?", 1);
10907 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10911 Jim_AppendString(interp
, argmsg
, arg
, -1);
10915 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10916 Jim_FreeNewObj(interp
, argmsg
);
10919 #ifdef jim_ext_namespace
10923 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10925 Jim_CallFrame
*callFramePtr
;
10928 /* Create a new callframe */
10929 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10930 callFramePtr
->argv
= &interp
->emptyObj
;
10931 callFramePtr
->argc
= 0;
10932 callFramePtr
->procArgsObjPtr
= NULL
;
10933 callFramePtr
->procBodyObjPtr
= scriptObj
;
10934 callFramePtr
->staticVars
= NULL
;
10935 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10936 callFramePtr
->line
= 0;
10937 Jim_IncrRefCount(scriptObj
);
10938 interp
->framePtr
= callFramePtr
;
10940 /* Check if there are too nested calls */
10941 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10942 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10946 /* Eval the body */
10947 retcode
= Jim_EvalObj(interp
, scriptObj
);
10950 /* Destroy the callframe */
10951 interp
->framePtr
= interp
->framePtr
->parent
;
10952 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10958 /* Call a procedure implemented in Tcl.
10959 * It's possible to speed-up a lot this function, currently
10960 * the callframes are not cached, but allocated and
10961 * destroied every time. What is expecially costly is
10962 * to create/destroy the local vars hash table every time.
10964 * This can be fixed just implementing callframes caching
10965 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10966 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10968 Jim_CallFrame
*callFramePtr
;
10969 int i
, d
, retcode
, optargs
;
10973 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10974 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10975 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10979 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10980 /* Optimise for procedure with no body - useful for optional debugging */
10984 /* Check if there are too nested calls */
10985 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10986 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10990 /* Create a new callframe */
10991 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10992 callFramePtr
->argv
= argv
;
10993 callFramePtr
->argc
= argc
;
10994 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10995 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10996 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10998 /* Remember where we were called from. */
10999 script
= JimGetScript(interp
, interp
->currentScriptObj
);
11000 callFramePtr
->fileNameObj
= script
->fileNameObj
;
11001 callFramePtr
->line
= script
->linenr
;
11003 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
11004 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
11005 interp
->framePtr
= callFramePtr
;
11007 /* How many optional args are available */
11008 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
11010 /* Step 'i' along the actual args, and step 'd' along the formal args */
11012 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
11013 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
11014 if (d
== cmd
->u
.proc
.argsPos
) {
11016 Jim_Obj
*listObjPtr
;
11018 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
11019 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
11021 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
11023 /* It is possible to rename args. */
11024 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
11025 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
11027 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
11028 if (retcode
!= JIM_OK
) {
11036 /* Optional or required? */
11037 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
11038 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
11041 /* Ran out, so use the default */
11042 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
11044 if (retcode
!= JIM_OK
) {
11049 /* Eval the body */
11050 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
11054 /* Free the callframe */
11055 interp
->framePtr
= interp
->framePtr
->parent
;
11056 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
11058 /* Now chain any tailcalls in the parent frame */
11059 if (interp
->framePtr
->tailcallObj
) {
11061 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
11063 interp
->framePtr
->tailcallObj
= NULL
;
11065 if (retcode
== JIM_EVAL
) {
11066 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
11067 if (retcode
== JIM_RETURN
) {
11068 /* If the result of the tailcall is 'return', push
11069 * it up to the caller
11071 interp
->returnLevel
++;
11074 Jim_DecrRefCount(interp
, tailcallObj
);
11075 } while (interp
->framePtr
->tailcallObj
);
11077 /* If the tailcall chain finished early, may need to manually discard the command */
11078 if (interp
->framePtr
->tailcallCmd
) {
11079 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
11080 interp
->framePtr
->tailcallCmd
= NULL
;
11084 /* Handle the JIM_RETURN return code */
11085 if (retcode
== JIM_RETURN
) {
11086 if (--interp
->returnLevel
<= 0) {
11087 retcode
= interp
->returnCode
;
11088 interp
->returnCode
= JIM_OK
;
11089 interp
->returnLevel
= 0;
11092 else if (retcode
== JIM_ERR
) {
11093 interp
->addStackTrace
++;
11094 Jim_DecrRefCount(interp
, interp
->errorProc
);
11095 interp
->errorProc
= argv
[0];
11096 Jim_IncrRefCount(interp
->errorProc
);
11102 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
11105 Jim_Obj
*scriptObjPtr
;
11107 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
11108 Jim_IncrRefCount(scriptObjPtr
);
11111 Jim_Obj
*prevScriptObj
;
11113 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
11115 prevScriptObj
= interp
->currentScriptObj
;
11116 interp
->currentScriptObj
= scriptObjPtr
;
11118 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11120 interp
->currentScriptObj
= prevScriptObj
;
11123 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11125 Jim_DecrRefCount(interp
, scriptObjPtr
);
11129 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
11131 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
11134 /* Execute script in the scope of the global level */
11135 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
11138 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11140 interp
->framePtr
= interp
->topFramePtr
;
11141 retval
= Jim_Eval(interp
, script
);
11142 interp
->framePtr
= savedFramePtr
;
11147 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
11150 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11152 interp
->framePtr
= interp
->topFramePtr
;
11153 retval
= Jim_EvalFile(interp
, filename
);
11154 interp
->framePtr
= savedFramePtr
;
11159 #include <sys/stat.h>
11161 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11165 Jim_Obj
*scriptObjPtr
;
11166 Jim_Obj
*prevScriptObj
;
11171 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11172 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11175 if (sb
.st_size
== 0) {
11180 buf
= Jim_Alloc(sb
.st_size
+ 1);
11181 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11185 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11191 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11192 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11193 Jim_IncrRefCount(scriptObjPtr
);
11195 prevScriptObj
= interp
->currentScriptObj
;
11196 interp
->currentScriptObj
= scriptObjPtr
;
11198 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11200 /* Handle the JIM_RETURN return code */
11201 if (retcode
== JIM_RETURN
) {
11202 if (--interp
->returnLevel
<= 0) {
11203 retcode
= interp
->returnCode
;
11204 interp
->returnCode
= JIM_OK
;
11205 interp
->returnLevel
= 0;
11208 if (retcode
== JIM_ERR
) {
11209 /* EvalFile changes context, so add a stack frame here */
11210 interp
->addStackTrace
++;
11213 interp
->currentScriptObj
= prevScriptObj
;
11215 Jim_DecrRefCount(interp
, scriptObjPtr
);
11220 /* -----------------------------------------------------------------------------
11222 * ---------------------------------------------------------------------------*/
11223 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11225 pc
->tstart
= pc
->p
;
11226 pc
->tline
= pc
->linenr
;
11228 if (pc
->len
== 0) {
11230 pc
->tt
= JIM_TT_EOL
;
11234 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11238 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11239 if (JimParseVar(pc
) == JIM_OK
) {
11242 /* Not a var, so treat as a string */
11243 pc
->tstart
= pc
->p
;
11244 flags
|= JIM_SUBST_NOVAR
;
11247 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11250 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11253 if (*pc
->p
== '\\' && pc
->len
> 1) {
11260 pc
->tend
= pc
->p
- 1;
11261 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11264 /* The subst object type reuses most of the data structures and functions
11265 * of the script object. Script's data structures are a bit more complex
11266 * for what is needed for [subst]itution tasks, but the reuse helps to
11267 * deal with a single data structure at the cost of some more memory
11268 * usage for substitutions. */
11270 /* This method takes the string representation of an object
11271 * as a Tcl string where to perform [subst]itution, and generates
11272 * the pre-parsed internal representation. */
11273 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11276 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11277 struct JimParserCtx parser
;
11278 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11279 ParseTokenList tokenlist
;
11281 /* Initially parse the subst into tokens (in tokenlist) */
11282 ScriptTokenListInit(&tokenlist
);
11284 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11286 JimParseSubst(&parser
, flags
);
11288 /* Note that subst doesn't need the EOL token */
11291 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11295 /* Create the "real" subst/script tokens from the initial token list */
11297 script
->substFlags
= flags
;
11298 script
->fileNameObj
= interp
->emptyObj
;
11299 Jim_IncrRefCount(script
->fileNameObj
);
11300 SubstObjAddTokens(interp
, script
, &tokenlist
);
11302 /* No longer need the token list */
11303 ScriptTokenListFree(&tokenlist
);
11305 #ifdef DEBUG_SHOW_SUBST
11309 printf("==== Subst ====\n");
11310 for (i
= 0; i
< script
->len
; i
++) {
11311 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11312 Jim_String(script
->token
[i
].objPtr
));
11317 /* Free the old internal rep and set the new one. */
11318 Jim_FreeIntRep(interp
, objPtr
);
11319 Jim_SetIntRepPtr(objPtr
, script
);
11320 objPtr
->typePtr
= &scriptObjType
;
11324 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11326 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11327 SetSubstFromAny(interp
, objPtr
, flags
);
11328 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11331 /* Performs commands,variables,blackslashes substitution,
11332 * storing the result object (with refcount 0) into
11334 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11336 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11338 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11339 /* In order to preserve the internal rep, we increment the
11340 * inUse field of the script internal rep structure. */
11343 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11346 Jim_DecrRefCount(interp
, substObjPtr
);
11347 if (*resObjPtrPtr
== NULL
) {
11353 /* -----------------------------------------------------------------------------
11354 * Core commands utility functions
11355 * ---------------------------------------------------------------------------*/
11356 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11359 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11362 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11364 Jim_IncrRefCount(listObjPtr
);
11365 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11366 Jim_DecrRefCount(interp
, listObjPtr
);
11368 Jim_IncrRefCount(objPtr
);
11369 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11370 Jim_DecrRefCount(interp
, objPtr
);
11374 * May add the key and/or value to the list.
11376 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11377 Jim_HashEntry
*he
, int type
);
11379 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11382 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11383 * invoke the callback to add entries to a list.
11384 * Returns the list.
11386 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11387 JimHashtableIteratorCallbackType
*callback
, int type
)
11390 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11392 /* Check for the non-pattern case. We can do this much more efficiently. */
11393 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11394 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11396 callback(interp
, listObjPtr
, he
, type
);
11400 Jim_HashTableIterator htiter
;
11401 JimInitHashTableIterator(ht
, &htiter
);
11402 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11403 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11404 callback(interp
, listObjPtr
, he
, type
);
11411 /* Keep these in order */
11412 #define JIM_CMDLIST_COMMANDS 0
11413 #define JIM_CMDLIST_PROCS 1
11414 #define JIM_CMDLIST_CHANNELS 2
11417 * Adds matching command names (procs, channels) to the list.
11419 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11420 Jim_HashEntry
*he
, int type
)
11422 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11425 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11430 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11431 Jim_IncrRefCount(objPtr
);
11433 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11434 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11436 Jim_DecrRefCount(interp
, objPtr
);
11439 /* type is JIM_CMDLIST_xxx */
11440 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11442 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11445 /* Keep these in order */
11446 #define JIM_VARLIST_GLOBALS 0
11447 #define JIM_VARLIST_LOCALS 1
11448 #define JIM_VARLIST_VARS 2
11450 #define JIM_VARLIST_VALUES 0x1000
11453 * Adds matching variable names to the list.
11455 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11456 Jim_HashEntry
*he
, int type
)
11458 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11460 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11461 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11462 if (type
& JIM_VARLIST_VALUES
) {
11463 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11468 /* mode is JIM_VARLIST_xxx */
11469 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11471 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11472 /* For [info locals], if we are at top level an emtpy list
11473 * is returned. I don't agree, but we aim at compatibility (SS) */
11474 return interp
->emptyObj
;
11477 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11478 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11482 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11483 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11485 Jim_CallFrame
*targetCallFrame
;
11487 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11488 if (targetCallFrame
== NULL
) {
11491 /* No proc call at toplevel callframe */
11492 if (targetCallFrame
== interp
->topFramePtr
) {
11493 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11496 if (info_level_cmd
) {
11497 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11500 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11502 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11503 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11504 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11505 *objPtrPtr
= listObj
;
11510 /* -----------------------------------------------------------------------------
11512 * ---------------------------------------------------------------------------*/
11514 /* fake [puts] -- not the real puts, just for debugging. */
11515 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11517 if (argc
!= 2 && argc
!= 3) {
11518 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11522 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11523 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11527 fputs(Jim_String(argv
[2]), stdout
);
11531 puts(Jim_String(argv
[1]));
11536 /* Helper for [+] and [*] */
11537 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11539 jim_wide wideValue
, res
;
11540 double doubleValue
, doubleRes
;
11543 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11545 for (i
= 1; i
< argc
; i
++) {
11546 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11548 if (op
== JIM_EXPROP_ADD
)
11553 Jim_SetResultInt(interp
, res
);
11556 doubleRes
= (double)res
;
11557 for (; i
< argc
; i
++) {
11558 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11560 if (op
== JIM_EXPROP_ADD
)
11561 doubleRes
+= doubleValue
;
11563 doubleRes
*= doubleValue
;
11565 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11569 /* Helper for [-] and [/] */
11570 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11572 jim_wide wideValue
, res
= 0;
11573 double doubleValue
, doubleRes
= 0;
11577 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11580 else if (argc
== 2) {
11581 /* The arity = 2 case is different. For [- x] returns -x,
11582 * while [/ x] returns 1/x. */
11583 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11584 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11588 if (op
== JIM_EXPROP_SUB
)
11589 doubleRes
= -doubleValue
;
11591 doubleRes
= 1.0 / doubleValue
;
11592 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11596 if (op
== JIM_EXPROP_SUB
) {
11598 Jim_SetResultInt(interp
, res
);
11601 doubleRes
= 1.0 / wideValue
;
11602 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11607 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11608 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11617 for (i
= 2; i
< argc
; i
++) {
11618 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11619 doubleRes
= (double)res
;
11622 if (op
== JIM_EXPROP_SUB
)
11627 Jim_SetResultInt(interp
, res
);
11630 for (; i
< argc
; i
++) {
11631 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11633 if (op
== JIM_EXPROP_SUB
)
11634 doubleRes
-= doubleValue
;
11636 doubleRes
/= doubleValue
;
11638 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11644 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11646 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11650 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11652 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11656 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11658 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11662 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11664 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11668 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11670 if (argc
!= 2 && argc
!= 3) {
11671 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11677 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11680 Jim_SetResult(interp
, objPtr
);
11683 /* argc == 3 case. */
11684 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11686 Jim_SetResult(interp
, argv
[2]);
11692 * unset ?-nocomplain? ?--? ?varName ...?
11694 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11700 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11704 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11713 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11723 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11726 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11730 /* The general purpose implementation of while starts here */
11732 int boolean
, retval
;
11734 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11739 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11753 Jim_SetEmptyResult(interp
);
11758 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11762 Jim_Obj
*varNamePtr
= NULL
;
11763 Jim_Obj
*stopVarNamePtr
= NULL
;
11766 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11770 /* Do the initialisation */
11771 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11775 /* And do the first test now. Better for optimisation
11776 * if we can do next/test at the bottom of the loop
11778 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11780 /* Ready to do the body as follows:
11782 * body // check retcode
11783 * next // check retcode
11784 * test // check retcode/test bool
11788 #ifdef JIM_OPTIMIZATION
11789 /* Check if the for is on the form:
11790 * for ... {$i < CONST} {incr i}
11791 * for ... {$i < $j} {incr i}
11793 if (retval
== JIM_OK
&& boolean
) {
11794 ScriptObj
*incrScript
;
11795 ExprByteCode
*expr
;
11796 jim_wide stop
, currentVal
;
11800 /* Do it only if there aren't shared arguments */
11801 expr
= JimGetExpression(interp
, argv
[2]);
11802 incrScript
= JimGetScript(interp
, argv
[3]);
11804 /* Ensure proper lengths to start */
11805 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11808 /* Ensure proper token types. */
11809 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11810 expr
->token
[0].type
!= JIM_TT_VAR
||
11811 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11815 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11818 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11825 /* Update command must be incr */
11826 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11830 /* incr, expression must be about the same variable */
11831 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11835 /* Get the stop condition (must be a variable or integer) */
11836 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11837 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11842 stopVarNamePtr
= expr
->token
[1].objPtr
;
11843 Jim_IncrRefCount(stopVarNamePtr
);
11844 /* Keep the compiler happy */
11848 /* Initialization */
11849 varNamePtr
= expr
->token
[0].objPtr
;
11850 Jim_IncrRefCount(varNamePtr
);
11852 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11853 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11857 /* --- OPTIMIZED FOR --- */
11858 while (retval
== JIM_OK
) {
11859 /* === Check condition === */
11860 /* Note that currentVal is already set here */
11862 /* Immediate or Variable? get the 'stop' value if the latter. */
11863 if (stopVarNamePtr
) {
11864 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11865 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11870 if (currentVal
>= stop
+ cmpOffset
) {
11875 retval
= Jim_EvalObj(interp
, argv
[4]);
11876 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11879 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11882 if (objPtr
== NULL
) {
11886 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11887 currentVal
= ++JimWideValue(objPtr
);
11888 Jim_InvalidateStringRep(objPtr
);
11891 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11892 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11893 ++currentVal
)) != JIM_OK
) {
11904 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11906 retval
= Jim_EvalObj(interp
, argv
[4]);
11908 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11911 retval
= Jim_EvalObj(interp
, argv
[3]);
11912 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11915 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11920 if (stopVarNamePtr
) {
11921 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11924 Jim_DecrRefCount(interp
, varNamePtr
);
11927 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11928 Jim_SetEmptyResult(interp
);
11936 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11942 Jim_Obj
*bodyObjPtr
;
11944 if (argc
!= 5 && argc
!= 6) {
11945 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11949 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11950 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11951 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11954 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11956 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11958 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11959 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11960 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11961 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11968 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11969 if (argv
[1]->typePtr
!= &variableObjType
) {
11970 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11974 JimWideValue(objPtr
) = i
;
11975 Jim_InvalidateStringRep(objPtr
);
11977 /* The following step is required in order to invalidate the
11978 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11979 if (argv
[1]->typePtr
!= &variableObjType
) {
11980 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11987 objPtr
= Jim_NewIntObj(interp
, i
);
11988 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11989 if (retval
!= JIM_OK
) {
11990 Jim_FreeNewObj(interp
, objPtr
);
11996 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11997 Jim_SetEmptyResult(interp
);
12003 /* List iterators make it easy to iterate over a list.
12004 * At some point iterators will be expanded to support generators.
12012 * Initialise the iterator at the start of the list.
12014 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
12016 iter
->objPtr
= objPtr
;
12021 * Returns the next object from the list, or NULL on end-of-list.
12023 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
12025 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
12028 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
12032 * Returns 1 if end-of-list has been reached.
12034 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
12036 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
12039 /* foreach + lmap implementation. */
12040 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
12042 int result
= JIM_OK
;
12044 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
12045 Jim_ListIter
*iters
;
12047 Jim_Obj
*resultObj
;
12049 if (argc
< 4 || argc
% 2 != 0) {
12050 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
12053 script
= argv
[argc
- 1]; /* Last argument is a script */
12054 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
12056 if (numargs
== 2) {
12060 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
12062 for (i
= 0; i
< numargs
; i
++) {
12063 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12064 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
12068 if (result
!= JIM_OK
) {
12069 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
12074 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12077 resultObj
= interp
->emptyObj
;
12079 Jim_IncrRefCount(resultObj
);
12082 /* Have we expired all lists? */
12083 for (i
= 0; i
< numargs
; i
+= 2) {
12084 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
12088 if (i
== numargs
) {
12093 /* For each list */
12094 for (i
= 0; i
< numargs
; i
+= 2) {
12098 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12099 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
12100 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
12102 /* Ran out, so store the empty string */
12103 valObj
= interp
->emptyObj
;
12105 /* Avoid shimmering */
12106 Jim_IncrRefCount(valObj
);
12107 result
= Jim_SetVariable(interp
, varName
, valObj
);
12108 Jim_DecrRefCount(interp
, valObj
);
12109 if (result
!= JIM_OK
) {
12114 switch (result
= Jim_EvalObj(interp
, script
)) {
12117 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
12130 Jim_SetResult(interp
, resultObj
);
12132 Jim_DecrRefCount(interp
, resultObj
);
12140 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12142 return JimForeachMapHelper(interp
, argc
, argv
, 0);
12146 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12148 return JimForeachMapHelper(interp
, argc
, argv
, 1);
12152 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12154 int result
= JIM_ERR
;
12157 Jim_Obj
*resultObj
;
12160 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12164 JimListIterInit(&iter
, argv
[1]);
12166 for (i
= 2; i
< argc
; i
++) {
12167 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12168 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12169 if (result
!= JIM_OK
) {
12174 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12175 while (!JimListIterDone(interp
, &iter
)) {
12176 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12179 Jim_SetResult(interp
, resultObj
);
12185 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12187 int boolean
, retval
, current
= 1, falsebody
= 0;
12191 /* Far not enough arguments given! */
12192 if (current
>= argc
)
12194 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12197 /* There lacks something, isn't it? */
12198 if (current
>= argc
)
12200 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12202 /* Tsk tsk, no then-clause? */
12203 if (current
>= argc
)
12206 return Jim_EvalObj(interp
, argv
[current
]);
12207 /* Ok: no else-clause follows */
12208 if (++current
>= argc
) {
12209 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12212 falsebody
= current
++;
12213 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12214 /* IIICKS - else-clause isn't last cmd? */
12215 if (current
!= argc
- 1)
12217 return Jim_EvalObj(interp
, argv
[current
]);
12219 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12220 /* Ok: elseif follows meaning all the stuff
12221 * again (how boring...) */
12223 /* OOPS - else-clause is not last cmd? */
12224 else if (falsebody
!= argc
- 1)
12226 return Jim_EvalObj(interp
, argv
[falsebody
]);
12231 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12236 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12237 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12238 Jim_Obj
*stringObj
, int nocase
)
12245 parms
[argc
++] = commandObj
;
12247 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12249 parms
[argc
++] = patternObj
;
12250 parms
[argc
++] = stringObj
;
12252 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12254 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12262 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12265 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12267 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12268 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12269 Jim_Obj
*script
= 0;
12273 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12274 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12277 for (opt
= 1; opt
< argc
; ++opt
) {
12278 const char *option
= Jim_String(argv
[opt
]);
12280 if (*option
!= '-')
12282 else if (strncmp(option
, "--", 2) == 0) {
12286 else if (strncmp(option
, "-exact", 2) == 0)
12287 matchOpt
= SWITCH_EXACT
;
12288 else if (strncmp(option
, "-glob", 2) == 0)
12289 matchOpt
= SWITCH_GLOB
;
12290 else if (strncmp(option
, "-regexp", 2) == 0)
12291 matchOpt
= SWITCH_RE
;
12292 else if (strncmp(option
, "-command", 2) == 0) {
12293 matchOpt
= SWITCH_CMD
;
12294 if ((argc
- opt
) < 2)
12296 command
= argv
[++opt
];
12299 Jim_SetResultFormatted(interp
,
12300 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12304 if ((argc
- opt
) < 2)
12307 strObj
= argv
[opt
++];
12308 patCount
= argc
- opt
;
12309 if (patCount
== 1) {
12312 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12316 caseList
= &argv
[opt
];
12317 if (patCount
== 0 || patCount
% 2 != 0)
12319 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12320 Jim_Obj
*patObj
= caseList
[i
];
12322 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12323 || i
< (patCount
- 2)) {
12324 switch (matchOpt
) {
12326 if (Jim_StringEqObj(strObj
, patObj
))
12327 script
= caseList
[i
+ 1];
12330 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12331 script
= caseList
[i
+ 1];
12334 command
= Jim_NewStringObj(interp
, "regexp", -1);
12335 /* Fall thru intentionally */
12337 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12339 /* After the execution of a command we need to
12340 * make sure to reconvert the object into a list
12341 * again. Only for the single-list style [switch]. */
12342 if (argc
- opt
== 1) {
12345 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12348 /* command is here already decref'd */
12353 script
= caseList
[i
+ 1];
12359 script
= caseList
[i
+ 1];
12362 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12363 script
= caseList
[i
+ 1];
12364 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12365 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12368 Jim_SetEmptyResult(interp
);
12370 return Jim_EvalObj(interp
, script
);
12376 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12378 Jim_Obj
*listObjPtr
;
12380 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12381 Jim_SetResult(interp
, listObjPtr
);
12386 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12388 Jim_Obj
*objPtr
, *listObjPtr
;
12393 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12397 Jim_IncrRefCount(objPtr
);
12398 for (i
= 2; i
< argc
; i
++) {
12399 listObjPtr
= objPtr
;
12400 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12401 Jim_DecrRefCount(interp
, listObjPtr
);
12404 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12405 /* Returns an empty object if the index
12406 * is out of range. */
12407 Jim_DecrRefCount(interp
, listObjPtr
);
12408 Jim_SetEmptyResult(interp
);
12411 Jim_IncrRefCount(objPtr
);
12412 Jim_DecrRefCount(interp
, listObjPtr
);
12414 Jim_SetResult(interp
, objPtr
);
12415 Jim_DecrRefCount(interp
, objPtr
);
12420 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12423 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12426 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12431 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12433 static const char * const options
[] = {
12434 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12438 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12443 int opt_nocase
= 0;
12445 int opt_inline
= 0;
12446 int opt_match
= OPT_EXACT
;
12449 Jim_Obj
*listObjPtr
= NULL
;
12450 Jim_Obj
*commandObj
= NULL
;
12454 Jim_WrongNumArgs(interp
, 1, argv
,
12455 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12459 for (i
= 1; i
< argc
- 2; i
++) {
12462 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12484 if (i
>= argc
- 2) {
12487 commandObj
= argv
[++i
];
12492 opt_match
= option
;
12500 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12502 if (opt_match
== OPT_REGEXP
) {
12503 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12506 Jim_IncrRefCount(commandObj
);
12509 listlen
= Jim_ListLength(interp
, argv
[0]);
12510 for (i
= 0; i
< listlen
; i
++) {
12512 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12514 switch (opt_match
) {
12516 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12520 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12525 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12528 Jim_FreeNewObj(interp
, listObjPtr
);
12536 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12537 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12541 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12542 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12543 Jim_Obj
*resultObj
;
12546 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12548 else if (!opt_inline
) {
12549 resultObj
= Jim_NewIntObj(interp
, i
);
12552 resultObj
= objPtr
;
12556 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12559 Jim_SetResult(interp
, resultObj
);
12566 Jim_SetResult(interp
, listObjPtr
);
12571 Jim_SetResultBool(interp
, opt_not
);
12573 else if (!opt_inline
) {
12574 Jim_SetResultInt(interp
, -1);
12580 Jim_DecrRefCount(interp
, commandObj
);
12586 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12588 Jim_Obj
*listObjPtr
;
12593 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12596 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12598 /* Create the list if it does not exist */
12599 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12602 else if (Jim_IsShared(listObjPtr
)) {
12603 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12606 for (i
= 2; i
< argc
; i
++)
12607 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12608 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12610 Jim_FreeNewObj(interp
, listObjPtr
);
12613 Jim_SetResult(interp
, listObjPtr
);
12618 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12624 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12628 if (Jim_IsShared(listPtr
))
12629 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12630 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12632 len
= Jim_ListLength(interp
, listPtr
);
12636 idx
= len
+ idx
+ 1;
12637 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12638 Jim_SetResult(interp
, listPtr
);
12641 if (listPtr
!= argv
[1]) {
12642 Jim_FreeNewObj(interp
, listPtr
);
12648 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12650 int first
, last
, len
, rangeLen
;
12652 Jim_Obj
*newListObj
;
12655 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12658 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12659 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12664 len
= Jim_ListLength(interp
, listObj
);
12666 first
= JimRelToAbsIndex(len
, first
);
12667 last
= JimRelToAbsIndex(len
, last
);
12668 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12670 /* Now construct a new list which consists of:
12671 * <elements before first> <supplied elements> <elements after last>
12674 /* Check to see if trying to replace past the end of the list */
12676 /* OK. Not past the end */
12678 else if (len
== 0) {
12679 /* Special for empty list, adjust first to 0 */
12683 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12684 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12688 /* Add the first set of elements */
12689 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12691 /* Add supplied elements */
12692 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12694 /* Add the remaining elements */
12695 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12697 Jim_SetResult(interp
, newListObj
);
12702 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12705 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12708 else if (argc
== 3) {
12709 /* With no indexes, simply implements [set] */
12710 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12712 Jim_SetResult(interp
, argv
[2]);
12715 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12719 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12721 static const char * const options
[] = {
12722 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12725 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12730 struct lsort_info info
;
12733 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12737 info
.type
= JIM_LSORT_ASCII
;
12741 info
.command
= NULL
;
12742 info
.interp
= interp
;
12744 for (i
= 1; i
< (argc
- 1); i
++) {
12747 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12752 info
.type
= JIM_LSORT_ASCII
;
12755 info
.type
= JIM_LSORT_NOCASE
;
12758 info
.type
= JIM_LSORT_INTEGER
;
12761 info
.type
= JIM_LSORT_REAL
;
12763 case OPT_INCREASING
:
12766 case OPT_DECREASING
:
12773 if (i
>= (argc
- 2)) {
12774 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12777 info
.type
= JIM_LSORT_COMMAND
;
12778 info
.command
= argv
[i
+ 1];
12782 if (i
>= (argc
- 2)) {
12783 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12786 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12794 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12795 retCode
= ListSortElements(interp
, resObj
, &info
);
12796 if (retCode
== JIM_OK
) {
12797 Jim_SetResult(interp
, resObj
);
12800 Jim_FreeNewObj(interp
, resObj
);
12806 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12808 Jim_Obj
*stringObjPtr
;
12812 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12816 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12822 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12823 if (!stringObjPtr
) {
12824 /* Create the string if it doesn't exist */
12825 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12828 else if (Jim_IsShared(stringObjPtr
)) {
12830 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12832 for (i
= 2; i
< argc
; i
++) {
12833 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12835 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12837 Jim_FreeNewObj(interp
, stringObjPtr
);
12842 Jim_SetResult(interp
, stringObjPtr
);
12847 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12849 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12850 static const char * const options
[] = {
12851 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12857 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12858 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12863 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12866 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12868 if (option
== OPT_REFCOUNT
) {
12870 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12873 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12876 else if (option
== OPT_OBJCOUNT
) {
12877 int freeobj
= 0, liveobj
= 0;
12882 Jim_WrongNumArgs(interp
, 2, argv
, "");
12885 /* Count the number of free objects. */
12886 objPtr
= interp
->freeList
;
12889 objPtr
= objPtr
->nextObjPtr
;
12891 /* Count the number of live objects. */
12892 objPtr
= interp
->liveList
;
12895 objPtr
= objPtr
->nextObjPtr
;
12897 /* Set the result string and return. */
12898 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12899 Jim_SetResultString(interp
, buf
, -1);
12902 else if (option
== OPT_OBJECTS
) {
12903 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12905 /* Count the number of live objects. */
12906 objPtr
= interp
->liveList
;
12907 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12910 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12912 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12913 sprintf(buf
, "%p", objPtr
);
12914 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12915 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12916 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12917 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12918 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12919 objPtr
= objPtr
->nextObjPtr
;
12921 Jim_SetResult(interp
, listObjPtr
);
12924 else if (option
== OPT_INVSTR
) {
12928 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12932 if (objPtr
->typePtr
!= NULL
)
12933 Jim_InvalidateStringRep(objPtr
);
12934 Jim_SetEmptyResult(interp
);
12937 else if (option
== OPT_SHOW
) {
12942 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12945 s
= Jim_GetString(argv
[2], &len
);
12947 charlen
= utf8_strlen(s
, len
);
12951 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12952 printf("chars (%d): <<%s>>\n", charlen
, s
);
12953 printf("bytes (%d):", len
);
12955 printf(" %02x", (unsigned char)*s
++);
12960 else if (option
== OPT_SCRIPTLEN
) {
12964 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12967 script
= JimGetScript(interp
, argv
[2]);
12968 if (script
== NULL
)
12970 Jim_SetResultInt(interp
, script
->len
);
12973 else if (option
== OPT_EXPRLEN
) {
12974 ExprByteCode
*expr
;
12977 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12980 expr
= JimGetExpression(interp
, argv
[2]);
12983 Jim_SetResultInt(interp
, expr
->len
);
12986 else if (option
== OPT_EXPRBC
) {
12988 ExprByteCode
*expr
;
12992 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12995 expr
= JimGetExpression(interp
, argv
[2]);
12998 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12999 for (i
= 0; i
< expr
->len
; i
++) {
13001 const Jim_ExprOperator
*op
;
13002 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
13004 switch (expr
->token
[i
].type
) {
13005 case JIM_TT_EXPR_INT
:
13008 case JIM_TT_EXPR_DOUBLE
:
13011 case JIM_TT_EXPR_BOOLEAN
:
13020 case JIM_TT_DICTSUGAR
:
13021 type
= "dictsugar";
13023 case JIM_TT_EXPRSUGAR
:
13024 type
= "exprsugar";
13033 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
13040 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
13043 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
13044 Jim_ListAppendElement(interp
, objPtr
, obj
);
13046 Jim_SetResult(interp
, objPtr
);
13050 Jim_SetResultString(interp
,
13051 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13055 #endif /* JIM_BOOTSTRAP */
13056 #if !defined(JIM_DEBUG_COMMAND)
13057 Jim_SetResultString(interp
, "unsupported", -1);
13063 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13068 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
13073 rc
= Jim_EvalObj(interp
, argv
[1]);
13076 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13079 if (rc
== JIM_ERR
) {
13080 /* eval is "interesting", so add a stack frame here */
13081 interp
->addStackTrace
++;
13087 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13091 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
13094 /* Save the old callframe pointer */
13095 savedCallFrame
= interp
->framePtr
;
13097 /* Lookup the target frame pointer */
13098 str
= Jim_String(argv
[1]);
13099 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
13100 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13105 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13107 if (targetCallFrame
== NULL
) {
13111 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
13114 /* Eval the code in the target callframe. */
13115 interp
->framePtr
= targetCallFrame
;
13117 retcode
= Jim_EvalObj(interp
, argv
[1]);
13120 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13122 interp
->framePtr
= savedCallFrame
;
13126 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
13132 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13134 Jim_Obj
*exprResultPtr
;
13138 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
13140 else if (argc
> 2) {
13143 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
13144 Jim_IncrRefCount(objPtr
);
13145 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
13146 Jim_DecrRefCount(interp
, objPtr
);
13149 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
13152 if (retcode
!= JIM_OK
)
13154 Jim_SetResult(interp
, exprResultPtr
);
13155 Jim_DecrRefCount(interp
, exprResultPtr
);
13160 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13163 Jim_WrongNumArgs(interp
, 1, argv
, "");
13170 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13173 Jim_WrongNumArgs(interp
, 1, argv
, "");
13176 return JIM_CONTINUE
;
13180 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13183 Jim_Obj
*stackTraceObj
= NULL
;
13184 Jim_Obj
*errorCodeObj
= NULL
;
13185 int returnCode
= JIM_OK
;
13188 for (i
= 1; i
< argc
- 1; i
+= 2) {
13189 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13190 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13194 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13195 stackTraceObj
= argv
[i
+ 1];
13197 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13198 errorCodeObj
= argv
[i
+ 1];
13200 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13201 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13202 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13211 if (i
!= argc
- 1 && i
!= argc
) {
13212 Jim_WrongNumArgs(interp
, 1, argv
,
13213 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13216 /* If a stack trace is supplied and code is error, set the stack trace */
13217 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13218 JimSetStackTrace(interp
, stackTraceObj
);
13220 /* If an error code list is supplied, set the global $errorCode */
13221 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13222 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13224 interp
->returnCode
= returnCode
;
13225 interp
->returnLevel
= level
;
13227 if (i
== argc
- 1) {
13228 Jim_SetResult(interp
, argv
[i
]);
13234 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13236 if (interp
->framePtr
->level
== 0) {
13237 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13240 else if (argc
>= 2) {
13241 /* Need to resolve the tailcall command in the current context */
13242 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13244 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13245 if (cmdPtr
== NULL
) {
13249 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13251 /* And stash this pre-resolved command */
13252 JimIncrCmdRefCount(cmdPtr
);
13253 cf
->tailcallCmd
= cmdPtr
;
13255 /* And stash the command list */
13256 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13258 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13259 Jim_IncrRefCount(cf
->tailcallObj
);
13261 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13267 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13270 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13272 /* prefixListObj is a list to which the args need to be appended */
13273 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13274 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13276 return JimEvalObjList(interp
, cmdList
);
13279 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13281 Jim_Obj
*prefixListObj
= privData
;
13282 Jim_DecrRefCount(interp
, prefixListObj
);
13285 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13287 Jim_Obj
*prefixListObj
;
13288 const char *newname
;
13291 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13295 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13296 Jim_IncrRefCount(prefixListObj
);
13297 newname
= Jim_String(argv
[1]);
13298 if (newname
[0] == ':' && newname
[1] == ':') {
13299 while (*++newname
== ':') {
13303 Jim_SetResult(interp
, argv
[1]);
13305 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13309 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13313 if (argc
!= 4 && argc
!= 5) {
13314 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13318 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13323 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13326 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13330 /* Add the new command */
13331 Jim_Obj
*qualifiedCmdNameObj
;
13332 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13334 JimCreateCommand(interp
, cmdname
, cmd
);
13336 /* Calculate and set the namespace for this proc */
13337 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13339 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13341 /* Unlike Tcl, set the name of the proc as the result */
13342 Jim_SetResult(interp
, argv
[1]);
13349 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13354 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13358 /* Evaluate the arguments with 'local' in force */
13360 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13364 /* If OK, and the result is a proc, add it to the list of local procs */
13365 if (retcode
== 0) {
13366 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13368 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13371 if (interp
->framePtr
->localCommands
== NULL
) {
13372 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13373 Jim_InitStack(interp
->framePtr
->localCommands
);
13375 Jim_IncrRefCount(cmdNameObj
);
13376 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13383 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13386 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13392 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13393 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13394 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13397 /* OK. Mark this command as being in an upcall */
13398 cmdPtr
->u
.proc
.upcall
++;
13399 JimIncrCmdRefCount(cmdPtr
);
13401 /* Invoke the command as normal */
13402 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13404 /* No longer in an upcall */
13405 cmdPtr
->u
.proc
.upcall
--;
13406 JimDecrCmdRefCount(interp
, cmdPtr
);
13413 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13416 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13422 Jim_Obj
*argListObjPtr
;
13423 Jim_Obj
*bodyObjPtr
;
13424 Jim_Obj
*nsObj
= NULL
;
13427 int len
= Jim_ListLength(interp
, argv
[1]);
13428 if (len
!= 2 && len
!= 3) {
13429 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13434 #ifdef jim_ext_namespace
13435 /* Need to canonicalise the given namespace. */
13436 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13438 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13442 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13443 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13445 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13448 /* Create a new argv array with a dummy argv[0], for error messages */
13449 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13450 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13451 Jim_IncrRefCount(nargv
[0]);
13452 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13453 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13454 Jim_DecrRefCount(interp
, nargv
[0]);
13457 JimDecrCmdRefCount(interp
, cmd
);
13466 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13468 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13473 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13476 Jim_CallFrame
*targetCallFrame
;
13478 /* Lookup the target frame pointer */
13479 if (argc
> 3 && (argc
% 2 == 0)) {
13480 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13485 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13487 if (targetCallFrame
== NULL
) {
13491 /* Check for arity */
13493 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13497 /* Now... for every other/local couple: */
13498 for (i
= 1; i
< argc
; i
+= 2) {
13499 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13506 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13511 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13514 /* Link every var to the toplevel having the same name */
13515 if (interp
->framePtr
->level
== 0)
13516 return JIM_OK
; /* global at toplevel... */
13517 for (i
= 1; i
< argc
; i
++) {
13518 /* global ::blah does nothing */
13519 const char *name
= Jim_String(argv
[i
]);
13520 if (name
[0] != ':' || name
[1] != ':') {
13521 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13528 /* does the [string map] operation. On error NULL is returned,
13529 * otherwise a new string object with the result, having refcount = 0,
13531 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13532 Jim_Obj
*objPtr
, int nocase
)
13535 const char *str
, *noMatchStart
= NULL
;
13537 Jim_Obj
*resultObjPtr
;
13539 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13541 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13545 str
= Jim_String(objPtr
);
13546 strLen
= Jim_Utf8Length(interp
, objPtr
);
13549 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13551 for (i
= 0; i
< numMaps
; i
+= 2) {
13556 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13557 k
= Jim_String(objPtr
);
13558 kl
= Jim_Utf8Length(interp
, objPtr
);
13560 if (strLen
>= kl
&& kl
) {
13562 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13564 if (noMatchStart
) {
13565 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13566 noMatchStart
= NULL
;
13568 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13569 str
+= utf8_index(str
, kl
);
13575 if (i
== numMaps
) { /* no match */
13577 if (noMatchStart
== NULL
)
13578 noMatchStart
= str
;
13579 str
+= utf8_tounicode(str
, &c
);
13583 if (noMatchStart
) {
13584 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13586 return resultObjPtr
;
13590 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13595 static const char * const options
[] = {
13596 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13597 "map", "repeat", "reverse", "index", "first", "last", "cat",
13598 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13602 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13603 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13604 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13606 static const char * const nocase_options
[] = {
13609 static const char * const nocase_length_options
[] = {
13610 "-nocase", "-length", NULL
13614 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13617 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13618 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13623 case OPT_BYTELENGTH
:
13625 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13628 if (option
== OPT_LENGTH
) {
13629 len
= Jim_Utf8Length(interp
, argv
[2]);
13632 len
= Jim_Length(argv
[2]);
13634 Jim_SetResultInt(interp
, len
);
13640 /* optimise the one-arg case */
13646 objPtr
= Jim_NewStringObj(interp
, "", 0);
13648 for (i
= 2; i
< argc
; i
++) {
13649 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13652 Jim_SetResult(interp
, objPtr
);
13659 /* n is the number of remaining option args */
13660 long opt_length
= -1;
13665 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13666 JIM_ENUM_ABBREV
) != JIM_OK
) {
13668 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13679 goto badcompareargs
;
13681 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13688 goto badcompareargs
;
13691 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13692 /* Fast version - [string equal], case sensitive, no length */
13693 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13696 if (opt_length
>= 0) {
13697 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13700 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13702 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13710 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13711 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13712 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13715 if (opt_case
== 0) {
13718 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13726 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13727 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13728 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13732 if (opt_case
== 0) {
13735 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13736 if (objPtr
== NULL
) {
13739 Jim_SetResult(interp
, objPtr
);
13744 case OPT_BYTERANGE
:{
13748 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13751 if (option
== OPT_RANGE
) {
13752 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13756 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13759 if (objPtr
== NULL
) {
13762 Jim_SetResult(interp
, objPtr
);
13769 if (argc
!= 5 && argc
!= 6) {
13770 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13773 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13774 if (objPtr
== NULL
) {
13777 Jim_SetResult(interp
, objPtr
);
13787 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13790 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13793 objPtr
= Jim_NewStringObj(interp
, "", 0);
13796 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13799 Jim_SetResult(interp
, objPtr
);
13810 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13814 str
= Jim_GetString(argv
[2], &len
);
13815 buf
= Jim_Alloc(len
+ 1);
13818 for (i
= 0; i
< len
; ) {
13820 int l
= utf8_tounicode(str
, &c
);
13821 memcpy(p
- l
, str
, l
);
13826 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13835 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13838 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13841 str
= Jim_String(argv
[2]);
13842 len
= Jim_Utf8Length(interp
, argv
[2]);
13843 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13844 idx
= JimRelToAbsIndex(len
, idx
);
13846 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13847 Jim_SetResultString(interp
, "", 0);
13849 else if (len
== Jim_Length(argv
[2])) {
13850 /* ASCII optimisation */
13851 Jim_SetResultString(interp
, str
+ idx
, 1);
13855 int i
= utf8_index(str
, idx
);
13856 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13863 int idx
= 0, l1
, l2
;
13864 const char *s1
, *s2
;
13866 if (argc
!= 4 && argc
!= 5) {
13867 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13870 s1
= Jim_String(argv
[2]);
13871 s2
= Jim_String(argv
[3]);
13872 l1
= Jim_Utf8Length(interp
, argv
[2]);
13873 l2
= Jim_Utf8Length(interp
, argv
[3]);
13875 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13878 idx
= JimRelToAbsIndex(l2
, idx
);
13880 else if (option
== OPT_LAST
) {
13883 if (option
== OPT_FIRST
) {
13884 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13888 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13890 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13898 case OPT_TRIMRIGHT
:{
13899 Jim_Obj
*trimchars
;
13901 if (argc
!= 3 && argc
!= 4) {
13902 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13905 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13906 if (option
== OPT_TRIM
) {
13907 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13909 else if (option
== OPT_TRIMLEFT
) {
13910 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13912 else if (option
== OPT_TRIMRIGHT
) {
13913 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13922 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13925 if (option
== OPT_TOLOWER
) {
13926 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13928 else if (option
== OPT_TOUPPER
) {
13929 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13932 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13937 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13938 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13940 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13947 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13950 jim_wide start
, elapsed
;
13952 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13955 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13959 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13965 start
= JimClock();
13969 retval
= Jim_EvalObj(interp
, argv
[1]);
13970 if (retval
!= JIM_OK
) {
13974 elapsed
= JimClock() - start
;
13975 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13976 Jim_SetResultString(interp
, buf
, -1);
13981 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13986 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13990 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13993 interp
->exitCode
= exitCode
;
13998 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14004 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14005 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
14006 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
14008 /* Reset the error code before catch.
14009 * Note that this is not strictly correct.
14011 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
14013 for (i
= 1; i
< argc
- 1; i
++) {
14014 const char *arg
= Jim_String(argv
[i
]);
14018 /* It's a pity we can't use Jim_GetEnum here :-( */
14019 if (strcmp(arg
, "--") == 0) {
14027 if (strncmp(arg
, "-no", 3) == 0) {
14036 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
14040 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
14047 ignore_mask
|= ((jim_wide
)1 << option
);
14050 ignore_mask
&= (~((jim_wide
)1 << option
));
14055 if (argc
< 1 || argc
> 3) {
14057 Jim_WrongNumArgs(interp
, 1, argv
,
14058 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14063 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
14067 interp
->signal_level
+= sig
;
14068 if (Jim_CheckSignal(interp
)) {
14069 /* If a signal is set, don't even try to execute the body */
14070 exitCode
= JIM_SIGNAL
;
14073 exitCode
= Jim_EvalObj(interp
, argv
[0]);
14074 /* Don't want any caught error included in a later stack trace */
14075 interp
->errorFlag
= 0;
14077 interp
->signal_level
-= sig
;
14079 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14080 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
14081 /* Not caught, pass it up */
14085 if (sig
&& exitCode
== JIM_SIGNAL
) {
14086 /* Catch the signal at this level */
14087 if (interp
->signal_set_result
) {
14088 interp
->signal_set_result(interp
, interp
->sigmask
);
14091 Jim_SetResultInt(interp
, interp
->sigmask
);
14093 interp
->sigmask
= 0;
14097 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
14101 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
14103 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
14104 Jim_ListAppendElement(interp
, optListObj
,
14105 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
14106 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
14107 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
14108 if (exitCode
== JIM_ERR
) {
14109 Jim_Obj
*errorCode
;
14110 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
14112 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
14114 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
14116 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
14117 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
14120 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
14125 Jim_SetResultInt(interp
, exitCode
);
14129 #ifdef JIM_REFERENCES
14132 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14134 if (argc
!= 3 && argc
!= 4) {
14135 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
14139 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
14142 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
14148 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14150 Jim_Reference
*refPtr
;
14153 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14156 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14158 Jim_SetResult(interp
, refPtr
->objPtr
);
14163 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14165 Jim_Reference
*refPtr
;
14168 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14171 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14173 Jim_IncrRefCount(argv
[2]);
14174 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14175 refPtr
->objPtr
= argv
[2];
14176 Jim_SetResult(interp
, argv
[2]);
14181 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14184 Jim_WrongNumArgs(interp
, 1, argv
, "");
14187 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14189 /* Free all the freed objects. */
14190 while (interp
->freeList
) {
14191 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14192 Jim_Free(interp
->freeList
);
14193 interp
->freeList
= nextObjPtr
;
14199 /* [finalize] reference ?newValue? */
14200 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14202 if (argc
!= 2 && argc
!= 3) {
14203 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14207 Jim_Obj
*cmdNamePtr
;
14209 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14211 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14212 Jim_SetResult(interp
, cmdNamePtr
);
14215 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14217 Jim_SetResult(interp
, argv
[2]);
14222 /* [info references] */
14223 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14225 Jim_Obj
*listObjPtr
;
14226 Jim_HashTableIterator htiter
;
14229 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14231 JimInitHashTableIterator(&interp
->references
, &htiter
);
14232 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14233 char buf
[JIM_REFERENCE_SPACE
+ 1];
14234 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14235 const unsigned long *refId
= he
->key
;
14237 JimFormatReference(buf
, refPtr
, *refId
);
14238 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14240 Jim_SetResult(interp
, listObjPtr
);
14246 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14249 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14253 if (JimValidName(interp
, "new procedure", argv
[2])) {
14257 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14260 #define JIM_DICTMATCH_VALUES 0x0001
14262 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14264 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14266 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14267 if (type
& JIM_DICTMATCH_VALUES
) {
14268 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14273 * Like JimHashtablePatternMatch, but for dictionaries.
14275 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14276 JimDictMatchCallbackType
*callback
, int type
)
14279 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14281 /* Check for the non-pattern case. We can do this much more efficiently. */
14282 Jim_HashTableIterator htiter
;
14283 JimInitHashTableIterator(ht
, &htiter
);
14284 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14285 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14286 callback(interp
, listObjPtr
, he
, type
);
14294 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14296 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14299 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14303 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14305 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14308 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14312 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14314 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14317 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14320 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14325 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14329 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14331 /* Note that this uses internal knowledge of the hash table */
14332 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14334 for (i
= 0; i
< ht
->size
; i
++) {
14335 Jim_HashEntry
*he
= ht
->table
[i
];
14341 printf(" %s", Jim_String(he
->key
));
14350 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14352 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14354 Jim_AppendString(interp
, prefixObj
, " ", 1);
14355 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14357 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14361 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14365 static const char * const options
[] = {
14366 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14367 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14368 "replace", "update", NULL
14372 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14373 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14374 OPT_REPLACE
, OPT_UPDATE
,
14378 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14382 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14389 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14392 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14393 JIM_ERRMSG
) != JIM_OK
) {
14396 Jim_SetResult(interp
, objPtr
);
14401 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14404 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14408 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14412 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14416 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14422 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14425 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14431 if (argc
!= 3 && argc
!= 4) {
14432 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14435 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14439 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14442 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14445 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14452 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14455 /* Handle as ensemble */
14459 if (argc
< 6 || argc
% 2) {
14460 /* Better error message */
14467 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14470 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14471 Jim_SetResult(interp
, objPtr
);
14476 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14479 return Jim_DictInfo(interp
, argv
[2]);
14481 /* Handle command as an ensemble */
14482 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14486 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14488 static const char * const options
[] = {
14489 "-nobackslashes", "-nocommands", "-novariables", NULL
14492 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14494 int flags
= JIM_SUBST_FLAG
;
14498 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14501 for (i
= 1; i
< (argc
- 1); i
++) {
14504 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14505 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14509 case OPT_NOBACKSLASHES
:
14510 flags
|= JIM_SUBST_NOESC
;
14512 case OPT_NOCOMMANDS
:
14513 flags
|= JIM_SUBST_NOCMD
;
14515 case OPT_NOVARIABLES
:
14516 flags
|= JIM_SUBST_NOVAR
;
14520 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14523 Jim_SetResult(interp
, objPtr
);
14528 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14534 static const char * const commands
[] = {
14535 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14536 "vars", "version", "patchlevel", "complete", "args", "hostname",
14537 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14538 "references", "alias", NULL
14541 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14542 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14543 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14544 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14547 #ifdef jim_ext_namespace
14550 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14551 /* This is for internal use only */
14559 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14562 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14567 /* Test for the most common commands first, just in case it makes a difference */
14571 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14574 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14581 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14584 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14587 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14588 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14591 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14595 case INFO_CHANNELS
:
14596 mode
++; /* JIM_CMDLIST_CHANNELS */
14597 #ifndef jim_ext_aio
14598 Jim_SetResultString(interp
, "aio not enabled", -1);
14603 mode
++; /* JIM_CMDLIST_PROCS */
14605 case INFO_COMMANDS
:
14606 /* mode 0 => JIM_CMDLIST_COMMANDS */
14607 if (argc
!= 2 && argc
!= 3) {
14608 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14611 #ifdef jim_ext_namespace
14613 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14614 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14618 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14622 mode
++; /* JIM_VARLIST_VARS */
14625 mode
++; /* JIM_VARLIST_LOCALS */
14628 /* mode 0 => JIM_VARLIST_GLOBALS */
14629 if (argc
!= 2 && argc
!= 3) {
14630 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14633 #ifdef jim_ext_namespace
14635 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14636 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14640 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14645 Jim_WrongNumArgs(interp
, 2, argv
, "");
14648 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14653 Jim_Obj
*resObjPtr
;
14654 Jim_Obj
*fileNameObj
;
14656 if (argc
!= 3 && argc
!= 5) {
14657 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14661 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14664 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14665 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14668 if (argv
[2]->typePtr
== &sourceObjType
) {
14669 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14670 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14672 else if (argv
[2]->typePtr
== &scriptObjType
) {
14673 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14674 fileNameObj
= script
->fileNameObj
;
14675 line
= script
->firstline
;
14678 fileNameObj
= interp
->emptyObj
;
14681 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14682 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14683 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14685 Jim_SetResult(interp
, resObjPtr
);
14689 case INFO_STACKTRACE
:
14690 Jim_SetResult(interp
, interp
->stackTrace
);
14697 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14701 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14704 Jim_SetResult(interp
, objPtr
);
14708 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14719 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14722 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14725 if (!cmdPtr
->isproc
) {
14726 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14731 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14734 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14737 if (cmdPtr
->u
.proc
.staticVars
) {
14738 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14739 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14740 NULL
, JimVariablesMatch
, mode
));
14748 case INFO_PATCHLEVEL
:{
14749 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14751 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14752 Jim_SetResultString(interp
, buf
, -1);
14756 case INFO_COMPLETE
:
14757 if (argc
!= 3 && argc
!= 4) {
14758 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14764 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(interp
, argv
[2], &missing
));
14765 if (missing
!= ' ' && argc
== 4) {
14766 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14771 case INFO_HOSTNAME
:
14772 /* Redirect to os.gethostname if it exists */
14773 return Jim_Eval(interp
, "os.gethostname");
14775 case INFO_NAMEOFEXECUTABLE
:
14776 /* Redirect to Tcl proc */
14777 return Jim_Eval(interp
, "{info nameofexecutable}");
14779 case INFO_RETURNCODES
:
14782 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14784 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14785 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14786 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14787 jimReturnCodes
[i
], -1));
14790 Jim_SetResult(interp
, listObjPtr
);
14792 else if (argc
== 3) {
14796 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14799 name
= Jim_ReturnCode(code
);
14800 if (*name
== '?') {
14801 Jim_SetResultInt(interp
, code
);
14804 Jim_SetResultString(interp
, name
, -1);
14808 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14812 case INFO_REFERENCES
:
14813 #ifdef JIM_REFERENCES
14814 return JimInfoReferences(interp
, argc
, argv
);
14816 Jim_SetResultString(interp
, "not supported", -1);
14824 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14829 static const char * const options
[] = {
14830 "-command", "-proc", "-alias", "-var", NULL
14834 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14842 else if (argc
== 3) {
14843 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14849 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14853 if (option
== OPT_VAR
) {
14854 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14857 /* Now different kinds of commands */
14858 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14867 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14871 result
= cmd
->isproc
;
14876 Jim_SetResultBool(interp
, result
);
14881 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14883 const char *str
, *splitChars
, *noMatchStart
;
14884 int splitLen
, strLen
;
14885 Jim_Obj
*resObjPtr
;
14889 if (argc
!= 2 && argc
!= 3) {
14890 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14894 str
= Jim_GetString(argv
[1], &len
);
14898 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14902 splitChars
= " \n\t\r";
14906 splitChars
= Jim_String(argv
[2]);
14907 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14910 noMatchStart
= str
;
14911 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14917 const char *sc
= splitChars
;
14918 int scLen
= splitLen
;
14919 int sl
= utf8_tounicode(str
, &c
);
14922 sc
+= utf8_tounicode(sc
, &pc
);
14924 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14925 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14926 noMatchStart
= str
+ sl
;
14932 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14933 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14936 /* This handles the special case of splitchars eq {}
14937 * Optimise by sharing common (ASCII) characters
14939 Jim_Obj
**commonObj
= NULL
;
14940 #define NUM_COMMON (128 - 9)
14942 int n
= utf8_tounicode(str
, &c
);
14943 #ifdef JIM_OPTIMIZATION
14944 if (c
>= 9 && c
< 128) {
14945 /* Common ASCII char. Note that 9 is the tab character */
14948 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14949 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14951 if (!commonObj
[c
]) {
14952 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14954 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14959 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14962 Jim_Free(commonObj
);
14965 Jim_SetResult(interp
, resObjPtr
);
14970 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14972 const char *joinStr
;
14975 if (argc
!= 2 && argc
!= 3) {
14976 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14985 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14987 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14992 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14997 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
15000 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
15001 if (objPtr
== NULL
)
15003 Jim_SetResult(interp
, objPtr
);
15008 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15010 Jim_Obj
*listPtr
, **outVec
;
15014 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
15017 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
15018 SetScanFmtFromAny(interp
, argv
[2]);
15019 if (FormatGetError(argv
[2]) != 0) {
15020 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
15024 int maxPos
= FormatGetMaxPos(argv
[2]);
15025 int count
= FormatGetCnvCount(argv
[2]);
15027 if (maxPos
> argc
- 3) {
15028 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
15031 else if (count
> argc
- 3) {
15032 Jim_SetResultString(interp
, "different numbers of variable names and "
15033 "field specifiers", -1);
15036 else if (count
< argc
- 3) {
15037 Jim_SetResultString(interp
, "variable is not assigned by any "
15038 "conversion specifiers", -1);
15042 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
15049 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
15050 int len
= Jim_ListLength(interp
, listPtr
);
15053 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
15054 for (i
= 0; i
< outc
; ++i
) {
15055 if (Jim_Length(outVec
[i
]) > 0) {
15057 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
15063 Jim_FreeNewObj(interp
, listPtr
);
15068 if (rc
== JIM_OK
) {
15069 Jim_SetResultInt(interp
, count
);
15074 if (listPtr
== (Jim_Obj
*)EOF
) {
15075 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
15078 Jim_SetResult(interp
, listPtr
);
15084 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15086 if (argc
!= 2 && argc
!= 3) {
15087 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
15090 Jim_SetResult(interp
, argv
[1]);
15092 JimSetStackTrace(interp
, argv
[2]);
15095 interp
->addStackTrace
++;
15100 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15105 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
15108 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
15110 Jim_SetResult(interp
, objPtr
);
15115 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15120 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
15121 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
15125 if (count
== 0 || argc
== 2) {
15132 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
15134 ListInsertElements(objPtr
, -1, argc
, argv
);
15137 Jim_SetResult(interp
, objPtr
);
15141 char **Jim_GetEnviron(void)
15143 #if defined(HAVE__NSGETENVIRON)
15144 return *_NSGetEnviron();
15146 #if !defined(NO_ENVIRON_EXTERN)
15147 extern char **environ
;
15154 void Jim_SetEnviron(char **env
)
15156 #if defined(HAVE__NSGETENVIRON)
15157 *_NSGetEnviron() = env
;
15159 #if !defined(NO_ENVIRON_EXTERN)
15160 extern char **environ
;
15168 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15174 char **e
= Jim_GetEnviron();
15177 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15179 for (i
= 0; e
[i
]; i
++) {
15180 const char *equals
= strchr(e
[i
], '=');
15183 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15185 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15189 Jim_SetResult(interp
, listObjPtr
);
15194 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15197 key
= Jim_String(argv
[1]);
15201 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15204 val
= Jim_String(argv
[2]);
15206 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15211 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15216 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15219 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15220 if (retval
== JIM_RETURN
)
15226 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15228 Jim_Obj
*revObjPtr
, **ele
;
15232 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15235 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15237 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15239 ListAppendElement(revObjPtr
, ele
[len
--]);
15240 Jim_SetResult(interp
, revObjPtr
);
15244 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15252 else if (step
> 0 && start
> end
)
15254 else if (step
< 0 && end
> start
)
15258 len
= -len
; /* abs(len) */
15260 step
= -step
; /* abs(step) */
15261 len
= 1 + ((len
- 1) / step
);
15262 /* We can truncate safely to INT_MAX, the range command
15263 * will always return an error for a such long range
15264 * because Tcl lists can't be so long. */
15267 return (int)((len
< 0) ? -1 : len
);
15271 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15273 jim_wide start
= 0, end
, step
= 1;
15277 if (argc
< 2 || argc
> 4) {
15278 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15282 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15286 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15287 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15289 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15292 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15293 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15296 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15297 for (i
= 0; i
< len
; i
++)
15298 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15299 Jim_SetResult(interp
, objPtr
);
15304 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15306 jim_wide min
= 0, max
= 0, len
, maxMul
;
15308 if (argc
< 1 || argc
> 3) {
15309 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15313 max
= JIM_WIDE_MAX
;
15314 } else if (argc
== 2) {
15315 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15317 } else if (argc
== 3) {
15318 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15319 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15324 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15327 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15331 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15332 if (r
< 0 || r
>= maxMul
) continue;
15333 r
= (len
== 0) ? 0 : r
%len
;
15334 Jim_SetResultInt(interp
, min
+r
);
15339 static const struct {
15341 Jim_CmdProc
*cmdProc
;
15342 } Jim_CoreCommandsTable
[] = {
15343 {"alias", Jim_AliasCoreCommand
},
15344 {"set", Jim_SetCoreCommand
},
15345 {"unset", Jim_UnsetCoreCommand
},
15346 {"puts", Jim_PutsCoreCommand
},
15347 {"+", Jim_AddCoreCommand
},
15348 {"*", Jim_MulCoreCommand
},
15349 {"-", Jim_SubCoreCommand
},
15350 {"/", Jim_DivCoreCommand
},
15351 {"incr", Jim_IncrCoreCommand
},
15352 {"while", Jim_WhileCoreCommand
},
15353 {"loop", Jim_LoopCoreCommand
},
15354 {"for", Jim_ForCoreCommand
},
15355 {"foreach", Jim_ForeachCoreCommand
},
15356 {"lmap", Jim_LmapCoreCommand
},
15357 {"lassign", Jim_LassignCoreCommand
},
15358 {"if", Jim_IfCoreCommand
},
15359 {"switch", Jim_SwitchCoreCommand
},
15360 {"list", Jim_ListCoreCommand
},
15361 {"lindex", Jim_LindexCoreCommand
},
15362 {"lset", Jim_LsetCoreCommand
},
15363 {"lsearch", Jim_LsearchCoreCommand
},
15364 {"llength", Jim_LlengthCoreCommand
},
15365 {"lappend", Jim_LappendCoreCommand
},
15366 {"linsert", Jim_LinsertCoreCommand
},
15367 {"lreplace", Jim_LreplaceCoreCommand
},
15368 {"lsort", Jim_LsortCoreCommand
},
15369 {"append", Jim_AppendCoreCommand
},
15370 {"debug", Jim_DebugCoreCommand
},
15371 {"eval", Jim_EvalCoreCommand
},
15372 {"uplevel", Jim_UplevelCoreCommand
},
15373 {"expr", Jim_ExprCoreCommand
},
15374 {"break", Jim_BreakCoreCommand
},
15375 {"continue", Jim_ContinueCoreCommand
},
15376 {"proc", Jim_ProcCoreCommand
},
15377 {"concat", Jim_ConcatCoreCommand
},
15378 {"return", Jim_ReturnCoreCommand
},
15379 {"upvar", Jim_UpvarCoreCommand
},
15380 {"global", Jim_GlobalCoreCommand
},
15381 {"string", Jim_StringCoreCommand
},
15382 {"time", Jim_TimeCoreCommand
},
15383 {"exit", Jim_ExitCoreCommand
},
15384 {"catch", Jim_CatchCoreCommand
},
15385 #ifdef JIM_REFERENCES
15386 {"ref", Jim_RefCoreCommand
},
15387 {"getref", Jim_GetrefCoreCommand
},
15388 {"setref", Jim_SetrefCoreCommand
},
15389 {"finalize", Jim_FinalizeCoreCommand
},
15390 {"collect", Jim_CollectCoreCommand
},
15392 {"rename", Jim_RenameCoreCommand
},
15393 {"dict", Jim_DictCoreCommand
},
15394 {"subst", Jim_SubstCoreCommand
},
15395 {"info", Jim_InfoCoreCommand
},
15396 {"exists", Jim_ExistsCoreCommand
},
15397 {"split", Jim_SplitCoreCommand
},
15398 {"join", Jim_JoinCoreCommand
},
15399 {"format", Jim_FormatCoreCommand
},
15400 {"scan", Jim_ScanCoreCommand
},
15401 {"error", Jim_ErrorCoreCommand
},
15402 {"lrange", Jim_LrangeCoreCommand
},
15403 {"lrepeat", Jim_LrepeatCoreCommand
},
15404 {"env", Jim_EnvCoreCommand
},
15405 {"source", Jim_SourceCoreCommand
},
15406 {"lreverse", Jim_LreverseCoreCommand
},
15407 {"range", Jim_RangeCoreCommand
},
15408 {"rand", Jim_RandCoreCommand
},
15409 {"tailcall", Jim_TailcallCoreCommand
},
15410 {"local", Jim_LocalCoreCommand
},
15411 {"upcall", Jim_UpcallCoreCommand
},
15412 {"apply", Jim_ApplyCoreCommand
},
15416 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15420 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15421 Jim_CreateCommand(interp
,
15422 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15427 /* -----------------------------------------------------------------------------
15428 * Interactive prompt
15429 * ---------------------------------------------------------------------------*/
15430 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15434 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15435 argv
[1] = interp
->result
;
15437 Jim_EvalObjVector(interp
, 2, argv
);
15440 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15441 const char *prefix
, const char *const *tablePtr
, const char *name
)
15444 char **tablePtrSorted
;
15447 for (count
= 0; tablePtr
[count
]; count
++) {
15450 if (name
== NULL
) {
15454 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15455 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15456 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15457 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15458 for (i
= 0; i
< count
; i
++) {
15459 if (i
+ 1 == count
&& count
> 1) {
15460 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15462 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15463 if (i
+ 1 != count
) {
15464 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15467 Jim_Free(tablePtrSorted
);
15470 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15471 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15473 const char *bad
= "bad ";
15474 const char *const *entryPtr
= NULL
;
15478 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15482 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15483 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15484 /* Found an exact match */
15488 if (flags
& JIM_ENUM_ABBREV
) {
15489 /* Accept an unambiguous abbreviation.
15490 * Note that '-' doesnt' consitute a valid abbreviation
15492 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15493 if (*arg
== '-' && arglen
== 1) {
15497 bad
= "ambiguous ";
15505 /* If we had an unambiguous partial match */
15512 if (flags
& JIM_ERRMSG
) {
15513 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15518 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15522 for (i
= 0; i
< (int)len
; i
++) {
15523 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15530 int Jim_IsDict(Jim_Obj
*objPtr
)
15532 return objPtr
->typePtr
== &dictObjType
;
15535 int Jim_IsList(Jim_Obj
*objPtr
)
15537 return objPtr
->typePtr
== &listObjType
;
15541 * Very simple printf-like formatting, designed for error messages.
15543 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15544 * The resulting string is created and set as the result.
15546 * Each '%s' should correspond to a regular string parameter.
15547 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15548 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15550 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15552 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15554 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15556 /* Initial space needed */
15557 int len
= strlen(format
);
15560 const char *params
[5];
15565 va_start(args
, format
);
15567 for (i
= 0; i
< len
&& n
< 5; i
++) {
15570 if (strncmp(format
+ i
, "%s", 2) == 0) {
15571 params
[n
] = va_arg(args
, char *);
15573 l
= strlen(params
[n
]);
15575 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15576 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15578 params
[n
] = Jim_GetString(objPtr
, &l
);
15581 if (format
[i
] == '%') {
15591 buf
= Jim_Alloc(len
+ 1);
15592 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15596 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15600 #ifndef jim_ext_package
15601 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15606 #ifndef jim_ext_aio
15607 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15609 Jim_SetResultString(interp
, "aio not enabled", -1);
15616 * Local Variables: ***
15617 * c-basic-offset: 4 ***