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
)
568 if ((b
== 0 && e
!= 0) || (e
< 0))
570 for (i
= 0; i
< e
; i
++) {
576 /* -----------------------------------------------------------------------------
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition
, const char *fmt
, ...)
590 fprintf(stderr
, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr
, fmt
, ap
);
592 fprintf(stderr
, "\n\n");
595 #ifdef HAVE_BACKTRACE
601 size
= backtrace(array
, 40);
602 strings
= backtrace_symbols(array
, size
);
603 for (i
= 0; i
< size
; i
++)
604 fprintf(stderr
, "[backtrace] %s\n", strings
[i
]);
605 fprintf(stderr
, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report.\n");
614 /* -----------------------------------------------------------------------------
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size
)
620 return size
? malloc(size
) : NULL
;
623 void Jim_Free(void *ptr
)
628 void *Jim_Realloc(void *ptr
, int size
)
630 return realloc(ptr
, size
);
633 char *Jim_StrDup(const char *s
)
638 char *Jim_StrDupLen(const char *s
, int l
)
640 char *copy
= Jim_Alloc(l
+ 1);
642 memcpy(copy
, s
, l
+ 1);
643 copy
[l
] = 0; /* Just to be sure, original could be substring */
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide
JimClock(void)
656 gettimeofday(&tv
, NULL
);
657 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
660 /* -----------------------------------------------------------------------------
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
666 static unsigned int JimHashTableNextPower(unsigned int size
);
667 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key
)
683 /* Generic hash function (we are using to multiply by 9 and add the byte
685 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
690 h
+= (h
<< 3) + *buf
++;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable
*ht
)
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht
->uniq
= (rand() ^ time(NULL
) ^ clock());
714 static void JimInitHashTableIterator(Jim_HashTable
*ht
, Jim_HashTableIterator
*iter
)
719 iter
->nextEntry
= NULL
;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
725 JimResetHashTable(ht
);
727 ht
->privdata
= privDataPtr
;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable
*ht
)
735 int minimal
= ht
->used
;
737 if (minimal
< JIM_HT_INITIAL_SIZE
)
738 minimal
= JIM_HT_INITIAL_SIZE
;
739 Jim_ExpandHashTable(ht
, minimal
);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
745 Jim_HashTable n
; /* the new hashtable */
746 unsigned int realsize
= JimHashTableNextPower(size
), i
;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size
<= ht
->used
)
753 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
755 n
.sizemask
= realsize
- 1;
756 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
757 /* Keep the same 'uniq' as the original */
760 /* Initialize all the pointers to NULL */
761 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
767 for (i
= 0; ht
->used
> 0; i
++) {
768 Jim_HashEntry
*he
, *nextHe
;
770 if (ht
->table
[i
] == NULL
)
773 /* For each hash entry on this slot... */
779 /* Get the new element index */
780 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
781 he
->next
= n
.table
[h
];
784 /* Pass to the next element */
788 assert(ht
->used
== 0);
791 /* Remap the new hashtable in the old */
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
798 Jim_HashEntry
*entry
;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry
= JimInsertHashEntry(ht
, key
, 0);
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht
, entry
, key
);
808 Jim_SetHashVal(ht
, entry
, val
);
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
816 Jim_HashEntry
*entry
;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry
= JimInsertHashEntry(ht
, key
, 1);
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht
->type
->valDestructor
&& ht
->type
->valDup
) {
828 void *newval
= ht
->type
->valDup(ht
->privdata
, val
);
829 ht
->type
->valDestructor(ht
->privdata
, entry
->u
.val
);
830 entry
->u
.val
= newval
;
833 Jim_FreeEntryVal(ht
, entry
);
834 Jim_SetHashVal(ht
, entry
, val
);
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht
, entry
, key
);
841 Jim_SetHashVal(ht
, entry
, val
);
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
852 Jim_HashEntry
*he
, *prevHe
;
856 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
861 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
862 /* Unlink the element from the list */
864 prevHe
->next
= he
->next
;
866 ht
->table
[h
] = he
->next
;
867 Jim_FreeEntryKey(ht
, he
);
868 Jim_FreeEntryVal(ht
, he
);
876 return JIM_ERR
; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable
*ht
)
884 /* Free all the elements */
885 for (i
= 0; ht
->used
> 0; i
++) {
886 Jim_HashEntry
*he
, *nextHe
;
888 if ((he
= ht
->table
[i
]) == NULL
)
892 Jim_FreeEntryKey(ht
, he
);
893 Jim_FreeEntryVal(ht
, he
);
899 /* Free the table and the allocated cache structure */
901 /* Re-initialize the table */
902 JimResetHashTable(ht
);
903 return JIM_OK
; /* never fails */
906 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
913 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
916 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
923 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
925 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
926 JimInitHashTableIterator(ht
, iter
);
930 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
933 if (iter
->entry
== NULL
) {
935 if (iter
->index
>= (signed)iter
->ht
->size
)
937 iter
->entry
= iter
->ht
->table
[iter
->index
];
940 iter
->entry
= iter
->nextEntry
;
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter
->nextEntry
= iter
->entry
->next
;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
960 Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
961 if (ht
->size
== ht
->used
)
962 Jim_ExpandHashTable(ht
, ht
->size
* 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size
)
968 unsigned int i
= JIM_HT_INITIAL_SIZE
;
970 if (size
>= 2147483648U)
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
)
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht
);
990 /* Compute the key hash value */
991 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
992 /* Search if this slot does not already contain the given key */
995 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
996 return replace
? he
: NULL
;
1000 /* Allocates the memory and stores key */
1001 he
= Jim_Alloc(sizeof(*he
));
1002 he
->next
= ht
->table
[h
];
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key
)
1014 return Jim_GenHashFunction(key
, strlen(key
));
1017 static void *JimStringCopyHTDup(void *privdata
, const void *key
)
1019 return Jim_StrDup(key
);
1022 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
1024 return strcmp(key1
, key2
) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata
, void *key
)
1032 static const Jim_HashTableType JimPackageHashTableType
= {
1033 JimStringCopyHTHashFunction
, /* hash function */
1034 JimStringCopyHTDup
, /* key dup */
1036 JimStringCopyHTKeyCompare
, /* key compare */
1037 JimStringCopyHTKeyDestructor
, /* key destructor */
1038 NULL
/* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc
*delProc
;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1049 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
1051 if (assocPtr
->delProc
!= NULL
)
1052 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1056 static const Jim_HashTableType JimAssocDataHashTableType
= {
1057 JimStringCopyHTHashFunction
, /* hash function */
1058 JimStringCopyHTDup
, /* key dup */
1060 JimStringCopyHTKeyCompare
, /* key compare */
1061 JimStringCopyHTKeyDestructor
, /* key destructor */
1062 JimAssocDataHashTableValueDestructor
/* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack
*stack
)
1073 stack
->vector
= NULL
;
1076 void Jim_FreeStack(Jim_Stack
*stack
)
1078 Jim_Free(stack
->vector
);
1081 int Jim_StackLen(Jim_Stack
*stack
)
1086 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
1088 int neededLen
= stack
->len
+ 1;
1090 if (neededLen
> stack
->maxlen
) {
1091 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
1092 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
1094 stack
->vector
[stack
->len
] = element
;
1098 void *Jim_StackPop(Jim_Stack
*stack
)
1100 if (stack
->len
== 0)
1103 return stack
->vector
[stack
->len
];
1106 void *Jim_StackPeek(Jim_Stack
*stack
)
1108 if (stack
->len
== 0)
1110 return stack
->vector
[stack
->len
- 1];
1113 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
1117 for (i
= 0; i
< stack
->len
; i
++)
1118 freeFunc(stack
->vector
[i
]);
1121 /* -----------------------------------------------------------------------------
1123 * ---------------------------------------------------------------------------*/
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing
{
1163 int ch
; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1164 int line
; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1171 const char *p
; /* Pointer to the point of the program we are parsing */
1172 int len
; /* Remaining length */
1173 int linenr
; /* Current line number */
1175 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline
; /* Line number of the returned token */
1177 int tt
; /* Token type */
1178 int eof
; /* Non zero if EOF condition is true. */
1179 int state
; /* Parser state */
1180 int comment
; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing
; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx
*pc
);
1185 static int JimParseSep(struct JimParserCtx
*pc
);
1186 static int JimParseEol(struct JimParserCtx
*pc
);
1187 static int JimParseCmd(struct JimParserCtx
*pc
);
1188 static int JimParseQuote(struct JimParserCtx
*pc
);
1189 static int JimParseVar(struct JimParserCtx
*pc
);
1190 static int JimParseBrace(struct JimParserCtx
*pc
);
1191 static int JimParseStr(struct JimParserCtx
*pc
);
1192 static int JimParseComment(struct JimParserCtx
*pc
);
1193 static void JimParseSubCmd(struct JimParserCtx
*pc
);
1194 static int JimParseSubQuote(struct JimParserCtx
*pc
);
1195 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1207 pc
->tt
= JIM_TT_NONE
;
1209 pc
->state
= JIM_PS_DEF
;
1210 pc
->linenr
= linenr
;
1212 pc
->missing
.ch
= ' ';
1213 pc
->missing
.line
= linenr
;
1216 static int JimParseScript(struct JimParserCtx
*pc
)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1221 pc
->tend
= pc
->p
- 1;
1222 pc
->tline
= pc
->linenr
;
1223 pc
->tt
= JIM_TT_EOL
;
1229 if (*(pc
->p
+ 1) == '\n' && pc
->state
== JIM_PS_DEF
) {
1230 return JimParseSep(pc
);
1233 return JimParseStr(pc
);
1238 if (pc
->state
== JIM_PS_DEF
)
1239 return JimParseSep(pc
);
1241 return JimParseStr(pc
);
1245 if (pc
->state
== JIM_PS_DEF
)
1246 return JimParseEol(pc
);
1247 return JimParseStr(pc
);
1250 return JimParseCmd(pc
);
1253 if (JimParseVar(pc
) == JIM_ERR
) {
1254 /* An orphan $. Create as a separate token */
1255 pc
->tstart
= pc
->tend
= pc
->p
++;
1257 pc
->tt
= JIM_TT_ESC
;
1262 JimParseComment(pc
);
1265 return JimParseStr(pc
);
1268 return JimParseStr(pc
);
1274 static int JimParseSep(struct JimParserCtx
*pc
)
1277 pc
->tline
= pc
->linenr
;
1278 while (isspace(UCHAR(*pc
->p
)) || (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1279 if (*pc
->p
== '\n') {
1282 if (*pc
->p
== '\\') {
1290 pc
->tend
= pc
->p
- 1;
1291 pc
->tt
= JIM_TT_SEP
;
1295 static int JimParseEol(struct JimParserCtx
*pc
)
1298 pc
->tline
= pc
->linenr
;
1299 while (isspace(UCHAR(*pc
->p
)) || *pc
->p
== ';') {
1305 pc
->tend
= pc
->p
- 1;
1306 pc
->tt
= JIM_TT_EOL
;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx
*pc
)
1342 /* Skip the brace */
1349 if (*++pc
->p
== '\n') {
1362 pc
->tend
= pc
->p
- 1;
1376 pc
->missing
.ch
= '{';
1377 pc
->missing
.line
= pc
->tline
;
1378 pc
->tend
= pc
->p
- 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1391 static int JimParseSubQuote(struct JimParserCtx
*pc
)
1393 int tt
= JIM_TT_STR
;
1394 int line
= pc
->tline
;
1396 /* Skip the quote */
1403 if (*++pc
->p
== '\n') {
1412 pc
->tend
= pc
->p
- 1;
1433 pc
->missing
.ch
= '"';
1434 pc
->missing
.line
= line
;
1435 pc
->tend
= pc
->p
- 1;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx
*pc
)
1448 int startofword
= 1;
1449 int line
= pc
->tline
;
1451 /* Skip the bracket */
1458 if (*++pc
->p
== '\n') {
1471 pc
->tend
= pc
->p
- 1;
1480 JimParseSubQuote(pc
);
1486 JimParseSubBrace(pc
);
1494 startofword
= isspace(UCHAR(*pc
->p
));
1498 pc
->missing
.ch
= '[';
1499 pc
->missing
.line
= line
;
1500 pc
->tend
= pc
->p
- 1;
1503 static int JimParseBrace(struct JimParserCtx
*pc
)
1505 pc
->tstart
= pc
->p
+ 1;
1506 pc
->tline
= pc
->linenr
;
1507 pc
->tt
= JIM_TT_STR
;
1508 JimParseSubBrace(pc
);
1512 static int JimParseCmd(struct JimParserCtx
*pc
)
1514 pc
->tstart
= pc
->p
+ 1;
1515 pc
->tline
= pc
->linenr
;
1516 pc
->tt
= JIM_TT_CMD
;
1521 static int JimParseQuote(struct JimParserCtx
*pc
)
1523 pc
->tstart
= pc
->p
+ 1;
1524 pc
->tline
= pc
->linenr
;
1525 pc
->tt
= JimParseSubQuote(pc
);
1529 static int JimParseVar(struct JimParserCtx
*pc
)
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc
->p
== '[') {
1537 /* Parse $[...] expr shorthand syntax */
1539 pc
->tt
= JIM_TT_EXPRSUGAR
;
1545 pc
->tt
= JIM_TT_VAR
;
1546 pc
->tline
= pc
->linenr
;
1548 if (*pc
->p
== '{') {
1549 pc
->tstart
= ++pc
->p
;
1552 while (pc
->len
&& *pc
->p
!= '}') {
1553 if (*pc
->p
== '\n') {
1559 pc
->tend
= pc
->p
- 1;
1567 /* Skip double colon, but not single colon! */
1568 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
1569 while (*pc
->p
== ':') {
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_' || UCHAR(*pc
->p
) >= 0x80) {
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc
->p
== '(') {
1588 const char *paren
= NULL
;
1590 pc
->tt
= JIM_TT_DICTSUGAR
;
1592 while (count
&& pc
->len
) {
1595 if (*pc
->p
== '\\' && pc
->len
>= 1) {
1599 else if (*pc
->p
== '(') {
1602 else if (*pc
->p
== ')') {
1612 /* Did not find a matching paren. Back up */
1614 pc
->len
+= (pc
->p
- paren
);
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc
->tstart
== '(') {
1619 pc
->tt
= JIM_TT_EXPRSUGAR
;
1623 pc
->tend
= pc
->p
- 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1629 if (pc
->tstart
== pc
->p
) {
1637 static int JimParseStr(struct JimParserCtx
*pc
)
1639 if (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1640 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
) {
1641 /* Starting a new word */
1642 if (*pc
->p
== '{') {
1643 return JimParseBrace(pc
);
1645 if (*pc
->p
== '"') {
1646 pc
->state
= JIM_PS_QUOTE
;
1649 /* In case the end quote is missing */
1650 pc
->missing
.line
= pc
->tline
;
1654 pc
->tline
= pc
->linenr
;
1657 if (pc
->state
== JIM_PS_QUOTE
) {
1658 pc
->missing
.ch
= '"';
1660 pc
->tend
= pc
->p
- 1;
1661 pc
->tt
= JIM_TT_ESC
;
1666 if (pc
->state
== JIM_PS_DEF
&& *(pc
->p
+ 1) == '\n') {
1667 pc
->tend
= pc
->p
- 1;
1668 pc
->tt
= JIM_TT_ESC
;
1672 if (*(pc
->p
+ 1) == '\n') {
1678 else if (pc
->len
== 1) {
1679 /* End of script with trailing backslash */
1680 pc
->missing
.ch
= '\\';
1684 /* If the following token is not '$' just keep going */
1685 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1689 /* Only need a separate ')' token if the previous was a var */
1690 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1691 if (pc
->p
== pc
->tstart
) {
1692 /* At the start of the token, so just return this char */
1696 pc
->tend
= pc
->p
- 1;
1697 pc
->tt
= JIM_TT_ESC
;
1704 pc
->tend
= pc
->p
- 1;
1705 pc
->tt
= JIM_TT_ESC
;
1713 if (pc
->state
== JIM_PS_DEF
) {
1714 pc
->tend
= pc
->p
- 1;
1715 pc
->tt
= JIM_TT_ESC
;
1718 else if (*pc
->p
== '\n') {
1723 if (pc
->state
== JIM_PS_QUOTE
) {
1724 pc
->tend
= pc
->p
- 1;
1725 pc
->tt
= JIM_TT_ESC
;
1728 pc
->state
= JIM_PS_DEF
;
1736 return JIM_OK
; /* unreached */
1739 static int JimParseComment(struct JimParserCtx
*pc
)
1742 if (*pc
->p
== '\\') {
1746 pc
->missing
.ch
= '\\';
1749 if (*pc
->p
== '\n') {
1753 else if (*pc
->p
== '\n') {
1765 /* xdigitval and odigitval are helper functions for JimEscape() */
1766 static int xdigitval(int c
)
1768 if (c
>= '0' && c
<= '9')
1770 if (c
>= 'a' && c
<= 'f')
1771 return c
- 'a' + 10;
1772 if (c
>= 'A' && c
<= 'F')
1773 return c
- 'A' + 10;
1777 static int odigitval(int c
)
1779 if (c
>= '0' && c
<= '7')
1784 /* Perform Tcl escape substitution of 's', storing the result
1785 * string into 'dest'. The escaped string is guaranteed to
1786 * be the same length or shorted than the source string.
1787 * Slen is the length of the string at 's', if it's -1 the string
1788 * length will be calculated by the function.
1790 * The function returns the length of the resulting string. */
1791 static int JimEscape(char *dest
, const char *s
, int slen
)
1799 for (i
= 0; i
< slen
; i
++) {
1830 /* A unicode or hex sequence.
1831 * \x Expect 1-2 hex chars and convert to hex.
1832 * \u Expect 1-4 hex chars and convert to utf-8.
1833 * \U Expect 1-8 hex chars and convert to utf-8.
1834 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1835 * An invalid sequence means simply the escaped char.
1847 else if (s
[i
] == 'u') {
1848 if (s
[i
+ 1] == '{') {
1857 for (k
= 0; k
< maxchars
; k
++) {
1858 int c
= xdigitval(s
[i
+ k
+ 1]);
1862 val
= (val
<< 4) | c
;
1864 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1866 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1872 /* Skip the closing brace */
1877 /* Got a valid sequence, so convert */
1882 p
+= utf8_fromunicode(p
, val
);
1887 /* Not a valid codepoint, just an escaped char */
1900 /* Replace all spaces and tabs after backslash newline with a single space*/
1904 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1917 int c
= odigitval(s
[i
+ 1]);
1920 c
= odigitval(s
[i
+ 2]);
1926 val
= (val
* 8) + c
;
1927 c
= odigitval(s
[i
+ 3]);
1933 val
= (val
* 8) + c
;
1954 /* Returns a dynamically allocated copy of the current token in the
1955 * parser context. The function performs conversion of escapes if
1956 * the token is of type JIM_TT_ESC.
1958 * Note that after the conversion, tokens that are grouped with
1959 * braces in the source code, are always recognizable from the
1960 * identical string obtained in a different way from the type.
1962 * For example the string:
1966 * will return as first token "*", of type JIM_TT_STR
1972 * will return as first token "*", of type JIM_TT_ESC
1974 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
1976 const char *start
, *end
;
1984 token
= Jim_Alloc(1);
1988 len
= (end
- start
) + 1;
1989 token
= Jim_Alloc(len
+ 1);
1990 if (pc
->tt
!= JIM_TT_ESC
) {
1991 /* No escape conversion needed? Just copy it. */
1992 memcpy(token
, start
, len
);
1996 /* Else convert the escape chars. */
1997 len
= JimEscape(token
, start
, len
);
2001 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
2004 /* Parses the given string to determine if it represents a complete script.
2006 * This is useful for interactive shells implementation, for [info complete].
2008 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2009 * '{' on scripts incomplete missing one or more '}' to be balanced.
2010 * '[' on scripts incomplete missing one or more ']' to be balanced.
2011 * '"' on scripts incomplete missing a '"' char.
2012 * '\\' on scripts with a trailing backslash.
2014 * If the script is complete, 1 is returned, otherwise 0.
2016 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
2018 struct JimParserCtx parser
;
2020 JimParserInit(&parser
, s
, len
, 1);
2021 while (!parser
.eof
) {
2022 JimParseScript(&parser
);
2025 *stateCharPtr
= parser
.missing
.ch
;
2027 return parser
.missing
.ch
== ' ';
2030 /* -----------------------------------------------------------------------------
2032 * ---------------------------------------------------------------------------*/
2033 static int JimParseListSep(struct JimParserCtx
*pc
);
2034 static int JimParseListStr(struct JimParserCtx
*pc
);
2035 static int JimParseListQuote(struct JimParserCtx
*pc
);
2037 static int JimParseList(struct JimParserCtx
*pc
)
2039 if (isspace(UCHAR(*pc
->p
))) {
2040 return JimParseListSep(pc
);
2044 return JimParseListQuote(pc
);
2047 return JimParseBrace(pc
);
2051 return JimParseListStr(pc
);
2056 pc
->tstart
= pc
->tend
= pc
->p
;
2057 pc
->tline
= pc
->linenr
;
2058 pc
->tt
= JIM_TT_EOL
;
2063 static int JimParseListSep(struct JimParserCtx
*pc
)
2066 pc
->tline
= pc
->linenr
;
2067 while (isspace(UCHAR(*pc
->p
))) {
2068 if (*pc
->p
== '\n') {
2074 pc
->tend
= pc
->p
- 1;
2075 pc
->tt
= JIM_TT_SEP
;
2079 static int JimParseListQuote(struct JimParserCtx
*pc
)
2085 pc
->tline
= pc
->linenr
;
2086 pc
->tt
= JIM_TT_STR
;
2091 pc
->tt
= JIM_TT_ESC
;
2092 if (--pc
->len
== 0) {
2093 /* Trailing backslash */
2103 pc
->tend
= pc
->p
- 1;
2112 pc
->tend
= pc
->p
- 1;
2116 static int JimParseListStr(struct JimParserCtx
*pc
)
2119 pc
->tline
= pc
->linenr
;
2120 pc
->tt
= JIM_TT_STR
;
2123 if (isspace(UCHAR(*pc
->p
))) {
2124 pc
->tend
= pc
->p
- 1;
2127 if (*pc
->p
== '\\') {
2128 if (--pc
->len
== 0) {
2129 /* Trailing backslash */
2133 pc
->tt
= JIM_TT_ESC
;
2139 pc
->tend
= pc
->p
- 1;
2143 /* -----------------------------------------------------------------------------
2144 * Jim_Obj related functions
2145 * ---------------------------------------------------------------------------*/
2147 /* Return a new initialized object. */
2148 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2152 /* -- Check if there are objects in the free list -- */
2153 if (interp
->freeList
!= NULL
) {
2154 /* -- Unlink the object from the free list -- */
2155 objPtr
= interp
->freeList
;
2156 interp
->freeList
= objPtr
->nextObjPtr
;
2159 /* -- No ready to use objects: allocate a new one -- */
2160 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2163 /* Object is returned with refCount of 0. Every
2164 * kind of GC implemented should take care to don't try
2165 * to scan objects with refCount == 0. */
2166 objPtr
->refCount
= 0;
2167 /* All the other fields are left not initialized to save time.
2168 * The caller will probably want to set them to the right
2171 /* -- Put the object into the live list -- */
2172 objPtr
->prevObjPtr
= NULL
;
2173 objPtr
->nextObjPtr
= interp
->liveList
;
2174 if (interp
->liveList
)
2175 interp
->liveList
->prevObjPtr
= objPtr
;
2176 interp
->liveList
= objPtr
;
2181 /* Free an object. Actually objects are never freed, but
2182 * just moved to the free objects list, where they will be
2183 * reused by Jim_NewObj(). */
2184 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2186 /* Check if the object was already freed, panic. */
2187 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2188 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2190 /* Free the internal representation */
2191 Jim_FreeIntRep(interp
, objPtr
);
2192 /* Free the string representation */
2193 if (objPtr
->bytes
!= NULL
) {
2194 if (objPtr
->bytes
!= JimEmptyStringRep
)
2195 Jim_Free(objPtr
->bytes
);
2197 /* Unlink the object from the live objects list */
2198 if (objPtr
->prevObjPtr
)
2199 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2200 if (objPtr
->nextObjPtr
)
2201 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2202 if (interp
->liveList
== objPtr
)
2203 interp
->liveList
= objPtr
->nextObjPtr
;
2204 #ifdef JIM_DISABLE_OBJECT_POOL
2207 /* Link the object into the free objects list */
2208 objPtr
->prevObjPtr
= NULL
;
2209 objPtr
->nextObjPtr
= interp
->freeList
;
2210 if (interp
->freeList
)
2211 interp
->freeList
->prevObjPtr
= objPtr
;
2212 interp
->freeList
= objPtr
;
2213 objPtr
->refCount
= -1;
2217 /* Invalidate the string representation of an object. */
2218 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2220 if (objPtr
->bytes
!= NULL
) {
2221 if (objPtr
->bytes
!= JimEmptyStringRep
)
2222 Jim_Free(objPtr
->bytes
);
2224 objPtr
->bytes
= NULL
;
2227 /* Duplicate an object. The returned object has refcount = 0. */
2228 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2232 dupPtr
= Jim_NewObj(interp
);
2233 if (objPtr
->bytes
== NULL
) {
2234 /* Object does not have a valid string representation. */
2235 dupPtr
->bytes
= NULL
;
2237 else if (objPtr
->length
== 0) {
2238 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2239 dupPtr
->bytes
= JimEmptyStringRep
;
2241 dupPtr
->typePtr
= NULL
;
2245 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2246 dupPtr
->length
= objPtr
->length
;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr
->typePtr
= objPtr
->typePtr
;
2253 if (objPtr
->typePtr
!= NULL
) {
2254 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2255 dupPtr
->internalRep
= objPtr
->internalRep
;
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2271 if (objPtr
->bytes
== NULL
) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2274 objPtr
->typePtr
->updateStringProc(objPtr
);
2277 *lenPtr
= objPtr
->length
;
2278 return objPtr
->bytes
;
2281 /* Just returns the length of the object's string rep */
2282 int Jim_Length(Jim_Obj
*objPtr
)
2284 if (objPtr
->bytes
== NULL
) {
2285 /* Invalid string repr. Generate it. */
2286 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2287 objPtr
->typePtr
->updateStringProc(objPtr
);
2289 return objPtr
->length
;
2292 /* Just returns the length of the object's string rep */
2293 const char *Jim_String(Jim_Obj
*objPtr
)
2295 if (objPtr
->bytes
== NULL
) {
2296 /* Invalid string repr. Generate it. */
2297 JimPanic((objPtr
->typePtr
== NULL
, "UpdateStringProc called against typeless value."));
2298 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2299 objPtr
->typePtr
->updateStringProc(objPtr
);
2301 return objPtr
->bytes
;
2304 static void JimSetStringBytes(Jim_Obj
*objPtr
, const char *str
)
2306 objPtr
->bytes
= Jim_StrDup(str
);
2307 objPtr
->length
= strlen(str
);
2310 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2311 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2313 static const Jim_ObjType dictSubstObjType
= {
2314 "dict-substitution",
2315 FreeDictSubstInternalRep
,
2316 DupDictSubstInternalRep
,
2321 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2323 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
2326 static const Jim_ObjType interpolatedObjType
= {
2328 FreeInterpolatedInternalRep
,
2334 /* -----------------------------------------------------------------------------
2336 * ---------------------------------------------------------------------------*/
2337 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2338 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2340 static const Jim_ObjType stringObjType
= {
2343 DupStringInternalRep
,
2345 JIM_TYPE_REFERENCES
,
2348 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2350 JIM_NOTUSED(interp
);
2352 /* This is a bit subtle: the only caller of this function
2353 * should be Jim_DuplicateObj(), that will copy the
2354 * string representaion. After the copy, the duplicated
2355 * object will not have more room in the buffer than
2356 * srcPtr->length bytes. So we just set it to length. */
2357 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
2358 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
2361 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2363 if (objPtr
->typePtr
!= &stringObjType
) {
2364 /* Get a fresh string representation. */
2365 if (objPtr
->bytes
== NULL
) {
2366 /* Invalid string repr. Generate it. */
2367 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2368 objPtr
->typePtr
->updateStringProc(objPtr
);
2370 /* Free any other internal representation. */
2371 Jim_FreeIntRep(interp
, objPtr
);
2372 /* Set it as string, i.e. just set the maxLength field. */
2373 objPtr
->typePtr
= &stringObjType
;
2374 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
2375 /* Don't know the utf-8 length yet */
2376 objPtr
->internalRep
.strValue
.charLength
= -1;
2382 * Returns the length of the object string in chars, not bytes.
2384 * These may be different for a utf-8 string.
2386 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2389 SetStringFromAny(interp
, objPtr
);
2391 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
2392 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
2394 return objPtr
->internalRep
.strValue
.charLength
;
2396 return Jim_Length(objPtr
);
2400 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2401 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
2403 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2405 /* Need to find out how many bytes the string requires */
2408 /* Alloc/Set the string rep. */
2410 objPtr
->bytes
= JimEmptyStringRep
;
2413 objPtr
->bytes
= Jim_Alloc(len
+ 1);
2414 memcpy(objPtr
->bytes
, s
, len
);
2415 objPtr
->bytes
[len
] = '\0';
2417 objPtr
->length
= len
;
2419 /* No typePtr field for the vanilla string object. */
2420 objPtr
->typePtr
= NULL
;
2424 /* charlen is in characters -- see also Jim_NewStringObj() */
2425 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
2428 /* Need to find out how many bytes the string requires */
2429 int bytelen
= utf8_index(s
, charlen
);
2431 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
2433 /* Remember the utf8 length, so set the type */
2434 objPtr
->typePtr
= &stringObjType
;
2435 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
2436 objPtr
->internalRep
.strValue
.charLength
= charlen
;
2440 return Jim_NewStringObj(interp
, s
, charlen
);
2444 /* This version does not try to duplicate the 's' pointer, but
2445 * use it directly. */
2446 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2448 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2451 objPtr
->length
= (len
== -1) ? strlen(s
) : len
;
2452 objPtr
->typePtr
= NULL
;
2456 /* Low-level string append. Use it only against unshared objects
2457 * of type "string". */
2458 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2464 needlen
= objPtr
->length
+ len
;
2465 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2466 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2468 /* Inefficient to malloc() for less than 8 bytes */
2472 if (objPtr
->bytes
== JimEmptyStringRep
) {
2473 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
2476 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
2478 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
2480 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2481 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2483 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
2484 /* Update the utf-8 char length */
2485 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
2487 objPtr
->length
+= len
;
2490 /* Higher level API to append strings to objects.
2491 * Object must not be unshared for each of these.
2493 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2495 JimPanic((Jim_IsShared(objPtr
), "Jim_AppendString called with shared object"));
2496 SetStringFromAny(interp
, objPtr
);
2497 StringAppendString(objPtr
, str
, len
);
2500 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2503 const char *str
= Jim_GetString(appendObjPtr
, &len
);
2504 Jim_AppendString(interp
, objPtr
, str
, len
);
2507 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2511 SetStringFromAny(interp
, objPtr
);
2512 va_start(ap
, objPtr
);
2514 const char *s
= va_arg(ap
, const char *);
2518 Jim_AppendString(interp
, objPtr
, s
, -1);
2523 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
2525 if (aObjPtr
== bObjPtr
) {
2530 const char *sA
= Jim_GetString(aObjPtr
, &Alen
);
2531 const char *sB
= Jim_GetString(bObjPtr
, &Blen
);
2533 return Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0;
2538 * Note. Does not support embedded nulls in either the pattern or the object.
2540 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2542 return JimGlobMatch(Jim_String(patternObjPtr
), Jim_String(objPtr
), nocase
);
2546 * Note: does not support embedded nulls for the nocase option.
2548 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2551 const char *s1
= Jim_GetString(firstObjPtr
, &l1
);
2552 const char *s2
= Jim_GetString(secondObjPtr
, &l2
);
2555 /* Do a character compare for nocase */
2556 return JimStringCompareLen(s1
, s2
, -1, nocase
);
2558 return JimStringCompare(s1
, l1
, s2
, l2
);
2562 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2564 * Note: does not support embedded nulls
2566 int Jim_StringCompareLenObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2568 const char *s1
= Jim_String(firstObjPtr
);
2569 const char *s2
= Jim_String(secondObjPtr
);
2571 return JimStringCompareLen(s1
, s2
, Jim_Utf8Length(interp
, firstObjPtr
), nocase
);
2574 /* Convert a range, as returned by Jim_GetRange(), into
2575 * an absolute index into an object of the specified length.
2576 * This function may return negative values, or values
2577 * greater than or equal to the length of the list if the index
2578 * is out of range. */
2579 static int JimRelToAbsIndex(int len
, int idx
)
2586 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2587 * into a form suitable for implementation of commands like [string range] and [lrange].
2589 * The resulting range is guaranteed to address valid elements of
2592 static void JimRelToAbsRange(int len
, int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2596 if (*firstPtr
> *lastPtr
) {
2600 rangeLen
= *lastPtr
- *firstPtr
+ 1;
2602 if (*firstPtr
< 0) {
2603 rangeLen
+= *firstPtr
;
2606 if (*lastPtr
>= len
) {
2607 rangeLen
-= (*lastPtr
- (len
- 1));
2615 *rangeLenPtr
= rangeLen
;
2618 static int JimStringGetRange(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
,
2619 int len
, int *first
, int *last
, int *range
)
2621 if (Jim_GetIndex(interp
, firstObjPtr
, first
) != JIM_OK
) {
2624 if (Jim_GetIndex(interp
, lastObjPtr
, last
) != JIM_OK
) {
2627 *first
= JimRelToAbsIndex(len
, *first
);
2628 *last
= JimRelToAbsIndex(len
, *last
);
2629 JimRelToAbsRange(len
, first
, last
, range
);
2633 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
2634 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2641 str
= Jim_GetString(strObjPtr
, &bytelen
);
2643 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, bytelen
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2647 if (first
== 0 && rangeLen
== bytelen
) {
2650 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2653 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2654 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2662 str
= Jim_GetString(strObjPtr
, &bytelen
);
2663 len
= Jim_Utf8Length(interp
, strObjPtr
);
2665 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2669 if (first
== 0 && rangeLen
== len
) {
2672 if (len
== bytelen
) {
2673 /* ASCII optimisation */
2674 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2676 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
2678 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
2682 Jim_Obj
*JimStringReplaceObj(Jim_Interp
*interp
,
2683 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
, Jim_Obj
*newStrObj
)
2690 len
= Jim_Utf8Length(interp
, strObjPtr
);
2692 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2700 str
= Jim_String(strObjPtr
);
2703 objPtr
= Jim_NewStringObjUtf8(interp
, str
, first
);
2707 Jim_AppendObj(interp
, objPtr
, newStrObj
);
2711 Jim_AppendString(interp
, objPtr
, str
+ utf8_index(str
, last
+ 1), len
- last
- 1);
2717 * Note: does not support embedded nulls.
2719 static void JimStrCopyUpperLower(char *dest
, const char *str
, int uc
)
2723 str
+= utf8_tounicode(str
, &c
);
2724 dest
+= utf8_getchars(dest
, uc
? utf8_upper(c
) : utf8_lower(c
));
2730 * Note: does not support embedded nulls.
2732 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2738 SetStringFromAny(interp
, strObjPtr
);
2740 str
= Jim_GetString(strObjPtr
, &len
);
2743 /* Case mapping can change the utf-8 length of the string.
2744 * But at worst it will be by one extra byte per char
2748 buf
= Jim_Alloc(len
+ 1);
2749 JimStrCopyUpperLower(buf
, str
, 0);
2750 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2754 * Note: does not support embedded nulls.
2756 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2762 if (strObjPtr
->typePtr
!= &stringObjType
) {
2763 SetStringFromAny(interp
, strObjPtr
);
2766 str
= Jim_GetString(strObjPtr
, &len
);
2769 /* Case mapping can change the utf-8 length of the string.
2770 * But at worst it will be by one extra byte per char
2774 buf
= Jim_Alloc(len
+ 1);
2775 JimStrCopyUpperLower(buf
, str
, 1);
2776 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2780 * Note: does not support embedded nulls.
2782 static Jim_Obj
*JimStringToTitle(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2789 str
= Jim_GetString(strObjPtr
, &len
);
2794 /* Case mapping can change the utf-8 length of the string.
2795 * But at worst it will be by one extra byte per char
2799 buf
= p
= Jim_Alloc(len
+ 1);
2801 str
+= utf8_tounicode(str
, &c
);
2802 p
+= utf8_getchars(p
, utf8_title(c
));
2804 JimStrCopyUpperLower(p
, str
, 0);
2806 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2809 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2810 * for unicode character 'c'.
2811 * Returns the position if found or NULL if not
2813 static const char *utf8_memchr(const char *str
, int len
, int c
)
2818 int n
= utf8_tounicode(str
, &sc
);
2827 return memchr(str
, c
, len
);
2832 * Searches for the first non-trim char in string (str, len)
2834 * If none is found, returns just past the last char.
2836 * Lengths are in bytes.
2838 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
2842 int n
= utf8_tounicode(str
, &c
);
2844 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2845 /* Not a trim char, so stop */
2855 * Searches backwards for a non-trim char in string (str, len).
2857 * Returns a pointer to just after the non-trim char, or NULL if not found.
2859 * Lengths are in bytes.
2861 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
2867 int n
= utf8_prev_len(str
, len
);
2872 n
= utf8_tounicode(str
, &c
);
2874 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2882 static const char default_trim_chars
[] = " \t\n\r";
2883 /* sizeof() here includes the null byte */
2884 static int default_trim_chars_len
= sizeof(default_trim_chars
);
2886 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2889 const char *str
= Jim_GetString(strObjPtr
, &len
);
2890 const char *trimchars
= default_trim_chars
;
2891 int trimcharslen
= default_trim_chars_len
;
2894 if (trimcharsObjPtr
) {
2895 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2898 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
2899 if (newstr
== str
) {
2903 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
2906 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2909 const char *trimchars
= default_trim_chars
;
2910 int trimcharslen
= default_trim_chars_len
;
2911 const char *nontrim
;
2913 if (trimcharsObjPtr
) {
2914 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2917 SetStringFromAny(interp
, strObjPtr
);
2919 len
= Jim_Length(strObjPtr
);
2920 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
2922 if (nontrim
== NULL
) {
2923 /* All trim, so return a zero-length string */
2924 return Jim_NewEmptyStringObj(interp
);
2926 if (nontrim
== strObjPtr
->bytes
+ len
) {
2927 /* All non-trim, so return the original object */
2931 if (Jim_IsShared(strObjPtr
)) {
2932 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
2935 /* Can modify this string in place */
2936 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
2937 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
2943 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2945 /* First trim left. */
2946 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
2948 /* Now trim right */
2949 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
2951 /* Note: refCount check is needed since objPtr may be emptyObj */
2952 if (objPtr
!= strObjPtr
&& objPtr
->refCount
== 0) {
2953 /* We don't want this object to be leaked */
2954 Jim_FreeNewObj(interp
, objPtr
);
2960 /* Some platforms don't have isascii - need a non-macro version */
2962 #define jim_isascii isascii
2964 static int jim_isascii(int c
)
2966 return !(c
& ~0x7f);
2970 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2972 static const char * const strclassnames
[] = {
2973 "integer", "alpha", "alnum", "ascii", "digit",
2974 "double", "lower", "upper", "space", "xdigit",
2975 "control", "print", "graph", "punct",
2979 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2980 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2981 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
2987 int (*isclassfunc
)(int c
) = NULL
;
2989 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2993 str
= Jim_GetString(strObjPtr
, &len
);
2995 Jim_SetResultBool(interp
, !strict
);
3000 case STR_IS_INTEGER
:
3003 Jim_SetResultBool(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
3010 Jim_SetResultBool(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
3014 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
3015 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
3016 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
3017 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
3018 case STR_IS_LOWER
: isclassfunc
= islower
; break;
3019 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
3020 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
3021 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
3022 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
3023 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
3024 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
3025 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3030 for (i
= 0; i
< len
; i
++) {
3031 if (!isclassfunc(str
[i
])) {
3032 Jim_SetResultBool(interp
, 0);
3036 Jim_SetResultBool(interp
, 1);
3040 /* -----------------------------------------------------------------------------
3041 * Compared String Object
3042 * ---------------------------------------------------------------------------*/
3044 /* This is strange object that allows comparison of a C literal string
3045 * with a Jim object in a very short time if the same comparison is done
3046 * multiple times. For example every time the [if] command is executed,
3047 * Jim has to check if a given argument is "else".
3048 * If the code has no errors, this comparison is true most of the time,
3049 * so we can cache the pointer of the string of the last matching
3050 * comparison inside the object. Because most C compilers perform literal sharing,
3051 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3052 * this works pretty well even if comparisons are at different places
3053 * inside the C code. */
3055 static const Jim_ObjType comparedStringObjType
= {
3060 JIM_TYPE_REFERENCES
,
3063 /* The only way this object is exposed to the API is via the following
3064 * function. Returns true if the string and the object string repr.
3065 * are the same, otherwise zero is returned.
3067 * Note: this isn't binary safe, but it hardly needs to be.*/
3068 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3070 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3074 const char *objStr
= Jim_String(objPtr
);
3076 if (strcmp(str
, objStr
) != 0)
3079 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3080 Jim_FreeIntRep(interp
, objPtr
);
3081 objPtr
->typePtr
= &comparedStringObjType
;
3083 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3088 static int qsortCompareStringPointers(const void *a
, const void *b
)
3090 char *const *sa
= (char *const *)a
;
3091 char *const *sb
= (char *const *)b
;
3093 return strcmp(*sa
, *sb
);
3097 /* -----------------------------------------------------------------------------
3100 * This object is just a string from the language point of view, but
3101 * the internal representation contains the filename and line number
3102 * where this token was read. This information is used by
3103 * Jim_EvalObj() if the object passed happens to be of type "source".
3105 * This allows propagation of the information about line numbers and file
3106 * names and gives error messages with absolute line numbers.
3108 * Note that this object uses the internal representation of the Jim_Object,
3109 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3111 * Also the object will be converted to something else if the given
3112 * token it represents in the source file is not something to be
3113 * evaluated (not a script), and will be specialized in some other way,
3114 * so the time overhead is also almost zero.
3115 * ---------------------------------------------------------------------------*/
3117 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3118 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3120 static const Jim_ObjType sourceObjType
= {
3122 FreeSourceInternalRep
,
3123 DupSourceInternalRep
,
3125 JIM_TYPE_REFERENCES
,
3128 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3130 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3133 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3135 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3136 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3139 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3140 Jim_Obj
*fileNameObj
, int lineNumber
)
3142 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3143 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3144 Jim_IncrRefCount(fileNameObj
);
3145 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3146 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3147 objPtr
->typePtr
= &sourceObjType
;
3150 /* -----------------------------------------------------------------------------
3153 * This object is used only in the Script internal represenation.
3154 * For each line of the script, it holds the number of tokens on the line
3155 * and the source line number.
3157 static const Jim_ObjType scriptLineObjType
= {
3165 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3169 #ifdef DEBUG_SHOW_SCRIPT
3171 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3172 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3174 objPtr
= Jim_NewEmptyStringObj(interp
);
3176 objPtr
->typePtr
= &scriptLineObjType
;
3177 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3178 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3183 /* -----------------------------------------------------------------------------
3186 * This object holds the parsed internal representation of a script.
3187 * This representation is help within an allocated ScriptObj (see below)
3189 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3190 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3191 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3192 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3194 static const Jim_ObjType scriptObjType
= {
3196 FreeScriptInternalRep
,
3197 DupScriptInternalRep
,
3199 JIM_TYPE_REFERENCES
,
3202 /* Each token of a script is represented by a ScriptToken.
3203 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3204 * can be specialized by commands operating on it.
3206 typedef struct ScriptToken
3212 /* This is the script object internal representation. An array of
3213 * ScriptToken structures, including a pre-computed representation of the
3214 * command length and arguments.
3216 * For example the script:
3219 * set $i $x$y [foo]BAR
3221 * will produce a ScriptObj with the following ScriptToken's:
3236 * "puts hello" has two args (LIN 2), composed of single tokens.
3237 * (Note that the WRD token is omitted for the common case of a single token.)
3239 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3240 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3242 * The precomputation of the command structure makes Jim_Eval() faster,
3243 * and simpler because there aren't dynamic lengths / allocations.
3245 * -- {expand}/{*} handling --
3247 * Expand is handled in a special way.
3249 * If a "word" begins with {*}, the word token count is -ve.
3251 * For example the command:
3255 * Will produce the following cmdstruct array:
3262 * Note that the 'LIN' token also contains the source information for the
3263 * first word of the line for error reporting purposes
3265 * -- the substFlags field of the structure --
3267 * The scriptObj structure is used to represent both "script" objects
3268 * and "subst" objects. In the second case, the there are no LIN and WRD
3269 * tokens. Instead SEP and EOL tokens are added as-is.
3270 * In addition, the field 'substFlags' is used to represent the flags used to turn
3271 * the string into the internal representation.
3272 * If these flags do not match what the application requires,
3273 * the scriptObj is created again. For example the script:
3275 * subst -nocommands $string
3276 * subst -novariables $string
3278 * Will (re)create the internal representation of the $string object
3281 typedef struct ScriptObj
3283 ScriptToken
*token
; /* Tokens array. */
3284 Jim_Obj
*fileNameObj
; /* Filename */
3285 int len
; /* Length of token[] */
3286 int substFlags
; /* flags used for the compilation of "subst" objects */
3287 int inUse
; /* Used to share a ScriptObj. Currently
3288 only used by Jim_EvalObj() as protection against
3289 shimmering of the currently evaluated object. */
3290 int firstline
; /* Line number of the first line */
3291 int linenr
; /* Error line number, if any */
3292 int missing
; /* Missing char if script failed to parse, (or space or backslash if OK) */
3295 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3298 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3300 if (--script
->inUse
!= 0)
3302 for (i
= 0; i
< script
->len
; i
++) {
3303 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3305 Jim_Free(script
->token
);
3306 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3310 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3312 JIM_NOTUSED(interp
);
3313 JIM_NOTUSED(srcPtr
);
3315 /* Just return a simple string. We don't try to preserve the source info
3316 * since in practice scripts are never duplicated
3318 dupPtr
->typePtr
= NULL
;
3321 /* A simple parse token.
3322 * As the script is parsed, the created tokens point into the script string rep.
3326 const char *token
; /* Pointer to the start of the token */
3327 int len
; /* Length of this token */
3328 int type
; /* Token type */
3329 int line
; /* Line number */
3332 /* A list of parsed tokens representing a script.
3333 * Tokens are added to this list as the script is parsed.
3334 * It grows as needed.
3338 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3339 ParseToken
*list
; /* Array of tokens */
3340 int size
; /* Current size of the list */
3341 int count
; /* Number of entries used */
3342 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3345 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3347 tokenlist
->list
= tokenlist
->static_list
;
3348 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3349 tokenlist
->count
= 0;
3352 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3354 if (tokenlist
->list
!= tokenlist
->static_list
) {
3355 Jim_Free(tokenlist
->list
);
3360 * Adds the new token to the tokenlist.
3361 * The token has the given length, type and line number.
3362 * The token list is resized as necessary.
3364 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3369 if (tokenlist
->count
== tokenlist
->size
) {
3370 /* Resize the list */
3371 tokenlist
->size
*= 2;
3372 if (tokenlist
->list
!= tokenlist
->static_list
) {
3374 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3377 /* The list needs to become allocated */
3378 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3379 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3380 tokenlist
->count
* sizeof(*tokenlist
->list
));
3383 t
= &tokenlist
->list
[tokenlist
->count
++];
3390 /* Counts the number of adjoining non-separator tokens.
3392 * Returns -ve if the first token is the expansion
3393 * operator (in which case the count doesn't include
3396 static int JimCountWordTokens(ParseToken
*t
)
3401 /* Is the first word {*} or {expand}? */
3402 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3403 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3404 /* Create an expand token */
3410 /* Now count non-separator words */
3411 while (!TOKEN_IS_SEP(t
->type
)) {
3416 return count
* expand
;
3420 * Create a script/subst object from the given token.
3422 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3426 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3427 /* Convert backlash escapes. The result will never be longer than the original */
3429 char *str
= Jim_Alloc(len
+ 1);
3430 len
= JimEscape(str
, t
->token
, len
);
3431 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3434 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3435 * with a single space.
3437 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3443 * Takes a tokenlist and creates the allocated list of script tokens
3444 * in script->token, of length script->len.
3446 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3449 * Also sets script->line to the line number of the first token
3451 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3452 ParseTokenList
*tokenlist
)
3455 struct ScriptToken
*token
;
3456 /* Number of tokens so far for the current command */
3458 /* This is the first token for the current command */
3459 ScriptToken
*linefirst
;
3463 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3464 printf("==== Tokens ====\n");
3465 for (i
= 0; i
< tokenlist
->count
; i
++) {
3466 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3467 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3471 /* May need up to one extra script token for each EOL in the worst case */
3472 count
= tokenlist
->count
;
3473 for (i
= 0; i
< tokenlist
->count
; i
++) {
3474 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3478 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3480 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3482 /* This is the first token for the current command */
3483 linefirst
= token
++;
3485 for (i
= 0; i
< tokenlist
->count
; ) {
3486 /* Look ahead to find out how many tokens make up the next word */
3489 /* Skip any leading separators */
3490 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3494 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3496 if (wordtokens
== 0) {
3497 /* None, so at end of line */
3499 linefirst
->type
= JIM_TT_LINE
;
3500 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3501 Jim_IncrRefCount(linefirst
->objPtr
);
3503 /* Reset for new line */
3505 linefirst
= token
++;
3510 else if (wordtokens
!= 1) {
3511 /* More than 1, or {*}, so insert a WORD token */
3512 token
->type
= JIM_TT_WORD
;
3513 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3514 Jim_IncrRefCount(token
->objPtr
);
3516 if (wordtokens
< 0) {
3517 /* Skip the expand token */
3519 wordtokens
= -wordtokens
- 1;
3524 if (lineargs
== 0) {
3525 /* First real token on the line, so record the line number */
3526 linenr
= tokenlist
->list
[i
].line
;
3530 /* Add each non-separator word token to the line */
3531 while (wordtokens
--) {
3532 const ParseToken
*t
= &tokenlist
->list
[i
++];
3534 token
->type
= t
->type
;
3535 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3536 Jim_IncrRefCount(token
->objPtr
);
3538 /* Every object is initially a string of type 'source', but the
3539 * internal type may be specialized during execution of the
3541 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3546 if (lineargs
== 0) {
3550 script
->len
= token
- script
->token
;
3552 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3554 #ifdef DEBUG_SHOW_SCRIPT
3555 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3556 for (i
= 0; i
< script
->len
; i
++) {
3557 const ScriptToken
*t
= &script
->token
[i
];
3558 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3565 * Sets an appropriate error message for a missing script/expression terminator.
3567 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3569 * Note that a trailing backslash is not considered to be an error.
3571 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3581 msg
= "unmatched \"[\"";
3584 msg
= "missing close-brace";
3588 msg
= "missing quote";
3592 Jim_SetResultString(interp
, msg
, -1);
3597 * Similar to ScriptObjAddTokens(), but for subst objects.
3599 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3600 ParseTokenList
*tokenlist
)
3603 struct ScriptToken
*token
;
3605 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3607 for (i
= 0; i
< tokenlist
->count
; i
++) {
3608 const ParseToken
*t
= &tokenlist
->list
[i
];
3610 /* Create a token for 't' */
3611 token
->type
= t
->type
;
3612 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3613 Jim_IncrRefCount(token
->objPtr
);
3620 /* This method takes the string representation of an object
3621 * as a Tcl script, and generates the pre-parsed internal representation
3624 * On parse error, sets an error message and returns JIM_ERR
3625 * (Note: the object is still converted to a script, even if an error occurs)
3627 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3630 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3631 struct JimParserCtx parser
;
3632 struct ScriptObj
*script
;
3633 ParseTokenList tokenlist
;
3636 /* Try to get information about filename / line number */
3637 if (objPtr
->typePtr
== &sourceObjType
) {
3638 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3641 /* Initially parse the script into tokens (in tokenlist) */
3642 ScriptTokenListInit(&tokenlist
);
3644 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3645 while (!parser
.eof
) {
3646 JimParseScript(&parser
);
3647 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3651 /* Add a final EOF token */
3652 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3654 /* Create the "real" script tokens from the parsed tokens */
3655 script
= Jim_Alloc(sizeof(*script
));
3656 memset(script
, 0, sizeof(*script
));
3658 if (objPtr
->typePtr
== &sourceObjType
) {
3659 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3662 script
->fileNameObj
= interp
->emptyObj
;
3664 Jim_IncrRefCount(script
->fileNameObj
);
3665 script
->missing
= parser
.missing
.ch
;
3666 script
->linenr
= parser
.missing
.line
;
3668 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist
);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp
, objPtr
);
3675 Jim_SetIntRepPtr(objPtr
, script
);
3676 objPtr
->typePtr
= &scriptObjType
;
3679 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
);
3682 * Returns the parsed script.
3683 * Note that if there is any possibility that the script is not valid,
3684 * call JimScriptValid() to check
3686 ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3688 if (objPtr
== interp
->emptyObj
) {
3689 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3690 objPtr
= interp
->nullScriptObj
;
3693 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3694 JimSetScriptFromAny(interp
, objPtr
);
3697 return (ScriptObj
*)Jim_GetIntRepPtr(objPtr
);
3701 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3702 * and leaves an error message in the interp result.
3705 static int JimScriptValid(Jim_Interp
*interp
, ScriptObj
*script
)
3707 if (JimParseCheckMissing(interp
, script
->missing
) == JIM_ERR
) {
3708 JimAddErrorToStack(interp
, script
);
3715 /* -----------------------------------------------------------------------------
3717 * ---------------------------------------------------------------------------*/
3718 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3723 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3725 if (--cmdPtr
->inUse
== 0) {
3726 if (cmdPtr
->isproc
) {
3727 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3728 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3729 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3730 if (cmdPtr
->u
.proc
.staticVars
) {
3731 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3732 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3737 if (cmdPtr
->u
.native
.delProc
) {
3738 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3741 if (cmdPtr
->prevCmd
) {
3742 /* Delete any pushed command too */
3743 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3749 /* Variables HashTable Type.
3751 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3754 /* Variables HashTable Type.
3756 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3757 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3759 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3763 static const Jim_HashTableType JimVariablesHashTableType
= {
3764 JimStringCopyHTHashFunction
, /* hash function */
3765 JimStringCopyHTDup
, /* key dup */
3767 JimStringCopyHTKeyCompare
, /* key compare */
3768 JimStringCopyHTKeyDestructor
, /* key destructor */
3769 JimVariablesHTValDestructor
/* val destructor */
3772 /* Commands HashTable Type.
3774 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3776 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3778 JimDecrCmdRefCount(interp
, val
);
3781 static const Jim_HashTableType JimCommandsHashTableType
= {
3782 JimStringCopyHTHashFunction
, /* hash function */
3783 JimStringCopyHTDup
, /* key dup */
3785 JimStringCopyHTKeyCompare
, /* key compare */
3786 JimStringCopyHTKeyDestructor
, /* key destructor */
3787 JimCommandsHT_ValDestructor
/* val destructor */
3790 /* ------------------------- Commands related functions --------------------- */
3792 #ifdef jim_ext_namespace
3794 * Returns the "unscoped" version of the given namespace.
3795 * That is, the fully qualfied name without the leading ::
3796 * The returned value is either nsObj, or an object with a zero ref count.
3798 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3800 const char *name
= Jim_String(nsObj
);
3801 if (name
[0] == ':' && name
[1] == ':') {
3802 /* This command is being defined in the global namespace */
3803 while (*++name
== ':') {
3805 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3807 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3808 /* This command is being defined in a non-global namespace */
3809 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3810 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3815 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3819 const char *name
= Jim_String(nameObjPtr
);
3820 if (name
[0] == ':' && name
[1] == ':') {
3823 Jim_IncrRefCount(nameObjPtr
);
3824 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3825 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3826 Jim_DecrRefCount(interp
, nameObjPtr
);
3832 * An efficient version of JimQualifyNameObj() where the name is
3833 * available (and needed) as a 'const char *'.
3834 * Avoids creating an object if not necessary.
3835 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3837 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3839 Jim_Obj
*objPtr
= interp
->emptyObj
;
3841 if (name
[0] == ':' && name
[1] == ':') {
3842 /* This command is being defined in the global namespace */
3843 while (*++name
== ':') {
3846 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3847 /* This command is being defined in a non-global namespace */
3848 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3849 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3850 name
= Jim_String(objPtr
);
3852 Jim_IncrRefCount(objPtr
);
3853 *objPtrPtr
= objPtr
;
3857 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3860 /* We can be more efficient in the no-namespace case */
3861 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3862 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3864 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3870 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3872 /* It may already exist, so we try to delete the old one.
3873 * Note that reference count means that it won't be deleted yet if
3874 * it exists in the call stack.
3876 * BUT, if 'local' is in force, instead of deleting the existing
3877 * proc, we stash a reference to the old proc here.
3879 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3881 /* There was an old cmd with the same name,
3882 * so this requires a 'proc epoch' update. */
3884 /* If a procedure with the same name didn't exist there is no need
3885 * to increment the 'proc epoch' because creation of a new procedure
3886 * can never affect existing cached commands. We don't do
3887 * negative caching. */
3888 Jim_InterpIncrProcEpoch(interp
);
3891 if (he
&& interp
->local
) {
3892 /* Push this command over the top of the previous one */
3893 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3894 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3898 /* Replace the existing command */
3899 Jim_DeleteHashEntry(&interp
->commands
, name
);
3902 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3908 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3909 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
3911 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3913 /* Store the new details for this command */
3914 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3916 cmdPtr
->u
.native
.delProc
= delProc
;
3917 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3918 cmdPtr
->u
.native
.privData
= privData
;
3920 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3925 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3929 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3934 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3935 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3936 for (i
= 0; i
< len
; i
++) {
3937 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3941 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3942 /* Check if it's composed of two elements. */
3943 subLen
= Jim_ListLength(interp
, objPtr
);
3944 if (subLen
== 1 || subLen
== 2) {
3945 /* Try to get the variable value from the current
3947 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3949 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3950 if (initObjPtr
== NULL
) {
3951 Jim_SetResultFormatted(interp
,
3952 "variable for initialization of static \"%#s\" not found in the local context",
3958 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3960 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3964 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3965 varPtr
->objPtr
= initObjPtr
;
3966 Jim_IncrRefCount(initObjPtr
);
3967 varPtr
->linkFramePtr
= NULL
;
3968 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3969 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3970 Jim_SetResultFormatted(interp
,
3971 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3972 Jim_DecrRefCount(interp
, initObjPtr
);
3978 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
3986 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
3988 #ifdef jim_ext_namespace
3989 if (cmdPtr
->isproc
) {
3990 /* XXX: Really need JimNamespaceSplit() */
3991 const char *pt
= strrchr(cmdname
, ':');
3992 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
3993 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3994 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
3995 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
3997 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
3998 /* This commands shadows a global command, so a proc epoch update is required */
3999 Jim_InterpIncrProcEpoch(interp
);
4006 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
4007 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4013 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4015 /* Allocate space for both the command pointer and the arg list */
4016 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4017 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4020 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4021 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4022 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4023 cmdPtr
->u
.proc
.argsPos
= -1;
4024 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4025 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4026 Jim_IncrRefCount(argListObjPtr
);
4027 Jim_IncrRefCount(bodyObjPtr
);
4028 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4030 /* Create the statics hash table. */
4031 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4035 /* Parse the args out into arglist, validating as we go */
4036 /* Examine the argument list for default parameters and 'args' */
4037 for (i
= 0; i
< argListLen
; i
++) {
4039 Jim_Obj
*nameObjPtr
;
4040 Jim_Obj
*defaultObjPtr
;
4043 /* Examine a parameter */
4044 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4045 len
= Jim_ListLength(interp
, argPtr
);
4047 Jim_SetResultString(interp
, "argument with no name", -1);
4049 JimDecrCmdRefCount(interp
, cmdPtr
);
4053 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4058 /* Optional parameter */
4059 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4060 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4063 /* Required parameter */
4064 nameObjPtr
= argPtr
;
4065 defaultObjPtr
= NULL
;
4069 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4070 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4071 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4074 cmdPtr
->u
.proc
.argsPos
= i
;
4078 cmdPtr
->u
.proc
.optArity
++;
4081 cmdPtr
->u
.proc
.reqArity
++;
4085 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4086 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4092 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4095 Jim_Obj
*qualifiedNameObj
;
4096 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4098 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4099 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4103 Jim_InterpIncrProcEpoch(interp
);
4106 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4111 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4116 Jim_Obj
*qualifiedOldNameObj
;
4117 Jim_Obj
*qualifiedNewNameObj
;
4121 if (newName
[0] == 0) {
4122 return Jim_DeleteCommand(interp
, oldName
);
4125 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4126 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4128 /* Does it exist? */
4129 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4131 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4133 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4134 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4137 /* Add the new name first */
4138 cmdPtr
= Jim_GetHashEntryVal(he
);
4139 JimIncrCmdRefCount(cmdPtr
);
4140 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4141 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4143 /* Now remove the old name */
4144 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4146 /* Increment the epoch */
4147 Jim_InterpIncrProcEpoch(interp
);
4152 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4153 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4158 /* -----------------------------------------------------------------------------
4160 * ---------------------------------------------------------------------------*/
4162 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4164 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4167 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4169 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4170 dupPtr
->typePtr
= srcPtr
->typePtr
;
4171 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4174 static const Jim_ObjType commandObjType
= {
4176 FreeCommandInternalRep
,
4177 DupCommandInternalRep
,
4179 JIM_TYPE_REFERENCES
,
4182 /* This function returns the command structure for the command name
4183 * stored in objPtr. It tries to specialize the objPtr to contain
4184 * a cached info instead to perform the lookup into the hash table
4185 * every time. The information cached may not be uptodate, in such
4186 * a case the lookup is performed and the cache updated.
4188 * Respects the 'upcall' setting
4190 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4194 /* In order to be valid, the proc epoch must match and
4195 * the lookup must have occurred in the same namespace
4197 if (objPtr
->typePtr
!= &commandObjType
||
4198 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4199 #ifdef jim_ext_namespace
4200 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4203 /* Not cached or out of date, so lookup */
4205 /* Do we need to try the local namespace? */
4206 const char *name
= Jim_String(objPtr
);
4209 if (name
[0] == ':' && name
[1] == ':') {
4210 while (*++name
== ':') {
4213 #ifdef jim_ext_namespace
4214 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4215 /* This command is being defined in a non-global namespace */
4216 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4217 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4218 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4219 Jim_FreeNewObj(interp
, nameObj
);
4226 /* Lookup in the global namespace */
4227 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4229 if (flags
& JIM_ERRMSG
) {
4230 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4234 #ifdef jim_ext_namespace
4237 cmd
= Jim_GetHashEntryVal(he
);
4239 /* Free the old internal repr and set the new one. */
4240 Jim_FreeIntRep(interp
, objPtr
);
4241 objPtr
->typePtr
= &commandObjType
;
4242 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4243 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4244 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4245 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4248 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4250 while (cmd
->u
.proc
.upcall
) {
4256 /* -----------------------------------------------------------------------------
4258 * ---------------------------------------------------------------------------*/
4260 /* -----------------------------------------------------------------------------
4262 * ---------------------------------------------------------------------------*/
4264 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4266 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4268 static const Jim_ObjType variableObjType
= {
4273 JIM_TYPE_REFERENCES
,
4277 * Check that the name does not contain embedded nulls.
4279 * Variable and procedure names are maniplated as null terminated strings, so
4280 * don't allow names with embedded nulls.
4282 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4284 /* Variable names and proc names can't contain embedded nulls */
4285 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4287 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4288 if (memchr(str
, '\0', len
)) {
4289 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4296 /* This method should be called only by the variable API.
4297 * It returns JIM_OK on success (variable already exists),
4298 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4299 * a variable name, but syntax glue for [dict] i.e. the last
4300 * character is ')' */
4301 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4303 const char *varName
;
4304 Jim_CallFrame
*framePtr
;
4309 /* Check if the object is already an uptodate variable */
4310 if (objPtr
->typePtr
== &variableObjType
) {
4311 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4312 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4316 /* Need to re-resolve the variable in the updated callframe */
4318 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4319 return JIM_DICT_SUGAR
;
4321 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4326 varName
= Jim_GetString(objPtr
, &len
);
4328 /* Make sure it's not syntax glue to get/set dict. */
4329 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4330 return JIM_DICT_SUGAR
;
4333 if (varName
[0] == ':' && varName
[1] == ':') {
4334 while (*++varName
== ':') {
4337 framePtr
= interp
->topFramePtr
;
4341 framePtr
= interp
->framePtr
;
4344 /* Resolve this name in the variables hash table */
4345 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4347 if (!global
&& framePtr
->staticVars
) {
4348 /* Try with static vars. */
4349 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4356 /* Free the old internal repr and set the new one. */
4357 Jim_FreeIntRep(interp
, objPtr
);
4358 objPtr
->typePtr
= &variableObjType
;
4359 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4360 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4361 objPtr
->internalRep
.varValue
.global
= global
;
4365 /* -------------------- Variables related functions ------------------------- */
4366 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4367 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4369 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4372 Jim_CallFrame
*framePtr
;
4375 /* New variable to create */
4376 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4378 var
->objPtr
= valObjPtr
;
4379 Jim_IncrRefCount(valObjPtr
);
4380 var
->linkFramePtr
= NULL
;
4382 name
= Jim_String(nameObjPtr
);
4383 if (name
[0] == ':' && name
[1] == ':') {
4384 while (*++name
== ':') {
4386 framePtr
= interp
->topFramePtr
;
4390 framePtr
= interp
->framePtr
;
4394 /* Insert the new variable */
4395 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4397 /* Make the object int rep a variable */
4398 Jim_FreeIntRep(interp
, nameObjPtr
);
4399 nameObjPtr
->typePtr
= &variableObjType
;
4400 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4401 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4402 nameObjPtr
->internalRep
.varValue
.global
= global
;
4407 /* For now that's dummy. Variables lookup should be optimized
4408 * in many ways, with caching of lookups, and possibly with
4409 * a table of pre-allocated vars in every CallFrame for local vars.
4410 * All the caching should also have an 'epoch' mechanism similar
4411 * to the one used by Tcl for procedures lookup caching. */
4413 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4418 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4419 case JIM_DICT_SUGAR
:
4420 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4423 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4426 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4430 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4431 if (var
->linkFramePtr
== NULL
) {
4432 Jim_IncrRefCount(valObjPtr
);
4433 Jim_DecrRefCount(interp
, var
->objPtr
);
4434 var
->objPtr
= valObjPtr
;
4436 else { /* Else handle the link */
4437 Jim_CallFrame
*savedCallFrame
;
4439 savedCallFrame
= interp
->framePtr
;
4440 interp
->framePtr
= var
->linkFramePtr
;
4441 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4442 interp
->framePtr
= savedCallFrame
;
4450 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4452 Jim_Obj
*nameObjPtr
;
4455 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4456 Jim_IncrRefCount(nameObjPtr
);
4457 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4458 Jim_DecrRefCount(interp
, nameObjPtr
);
4462 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4464 Jim_CallFrame
*savedFramePtr
;
4467 savedFramePtr
= interp
->framePtr
;
4468 interp
->framePtr
= interp
->topFramePtr
;
4469 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4470 interp
->framePtr
= savedFramePtr
;
4474 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4476 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4479 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4480 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4481 Jim_IncrRefCount(nameObjPtr
);
4482 Jim_IncrRefCount(valObjPtr
);
4483 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4484 Jim_DecrRefCount(interp
, nameObjPtr
);
4485 Jim_DecrRefCount(interp
, valObjPtr
);
4489 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4490 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4492 const char *varName
;
4493 const char *targetName
;
4494 Jim_CallFrame
*framePtr
;
4497 /* Check for an existing variable or link */
4498 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4499 case JIM_DICT_SUGAR
:
4500 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4501 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4505 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4507 if (varPtr
->linkFramePtr
== NULL
) {
4508 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4512 /* It exists, but is a link, so first delete the link */
4513 varPtr
->linkFramePtr
= NULL
;
4517 /* Resolve the call frames for both variables */
4518 /* XXX: SetVariableFromAny() already did this! */
4519 varName
= Jim_String(nameObjPtr
);
4521 if (varName
[0] == ':' && varName
[1] == ':') {
4522 while (*++varName
== ':') {
4524 /* Linking a global var does nothing */
4525 framePtr
= interp
->topFramePtr
;
4528 framePtr
= interp
->framePtr
;
4531 targetName
= Jim_String(targetNameObjPtr
);
4532 if (targetName
[0] == ':' && targetName
[1] == ':') {
4533 while (*++targetName
== ':') {
4535 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4536 targetCallFrame
= interp
->topFramePtr
;
4538 Jim_IncrRefCount(targetNameObjPtr
);
4540 if (framePtr
->level
< targetCallFrame
->level
) {
4541 Jim_SetResultFormatted(interp
,
4542 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4544 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4548 /* Check for cycles. */
4549 if (framePtr
== targetCallFrame
) {
4550 Jim_Obj
*objPtr
= targetNameObjPtr
;
4552 /* Cycles are only possible with 'uplevel 0' */
4554 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4555 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4556 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4559 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4561 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4562 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4564 objPtr
= varPtr
->objPtr
;
4568 /* Perform the binding */
4569 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4570 /* We are now sure 'nameObjPtr' type is variableObjType */
4571 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4572 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4576 /* Return the Jim_Obj pointer associated with a variable name,
4577 * or NULL if the variable was not found in the current context.
4578 * The same optimization discussed in the comment to the
4579 * 'SetVariable' function should apply here.
4581 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4582 * in a dictionary which is shared, the array variable value is duplicated first.
4583 * This allows the array element to be updated (e.g. append, lappend) without
4584 * affecting other references to the dictionary.
4586 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4588 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4590 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4592 if (varPtr
->linkFramePtr
== NULL
) {
4593 return varPtr
->objPtr
;
4598 /* The variable is a link? Resolve it. */
4599 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4601 interp
->framePtr
= varPtr
->linkFramePtr
;
4602 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4603 interp
->framePtr
= savedCallFrame
;
4607 /* Error, so fall through to the error message */
4612 case JIM_DICT_SUGAR
:
4613 /* [dict] syntax sugar. */
4614 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4616 if (flags
& JIM_ERRMSG
) {
4617 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4622 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4624 Jim_CallFrame
*savedFramePtr
;
4627 savedFramePtr
= interp
->framePtr
;
4628 interp
->framePtr
= interp
->topFramePtr
;
4629 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4630 interp
->framePtr
= savedFramePtr
;
4635 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4637 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4639 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4640 Jim_IncrRefCount(nameObjPtr
);
4641 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4642 Jim_DecrRefCount(interp
, nameObjPtr
);
4646 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4648 Jim_CallFrame
*savedFramePtr
;
4651 savedFramePtr
= interp
->framePtr
;
4652 interp
->framePtr
= interp
->topFramePtr
;
4653 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4654 interp
->framePtr
= savedFramePtr
;
4659 /* Unset a variable.
4660 * Note: On success unset invalidates all the variable objects created
4661 * in the current call frame incrementing. */
4662 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4666 Jim_CallFrame
*framePtr
;
4668 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4669 if (retval
== JIM_DICT_SUGAR
) {
4670 /* [dict] syntax sugar. */
4671 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4673 else if (retval
== JIM_OK
) {
4674 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4676 /* If it's a link call UnsetVariable recursively */
4677 if (varPtr
->linkFramePtr
) {
4678 framePtr
= interp
->framePtr
;
4679 interp
->framePtr
= varPtr
->linkFramePtr
;
4680 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4681 interp
->framePtr
= framePtr
;
4684 const char *name
= Jim_String(nameObjPtr
);
4685 if (nameObjPtr
->internalRep
.varValue
.global
) {
4687 framePtr
= interp
->topFramePtr
;
4690 framePtr
= interp
->framePtr
;
4693 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4694 if (retval
== JIM_OK
) {
4695 /* Change the callframe id, invalidating var lookup caching */
4696 framePtr
->id
= interp
->callFrameEpoch
++;
4700 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4701 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4706 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4708 /* Given a variable name for [dict] operation syntax sugar,
4709 * this function returns two objects, the first with the name
4710 * of the variable to set, and the second with the rispective key.
4711 * For example "foo(bar)" will return objects with string repr. of
4714 * The returned objects have refcount = 1. The function can't fail. */
4715 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4716 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4718 const char *str
, *p
;
4720 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4722 str
= Jim_GetString(objPtr
, &len
);
4724 p
= strchr(str
, '(');
4725 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4727 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4730 keyLen
= (str
+ len
) - p
;
4731 if (str
[len
- 1] == ')') {
4735 /* Create the objects with the variable name and key. */
4736 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4738 Jim_IncrRefCount(varObjPtr
);
4739 Jim_IncrRefCount(keyObjPtr
);
4740 *varPtrPtr
= varObjPtr
;
4741 *keyPtrPtr
= keyObjPtr
;
4744 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4745 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4746 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4750 SetDictSubstFromAny(interp
, objPtr
);
4752 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4753 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4755 if (err
== JIM_OK
) {
4756 /* Don't keep an extra ref to the result */
4757 Jim_SetEmptyResult(interp
);
4761 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4762 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4763 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4768 /* Make the error more informative and Tcl-compatible */
4769 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4770 (valObjPtr
? "set" : "unset"), objPtr
);
4776 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4778 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4779 * and stored back to the variable before expansion.
4781 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4782 Jim_Obj
*keyObjPtr
, int flags
)
4784 Jim_Obj
*dictObjPtr
;
4785 Jim_Obj
*resObjPtr
= NULL
;
4788 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4793 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4794 if (ret
!= JIM_OK
) {
4795 Jim_SetResultFormatted(interp
,
4796 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4797 ret
< 0 ? "variable isn't" : "no such element in");
4799 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4800 /* Update the variable to have an unshared copy */
4801 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4807 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4808 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4810 SetDictSubstFromAny(interp
, objPtr
);
4812 return JimDictExpandArrayVariable(interp
,
4813 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4814 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4817 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4819 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4821 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4822 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4825 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4827 JIM_NOTUSED(interp
);
4829 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4830 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4831 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4832 dupPtr
->typePtr
= &dictSubstObjType
;
4835 /* Note: The object *must* be in dict-sugar format */
4836 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4838 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4839 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4841 if (objPtr
->typePtr
== &interpolatedObjType
) {
4842 /* An interpolated object in dict-sugar form */
4844 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4845 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4847 Jim_IncrRefCount(varObjPtr
);
4848 Jim_IncrRefCount(keyObjPtr
);
4851 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4854 Jim_FreeIntRep(interp
, objPtr
);
4855 objPtr
->typePtr
= &dictSubstObjType
;
4856 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4857 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4861 /* This function is used to expand [dict get] sugar in the form
4862 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4863 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4864 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4865 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4866 * the [dict]ionary contained in variable VARNAME. */
4867 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4869 Jim_Obj
*resObjPtr
= NULL
;
4870 Jim_Obj
*substKeyObjPtr
= NULL
;
4872 SetDictSubstFromAny(interp
, objPtr
);
4874 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4875 &substKeyObjPtr
, JIM_NONE
)
4879 Jim_IncrRefCount(substKeyObjPtr
);
4881 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4883 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4888 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4890 Jim_Obj
*resultObjPtr
;
4892 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4893 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4894 resultObjPtr
->refCount
--;
4895 return resultObjPtr
;
4900 /* -----------------------------------------------------------------------------
4902 * ---------------------------------------------------------------------------*/
4904 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4908 if (interp
->freeFramesList
) {
4909 cf
= interp
->freeFramesList
;
4910 interp
->freeFramesList
= cf
->next
;
4914 cf
->procArgsObjPtr
= NULL
;
4915 cf
->procBodyObjPtr
= NULL
;
4917 cf
->staticVars
= NULL
;
4918 cf
->localCommands
= NULL
;
4920 cf
->tailcallObj
= NULL
;
4921 cf
->tailcallCmd
= NULL
;
4924 cf
= Jim_Alloc(sizeof(*cf
));
4925 memset(cf
, 0, sizeof(*cf
));
4927 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4930 cf
->id
= interp
->callFrameEpoch
++;
4931 cf
->parent
= parent
;
4932 cf
->level
= parent
? parent
->level
+ 1 : 0;
4934 Jim_IncrRefCount(nsObj
);
4939 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
)
4941 /* Delete any local procs */
4942 if (localCommands
) {
4943 Jim_Obj
*cmdNameObj
;
4945 while ((cmdNameObj
= Jim_StackPop(localCommands
)) != NULL
) {
4948 Jim_HashTable
*ht
= &interp
->commands
;
4950 const char *fqname
= JimQualifyName(interp
, Jim_String(cmdNameObj
), &fqObjName
);
4952 he
= Jim_FindHashEntry(ht
, fqname
);
4955 Jim_Cmd
*cmd
= Jim_GetHashEntryVal(he
);
4957 Jim_Cmd
*prevCmd
= cmd
->prevCmd
;
4958 cmd
->prevCmd
= NULL
;
4960 /* Delete the old command */
4961 JimDecrCmdRefCount(interp
, cmd
);
4963 /* And restore the original */
4964 Jim_SetHashVal(ht
, he
, prevCmd
);
4967 Jim_DeleteHashEntry(ht
, fqname
);
4968 Jim_InterpIncrProcEpoch(interp
);
4971 Jim_DecrRefCount(interp
, cmdNameObj
);
4972 JimFreeQualifiedName(interp
, fqObjName
);
4974 Jim_FreeStack(localCommands
);
4975 Jim_Free(localCommands
);
4981 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4982 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4983 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
)
4985 JimDeleteLocalProcs(interp
, cf
->localCommands
);
4987 if (cf
->procArgsObjPtr
)
4988 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
4989 if (cf
->procBodyObjPtr
)
4990 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
4991 Jim_DecrRefCount(interp
, cf
->nsObj
);
4992 if (action
== JIM_FCF_FULL
|| cf
->vars
.size
!= JIM_HT_INITIAL_SIZE
)
4993 Jim_FreeHashTable(&cf
->vars
);
4996 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
4998 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
5000 while (he
!= NULL
) {
5001 Jim_HashEntry
*nextEntry
= he
->next
;
5002 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
5004 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
5005 Jim_Free(Jim_GetHashEntryKey(he
));
5014 cf
->next
= interp
->freeFramesList
;
5015 interp
->freeFramesList
= cf
;
5019 /* -----------------------------------------------------------------------------
5021 * ---------------------------------------------------------------------------*/
5022 #ifdef JIM_REFERENCES
5024 /* References HashTable Type.
5026 * Keys are unsigned long integers, dynamically allocated for now but in the
5027 * future it's worth to cache this 4 bytes objects. Values are pointers
5028 * to Jim_References. */
5029 static void JimReferencesHTValDestructor(void *interp
, void *val
)
5031 Jim_Reference
*refPtr
= (void *)val
;
5033 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
5034 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
5035 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5040 static unsigned int JimReferencesHTHashFunction(const void *key
)
5042 /* Only the least significant bits are used. */
5043 const unsigned long *widePtr
= key
;
5044 unsigned int intValue
= (unsigned int)*widePtr
;
5046 return Jim_IntHashFunction(intValue
);
5049 static void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
5051 void *copy
= Jim_Alloc(sizeof(unsigned long));
5053 JIM_NOTUSED(privdata
);
5055 memcpy(copy
, key
, sizeof(unsigned long));
5059 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5061 JIM_NOTUSED(privdata
);
5063 return memcmp(key1
, key2
, sizeof(unsigned long)) == 0;
5066 static void JimReferencesHTKeyDestructor(void *privdata
, void *key
)
5068 JIM_NOTUSED(privdata
);
5073 static const Jim_HashTableType JimReferencesHashTableType
= {
5074 JimReferencesHTHashFunction
, /* hash function */
5075 JimReferencesHTKeyDup
, /* key dup */
5077 JimReferencesHTKeyCompare
, /* key compare */
5078 JimReferencesHTKeyDestructor
, /* key destructor */
5079 JimReferencesHTValDestructor
/* val destructor */
5082 /* -----------------------------------------------------------------------------
5083 * Reference object type and References API
5084 * ---------------------------------------------------------------------------*/
5086 /* The string representation of references has two features in order
5087 * to make the GC faster. The first is that every reference starts
5088 * with a non common character '<', in order to make the string matching
5089 * faster. The second is that the reference string rep is 42 characters
5090 * in length, this means that it is not necessary to check any object with a string
5091 * repr < 42, and usually there aren't many of these objects. */
5093 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5095 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, unsigned long id
)
5097 const char *fmt
= "<reference.<%s>.%020lu>";
5099 sprintf(buf
, fmt
, refPtr
->tag
, id
);
5100 return JIM_REFERENCE_SPACE
;
5103 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
5105 static const Jim_ObjType referenceObjType
= {
5109 UpdateStringOfReference
,
5110 JIM_TYPE_REFERENCES
,
5113 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
5115 char buf
[JIM_REFERENCE_SPACE
+ 1];
5117 JimFormatReference(buf
, objPtr
->internalRep
.refValue
.refPtr
, objPtr
->internalRep
.refValue
.id
);
5118 JimSetStringBytes(objPtr
, buf
);
5121 /* returns true if 'c' is a valid reference tag character.
5122 * i.e. inside the range [_a-zA-Z0-9] */
5123 static int isrefchar(int c
)
5125 return (c
== '_' || isalnum(c
));
5128 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5130 unsigned long value
;
5132 const char *str
, *start
, *end
;
5134 Jim_Reference
*refPtr
;
5138 /* Get the string representation */
5139 str
= Jim_GetString(objPtr
, &len
);
5140 /* Check if it looks like a reference */
5141 if (len
< JIM_REFERENCE_SPACE
)
5145 end
= str
+ len
- 1;
5146 while (*start
== ' ')
5148 while (*end
== ' ' && end
> start
)
5150 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
5152 /* <reference.<1234567>.%020> */
5153 if (memcmp(start
, "<reference.<", 12) != 0)
5155 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
5157 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5158 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5159 if (!isrefchar(start
[12 + i
]))
5162 /* Extract info from the reference. */
5163 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
5165 /* Try to convert the ID into an unsigned long */
5166 value
= strtoul(refId
, &endptr
, 10);
5167 if (JimCheckConversion(refId
, endptr
) != JIM_OK
)
5169 /* Check if the reference really exists! */
5170 he
= Jim_FindHashEntry(&interp
->references
, &value
);
5172 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
5175 refPtr
= Jim_GetHashEntryVal(he
);
5176 /* Free the old internal repr and set the new one. */
5177 Jim_FreeIntRep(interp
, objPtr
);
5178 objPtr
->typePtr
= &referenceObjType
;
5179 objPtr
->internalRep
.refValue
.id
= value
;
5180 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5184 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
5188 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5189 * as finalizer command (or NULL if there is no finalizer).
5190 * The returned reference object has refcount = 0. */
5191 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
5193 struct Jim_Reference
*refPtr
;
5199 /* Perform the Garbage Collection if needed. */
5200 Jim_CollectIfNeeded(interp
);
5202 refPtr
= Jim_Alloc(sizeof(*refPtr
));
5203 refPtr
->objPtr
= objPtr
;
5204 Jim_IncrRefCount(objPtr
);
5205 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5207 Jim_IncrRefCount(cmdNamePtr
);
5208 id
= interp
->referenceNextId
++;
5209 Jim_AddHashEntry(&interp
->references
, &id
, refPtr
);
5210 refObjPtr
= Jim_NewObj(interp
);
5211 refObjPtr
->typePtr
= &referenceObjType
;
5212 refObjPtr
->bytes
= NULL
;
5213 refObjPtr
->internalRep
.refValue
.id
= id
;
5214 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5215 interp
->referenceNextId
++;
5216 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5217 * that does not pass the 'isrefchar' test is replaced with '_' */
5218 tag
= Jim_GetString(tagPtr
, &tagLen
);
5219 if (tagLen
> JIM_REFERENCE_TAGLEN
)
5220 tagLen
= JIM_REFERENCE_TAGLEN
;
5221 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5222 if (i
< tagLen
&& isrefchar(tag
[i
]))
5223 refPtr
->tag
[i
] = tag
[i
];
5225 refPtr
->tag
[i
] = '_';
5227 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
5231 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5233 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
5235 return objPtr
->internalRep
.refValue
.refPtr
;
5238 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
5240 Jim_Reference
*refPtr
;
5242 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5244 Jim_IncrRefCount(cmdNamePtr
);
5245 if (refPtr
->finalizerCmdNamePtr
)
5246 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5247 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5251 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
5253 Jim_Reference
*refPtr
;
5255 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5257 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
5261 /* -----------------------------------------------------------------------------
5262 * References Garbage Collection
5263 * ---------------------------------------------------------------------------*/
5265 /* This the hash table type for the "MARK" phase of the GC */
5266 static const Jim_HashTableType JimRefMarkHashTableType
= {
5267 JimReferencesHTHashFunction
, /* hash function */
5268 JimReferencesHTKeyDup
, /* key dup */
5270 JimReferencesHTKeyCompare
, /* key compare */
5271 JimReferencesHTKeyDestructor
, /* key destructor */
5272 NULL
/* val destructor */
5275 /* Performs the garbage collection. */
5276 int Jim_Collect(Jim_Interp
*interp
)
5279 #ifndef JIM_BOOTSTRAP
5280 Jim_HashTable marks
;
5281 Jim_HashTableIterator htiter
;
5285 /* Avoid recursive calls */
5286 if (interp
->lastCollectId
== -1) {
5287 /* Jim_Collect() already running. Return just now. */
5290 interp
->lastCollectId
= -1;
5292 /* Mark all the references found into the 'mark' hash table.
5293 * The references are searched in every live object that
5294 * is of a type that can contain references. */
5295 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
5296 objPtr
= interp
->liveList
;
5298 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
5299 const char *str
, *p
;
5302 /* If the object is of type reference, to get the
5303 * Id is simple... */
5304 if (objPtr
->typePtr
== &referenceObjType
) {
5305 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
5307 printf("MARK (reference): %d refcount: %d\n",
5308 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
5310 objPtr
= objPtr
->nextObjPtr
;
5313 /* Get the string repr of the object we want
5314 * to scan for references. */
5315 p
= str
= Jim_GetString(objPtr
, &len
);
5316 /* Skip objects too little to contain references. */
5317 if (len
< JIM_REFERENCE_SPACE
) {
5318 objPtr
= objPtr
->nextObjPtr
;
5321 /* Extract references from the object string repr. */
5326 if ((p
= strstr(p
, "<reference.<")) == NULL
)
5328 /* Check if it's a valid reference. */
5329 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
5331 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
5333 for (i
= 21; i
<= 40; i
++)
5334 if (!isdigit(UCHAR(p
[i
])))
5337 id
= strtoul(p
+ 21, NULL
, 10);
5339 /* Ok, a reference for the given ID
5340 * was found. Mark it. */
5341 Jim_AddHashEntry(&marks
, &id
, NULL
);
5343 printf("MARK: %d\n", (int)id
);
5345 p
+= JIM_REFERENCE_SPACE
;
5348 objPtr
= objPtr
->nextObjPtr
;
5351 /* Run the references hash table to destroy every reference that
5352 * is not referenced outside (not present in the mark HT). */
5353 JimInitHashTableIterator(&interp
->references
, &htiter
);
5354 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
5355 const unsigned long *refId
;
5356 Jim_Reference
*refPtr
;
5359 /* Check if in the mark phase we encountered
5360 * this reference. */
5361 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
5363 printf("COLLECTING %d\n", (int)*refId
);
5366 /* Drop the reference, but call the
5367 * finalizer first if registered. */
5368 refPtr
= Jim_GetHashEntryVal(he
);
5369 if (refPtr
->finalizerCmdNamePtr
) {
5370 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
5371 Jim_Obj
*objv
[3], *oldResult
;
5373 JimFormatReference(refstr
, refPtr
, *refId
);
5375 objv
[0] = refPtr
->finalizerCmdNamePtr
;
5376 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, JIM_REFERENCE_SPACE
);
5377 objv
[2] = refPtr
->objPtr
;
5379 /* Drop the reference itself */
5380 /* Avoid the finaliser being freed here */
5381 Jim_IncrRefCount(objv
[0]);
5382 /* Don't remove the reference from the hash table just yet
5383 * since that will free refPtr, and hence refPtr->objPtr
5386 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5387 oldResult
= interp
->result
;
5388 Jim_IncrRefCount(oldResult
);
5389 Jim_EvalObjVector(interp
, 3, objv
);
5390 Jim_SetResult(interp
, oldResult
);
5391 Jim_DecrRefCount(interp
, oldResult
);
5393 Jim_DecrRefCount(interp
, objv
[0]);
5395 Jim_DeleteHashEntry(&interp
->references
, refId
);
5398 Jim_FreeHashTable(&marks
);
5399 interp
->lastCollectId
= interp
->referenceNextId
;
5400 interp
->lastCollectTime
= time(NULL
);
5401 #endif /* JIM_BOOTSTRAP */
5405 #define JIM_COLLECT_ID_PERIOD 5000
5406 #define JIM_COLLECT_TIME_PERIOD 300
5408 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
5410 unsigned long elapsedId
;
5413 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
5414 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
5417 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
5418 Jim_Collect(interp
);
5423 int Jim_IsBigEndian(void)
5430 return uval
.c
[0] == 1;
5433 /* -----------------------------------------------------------------------------
5434 * Interpreter related functions
5435 * ---------------------------------------------------------------------------*/
5437 Jim_Interp
*Jim_CreateInterp(void)
5439 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
5441 memset(i
, 0, sizeof(*i
));
5443 i
->maxCallFrameDepth
= JIM_MAX_CALLFRAME_DEPTH
;
5444 i
->maxEvalDepth
= JIM_MAX_EVAL_DEPTH
;
5445 i
->lastCollectTime
= time(NULL
);
5447 /* Note that we can create objects only after the
5448 * interpreter liveList and freeList pointers are
5449 * initialized to NULL. */
5450 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
5451 #ifdef JIM_REFERENCES
5452 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
5454 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
5455 Jim_InitHashTable(&i
->packages
, &JimPackageHashTableType
, NULL
);
5456 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
5457 i
->trueObj
= Jim_NewIntObj(i
, 1);
5458 i
->falseObj
= Jim_NewIntObj(i
, 0);
5459 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
, i
->emptyObj
);
5460 i
->errorFileNameObj
= i
->emptyObj
;
5461 i
->result
= i
->emptyObj
;
5462 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
5463 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
5464 i
->errorProc
= i
->emptyObj
;
5465 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
5466 i
->nullScriptObj
= Jim_NewEmptyStringObj(i
);
5467 Jim_IncrRefCount(i
->emptyObj
);
5468 Jim_IncrRefCount(i
->errorFileNameObj
);
5469 Jim_IncrRefCount(i
->result
);
5470 Jim_IncrRefCount(i
->stackTrace
);
5471 Jim_IncrRefCount(i
->unknown
);
5472 Jim_IncrRefCount(i
->currentScriptObj
);
5473 Jim_IncrRefCount(i
->nullScriptObj
);
5474 Jim_IncrRefCount(i
->errorProc
);
5475 Jim_IncrRefCount(i
->trueObj
);
5476 Jim_IncrRefCount(i
->falseObj
);
5478 /* Initialize key variables every interpreter should contain */
5479 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
5480 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
5482 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5483 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5484 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5485 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5486 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5487 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5488 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5493 void Jim_FreeInterp(Jim_Interp
*i
)
5495 Jim_CallFrame
*cf
, *cfx
;
5497 Jim_Obj
*objPtr
, *nextObjPtr
;
5499 /* Free the active call frames list - must be done before i->commands is destroyed */
5500 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5502 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5505 Jim_DecrRefCount(i
, i
->emptyObj
);
5506 Jim_DecrRefCount(i
, i
->trueObj
);
5507 Jim_DecrRefCount(i
, i
->falseObj
);
5508 Jim_DecrRefCount(i
, i
->result
);
5509 Jim_DecrRefCount(i
, i
->stackTrace
);
5510 Jim_DecrRefCount(i
, i
->errorProc
);
5511 Jim_DecrRefCount(i
, i
->unknown
);
5512 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5513 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5514 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5515 Jim_FreeHashTable(&i
->commands
);
5516 #ifdef JIM_REFERENCES
5517 Jim_FreeHashTable(&i
->references
);
5519 Jim_FreeHashTable(&i
->packages
);
5520 Jim_Free(i
->prngState
);
5521 Jim_FreeHashTable(&i
->assocData
);
5523 /* Check that the live object list is empty, otherwise
5524 * there is a memory leak. */
5525 #ifdef JIM_MAINTAINER
5526 if (i
->liveList
!= NULL
) {
5527 objPtr
= i
->liveList
;
5529 printf("\n-------------------------------------\n");
5530 printf("Objects still in the free list:\n");
5532 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5534 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5535 printf("%p (%d) %-10s: '%.20s...'\n",
5536 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5539 printf("%p (%d) %-10s: '%s'\n",
5540 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5542 if (objPtr
->typePtr
== &sourceObjType
) {
5543 printf("FILE %s LINE %d\n",
5544 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5545 objPtr
->internalRep
.sourceValue
.lineNumber
);
5547 objPtr
= objPtr
->nextObjPtr
;
5549 printf("-------------------------------------\n\n");
5550 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5554 /* Free all the freed objects. */
5555 objPtr
= i
->freeList
;
5557 nextObjPtr
= objPtr
->nextObjPtr
;
5559 objPtr
= nextObjPtr
;
5562 /* Free the free call frames list */
5563 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5566 Jim_FreeHashTable(&cf
->vars
);
5570 /* Free the interpreter structure. */
5574 /* Returns the call frame relative to the level represented by
5575 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5577 * This function accepts the 'level' argument in the form
5578 * of the commands [uplevel] and [upvar].
5580 * Returns NULL on error.
5582 * Note: for a function accepting a relative integer as level suitable
5583 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5585 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5589 Jim_CallFrame
*framePtr
;
5592 str
= Jim_String(levelObjPtr
);
5593 if (str
[0] == '#') {
5596 level
= jim_strtol(str
+ 1, &endptr
);
5597 if (str
[1] == '\0' || endptr
[0] != '\0') {
5602 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5606 /* Convert from a relative to an absolute level */
5607 level
= interp
->framePtr
->level
- level
;
5612 str
= "1"; /* Needed to format the error message. */
5613 level
= interp
->framePtr
->level
- 1;
5617 return interp
->topFramePtr
;
5621 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5622 if (framePtr
->level
== level
) {
5628 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5632 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5633 * as a relative integer like in the [info level ?level?] command.
5635 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5638 Jim_CallFrame
*framePtr
;
5640 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5642 /* Convert from a relative to an absolute level */
5643 level
= interp
->framePtr
->level
+ level
;
5647 return interp
->topFramePtr
;
5651 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5652 if (framePtr
->level
== level
) {
5658 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5662 static void JimResetStackTrace(Jim_Interp
*interp
)
5664 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5665 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5666 Jim_IncrRefCount(interp
->stackTrace
);
5669 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5673 /* Increment reference first in case these are the same object */
5674 Jim_IncrRefCount(stackTraceObj
);
5675 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5676 interp
->stackTrace
= stackTraceObj
;
5677 interp
->errorFlag
= 1;
5679 /* This is a bit ugly.
5680 * If the filename of the last entry of the stack trace is empty,
5681 * the next stack level should be added.
5683 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5685 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5686 interp
->addStackTrace
= 1;
5691 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5692 Jim_Obj
*fileNameObj
, int linenr
)
5694 if (strcmp(procname
, "unknown") == 0) {
5697 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5698 /* No useful info here */
5702 if (Jim_IsShared(interp
->stackTrace
)) {
5703 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5704 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5705 Jim_IncrRefCount(interp
->stackTrace
);
5708 /* If we have no procname but the previous element did, merge with that frame */
5709 if (!*procname
&& Jim_Length(fileNameObj
)) {
5710 /* Just a filename. Check the previous entry */
5711 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5714 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5715 if (Jim_Length(objPtr
)) {
5716 /* Yes, the previous level had procname */
5717 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5718 if (Jim_Length(objPtr
) == 0) {
5719 /* But no filename, so merge the new info with that frame */
5720 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5721 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5728 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5729 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5730 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5733 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5736 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5738 assocEntryPtr
->delProc
= delProc
;
5739 assocEntryPtr
->data
= data
;
5740 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5743 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5745 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5747 if (entryPtr
!= NULL
) {
5748 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5749 return assocEntryPtr
->data
;
5754 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5756 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5759 int Jim_GetExitCode(Jim_Interp
*interp
)
5761 return interp
->exitCode
;
5764 /* -----------------------------------------------------------------------------
5766 * ---------------------------------------------------------------------------*/
5767 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5768 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5770 static const Jim_ObjType intObjType
= {
5778 /* A coerced double is closer to an int than a double.
5779 * It is an int value temporarily masquerading as a double value.
5780 * i.e. it has the same string value as an int and Jim_GetWide()
5781 * succeeds, but also Jim_GetDouble() returns the value directly.
5783 static const Jim_ObjType coercedDoubleObjType
= {
5792 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5794 char buf
[JIM_INTEGER_SPACE
+ 1];
5795 jim_wide wideValue
= JimWideValue(objPtr
);
5798 if (wideValue
== 0) {
5802 char tmp
[JIM_INTEGER_SPACE
];
5806 if (wideValue
< 0) {
5809 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5810 * whereas C99 is always -6
5811 * coverity[dead_error_line]
5813 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5818 tmp
[num
++] = wideValue
% 10;
5822 for (i
= 0; i
< num
; i
++) {
5823 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5828 JimSetStringBytes(objPtr
, buf
);
5831 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5836 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5837 /* Simple switcheroo */
5838 objPtr
->typePtr
= &intObjType
;
5842 /* Get the string representation */
5843 str
= Jim_String(objPtr
);
5844 /* Try to convert into a jim_wide */
5845 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5846 if (flags
& JIM_ERRMSG
) {
5847 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5851 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5852 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5855 /* Free the old internal repr and set the new one. */
5856 Jim_FreeIntRep(interp
, objPtr
);
5857 objPtr
->typePtr
= &intObjType
;
5858 objPtr
->internalRep
.wideValue
= wideValue
;
5862 #ifdef JIM_OPTIMIZATION
5863 static int JimIsWide(Jim_Obj
*objPtr
)
5865 return objPtr
->typePtr
== &intObjType
;
5869 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5871 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5873 *widePtr
= JimWideValue(objPtr
);
5877 /* Get a wide but does not set an error if the format is bad. */
5878 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5880 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5882 *widePtr
= JimWideValue(objPtr
);
5886 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5891 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5892 if (retval
== JIM_OK
) {
5893 *longPtr
= (long)wideValue
;
5899 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5903 objPtr
= Jim_NewObj(interp
);
5904 objPtr
->typePtr
= &intObjType
;
5905 objPtr
->bytes
= NULL
;
5906 objPtr
->internalRep
.wideValue
= wideValue
;
5910 /* -----------------------------------------------------------------------------
5912 * ---------------------------------------------------------------------------*/
5913 #define JIM_DOUBLE_SPACE 30
5915 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5916 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5918 static const Jim_ObjType doubleObjType
= {
5922 UpdateStringOfDouble
,
5928 #define isnan(X) ((X) != (X))
5932 #define isinf(X) (1.0 / (X) == 0.0)
5935 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5937 double value
= objPtr
->internalRep
.doubleValue
;
5940 JimSetStringBytes(objPtr
, "NaN");
5945 JimSetStringBytes(objPtr
, "-Inf");
5948 JimSetStringBytes(objPtr
, "Inf");
5953 char buf
[JIM_DOUBLE_SPACE
+ 1];
5955 int len
= sprintf(buf
, "%.12g", value
);
5957 /* Add a final ".0" if necessary */
5958 for (i
= 0; i
< len
; i
++) {
5959 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5960 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5961 /* If 'buf' ends in e-0nn or e+0nn, remove
5962 * the 0 after the + or - and reduce the length by 1
5964 char *e
= strchr(buf
, 'e');
5965 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5968 memmove(e
, e
+ 1, len
- (e
- buf
));
5974 if (buf
[i
] == '\0') {
5979 JimSetStringBytes(objPtr
, buf
);
5983 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5989 /* Preserve the string representation.
5990 * Needed so we can convert back to int without loss
5992 str
= Jim_String(objPtr
);
5994 #ifdef HAVE_LONG_LONG
5995 /* Assume a 53 bit mantissa */
5996 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5997 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5999 if (objPtr
->typePtr
== &intObjType
6000 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
6001 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6003 /* Direct conversion to coerced double */
6004 objPtr
->typePtr
= &coercedDoubleObjType
;
6009 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6010 /* Managed to convert to an int, so we can use this as a cooerced double */
6011 Jim_FreeIntRep(interp
, objPtr
);
6012 objPtr
->typePtr
= &coercedDoubleObjType
;
6013 objPtr
->internalRep
.wideValue
= wideValue
;
6017 /* Try to convert into a double */
6018 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6019 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6022 /* Free the old internal repr and set the new one. */
6023 Jim_FreeIntRep(interp
, objPtr
);
6025 objPtr
->typePtr
= &doubleObjType
;
6026 objPtr
->internalRep
.doubleValue
= doubleValue
;
6030 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6032 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6033 *doublePtr
= JimWideValue(objPtr
);
6036 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6039 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6040 *doublePtr
= JimWideValue(objPtr
);
6043 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6048 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6052 objPtr
= Jim_NewObj(interp
);
6053 objPtr
->typePtr
= &doubleObjType
;
6054 objPtr
->bytes
= NULL
;
6055 objPtr
->internalRep
.doubleValue
= doubleValue
;
6059 /* -----------------------------------------------------------------------------
6061 * ---------------------------------------------------------------------------*/
6062 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6063 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6064 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6065 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6066 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6067 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6069 /* Note that while the elements of the list may contain references,
6070 * the list object itself can't. This basically means that the
6071 * list object string representation as a whole can't contain references
6072 * that are not presents in the single elements. */
6073 static const Jim_ObjType listObjType
= {
6075 FreeListInternalRep
,
6081 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6085 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6086 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6088 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6091 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6095 JIM_NOTUSED(interp
);
6097 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6098 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6099 dupPtr
->internalRep
.listValue
.ele
=
6100 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6101 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6102 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6103 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6104 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6106 dupPtr
->typePtr
= &listObjType
;
6109 /* The following function checks if a given string can be encoded
6110 * into a list element without any kind of quoting, surrounded by braces,
6111 * or using escapes to quote. */
6112 #define JIM_ELESTR_SIMPLE 0
6113 #define JIM_ELESTR_BRACE 1
6114 #define JIM_ELESTR_QUOTE 2
6115 static unsigned char ListElementQuotingType(const char *s
, int len
)
6117 int i
, level
, blevel
, trySimple
= 1;
6119 /* Try with the SIMPLE case */
6121 return JIM_ELESTR_BRACE
;
6122 if (s
[0] == '"' || s
[0] == '{') {
6126 for (i
= 0; i
< len
; i
++) {
6146 return JIM_ELESTR_SIMPLE
;
6149 /* Test if it's possible to do with braces */
6150 if (s
[len
- 1] == '\\')
6151 return JIM_ELESTR_QUOTE
;
6154 for (i
= 0; i
< len
; i
++) {
6162 return JIM_ELESTR_QUOTE
;
6171 if (s
[i
+ 1] == '\n')
6172 return JIM_ELESTR_QUOTE
;
6173 else if (s
[i
+ 1] != '\0')
6179 return JIM_ELESTR_QUOTE
;
6184 return JIM_ELESTR_BRACE
;
6185 for (i
= 0; i
< len
; i
++) {
6199 return JIM_ELESTR_BRACE
;
6203 return JIM_ELESTR_SIMPLE
;
6205 return JIM_ELESTR_QUOTE
;
6208 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6209 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6211 * Returns the length of the result.
6213 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6266 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6268 #define STATIC_QUOTING_LEN 32
6269 int i
, bufLen
, realLength
;
6272 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6274 /* Estimate the space needed. */
6275 if (objc
> STATIC_QUOTING_LEN
) {
6276 quotingType
= Jim_Alloc(objc
);
6279 quotingType
= staticQuoting
;
6282 for (i
= 0; i
< objc
; i
++) {
6285 strRep
= Jim_GetString(objv
[i
], &len
);
6286 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6287 switch (quotingType
[i
]) {
6288 case JIM_ELESTR_SIMPLE
:
6289 if (i
!= 0 || strRep
[0] != '#') {
6293 /* Special case '#' on first element needs braces */
6294 quotingType
[i
] = JIM_ELESTR_BRACE
;
6296 case JIM_ELESTR_BRACE
:
6299 case JIM_ELESTR_QUOTE
:
6303 bufLen
++; /* elements separator. */
6307 /* Generate the string rep. */
6308 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6310 for (i
= 0; i
< objc
; i
++) {
6313 strRep
= Jim_GetString(objv
[i
], &len
);
6315 switch (quotingType
[i
]) {
6316 case JIM_ELESTR_SIMPLE
:
6317 memcpy(p
, strRep
, len
);
6321 case JIM_ELESTR_BRACE
:
6323 memcpy(p
, strRep
, len
);
6326 realLength
+= len
+ 2;
6328 case JIM_ELESTR_QUOTE
:
6329 if (i
== 0 && strRep
[0] == '#') {
6333 qlen
= BackslashQuoteString(strRep
, len
, p
);
6338 /* Add a separating space */
6339 if (i
+ 1 != objc
) {
6344 *p
= '\0'; /* nul term. */
6345 objPtr
->length
= realLength
;
6347 if (quotingType
!= staticQuoting
) {
6348 Jim_Free(quotingType
);
6352 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6354 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6357 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6359 struct JimParserCtx parser
;
6362 Jim_Obj
*fileNameObj
;
6365 if (objPtr
->typePtr
== &listObjType
) {
6369 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6370 * it also preserves any source location of the dict elements
6371 * which can be very useful
6373 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6374 Jim_Obj
**listObjPtrPtr
;
6378 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6379 for (i
= 0; i
< len
; i
++) {
6380 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6383 /* Now just switch the internal rep */
6384 Jim_FreeIntRep(interp
, objPtr
);
6385 objPtr
->typePtr
= &listObjType
;
6386 objPtr
->internalRep
.listValue
.len
= len
;
6387 objPtr
->internalRep
.listValue
.maxLen
= len
;
6388 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6393 /* Try to preserve information about filename / line number */
6394 if (objPtr
->typePtr
== &sourceObjType
) {
6395 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6396 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6399 fileNameObj
= interp
->emptyObj
;
6402 Jim_IncrRefCount(fileNameObj
);
6404 /* Get the string representation */
6405 str
= Jim_GetString(objPtr
, &strLen
);
6407 /* Free the old internal repr just now and initialize the
6408 * new one just now. The string->list conversion can't fail. */
6409 Jim_FreeIntRep(interp
, objPtr
);
6410 objPtr
->typePtr
= &listObjType
;
6411 objPtr
->internalRep
.listValue
.len
= 0;
6412 objPtr
->internalRep
.listValue
.maxLen
= 0;
6413 objPtr
->internalRep
.listValue
.ele
= NULL
;
6415 /* Convert into a list */
6417 JimParserInit(&parser
, str
, strLen
, linenr
);
6418 while (!parser
.eof
) {
6419 Jim_Obj
*elementPtr
;
6421 JimParseList(&parser
);
6422 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6424 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6425 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6426 ListAppendElement(objPtr
, elementPtr
);
6429 Jim_DecrRefCount(interp
, fileNameObj
);
6433 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6437 objPtr
= Jim_NewObj(interp
);
6438 objPtr
->typePtr
= &listObjType
;
6439 objPtr
->bytes
= NULL
;
6440 objPtr
->internalRep
.listValue
.ele
= NULL
;
6441 objPtr
->internalRep
.listValue
.len
= 0;
6442 objPtr
->internalRep
.listValue
.maxLen
= 0;
6445 ListInsertElements(objPtr
, 0, len
, elements
);
6451 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6452 * length of the vector. Note that the user of this function should make
6453 * sure that the list object can't shimmer while the vector returned
6454 * is in use, this vector is the one stored inside the internal representation
6455 * of the list object. This function is not exported, extensions should
6456 * always access to the List object elements using Jim_ListIndex(). */
6457 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6460 *listLen
= Jim_ListLength(interp
, listObj
);
6461 *listVec
= listObj
->internalRep
.listValue
.ele
;
6464 /* Sorting uses ints, but commands may return wide */
6465 static int JimSign(jim_wide w
)
6476 /* ListSortElements type values */
6492 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6495 static struct lsort_info
*sort_info
;
6497 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6499 Jim_Obj
*lObj
, *rObj
;
6501 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6502 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6503 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6505 return sort_info
->subfn(&lObj
, &rObj
);
6508 /* Sort the internal rep of a list. */
6509 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6511 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6514 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6516 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6519 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6521 jim_wide lhs
= 0, rhs
= 0;
6523 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6524 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6525 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6528 return JimSign(lhs
- rhs
) * sort_info
->order
;
6531 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6533 double lhs
= 0, rhs
= 0;
6535 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6536 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6537 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6543 return sort_info
->order
;
6545 return -sort_info
->order
;
6548 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6550 Jim_Obj
*compare_script
;
6555 /* This must be a valid list */
6556 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6557 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6558 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6560 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6562 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6563 longjmp(sort_info
->jmpbuf
, rc
);
6566 return JimSign(ret
) * sort_info
->order
;
6569 /* Remove duplicate elements from the (sorted) list in-place, according to the
6570 * comparison function, comp.
6572 * Note that the last unique value is kept, not the first
6574 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6578 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6580 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6581 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6582 /* Match, so replace the dest with the current source */
6583 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6586 /* No match, so keep the current source and move to the next destination */
6589 ele
[dst
] = ele
[src
];
6591 /* At end of list, keep the final element */
6592 ele
[++dst
] = ele
[src
];
6594 /* Set the new length */
6595 listObjPtr
->internalRep
.listValue
.len
= dst
;
6598 /* Sort a list *in place*. MUST be called with a non-shared list. */
6599 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6601 struct lsort_info
*prev_info
;
6603 typedef int (qsort_comparator
) (const void *, const void *);
6604 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6609 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6610 SetListFromAny(interp
, listObjPtr
);
6612 /* Allow lsort to be called reentrantly */
6613 prev_info
= sort_info
;
6616 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6617 len
= listObjPtr
->internalRep
.listValue
.len
;
6618 switch (info
->type
) {
6619 case JIM_LSORT_ASCII
:
6620 fn
= ListSortString
;
6622 case JIM_LSORT_NOCASE
:
6623 fn
= ListSortStringNoCase
;
6625 case JIM_LSORT_INTEGER
:
6626 fn
= ListSortInteger
;
6628 case JIM_LSORT_REAL
:
6631 case JIM_LSORT_COMMAND
:
6632 fn
= ListSortCommand
;
6635 fn
= NULL
; /* avoid warning */
6636 JimPanic((1, "ListSort called with invalid sort type"));
6639 if (info
->indexed
) {
6640 /* Need to interpose a "list index" function */
6642 fn
= ListSortIndexHelper
;
6645 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6646 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6648 if (info
->unique
&& len
> 1) {
6649 ListRemoveDuplicates(listObjPtr
, fn
);
6652 Jim_InvalidateStringRep(listObjPtr
);
6654 sort_info
= prev_info
;
6659 /* This is the low-level function to insert elements into a list.
6660 * The higher-level Jim_ListInsertElements() performs shared object
6661 * check and invalidates the string repr. This version is used
6662 * in the internals of the List Object and is not exported.
6664 * NOTE: this function can be called only against objects
6665 * with internal type of List.
6667 * An insertion point (idx) of -1 means end-of-list.
6669 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6671 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6672 int requiredLen
= currentLen
+ elemc
;
6676 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6677 if (requiredLen
< 2) {
6678 /* Don't do allocations of under 4 pointers. */
6685 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6686 sizeof(Jim_Obj
*) * requiredLen
);
6688 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6693 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6694 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6695 for (i
= 0; i
< elemc
; ++i
) {
6696 point
[i
] = elemVec
[i
];
6697 Jim_IncrRefCount(point
[i
]);
6699 listPtr
->internalRep
.listValue
.len
+= elemc
;
6702 /* Convenience call to ListInsertElements() to append a single element.
6704 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6706 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6709 /* Appends every element of appendListPtr into listPtr.
6710 * Both have to be of the list type.
6711 * Convenience call to ListInsertElements()
6713 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6715 ListInsertElements(listPtr
, -1,
6716 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6719 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6721 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6722 SetListFromAny(interp
, listPtr
);
6723 Jim_InvalidateStringRep(listPtr
);
6724 ListAppendElement(listPtr
, objPtr
);
6727 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6729 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6730 SetListFromAny(interp
, listPtr
);
6731 SetListFromAny(interp
, appendListPtr
);
6732 Jim_InvalidateStringRep(listPtr
);
6733 ListAppendList(listPtr
, appendListPtr
);
6736 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6738 SetListFromAny(interp
, objPtr
);
6739 return objPtr
->internalRep
.listValue
.len
;
6742 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6743 int objc
, Jim_Obj
*const *objVec
)
6745 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6746 SetListFromAny(interp
, listPtr
);
6747 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6748 idx
= listPtr
->internalRep
.listValue
.len
;
6751 Jim_InvalidateStringRep(listPtr
);
6752 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6755 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6757 SetListFromAny(interp
, listPtr
);
6758 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6759 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6763 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6764 return listPtr
->internalRep
.listValue
.ele
[idx
];
6767 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6769 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6770 if (*objPtrPtr
== NULL
) {
6771 if (flags
& JIM_ERRMSG
) {
6772 Jim_SetResultString(interp
, "list index out of range", -1);
6779 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6780 Jim_Obj
*newObjPtr
, int flags
)
6782 SetListFromAny(interp
, listPtr
);
6783 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6784 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6785 if (flags
& JIM_ERRMSG
) {
6786 Jim_SetResultString(interp
, "list index out of range", -1);
6791 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6792 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6793 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6794 Jim_IncrRefCount(newObjPtr
);
6798 /* Modify the list stored in the variable named 'varNamePtr'
6799 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6800 * with the new element 'newObjptr'. (implements the [lset] command) */
6801 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6802 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6804 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6807 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6810 if ((shared
= Jim_IsShared(objPtr
)))
6811 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6812 for (i
= 0; i
< indexc
- 1; i
++) {
6813 listObjPtr
= objPtr
;
6814 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6816 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6819 if (Jim_IsShared(objPtr
)) {
6820 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6821 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6823 Jim_InvalidateStringRep(listObjPtr
);
6825 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6827 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6829 Jim_InvalidateStringRep(objPtr
);
6830 Jim_InvalidateStringRep(varObjPtr
);
6831 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6833 Jim_SetResult(interp
, varObjPtr
);
6837 Jim_FreeNewObj(interp
, varObjPtr
);
6842 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6845 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6846 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6848 for (i
= 0; i
< listLen
; ) {
6849 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6850 if (++i
!= listLen
) {
6851 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6857 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6861 /* If all the objects in objv are lists,
6862 * it's possible to return a list as result, that's the
6863 * concatenation of all the lists. */
6864 for (i
= 0; i
< objc
; i
++) {
6865 if (!Jim_IsList(objv
[i
]))
6869 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6871 for (i
= 0; i
< objc
; i
++)
6872 ListAppendList(objPtr
, objv
[i
]);
6876 /* Else... we have to glue strings together */
6877 int len
= 0, objLen
;
6880 /* Compute the length */
6881 for (i
= 0; i
< objc
; i
++) {
6882 len
+= Jim_Length(objv
[i
]);
6886 /* Create the string rep, and a string object holding it. */
6887 p
= bytes
= Jim_Alloc(len
+ 1);
6888 for (i
= 0; i
< objc
; i
++) {
6889 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6891 /* Remove leading space */
6892 while (objLen
&& isspace(UCHAR(*s
))) {
6897 /* And trailing space */
6898 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6899 /* Handle trailing backslash-space case */
6900 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6906 memcpy(p
, s
, objLen
);
6908 if (i
+ 1 != objc
) {
6912 /* Drop the space calcuated for this
6913 * element that is instead null. */
6919 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6923 /* Returns a list composed of the elements in the specified range.
6924 * first and start are directly accepted as Jim_Objects and
6925 * processed for the end?-index? case. */
6926 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6927 Jim_Obj
*lastObjPtr
)
6932 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6933 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
6935 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
6936 first
= JimRelToAbsIndex(len
, first
);
6937 last
= JimRelToAbsIndex(len
, last
);
6938 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
6939 if (first
== 0 && last
== len
) {
6942 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
6945 /* -----------------------------------------------------------------------------
6947 * ---------------------------------------------------------------------------*/
6948 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6949 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6950 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
6951 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6953 /* Dict HashTable Type.
6955 * Keys and Values are Jim objects. */
6957 static unsigned int JimObjectHTHashFunction(const void *key
)
6960 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
6961 return Jim_GenHashFunction((const unsigned char *)str
, len
);
6964 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
6966 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
6969 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
6971 Jim_IncrRefCount((Jim_Obj
*)val
);
6975 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
6977 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
6980 static const Jim_HashTableType JimDictHashTableType
= {
6981 JimObjectHTHashFunction
, /* hash function */
6982 JimObjectHTKeyValDup
, /* key dup */
6983 JimObjectHTKeyValDup
, /* val dup */
6984 JimObjectHTKeyCompare
, /* key compare */
6985 JimObjectHTKeyValDestructor
, /* key destructor */
6986 JimObjectHTKeyValDestructor
/* val destructor */
6989 /* Note that while the elements of the dict may contain references,
6990 * the list object itself can't. This basically means that the
6991 * dict object string representation as a whole can't contain references
6992 * that are not presents in the single elements. */
6993 static const Jim_ObjType dictObjType
= {
6995 FreeDictInternalRep
,
7001 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7003 JIM_NOTUSED(interp
);
7005 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7006 Jim_Free(objPtr
->internalRep
.ptr
);
7009 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7011 Jim_HashTable
*ht
, *dupHt
;
7012 Jim_HashTableIterator htiter
;
7015 /* Create a new hash table */
7016 ht
= srcPtr
->internalRep
.ptr
;
7017 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7018 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7020 Jim_ExpandHashTable(dupHt
, ht
->size
);
7021 /* Copy every element from the source to the dup hash table */
7022 JimInitHashTableIterator(ht
, &htiter
);
7023 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7024 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7027 dupPtr
->internalRep
.ptr
= dupHt
;
7028 dupPtr
->typePtr
= &dictObjType
;
7031 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7034 Jim_HashTableIterator htiter
;
7039 ht
= dictPtr
->internalRep
.ptr
;
7041 /* Turn the hash table into a flat vector of Jim_Objects. */
7042 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7043 JimInitHashTableIterator(ht
, &htiter
);
7045 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7046 objv
[i
++] = Jim_GetHashEntryKey(he
);
7047 objv
[i
++] = Jim_GetHashEntryVal(he
);
7053 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7055 /* Turn the hash table into a flat vector of Jim_Objects. */
7057 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7059 /* And now generate the string rep as a list */
7060 JimMakeListStringRep(objPtr
, objv
, len
);
7065 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7069 if (objPtr
->typePtr
== &dictObjType
) {
7073 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7074 /* A shared list, so get the string representation now to avoid
7075 * changing the order in case of fast conversion to dict.
7080 /* For simplicity, convert a non-list object to a list and then to a dict */
7081 listlen
= Jim_ListLength(interp
, objPtr
);
7083 Jim_SetResultString(interp
, "missing value to go with key", -1);
7087 /* Converting from a list to a dict can't fail */
7091 ht
= Jim_Alloc(sizeof(*ht
));
7092 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7094 for (i
= 0; i
< listlen
; i
+= 2) {
7095 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7096 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7098 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7101 Jim_FreeIntRep(interp
, objPtr
);
7102 objPtr
->typePtr
= &dictObjType
;
7103 objPtr
->internalRep
.ptr
= ht
;
7109 /* Dict object API */
7111 /* Add an element to a dict. objPtr must be of the "dict" type.
7112 * The higer-level exported function is Jim_DictAddElement().
7113 * If an element with the specified key already exists, the value
7114 * associated is replaced with the new one.
7116 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7117 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7118 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7120 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7122 if (valueObjPtr
== NULL
) { /* unset */
7123 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7125 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7129 /* Add an element, higher-level interface for DictAddElement().
7130 * If valueObjPtr == NULL, the key is removed if it exists. */
7131 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7132 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7134 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7135 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7138 Jim_InvalidateStringRep(objPtr
);
7139 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7142 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7147 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7149 objPtr
= Jim_NewObj(interp
);
7150 objPtr
->typePtr
= &dictObjType
;
7151 objPtr
->bytes
= NULL
;
7152 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7153 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7154 for (i
= 0; i
< len
; i
+= 2)
7155 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7159 /* Return the value associated to the specified dict key
7160 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7162 * Sets *objPtrPtr to non-NULL only upon success.
7164 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7165 Jim_Obj
**objPtrPtr
, int flags
)
7170 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7173 ht
= dictPtr
->internalRep
.ptr
;
7174 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7175 if (flags
& JIM_ERRMSG
) {
7176 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7180 *objPtrPtr
= he
->u
.val
;
7184 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7185 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7187 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7190 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7196 /* Return the value associated to the specified dict keys */
7197 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7198 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7203 *objPtrPtr
= dictPtr
;
7207 for (i
= 0; i
< keyc
; i
++) {
7210 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7216 *objPtrPtr
= dictPtr
;
7220 /* Modify the dict stored into the variable named 'varNamePtr'
7221 * setting the element specified by the 'keyc' keys objects in 'keyv',
7222 * with the new value of the element 'newObjPtr'.
7224 * If newObjPtr == NULL the operation is to remove the given key
7225 * from the dictionary.
7227 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7228 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7230 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7231 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7233 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7236 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7237 if (objPtr
== NULL
) {
7238 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7239 /* Cannot remove a key from non existing var */
7242 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7243 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7244 Jim_FreeNewObj(interp
, varObjPtr
);
7248 if ((shared
= Jim_IsShared(objPtr
)))
7249 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7250 for (i
= 0; i
< keyc
; i
++) {
7251 dictObjPtr
= objPtr
;
7253 /* Check if it's a valid dictionary */
7254 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7258 if (i
== keyc
- 1) {
7259 /* Last key: Note that error on unset with missing last key is OK */
7260 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7261 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7268 /* Check if the given key exists. */
7269 Jim_InvalidateStringRep(dictObjPtr
);
7270 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7271 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7272 /* This key exists at the current level.
7273 * Make sure it's not shared!. */
7274 if (Jim_IsShared(objPtr
)) {
7275 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7276 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7280 /* Key not found. If it's an [unset] operation
7281 * this is an error. Only the last key may not
7283 if (newObjPtr
== NULL
) {
7286 /* Otherwise set an empty dictionary
7287 * as key's value. */
7288 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7289 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7292 /* XXX: Is this necessary? */
7293 Jim_InvalidateStringRep(objPtr
);
7294 Jim_InvalidateStringRep(varObjPtr
);
7295 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7298 Jim_SetResult(interp
, varObjPtr
);
7302 Jim_FreeNewObj(interp
, varObjPtr
);
7307 /* -----------------------------------------------------------------------------
7309 * ---------------------------------------------------------------------------*/
7310 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7311 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7313 static const Jim_ObjType indexObjType
= {
7317 UpdateStringOfIndex
,
7321 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7323 if (objPtr
->internalRep
.intValue
== -1) {
7324 JimSetStringBytes(objPtr
, "end");
7327 char buf
[JIM_INTEGER_SPACE
+ 1];
7328 if (objPtr
->internalRep
.intValue
>= 0) {
7329 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7333 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7335 JimSetStringBytes(objPtr
, buf
);
7339 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7345 /* Get the string representation */
7346 str
= Jim_String(objPtr
);
7348 /* Try to convert into an index */
7349 if (strncmp(str
, "end", 3) == 0) {
7355 idx
= jim_strtol(str
, &endptr
);
7357 if (endptr
== str
) {
7363 /* Now str may include or +<num> or -<num> */
7364 if (*str
== '+' || *str
== '-') {
7365 int sign
= (*str
== '+' ? 1 : -1);
7367 idx
+= sign
* jim_strtol(++str
, &endptr
);
7368 if (str
== endptr
|| *endptr
) {
7373 /* The only thing left should be spaces */
7374 while (isspace(UCHAR(*str
))) {
7385 /* end-1 is repesented as -2 */
7393 /* Free the old internal repr and set the new one. */
7394 Jim_FreeIntRep(interp
, objPtr
);
7395 objPtr
->typePtr
= &indexObjType
;
7396 objPtr
->internalRep
.intValue
= idx
;
7400 Jim_SetResultFormatted(interp
,
7401 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7405 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7407 /* Avoid shimmering if the object is an integer. */
7408 if (objPtr
->typePtr
== &intObjType
) {
7409 jim_wide val
= JimWideValue(objPtr
);
7412 *indexPtr
= -INT_MAX
;
7413 else if (val
> INT_MAX
)
7414 *indexPtr
= INT_MAX
;
7416 *indexPtr
= (int)val
;
7419 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7421 *indexPtr
= objPtr
->internalRep
.intValue
;
7425 /* -----------------------------------------------------------------------------
7426 * Return Code Object.
7427 * ---------------------------------------------------------------------------*/
7429 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7430 static const char * const jimReturnCodes
[] = {
7442 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7444 static const Jim_ObjType returnCodeObjType
= {
7452 /* Converts a (standard) return code to a string. Returns "?" for
7453 * non-standard return codes.
7455 const char *Jim_ReturnCode(int code
)
7457 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7461 return jimReturnCodes
[code
];
7465 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7470 /* Try to convert into an integer */
7471 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7472 returnCode
= (int)wideValue
;
7473 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7474 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7477 /* Free the old internal repr and set the new one. */
7478 Jim_FreeIntRep(interp
, objPtr
);
7479 objPtr
->typePtr
= &returnCodeObjType
;
7480 objPtr
->internalRep
.intValue
= returnCode
;
7484 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7486 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7488 *intPtr
= objPtr
->internalRep
.intValue
;
7492 /* -----------------------------------------------------------------------------
7493 * Expression Parsing
7494 * ---------------------------------------------------------------------------*/
7495 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7496 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7497 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7499 /* Exrp's Stack machine operators opcodes. */
7501 /* Binary operators (numbers) */
7504 /* Continues on from the JIM_TT_ space */
7506 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7521 JIM_EXPROP_BITAND
, /* 35 */
7525 /* Note must keep these together */
7526 JIM_EXPROP_LOGICAND
, /* 38 */
7527 JIM_EXPROP_LOGICAND_LEFT
,
7528 JIM_EXPROP_LOGICAND_RIGHT
,
7531 JIM_EXPROP_LOGICOR
, /* 41 */
7532 JIM_EXPROP_LOGICOR_LEFT
,
7533 JIM_EXPROP_LOGICOR_RIGHT
,
7536 /* Ternary operators */
7537 JIM_EXPROP_TERNARY
, /* 44 */
7538 JIM_EXPROP_TERNARY_LEFT
,
7539 JIM_EXPROP_TERNARY_RIGHT
,
7542 JIM_EXPROP_COLON
, /* 47 */
7543 JIM_EXPROP_COLON_LEFT
,
7544 JIM_EXPROP_COLON_RIGHT
,
7546 JIM_EXPROP_POW
, /* 50 */
7548 /* Binary operators (strings) */
7549 JIM_EXPROP_STREQ
, /* 51 */
7554 /* Unary operators (numbers) */
7555 JIM_EXPROP_NOT
, /* 55 */
7557 JIM_EXPROP_UNARYMINUS
,
7558 JIM_EXPROP_UNARYPLUS
,
7561 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7562 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7563 JIM_EXPROP_FUNC_WIDE
,
7564 JIM_EXPROP_FUNC_ABS
,
7565 JIM_EXPROP_FUNC_DOUBLE
,
7566 JIM_EXPROP_FUNC_ROUND
,
7567 JIM_EXPROP_FUNC_RAND
,
7568 JIM_EXPROP_FUNC_SRAND
,
7570 /* math functions from libm */
7571 JIM_EXPROP_FUNC_SIN
, /* 65 */
7572 JIM_EXPROP_FUNC_COS
,
7573 JIM_EXPROP_FUNC_TAN
,
7574 JIM_EXPROP_FUNC_ASIN
,
7575 JIM_EXPROP_FUNC_ACOS
,
7576 JIM_EXPROP_FUNC_ATAN
,
7577 JIM_EXPROP_FUNC_SINH
,
7578 JIM_EXPROP_FUNC_COSH
,
7579 JIM_EXPROP_FUNC_TANH
,
7580 JIM_EXPROP_FUNC_CEIL
,
7581 JIM_EXPROP_FUNC_FLOOR
,
7582 JIM_EXPROP_FUNC_EXP
,
7583 JIM_EXPROP_FUNC_LOG
,
7584 JIM_EXPROP_FUNC_LOG10
,
7585 JIM_EXPROP_FUNC_SQRT
,
7586 JIM_EXPROP_FUNC_POW
,
7597 /* Operators table */
7598 typedef struct Jim_ExprOperator
7601 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7602 unsigned char precedence
;
7603 unsigned char arity
;
7605 unsigned char namelen
;
7608 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7610 Jim_IncrRefCount(obj
);
7611 e
->stack
[e
->stacklen
++] = obj
;
7614 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7616 return e
->stack
[--e
->stacklen
];
7619 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7623 Jim_Obj
*A
= ExprPop(e
);
7625 jim_wide wA
, wC
= 0;
7627 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7628 switch (e
->opcode
) {
7629 case JIM_EXPROP_FUNC_INT
:
7630 case JIM_EXPROP_FUNC_WIDE
:
7631 case JIM_EXPROP_FUNC_ROUND
:
7632 case JIM_EXPROP_UNARYPLUS
:
7635 case JIM_EXPROP_FUNC_DOUBLE
:
7639 case JIM_EXPROP_FUNC_ABS
:
7640 wC
= wA
>= 0 ? wA
: -wA
;
7642 case JIM_EXPROP_UNARYMINUS
:
7645 case JIM_EXPROP_NOT
:
7652 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7653 switch (e
->opcode
) {
7654 case JIM_EXPROP_FUNC_INT
:
7655 case JIM_EXPROP_FUNC_WIDE
:
7658 case JIM_EXPROP_FUNC_ROUND
:
7659 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7661 case JIM_EXPROP_FUNC_DOUBLE
:
7662 case JIM_EXPROP_UNARYPLUS
:
7666 case JIM_EXPROP_FUNC_ABS
:
7667 dC
= dA
>= 0 ? dA
: -dA
;
7670 case JIM_EXPROP_UNARYMINUS
:
7674 case JIM_EXPROP_NOT
:
7684 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7687 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7691 Jim_DecrRefCount(interp
, A
);
7696 static double JimRandDouble(Jim_Interp
*interp
)
7699 JimRandomBytes(interp
, &x
, sizeof(x
));
7701 return (double)x
/ (unsigned long)~0;
7704 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7706 Jim_Obj
*A
= ExprPop(e
);
7709 int rc
= Jim_GetWide(interp
, A
, &wA
);
7711 switch (e
->opcode
) {
7712 case JIM_EXPROP_BITNOT
:
7713 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7715 case JIM_EXPROP_FUNC_SRAND
:
7716 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7717 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7724 Jim_DecrRefCount(interp
, A
);
7729 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7731 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7733 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7738 #ifdef JIM_MATH_FUNCTIONS
7739 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7742 Jim_Obj
*A
= ExprPop(e
);
7745 rc
= Jim_GetDouble(interp
, A
, &dA
);
7747 switch (e
->opcode
) {
7748 case JIM_EXPROP_FUNC_SIN
:
7751 case JIM_EXPROP_FUNC_COS
:
7754 case JIM_EXPROP_FUNC_TAN
:
7757 case JIM_EXPROP_FUNC_ASIN
:
7760 case JIM_EXPROP_FUNC_ACOS
:
7763 case JIM_EXPROP_FUNC_ATAN
:
7766 case JIM_EXPROP_FUNC_SINH
:
7769 case JIM_EXPROP_FUNC_COSH
:
7772 case JIM_EXPROP_FUNC_TANH
:
7775 case JIM_EXPROP_FUNC_CEIL
:
7778 case JIM_EXPROP_FUNC_FLOOR
:
7781 case JIM_EXPROP_FUNC_EXP
:
7784 case JIM_EXPROP_FUNC_LOG
:
7787 case JIM_EXPROP_FUNC_LOG10
:
7790 case JIM_EXPROP_FUNC_SQRT
:
7796 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7799 Jim_DecrRefCount(interp
, A
);
7805 /* A binary operation on two ints */
7806 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7808 Jim_Obj
*B
= ExprPop(e
);
7809 Jim_Obj
*A
= ExprPop(e
);
7813 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7818 switch (e
->opcode
) {
7819 case JIM_EXPROP_LSHIFT
:
7822 case JIM_EXPROP_RSHIFT
:
7825 case JIM_EXPROP_BITAND
:
7828 case JIM_EXPROP_BITXOR
:
7831 case JIM_EXPROP_BITOR
:
7834 case JIM_EXPROP_MOD
:
7837 Jim_SetResultString(interp
, "Division by zero", -1);
7844 * This code is tricky: C doesn't guarantee much
7845 * about the quotient or remainder, but Tcl does.
7846 * The remainder always has the same sign as the
7847 * divisor and a smaller absolute value.
7865 case JIM_EXPROP_ROTL
:
7866 case JIM_EXPROP_ROTR
:{
7867 /* uint32_t would be better. But not everyone has inttypes.h? */
7868 unsigned long uA
= (unsigned long)wA
;
7869 unsigned long uB
= (unsigned long)wB
;
7870 const unsigned int S
= sizeof(unsigned long) * 8;
7872 /* Shift left by the word size or more is undefined. */
7875 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7878 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7884 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7888 Jim_DecrRefCount(interp
, A
);
7889 Jim_DecrRefCount(interp
, B
);
7895 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7896 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7900 double dA
, dB
, dC
= 0;
7901 jim_wide wA
, wB
, wC
= 0;
7903 Jim_Obj
*B
= ExprPop(e
);
7904 Jim_Obj
*A
= ExprPop(e
);
7906 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7907 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7908 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7912 switch (e
->opcode
) {
7913 case JIM_EXPROP_POW
:
7914 case JIM_EXPROP_FUNC_POW
:
7915 wC
= JimPowWide(wA
, wB
);
7917 case JIM_EXPROP_ADD
:
7920 case JIM_EXPROP_SUB
:
7923 case JIM_EXPROP_MUL
:
7926 case JIM_EXPROP_DIV
:
7928 Jim_SetResultString(interp
, "Division by zero", -1);
7935 * This code is tricky: C doesn't guarantee much
7936 * about the quotient or remainder, but Tcl does.
7937 * The remainder always has the same sign as the
7938 * divisor and a smaller absolute value.
7956 case JIM_EXPROP_LTE
:
7959 case JIM_EXPROP_GTE
:
7962 case JIM_EXPROP_NUMEQ
:
7965 case JIM_EXPROP_NUMNE
:
7972 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
7974 switch (e
->opcode
) {
7975 case JIM_EXPROP_POW
:
7976 case JIM_EXPROP_FUNC_POW
:
7977 #ifdef JIM_MATH_FUNCTIONS
7980 Jim_SetResultString(interp
, "unsupported", -1);
7984 case JIM_EXPROP_ADD
:
7987 case JIM_EXPROP_SUB
:
7990 case JIM_EXPROP_MUL
:
7993 case JIM_EXPROP_DIV
:
7996 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
7998 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8013 case JIM_EXPROP_LTE
:
8017 case JIM_EXPROP_GTE
:
8021 case JIM_EXPROP_NUMEQ
:
8025 case JIM_EXPROP_NUMNE
:
8034 /* Handle the string case */
8036 /* XXX: Could optimise the eq/ne case by checking lengths */
8037 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8039 switch (e
->opcode
) {
8046 case JIM_EXPROP_LTE
:
8049 case JIM_EXPROP_GTE
:
8052 case JIM_EXPROP_NUMEQ
:
8055 case JIM_EXPROP_NUMNE
:
8066 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8069 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8073 Jim_DecrRefCount(interp
, A
);
8074 Jim_DecrRefCount(interp
, B
);
8079 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8084 listlen
= Jim_ListLength(interp
, listObjPtr
);
8085 for (i
= 0; i
< listlen
; i
++) {
8086 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8093 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8095 Jim_Obj
*B
= ExprPop(e
);
8096 Jim_Obj
*A
= ExprPop(e
);
8100 switch (e
->opcode
) {
8101 case JIM_EXPROP_STREQ
:
8102 case JIM_EXPROP_STRNE
:
8103 wC
= Jim_StringEqObj(A
, B
);
8104 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8108 case JIM_EXPROP_STRIN
:
8109 wC
= JimSearchList(interp
, B
, A
);
8111 case JIM_EXPROP_STRNI
:
8112 wC
= !JimSearchList(interp
, B
, A
);
8117 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8119 Jim_DecrRefCount(interp
, A
);
8120 Jim_DecrRefCount(interp
, B
);
8125 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8130 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8133 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8139 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8141 Jim_Obj
*skip
= ExprPop(e
);
8142 Jim_Obj
*A
= ExprPop(e
);
8145 switch (ExprBool(interp
, A
)) {
8147 /* false, so skip RHS opcodes with a 0 result */
8148 e
->skip
= JimWideValue(skip
);
8149 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8153 /* true so continue */
8160 Jim_DecrRefCount(interp
, A
);
8161 Jim_DecrRefCount(interp
, skip
);
8166 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8168 Jim_Obj
*skip
= ExprPop(e
);
8169 Jim_Obj
*A
= ExprPop(e
);
8172 switch (ExprBool(interp
, A
)) {
8174 /* false, so do nothing */
8178 /* true so skip RHS opcodes with a 1 result */
8179 e
->skip
= JimWideValue(skip
);
8180 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8188 Jim_DecrRefCount(interp
, A
);
8189 Jim_DecrRefCount(interp
, skip
);
8194 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8196 Jim_Obj
*A
= ExprPop(e
);
8199 switch (ExprBool(interp
, A
)) {
8201 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8205 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8213 Jim_DecrRefCount(interp
, A
);
8218 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8220 Jim_Obj
*skip
= ExprPop(e
);
8221 Jim_Obj
*A
= ExprPop(e
);
8227 switch (ExprBool(interp
, A
)) {
8229 /* false, skip RHS opcodes */
8230 e
->skip
= JimWideValue(skip
);
8231 /* Push a dummy value */
8232 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8236 /* true so do nothing */
8244 Jim_DecrRefCount(interp
, A
);
8245 Jim_DecrRefCount(interp
, skip
);
8250 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8252 Jim_Obj
*skip
= ExprPop(e
);
8253 Jim_Obj
*B
= ExprPop(e
);
8254 Jim_Obj
*A
= ExprPop(e
);
8256 /* No need to check for A as non-boolean */
8257 if (ExprBool(interp
, A
)) {
8258 /* true, so skip RHS opcodes */
8259 e
->skip
= JimWideValue(skip
);
8260 /* Repush B as the answer */
8264 Jim_DecrRefCount(interp
, skip
);
8265 Jim_DecrRefCount(interp
, A
);
8266 Jim_DecrRefCount(interp
, B
);
8270 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8283 /* name - precedence - arity - opcode
8285 * This array *must* be kept in sync with the JIM_EXPROP enum.
8287 * The following macros pre-compute the string length at compile time.
8289 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8290 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8292 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8293 OPRINIT("*", 110, 2, JimExprOpBin
),
8294 OPRINIT("/", 110, 2, JimExprOpBin
),
8295 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8297 OPRINIT("-", 100, 2, JimExprOpBin
),
8298 OPRINIT("+", 100, 2, JimExprOpBin
),
8300 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8301 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8303 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8304 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8306 OPRINIT("<", 80, 2, JimExprOpBin
),
8307 OPRINIT(">", 80, 2, JimExprOpBin
),
8308 OPRINIT("<=", 80, 2, JimExprOpBin
),
8309 OPRINIT(">=", 80, 2, JimExprOpBin
),
8311 OPRINIT("==", 70, 2, JimExprOpBin
),
8312 OPRINIT("!=", 70, 2, JimExprOpBin
),
8314 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8315 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8316 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8318 OPRINIT_LAZY("&&", 10, 2, NULL
, LAZY_OP
),
8319 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8320 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8322 OPRINIT_LAZY("||", 9, 2, NULL
, LAZY_OP
),
8323 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8324 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8326 OPRINIT_LAZY("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8327 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8328 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8330 OPRINIT_LAZY(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8331 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8332 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8334 OPRINIT("**", 250, 2, JimExprOpBin
),
8336 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8337 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8339 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8340 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8342 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8343 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8344 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8345 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8349 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8350 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8351 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8352 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8353 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8354 OPRINIT("rand", 200, 0, JimExprOpNone
),
8355 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8357 #ifdef JIM_MATH_FUNCTIONS
8358 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8359 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8360 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8361 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8362 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8363 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8364 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8365 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8366 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8367 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8368 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8369 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8370 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8371 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8372 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8373 OPRINIT("pow", 200, 2, JimExprOpBin
),
8379 #define JIM_EXPR_OPERATORS_NUM \
8380 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8382 static int JimParseExpression(struct JimParserCtx
*pc
)
8384 /* Discard spaces and quoted newline */
8385 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8386 if (*pc
->p
== '\n') {
8394 pc
->tline
= pc
->linenr
;
8399 pc
->tt
= JIM_TT_EOL
;
8405 pc
->tt
= JIM_TT_SUBEXPR_START
;
8408 pc
->tt
= JIM_TT_SUBEXPR_END
;
8411 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8418 return JimParseCmd(pc
);
8420 if (JimParseVar(pc
) == JIM_ERR
)
8421 return JimParseExprOperator(pc
);
8423 /* Don't allow expr sugar in expressions */
8424 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8441 return JimParseExprNumber(pc
);
8443 return JimParseQuote(pc
);
8445 return JimParseBrace(pc
);
8451 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8452 return JimParseExprOperator(pc
);
8455 return JimParseExprOperator(pc
);
8461 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8465 /* Assume an integer for now */
8466 pc
->tt
= JIM_TT_EXPR_INT
;
8468 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8469 /* Tried as an integer, but perhaps it parses as a double */
8470 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8471 /* Some stupid compilers insist they are cleverer that
8472 * we are. Even a (void) cast doesn't prevent this warning!
8474 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8475 if (end
== pc
->tstart
)
8478 /* Yes, double captured more chars */
8479 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8483 pc
->tend
= pc
->p
- 1;
8484 pc
->len
-= (pc
->p
- pc
->tstart
);
8488 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8490 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8493 for (i
= 0; irrationals
[i
]; i
++) {
8494 const char *irr
= irrationals
[i
];
8496 if (strncmp(irr
, pc
->p
, 3) == 0) {
8499 pc
->tend
= pc
->p
- 1;
8500 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8507 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8510 int bestIdx
= -1, bestLen
= 0;
8512 /* Try to get the longest match. */
8513 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8514 const char * const opname
= Jim_ExprOperators
[i
].name
;
8515 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8517 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8521 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8522 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8526 if (bestIdx
== -1) {
8530 /* Validate paretheses around function arguments */
8531 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8532 const char *p
= pc
->p
+ bestLen
;
8533 int len
= pc
->len
- bestLen
;
8535 while (len
&& isspace(UCHAR(*p
))) {
8543 pc
->tend
= pc
->p
+ bestLen
- 1;
8551 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8553 static Jim_ExprOperator dummy_op
;
8554 if (opcode
< JIM_TT_EXPR_OP
) {
8557 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8560 const char *jim_tt_name(int type
)
8562 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8563 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8565 if (type
< JIM_TT_EXPR_OP
) {
8566 return tt_names
[type
];
8569 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8570 static char buf
[20];
8575 sprintf(buf
, "(%d)", type
);
8580 /* -----------------------------------------------------------------------------
8582 * ---------------------------------------------------------------------------*/
8583 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8584 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8585 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8587 static const Jim_ObjType exprObjType
= {
8589 FreeExprInternalRep
,
8592 JIM_TYPE_REFERENCES
,
8595 /* Expr bytecode structure */
8596 typedef struct ExprByteCode
8598 ScriptToken
*token
; /* Tokens array. */
8599 int len
; /* Length as number of tokens. */
8600 int inUse
; /* Used for sharing. */
8603 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8607 for (i
= 0; i
< expr
->len
; i
++) {
8608 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8610 Jim_Free(expr
->token
);
8614 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8616 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8619 if (--expr
->inUse
!= 0) {
8623 ExprFreeByteCode(interp
, expr
);
8627 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8629 JIM_NOTUSED(interp
);
8630 JIM_NOTUSED(srcPtr
);
8632 /* Just returns an simple string. */
8633 dupPtr
->typePtr
= NULL
;
8636 /* Check if an expr program looks correct. */
8637 static int ExprCheckCorrectness(ExprByteCode
* expr
)
8643 /* Try to check if there are stack underflows,
8644 * and make sure at the end of the program there is
8645 * a single result on the stack. */
8646 for (i
= 0; i
< expr
->len
; i
++) {
8647 ScriptToken
*t
= &expr
->token
[i
];
8648 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8650 stacklen
-= op
->arity
;
8654 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8657 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8661 /* All operations and operands add one to the stack */
8664 if (stacklen
!= 1 || ternary
!= 0) {
8670 /* This procedure converts every occurrence of || and && opereators
8671 * in lazy unary versions.
8673 * a b || is converted into:
8675 * a <offset> |L b |R
8677 * a b && is converted into:
8679 * a <offset> &L b &R
8681 * "|L" checks if 'a' is true:
8682 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8683 * the opcode just after |R.
8684 * 2) if it is false does nothing.
8685 * "|R" checks if 'b' is true:
8686 * 1) if it is true pushes 1, otherwise pushes 0.
8688 * "&L" checks if 'a' is true:
8689 * 1) if it is true does nothing.
8690 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8691 * the opcode just after &R
8692 * "&R" checks if 'a' is true:
8693 * if it is true pushes 1, otherwise pushes 0.
8695 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8699 int leftindex
, arity
, offset
;
8701 /* Search for the end of the first operator */
8702 leftindex
= expr
->len
- 1;
8706 ScriptToken
*tt
= &expr
->token
[leftindex
];
8708 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8709 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8712 if (--leftindex
< 0) {
8719 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8720 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8722 offset
= (expr
->len
- leftindex
) - 1;
8724 /* Now we rely on the fact the the left and right version have opcodes
8725 * 1 and 2 after the main opcode respectively
8727 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8728 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8730 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8731 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8733 /* Now add the 'R' operator */
8734 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8735 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8738 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8739 for (i
= leftindex
- 1; i
> 0; i
--) {
8740 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8741 if (op
->lazy
== LAZY_LEFT
) {
8742 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8743 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8750 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8752 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8753 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8755 if (op
->lazy
== LAZY_OP
) {
8756 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8757 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8762 token
->objPtr
= interp
->emptyObj
;
8763 token
->type
= t
->type
;
8770 * Returns the index of the COLON_LEFT to the left of 'right_index'
8771 * taking into account nesting.
8773 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8775 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8777 int ternary_count
= 1;
8781 while (right_index
> 1) {
8782 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8785 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8788 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8799 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8801 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8802 * Otherwise returns 0.
8804 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8806 int i
= right_index
- 1;
8807 int ternary_count
= 1;
8810 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8811 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8812 *prev_right_index
= i
- 2;
8813 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8817 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8818 if (ternary_count
== 0) {
8829 * ExprTernaryReorderExpression description
8830 * ========================================
8832 * ?: is right-to-left associative which doesn't work with the stack-based
8833 * expression engine. The fix is to reorder the bytecode.
8839 * Has initial bytecode:
8841 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8842 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8844 * The fix involves simulating this expression instead:
8848 * With the following bytecode:
8850 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8851 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8853 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8854 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8855 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8856 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8858 * ExprTernaryReorderExpression works thus as follows :
8859 * - start from the end of the stack
8860 * - while walking towards the beginning of the stack
8861 * if token=JIM_EXPROP_COLON_RIGHT then
8862 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8863 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8864 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8866 * perform the rotation
8867 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8871 * Note: care has to be taken for nested ternary constructs!!!
8873 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
8877 for (i
= expr
->len
- 1; i
> 1; i
--) {
8878 int prev_right_index
;
8879 int prev_left_index
;
8883 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
8887 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8888 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
8893 ** rotate tokens down
8895 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8904 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8906 tmp
= expr
->token
[prev_right_index
];
8907 for (j
= prev_right_index
; j
< i
; j
++) {
8908 expr
->token
[j
] = expr
->token
[j
+ 1];
8910 expr
->token
[i
] = tmp
;
8912 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8914 * This is 'colon left increment' = i - prev_right_index
8916 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8917 * [prev_left_index-1] : skip_count
8920 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
8922 /* Adjust for i-- in the loop */
8927 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*fileNameObj
)
8933 int prevtt
= JIM_TT_NONE
;
8934 int have_ternary
= 0;
8937 int count
= tokenlist
->count
- 1;
8939 expr
= Jim_Alloc(sizeof(*expr
));
8943 Jim_InitStack(&stack
);
8945 /* Need extra bytecodes for lazy operators.
8946 * Also check for the ternary operator
8948 for (i
= 0; i
< tokenlist
->count
; i
++) {
8949 ParseToken
*t
= &tokenlist
->list
[i
];
8950 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8952 if (op
->lazy
== LAZY_OP
) {
8954 /* Ternary is a lazy op but also needs reordering */
8955 if (t
->type
== JIM_EXPROP_TERNARY
) {
8961 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
8963 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
8964 ParseToken
*t
= &tokenlist
->list
[i
];
8966 /* Next token will be stored here */
8967 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8969 if (t
->type
== JIM_TT_EOL
) {
8977 case JIM_TT_DICTSUGAR
:
8978 case JIM_TT_EXPRSUGAR
:
8980 token
->type
= t
->type
;
8982 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
8983 if (t
->type
== JIM_TT_CMD
) {
8984 /* Only commands need source info */
8985 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
8990 case JIM_TT_EXPR_INT
:
8991 case JIM_TT_EXPR_DOUBLE
:
8994 if (t
->type
== JIM_TT_EXPR_INT
) {
8995 token
->objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
8998 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9000 if (endptr
!= t
->token
+ t
->len
) {
9001 /* Conversion failed, so just store it as a string */
9002 Jim_FreeNewObj(interp
, token
->objPtr
);
9003 token
->type
= JIM_TT_STR
;
9006 token
->type
= t
->type
;
9011 case JIM_TT_SUBEXPR_START
:
9012 Jim_StackPush(&stack
, t
);
9013 prevtt
= JIM_TT_NONE
;
9016 case JIM_TT_SUBEXPR_COMMA
:
9017 /* Simple approach. Comma is simply ignored */
9020 case JIM_TT_SUBEXPR_END
:
9022 while (Jim_StackLen(&stack
)) {
9023 ParseToken
*tt
= Jim_StackPop(&stack
);
9025 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9030 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9035 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
9042 /* Must be an operator */
9043 const struct Jim_ExprOperator
*op
;
9046 /* Convert -/+ to unary minus or unary plus if necessary */
9047 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
9048 if (t
->type
== JIM_EXPROP_SUB
) {
9049 t
->type
= JIM_EXPROP_UNARYMINUS
;
9051 else if (t
->type
== JIM_EXPROP_ADD
) {
9052 t
->type
= JIM_EXPROP_UNARYPLUS
;
9056 op
= JimExprOperatorInfoByOpcode(t
->type
);
9058 /* Now handle precedence */
9059 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9060 const struct Jim_ExprOperator
*tt_op
=
9061 JimExprOperatorInfoByOpcode(tt
->type
);
9063 /* Note that right-to-left associativity of ?: operator is handled later */
9065 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9066 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9070 Jim_StackPop(&stack
);
9076 Jim_StackPush(&stack
, t
);
9083 /* Reduce any remaining subexpr */
9084 while (Jim_StackLen(&stack
)) {
9085 ParseToken
*tt
= Jim_StackPop(&stack
);
9087 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9089 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9092 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9099 ExprTernaryReorderExpression(interp
, expr
);
9103 /* Free the stack used for the compilation. */
9104 Jim_FreeStack(&stack
);
9106 for (i
= 0; i
< expr
->len
; i
++) {
9107 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9111 ExprFreeByteCode(interp
, expr
);
9119 /* This method takes the string representation of an expression
9120 * and generates a program for the Expr's stack-based VM. */
9121 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9124 const char *exprText
;
9125 struct JimParserCtx parser
;
9126 struct ExprByteCode
*expr
;
9127 ParseTokenList tokenlist
;
9129 Jim_Obj
*fileNameObj
;
9132 /* Try to get information about filename / line number */
9133 if (objPtr
->typePtr
== &sourceObjType
) {
9134 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9135 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9138 fileNameObj
= interp
->emptyObj
;
9141 Jim_IncrRefCount(fileNameObj
);
9143 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9145 /* Initially tokenise the expression into tokenlist */
9146 ScriptTokenListInit(&tokenlist
);
9148 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9149 while (!parser
.eof
) {
9150 if (JimParseExpression(&parser
) != JIM_OK
) {
9151 ScriptTokenListFree(&tokenlist
);
9153 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9158 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9162 #ifdef DEBUG_SHOW_EXPR_TOKENS
9165 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9166 for (i
= 0; i
< tokenlist
.count
; i
++) {
9167 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9168 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9173 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9174 ScriptTokenListFree(&tokenlist
);
9175 Jim_DecrRefCount(interp
, fileNameObj
);
9179 /* Now create the expression bytecode from the tokenlist */
9180 expr
= ExprCreateByteCode(interp
, &tokenlist
, fileNameObj
);
9182 /* No longer need the token list */
9183 ScriptTokenListFree(&tokenlist
);
9189 #ifdef DEBUG_SHOW_EXPR
9193 printf("==== Expr ====\n");
9194 for (i
= 0; i
< expr
->len
; i
++) {
9195 ScriptToken
*t
= &expr
->token
[i
];
9197 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9202 /* Check program correctness. */
9203 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
9204 ExprFreeByteCode(interp
, expr
);
9211 /* Free the old internal rep and set the new one. */
9212 Jim_DecrRefCount(interp
, fileNameObj
);
9213 Jim_FreeIntRep(interp
, objPtr
);
9214 Jim_SetIntRepPtr(objPtr
, expr
);
9215 objPtr
->typePtr
= &exprObjType
;
9219 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9221 if (objPtr
->typePtr
!= &exprObjType
) {
9222 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9226 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9229 #ifdef JIM_OPTIMIZATION
9230 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9232 if (token
->type
== JIM_TT_EXPR_INT
)
9233 return token
->objPtr
;
9234 else if (token
->type
== JIM_TT_VAR
)
9235 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9236 else if (token
->type
== JIM_TT_DICTSUGAR
)
9237 return JimExpandDictSugar(interp
, token
->objPtr
);
9243 /* -----------------------------------------------------------------------------
9244 * Expressions evaluation.
9245 * Jim uses a specialized stack-based virtual machine for expressions,
9246 * that takes advantage of the fact that expr's operators
9247 * can't be redefined.
9249 * Jim_EvalExpression() uses the bytecode compiled by
9250 * SetExprFromAny() method of the "expression" object.
9252 * On success a Tcl Object containing the result of the evaluation
9253 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9255 * On error the function returns a retcode != to JIM_OK and set a suitable
9256 * error on the interp.
9257 * ---------------------------------------------------------------------------*/
9258 #define JIM_EE_STATICSTACK_LEN 10
9260 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9263 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9265 int retcode
= JIM_OK
;
9266 struct JimExprState e
;
9268 expr
= JimGetExpression(interp
, exprObjPtr
);
9270 return JIM_ERR
; /* error in expression. */
9273 #ifdef JIM_OPTIMIZATION
9274 /* Check for one of the following common expressions used by while/for
9279 * $a < CONST, $a < $b
9280 * $a <= CONST, $a <= $b
9281 * $a > CONST, $a > $b
9282 * $a >= CONST, $a >= $b
9283 * $a != CONST, $a != $b
9284 * $a == CONST, $a == $b
9289 /* STEP 1 -- Check if there are the conditions to run the specialized
9290 * version of while */
9292 switch (expr
->len
) {
9294 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9296 Jim_IncrRefCount(objPtr
);
9297 *exprResultPtrPtr
= objPtr
;
9303 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9304 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9306 if (objPtr
&& JimIsWide(objPtr
)) {
9307 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9308 Jim_IncrRefCount(*exprResultPtrPtr
);
9315 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9316 if (objPtr
&& JimIsWide(objPtr
)) {
9317 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9318 if (objPtr2
&& JimIsWide(objPtr2
)) {
9319 jim_wide wideValueA
= JimWideValue(objPtr
);
9320 jim_wide wideValueB
= JimWideValue(objPtr2
);
9322 switch (expr
->token
[2].type
) {
9324 cmpRes
= wideValueA
< wideValueB
;
9326 case JIM_EXPROP_LTE
:
9327 cmpRes
= wideValueA
<= wideValueB
;
9330 cmpRes
= wideValueA
> wideValueB
;
9332 case JIM_EXPROP_GTE
:
9333 cmpRes
= wideValueA
>= wideValueB
;
9335 case JIM_EXPROP_NUMEQ
:
9336 cmpRes
= wideValueA
== wideValueB
;
9338 case JIM_EXPROP_NUMNE
:
9339 cmpRes
= wideValueA
!= wideValueB
;
9344 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9345 Jim_IncrRefCount(*exprResultPtrPtr
);
9355 /* In order to avoid that the internal repr gets freed due to
9356 * shimmering of the exprObjPtr's object, we make the internal rep
9360 /* The stack-based expr VM itself */
9362 /* Stack allocation. Expr programs have the feature that
9363 * a program of length N can't require a stack longer than
9365 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9366 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9368 e
.stack
= staticStack
;
9372 /* Execute every instruction */
9373 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9376 switch (expr
->token
[i
].type
) {
9377 case JIM_TT_EXPR_INT
:
9378 case JIM_TT_EXPR_DOUBLE
:
9380 ExprPush(&e
, expr
->token
[i
].objPtr
);
9384 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9386 ExprPush(&e
, objPtr
);
9393 case JIM_TT_DICTSUGAR
:
9394 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9396 ExprPush(&e
, objPtr
);
9404 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9405 if (retcode
== JIM_OK
) {
9406 ExprPush(&e
, objPtr
);
9411 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9412 if (retcode
== JIM_OK
) {
9413 ExprPush(&e
, Jim_GetResult(interp
));
9418 /* Find and execute the operation */
9420 e
.opcode
= expr
->token
[i
].type
;
9422 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9423 /* Skip some opcodes if necessary */
9432 if (retcode
== JIM_OK
) {
9433 *exprResultPtrPtr
= ExprPop(&e
);
9436 for (i
= 0; i
< e
.stacklen
; i
++) {
9437 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9440 if (e
.stack
!= staticStack
) {
9446 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9451 Jim_Obj
*exprResultPtr
;
9453 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9454 if (retcode
!= JIM_OK
)
9457 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9458 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9459 Jim_DecrRefCount(interp
, exprResultPtr
);
9463 Jim_DecrRefCount(interp
, exprResultPtr
);
9464 *boolPtr
= doubleValue
!= 0;
9468 *boolPtr
= wideValue
!= 0;
9470 Jim_DecrRefCount(interp
, exprResultPtr
);
9474 /* -----------------------------------------------------------------------------
9475 * ScanFormat String Object
9476 * ---------------------------------------------------------------------------*/
9478 /* This Jim_Obj will held a parsed representation of a format string passed to
9479 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9480 * to be parsed in its entirely first and then, if correct, can be used for
9481 * scanning. To avoid endless re-parsing, the parsed representation will be
9482 * stored in an internal representation and re-used for performance reason. */
9484 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9485 * scanformat string. This part will later be used to extract information
9486 * out from the string to be parsed by Jim_ScanString */
9488 typedef struct ScanFmtPartDescr
9490 char *arg
; /* Specification of a CHARSET conversion */
9491 char *prefix
; /* Prefix to be scanned literally before conversion */
9492 size_t width
; /* Maximal width of input to be converted */
9493 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9494 char type
; /* Type of conversion (e.g. c, d, f) */
9495 char modifier
; /* Modify type (e.g. l - long, h - short */
9498 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9499 * string parsed and separated in part descriptions. Furthermore it contains
9500 * the original string representation of the scanformat string to allow for
9501 * fast update of the Jim_Obj's string representation part.
9503 * As an add-on the internal object representation adds some scratch pad area
9504 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9505 * memory for purpose of string scanning.
9507 * The error member points to a static allocated string in case of a mal-
9508 * formed scanformat string or it contains '0' (NULL) in case of a valid
9509 * parse representation.
9511 * The whole memory of the internal representation is allocated as a single
9512 * area of memory that will be internally separated. So freeing and duplicating
9513 * of such an object is cheap */
9515 typedef struct ScanFmtStringObj
9517 jim_wide size
; /* Size of internal repr in bytes */
9518 char *stringRep
; /* Original string representation */
9519 size_t count
; /* Number of ScanFmtPartDescr contained */
9520 size_t convCount
; /* Number of conversions that will assign */
9521 size_t maxPos
; /* Max position index if XPG3 is used */
9522 const char *error
; /* Ptr to error text (NULL if no error */
9523 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9524 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9528 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9529 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9530 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9532 static const Jim_ObjType scanFmtStringObjType
= {
9534 FreeScanFmtInternalRep
,
9535 DupScanFmtInternalRep
,
9536 UpdateStringOfScanFmt
,
9540 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9542 JIM_NOTUSED(interp
);
9543 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9544 objPtr
->internalRep
.ptr
= 0;
9547 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9549 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9550 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9552 JIM_NOTUSED(interp
);
9553 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9554 dupPtr
->internalRep
.ptr
= newVec
;
9555 dupPtr
->typePtr
= &scanFmtStringObjType
;
9558 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9560 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9563 /* SetScanFmtFromAny will parse a given string and create the internal
9564 * representation of the format specification. In case of an error
9565 * the error data member of the internal representation will be set
9566 * to an descriptive error text and the function will be left with
9567 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9570 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9572 ScanFmtStringObj
*fmtObj
;
9574 int maxCount
, i
, approxSize
, lastPos
= -1;
9575 const char *fmt
= objPtr
->bytes
;
9576 int maxFmtLen
= objPtr
->length
;
9577 const char *fmtEnd
= fmt
+ maxFmtLen
;
9580 Jim_FreeIntRep(interp
, objPtr
);
9581 /* Count how many conversions could take place maximally */
9582 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9585 /* Calculate an approximation of the memory necessary */
9586 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9587 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9588 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9589 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9590 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9591 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9592 +1; /* safety byte */
9593 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9594 memset(fmtObj
, 0, approxSize
);
9595 fmtObj
->size
= approxSize
;
9597 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9598 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9599 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9600 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9601 objPtr
->internalRep
.ptr
= fmtObj
;
9602 objPtr
->typePtr
= &scanFmtStringObjType
;
9603 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9604 int width
= 0, skip
;
9605 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9608 descr
->width
= 0; /* Assume width unspecified */
9609 /* Overread and store any "literal" prefix */
9610 if (*fmt
!= '%' || fmt
[1] == '%') {
9612 descr
->prefix
= &buffer
[i
];
9613 for (; fmt
< fmtEnd
; ++fmt
) {
9623 /* Skip the conversion introducing '%' sign */
9625 /* End reached due to non-conversion literal only? */
9628 descr
->pos
= 0; /* Assume "natural" positioning */
9630 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9634 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9635 /* Check if next token is a number (could be width or pos */
9636 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9638 /* Was the number a XPG3 position specifier? */
9639 if (descr
->pos
!= -1 && *fmt
== '$') {
9645 /* Look if "natural" postioning and XPG3 one was mixed */
9646 if ((lastPos
== 0 && descr
->pos
> 0)
9647 || (lastPos
> 0 && descr
->pos
== 0)) {
9648 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9651 /* Look if this position was already used */
9652 for (prev
= 0; prev
< curr
; ++prev
) {
9653 if (fmtObj
->descr
[prev
].pos
== -1)
9655 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9657 "variable is assigned by multiple \"%n$\" conversion specifiers";
9661 /* Try to find a width after the XPG3 specifier */
9662 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9663 descr
->width
= width
;
9666 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9667 fmtObj
->maxPos
= descr
->pos
;
9670 /* Number was not a XPG3, so it has to be a width */
9671 descr
->width
= width
;
9674 /* If positioning mode was undetermined yet, fix this */
9676 lastPos
= descr
->pos
;
9677 /* Handle CHARSET conversion type ... */
9679 int swapped
= 1, beg
= i
, end
, j
;
9682 descr
->arg
= &buffer
[i
];
9685 buffer
[i
++] = *fmt
++;
9687 buffer
[i
++] = *fmt
++;
9688 while (*fmt
&& *fmt
!= ']')
9689 buffer
[i
++] = *fmt
++;
9691 fmtObj
->error
= "unmatched [ in format string";
9696 /* In case a range fence was given "backwards", swap it */
9699 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9700 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9701 char tmp
= buffer
[j
- 1];
9703 buffer
[j
- 1] = buffer
[j
+ 1];
9704 buffer
[j
+ 1] = tmp
;
9711 /* Remember any valid modifier if given */
9712 if (strchr("hlL", *fmt
) != 0)
9713 descr
->modifier
= tolower((int)*fmt
++);
9716 if (strchr("efgcsndoxui", *fmt
) == 0) {
9717 fmtObj
->error
= "bad scan conversion character";
9720 else if (*fmt
== 'c' && descr
->width
!= 0) {
9721 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9724 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9725 fmtObj
->error
= "unsigned wide not supported";
9735 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9737 #define FormatGetCnvCount(_fo_) \
9738 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9739 #define FormatGetMaxPos(_fo_) \
9740 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9741 #define FormatGetError(_fo_) \
9742 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9744 /* JimScanAString is used to scan an unspecified string that ends with
9745 * next WS, or a string that is specified via a charset.
9748 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9750 char *buffer
= Jim_StrDup(str
);
9757 if (!sdescr
&& isspace(UCHAR(*str
)))
9758 break; /* EOS via WS if unspecified */
9760 n
= utf8_tounicode(str
, &c
);
9761 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9767 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9770 /* ScanOneEntry will scan one entry out of the string passed as argument.
9771 * It use the sscanf() function for this task. After extracting and
9772 * converting of the value, the count of scanned characters will be
9773 * returned of -1 in case of no conversion tool place and string was
9774 * already scanned thru */
9776 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9777 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9780 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9782 size_t anchor
= pos
;
9784 Jim_Obj
*tmpObj
= NULL
;
9786 /* First pessimistically assume, we will not scan anything :-) */
9788 if (descr
->prefix
) {
9789 /* There was a prefix given before the conversion, skip it and adjust
9790 * the string-to-be-parsed accordingly */
9791 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9792 /* If prefix require, skip WS */
9793 if (isspace(UCHAR(descr
->prefix
[i
])))
9794 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9796 else if (descr
->prefix
[i
] != str
[pos
])
9797 break; /* Prefix do not match here, leave the loop */
9799 ++pos
; /* Prefix matched so far, next round */
9801 if (pos
>= strLen
) {
9802 return -1; /* All of str consumed: EOF condition */
9804 else if (descr
->prefix
[i
] != 0)
9805 return 0; /* Not whole prefix consumed, no conversion possible */
9807 /* For all but following conversion, skip leading WS */
9808 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9809 while (isspace(UCHAR(str
[pos
])))
9811 /* Determine how much skipped/scanned so far */
9812 scanned
= pos
- anchor
;
9814 /* %c is a special, simple case. no width */
9815 if (descr
->type
== 'n') {
9816 /* Return pseudo conversion means: how much scanned so far? */
9817 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9819 else if (pos
>= strLen
) {
9820 /* Cannot scan anything, as str is totally consumed */
9823 else if (descr
->type
== 'c') {
9825 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9826 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9830 /* Processing of conversions follows ... */
9831 if (descr
->width
> 0) {
9832 /* Do not try to scan as fas as possible but only the given width.
9833 * To ensure this, we copy the part that should be scanned. */
9834 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9835 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9837 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9838 tok
= tmpObj
->bytes
;
9841 /* As no width was given, simply refer to the original string */
9844 switch (descr
->type
) {
9850 char *endp
; /* Position where the number finished */
9853 int base
= descr
->type
== 'o' ? 8
9854 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
9856 /* Try to scan a number with the given base */
9858 w
= jim_strtoull(tok
, &endp
);
9861 w
= strtoull(tok
, &endp
, base
);
9865 /* There was some number sucessfully scanned! */
9866 *valObjPtr
= Jim_NewIntObj(interp
, w
);
9868 /* Adjust the number-of-chars scanned so far */
9869 scanned
+= endp
- tok
;
9872 /* Nothing was scanned. We have to determine if this
9873 * happened due to e.g. prefix mismatch or input str
9875 scanned
= *tok
? 0 : -1;
9881 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
9882 scanned
+= Jim_Length(*valObjPtr
);
9889 double value
= strtod(tok
, &endp
);
9892 /* There was some number sucessfully scanned! */
9893 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
9894 /* Adjust the number-of-chars scanned so far */
9895 scanned
+= endp
- tok
;
9898 /* Nothing was scanned. We have to determine if this
9899 * happened due to e.g. prefix mismatch or input str
9901 scanned
= *tok
? 0 : -1;
9906 /* If a substring was allocated (due to pre-defined width) do not
9907 * forget to free it */
9909 Jim_FreeNewObj(interp
, tmpObj
);
9915 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9916 * string and returns all converted (and not ignored) values in a list back
9917 * to the caller. If an error occured, a NULL pointer will be returned */
9919 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
9923 const char *str
= Jim_String(strObjPtr
);
9924 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
9925 Jim_Obj
*resultList
= 0;
9926 Jim_Obj
**resultVec
= 0;
9928 Jim_Obj
*emptyStr
= 0;
9929 ScanFmtStringObj
*fmtObj
;
9931 /* This should never happen. The format object should already be of the correct type */
9932 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
9934 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
9935 /* Check if format specification was valid */
9936 if (fmtObj
->error
!= 0) {
9937 if (flags
& JIM_ERRMSG
)
9938 Jim_SetResultString(interp
, fmtObj
->error
, -1);
9941 /* Allocate a new "shared" empty string for all unassigned conversions */
9942 emptyStr
= Jim_NewEmptyStringObj(interp
);
9943 Jim_IncrRefCount(emptyStr
);
9944 /* Create a list and fill it with empty strings up to max specified XPG3 */
9945 resultList
= Jim_NewListObj(interp
, NULL
, 0);
9946 if (fmtObj
->maxPos
> 0) {
9947 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
9948 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
9949 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
9951 /* Now handle every partial format description */
9952 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
9953 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
9956 /* Only last type may be "literal" w/o conversion - skip it! */
9957 if (descr
->type
== 0)
9959 /* As long as any conversion could be done, we will proceed */
9961 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
9962 /* In case our first try results in EOF, we will leave */
9963 if (scanned
== -1 && i
== 0)
9965 /* Advance next pos-to-be-scanned for the amount scanned already */
9968 /* value == 0 means no conversion took place so take empty string */
9970 value
= Jim_NewEmptyStringObj(interp
);
9971 /* If value is a non-assignable one, skip it */
9972 if (descr
->pos
== -1) {
9973 Jim_FreeNewObj(interp
, value
);
9975 else if (descr
->pos
== 0)
9976 /* Otherwise append it to the result list if no XPG3 was given */
9977 Jim_ListAppendElement(interp
, resultList
, value
);
9978 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
9979 /* But due to given XPG3, put the value into the corr. slot */
9980 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
9981 Jim_IncrRefCount(value
);
9982 resultVec
[descr
->pos
- 1] = value
;
9985 /* Otherwise, the slot was already used - free obj and ERROR */
9986 Jim_FreeNewObj(interp
, value
);
9990 Jim_DecrRefCount(interp
, emptyStr
);
9993 Jim_DecrRefCount(interp
, emptyStr
);
9994 Jim_FreeNewObj(interp
, resultList
);
9995 return (Jim_Obj
*)EOF
;
9997 Jim_DecrRefCount(interp
, emptyStr
);
9998 Jim_FreeNewObj(interp
, resultList
);
10002 /* -----------------------------------------------------------------------------
10003 * Pseudo Random Number Generation
10004 * ---------------------------------------------------------------------------*/
10005 /* Initialize the sbox with the numbers from 0 to 255 */
10006 static void JimPrngInit(Jim_Interp
*interp
)
10008 #define PRNG_SEED_SIZE 256
10010 unsigned int *seed
;
10011 time_t t
= time(NULL
);
10013 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10015 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10016 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10017 seed
[i
] = (rand() ^ t
^ clock());
10019 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10023 /* Generates N bytes of random data */
10024 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10026 Jim_PrngState
*prng
;
10027 unsigned char *destByte
= (unsigned char *)dest
;
10028 unsigned int si
, sj
, x
;
10030 /* initialization, only needed the first time */
10031 if (interp
->prngState
== NULL
)
10032 JimPrngInit(interp
);
10033 prng
= interp
->prngState
;
10034 /* generates 'len' bytes of pseudo-random numbers */
10035 for (x
= 0; x
< len
; x
++) {
10036 prng
->i
= (prng
->i
+ 1) & 0xff;
10037 si
= prng
->sbox
[prng
->i
];
10038 prng
->j
= (prng
->j
+ si
) & 0xff;
10039 sj
= prng
->sbox
[prng
->j
];
10040 prng
->sbox
[prng
->i
] = sj
;
10041 prng
->sbox
[prng
->j
] = si
;
10042 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10046 /* Re-seed the generator with user-provided bytes */
10047 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10050 Jim_PrngState
*prng
;
10052 /* initialization, only needed the first time */
10053 if (interp
->prngState
== NULL
)
10054 JimPrngInit(interp
);
10055 prng
= interp
->prngState
;
10057 /* Set the sbox[i] with i */
10058 for (i
= 0; i
< 256; i
++)
10060 /* Now use the seed to perform a random permutation of the sbox */
10061 for (i
= 0; i
< seedLen
; i
++) {
10064 t
= prng
->sbox
[i
& 0xFF];
10065 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10066 prng
->sbox
[seed
[i
]] = t
;
10068 prng
->i
= prng
->j
= 0;
10070 /* discard at least the first 256 bytes of stream.
10071 * borrow the seed buffer for this
10073 for (i
= 0; i
< 256; i
+= seedLen
) {
10074 JimRandomBytes(interp
, seed
, seedLen
);
10079 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10081 jim_wide wideValue
, increment
= 1;
10082 Jim_Obj
*intObjPtr
;
10084 if (argc
!= 2 && argc
!= 3) {
10085 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10089 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10092 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10094 /* Set missing variable to 0 */
10097 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10100 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10101 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10102 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10103 Jim_FreeNewObj(interp
, intObjPtr
);
10108 /* Can do it the quick way */
10109 Jim_InvalidateStringRep(intObjPtr
);
10110 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10112 /* The following step is required in order to invalidate the
10113 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10114 if (argv
[1]->typePtr
!= &variableObjType
) {
10115 /* Note that this can't fail since GetVariable already succeeded */
10116 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10119 Jim_SetResult(interp
, intObjPtr
);
10124 /* -----------------------------------------------------------------------------
10126 * ---------------------------------------------------------------------------*/
10127 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10128 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10130 /* Handle calls to the [unknown] command */
10131 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10135 /* If JimUnknown() is recursively called too many times...
10138 if (interp
->unknown_called
> 50) {
10142 /* The object interp->unknown just contains
10143 * the "unknown" string, it is used in order to
10144 * avoid to lookup the unknown command every time
10145 * but instead to cache the result. */
10147 /* If the [unknown] command does not exist ... */
10148 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10151 interp
->unknown_called
++;
10152 /* XXX: Are we losing fileNameObj and linenr? */
10153 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10154 interp
->unknown_called
--;
10159 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10167 for (j
= 0; j
< objc
; j
++) {
10168 printf(" '%s'", Jim_String(objv
[j
]));
10173 if (interp
->framePtr
->tailcallCmd
) {
10174 /* Special tailcall command was pre-resolved */
10175 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10176 interp
->framePtr
->tailcallCmd
= NULL
;
10179 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10180 if (cmdPtr
== NULL
) {
10181 return JimUnknown(interp
, objc
, objv
);
10183 JimIncrCmdRefCount(cmdPtr
);
10186 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10187 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10191 interp
->evalDepth
++;
10193 /* Call it -- Make sure result is an empty object. */
10194 Jim_SetEmptyResult(interp
);
10195 if (cmdPtr
->isproc
) {
10196 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10199 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10200 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10202 interp
->evalDepth
--;
10205 JimDecrCmdRefCount(interp
, cmdPtr
);
10210 /* Eval the object vector 'objv' composed of 'objc' elements.
10211 * Every element is used as single argument.
10212 * Jim_EvalObj() will call this function every time its object
10213 * argument is of "list" type, with no string representation.
10215 * This is possible because the string representation of a
10216 * list object generated by the UpdateStringOfList is made
10217 * in a way that ensures that every list element is a different
10218 * command argument. */
10219 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10223 /* Incr refcount of arguments. */
10224 for (i
= 0; i
< objc
; i
++)
10225 Jim_IncrRefCount(objv
[i
]);
10227 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10229 /* Decr refcount of arguments and return the retcode */
10230 for (i
= 0; i
< objc
; i
++)
10231 Jim_DecrRefCount(interp
, objv
[i
]);
10237 * Invokes 'prefix' as a command with the objv array as arguments.
10239 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10242 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10245 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10246 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10251 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10253 if (!interp
->errorFlag
) {
10254 /* This is the first error, so save the file/line information and reset the stack */
10255 interp
->errorFlag
= 1;
10256 Jim_IncrRefCount(script
->fileNameObj
);
10257 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10258 interp
->errorFileNameObj
= script
->fileNameObj
;
10259 interp
->errorLine
= script
->linenr
;
10261 JimResetStackTrace(interp
);
10262 /* Always add a level where the error first occurs */
10263 interp
->addStackTrace
++;
10266 /* Now if this is an "interesting" level, add it to the stack trace */
10267 if (interp
->addStackTrace
> 0) {
10268 /* Add the stack info for the current level */
10270 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10272 /* Note: if we didn't have a filename for this level,
10273 * don't clear the addStackTrace flag
10274 * so we can pick it up at the next level
10276 if (Jim_Length(script
->fileNameObj
)) {
10277 interp
->addStackTrace
= 0;
10280 Jim_DecrRefCount(interp
, interp
->errorProc
);
10281 interp
->errorProc
= interp
->emptyObj
;
10282 Jim_IncrRefCount(interp
->errorProc
);
10286 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10290 switch (token
->type
) {
10293 objPtr
= token
->objPtr
;
10296 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10298 case JIM_TT_DICTSUGAR
:
10299 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10301 case JIM_TT_EXPRSUGAR
:
10302 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10305 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10308 objPtr
= interp
->result
;
10311 /* Stop substituting */
10314 /* just skip this one */
10315 return JIM_CONTINUE
;
10322 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10327 *objPtrPtr
= objPtr
;
10333 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10334 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10335 * The returned object has refcount = 0.
10337 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10341 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10345 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10348 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10350 /* Compute every token forming the argument
10351 * in the intv objects vector. */
10352 for (i
= 0; i
< tokens
; i
++) {
10353 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10358 if (flags
& JIM_SUBST_FLAG
) {
10363 /* XXX: Should probably set an error about break outside loop */
10364 /* fall through to error */
10366 if (flags
& JIM_SUBST_FLAG
) {
10370 /* XXX: Ditto continue outside loop */
10371 /* fall through to error */
10374 Jim_DecrRefCount(interp
, intv
[i
]);
10376 if (intv
!= sintv
) {
10381 Jim_IncrRefCount(intv
[i
]);
10382 Jim_String(intv
[i
]);
10383 totlen
+= intv
[i
]->length
;
10386 /* Fast path return for a single token */
10387 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10388 Jim_DecrRefCount(interp
, intv
[0]);
10392 /* Concatenate every token in an unique
10394 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10396 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10397 && token
[2].type
== JIM_TT_VAR
) {
10398 /* May be able to do fast interpolated object -> dictSubst */
10399 objPtr
->typePtr
= &interpolatedObjType
;
10400 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10401 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10402 Jim_IncrRefCount(intv
[2]);
10404 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10405 /* The first interpolated token is source, so preserve the source info */
10406 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10410 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10411 objPtr
->length
= totlen
;
10412 for (i
= 0; i
< tokens
; i
++) {
10414 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10415 s
+= intv
[i
]->length
;
10416 Jim_DecrRefCount(interp
, intv
[i
]);
10419 objPtr
->bytes
[totlen
] = '\0';
10420 /* Free the intv vector if not static. */
10421 if (intv
!= sintv
) {
10429 /* listPtr *must* be a list.
10430 * The contents of the list is evaluated with the first element as the command and
10431 * the remaining elements as the arguments.
10433 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10435 int retcode
= JIM_OK
;
10437 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10439 if (listPtr
->internalRep
.listValue
.len
) {
10440 Jim_IncrRefCount(listPtr
);
10441 retcode
= JimInvokeCommand(interp
,
10442 listPtr
->internalRep
.listValue
.len
,
10443 listPtr
->internalRep
.listValue
.ele
);
10444 Jim_DecrRefCount(interp
, listPtr
);
10449 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10451 SetListFromAny(interp
, listPtr
);
10452 return JimEvalObjList(interp
, listPtr
);
10455 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10459 ScriptToken
*token
;
10460 int retcode
= JIM_OK
;
10461 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10462 Jim_Obj
*prevScriptObj
;
10464 /* If the object is of type "list", with no string rep we can call
10465 * a specialized version of Jim_EvalObj() */
10466 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10467 return JimEvalObjList(interp
, scriptObjPtr
);
10470 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10471 script
= JimGetScript(interp
, scriptObjPtr
);
10472 if (!JimScriptValid(interp
, script
)) {
10473 Jim_DecrRefCount(interp
, scriptObjPtr
);
10477 /* Reset the interpreter result. This is useful to
10478 * return the empty result in the case of empty program. */
10479 Jim_SetEmptyResult(interp
);
10481 token
= script
->token
;
10483 #ifdef JIM_OPTIMIZATION
10484 /* Check for one of the following common scripts used by for, while
10489 if (script
->len
== 0) {
10490 Jim_DecrRefCount(interp
, scriptObjPtr
);
10493 if (script
->len
== 3
10494 && token
[1].objPtr
->typePtr
== &commandObjType
10495 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10496 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10497 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10499 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10501 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10502 JimWideValue(objPtr
)++;
10503 Jim_InvalidateStringRep(objPtr
);
10504 Jim_DecrRefCount(interp
, scriptObjPtr
);
10505 Jim_SetResult(interp
, objPtr
);
10511 /* Now we have to make sure the internal repr will not be
10512 * freed on shimmering.
10514 * Think for example to this:
10516 * set x {llength $x; ... some more code ...}; eval $x
10518 * In order to preserve the internal rep, we increment the
10519 * inUse field of the script internal rep structure. */
10522 /* Stash the current script */
10523 prevScriptObj
= interp
->currentScriptObj
;
10524 interp
->currentScriptObj
= scriptObjPtr
;
10526 interp
->errorFlag
= 0;
10529 /* Execute every command sequentially until the end of the script
10530 * or an error occurs.
10532 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10536 /* First token of the line is always JIM_TT_LINE */
10537 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10538 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10540 /* Allocate the arguments vector if required */
10541 if (argc
> JIM_EVAL_SARGV_LEN
)
10542 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10544 /* Skip the JIM_TT_LINE token */
10547 /* Populate the arguments objects.
10548 * If an error occurs, retcode will be set and
10549 * 'j' will be set to the number of args expanded
10551 for (j
= 0; j
< argc
; j
++) {
10552 long wordtokens
= 1;
10554 Jim_Obj
*wordObjPtr
= NULL
;
10556 if (token
[i
].type
== JIM_TT_WORD
) {
10557 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10558 if (wordtokens
< 0) {
10560 wordtokens
= -wordtokens
;
10564 if (wordtokens
== 1) {
10565 /* Fast path if the token does not
10566 * need interpolation */
10568 switch (token
[i
].type
) {
10571 wordObjPtr
= token
[i
].objPtr
;
10574 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10576 case JIM_TT_EXPRSUGAR
:
10577 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10579 case JIM_TT_DICTSUGAR
:
10580 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10583 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10584 if (retcode
== JIM_OK
) {
10585 wordObjPtr
= Jim_GetResult(interp
);
10589 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10593 /* For interpolation we call a helper
10594 * function to do the work for us. */
10595 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10599 if (retcode
== JIM_OK
) {
10605 Jim_IncrRefCount(wordObjPtr
);
10609 argv
[j
] = wordObjPtr
;
10612 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10613 int len
= Jim_ListLength(interp
, wordObjPtr
);
10614 int newargc
= argc
+ len
- 1;
10618 if (argv
== sargv
) {
10619 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10620 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10621 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10625 /* Need to realloc to make room for (len - 1) more entries */
10626 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10630 /* Now copy in the expanded version */
10631 for (k
= 0; k
< len
; k
++) {
10632 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10633 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10636 /* The original object reference is no longer needed,
10637 * after the expansion it is no longer present on
10638 * the argument vector, but the single elements are
10640 Jim_DecrRefCount(interp
, wordObjPtr
);
10642 /* And update the indexes */
10648 if (retcode
== JIM_OK
&& argc
) {
10649 /* Invoke the command */
10650 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10651 /* Check for a signal after each command */
10652 if (Jim_CheckSignal(interp
)) {
10653 retcode
= JIM_SIGNAL
;
10657 /* Finished with the command, so decrement ref counts of each argument */
10659 Jim_DecrRefCount(interp
, argv
[j
]);
10662 if (argv
!= sargv
) {
10668 /* Possibly add to the error stack trace */
10669 if (retcode
== JIM_ERR
) {
10670 JimAddErrorToStack(interp
, script
);
10672 /* Propagate the addStackTrace value through 'return -code error' */
10673 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10674 /* No need to add stack trace */
10675 interp
->addStackTrace
= 0;
10678 /* Restore the current script */
10679 interp
->currentScriptObj
= prevScriptObj
;
10681 /* Note that we don't have to decrement inUse, because the
10682 * following code transfers our use of the reference again to
10683 * the script object. */
10684 Jim_FreeIntRep(interp
, scriptObjPtr
);
10685 scriptObjPtr
->typePtr
= &scriptObjType
;
10686 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10687 Jim_DecrRefCount(interp
, scriptObjPtr
);
10692 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10695 /* If argObjPtr begins with '&', do an automatic upvar */
10696 const char *varname
= Jim_String(argNameObj
);
10697 if (*varname
== '&') {
10698 /* First check that the target variable exists */
10700 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10702 interp
->framePtr
= interp
->framePtr
->parent
;
10703 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10704 interp
->framePtr
= savedCallFrame
;
10709 /* It exists, so perform the binding. */
10710 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10711 Jim_IncrRefCount(objPtr
);
10712 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10713 Jim_DecrRefCount(interp
, objPtr
);
10716 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10722 * Sets the interp result to be an error message indicating the required proc args.
10724 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10726 /* Create a nice error message, consistent with Tcl 8.5 */
10727 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10730 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10731 Jim_AppendString(interp
, argmsg
, " ", 1);
10733 if (i
== cmd
->u
.proc
.argsPos
) {
10734 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10736 Jim_AppendString(interp
, argmsg
, "?", 1);
10737 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10738 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10741 /* We have plain args */
10742 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10746 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10747 Jim_AppendString(interp
, argmsg
, "?", 1);
10748 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10749 Jim_AppendString(interp
, argmsg
, "?", 1);
10752 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10756 Jim_AppendString(interp
, argmsg
, arg
, -1);
10760 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10761 Jim_FreeNewObj(interp
, argmsg
);
10764 #ifdef jim_ext_namespace
10768 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10770 Jim_CallFrame
*callFramePtr
;
10773 /* Create a new callframe */
10774 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10775 callFramePtr
->argv
= &interp
->emptyObj
;
10776 callFramePtr
->argc
= 0;
10777 callFramePtr
->procArgsObjPtr
= NULL
;
10778 callFramePtr
->procBodyObjPtr
= scriptObj
;
10779 callFramePtr
->staticVars
= NULL
;
10780 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10781 callFramePtr
->line
= 0;
10782 Jim_IncrRefCount(scriptObj
);
10783 interp
->framePtr
= callFramePtr
;
10785 /* Check if there are too nested calls */
10786 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10787 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10791 /* Eval the body */
10792 retcode
= Jim_EvalObj(interp
, scriptObj
);
10795 /* Destroy the callframe */
10796 interp
->framePtr
= interp
->framePtr
->parent
;
10797 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10803 /* Call a procedure implemented in Tcl.
10804 * It's possible to speed-up a lot this function, currently
10805 * the callframes are not cached, but allocated and
10806 * destroied every time. What is expecially costly is
10807 * to create/destroy the local vars hash table every time.
10809 * This can be fixed just implementing callframes caching
10810 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10811 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10813 Jim_CallFrame
*callFramePtr
;
10814 int i
, d
, retcode
, optargs
;
10818 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10819 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10820 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10824 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10825 /* Optimise for procedure with no body - useful for optional debugging */
10829 /* Check if there are too nested calls */
10830 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10831 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10835 /* Create a new callframe */
10836 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10837 callFramePtr
->argv
= argv
;
10838 callFramePtr
->argc
= argc
;
10839 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10840 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10841 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10843 /* Remember where we were called from. */
10844 script
= JimGetScript(interp
, interp
->currentScriptObj
);
10845 callFramePtr
->fileNameObj
= script
->fileNameObj
;
10846 callFramePtr
->line
= script
->linenr
;
10848 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
10849 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
10850 interp
->framePtr
= callFramePtr
;
10852 /* How many optional args are available */
10853 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
10855 /* Step 'i' along the actual args, and step 'd' along the formal args */
10857 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
10858 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
10859 if (d
== cmd
->u
.proc
.argsPos
) {
10861 Jim_Obj
*listObjPtr
;
10863 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
10864 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
10866 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
10868 /* It is possible to rename args. */
10869 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
10870 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
10872 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
10873 if (retcode
!= JIM_OK
) {
10881 /* Optional or required? */
10882 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
10883 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
10886 /* Ran out, so use the default */
10887 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
10889 if (retcode
!= JIM_OK
) {
10894 /* Eval the body */
10895 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
10899 /* Free the callframe */
10900 interp
->framePtr
= interp
->framePtr
->parent
;
10901 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10903 if (interp
->framePtr
->tailcallObj
) {
10904 /* If a tailcall is already being executed, merge this tailcall with that one */
10905 if (interp
->framePtr
->tailcall
++ == 0) {
10906 /* No current tailcall in this frame, so invoke the tailcall command */
10908 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
10910 interp
->framePtr
->tailcallObj
= NULL
;
10912 if (retcode
== JIM_EVAL
) {
10913 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
10914 if (retcode
== JIM_RETURN
) {
10915 /* If the result of the tailcall is 'return', push
10916 * it up to the caller
10918 interp
->returnLevel
++;
10921 Jim_DecrRefCount(interp
, tailcallObj
);
10922 } while (interp
->framePtr
->tailcallObj
);
10924 /* If the tailcall chain finished early, may need to manually discard the command */
10925 if (interp
->framePtr
->tailcallCmd
) {
10926 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
10927 interp
->framePtr
->tailcallCmd
= NULL
;
10930 interp
->framePtr
->tailcall
--;
10933 /* Handle the JIM_RETURN return code */
10934 if (retcode
== JIM_RETURN
) {
10935 if (--interp
->returnLevel
<= 0) {
10936 retcode
= interp
->returnCode
;
10937 interp
->returnCode
= JIM_OK
;
10938 interp
->returnLevel
= 0;
10941 else if (retcode
== JIM_ERR
) {
10942 interp
->addStackTrace
++;
10943 Jim_DecrRefCount(interp
, interp
->errorProc
);
10944 interp
->errorProc
= argv
[0];
10945 Jim_IncrRefCount(interp
->errorProc
);
10951 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
10954 Jim_Obj
*scriptObjPtr
;
10956 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
10957 Jim_IncrRefCount(scriptObjPtr
);
10960 Jim_Obj
*prevScriptObj
;
10962 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
10964 prevScriptObj
= interp
->currentScriptObj
;
10965 interp
->currentScriptObj
= scriptObjPtr
;
10967 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10969 interp
->currentScriptObj
= prevScriptObj
;
10972 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10974 Jim_DecrRefCount(interp
, scriptObjPtr
);
10978 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
10980 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
10983 /* Execute script in the scope of the global level */
10984 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
10987 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10989 interp
->framePtr
= interp
->topFramePtr
;
10990 retval
= Jim_Eval(interp
, script
);
10991 interp
->framePtr
= savedFramePtr
;
10996 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
10999 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11001 interp
->framePtr
= interp
->topFramePtr
;
11002 retval
= Jim_EvalFile(interp
, filename
);
11003 interp
->framePtr
= savedFramePtr
;
11008 #include <sys/stat.h>
11010 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11014 Jim_Obj
*scriptObjPtr
;
11015 Jim_Obj
*prevScriptObj
;
11020 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11021 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11024 if (sb
.st_size
== 0) {
11029 buf
= Jim_Alloc(sb
.st_size
+ 1);
11030 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11034 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11040 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11041 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11042 Jim_IncrRefCount(scriptObjPtr
);
11044 prevScriptObj
= interp
->currentScriptObj
;
11045 interp
->currentScriptObj
= scriptObjPtr
;
11047 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11049 /* Handle the JIM_RETURN return code */
11050 if (retcode
== JIM_RETURN
) {
11051 if (--interp
->returnLevel
<= 0) {
11052 retcode
= interp
->returnCode
;
11053 interp
->returnCode
= JIM_OK
;
11054 interp
->returnLevel
= 0;
11057 if (retcode
== JIM_ERR
) {
11058 /* EvalFile changes context, so add a stack frame here */
11059 interp
->addStackTrace
++;
11062 interp
->currentScriptObj
= prevScriptObj
;
11064 Jim_DecrRefCount(interp
, scriptObjPtr
);
11069 /* -----------------------------------------------------------------------------
11071 * ---------------------------------------------------------------------------*/
11072 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11074 pc
->tstart
= pc
->p
;
11075 pc
->tline
= pc
->linenr
;
11077 if (pc
->len
== 0) {
11079 pc
->tt
= JIM_TT_EOL
;
11083 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11087 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11088 if (JimParseVar(pc
) == JIM_OK
) {
11091 /* Not a var, so treat as a string */
11092 pc
->tstart
= pc
->p
;
11093 flags
|= JIM_SUBST_NOVAR
;
11096 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11099 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11102 if (*pc
->p
== '\\' && pc
->len
> 1) {
11109 pc
->tend
= pc
->p
- 1;
11110 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11113 /* The subst object type reuses most of the data structures and functions
11114 * of the script object. Script's data structures are a bit more complex
11115 * for what is needed for [subst]itution tasks, but the reuse helps to
11116 * deal with a single data structure at the cost of some more memory
11117 * usage for substitutions. */
11119 /* This method takes the string representation of an object
11120 * as a Tcl string where to perform [subst]itution, and generates
11121 * the pre-parsed internal representation. */
11122 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11125 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11126 struct JimParserCtx parser
;
11127 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11128 ParseTokenList tokenlist
;
11130 /* Initially parse the subst into tokens (in tokenlist) */
11131 ScriptTokenListInit(&tokenlist
);
11133 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11135 JimParseSubst(&parser
, flags
);
11137 /* Note that subst doesn't need the EOL token */
11140 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11144 /* Create the "real" subst/script tokens from the initial token list */
11146 script
->substFlags
= flags
;
11147 script
->fileNameObj
= interp
->emptyObj
;
11148 Jim_IncrRefCount(script
->fileNameObj
);
11149 SubstObjAddTokens(interp
, script
, &tokenlist
);
11151 /* No longer need the token list */
11152 ScriptTokenListFree(&tokenlist
);
11154 #ifdef DEBUG_SHOW_SUBST
11158 printf("==== Subst ====\n");
11159 for (i
= 0; i
< script
->len
; i
++) {
11160 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11161 Jim_String(script
->token
[i
].objPtr
));
11166 /* Free the old internal rep and set the new one. */
11167 Jim_FreeIntRep(interp
, objPtr
);
11168 Jim_SetIntRepPtr(objPtr
, script
);
11169 objPtr
->typePtr
= &scriptObjType
;
11173 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11175 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11176 SetSubstFromAny(interp
, objPtr
, flags
);
11177 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11180 /* Performs commands,variables,blackslashes substitution,
11181 * storing the result object (with refcount 0) into
11183 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11185 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11187 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11188 /* In order to preserve the internal rep, we increment the
11189 * inUse field of the script internal rep structure. */
11192 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11195 Jim_DecrRefCount(interp
, substObjPtr
);
11196 if (*resObjPtrPtr
== NULL
) {
11202 /* -----------------------------------------------------------------------------
11203 * Core commands utility functions
11204 * ---------------------------------------------------------------------------*/
11205 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11208 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11211 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11213 Jim_IncrRefCount(listObjPtr
);
11214 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11215 Jim_DecrRefCount(interp
, listObjPtr
);
11217 Jim_IncrRefCount(objPtr
);
11218 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11219 Jim_DecrRefCount(interp
, objPtr
);
11223 * May add the key and/or value to the list.
11225 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11226 Jim_HashEntry
*he
, int type
);
11228 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11231 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11232 * invoke the callback to add entries to a list.
11233 * Returns the list.
11235 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11236 JimHashtableIteratorCallbackType
*callback
, int type
)
11239 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11241 /* Check for the non-pattern case. We can do this much more efficiently. */
11242 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11243 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11245 callback(interp
, listObjPtr
, he
, type
);
11249 Jim_HashTableIterator htiter
;
11250 JimInitHashTableIterator(ht
, &htiter
);
11251 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11252 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11253 callback(interp
, listObjPtr
, he
, type
);
11260 /* Keep these in order */
11261 #define JIM_CMDLIST_COMMANDS 0
11262 #define JIM_CMDLIST_PROCS 1
11263 #define JIM_CMDLIST_CHANNELS 2
11266 * Adds matching command names (procs, channels) to the list.
11268 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11269 Jim_HashEntry
*he
, int type
)
11271 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11274 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11279 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11280 Jim_IncrRefCount(objPtr
);
11282 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11283 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11285 Jim_DecrRefCount(interp
, objPtr
);
11288 /* type is JIM_CMDLIST_xxx */
11289 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11291 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11294 /* Keep these in order */
11295 #define JIM_VARLIST_GLOBALS 0
11296 #define JIM_VARLIST_LOCALS 1
11297 #define JIM_VARLIST_VARS 2
11299 #define JIM_VARLIST_VALUES 0x1000
11302 * Adds matching variable names to the list.
11304 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11305 Jim_HashEntry
*he
, int type
)
11307 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11309 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11310 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11311 if (type
& JIM_VARLIST_VALUES
) {
11312 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11317 /* mode is JIM_VARLIST_xxx */
11318 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11320 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11321 /* For [info locals], if we are at top level an emtpy list
11322 * is returned. I don't agree, but we aim at compatibility (SS) */
11323 return interp
->emptyObj
;
11326 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11327 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11331 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11332 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11334 Jim_CallFrame
*targetCallFrame
;
11336 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11337 if (targetCallFrame
== NULL
) {
11340 /* No proc call at toplevel callframe */
11341 if (targetCallFrame
== interp
->topFramePtr
) {
11342 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11345 if (info_level_cmd
) {
11346 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11349 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11351 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11352 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11353 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11354 *objPtrPtr
= listObj
;
11359 /* -----------------------------------------------------------------------------
11361 * ---------------------------------------------------------------------------*/
11363 /* fake [puts] -- not the real puts, just for debugging. */
11364 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11366 if (argc
!= 2 && argc
!= 3) {
11367 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11371 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11372 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11376 fputs(Jim_String(argv
[2]), stdout
);
11380 puts(Jim_String(argv
[1]));
11385 /* Helper for [+] and [*] */
11386 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11388 jim_wide wideValue
, res
;
11389 double doubleValue
, doubleRes
;
11392 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11394 for (i
= 1; i
< argc
; i
++) {
11395 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11397 if (op
== JIM_EXPROP_ADD
)
11402 Jim_SetResultInt(interp
, res
);
11405 doubleRes
= (double)res
;
11406 for (; i
< argc
; i
++) {
11407 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11409 if (op
== JIM_EXPROP_ADD
)
11410 doubleRes
+= doubleValue
;
11412 doubleRes
*= doubleValue
;
11414 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11418 /* Helper for [-] and [/] */
11419 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11421 jim_wide wideValue
, res
= 0;
11422 double doubleValue
, doubleRes
= 0;
11426 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11429 else if (argc
== 2) {
11430 /* The arity = 2 case is different. For [- x] returns -x,
11431 * while [/ x] returns 1/x. */
11432 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11433 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11437 if (op
== JIM_EXPROP_SUB
)
11438 doubleRes
= -doubleValue
;
11440 doubleRes
= 1.0 / doubleValue
;
11441 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11445 if (op
== JIM_EXPROP_SUB
) {
11447 Jim_SetResultInt(interp
, res
);
11450 doubleRes
= 1.0 / wideValue
;
11451 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11456 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11457 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11466 for (i
= 2; i
< argc
; i
++) {
11467 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11468 doubleRes
= (double)res
;
11471 if (op
== JIM_EXPROP_SUB
)
11476 Jim_SetResultInt(interp
, res
);
11479 for (; i
< argc
; i
++) {
11480 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11482 if (op
== JIM_EXPROP_SUB
)
11483 doubleRes
-= doubleValue
;
11485 doubleRes
/= doubleValue
;
11487 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11493 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11495 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11499 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11501 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11505 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11507 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11511 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11513 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11517 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11519 if (argc
!= 2 && argc
!= 3) {
11520 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11526 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11529 Jim_SetResult(interp
, objPtr
);
11532 /* argc == 3 case. */
11533 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11535 Jim_SetResult(interp
, argv
[2]);
11541 * unset ?-nocomplain? ?--? ?varName ...?
11543 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11549 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11553 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11562 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11572 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11575 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11579 /* The general purpose implementation of while starts here */
11581 int boolean
, retval
;
11583 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11588 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11602 Jim_SetEmptyResult(interp
);
11607 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11611 Jim_Obj
*varNamePtr
= NULL
;
11612 Jim_Obj
*stopVarNamePtr
= NULL
;
11615 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11619 /* Do the initialisation */
11620 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11624 /* And do the first test now. Better for optimisation
11625 * if we can do next/test at the bottom of the loop
11627 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11629 /* Ready to do the body as follows:
11631 * body // check retcode
11632 * next // check retcode
11633 * test // check retcode/test bool
11637 #ifdef JIM_OPTIMIZATION
11638 /* Check if the for is on the form:
11639 * for ... {$i < CONST} {incr i}
11640 * for ... {$i < $j} {incr i}
11642 if (retval
== JIM_OK
&& boolean
) {
11643 ScriptObj
*incrScript
;
11644 ExprByteCode
*expr
;
11645 jim_wide stop
, currentVal
;
11649 /* Do it only if there aren't shared arguments */
11650 expr
= JimGetExpression(interp
, argv
[2]);
11651 incrScript
= JimGetScript(interp
, argv
[3]);
11653 /* Ensure proper lengths to start */
11654 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11657 /* Ensure proper token types. */
11658 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11659 expr
->token
[0].type
!= JIM_TT_VAR
||
11660 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11664 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11667 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11674 /* Update command must be incr */
11675 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11679 /* incr, expression must be about the same variable */
11680 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11684 /* Get the stop condition (must be a variable or integer) */
11685 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11686 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11691 stopVarNamePtr
= expr
->token
[1].objPtr
;
11692 Jim_IncrRefCount(stopVarNamePtr
);
11693 /* Keep the compiler happy */
11697 /* Initialization */
11698 varNamePtr
= expr
->token
[0].objPtr
;
11699 Jim_IncrRefCount(varNamePtr
);
11701 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11702 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11706 /* --- OPTIMIZED FOR --- */
11707 while (retval
== JIM_OK
) {
11708 /* === Check condition === */
11709 /* Note that currentVal is already set here */
11711 /* Immediate or Variable? get the 'stop' value if the latter. */
11712 if (stopVarNamePtr
) {
11713 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11714 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11719 if (currentVal
>= stop
+ cmpOffset
) {
11724 retval
= Jim_EvalObj(interp
, argv
[4]);
11725 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11728 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11731 if (objPtr
== NULL
) {
11735 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11736 currentVal
= ++JimWideValue(objPtr
);
11737 Jim_InvalidateStringRep(objPtr
);
11740 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11741 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11742 ++currentVal
)) != JIM_OK
) {
11753 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11755 retval
= Jim_EvalObj(interp
, argv
[4]);
11757 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11760 retval
= Jim_EvalObj(interp
, argv
[3]);
11761 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11764 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11769 if (stopVarNamePtr
) {
11770 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11773 Jim_DecrRefCount(interp
, varNamePtr
);
11776 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11777 Jim_SetEmptyResult(interp
);
11785 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11791 Jim_Obj
*bodyObjPtr
;
11793 if (argc
!= 5 && argc
!= 6) {
11794 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11798 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11799 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11800 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11803 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11805 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11807 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11808 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11809 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11810 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11817 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11818 if (argv
[1]->typePtr
!= &variableObjType
) {
11819 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11823 JimWideValue(objPtr
) = i
;
11824 Jim_InvalidateStringRep(objPtr
);
11826 /* The following step is required in order to invalidate the
11827 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11828 if (argv
[1]->typePtr
!= &variableObjType
) {
11829 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11836 objPtr
= Jim_NewIntObj(interp
, i
);
11837 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11838 if (retval
!= JIM_OK
) {
11839 Jim_FreeNewObj(interp
, objPtr
);
11845 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11846 Jim_SetEmptyResult(interp
);
11852 /* List iterators make it easy to iterate over a list.
11853 * At some point iterators will be expanded to support generators.
11861 * Initialise the iterator at the start of the list.
11863 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
11865 iter
->objPtr
= objPtr
;
11870 * Returns the next object from the list, or NULL on end-of-list.
11872 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11874 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
11877 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
11881 * Returns 1 if end-of-list has been reached.
11883 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11885 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
11888 /* foreach + lmap implementation. */
11889 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
11891 int result
= JIM_OK
;
11893 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
11894 Jim_ListIter
*iters
;
11896 Jim_Obj
*resultObj
;
11898 if (argc
< 4 || argc
% 2 != 0) {
11899 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
11902 script
= argv
[argc
- 1]; /* Last argument is a script */
11903 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
11905 if (numargs
== 2) {
11909 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
11911 for (i
= 0; i
< numargs
; i
++) {
11912 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11913 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
11917 if (result
!= JIM_OK
) {
11918 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
11923 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
11926 resultObj
= interp
->emptyObj
;
11928 Jim_IncrRefCount(resultObj
);
11931 /* Have we expired all lists? */
11932 for (i
= 0; i
< numargs
; i
+= 2) {
11933 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
11937 if (i
== numargs
) {
11942 /* For each list */
11943 for (i
= 0; i
< numargs
; i
+= 2) {
11947 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11948 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
11949 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
11951 /* Ran out, so store the empty string */
11952 valObj
= interp
->emptyObj
;
11954 /* Avoid shimmering */
11955 Jim_IncrRefCount(valObj
);
11956 result
= Jim_SetVariable(interp
, varName
, valObj
);
11957 Jim_DecrRefCount(interp
, valObj
);
11958 if (result
!= JIM_OK
) {
11963 switch (result
= Jim_EvalObj(interp
, script
)) {
11966 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
11979 Jim_SetResult(interp
, resultObj
);
11981 Jim_DecrRefCount(interp
, resultObj
);
11989 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11991 return JimForeachMapHelper(interp
, argc
, argv
, 0);
11995 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11997 return JimForeachMapHelper(interp
, argc
, argv
, 1);
12001 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12003 int result
= JIM_ERR
;
12006 Jim_Obj
*resultObj
;
12009 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12013 JimListIterInit(&iter
, argv
[1]);
12015 for (i
= 2; i
< argc
; i
++) {
12016 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12017 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12018 if (result
!= JIM_OK
) {
12023 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12024 while (!JimListIterDone(interp
, &iter
)) {
12025 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12028 Jim_SetResult(interp
, resultObj
);
12034 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12036 int boolean
, retval
, current
= 1, falsebody
= 0;
12040 /* Far not enough arguments given! */
12041 if (current
>= argc
)
12043 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12046 /* There lacks something, isn't it? */
12047 if (current
>= argc
)
12049 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12051 /* Tsk tsk, no then-clause? */
12052 if (current
>= argc
)
12055 return Jim_EvalObj(interp
, argv
[current
]);
12056 /* Ok: no else-clause follows */
12057 if (++current
>= argc
) {
12058 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12061 falsebody
= current
++;
12062 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12063 /* IIICKS - else-clause isn't last cmd? */
12064 if (current
!= argc
- 1)
12066 return Jim_EvalObj(interp
, argv
[current
]);
12068 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12069 /* Ok: elseif follows meaning all the stuff
12070 * again (how boring...) */
12072 /* OOPS - else-clause is not last cmd? */
12073 else if (falsebody
!= argc
- 1)
12075 return Jim_EvalObj(interp
, argv
[falsebody
]);
12080 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12085 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12086 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12087 Jim_Obj
*stringObj
, int nocase
)
12094 parms
[argc
++] = commandObj
;
12096 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12098 parms
[argc
++] = patternObj
;
12099 parms
[argc
++] = stringObj
;
12101 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12103 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12111 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12114 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12116 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12117 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12118 Jim_Obj
*script
= 0;
12122 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12123 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12126 for (opt
= 1; opt
< argc
; ++opt
) {
12127 const char *option
= Jim_String(argv
[opt
]);
12129 if (*option
!= '-')
12131 else if (strncmp(option
, "--", 2) == 0) {
12135 else if (strncmp(option
, "-exact", 2) == 0)
12136 matchOpt
= SWITCH_EXACT
;
12137 else if (strncmp(option
, "-glob", 2) == 0)
12138 matchOpt
= SWITCH_GLOB
;
12139 else if (strncmp(option
, "-regexp", 2) == 0)
12140 matchOpt
= SWITCH_RE
;
12141 else if (strncmp(option
, "-command", 2) == 0) {
12142 matchOpt
= SWITCH_CMD
;
12143 if ((argc
- opt
) < 2)
12145 command
= argv
[++opt
];
12148 Jim_SetResultFormatted(interp
,
12149 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12153 if ((argc
- opt
) < 2)
12156 strObj
= argv
[opt
++];
12157 patCount
= argc
- opt
;
12158 if (patCount
== 1) {
12161 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12165 caseList
= &argv
[opt
];
12166 if (patCount
== 0 || patCount
% 2 != 0)
12168 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12169 Jim_Obj
*patObj
= caseList
[i
];
12171 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12172 || i
< (patCount
- 2)) {
12173 switch (matchOpt
) {
12175 if (Jim_StringEqObj(strObj
, patObj
))
12176 script
= caseList
[i
+ 1];
12179 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12180 script
= caseList
[i
+ 1];
12183 command
= Jim_NewStringObj(interp
, "regexp", -1);
12184 /* Fall thru intentionally */
12186 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12188 /* After the execution of a command we need to
12189 * make sure to reconvert the object into a list
12190 * again. Only for the single-list style [switch]. */
12191 if (argc
- opt
== 1) {
12194 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12197 /* command is here already decref'd */
12202 script
= caseList
[i
+ 1];
12208 script
= caseList
[i
+ 1];
12211 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12212 script
= caseList
[i
+ 1];
12213 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12214 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12217 Jim_SetEmptyResult(interp
);
12219 return Jim_EvalObj(interp
, script
);
12225 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12227 Jim_Obj
*listObjPtr
;
12229 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12230 Jim_SetResult(interp
, listObjPtr
);
12235 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12237 Jim_Obj
*objPtr
, *listObjPtr
;
12242 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12246 Jim_IncrRefCount(objPtr
);
12247 for (i
= 2; i
< argc
; i
++) {
12248 listObjPtr
= objPtr
;
12249 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12250 Jim_DecrRefCount(interp
, listObjPtr
);
12253 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12254 /* Returns an empty object if the index
12255 * is out of range. */
12256 Jim_DecrRefCount(interp
, listObjPtr
);
12257 Jim_SetEmptyResult(interp
);
12260 Jim_IncrRefCount(objPtr
);
12261 Jim_DecrRefCount(interp
, listObjPtr
);
12263 Jim_SetResult(interp
, objPtr
);
12264 Jim_DecrRefCount(interp
, objPtr
);
12269 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12272 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12275 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12280 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12282 static const char * const options
[] = {
12283 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12287 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12292 int opt_nocase
= 0;
12294 int opt_inline
= 0;
12295 int opt_match
= OPT_EXACT
;
12298 Jim_Obj
*listObjPtr
= NULL
;
12299 Jim_Obj
*commandObj
= NULL
;
12303 Jim_WrongNumArgs(interp
, 1, argv
,
12304 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12308 for (i
= 1; i
< argc
- 2; i
++) {
12311 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12333 if (i
>= argc
- 2) {
12336 commandObj
= argv
[++i
];
12341 opt_match
= option
;
12349 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12351 if (opt_match
== OPT_REGEXP
) {
12352 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12355 Jim_IncrRefCount(commandObj
);
12358 listlen
= Jim_ListLength(interp
, argv
[0]);
12359 for (i
= 0; i
< listlen
; i
++) {
12361 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12363 switch (opt_match
) {
12365 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12369 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12374 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12377 Jim_FreeNewObj(interp
, listObjPtr
);
12385 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12386 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12390 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12391 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12392 Jim_Obj
*resultObj
;
12395 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12397 else if (!opt_inline
) {
12398 resultObj
= Jim_NewIntObj(interp
, i
);
12401 resultObj
= objPtr
;
12405 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12408 Jim_SetResult(interp
, resultObj
);
12415 Jim_SetResult(interp
, listObjPtr
);
12420 Jim_SetResultBool(interp
, opt_not
);
12422 else if (!opt_inline
) {
12423 Jim_SetResultInt(interp
, -1);
12429 Jim_DecrRefCount(interp
, commandObj
);
12435 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12437 Jim_Obj
*listObjPtr
;
12441 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12444 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12446 /* Create the list if it does not exists */
12447 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12448 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12449 Jim_FreeNewObj(interp
, listObjPtr
);
12453 shared
= Jim_IsShared(listObjPtr
);
12455 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12456 for (i
= 2; i
< argc
; i
++)
12457 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12458 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12460 Jim_FreeNewObj(interp
, listObjPtr
);
12463 Jim_SetResult(interp
, listObjPtr
);
12468 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12474 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12478 if (Jim_IsShared(listPtr
))
12479 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12480 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12482 len
= Jim_ListLength(interp
, listPtr
);
12486 idx
= len
+ idx
+ 1;
12487 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12488 Jim_SetResult(interp
, listPtr
);
12491 if (listPtr
!= argv
[1]) {
12492 Jim_FreeNewObj(interp
, listPtr
);
12498 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12500 int first
, last
, len
, rangeLen
;
12502 Jim_Obj
*newListObj
;
12505 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12508 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12509 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12514 len
= Jim_ListLength(interp
, listObj
);
12516 first
= JimRelToAbsIndex(len
, first
);
12517 last
= JimRelToAbsIndex(len
, last
);
12518 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12520 /* Now construct a new list which consists of:
12521 * <elements before first> <supplied elements> <elements after last>
12524 /* Check to see if trying to replace past the end of the list */
12526 /* OK. Not past the end */
12528 else if (len
== 0) {
12529 /* Special for empty list, adjust first to 0 */
12533 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12534 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12538 /* Add the first set of elements */
12539 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12541 /* Add supplied elements */
12542 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12544 /* Add the remaining elements */
12545 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12547 Jim_SetResult(interp
, newListObj
);
12552 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12555 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12558 else if (argc
== 3) {
12559 /* With no indexes, simply implements [set] */
12560 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12562 Jim_SetResult(interp
, argv
[2]);
12565 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12569 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12571 static const char * const options
[] = {
12572 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12575 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12580 struct lsort_info info
;
12583 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12587 info
.type
= JIM_LSORT_ASCII
;
12591 info
.command
= NULL
;
12592 info
.interp
= interp
;
12594 for (i
= 1; i
< (argc
- 1); i
++) {
12597 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12602 info
.type
= JIM_LSORT_ASCII
;
12605 info
.type
= JIM_LSORT_NOCASE
;
12608 info
.type
= JIM_LSORT_INTEGER
;
12611 info
.type
= JIM_LSORT_REAL
;
12613 case OPT_INCREASING
:
12616 case OPT_DECREASING
:
12623 if (i
>= (argc
- 2)) {
12624 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12627 info
.type
= JIM_LSORT_COMMAND
;
12628 info
.command
= argv
[i
+ 1];
12632 if (i
>= (argc
- 2)) {
12633 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12636 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12644 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12645 retCode
= ListSortElements(interp
, resObj
, &info
);
12646 if (retCode
== JIM_OK
) {
12647 Jim_SetResult(interp
, resObj
);
12650 Jim_FreeNewObj(interp
, resObj
);
12656 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12658 Jim_Obj
*stringObjPtr
;
12662 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12666 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12672 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12673 if (!stringObjPtr
) {
12674 /* Create the string if it doesn't exist */
12675 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12678 else if (Jim_IsShared(stringObjPtr
)) {
12680 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12682 for (i
= 2; i
< argc
; i
++) {
12683 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12685 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12687 Jim_FreeNewObj(interp
, stringObjPtr
);
12692 Jim_SetResult(interp
, stringObjPtr
);
12697 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12699 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12700 static const char * const options
[] = {
12701 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12707 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12708 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12713 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12716 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12718 if (option
== OPT_REFCOUNT
) {
12720 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12723 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12726 else if (option
== OPT_OBJCOUNT
) {
12727 int freeobj
= 0, liveobj
= 0;
12732 Jim_WrongNumArgs(interp
, 2, argv
, "");
12735 /* Count the number of free objects. */
12736 objPtr
= interp
->freeList
;
12739 objPtr
= objPtr
->nextObjPtr
;
12741 /* Count the number of live objects. */
12742 objPtr
= interp
->liveList
;
12745 objPtr
= objPtr
->nextObjPtr
;
12747 /* Set the result string and return. */
12748 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12749 Jim_SetResultString(interp
, buf
, -1);
12752 else if (option
== OPT_OBJECTS
) {
12753 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12755 /* Count the number of live objects. */
12756 objPtr
= interp
->liveList
;
12757 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12760 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12762 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12763 sprintf(buf
, "%p", objPtr
);
12764 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12765 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12766 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12767 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12768 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12769 objPtr
= objPtr
->nextObjPtr
;
12771 Jim_SetResult(interp
, listObjPtr
);
12774 else if (option
== OPT_INVSTR
) {
12778 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12782 if (objPtr
->typePtr
!= NULL
)
12783 Jim_InvalidateStringRep(objPtr
);
12784 Jim_SetEmptyResult(interp
);
12787 else if (option
== OPT_SHOW
) {
12792 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12795 s
= Jim_GetString(argv
[2], &len
);
12797 charlen
= utf8_strlen(s
, len
);
12801 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12802 printf("chars (%d): <<%s>>\n", charlen
, s
);
12803 printf("bytes (%d):", len
);
12805 printf(" %02x", (unsigned char)*s
++);
12810 else if (option
== OPT_SCRIPTLEN
) {
12814 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12817 script
= JimGetScript(interp
, argv
[2]);
12818 if (script
== NULL
)
12820 Jim_SetResultInt(interp
, script
->len
);
12823 else if (option
== OPT_EXPRLEN
) {
12824 ExprByteCode
*expr
;
12827 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12830 expr
= JimGetExpression(interp
, argv
[2]);
12833 Jim_SetResultInt(interp
, expr
->len
);
12836 else if (option
== OPT_EXPRBC
) {
12838 ExprByteCode
*expr
;
12842 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12845 expr
= JimGetExpression(interp
, argv
[2]);
12848 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12849 for (i
= 0; i
< expr
->len
; i
++) {
12851 const Jim_ExprOperator
*op
;
12852 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
12854 switch (expr
->token
[i
].type
) {
12855 case JIM_TT_EXPR_INT
:
12858 case JIM_TT_EXPR_DOUBLE
:
12867 case JIM_TT_DICTSUGAR
:
12868 type
= "dictsugar";
12870 case JIM_TT_EXPRSUGAR
:
12871 type
= "exprsugar";
12880 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
12887 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
12890 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
12891 Jim_ListAppendElement(interp
, objPtr
, obj
);
12893 Jim_SetResult(interp
, objPtr
);
12897 Jim_SetResultString(interp
,
12898 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12902 #endif /* JIM_BOOTSTRAP */
12903 #if !defined(JIM_DEBUG_COMMAND)
12904 Jim_SetResultString(interp
, "unsupported", -1);
12910 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12915 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
12920 rc
= Jim_EvalObj(interp
, argv
[1]);
12923 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12926 if (rc
== JIM_ERR
) {
12927 /* eval is "interesting", so add a stack frame here */
12928 interp
->addStackTrace
++;
12934 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12938 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
12942 /* Save the old callframe pointer */
12943 savedCallFrame
= interp
->framePtr
;
12945 /* Lookup the target frame pointer */
12946 str
= Jim_String(argv
[1]);
12947 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
12948 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
12953 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
12955 if (targetCallFrame
== NULL
) {
12959 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
12962 /* Eval the code in the target callframe. */
12963 interp
->framePtr
= targetCallFrame
;
12964 /* Can't merge tailcalls across upcall */
12965 savedTailcall
= interp
->framePtr
->tailcall
;
12966 interp
->framePtr
->tailcall
= 0;
12968 retcode
= Jim_EvalObj(interp
, argv
[1]);
12971 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12973 interp
->framePtr
->tailcall
= savedTailcall
;
12974 interp
->framePtr
= savedCallFrame
;
12978 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
12984 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12986 Jim_Obj
*exprResultPtr
;
12990 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
12992 else if (argc
> 2) {
12995 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
12996 Jim_IncrRefCount(objPtr
);
12997 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
12998 Jim_DecrRefCount(interp
, objPtr
);
13001 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
13004 if (retcode
!= JIM_OK
)
13006 Jim_SetResult(interp
, exprResultPtr
);
13007 Jim_DecrRefCount(interp
, exprResultPtr
);
13012 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13015 Jim_WrongNumArgs(interp
, 1, argv
, "");
13022 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13025 Jim_WrongNumArgs(interp
, 1, argv
, "");
13028 return JIM_CONTINUE
;
13032 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13035 Jim_Obj
*stackTraceObj
= NULL
;
13036 Jim_Obj
*errorCodeObj
= NULL
;
13037 int returnCode
= JIM_OK
;
13040 for (i
= 1; i
< argc
- 1; i
+= 2) {
13041 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13042 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13046 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13047 stackTraceObj
= argv
[i
+ 1];
13049 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13050 errorCodeObj
= argv
[i
+ 1];
13052 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13053 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13054 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13063 if (i
!= argc
- 1 && i
!= argc
) {
13064 Jim_WrongNumArgs(interp
, 1, argv
,
13065 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13068 /* If a stack trace is supplied and code is error, set the stack trace */
13069 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13070 JimSetStackTrace(interp
, stackTraceObj
);
13072 /* If an error code list is supplied, set the global $errorCode */
13073 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13074 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13076 interp
->returnCode
= returnCode
;
13077 interp
->returnLevel
= level
;
13079 if (i
== argc
- 1) {
13080 Jim_SetResult(interp
, argv
[i
]);
13086 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13088 if (interp
->framePtr
->level
== 0) {
13089 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13092 else if (argc
>= 2) {
13093 /* Need to resolve the tailcall command in the current context */
13094 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13096 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13097 if (cmdPtr
== NULL
) {
13101 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13103 /* And stash this pre-resolved command */
13104 JimIncrCmdRefCount(cmdPtr
);
13105 cf
->tailcallCmd
= cmdPtr
;
13107 /* And stash the command list */
13108 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13110 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13111 Jim_IncrRefCount(cf
->tailcallObj
);
13113 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13119 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13122 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13124 /* prefixListObj is a list to which the args need to be appended */
13125 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13126 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13128 return JimEvalObjList(interp
, cmdList
);
13131 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13133 Jim_Obj
*prefixListObj
= privData
;
13134 Jim_DecrRefCount(interp
, prefixListObj
);
13137 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13139 Jim_Obj
*prefixListObj
;
13140 const char *newname
;
13143 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13147 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13148 Jim_IncrRefCount(prefixListObj
);
13149 newname
= Jim_String(argv
[1]);
13150 if (newname
[0] == ':' && newname
[1] == ':') {
13151 while (*++newname
== ':') {
13155 Jim_SetResult(interp
, argv
[1]);
13157 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13161 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13165 if (argc
!= 4 && argc
!= 5) {
13166 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13170 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13175 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13178 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13182 /* Add the new command */
13183 Jim_Obj
*qualifiedCmdNameObj
;
13184 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13186 JimCreateCommand(interp
, cmdname
, cmd
);
13188 /* Calculate and set the namespace for this proc */
13189 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13191 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13193 /* Unlike Tcl, set the name of the proc as the result */
13194 Jim_SetResult(interp
, argv
[1]);
13201 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13206 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13210 /* Evaluate the arguments with 'local' in force */
13212 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13216 /* If OK, and the result is a proc, add it to the list of local procs */
13217 if (retcode
== 0) {
13218 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13220 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13223 if (interp
->framePtr
->localCommands
== NULL
) {
13224 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13225 Jim_InitStack(interp
->framePtr
->localCommands
);
13227 Jim_IncrRefCount(cmdNameObj
);
13228 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13235 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13238 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13244 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13245 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13246 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13249 /* OK. Mark this command as being in an upcall */
13250 cmdPtr
->u
.proc
.upcall
++;
13251 JimIncrCmdRefCount(cmdPtr
);
13253 /* Invoke the command as normal */
13254 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13256 /* No longer in an upcall */
13257 cmdPtr
->u
.proc
.upcall
--;
13258 JimDecrCmdRefCount(interp
, cmdPtr
);
13265 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13268 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13274 Jim_Obj
*argListObjPtr
;
13275 Jim_Obj
*bodyObjPtr
;
13276 Jim_Obj
*nsObj
= NULL
;
13279 int len
= Jim_ListLength(interp
, argv
[1]);
13280 if (len
!= 2 && len
!= 3) {
13281 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13286 #ifdef jim_ext_namespace
13287 /* Need to canonicalise the given namespace. */
13288 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13290 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13294 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13295 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13297 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13300 /* Create a new argv array with a dummy argv[0], for error messages */
13301 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13302 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13303 Jim_IncrRefCount(nargv
[0]);
13304 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13305 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13306 Jim_DecrRefCount(interp
, nargv
[0]);
13309 JimDecrCmdRefCount(interp
, cmd
);
13318 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13320 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13325 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13328 Jim_CallFrame
*targetCallFrame
;
13330 /* Lookup the target frame pointer */
13331 if (argc
> 3 && (argc
% 2 == 0)) {
13332 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13337 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13339 if (targetCallFrame
== NULL
) {
13343 /* Check for arity */
13345 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13349 /* Now... for every other/local couple: */
13350 for (i
= 1; i
< argc
; i
+= 2) {
13351 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13358 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13363 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13366 /* Link every var to the toplevel having the same name */
13367 if (interp
->framePtr
->level
== 0)
13368 return JIM_OK
; /* global at toplevel... */
13369 for (i
= 1; i
< argc
; i
++) {
13370 /* global ::blah does nothing */
13371 const char *name
= Jim_String(argv
[i
]);
13372 if (name
[0] != ':' || name
[1] != ':') {
13373 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13380 /* does the [string map] operation. On error NULL is returned,
13381 * otherwise a new string object with the result, having refcount = 0,
13383 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13384 Jim_Obj
*objPtr
, int nocase
)
13387 const char *str
, *noMatchStart
= NULL
;
13389 Jim_Obj
*resultObjPtr
;
13391 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13393 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13397 str
= Jim_String(objPtr
);
13398 strLen
= Jim_Utf8Length(interp
, objPtr
);
13401 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13403 for (i
= 0; i
< numMaps
; i
+= 2) {
13408 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13409 k
= Jim_String(objPtr
);
13410 kl
= Jim_Utf8Length(interp
, objPtr
);
13412 if (strLen
>= kl
&& kl
) {
13414 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13416 if (noMatchStart
) {
13417 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13418 noMatchStart
= NULL
;
13420 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13421 str
+= utf8_index(str
, kl
);
13427 if (i
== numMaps
) { /* no match */
13429 if (noMatchStart
== NULL
)
13430 noMatchStart
= str
;
13431 str
+= utf8_tounicode(str
, &c
);
13435 if (noMatchStart
) {
13436 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13438 return resultObjPtr
;
13442 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13447 static const char * const options
[] = {
13448 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13449 "map", "repeat", "reverse", "index", "first", "last", "cat",
13450 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13454 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13455 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13456 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13458 static const char * const nocase_options
[] = {
13461 static const char * const nocase_length_options
[] = {
13462 "-nocase", "-length", NULL
13466 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13469 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13470 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13475 case OPT_BYTELENGTH
:
13477 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13480 if (option
== OPT_LENGTH
) {
13481 len
= Jim_Utf8Length(interp
, argv
[2]);
13484 len
= Jim_Length(argv
[2]);
13486 Jim_SetResultInt(interp
, len
);
13492 /* optimise the one-arg case */
13498 objPtr
= Jim_NewStringObj(interp
, "", 0);
13500 for (i
= 2; i
< argc
; i
++) {
13501 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13504 Jim_SetResult(interp
, objPtr
);
13511 /* n is the number of remaining option args */
13512 long opt_length
= -1;
13517 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13518 JIM_ENUM_ABBREV
) != JIM_OK
) {
13520 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13531 goto badcompareargs
;
13533 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13540 goto badcompareargs
;
13543 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13544 /* Fast version - [string equal], case sensitive, no length */
13545 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13548 if (opt_length
>= 0) {
13549 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13552 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13554 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13562 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13563 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13564 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13567 if (opt_case
== 0) {
13570 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13578 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13579 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13580 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13584 if (opt_case
== 0) {
13587 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13588 if (objPtr
== NULL
) {
13591 Jim_SetResult(interp
, objPtr
);
13596 case OPT_BYTERANGE
:{
13600 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13603 if (option
== OPT_RANGE
) {
13604 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13608 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13611 if (objPtr
== NULL
) {
13614 Jim_SetResult(interp
, objPtr
);
13621 if (argc
!= 5 && argc
!= 6) {
13622 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13625 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13626 if (objPtr
== NULL
) {
13629 Jim_SetResult(interp
, objPtr
);
13639 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13642 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13645 objPtr
= Jim_NewStringObj(interp
, "", 0);
13648 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13651 Jim_SetResult(interp
, objPtr
);
13662 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13666 str
= Jim_GetString(argv
[2], &len
);
13667 buf
= Jim_Alloc(len
+ 1);
13670 for (i
= 0; i
< len
; ) {
13672 int l
= utf8_tounicode(str
, &c
);
13673 memcpy(p
- l
, str
, l
);
13678 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13687 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13690 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13693 str
= Jim_String(argv
[2]);
13694 len
= Jim_Utf8Length(interp
, argv
[2]);
13695 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13696 idx
= JimRelToAbsIndex(len
, idx
);
13698 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13699 Jim_SetResultString(interp
, "", 0);
13701 else if (len
== Jim_Length(argv
[2])) {
13702 /* ASCII optimisation */
13703 Jim_SetResultString(interp
, str
+ idx
, 1);
13707 int i
= utf8_index(str
, idx
);
13708 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13715 int idx
= 0, l1
, l2
;
13716 const char *s1
, *s2
;
13718 if (argc
!= 4 && argc
!= 5) {
13719 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13722 s1
= Jim_String(argv
[2]);
13723 s2
= Jim_String(argv
[3]);
13724 l1
= Jim_Utf8Length(interp
, argv
[2]);
13725 l2
= Jim_Utf8Length(interp
, argv
[3]);
13727 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13730 idx
= JimRelToAbsIndex(l2
, idx
);
13732 else if (option
== OPT_LAST
) {
13735 if (option
== OPT_FIRST
) {
13736 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13740 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13742 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13750 case OPT_TRIMRIGHT
:{
13751 Jim_Obj
*trimchars
;
13753 if (argc
!= 3 && argc
!= 4) {
13754 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13757 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13758 if (option
== OPT_TRIM
) {
13759 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13761 else if (option
== OPT_TRIMLEFT
) {
13762 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13764 else if (option
== OPT_TRIMRIGHT
) {
13765 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13774 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13777 if (option
== OPT_TOLOWER
) {
13778 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13780 else if (option
== OPT_TOUPPER
) {
13781 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13784 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13789 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13790 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13792 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13799 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13802 jim_wide start
, elapsed
;
13804 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13807 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13811 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13817 start
= JimClock();
13821 retval
= Jim_EvalObj(interp
, argv
[1]);
13822 if (retval
!= JIM_OK
) {
13826 elapsed
= JimClock() - start
;
13827 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13828 Jim_SetResultString(interp
, buf
, -1);
13833 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13838 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13842 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13845 interp
->exitCode
= exitCode
;
13850 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13856 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13857 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
13858 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
13860 /* Reset the error code before catch.
13861 * Note that this is not strictly correct.
13863 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
13865 for (i
= 1; i
< argc
- 1; i
++) {
13866 const char *arg
= Jim_String(argv
[i
]);
13870 /* It's a pity we can't use Jim_GetEnum here :-( */
13871 if (strcmp(arg
, "--") == 0) {
13879 if (strncmp(arg
, "-no", 3) == 0) {
13888 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
13892 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
13899 ignore_mask
|= (1 << option
);
13902 ignore_mask
&= ~(1 << option
);
13907 if (argc
< 1 || argc
> 3) {
13909 Jim_WrongNumArgs(interp
, 1, argv
,
13910 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13915 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
13919 interp
->signal_level
+= sig
;
13920 if (Jim_CheckSignal(interp
)) {
13921 /* If a signal is set, don't even try to execute the body */
13922 exitCode
= JIM_SIGNAL
;
13925 exitCode
= Jim_EvalObj(interp
, argv
[0]);
13926 /* Don't want any caught error included in a later stack trace */
13927 interp
->errorFlag
= 0;
13929 interp
->signal_level
-= sig
;
13931 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13932 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
13933 /* Not caught, pass it up */
13937 if (sig
&& exitCode
== JIM_SIGNAL
) {
13938 /* Catch the signal at this level */
13939 if (interp
->signal_set_result
) {
13940 interp
->signal_set_result(interp
, interp
->sigmask
);
13943 Jim_SetResultInt(interp
, interp
->sigmask
);
13945 interp
->sigmask
= 0;
13949 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
13953 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
13955 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
13956 Jim_ListAppendElement(interp
, optListObj
,
13957 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
13958 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
13959 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
13960 if (exitCode
== JIM_ERR
) {
13961 Jim_Obj
*errorCode
;
13962 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
13964 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
13966 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
13968 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
13969 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
13972 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
13977 Jim_SetResultInt(interp
, exitCode
);
13981 #ifdef JIM_REFERENCES
13984 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13986 if (argc
!= 3 && argc
!= 4) {
13987 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
13991 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
13994 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
14000 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14002 Jim_Reference
*refPtr
;
14005 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14008 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14010 Jim_SetResult(interp
, refPtr
->objPtr
);
14015 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14017 Jim_Reference
*refPtr
;
14020 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14023 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14025 Jim_IncrRefCount(argv
[2]);
14026 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14027 refPtr
->objPtr
= argv
[2];
14028 Jim_SetResult(interp
, argv
[2]);
14033 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14036 Jim_WrongNumArgs(interp
, 1, argv
, "");
14039 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14041 /* Free all the freed objects. */
14042 while (interp
->freeList
) {
14043 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14044 Jim_Free(interp
->freeList
);
14045 interp
->freeList
= nextObjPtr
;
14051 /* [finalize] reference ?newValue? */
14052 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14054 if (argc
!= 2 && argc
!= 3) {
14055 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14059 Jim_Obj
*cmdNamePtr
;
14061 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14063 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14064 Jim_SetResult(interp
, cmdNamePtr
);
14067 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14069 Jim_SetResult(interp
, argv
[2]);
14074 /* [info references] */
14075 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14077 Jim_Obj
*listObjPtr
;
14078 Jim_HashTableIterator htiter
;
14081 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14083 JimInitHashTableIterator(&interp
->references
, &htiter
);
14084 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14085 char buf
[JIM_REFERENCE_SPACE
+ 1];
14086 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14087 const unsigned long *refId
= he
->key
;
14089 JimFormatReference(buf
, refPtr
, *refId
);
14090 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14092 Jim_SetResult(interp
, listObjPtr
);
14098 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14101 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14105 if (JimValidName(interp
, "new procedure", argv
[2])) {
14109 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14112 #define JIM_DICTMATCH_VALUES 0x0001
14114 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14116 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14118 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14119 if (type
& JIM_DICTMATCH_VALUES
) {
14120 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14125 * Like JimHashtablePatternMatch, but for dictionaries.
14127 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14128 JimDictMatchCallbackType
*callback
, int type
)
14131 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14133 /* Check for the non-pattern case. We can do this much more efficiently. */
14134 Jim_HashTableIterator htiter
;
14135 JimInitHashTableIterator(ht
, &htiter
);
14136 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14137 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14138 callback(interp
, listObjPtr
, he
, type
);
14146 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14148 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14151 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14155 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14157 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14160 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14164 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14166 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14169 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14172 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14177 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14181 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14183 /* Note that this uses internal knowledge of the hash table */
14184 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14186 for (i
= 0; i
< ht
->size
; i
++) {
14187 Jim_HashEntry
*he
= ht
->table
[i
];
14193 printf(" %s", Jim_String(he
->key
));
14202 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14204 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14206 Jim_AppendString(interp
, prefixObj
, " ", 1);
14207 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14209 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14213 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14217 static const char * const options
[] = {
14218 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14219 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14220 "replace", "update", NULL
14224 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14225 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14226 OPT_REPLACE
, OPT_UPDATE
,
14230 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14234 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14241 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14244 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14245 JIM_ERRMSG
) != JIM_OK
) {
14248 Jim_SetResult(interp
, objPtr
);
14253 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14256 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14260 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14264 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14268 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14274 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14277 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14283 if (argc
!= 3 && argc
!= 4) {
14284 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14287 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14291 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14294 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14297 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14304 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14307 /* Handle as ensemble */
14311 if (argc
< 6 || argc
% 2) {
14312 /* Better error message */
14319 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14322 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14323 Jim_SetResult(interp
, objPtr
);
14328 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14331 return Jim_DictInfo(interp
, argv
[2]);
14333 /* Handle command as an ensemble */
14334 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14338 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14340 static const char * const options
[] = {
14341 "-nobackslashes", "-nocommands", "-novariables", NULL
14344 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14346 int flags
= JIM_SUBST_FLAG
;
14350 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14353 for (i
= 1; i
< (argc
- 1); i
++) {
14356 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14357 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14361 case OPT_NOBACKSLASHES
:
14362 flags
|= JIM_SUBST_NOESC
;
14364 case OPT_NOCOMMANDS
:
14365 flags
|= JIM_SUBST_NOCMD
;
14367 case OPT_NOVARIABLES
:
14368 flags
|= JIM_SUBST_NOVAR
;
14372 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14375 Jim_SetResult(interp
, objPtr
);
14380 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14386 static const char * const commands
[] = {
14387 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14388 "vars", "version", "patchlevel", "complete", "args", "hostname",
14389 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14390 "references", "alias", NULL
14393 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14394 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14395 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14396 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14399 #ifdef jim_ext_namespace
14402 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14403 /* This is for internal use only */
14411 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14414 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14419 /* Test for the the most common commands first, just in case it makes a difference */
14423 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14426 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14433 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14436 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14439 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14440 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14443 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14447 case INFO_CHANNELS
:
14448 mode
++; /* JIM_CMDLIST_CHANNELS */
14449 #ifndef jim_ext_aio
14450 Jim_SetResultString(interp
, "aio not enabled", -1);
14454 mode
++; /* JIM_CMDLIST_PROCS */
14455 case INFO_COMMANDS
:
14456 /* mode 0 => JIM_CMDLIST_COMMANDS */
14457 if (argc
!= 2 && argc
!= 3) {
14458 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14461 #ifdef jim_ext_namespace
14463 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14464 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14468 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14472 mode
++; /* JIM_VARLIST_VARS */
14474 mode
++; /* JIM_VARLIST_LOCALS */
14476 /* mode 0 => JIM_VARLIST_GLOBALS */
14477 if (argc
!= 2 && argc
!= 3) {
14478 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14481 #ifdef jim_ext_namespace
14483 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14484 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14488 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14493 Jim_WrongNumArgs(interp
, 2, argv
, "");
14496 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14501 Jim_Obj
*resObjPtr
;
14502 Jim_Obj
*fileNameObj
;
14504 if (argc
!= 3 && argc
!= 5) {
14505 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14509 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14512 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14513 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14516 if (argv
[2]->typePtr
== &sourceObjType
) {
14517 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14518 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14520 else if (argv
[2]->typePtr
== &scriptObjType
) {
14521 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14522 fileNameObj
= script
->fileNameObj
;
14523 line
= script
->firstline
;
14526 fileNameObj
= interp
->emptyObj
;
14529 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14530 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14531 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14533 Jim_SetResult(interp
, resObjPtr
);
14537 case INFO_STACKTRACE
:
14538 Jim_SetResult(interp
, interp
->stackTrace
);
14545 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14549 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14552 Jim_SetResult(interp
, objPtr
);
14556 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14567 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14570 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14573 if (!cmdPtr
->isproc
) {
14574 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14579 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14582 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14585 if (cmdPtr
->u
.proc
.staticVars
) {
14586 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14587 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14588 NULL
, JimVariablesMatch
, mode
));
14596 case INFO_PATCHLEVEL
:{
14597 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14599 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14600 Jim_SetResultString(interp
, buf
, -1);
14604 case INFO_COMPLETE
:
14605 if (argc
!= 3 && argc
!= 4) {
14606 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14611 const char *s
= Jim_GetString(argv
[2], &len
);
14614 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
14615 if (missing
!= ' ' && argc
== 4) {
14616 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14621 case INFO_HOSTNAME
:
14622 /* Redirect to os.gethostname if it exists */
14623 return Jim_Eval(interp
, "os.gethostname");
14625 case INFO_NAMEOFEXECUTABLE
:
14626 /* Redirect to Tcl proc */
14627 return Jim_Eval(interp
, "{info nameofexecutable}");
14629 case INFO_RETURNCODES
:
14632 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14634 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14635 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14636 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14637 jimReturnCodes
[i
], -1));
14640 Jim_SetResult(interp
, listObjPtr
);
14642 else if (argc
== 3) {
14646 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14649 name
= Jim_ReturnCode(code
);
14650 if (*name
== '?') {
14651 Jim_SetResultInt(interp
, code
);
14654 Jim_SetResultString(interp
, name
, -1);
14658 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14662 case INFO_REFERENCES
:
14663 #ifdef JIM_REFERENCES
14664 return JimInfoReferences(interp
, argc
, argv
);
14666 Jim_SetResultString(interp
, "not supported", -1);
14674 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14679 static const char * const options
[] = {
14680 "-command", "-proc", "-alias", "-var", NULL
14684 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14692 else if (argc
== 3) {
14693 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14699 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14703 if (option
== OPT_VAR
) {
14704 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14707 /* Now different kinds of commands */
14708 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14717 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14721 result
= cmd
->isproc
;
14726 Jim_SetResultBool(interp
, result
);
14731 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14733 const char *str
, *splitChars
, *noMatchStart
;
14734 int splitLen
, strLen
;
14735 Jim_Obj
*resObjPtr
;
14739 if (argc
!= 2 && argc
!= 3) {
14740 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14744 str
= Jim_GetString(argv
[1], &len
);
14748 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14752 splitChars
= " \n\t\r";
14756 splitChars
= Jim_String(argv
[2]);
14757 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14760 noMatchStart
= str
;
14761 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14767 const char *sc
= splitChars
;
14768 int scLen
= splitLen
;
14769 int sl
= utf8_tounicode(str
, &c
);
14772 sc
+= utf8_tounicode(sc
, &pc
);
14774 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14775 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14776 noMatchStart
= str
+ sl
;
14782 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14783 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14786 /* This handles the special case of splitchars eq {}
14787 * Optimise by sharing common (ASCII) characters
14789 Jim_Obj
**commonObj
= NULL
;
14790 #define NUM_COMMON (128 - 9)
14792 int n
= utf8_tounicode(str
, &c
);
14793 #ifdef JIM_OPTIMIZATION
14794 if (c
>= 9 && c
< 128) {
14795 /* Common ASCII char. Note that 9 is the tab character */
14798 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14799 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14801 if (!commonObj
[c
]) {
14802 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14804 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14809 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14812 Jim_Free(commonObj
);
14815 Jim_SetResult(interp
, resObjPtr
);
14820 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14822 const char *joinStr
;
14825 if (argc
!= 2 && argc
!= 3) {
14826 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14835 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14837 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14842 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14847 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
14850 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
14851 if (objPtr
== NULL
)
14853 Jim_SetResult(interp
, objPtr
);
14858 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14860 Jim_Obj
*listPtr
, **outVec
;
14864 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
14867 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
14868 SetScanFmtFromAny(interp
, argv
[2]);
14869 if (FormatGetError(argv
[2]) != 0) {
14870 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
14874 int maxPos
= FormatGetMaxPos(argv
[2]);
14875 int count
= FormatGetCnvCount(argv
[2]);
14877 if (maxPos
> argc
- 3) {
14878 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
14881 else if (count
> argc
- 3) {
14882 Jim_SetResultString(interp
, "different numbers of variable names and "
14883 "field specifiers", -1);
14886 else if (count
< argc
- 3) {
14887 Jim_SetResultString(interp
, "variable is not assigned by any "
14888 "conversion specifiers", -1);
14892 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
14899 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
14900 int len
= Jim_ListLength(interp
, listPtr
);
14903 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
14904 for (i
= 0; i
< outc
; ++i
) {
14905 if (Jim_Length(outVec
[i
]) > 0) {
14907 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
14913 Jim_FreeNewObj(interp
, listPtr
);
14918 if (rc
== JIM_OK
) {
14919 Jim_SetResultInt(interp
, count
);
14924 if (listPtr
== (Jim_Obj
*)EOF
) {
14925 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
14928 Jim_SetResult(interp
, listPtr
);
14934 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14936 if (argc
!= 2 && argc
!= 3) {
14937 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
14940 Jim_SetResult(interp
, argv
[1]);
14942 JimSetStackTrace(interp
, argv
[2]);
14945 interp
->addStackTrace
++;
14950 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14955 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
14958 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
14960 Jim_SetResult(interp
, objPtr
);
14965 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14970 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
14971 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
14975 if (count
== 0 || argc
== 2) {
14982 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
14984 ListInsertElements(objPtr
, -1, argc
, argv
);
14987 Jim_SetResult(interp
, objPtr
);
14991 char **Jim_GetEnviron(void)
14993 #if defined(HAVE__NSGETENVIRON)
14994 return *_NSGetEnviron();
14996 #if !defined(NO_ENVIRON_EXTERN)
14997 extern char **environ
;
15004 void Jim_SetEnviron(char **env
)
15006 #if defined(HAVE__NSGETENVIRON)
15007 *_NSGetEnviron() = env
;
15009 #if !defined(NO_ENVIRON_EXTERN)
15010 extern char **environ
;
15018 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15024 char **e
= Jim_GetEnviron();
15027 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15029 for (i
= 0; e
[i
]; i
++) {
15030 const char *equals
= strchr(e
[i
], '=');
15033 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15035 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15039 Jim_SetResult(interp
, listObjPtr
);
15044 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15047 key
= Jim_String(argv
[1]);
15051 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15054 val
= Jim_String(argv
[2]);
15056 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15061 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15066 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15069 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15070 if (retval
== JIM_RETURN
)
15076 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15078 Jim_Obj
*revObjPtr
, **ele
;
15082 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15085 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15087 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15089 ListAppendElement(revObjPtr
, ele
[len
--]);
15090 Jim_SetResult(interp
, revObjPtr
);
15094 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15102 else if (step
> 0 && start
> end
)
15104 else if (step
< 0 && end
> start
)
15108 len
= -len
; /* abs(len) */
15110 step
= -step
; /* abs(step) */
15111 len
= 1 + ((len
- 1) / step
);
15112 /* We can truncate safely to INT_MAX, the range command
15113 * will always return an error for a such long range
15114 * because Tcl lists can't be so long. */
15117 return (int)((len
< 0) ? -1 : len
);
15121 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15123 jim_wide start
= 0, end
, step
= 1;
15127 if (argc
< 2 || argc
> 4) {
15128 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15132 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15136 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15137 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15139 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15142 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15143 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15146 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15147 for (i
= 0; i
< len
; i
++)
15148 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15149 Jim_SetResult(interp
, objPtr
);
15154 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15156 jim_wide min
= 0, max
= 0, len
, maxMul
;
15158 if (argc
< 1 || argc
> 3) {
15159 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15163 max
= JIM_WIDE_MAX
;
15164 } else if (argc
== 2) {
15165 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15167 } else if (argc
== 3) {
15168 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15169 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15174 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15177 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15181 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15182 if (r
< 0 || r
>= maxMul
) continue;
15183 r
= (len
== 0) ? 0 : r
%len
;
15184 Jim_SetResultInt(interp
, min
+r
);
15189 static const struct {
15191 Jim_CmdProc
*cmdProc
;
15192 } Jim_CoreCommandsTable
[] = {
15193 {"alias", Jim_AliasCoreCommand
},
15194 {"set", Jim_SetCoreCommand
},
15195 {"unset", Jim_UnsetCoreCommand
},
15196 {"puts", Jim_PutsCoreCommand
},
15197 {"+", Jim_AddCoreCommand
},
15198 {"*", Jim_MulCoreCommand
},
15199 {"-", Jim_SubCoreCommand
},
15200 {"/", Jim_DivCoreCommand
},
15201 {"incr", Jim_IncrCoreCommand
},
15202 {"while", Jim_WhileCoreCommand
},
15203 {"loop", Jim_LoopCoreCommand
},
15204 {"for", Jim_ForCoreCommand
},
15205 {"foreach", Jim_ForeachCoreCommand
},
15206 {"lmap", Jim_LmapCoreCommand
},
15207 {"lassign", Jim_LassignCoreCommand
},
15208 {"if", Jim_IfCoreCommand
},
15209 {"switch", Jim_SwitchCoreCommand
},
15210 {"list", Jim_ListCoreCommand
},
15211 {"lindex", Jim_LindexCoreCommand
},
15212 {"lset", Jim_LsetCoreCommand
},
15213 {"lsearch", Jim_LsearchCoreCommand
},
15214 {"llength", Jim_LlengthCoreCommand
},
15215 {"lappend", Jim_LappendCoreCommand
},
15216 {"linsert", Jim_LinsertCoreCommand
},
15217 {"lreplace", Jim_LreplaceCoreCommand
},
15218 {"lsort", Jim_LsortCoreCommand
},
15219 {"append", Jim_AppendCoreCommand
},
15220 {"debug", Jim_DebugCoreCommand
},
15221 {"eval", Jim_EvalCoreCommand
},
15222 {"uplevel", Jim_UplevelCoreCommand
},
15223 {"expr", Jim_ExprCoreCommand
},
15224 {"break", Jim_BreakCoreCommand
},
15225 {"continue", Jim_ContinueCoreCommand
},
15226 {"proc", Jim_ProcCoreCommand
},
15227 {"concat", Jim_ConcatCoreCommand
},
15228 {"return", Jim_ReturnCoreCommand
},
15229 {"upvar", Jim_UpvarCoreCommand
},
15230 {"global", Jim_GlobalCoreCommand
},
15231 {"string", Jim_StringCoreCommand
},
15232 {"time", Jim_TimeCoreCommand
},
15233 {"exit", Jim_ExitCoreCommand
},
15234 {"catch", Jim_CatchCoreCommand
},
15235 #ifdef JIM_REFERENCES
15236 {"ref", Jim_RefCoreCommand
},
15237 {"getref", Jim_GetrefCoreCommand
},
15238 {"setref", Jim_SetrefCoreCommand
},
15239 {"finalize", Jim_FinalizeCoreCommand
},
15240 {"collect", Jim_CollectCoreCommand
},
15242 {"rename", Jim_RenameCoreCommand
},
15243 {"dict", Jim_DictCoreCommand
},
15244 {"subst", Jim_SubstCoreCommand
},
15245 {"info", Jim_InfoCoreCommand
},
15246 {"exists", Jim_ExistsCoreCommand
},
15247 {"split", Jim_SplitCoreCommand
},
15248 {"join", Jim_JoinCoreCommand
},
15249 {"format", Jim_FormatCoreCommand
},
15250 {"scan", Jim_ScanCoreCommand
},
15251 {"error", Jim_ErrorCoreCommand
},
15252 {"lrange", Jim_LrangeCoreCommand
},
15253 {"lrepeat", Jim_LrepeatCoreCommand
},
15254 {"env", Jim_EnvCoreCommand
},
15255 {"source", Jim_SourceCoreCommand
},
15256 {"lreverse", Jim_LreverseCoreCommand
},
15257 {"range", Jim_RangeCoreCommand
},
15258 {"rand", Jim_RandCoreCommand
},
15259 {"tailcall", Jim_TailcallCoreCommand
},
15260 {"local", Jim_LocalCoreCommand
},
15261 {"upcall", Jim_UpcallCoreCommand
},
15262 {"apply", Jim_ApplyCoreCommand
},
15266 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15270 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15271 Jim_CreateCommand(interp
,
15272 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15277 /* -----------------------------------------------------------------------------
15278 * Interactive prompt
15279 * ---------------------------------------------------------------------------*/
15280 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15284 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15285 argv
[1] = interp
->result
;
15287 Jim_EvalObjVector(interp
, 2, argv
);
15290 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15291 const char *prefix
, const char *const *tablePtr
, const char *name
)
15294 char **tablePtrSorted
;
15297 for (count
= 0; tablePtr
[count
]; count
++) {
15300 if (name
== NULL
) {
15304 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15305 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15306 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15307 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15308 for (i
= 0; i
< count
; i
++) {
15309 if (i
+ 1 == count
&& count
> 1) {
15310 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15312 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15313 if (i
+ 1 != count
) {
15314 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15317 Jim_Free(tablePtrSorted
);
15320 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15321 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15323 const char *bad
= "bad ";
15324 const char *const *entryPtr
= NULL
;
15328 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15332 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15333 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15334 /* Found an exact match */
15338 if (flags
& JIM_ENUM_ABBREV
) {
15339 /* Accept an unambiguous abbreviation.
15340 * Note that '-' doesnt' consitute a valid abbreviation
15342 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15343 if (*arg
== '-' && arglen
== 1) {
15347 bad
= "ambiguous ";
15355 /* If we had an unambiguous partial match */
15362 if (flags
& JIM_ERRMSG
) {
15363 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15368 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15372 for (i
= 0; i
< (int)len
; i
++) {
15373 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15380 int Jim_IsDict(Jim_Obj
*objPtr
)
15382 return objPtr
->typePtr
== &dictObjType
;
15385 int Jim_IsList(Jim_Obj
*objPtr
)
15387 return objPtr
->typePtr
== &listObjType
;
15391 * Very simple printf-like formatting, designed for error messages.
15393 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15394 * The resulting string is created and set as the result.
15396 * Each '%s' should correspond to a regular string parameter.
15397 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15398 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15400 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15402 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15404 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15406 /* Initial space needed */
15407 int len
= strlen(format
);
15410 const char *params
[5];
15415 va_start(args
, format
);
15417 for (i
= 0; i
< len
&& n
< 5; i
++) {
15420 if (strncmp(format
+ i
, "%s", 2) == 0) {
15421 params
[n
] = va_arg(args
, char *);
15423 l
= strlen(params
[n
]);
15425 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15426 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15428 params
[n
] = Jim_GetString(objPtr
, &l
);
15431 if (format
[i
] == '%') {
15441 buf
= Jim_Alloc(len
+ 1);
15442 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15446 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15450 #ifndef jim_ext_package
15451 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15456 #ifndef jim_ext_aio
15457 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15459 Jim_SetResultString(interp
, "aio not enabled", -1);
15466 * Local Variables: ***
15467 * c-basic-offset: 4 ***