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] != '$') {
1690 /* Only need a separate ')' token if the previous was a var */
1691 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1692 if (pc
->p
== pc
->tstart
) {
1693 /* At the start of the token, so just return this char */
1697 pc
->tend
= pc
->p
- 1;
1698 pc
->tt
= JIM_TT_ESC
;
1705 pc
->tend
= pc
->p
- 1;
1706 pc
->tt
= JIM_TT_ESC
;
1714 if (pc
->state
== JIM_PS_DEF
) {
1715 pc
->tend
= pc
->p
- 1;
1716 pc
->tt
= JIM_TT_ESC
;
1719 else if (*pc
->p
== '\n') {
1724 if (pc
->state
== JIM_PS_QUOTE
) {
1725 pc
->tend
= pc
->p
- 1;
1726 pc
->tt
= JIM_TT_ESC
;
1729 pc
->state
= JIM_PS_DEF
;
1737 return JIM_OK
; /* unreached */
1740 static int JimParseComment(struct JimParserCtx
*pc
)
1743 if (*pc
->p
== '\\') {
1747 pc
->missing
.ch
= '\\';
1750 if (*pc
->p
== '\n') {
1754 else if (*pc
->p
== '\n') {
1766 /* xdigitval and odigitval are helper functions for JimEscape() */
1767 static int xdigitval(int c
)
1769 if (c
>= '0' && c
<= '9')
1771 if (c
>= 'a' && c
<= 'f')
1772 return c
- 'a' + 10;
1773 if (c
>= 'A' && c
<= 'F')
1774 return c
- 'A' + 10;
1778 static int odigitval(int c
)
1780 if (c
>= '0' && c
<= '7')
1785 /* Perform Tcl escape substitution of 's', storing the result
1786 * string into 'dest'. The escaped string is guaranteed to
1787 * be the same length or shorted than the source string.
1788 * Slen is the length of the string at 's', if it's -1 the string
1789 * length will be calculated by the function.
1791 * The function returns the length of the resulting string. */
1792 static int JimEscape(char *dest
, const char *s
, int slen
)
1800 for (i
= 0; i
< slen
; i
++) {
1831 /* A unicode or hex sequence.
1832 * \x Expect 1-2 hex chars and convert to hex.
1833 * \u Expect 1-4 hex chars and convert to utf-8.
1834 * \U Expect 1-8 hex chars and convert to utf-8.
1835 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1836 * An invalid sequence means simply the escaped char.
1848 else if (s
[i
] == 'u') {
1849 if (s
[i
+ 1] == '{') {
1858 for (k
= 0; k
< maxchars
; k
++) {
1859 int c
= xdigitval(s
[i
+ k
+ 1]);
1863 val
= (val
<< 4) | c
;
1865 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1867 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1873 /* Skip the closing brace */
1878 /* Got a valid sequence, so convert */
1883 p
+= utf8_fromunicode(p
, val
);
1888 /* Not a valid codepoint, just an escaped char */
1901 /* Replace all spaces and tabs after backslash newline with a single space*/
1905 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1918 int c
= odigitval(s
[i
+ 1]);
1921 c
= odigitval(s
[i
+ 2]);
1927 val
= (val
* 8) + c
;
1928 c
= odigitval(s
[i
+ 3]);
1934 val
= (val
* 8) + c
;
1955 /* Returns a dynamically allocated copy of the current token in the
1956 * parser context. The function performs conversion of escapes if
1957 * the token is of type JIM_TT_ESC.
1959 * Note that after the conversion, tokens that are grouped with
1960 * braces in the source code, are always recognizable from the
1961 * identical string obtained in a different way from the type.
1963 * For example the string:
1967 * will return as first token "*", of type JIM_TT_STR
1973 * will return as first token "*", of type JIM_TT_ESC
1975 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
1977 const char *start
, *end
;
1985 token
= Jim_Alloc(1);
1989 len
= (end
- start
) + 1;
1990 token
= Jim_Alloc(len
+ 1);
1991 if (pc
->tt
!= JIM_TT_ESC
) {
1992 /* No escape conversion needed? Just copy it. */
1993 memcpy(token
, start
, len
);
1997 /* Else convert the escape chars. */
1998 len
= JimEscape(token
, start
, len
);
2002 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
2005 /* Parses the given string to determine if it represents a complete script.
2007 * This is useful for interactive shells implementation, for [info complete].
2009 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2010 * '{' on scripts incomplete missing one or more '}' to be balanced.
2011 * '[' on scripts incomplete missing one or more ']' to be balanced.
2012 * '"' on scripts incomplete missing a '"' char.
2013 * '\\' on scripts with a trailing backslash.
2015 * If the script is complete, 1 is returned, otherwise 0.
2017 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
2019 struct JimParserCtx parser
;
2021 JimParserInit(&parser
, s
, len
, 1);
2022 while (!parser
.eof
) {
2023 JimParseScript(&parser
);
2026 *stateCharPtr
= parser
.missing
.ch
;
2028 return parser
.missing
.ch
== ' ';
2031 /* -----------------------------------------------------------------------------
2033 * ---------------------------------------------------------------------------*/
2034 static int JimParseListSep(struct JimParserCtx
*pc
);
2035 static int JimParseListStr(struct JimParserCtx
*pc
);
2036 static int JimParseListQuote(struct JimParserCtx
*pc
);
2038 static int JimParseList(struct JimParserCtx
*pc
)
2040 if (isspace(UCHAR(*pc
->p
))) {
2041 return JimParseListSep(pc
);
2045 return JimParseListQuote(pc
);
2048 return JimParseBrace(pc
);
2052 return JimParseListStr(pc
);
2057 pc
->tstart
= pc
->tend
= pc
->p
;
2058 pc
->tline
= pc
->linenr
;
2059 pc
->tt
= JIM_TT_EOL
;
2064 static int JimParseListSep(struct JimParserCtx
*pc
)
2067 pc
->tline
= pc
->linenr
;
2068 while (isspace(UCHAR(*pc
->p
))) {
2069 if (*pc
->p
== '\n') {
2075 pc
->tend
= pc
->p
- 1;
2076 pc
->tt
= JIM_TT_SEP
;
2080 static int JimParseListQuote(struct JimParserCtx
*pc
)
2086 pc
->tline
= pc
->linenr
;
2087 pc
->tt
= JIM_TT_STR
;
2092 pc
->tt
= JIM_TT_ESC
;
2093 if (--pc
->len
== 0) {
2094 /* Trailing backslash */
2104 pc
->tend
= pc
->p
- 1;
2113 pc
->tend
= pc
->p
- 1;
2117 static int JimParseListStr(struct JimParserCtx
*pc
)
2120 pc
->tline
= pc
->linenr
;
2121 pc
->tt
= JIM_TT_STR
;
2124 if (isspace(UCHAR(*pc
->p
))) {
2125 pc
->tend
= pc
->p
- 1;
2128 if (*pc
->p
== '\\') {
2129 if (--pc
->len
== 0) {
2130 /* Trailing backslash */
2134 pc
->tt
= JIM_TT_ESC
;
2140 pc
->tend
= pc
->p
- 1;
2144 /* -----------------------------------------------------------------------------
2145 * Jim_Obj related functions
2146 * ---------------------------------------------------------------------------*/
2148 /* Return a new initialized object. */
2149 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2153 /* -- Check if there are objects in the free list -- */
2154 if (interp
->freeList
!= NULL
) {
2155 /* -- Unlink the object from the free list -- */
2156 objPtr
= interp
->freeList
;
2157 interp
->freeList
= objPtr
->nextObjPtr
;
2160 /* -- No ready to use objects: allocate a new one -- */
2161 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2164 /* Object is returned with refCount of 0. Every
2165 * kind of GC implemented should take care to don't try
2166 * to scan objects with refCount == 0. */
2167 objPtr
->refCount
= 0;
2168 /* All the other fields are left not initialized to save time.
2169 * The caller will probably want to set them to the right
2172 /* -- Put the object into the live list -- */
2173 objPtr
->prevObjPtr
= NULL
;
2174 objPtr
->nextObjPtr
= interp
->liveList
;
2175 if (interp
->liveList
)
2176 interp
->liveList
->prevObjPtr
= objPtr
;
2177 interp
->liveList
= objPtr
;
2182 /* Free an object. Actually objects are never freed, but
2183 * just moved to the free objects list, where they will be
2184 * reused by Jim_NewObj(). */
2185 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2187 /* Check if the object was already freed, panic. */
2188 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2189 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2191 /* Free the internal representation */
2192 Jim_FreeIntRep(interp
, objPtr
);
2193 /* Free the string representation */
2194 if (objPtr
->bytes
!= NULL
) {
2195 if (objPtr
->bytes
!= JimEmptyStringRep
)
2196 Jim_Free(objPtr
->bytes
);
2198 /* Unlink the object from the live objects list */
2199 if (objPtr
->prevObjPtr
)
2200 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2201 if (objPtr
->nextObjPtr
)
2202 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2203 if (interp
->liveList
== objPtr
)
2204 interp
->liveList
= objPtr
->nextObjPtr
;
2205 #ifdef JIM_DISABLE_OBJECT_POOL
2208 /* Link the object into the free objects list */
2209 objPtr
->prevObjPtr
= NULL
;
2210 objPtr
->nextObjPtr
= interp
->freeList
;
2211 if (interp
->freeList
)
2212 interp
->freeList
->prevObjPtr
= objPtr
;
2213 interp
->freeList
= objPtr
;
2214 objPtr
->refCount
= -1;
2218 /* Invalidate the string representation of an object. */
2219 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2221 if (objPtr
->bytes
!= NULL
) {
2222 if (objPtr
->bytes
!= JimEmptyStringRep
)
2223 Jim_Free(objPtr
->bytes
);
2225 objPtr
->bytes
= NULL
;
2228 /* Duplicate an object. The returned object has refcount = 0. */
2229 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2233 dupPtr
= Jim_NewObj(interp
);
2234 if (objPtr
->bytes
== NULL
) {
2235 /* Object does not have a valid string representation. */
2236 dupPtr
->bytes
= NULL
;
2238 else if (objPtr
->length
== 0) {
2239 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2240 dupPtr
->bytes
= JimEmptyStringRep
;
2242 dupPtr
->typePtr
= NULL
;
2246 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2247 dupPtr
->length
= objPtr
->length
;
2248 /* Copy the null byte too */
2249 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2252 /* By default, the new object has the same type as the old object */
2253 dupPtr
->typePtr
= objPtr
->typePtr
;
2254 if (objPtr
->typePtr
!= NULL
) {
2255 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2256 dupPtr
->internalRep
= objPtr
->internalRep
;
2259 /* The dup proc may set a different type, e.g. NULL */
2260 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2266 /* Return the string representation for objPtr. If the object's
2267 * string representation is invalid, calls the updateStringProc method to create
2268 * a new one from the internal representation of the object.
2270 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2272 if (objPtr
->bytes
== NULL
) {
2273 /* Invalid string repr. Generate it. */
2274 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2275 objPtr
->typePtr
->updateStringProc(objPtr
);
2278 *lenPtr
= objPtr
->length
;
2279 return objPtr
->bytes
;
2282 /* Just returns the length of the object's string rep */
2283 int Jim_Length(Jim_Obj
*objPtr
)
2285 if (objPtr
->bytes
== NULL
) {
2286 /* Invalid string repr. Generate it. */
2287 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2288 objPtr
->typePtr
->updateStringProc(objPtr
);
2290 return objPtr
->length
;
2293 /* Just returns object's string rep */
2294 const char *Jim_String(Jim_Obj
*objPtr
)
2296 if (objPtr
->bytes
== NULL
) {
2297 /* Invalid string repr. Generate it. */
2298 JimPanic((objPtr
->typePtr
== NULL
, "UpdateStringProc called against typeless value."));
2299 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2300 objPtr
->typePtr
->updateStringProc(objPtr
);
2302 return objPtr
->bytes
;
2305 static void JimSetStringBytes(Jim_Obj
*objPtr
, const char *str
)
2307 objPtr
->bytes
= Jim_StrDup(str
);
2308 objPtr
->length
= strlen(str
);
2311 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2312 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2314 static const Jim_ObjType dictSubstObjType
= {
2315 "dict-substitution",
2316 FreeDictSubstInternalRep
,
2317 DupDictSubstInternalRep
,
2322 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2324 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
2327 static const Jim_ObjType interpolatedObjType
= {
2329 FreeInterpolatedInternalRep
,
2335 /* -----------------------------------------------------------------------------
2337 * ---------------------------------------------------------------------------*/
2338 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2339 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2341 static const Jim_ObjType stringObjType
= {
2344 DupStringInternalRep
,
2346 JIM_TYPE_REFERENCES
,
2349 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2351 JIM_NOTUSED(interp
);
2353 /* This is a bit subtle: the only caller of this function
2354 * should be Jim_DuplicateObj(), that will copy the
2355 * string representaion. After the copy, the duplicated
2356 * object will not have more room in the buffer than
2357 * srcPtr->length bytes. So we just set it to length. */
2358 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
2359 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
2362 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2364 if (objPtr
->typePtr
!= &stringObjType
) {
2365 /* Get a fresh string representation. */
2366 if (objPtr
->bytes
== NULL
) {
2367 /* Invalid string repr. Generate it. */
2368 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2369 objPtr
->typePtr
->updateStringProc(objPtr
);
2371 /* Free any other internal representation. */
2372 Jim_FreeIntRep(interp
, objPtr
);
2373 /* Set it as string, i.e. just set the maxLength field. */
2374 objPtr
->typePtr
= &stringObjType
;
2375 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
2376 /* Don't know the utf-8 length yet */
2377 objPtr
->internalRep
.strValue
.charLength
= -1;
2383 * Returns the length of the object string in chars, not bytes.
2385 * These may be different for a utf-8 string.
2387 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2390 SetStringFromAny(interp
, objPtr
);
2392 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
2393 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
2395 return objPtr
->internalRep
.strValue
.charLength
;
2397 return Jim_Length(objPtr
);
2401 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2402 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
2404 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2406 /* Need to find out how many bytes the string requires */
2409 /* Alloc/Set the string rep. */
2411 objPtr
->bytes
= JimEmptyStringRep
;
2414 objPtr
->bytes
= Jim_Alloc(len
+ 1);
2415 memcpy(objPtr
->bytes
, s
, len
);
2416 objPtr
->bytes
[len
] = '\0';
2418 objPtr
->length
= len
;
2420 /* No typePtr field for the vanilla string object. */
2421 objPtr
->typePtr
= NULL
;
2425 /* charlen is in characters -- see also Jim_NewStringObj() */
2426 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
2429 /* Need to find out how many bytes the string requires */
2430 int bytelen
= utf8_index(s
, charlen
);
2432 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
2434 /* Remember the utf8 length, so set the type */
2435 objPtr
->typePtr
= &stringObjType
;
2436 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
2437 objPtr
->internalRep
.strValue
.charLength
= charlen
;
2441 return Jim_NewStringObj(interp
, s
, charlen
);
2445 /* This version does not try to duplicate the 's' pointer, but
2446 * use it directly. */
2447 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2449 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2452 objPtr
->length
= (len
== -1) ? strlen(s
) : len
;
2453 objPtr
->typePtr
= NULL
;
2457 /* Low-level string append. Use it only against unshared objects
2458 * of type "string". */
2459 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2465 needlen
= objPtr
->length
+ len
;
2466 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2467 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2469 /* Inefficient to malloc() for less than 8 bytes */
2473 if (objPtr
->bytes
== JimEmptyStringRep
) {
2474 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
2477 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
2479 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
2481 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2482 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2484 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
2485 /* Update the utf-8 char length */
2486 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
2488 objPtr
->length
+= len
;
2491 /* Higher level API to append strings to objects.
2492 * Object must not be unshared for each of these.
2494 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2496 JimPanic((Jim_IsShared(objPtr
), "Jim_AppendString called with shared object"));
2497 SetStringFromAny(interp
, objPtr
);
2498 StringAppendString(objPtr
, str
, len
);
2501 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2504 const char *str
= Jim_GetString(appendObjPtr
, &len
);
2505 Jim_AppendString(interp
, objPtr
, str
, len
);
2508 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2512 SetStringFromAny(interp
, objPtr
);
2513 va_start(ap
, objPtr
);
2515 const char *s
= va_arg(ap
, const char *);
2519 Jim_AppendString(interp
, objPtr
, s
, -1);
2524 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
2526 if (aObjPtr
== bObjPtr
) {
2531 const char *sA
= Jim_GetString(aObjPtr
, &Alen
);
2532 const char *sB
= Jim_GetString(bObjPtr
, &Blen
);
2534 return Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0;
2539 * Note. Does not support embedded nulls in either the pattern or the object.
2541 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2543 return JimGlobMatch(Jim_String(patternObjPtr
), Jim_String(objPtr
), nocase
);
2547 * Note: does not support embedded nulls for the nocase option.
2549 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2552 const char *s1
= Jim_GetString(firstObjPtr
, &l1
);
2553 const char *s2
= Jim_GetString(secondObjPtr
, &l2
);
2556 /* Do a character compare for nocase */
2557 return JimStringCompareLen(s1
, s2
, -1, nocase
);
2559 return JimStringCompare(s1
, l1
, s2
, l2
);
2563 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2565 * Note: does not support embedded nulls
2567 int Jim_StringCompareLenObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2569 const char *s1
= Jim_String(firstObjPtr
);
2570 const char *s2
= Jim_String(secondObjPtr
);
2572 return JimStringCompareLen(s1
, s2
, Jim_Utf8Length(interp
, firstObjPtr
), nocase
);
2575 /* Convert a range, as returned by Jim_GetRange(), into
2576 * an absolute index into an object of the specified length.
2577 * This function may return negative values, or values
2578 * greater than or equal to the length of the list if the index
2579 * is out of range. */
2580 static int JimRelToAbsIndex(int len
, int idx
)
2587 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2588 * into a form suitable for implementation of commands like [string range] and [lrange].
2590 * The resulting range is guaranteed to address valid elements of
2593 static void JimRelToAbsRange(int len
, int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2597 if (*firstPtr
> *lastPtr
) {
2601 rangeLen
= *lastPtr
- *firstPtr
+ 1;
2603 if (*firstPtr
< 0) {
2604 rangeLen
+= *firstPtr
;
2607 if (*lastPtr
>= len
) {
2608 rangeLen
-= (*lastPtr
- (len
- 1));
2616 *rangeLenPtr
= rangeLen
;
2619 static int JimStringGetRange(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
,
2620 int len
, int *first
, int *last
, int *range
)
2622 if (Jim_GetIndex(interp
, firstObjPtr
, first
) != JIM_OK
) {
2625 if (Jim_GetIndex(interp
, lastObjPtr
, last
) != JIM_OK
) {
2628 *first
= JimRelToAbsIndex(len
, *first
);
2629 *last
= JimRelToAbsIndex(len
, *last
);
2630 JimRelToAbsRange(len
, first
, last
, range
);
2634 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
2635 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2642 str
= Jim_GetString(strObjPtr
, &bytelen
);
2644 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, bytelen
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2648 if (first
== 0 && rangeLen
== bytelen
) {
2651 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2654 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2655 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2663 str
= Jim_GetString(strObjPtr
, &bytelen
);
2664 len
= Jim_Utf8Length(interp
, strObjPtr
);
2666 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2670 if (first
== 0 && rangeLen
== len
) {
2673 if (len
== bytelen
) {
2674 /* ASCII optimisation */
2675 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2677 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
2679 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
2683 Jim_Obj
*JimStringReplaceObj(Jim_Interp
*interp
,
2684 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
, Jim_Obj
*newStrObj
)
2691 len
= Jim_Utf8Length(interp
, strObjPtr
);
2693 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2701 str
= Jim_String(strObjPtr
);
2704 objPtr
= Jim_NewStringObjUtf8(interp
, str
, first
);
2708 Jim_AppendObj(interp
, objPtr
, newStrObj
);
2712 Jim_AppendString(interp
, objPtr
, str
+ utf8_index(str
, last
+ 1), len
- last
- 1);
2718 * Note: does not support embedded nulls.
2720 static void JimStrCopyUpperLower(char *dest
, const char *str
, int uc
)
2724 str
+= utf8_tounicode(str
, &c
);
2725 dest
+= utf8_getchars(dest
, uc
? utf8_upper(c
) : utf8_lower(c
));
2731 * Note: does not support embedded nulls.
2733 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2739 SetStringFromAny(interp
, strObjPtr
);
2741 str
= Jim_GetString(strObjPtr
, &len
);
2744 /* Case mapping can change the utf-8 length of the string.
2745 * But at worst it will be by one extra byte per char
2749 buf
= Jim_Alloc(len
+ 1);
2750 JimStrCopyUpperLower(buf
, str
, 0);
2751 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2755 * Note: does not support embedded nulls.
2757 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2763 if (strObjPtr
->typePtr
!= &stringObjType
) {
2764 SetStringFromAny(interp
, strObjPtr
);
2767 str
= Jim_GetString(strObjPtr
, &len
);
2770 /* Case mapping can change the utf-8 length of the string.
2771 * But at worst it will be by one extra byte per char
2775 buf
= Jim_Alloc(len
+ 1);
2776 JimStrCopyUpperLower(buf
, str
, 1);
2777 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2781 * Note: does not support embedded nulls.
2783 static Jim_Obj
*JimStringToTitle(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2790 str
= Jim_GetString(strObjPtr
, &len
);
2795 /* Case mapping can change the utf-8 length of the string.
2796 * But at worst it will be by one extra byte per char
2800 buf
= p
= Jim_Alloc(len
+ 1);
2802 str
+= utf8_tounicode(str
, &c
);
2803 p
+= utf8_getchars(p
, utf8_title(c
));
2805 JimStrCopyUpperLower(p
, str
, 0);
2807 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2810 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2811 * for unicode character 'c'.
2812 * Returns the position if found or NULL if not
2814 static const char *utf8_memchr(const char *str
, int len
, int c
)
2819 int n
= utf8_tounicode(str
, &sc
);
2828 return memchr(str
, c
, len
);
2833 * Searches for the first non-trim char in string (str, len)
2835 * If none is found, returns just past the last char.
2837 * Lengths are in bytes.
2839 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
2843 int n
= utf8_tounicode(str
, &c
);
2845 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2846 /* Not a trim char, so stop */
2856 * Searches backwards for a non-trim char in string (str, len).
2858 * Returns a pointer to just after the non-trim char, or NULL if not found.
2860 * Lengths are in bytes.
2862 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
2868 int n
= utf8_prev_len(str
, len
);
2873 n
= utf8_tounicode(str
, &c
);
2875 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2883 static const char default_trim_chars
[] = " \t\n\r";
2884 /* sizeof() here includes the null byte */
2885 static int default_trim_chars_len
= sizeof(default_trim_chars
);
2887 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2890 const char *str
= Jim_GetString(strObjPtr
, &len
);
2891 const char *trimchars
= default_trim_chars
;
2892 int trimcharslen
= default_trim_chars_len
;
2895 if (trimcharsObjPtr
) {
2896 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2899 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
2900 if (newstr
== str
) {
2904 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
2907 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2910 const char *trimchars
= default_trim_chars
;
2911 int trimcharslen
= default_trim_chars_len
;
2912 const char *nontrim
;
2914 if (trimcharsObjPtr
) {
2915 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2918 SetStringFromAny(interp
, strObjPtr
);
2920 len
= Jim_Length(strObjPtr
);
2921 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
2923 if (nontrim
== NULL
) {
2924 /* All trim, so return a zero-length string */
2925 return Jim_NewEmptyStringObj(interp
);
2927 if (nontrim
== strObjPtr
->bytes
+ len
) {
2928 /* All non-trim, so return the original object */
2932 if (Jim_IsShared(strObjPtr
)) {
2933 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
2936 /* Can modify this string in place */
2937 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
2938 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
2944 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2946 /* First trim left. */
2947 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
2949 /* Now trim right */
2950 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
2952 /* Note: refCount check is needed since objPtr may be emptyObj */
2953 if (objPtr
!= strObjPtr
&& objPtr
->refCount
== 0) {
2954 /* We don't want this object to be leaked */
2955 Jim_FreeNewObj(interp
, objPtr
);
2961 /* Some platforms don't have isascii - need a non-macro version */
2963 #define jim_isascii isascii
2965 static int jim_isascii(int c
)
2967 return !(c
& ~0x7f);
2971 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2973 static const char * const strclassnames
[] = {
2974 "integer", "alpha", "alnum", "ascii", "digit",
2975 "double", "lower", "upper", "space", "xdigit",
2976 "control", "print", "graph", "punct",
2980 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2981 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2982 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
2988 int (*isclassfunc
)(int c
) = NULL
;
2990 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2994 str
= Jim_GetString(strObjPtr
, &len
);
2996 Jim_SetResultBool(interp
, !strict
);
3001 case STR_IS_INTEGER
:
3004 Jim_SetResultBool(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
3011 Jim_SetResultBool(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
3015 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
3016 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
3017 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
3018 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
3019 case STR_IS_LOWER
: isclassfunc
= islower
; break;
3020 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
3021 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
3022 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
3023 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
3024 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
3025 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
3026 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3031 for (i
= 0; i
< len
; i
++) {
3032 if (!isclassfunc(str
[i
])) {
3033 Jim_SetResultBool(interp
, 0);
3037 Jim_SetResultBool(interp
, 1);
3041 /* -----------------------------------------------------------------------------
3042 * Compared String Object
3043 * ---------------------------------------------------------------------------*/
3045 /* This is strange object that allows comparison of a C literal string
3046 * with a Jim object in a very short time if the same comparison is done
3047 * multiple times. For example every time the [if] command is executed,
3048 * Jim has to check if a given argument is "else".
3049 * If the code has no errors, this comparison is true most of the time,
3050 * so we can cache the pointer of the string of the last matching
3051 * comparison inside the object. Because most C compilers perform literal sharing,
3052 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3053 * this works pretty well even if comparisons are at different places
3054 * inside the C code. */
3056 static const Jim_ObjType comparedStringObjType
= {
3061 JIM_TYPE_REFERENCES
,
3064 /* The only way this object is exposed to the API is via the following
3065 * function. Returns true if the string and the object string repr.
3066 * are the same, otherwise zero is returned.
3068 * Note: this isn't binary safe, but it hardly needs to be.*/
3069 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3071 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3075 const char *objStr
= Jim_String(objPtr
);
3077 if (strcmp(str
, objStr
) != 0)
3080 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3081 Jim_FreeIntRep(interp
, objPtr
);
3082 objPtr
->typePtr
= &comparedStringObjType
;
3084 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3089 static int qsortCompareStringPointers(const void *a
, const void *b
)
3091 char *const *sa
= (char *const *)a
;
3092 char *const *sb
= (char *const *)b
;
3094 return strcmp(*sa
, *sb
);
3098 /* -----------------------------------------------------------------------------
3101 * This object is just a string from the language point of view, but
3102 * the internal representation contains the filename and line number
3103 * where this token was read. This information is used by
3104 * Jim_EvalObj() if the object passed happens to be of type "source".
3106 * This allows propagation of the information about line numbers and file
3107 * names and gives error messages with absolute line numbers.
3109 * Note that this object uses the internal representation of the Jim_Object,
3110 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3112 * Also the object will be converted to something else if the given
3113 * token it represents in the source file is not something to be
3114 * evaluated (not a script), and will be specialized in some other way,
3115 * so the time overhead is also almost zero.
3116 * ---------------------------------------------------------------------------*/
3118 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3119 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3121 static const Jim_ObjType sourceObjType
= {
3123 FreeSourceInternalRep
,
3124 DupSourceInternalRep
,
3126 JIM_TYPE_REFERENCES
,
3129 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3131 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3134 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3136 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3137 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3140 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3141 Jim_Obj
*fileNameObj
, int lineNumber
)
3143 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3144 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3145 Jim_IncrRefCount(fileNameObj
);
3146 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3147 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3148 objPtr
->typePtr
= &sourceObjType
;
3151 /* -----------------------------------------------------------------------------
3154 * This object is used only in the Script internal represenation.
3155 * For each line of the script, it holds the number of tokens on the line
3156 * and the source line number.
3158 static const Jim_ObjType scriptLineObjType
= {
3166 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3170 #ifdef DEBUG_SHOW_SCRIPT
3172 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3173 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3175 objPtr
= Jim_NewEmptyStringObj(interp
);
3177 objPtr
->typePtr
= &scriptLineObjType
;
3178 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3179 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3184 /* -----------------------------------------------------------------------------
3187 * This object holds the parsed internal representation of a script.
3188 * This representation is help within an allocated ScriptObj (see below)
3190 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3191 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3192 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3193 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3195 static const Jim_ObjType scriptObjType
= {
3197 FreeScriptInternalRep
,
3198 DupScriptInternalRep
,
3200 JIM_TYPE_REFERENCES
,
3203 /* Each token of a script is represented by a ScriptToken.
3204 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3205 * can be specialized by commands operating on it.
3207 typedef struct ScriptToken
3213 /* This is the script object internal representation. An array of
3214 * ScriptToken structures, including a pre-computed representation of the
3215 * command length and arguments.
3217 * For example the script:
3220 * set $i $x$y [foo]BAR
3222 * will produce a ScriptObj with the following ScriptToken's:
3237 * "puts hello" has two args (LIN 2), composed of single tokens.
3238 * (Note that the WRD token is omitted for the common case of a single token.)
3240 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3241 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3243 * The precomputation of the command structure makes Jim_Eval() faster,
3244 * and simpler because there aren't dynamic lengths / allocations.
3246 * -- {expand}/{*} handling --
3248 * Expand is handled in a special way.
3250 * If a "word" begins with {*}, the word token count is -ve.
3252 * For example the command:
3256 * Will produce the following cmdstruct array:
3263 * Note that the 'LIN' token also contains the source information for the
3264 * first word of the line for error reporting purposes
3266 * -- the substFlags field of the structure --
3268 * The scriptObj structure is used to represent both "script" objects
3269 * and "subst" objects. In the second case, there are no LIN and WRD
3270 * tokens. Instead SEP and EOL tokens are added as-is.
3271 * In addition, the field 'substFlags' is used to represent the flags used to turn
3272 * the string into the internal representation.
3273 * If these flags do not match what the application requires,
3274 * the scriptObj is created again. For example the script:
3276 * subst -nocommands $string
3277 * subst -novariables $string
3279 * Will (re)create the internal representation of the $string object
3282 typedef struct ScriptObj
3284 ScriptToken
*token
; /* Tokens array. */
3285 Jim_Obj
*fileNameObj
; /* Filename */
3286 int len
; /* Length of token[] */
3287 int substFlags
; /* flags used for the compilation of "subst" objects */
3288 int inUse
; /* Used to share a ScriptObj. Currently
3289 only used by Jim_EvalObj() as protection against
3290 shimmering of the currently evaluated object. */
3291 int firstline
; /* Line number of the first line */
3292 int linenr
; /* Error line number, if any */
3293 int missing
; /* Missing char if script failed to parse, (or space or backslash if OK) */
3296 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3299 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3301 if (--script
->inUse
!= 0)
3303 for (i
= 0; i
< script
->len
; i
++) {
3304 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3306 Jim_Free(script
->token
);
3307 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3311 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3313 JIM_NOTUSED(interp
);
3314 JIM_NOTUSED(srcPtr
);
3316 /* Just return a simple string. We don't try to preserve the source info
3317 * since in practice scripts are never duplicated
3319 dupPtr
->typePtr
= NULL
;
3322 /* A simple parse token.
3323 * As the script is parsed, the created tokens point into the script string rep.
3327 const char *token
; /* Pointer to the start of the token */
3328 int len
; /* Length of this token */
3329 int type
; /* Token type */
3330 int line
; /* Line number */
3333 /* A list of parsed tokens representing a script.
3334 * Tokens are added to this list as the script is parsed.
3335 * It grows as needed.
3339 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3340 ParseToken
*list
; /* Array of tokens */
3341 int size
; /* Current size of the list */
3342 int count
; /* Number of entries used */
3343 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3346 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3348 tokenlist
->list
= tokenlist
->static_list
;
3349 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3350 tokenlist
->count
= 0;
3353 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3355 if (tokenlist
->list
!= tokenlist
->static_list
) {
3356 Jim_Free(tokenlist
->list
);
3361 * Adds the new token to the tokenlist.
3362 * The token has the given length, type and line number.
3363 * The token list is resized as necessary.
3365 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3370 if (tokenlist
->count
== tokenlist
->size
) {
3371 /* Resize the list */
3372 tokenlist
->size
*= 2;
3373 if (tokenlist
->list
!= tokenlist
->static_list
) {
3375 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3378 /* The list needs to become allocated */
3379 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3380 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3381 tokenlist
->count
* sizeof(*tokenlist
->list
));
3384 t
= &tokenlist
->list
[tokenlist
->count
++];
3391 /* Counts the number of adjoining non-separator tokens.
3393 * Returns -ve if the first token is the expansion
3394 * operator (in which case the count doesn't include
3397 static int JimCountWordTokens(ParseToken
*t
)
3402 /* Is the first word {*} or {expand}? */
3403 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3404 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3405 /* Create an expand token */
3411 /* Now count non-separator words */
3412 while (!TOKEN_IS_SEP(t
->type
)) {
3417 return count
* expand
;
3421 * Create a script/subst object from the given token.
3423 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3427 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3428 /* Convert backlash escapes. The result will never be longer than the original */
3430 char *str
= Jim_Alloc(len
+ 1);
3431 len
= JimEscape(str
, t
->token
, len
);
3432 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3435 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3436 * with a single space.
3438 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3444 * Takes a tokenlist and creates the allocated list of script tokens
3445 * in script->token, of length script->len.
3447 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3450 * Also sets script->line to the line number of the first token
3452 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3453 ParseTokenList
*tokenlist
)
3456 struct ScriptToken
*token
;
3457 /* Number of tokens so far for the current command */
3459 /* This is the first token for the current command */
3460 ScriptToken
*linefirst
;
3464 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3465 printf("==== Tokens ====\n");
3466 for (i
= 0; i
< tokenlist
->count
; i
++) {
3467 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3468 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3472 /* May need up to one extra script token for each EOL in the worst case */
3473 count
= tokenlist
->count
;
3474 for (i
= 0; i
< tokenlist
->count
; i
++) {
3475 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3479 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3481 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3483 /* This is the first token for the current command */
3484 linefirst
= token
++;
3486 for (i
= 0; i
< tokenlist
->count
; ) {
3487 /* Look ahead to find out how many tokens make up the next word */
3490 /* Skip any leading separators */
3491 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3495 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3497 if (wordtokens
== 0) {
3498 /* None, so at end of line */
3500 linefirst
->type
= JIM_TT_LINE
;
3501 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3502 Jim_IncrRefCount(linefirst
->objPtr
);
3504 /* Reset for new line */
3506 linefirst
= token
++;
3511 else if (wordtokens
!= 1) {
3512 /* More than 1, or {*}, so insert a WORD token */
3513 token
->type
= JIM_TT_WORD
;
3514 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3515 Jim_IncrRefCount(token
->objPtr
);
3517 if (wordtokens
< 0) {
3518 /* Skip the expand token */
3520 wordtokens
= -wordtokens
- 1;
3525 if (lineargs
== 0) {
3526 /* First real token on the line, so record the line number */
3527 linenr
= tokenlist
->list
[i
].line
;
3531 /* Add each non-separator word token to the line */
3532 while (wordtokens
--) {
3533 const ParseToken
*t
= &tokenlist
->list
[i
++];
3535 token
->type
= t
->type
;
3536 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3537 Jim_IncrRefCount(token
->objPtr
);
3539 /* Every object is initially a string of type 'source', but the
3540 * internal type may be specialized during execution of the
3542 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3547 if (lineargs
== 0) {
3551 script
->len
= token
- script
->token
;
3553 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3555 #ifdef DEBUG_SHOW_SCRIPT
3556 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3557 for (i
= 0; i
< script
->len
; i
++) {
3558 const ScriptToken
*t
= &script
->token
[i
];
3559 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3566 * Sets an appropriate error message for a missing script/expression terminator.
3568 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3570 * Note that a trailing backslash is not considered to be an error.
3572 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3582 msg
= "unmatched \"[\"";
3585 msg
= "missing close-brace";
3589 msg
= "missing quote";
3593 Jim_SetResultString(interp
, msg
, -1);
3598 * Similar to ScriptObjAddTokens(), but for subst objects.
3600 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3601 ParseTokenList
*tokenlist
)
3604 struct ScriptToken
*token
;
3606 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3608 for (i
= 0; i
< tokenlist
->count
; i
++) {
3609 const ParseToken
*t
= &tokenlist
->list
[i
];
3611 /* Create a token for 't' */
3612 token
->type
= t
->type
;
3613 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3614 Jim_IncrRefCount(token
->objPtr
);
3621 /* This method takes the string representation of an object
3622 * as a Tcl script, and generates the pre-parsed internal representation
3625 * On parse error, sets an error message and returns JIM_ERR
3626 * (Note: the object is still converted to a script, even if an error occurs)
3628 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3631 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3632 struct JimParserCtx parser
;
3633 struct ScriptObj
*script
;
3634 ParseTokenList tokenlist
;
3637 /* Try to get information about filename / line number */
3638 if (objPtr
->typePtr
== &sourceObjType
) {
3639 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3642 /* Initially parse the script into tokens (in tokenlist) */
3643 ScriptTokenListInit(&tokenlist
);
3645 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3646 while (!parser
.eof
) {
3647 JimParseScript(&parser
);
3648 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3652 /* Add a final EOF token */
3653 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3655 /* Create the "real" script tokens from the parsed tokens */
3656 script
= Jim_Alloc(sizeof(*script
));
3657 memset(script
, 0, sizeof(*script
));
3659 if (objPtr
->typePtr
== &sourceObjType
) {
3660 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3663 script
->fileNameObj
= interp
->emptyObj
;
3665 Jim_IncrRefCount(script
->fileNameObj
);
3666 script
->missing
= parser
.missing
.ch
;
3667 script
->linenr
= parser
.missing
.line
;
3669 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3671 /* No longer need the token list */
3672 ScriptTokenListFree(&tokenlist
);
3674 /* Free the old internal rep and set the new one. */
3675 Jim_FreeIntRep(interp
, objPtr
);
3676 Jim_SetIntRepPtr(objPtr
, script
);
3677 objPtr
->typePtr
= &scriptObjType
;
3680 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
);
3683 * Returns the parsed script.
3684 * Note that if there is any possibility that the script is not valid,
3685 * call JimScriptValid() to check
3687 ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3689 if (objPtr
== interp
->emptyObj
) {
3690 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3691 objPtr
= interp
->nullScriptObj
;
3694 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3695 JimSetScriptFromAny(interp
, objPtr
);
3698 return (ScriptObj
*)Jim_GetIntRepPtr(objPtr
);
3702 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3703 * and leaves an error message in the interp result.
3706 static int JimScriptValid(Jim_Interp
*interp
, ScriptObj
*script
)
3708 if (JimParseCheckMissing(interp
, script
->missing
) == JIM_ERR
) {
3709 JimAddErrorToStack(interp
, script
);
3716 /* -----------------------------------------------------------------------------
3718 * ---------------------------------------------------------------------------*/
3719 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3724 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3726 if (--cmdPtr
->inUse
== 0) {
3727 if (cmdPtr
->isproc
) {
3728 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3729 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3730 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3731 if (cmdPtr
->u
.proc
.staticVars
) {
3732 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3733 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3738 if (cmdPtr
->u
.native
.delProc
) {
3739 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3742 if (cmdPtr
->prevCmd
) {
3743 /* Delete any pushed command too */
3744 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3750 /* Variables HashTable Type.
3752 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3755 /* Variables HashTable Type.
3757 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3758 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3760 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3764 static const Jim_HashTableType JimVariablesHashTableType
= {
3765 JimStringCopyHTHashFunction
, /* hash function */
3766 JimStringCopyHTDup
, /* key dup */
3768 JimStringCopyHTKeyCompare
, /* key compare */
3769 JimStringCopyHTKeyDestructor
, /* key destructor */
3770 JimVariablesHTValDestructor
/* val destructor */
3773 /* Commands HashTable Type.
3775 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3777 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3779 JimDecrCmdRefCount(interp
, val
);
3782 static const Jim_HashTableType JimCommandsHashTableType
= {
3783 JimStringCopyHTHashFunction
, /* hash function */
3784 JimStringCopyHTDup
, /* key dup */
3786 JimStringCopyHTKeyCompare
, /* key compare */
3787 JimStringCopyHTKeyDestructor
, /* key destructor */
3788 JimCommandsHT_ValDestructor
/* val destructor */
3791 /* ------------------------- Commands related functions --------------------- */
3793 #ifdef jim_ext_namespace
3795 * Returns the "unscoped" version of the given namespace.
3796 * That is, the fully qualified name without the leading ::
3797 * The returned value is either nsObj, or an object with a zero ref count.
3799 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3801 const char *name
= Jim_String(nsObj
);
3802 if (name
[0] == ':' && name
[1] == ':') {
3803 /* This command is being defined in the global namespace */
3804 while (*++name
== ':') {
3806 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3808 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3809 /* This command is being defined in a non-global namespace */
3810 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3811 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3816 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3820 const char *name
= Jim_String(nameObjPtr
);
3821 if (name
[0] == ':' && name
[1] == ':') {
3824 Jim_IncrRefCount(nameObjPtr
);
3825 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3826 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3827 Jim_DecrRefCount(interp
, nameObjPtr
);
3833 * An efficient version of JimQualifyNameObj() where the name is
3834 * available (and needed) as a 'const char *'.
3835 * Avoids creating an object if not necessary.
3836 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3838 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3840 Jim_Obj
*objPtr
= interp
->emptyObj
;
3842 if (name
[0] == ':' && name
[1] == ':') {
3843 /* This command is being defined in the global namespace */
3844 while (*++name
== ':') {
3847 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3848 /* This command is being defined in a non-global namespace */
3849 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3850 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3851 name
= Jim_String(objPtr
);
3853 Jim_IncrRefCount(objPtr
);
3854 *objPtrPtr
= objPtr
;
3858 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3861 /* We can be more efficient in the no-namespace case */
3862 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3863 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3865 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3871 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3873 /* It may already exist, so we try to delete the old one.
3874 * Note that reference count means that it won't be deleted yet if
3875 * it exists in the call stack.
3877 * BUT, if 'local' is in force, instead of deleting the existing
3878 * proc, we stash a reference to the old proc here.
3880 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3882 /* There was an old cmd with the same name,
3883 * so this requires a 'proc epoch' update. */
3885 /* If a procedure with the same name didn't exist there is no need
3886 * to increment the 'proc epoch' because creation of a new procedure
3887 * can never affect existing cached commands. We don't do
3888 * negative caching. */
3889 Jim_InterpIncrProcEpoch(interp
);
3892 if (he
&& interp
->local
) {
3893 /* Push this command over the top of the previous one */
3894 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3895 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3899 /* Replace the existing command */
3900 Jim_DeleteHashEntry(&interp
->commands
, name
);
3903 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3909 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3910 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
3912 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3914 /* Store the new details for this command */
3915 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3917 cmdPtr
->u
.native
.delProc
= delProc
;
3918 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3919 cmdPtr
->u
.native
.privData
= privData
;
3921 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3926 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3930 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3935 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3936 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3937 for (i
= 0; i
< len
; i
++) {
3938 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3942 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3943 /* Check if it's composed of two elements. */
3944 subLen
= Jim_ListLength(interp
, objPtr
);
3945 if (subLen
== 1 || subLen
== 2) {
3946 /* Try to get the variable value from the current
3948 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3950 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3951 if (initObjPtr
== NULL
) {
3952 Jim_SetResultFormatted(interp
,
3953 "variable for initialization of static \"%#s\" not found in the local context",
3959 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3961 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3965 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3966 varPtr
->objPtr
= initObjPtr
;
3967 Jim_IncrRefCount(initObjPtr
);
3968 varPtr
->linkFramePtr
= NULL
;
3969 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3970 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3971 Jim_SetResultFormatted(interp
,
3972 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3973 Jim_DecrRefCount(interp
, initObjPtr
);
3979 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
3987 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
3989 #ifdef jim_ext_namespace
3990 if (cmdPtr
->isproc
) {
3991 /* XXX: Really need JimNamespaceSplit() */
3992 const char *pt
= strrchr(cmdname
, ':');
3993 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
3994 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3995 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
3996 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
3998 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
3999 /* This commands shadows a global command, so a proc epoch update is required */
4000 Jim_InterpIncrProcEpoch(interp
);
4007 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
4008 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4014 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4016 /* Allocate space for both the command pointer and the arg list */
4017 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4018 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4021 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4022 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4023 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4024 cmdPtr
->u
.proc
.argsPos
= -1;
4025 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4026 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4027 Jim_IncrRefCount(argListObjPtr
);
4028 Jim_IncrRefCount(bodyObjPtr
);
4029 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4031 /* Create the statics hash table. */
4032 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4036 /* Parse the args out into arglist, validating as we go */
4037 /* Examine the argument list for default parameters and 'args' */
4038 for (i
= 0; i
< argListLen
; i
++) {
4040 Jim_Obj
*nameObjPtr
;
4041 Jim_Obj
*defaultObjPtr
;
4044 /* Examine a parameter */
4045 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4046 len
= Jim_ListLength(interp
, argPtr
);
4048 Jim_SetResultString(interp
, "argument with no name", -1);
4050 JimDecrCmdRefCount(interp
, cmdPtr
);
4054 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4059 /* Optional parameter */
4060 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4061 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4064 /* Required parameter */
4065 nameObjPtr
= argPtr
;
4066 defaultObjPtr
= NULL
;
4070 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4071 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4072 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4075 cmdPtr
->u
.proc
.argsPos
= i
;
4079 cmdPtr
->u
.proc
.optArity
++;
4082 cmdPtr
->u
.proc
.reqArity
++;
4086 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4087 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4093 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4096 Jim_Obj
*qualifiedNameObj
;
4097 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4099 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4100 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4104 Jim_InterpIncrProcEpoch(interp
);
4107 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4112 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4117 Jim_Obj
*qualifiedOldNameObj
;
4118 Jim_Obj
*qualifiedNewNameObj
;
4122 if (newName
[0] == 0) {
4123 return Jim_DeleteCommand(interp
, oldName
);
4126 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4127 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4129 /* Does it exist? */
4130 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4132 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4134 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4135 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4138 /* Add the new name first */
4139 cmdPtr
= Jim_GetHashEntryVal(he
);
4140 JimIncrCmdRefCount(cmdPtr
);
4141 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4142 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4144 /* Now remove the old name */
4145 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4147 /* Increment the epoch */
4148 Jim_InterpIncrProcEpoch(interp
);
4153 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4154 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4159 /* -----------------------------------------------------------------------------
4161 * ---------------------------------------------------------------------------*/
4163 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4165 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4168 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4170 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4171 dupPtr
->typePtr
= srcPtr
->typePtr
;
4172 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4175 static const Jim_ObjType commandObjType
= {
4177 FreeCommandInternalRep
,
4178 DupCommandInternalRep
,
4180 JIM_TYPE_REFERENCES
,
4183 /* This function returns the command structure for the command name
4184 * stored in objPtr. It tries to specialize the objPtr to contain
4185 * a cached info instead to perform the lookup into the hash table
4186 * every time. The information cached may not be uptodate, in such
4187 * a case the lookup is performed and the cache updated.
4189 * Respects the 'upcall' setting
4191 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4195 /* In order to be valid, the proc epoch must match and
4196 * the lookup must have occurred in the same namespace
4198 if (objPtr
->typePtr
!= &commandObjType
||
4199 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4200 #ifdef jim_ext_namespace
4201 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4204 /* Not cached or out of date, so lookup */
4206 /* Do we need to try the local namespace? */
4207 const char *name
= Jim_String(objPtr
);
4210 if (name
[0] == ':' && name
[1] == ':') {
4211 while (*++name
== ':') {
4214 #ifdef jim_ext_namespace
4215 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4216 /* This command is being defined in a non-global namespace */
4217 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4218 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4219 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4220 Jim_FreeNewObj(interp
, nameObj
);
4227 /* Lookup in the global namespace */
4228 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4230 if (flags
& JIM_ERRMSG
) {
4231 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4235 #ifdef jim_ext_namespace
4238 cmd
= Jim_GetHashEntryVal(he
);
4240 /* Free the old internal repr and set the new one. */
4241 Jim_FreeIntRep(interp
, objPtr
);
4242 objPtr
->typePtr
= &commandObjType
;
4243 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4244 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4245 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4246 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4249 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4251 while (cmd
->u
.proc
.upcall
) {
4257 /* -----------------------------------------------------------------------------
4259 * ---------------------------------------------------------------------------*/
4261 /* -----------------------------------------------------------------------------
4263 * ---------------------------------------------------------------------------*/
4265 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4267 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4269 static const Jim_ObjType variableObjType
= {
4274 JIM_TYPE_REFERENCES
,
4278 * Check that the name does not contain embedded nulls.
4280 * Variable and procedure names are manipulated as null terminated strings, so
4281 * don't allow names with embedded nulls.
4283 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4285 /* Variable names and proc names can't contain embedded nulls */
4286 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4288 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4289 if (memchr(str
, '\0', len
)) {
4290 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4297 /* This method should be called only by the variable API.
4298 * It returns JIM_OK on success (variable already exists),
4299 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4300 * a variable name, but syntax glue for [dict] i.e. the last
4301 * character is ')' */
4302 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4304 const char *varName
;
4305 Jim_CallFrame
*framePtr
;
4310 /* Check if the object is already an uptodate variable */
4311 if (objPtr
->typePtr
== &variableObjType
) {
4312 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4313 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4317 /* Need to re-resolve the variable in the updated callframe */
4319 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4320 return JIM_DICT_SUGAR
;
4322 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4327 varName
= Jim_GetString(objPtr
, &len
);
4329 /* Make sure it's not syntax glue to get/set dict. */
4330 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4331 return JIM_DICT_SUGAR
;
4334 if (varName
[0] == ':' && varName
[1] == ':') {
4335 while (*++varName
== ':') {
4338 framePtr
= interp
->topFramePtr
;
4342 framePtr
= interp
->framePtr
;
4345 /* Resolve this name in the variables hash table */
4346 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4348 if (!global
&& framePtr
->staticVars
) {
4349 /* Try with static vars. */
4350 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4357 /* Free the old internal repr and set the new one. */
4358 Jim_FreeIntRep(interp
, objPtr
);
4359 objPtr
->typePtr
= &variableObjType
;
4360 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4361 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4362 objPtr
->internalRep
.varValue
.global
= global
;
4366 /* -------------------- Variables related functions ------------------------- */
4367 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4368 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4370 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4373 Jim_CallFrame
*framePtr
;
4376 /* New variable to create */
4377 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4379 var
->objPtr
= valObjPtr
;
4380 Jim_IncrRefCount(valObjPtr
);
4381 var
->linkFramePtr
= NULL
;
4383 name
= Jim_String(nameObjPtr
);
4384 if (name
[0] == ':' && name
[1] == ':') {
4385 while (*++name
== ':') {
4387 framePtr
= interp
->topFramePtr
;
4391 framePtr
= interp
->framePtr
;
4395 /* Insert the new variable */
4396 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4398 /* Make the object int rep a variable */
4399 Jim_FreeIntRep(interp
, nameObjPtr
);
4400 nameObjPtr
->typePtr
= &variableObjType
;
4401 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4402 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4403 nameObjPtr
->internalRep
.varValue
.global
= global
;
4408 /* For now that's dummy. Variables lookup should be optimized
4409 * in many ways, with caching of lookups, and possibly with
4410 * a table of pre-allocated vars in every CallFrame for local vars.
4411 * All the caching should also have an 'epoch' mechanism similar
4412 * to the one used by Tcl for procedures lookup caching. */
4414 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4419 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4420 case JIM_DICT_SUGAR
:
4421 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4424 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4427 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4431 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4432 if (var
->linkFramePtr
== NULL
) {
4433 Jim_IncrRefCount(valObjPtr
);
4434 Jim_DecrRefCount(interp
, var
->objPtr
);
4435 var
->objPtr
= valObjPtr
;
4437 else { /* Else handle the link */
4438 Jim_CallFrame
*savedCallFrame
;
4440 savedCallFrame
= interp
->framePtr
;
4441 interp
->framePtr
= var
->linkFramePtr
;
4442 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4443 interp
->framePtr
= savedCallFrame
;
4451 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4453 Jim_Obj
*nameObjPtr
;
4456 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4457 Jim_IncrRefCount(nameObjPtr
);
4458 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4459 Jim_DecrRefCount(interp
, nameObjPtr
);
4463 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4465 Jim_CallFrame
*savedFramePtr
;
4468 savedFramePtr
= interp
->framePtr
;
4469 interp
->framePtr
= interp
->topFramePtr
;
4470 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4471 interp
->framePtr
= savedFramePtr
;
4475 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4477 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4480 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4481 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4482 Jim_IncrRefCount(nameObjPtr
);
4483 Jim_IncrRefCount(valObjPtr
);
4484 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4485 Jim_DecrRefCount(interp
, nameObjPtr
);
4486 Jim_DecrRefCount(interp
, valObjPtr
);
4490 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4491 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4493 const char *varName
;
4494 const char *targetName
;
4495 Jim_CallFrame
*framePtr
;
4498 /* Check for an existing variable or link */
4499 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4500 case JIM_DICT_SUGAR
:
4501 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4502 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4506 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4508 if (varPtr
->linkFramePtr
== NULL
) {
4509 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4513 /* It exists, but is a link, so first delete the link */
4514 varPtr
->linkFramePtr
= NULL
;
4518 /* Resolve the call frames for both variables */
4519 /* XXX: SetVariableFromAny() already did this! */
4520 varName
= Jim_String(nameObjPtr
);
4522 if (varName
[0] == ':' && varName
[1] == ':') {
4523 while (*++varName
== ':') {
4525 /* Linking a global var does nothing */
4526 framePtr
= interp
->topFramePtr
;
4529 framePtr
= interp
->framePtr
;
4532 targetName
= Jim_String(targetNameObjPtr
);
4533 if (targetName
[0] == ':' && targetName
[1] == ':') {
4534 while (*++targetName
== ':') {
4536 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4537 targetCallFrame
= interp
->topFramePtr
;
4539 Jim_IncrRefCount(targetNameObjPtr
);
4541 if (framePtr
->level
< targetCallFrame
->level
) {
4542 Jim_SetResultFormatted(interp
,
4543 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4545 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4549 /* Check for cycles. */
4550 if (framePtr
== targetCallFrame
) {
4551 Jim_Obj
*objPtr
= targetNameObjPtr
;
4553 /* Cycles are only possible with 'uplevel 0' */
4555 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4556 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4557 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4560 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4562 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4563 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4565 objPtr
= varPtr
->objPtr
;
4569 /* Perform the binding */
4570 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4571 /* We are now sure 'nameObjPtr' type is variableObjType */
4572 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4573 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4577 /* Return the Jim_Obj pointer associated with a variable name,
4578 * or NULL if the variable was not found in the current context.
4579 * The same optimization discussed in the comment to the
4580 * 'SetVariable' function should apply here.
4582 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4583 * in a dictionary which is shared, the array variable value is duplicated first.
4584 * This allows the array element to be updated (e.g. append, lappend) without
4585 * affecting other references to the dictionary.
4587 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4589 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4591 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4593 if (varPtr
->linkFramePtr
== NULL
) {
4594 return varPtr
->objPtr
;
4599 /* The variable is a link? Resolve it. */
4600 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4602 interp
->framePtr
= varPtr
->linkFramePtr
;
4603 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4604 interp
->framePtr
= savedCallFrame
;
4608 /* Error, so fall through to the error message */
4613 case JIM_DICT_SUGAR
:
4614 /* [dict] syntax sugar. */
4615 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4617 if (flags
& JIM_ERRMSG
) {
4618 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4623 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4625 Jim_CallFrame
*savedFramePtr
;
4628 savedFramePtr
= interp
->framePtr
;
4629 interp
->framePtr
= interp
->topFramePtr
;
4630 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4631 interp
->framePtr
= savedFramePtr
;
4636 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4638 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4640 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4641 Jim_IncrRefCount(nameObjPtr
);
4642 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4643 Jim_DecrRefCount(interp
, nameObjPtr
);
4647 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4649 Jim_CallFrame
*savedFramePtr
;
4652 savedFramePtr
= interp
->framePtr
;
4653 interp
->framePtr
= interp
->topFramePtr
;
4654 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4655 interp
->framePtr
= savedFramePtr
;
4660 /* Unset a variable.
4661 * Note: On success unset invalidates all the variable objects created
4662 * in the current call frame incrementing. */
4663 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4667 Jim_CallFrame
*framePtr
;
4669 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4670 if (retval
== JIM_DICT_SUGAR
) {
4671 /* [dict] syntax sugar. */
4672 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4674 else if (retval
== JIM_OK
) {
4675 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4677 /* If it's a link call UnsetVariable recursively */
4678 if (varPtr
->linkFramePtr
) {
4679 framePtr
= interp
->framePtr
;
4680 interp
->framePtr
= varPtr
->linkFramePtr
;
4681 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4682 interp
->framePtr
= framePtr
;
4685 const char *name
= Jim_String(nameObjPtr
);
4686 if (nameObjPtr
->internalRep
.varValue
.global
) {
4688 framePtr
= interp
->topFramePtr
;
4691 framePtr
= interp
->framePtr
;
4694 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4695 if (retval
== JIM_OK
) {
4696 /* Change the callframe id, invalidating var lookup caching */
4697 framePtr
->id
= interp
->callFrameEpoch
++;
4701 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4702 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4707 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4709 /* Given a variable name for [dict] operation syntax sugar,
4710 * this function returns two objects, the first with the name
4711 * of the variable to set, and the second with the respective key.
4712 * For example "foo(bar)" will return objects with string repr. of
4715 * The returned objects have refcount = 1. The function can't fail. */
4716 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4717 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4719 const char *str
, *p
;
4721 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4723 str
= Jim_GetString(objPtr
, &len
);
4725 p
= strchr(str
, '(');
4726 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4728 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4731 keyLen
= (str
+ len
) - p
;
4732 if (str
[len
- 1] == ')') {
4736 /* Create the objects with the variable name and key. */
4737 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4739 Jim_IncrRefCount(varObjPtr
);
4740 Jim_IncrRefCount(keyObjPtr
);
4741 *varPtrPtr
= varObjPtr
;
4742 *keyPtrPtr
= keyObjPtr
;
4745 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4746 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4747 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4751 SetDictSubstFromAny(interp
, objPtr
);
4753 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4754 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4756 if (err
== JIM_OK
) {
4757 /* Don't keep an extra ref to the result */
4758 Jim_SetEmptyResult(interp
);
4762 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4763 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4764 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4769 /* Make the error more informative and Tcl-compatible */
4770 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4771 (valObjPtr
? "set" : "unset"), objPtr
);
4777 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4779 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4780 * and stored back to the variable before expansion.
4782 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4783 Jim_Obj
*keyObjPtr
, int flags
)
4785 Jim_Obj
*dictObjPtr
;
4786 Jim_Obj
*resObjPtr
= NULL
;
4789 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4794 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4795 if (ret
!= JIM_OK
) {
4796 Jim_SetResultFormatted(interp
,
4797 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4798 ret
< 0 ? "variable isn't" : "no such element in");
4800 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4801 /* Update the variable to have an unshared copy */
4802 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4808 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4809 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4811 SetDictSubstFromAny(interp
, objPtr
);
4813 return JimDictExpandArrayVariable(interp
,
4814 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4815 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4818 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4820 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4822 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4823 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4826 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4828 JIM_NOTUSED(interp
);
4830 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4831 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4832 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4833 dupPtr
->typePtr
= &dictSubstObjType
;
4836 /* Note: The object *must* be in dict-sugar format */
4837 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4839 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4840 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4842 if (objPtr
->typePtr
== &interpolatedObjType
) {
4843 /* An interpolated object in dict-sugar form */
4845 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4846 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4848 Jim_IncrRefCount(varObjPtr
);
4849 Jim_IncrRefCount(keyObjPtr
);
4852 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4855 Jim_FreeIntRep(interp
, objPtr
);
4856 objPtr
->typePtr
= &dictSubstObjType
;
4857 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4858 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4862 /* This function is used to expand [dict get] sugar in the form
4863 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4864 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4865 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4866 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4867 * the [dict]ionary contained in variable VARNAME. */
4868 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4870 Jim_Obj
*resObjPtr
= NULL
;
4871 Jim_Obj
*substKeyObjPtr
= NULL
;
4873 SetDictSubstFromAny(interp
, objPtr
);
4875 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4876 &substKeyObjPtr
, JIM_NONE
)
4880 Jim_IncrRefCount(substKeyObjPtr
);
4882 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4884 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4889 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4891 Jim_Obj
*resultObjPtr
;
4893 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4894 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4895 resultObjPtr
->refCount
--;
4896 return resultObjPtr
;
4901 /* -----------------------------------------------------------------------------
4903 * ---------------------------------------------------------------------------*/
4905 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4909 if (interp
->freeFramesList
) {
4910 cf
= interp
->freeFramesList
;
4911 interp
->freeFramesList
= cf
->next
;
4915 cf
->procArgsObjPtr
= NULL
;
4916 cf
->procBodyObjPtr
= NULL
;
4918 cf
->staticVars
= NULL
;
4919 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(engine)", "Jim");
5483 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5484 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5485 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5486 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5487 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5488 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5489 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5494 void Jim_FreeInterp(Jim_Interp
*i
)
5496 Jim_CallFrame
*cf
, *cfx
;
5498 Jim_Obj
*objPtr
, *nextObjPtr
;
5500 /* Free the active call frames list - must be done before i->commands is destroyed */
5501 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5503 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5506 Jim_DecrRefCount(i
, i
->emptyObj
);
5507 Jim_DecrRefCount(i
, i
->trueObj
);
5508 Jim_DecrRefCount(i
, i
->falseObj
);
5509 Jim_DecrRefCount(i
, i
->result
);
5510 Jim_DecrRefCount(i
, i
->stackTrace
);
5511 Jim_DecrRefCount(i
, i
->errorProc
);
5512 Jim_DecrRefCount(i
, i
->unknown
);
5513 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5514 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5515 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5516 Jim_FreeHashTable(&i
->commands
);
5517 #ifdef JIM_REFERENCES
5518 Jim_FreeHashTable(&i
->references
);
5520 Jim_FreeHashTable(&i
->packages
);
5521 Jim_Free(i
->prngState
);
5522 Jim_FreeHashTable(&i
->assocData
);
5524 /* Check that the live object list is empty, otherwise
5525 * there is a memory leak. */
5526 #ifdef JIM_MAINTAINER
5527 if (i
->liveList
!= NULL
) {
5528 objPtr
= i
->liveList
;
5530 printf("\n-------------------------------------\n");
5531 printf("Objects still in the free list:\n");
5533 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5535 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5536 printf("%p (%d) %-10s: '%.20s...'\n",
5537 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5540 printf("%p (%d) %-10s: '%s'\n",
5541 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5543 if (objPtr
->typePtr
== &sourceObjType
) {
5544 printf("FILE %s LINE %d\n",
5545 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5546 objPtr
->internalRep
.sourceValue
.lineNumber
);
5548 objPtr
= objPtr
->nextObjPtr
;
5550 printf("-------------------------------------\n\n");
5551 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5555 /* Free all the freed objects. */
5556 objPtr
= i
->freeList
;
5558 nextObjPtr
= objPtr
->nextObjPtr
;
5560 objPtr
= nextObjPtr
;
5563 /* Free the free call frames list */
5564 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5567 Jim_FreeHashTable(&cf
->vars
);
5571 /* Free the interpreter structure. */
5575 /* Returns the call frame relative to the level represented by
5576 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5578 * This function accepts the 'level' argument in the form
5579 * of the commands [uplevel] and [upvar].
5581 * Returns NULL on error.
5583 * Note: for a function accepting a relative integer as level suitable
5584 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5586 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5590 Jim_CallFrame
*framePtr
;
5593 str
= Jim_String(levelObjPtr
);
5594 if (str
[0] == '#') {
5597 level
= jim_strtol(str
+ 1, &endptr
);
5598 if (str
[1] == '\0' || endptr
[0] != '\0') {
5603 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5607 /* Convert from a relative to an absolute level */
5608 level
= interp
->framePtr
->level
- level
;
5613 str
= "1"; /* Needed to format the error message. */
5614 level
= interp
->framePtr
->level
- 1;
5618 return interp
->topFramePtr
;
5622 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5623 if (framePtr
->level
== level
) {
5629 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5633 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5634 * as a relative integer like in the [info level ?level?] command.
5636 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5639 Jim_CallFrame
*framePtr
;
5641 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5643 /* Convert from a relative to an absolute level */
5644 level
= interp
->framePtr
->level
+ level
;
5648 return interp
->topFramePtr
;
5652 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5653 if (framePtr
->level
== level
) {
5659 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5663 static void JimResetStackTrace(Jim_Interp
*interp
)
5665 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5666 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5667 Jim_IncrRefCount(interp
->stackTrace
);
5670 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5674 /* Increment reference first in case these are the same object */
5675 Jim_IncrRefCount(stackTraceObj
);
5676 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5677 interp
->stackTrace
= stackTraceObj
;
5678 interp
->errorFlag
= 1;
5680 /* This is a bit ugly.
5681 * If the filename of the last entry of the stack trace is empty,
5682 * the next stack level should be added.
5684 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5686 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5687 interp
->addStackTrace
= 1;
5692 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5693 Jim_Obj
*fileNameObj
, int linenr
)
5695 if (strcmp(procname
, "unknown") == 0) {
5698 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5699 /* No useful info here */
5703 if (Jim_IsShared(interp
->stackTrace
)) {
5704 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5705 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5706 Jim_IncrRefCount(interp
->stackTrace
);
5709 /* If we have no procname but the previous element did, merge with that frame */
5710 if (!*procname
&& Jim_Length(fileNameObj
)) {
5711 /* Just a filename. Check the previous entry */
5712 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5715 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5716 if (Jim_Length(objPtr
)) {
5717 /* Yes, the previous level had procname */
5718 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5719 if (Jim_Length(objPtr
) == 0) {
5720 /* But no filename, so merge the new info with that frame */
5721 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5722 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5729 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5730 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5731 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5734 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5737 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5739 assocEntryPtr
->delProc
= delProc
;
5740 assocEntryPtr
->data
= data
;
5741 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5744 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5746 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5748 if (entryPtr
!= NULL
) {
5749 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5750 return assocEntryPtr
->data
;
5755 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5757 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5760 int Jim_GetExitCode(Jim_Interp
*interp
)
5762 return interp
->exitCode
;
5765 /* -----------------------------------------------------------------------------
5767 * ---------------------------------------------------------------------------*/
5768 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5769 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5771 static const Jim_ObjType intObjType
= {
5779 /* A coerced double is closer to an int than a double.
5780 * It is an int value temporarily masquerading as a double value.
5781 * i.e. it has the same string value as an int and Jim_GetWide()
5782 * succeeds, but also Jim_GetDouble() returns the value directly.
5784 static const Jim_ObjType coercedDoubleObjType
= {
5793 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5795 char buf
[JIM_INTEGER_SPACE
+ 1];
5796 jim_wide wideValue
= JimWideValue(objPtr
);
5799 if (wideValue
== 0) {
5803 char tmp
[JIM_INTEGER_SPACE
];
5807 if (wideValue
< 0) {
5810 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5811 * whereas C99 is always -6
5812 * coverity[dead_error_line]
5814 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5819 tmp
[num
++] = wideValue
% 10;
5823 for (i
= 0; i
< num
; i
++) {
5824 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5829 JimSetStringBytes(objPtr
, buf
);
5832 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5837 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5839 objPtr
->typePtr
= &intObjType
;
5843 /* Get the string representation */
5844 str
= Jim_String(objPtr
);
5845 /* Try to convert into a jim_wide */
5846 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5847 if (flags
& JIM_ERRMSG
) {
5848 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5852 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5853 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5856 /* Free the old internal repr and set the new one. */
5857 Jim_FreeIntRep(interp
, objPtr
);
5858 objPtr
->typePtr
= &intObjType
;
5859 objPtr
->internalRep
.wideValue
= wideValue
;
5863 #ifdef JIM_OPTIMIZATION
5864 static int JimIsWide(Jim_Obj
*objPtr
)
5866 return objPtr
->typePtr
== &intObjType
;
5870 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5872 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5874 *widePtr
= JimWideValue(objPtr
);
5878 /* Get a wide but does not set an error if the format is bad. */
5879 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5881 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5883 *widePtr
= JimWideValue(objPtr
);
5887 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5892 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5893 if (retval
== JIM_OK
) {
5894 *longPtr
= (long)wideValue
;
5900 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5904 objPtr
= Jim_NewObj(interp
);
5905 objPtr
->typePtr
= &intObjType
;
5906 objPtr
->bytes
= NULL
;
5907 objPtr
->internalRep
.wideValue
= wideValue
;
5911 /* -----------------------------------------------------------------------------
5913 * ---------------------------------------------------------------------------*/
5914 #define JIM_DOUBLE_SPACE 30
5916 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5917 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5919 static const Jim_ObjType doubleObjType
= {
5923 UpdateStringOfDouble
,
5929 #define isnan(X) ((X) != (X))
5933 #define isinf(X) (1.0 / (X) == 0.0)
5936 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5938 double value
= objPtr
->internalRep
.doubleValue
;
5941 JimSetStringBytes(objPtr
, "NaN");
5946 JimSetStringBytes(objPtr
, "-Inf");
5949 JimSetStringBytes(objPtr
, "Inf");
5954 char buf
[JIM_DOUBLE_SPACE
+ 1];
5956 int len
= sprintf(buf
, "%.12g", value
);
5958 /* Add a final ".0" if necessary */
5959 for (i
= 0; i
< len
; i
++) {
5960 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5961 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5962 /* If 'buf' ends in e-0nn or e+0nn, remove
5963 * the 0 after the + or - and reduce the length by 1
5965 char *e
= strchr(buf
, 'e');
5966 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5969 memmove(e
, e
+ 1, len
- (e
- buf
));
5975 if (buf
[i
] == '\0') {
5980 JimSetStringBytes(objPtr
, buf
);
5984 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5990 /* Preserve the string representation.
5991 * Needed so we can convert back to int without loss
5993 str
= Jim_String(objPtr
);
5995 #ifdef HAVE_LONG_LONG
5996 /* Assume a 53 bit mantissa */
5997 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5998 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6000 if (objPtr
->typePtr
== &intObjType
6001 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
6002 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6004 /* Direct conversion to coerced double */
6005 objPtr
->typePtr
= &coercedDoubleObjType
;
6010 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6011 /* Managed to convert to an int, so we can use this as a cooerced double */
6012 Jim_FreeIntRep(interp
, objPtr
);
6013 objPtr
->typePtr
= &coercedDoubleObjType
;
6014 objPtr
->internalRep
.wideValue
= wideValue
;
6018 /* Try to convert into a double */
6019 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6020 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6023 /* Free the old internal repr and set the new one. */
6024 Jim_FreeIntRep(interp
, objPtr
);
6026 objPtr
->typePtr
= &doubleObjType
;
6027 objPtr
->internalRep
.doubleValue
= doubleValue
;
6031 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6033 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6034 *doublePtr
= JimWideValue(objPtr
);
6037 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6040 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6041 *doublePtr
= JimWideValue(objPtr
);
6044 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6049 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6053 objPtr
= Jim_NewObj(interp
);
6054 objPtr
->typePtr
= &doubleObjType
;
6055 objPtr
->bytes
= NULL
;
6056 objPtr
->internalRep
.doubleValue
= doubleValue
;
6060 /* -----------------------------------------------------------------------------
6062 * ---------------------------------------------------------------------------*/
6063 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6064 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6065 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6066 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6067 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6068 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6070 /* Note that while the elements of the list may contain references,
6071 * the list object itself can't. This basically means that the
6072 * list object string representation as a whole can't contain references
6073 * that are not presents in the single elements. */
6074 static const Jim_ObjType listObjType
= {
6076 FreeListInternalRep
,
6082 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6086 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6087 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6089 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6092 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6096 JIM_NOTUSED(interp
);
6098 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6099 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6100 dupPtr
->internalRep
.listValue
.ele
=
6101 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6102 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6103 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6104 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6105 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6107 dupPtr
->typePtr
= &listObjType
;
6110 /* The following function checks if a given string can be encoded
6111 * into a list element without any kind of quoting, surrounded by braces,
6112 * or using escapes to quote. */
6113 #define JIM_ELESTR_SIMPLE 0
6114 #define JIM_ELESTR_BRACE 1
6115 #define JIM_ELESTR_QUOTE 2
6116 static unsigned char ListElementQuotingType(const char *s
, int len
)
6118 int i
, level
, blevel
, trySimple
= 1;
6120 /* Try with the SIMPLE case */
6122 return JIM_ELESTR_BRACE
;
6123 if (s
[0] == '"' || s
[0] == '{') {
6127 for (i
= 0; i
< len
; i
++) {
6148 return JIM_ELESTR_SIMPLE
;
6151 /* Test if it's possible to do with braces */
6152 if (s
[len
- 1] == '\\')
6153 return JIM_ELESTR_QUOTE
;
6156 for (i
= 0; i
< len
; i
++) {
6164 return JIM_ELESTR_QUOTE
;
6173 if (s
[i
+ 1] == '\n')
6174 return JIM_ELESTR_QUOTE
;
6175 else if (s
[i
+ 1] != '\0')
6181 return JIM_ELESTR_QUOTE
;
6186 return JIM_ELESTR_BRACE
;
6187 for (i
= 0; i
< len
; i
++) {
6201 return JIM_ELESTR_BRACE
;
6205 return JIM_ELESTR_SIMPLE
;
6207 return JIM_ELESTR_QUOTE
;
6210 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6211 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6213 * Returns the length of the result.
6215 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6268 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6270 #define STATIC_QUOTING_LEN 32
6271 int i
, bufLen
, realLength
;
6274 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6276 /* Estimate the space needed. */
6277 if (objc
> STATIC_QUOTING_LEN
) {
6278 quotingType
= Jim_Alloc(objc
);
6281 quotingType
= staticQuoting
;
6284 for (i
= 0; i
< objc
; i
++) {
6287 strRep
= Jim_GetString(objv
[i
], &len
);
6288 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6289 switch (quotingType
[i
]) {
6290 case JIM_ELESTR_SIMPLE
:
6291 if (i
!= 0 || strRep
[0] != '#') {
6295 /* Special case '#' on first element needs braces */
6296 quotingType
[i
] = JIM_ELESTR_BRACE
;
6298 case JIM_ELESTR_BRACE
:
6301 case JIM_ELESTR_QUOTE
:
6305 bufLen
++; /* elements separator. */
6309 /* Generate the string rep. */
6310 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6312 for (i
= 0; i
< objc
; i
++) {
6315 strRep
= Jim_GetString(objv
[i
], &len
);
6317 switch (quotingType
[i
]) {
6318 case JIM_ELESTR_SIMPLE
:
6319 memcpy(p
, strRep
, len
);
6323 case JIM_ELESTR_BRACE
:
6325 memcpy(p
, strRep
, len
);
6328 realLength
+= len
+ 2;
6330 case JIM_ELESTR_QUOTE
:
6331 if (i
== 0 && strRep
[0] == '#') {
6335 qlen
= BackslashQuoteString(strRep
, len
, p
);
6340 /* Add a separating space */
6341 if (i
+ 1 != objc
) {
6346 *p
= '\0'; /* nul term. */
6347 objPtr
->length
= realLength
;
6349 if (quotingType
!= staticQuoting
) {
6350 Jim_Free(quotingType
);
6354 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6356 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6359 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6361 struct JimParserCtx parser
;
6364 Jim_Obj
*fileNameObj
;
6367 if (objPtr
->typePtr
== &listObjType
) {
6371 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6372 * it also preserves any source location of the dict elements
6373 * which can be very useful
6375 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6376 Jim_Obj
**listObjPtrPtr
;
6380 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6381 for (i
= 0; i
< len
; i
++) {
6382 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6385 /* Now just switch the internal rep */
6386 Jim_FreeIntRep(interp
, objPtr
);
6387 objPtr
->typePtr
= &listObjType
;
6388 objPtr
->internalRep
.listValue
.len
= len
;
6389 objPtr
->internalRep
.listValue
.maxLen
= len
;
6390 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6395 /* Try to preserve information about filename / line number */
6396 if (objPtr
->typePtr
== &sourceObjType
) {
6397 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6398 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6401 fileNameObj
= interp
->emptyObj
;
6404 Jim_IncrRefCount(fileNameObj
);
6406 /* Get the string representation */
6407 str
= Jim_GetString(objPtr
, &strLen
);
6409 /* Free the old internal repr just now and initialize the
6410 * new one just now. The string->list conversion can't fail. */
6411 Jim_FreeIntRep(interp
, objPtr
);
6412 objPtr
->typePtr
= &listObjType
;
6413 objPtr
->internalRep
.listValue
.len
= 0;
6414 objPtr
->internalRep
.listValue
.maxLen
= 0;
6415 objPtr
->internalRep
.listValue
.ele
= NULL
;
6417 /* Convert into a list */
6419 JimParserInit(&parser
, str
, strLen
, linenr
);
6420 while (!parser
.eof
) {
6421 Jim_Obj
*elementPtr
;
6423 JimParseList(&parser
);
6424 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6426 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6427 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6428 ListAppendElement(objPtr
, elementPtr
);
6431 Jim_DecrRefCount(interp
, fileNameObj
);
6435 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6439 objPtr
= Jim_NewObj(interp
);
6440 objPtr
->typePtr
= &listObjType
;
6441 objPtr
->bytes
= NULL
;
6442 objPtr
->internalRep
.listValue
.ele
= NULL
;
6443 objPtr
->internalRep
.listValue
.len
= 0;
6444 objPtr
->internalRep
.listValue
.maxLen
= 0;
6447 ListInsertElements(objPtr
, 0, len
, elements
);
6453 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6454 * length of the vector. Note that the user of this function should make
6455 * sure that the list object can't shimmer while the vector returned
6456 * is in use, this vector is the one stored inside the internal representation
6457 * of the list object. This function is not exported, extensions should
6458 * always access to the List object elements using Jim_ListIndex(). */
6459 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6462 *listLen
= Jim_ListLength(interp
, listObj
);
6463 *listVec
= listObj
->internalRep
.listValue
.ele
;
6466 /* Sorting uses ints, but commands may return wide */
6467 static int JimSign(jim_wide w
)
6478 /* ListSortElements type values */
6494 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6497 static struct lsort_info
*sort_info
;
6499 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6501 Jim_Obj
*lObj
, *rObj
;
6503 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6504 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6505 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6507 return sort_info
->subfn(&lObj
, &rObj
);
6510 /* Sort the internal rep of a list. */
6511 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6513 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6516 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6518 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6521 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6523 jim_wide lhs
= 0, rhs
= 0;
6525 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6526 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6527 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6530 return JimSign(lhs
- rhs
) * sort_info
->order
;
6533 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6535 double lhs
= 0, rhs
= 0;
6537 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6538 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6539 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6545 return sort_info
->order
;
6547 return -sort_info
->order
;
6550 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6552 Jim_Obj
*compare_script
;
6557 /* This must be a valid list */
6558 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6559 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6560 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6562 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6564 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6565 longjmp(sort_info
->jmpbuf
, rc
);
6568 return JimSign(ret
) * sort_info
->order
;
6571 /* Remove duplicate elements from the (sorted) list in-place, according to the
6572 * comparison function, comp.
6574 * Note that the last unique value is kept, not the first
6576 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6580 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6582 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6583 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6584 /* Match, so replace the dest with the current source */
6585 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6588 /* No match, so keep the current source and move to the next destination */
6591 ele
[dst
] = ele
[src
];
6593 /* At end of list, keep the final element */
6594 ele
[++dst
] = ele
[src
];
6596 /* Set the new length */
6597 listObjPtr
->internalRep
.listValue
.len
= dst
;
6600 /* Sort a list *in place*. MUST be called with a non-shared list. */
6601 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6603 struct lsort_info
*prev_info
;
6605 typedef int (qsort_comparator
) (const void *, const void *);
6606 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6611 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6612 SetListFromAny(interp
, listObjPtr
);
6614 /* Allow lsort to be called reentrantly */
6615 prev_info
= sort_info
;
6618 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6619 len
= listObjPtr
->internalRep
.listValue
.len
;
6620 switch (info
->type
) {
6621 case JIM_LSORT_ASCII
:
6622 fn
= ListSortString
;
6624 case JIM_LSORT_NOCASE
:
6625 fn
= ListSortStringNoCase
;
6627 case JIM_LSORT_INTEGER
:
6628 fn
= ListSortInteger
;
6630 case JIM_LSORT_REAL
:
6633 case JIM_LSORT_COMMAND
:
6634 fn
= ListSortCommand
;
6637 fn
= NULL
; /* avoid warning */
6638 JimPanic((1, "ListSort called with invalid sort type"));
6641 if (info
->indexed
) {
6642 /* Need to interpose a "list index" function */
6644 fn
= ListSortIndexHelper
;
6647 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6648 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6650 if (info
->unique
&& len
> 1) {
6651 ListRemoveDuplicates(listObjPtr
, fn
);
6654 Jim_InvalidateStringRep(listObjPtr
);
6656 sort_info
= prev_info
;
6661 /* This is the low-level function to insert elements into a list.
6662 * The higher-level Jim_ListInsertElements() performs shared object
6663 * check and invalidates the string repr. This version is used
6664 * in the internals of the List Object and is not exported.
6666 * NOTE: this function can be called only against objects
6667 * with internal type of List.
6669 * An insertion point (idx) of -1 means end-of-list.
6671 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6673 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6674 int requiredLen
= currentLen
+ elemc
;
6678 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6679 if (requiredLen
< 2) {
6680 /* Don't do allocations of under 4 pointers. */
6687 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6688 sizeof(Jim_Obj
*) * requiredLen
);
6690 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6695 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6696 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6697 for (i
= 0; i
< elemc
; ++i
) {
6698 point
[i
] = elemVec
[i
];
6699 Jim_IncrRefCount(point
[i
]);
6701 listPtr
->internalRep
.listValue
.len
+= elemc
;
6704 /* Convenience call to ListInsertElements() to append a single element.
6706 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6708 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6711 /* Appends every element of appendListPtr into listPtr.
6712 * Both have to be of the list type.
6713 * Convenience call to ListInsertElements()
6715 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6717 ListInsertElements(listPtr
, -1,
6718 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6721 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6723 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6724 SetListFromAny(interp
, listPtr
);
6725 Jim_InvalidateStringRep(listPtr
);
6726 ListAppendElement(listPtr
, objPtr
);
6729 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6731 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6732 SetListFromAny(interp
, listPtr
);
6733 SetListFromAny(interp
, appendListPtr
);
6734 Jim_InvalidateStringRep(listPtr
);
6735 ListAppendList(listPtr
, appendListPtr
);
6738 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6740 SetListFromAny(interp
, objPtr
);
6741 return objPtr
->internalRep
.listValue
.len
;
6744 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6745 int objc
, Jim_Obj
*const *objVec
)
6747 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6748 SetListFromAny(interp
, listPtr
);
6749 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6750 idx
= listPtr
->internalRep
.listValue
.len
;
6753 Jim_InvalidateStringRep(listPtr
);
6754 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6757 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6759 SetListFromAny(interp
, listPtr
);
6760 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6761 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6765 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6766 return listPtr
->internalRep
.listValue
.ele
[idx
];
6769 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6771 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6772 if (*objPtrPtr
== NULL
) {
6773 if (flags
& JIM_ERRMSG
) {
6774 Jim_SetResultString(interp
, "list index out of range", -1);
6781 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6782 Jim_Obj
*newObjPtr
, int flags
)
6784 SetListFromAny(interp
, listPtr
);
6785 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6786 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6787 if (flags
& JIM_ERRMSG
) {
6788 Jim_SetResultString(interp
, "list index out of range", -1);
6793 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6794 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6795 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6796 Jim_IncrRefCount(newObjPtr
);
6800 /* Modify the list stored in the variable named 'varNamePtr'
6801 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6802 * with the new element 'newObjptr'. (implements the [lset] command) */
6803 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6804 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6806 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6809 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6812 if ((shared
= Jim_IsShared(objPtr
)))
6813 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6814 for (i
= 0; i
< indexc
- 1; i
++) {
6815 listObjPtr
= objPtr
;
6816 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6818 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6821 if (Jim_IsShared(objPtr
)) {
6822 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6823 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6825 Jim_InvalidateStringRep(listObjPtr
);
6827 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6829 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6831 Jim_InvalidateStringRep(objPtr
);
6832 Jim_InvalidateStringRep(varObjPtr
);
6833 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6835 Jim_SetResult(interp
, varObjPtr
);
6839 Jim_FreeNewObj(interp
, varObjPtr
);
6844 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6847 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6848 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6850 for (i
= 0; i
< listLen
; ) {
6851 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6852 if (++i
!= listLen
) {
6853 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6859 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6863 /* If all the objects in objv are lists,
6864 * it's possible to return a list as result, that's the
6865 * concatenation of all the lists. */
6866 for (i
= 0; i
< objc
; i
++) {
6867 if (!Jim_IsList(objv
[i
]))
6871 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6873 for (i
= 0; i
< objc
; i
++)
6874 ListAppendList(objPtr
, objv
[i
]);
6878 /* Else... we have to glue strings together */
6879 int len
= 0, objLen
;
6882 /* Compute the length */
6883 for (i
= 0; i
< objc
; i
++) {
6884 len
+= Jim_Length(objv
[i
]);
6888 /* Create the string rep, and a string object holding it. */
6889 p
= bytes
= Jim_Alloc(len
+ 1);
6890 for (i
= 0; i
< objc
; i
++) {
6891 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6893 /* Remove leading space */
6894 while (objLen
&& isspace(UCHAR(*s
))) {
6899 /* And trailing space */
6900 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6901 /* Handle trailing backslash-space case */
6902 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6908 memcpy(p
, s
, objLen
);
6910 if (i
+ 1 != objc
) {
6914 /* Drop the space calculated for this
6915 * element that is instead null. */
6921 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6925 /* Returns a list composed of the elements in the specified range.
6926 * first and start are directly accepted as Jim_Objects and
6927 * processed for the end?-index? case. */
6928 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6929 Jim_Obj
*lastObjPtr
)
6934 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6935 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
6937 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
6938 first
= JimRelToAbsIndex(len
, first
);
6939 last
= JimRelToAbsIndex(len
, last
);
6940 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
6941 if (first
== 0 && last
== len
) {
6944 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
6947 /* -----------------------------------------------------------------------------
6949 * ---------------------------------------------------------------------------*/
6950 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6951 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6952 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
6953 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6955 /* Dict HashTable Type.
6957 * Keys and Values are Jim objects. */
6959 static unsigned int JimObjectHTHashFunction(const void *key
)
6962 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
6963 return Jim_GenHashFunction((const unsigned char *)str
, len
);
6966 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
6968 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
6971 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
6973 Jim_IncrRefCount((Jim_Obj
*)val
);
6977 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
6979 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
6982 static const Jim_HashTableType JimDictHashTableType
= {
6983 JimObjectHTHashFunction
, /* hash function */
6984 JimObjectHTKeyValDup
, /* key dup */
6985 JimObjectHTKeyValDup
, /* val dup */
6986 JimObjectHTKeyCompare
, /* key compare */
6987 JimObjectHTKeyValDestructor
, /* key destructor */
6988 JimObjectHTKeyValDestructor
/* val destructor */
6991 /* Note that while the elements of the dict may contain references,
6992 * the list object itself can't. This basically means that the
6993 * dict object string representation as a whole can't contain references
6994 * that are not presents in the single elements. */
6995 static const Jim_ObjType dictObjType
= {
6997 FreeDictInternalRep
,
7003 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7005 JIM_NOTUSED(interp
);
7007 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7008 Jim_Free(objPtr
->internalRep
.ptr
);
7011 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7013 Jim_HashTable
*ht
, *dupHt
;
7014 Jim_HashTableIterator htiter
;
7017 /* Create a new hash table */
7018 ht
= srcPtr
->internalRep
.ptr
;
7019 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7020 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7022 Jim_ExpandHashTable(dupHt
, ht
->size
);
7023 /* Copy every element from the source to the dup hash table */
7024 JimInitHashTableIterator(ht
, &htiter
);
7025 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7026 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7029 dupPtr
->internalRep
.ptr
= dupHt
;
7030 dupPtr
->typePtr
= &dictObjType
;
7033 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7036 Jim_HashTableIterator htiter
;
7041 ht
= dictPtr
->internalRep
.ptr
;
7043 /* Turn the hash table into a flat vector of Jim_Objects. */
7044 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7045 JimInitHashTableIterator(ht
, &htiter
);
7047 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7048 objv
[i
++] = Jim_GetHashEntryKey(he
);
7049 objv
[i
++] = Jim_GetHashEntryVal(he
);
7055 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7057 /* Turn the hash table into a flat vector of Jim_Objects. */
7059 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7061 /* And now generate the string rep as a list */
7062 JimMakeListStringRep(objPtr
, objv
, len
);
7067 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7071 if (objPtr
->typePtr
== &dictObjType
) {
7075 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7076 /* A shared list, so get the string representation now to avoid
7077 * changing the order in case of fast conversion to dict.
7082 /* For simplicity, convert a non-list object to a list and then to a dict */
7083 listlen
= Jim_ListLength(interp
, objPtr
);
7085 Jim_SetResultString(interp
, "missing value to go with key", -1);
7089 /* Converting from a list to a dict can't fail */
7093 ht
= Jim_Alloc(sizeof(*ht
));
7094 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7096 for (i
= 0; i
< listlen
; i
+= 2) {
7097 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7098 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7100 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7103 Jim_FreeIntRep(interp
, objPtr
);
7104 objPtr
->typePtr
= &dictObjType
;
7105 objPtr
->internalRep
.ptr
= ht
;
7111 /* Dict object API */
7113 /* Add an element to a dict. objPtr must be of the "dict" type.
7114 * The higher-level exported function is Jim_DictAddElement().
7115 * If an element with the specified key already exists, the value
7116 * associated is replaced with the new one.
7118 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7119 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7120 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7122 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7124 if (valueObjPtr
== NULL
) { /* unset */
7125 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7127 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7131 /* Add an element, higher-level interface for DictAddElement().
7132 * If valueObjPtr == NULL, the key is removed if it exists. */
7133 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7134 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7136 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7137 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7140 Jim_InvalidateStringRep(objPtr
);
7141 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7144 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7149 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7151 objPtr
= Jim_NewObj(interp
);
7152 objPtr
->typePtr
= &dictObjType
;
7153 objPtr
->bytes
= NULL
;
7154 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7155 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7156 for (i
= 0; i
< len
; i
+= 2)
7157 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7161 /* Return the value associated to the specified dict key
7162 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7164 * Sets *objPtrPtr to non-NULL only upon success.
7166 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7167 Jim_Obj
**objPtrPtr
, int flags
)
7172 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7175 ht
= dictPtr
->internalRep
.ptr
;
7176 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7177 if (flags
& JIM_ERRMSG
) {
7178 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7182 *objPtrPtr
= he
->u
.val
;
7186 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7187 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7189 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7192 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7198 /* Return the value associated to the specified dict keys */
7199 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7200 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7205 *objPtrPtr
= dictPtr
;
7209 for (i
= 0; i
< keyc
; i
++) {
7212 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7218 *objPtrPtr
= dictPtr
;
7222 /* Modify the dict stored into the variable named 'varNamePtr'
7223 * setting the element specified by the 'keyc' keys objects in 'keyv',
7224 * with the new value of the element 'newObjPtr'.
7226 * If newObjPtr == NULL the operation is to remove the given key
7227 * from the dictionary.
7229 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7230 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7232 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7233 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7235 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7238 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7239 if (objPtr
== NULL
) {
7240 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7241 /* Cannot remove a key from non existing var */
7244 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7245 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7246 Jim_FreeNewObj(interp
, varObjPtr
);
7250 if ((shared
= Jim_IsShared(objPtr
)))
7251 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7252 for (i
= 0; i
< keyc
; i
++) {
7253 dictObjPtr
= objPtr
;
7255 /* Check if it's a valid dictionary */
7256 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7260 if (i
== keyc
- 1) {
7261 /* Last key: Note that error on unset with missing last key is OK */
7262 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7263 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7270 /* Check if the given key exists. */
7271 Jim_InvalidateStringRep(dictObjPtr
);
7272 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7273 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7274 /* This key exists at the current level.
7275 * Make sure it's not shared!. */
7276 if (Jim_IsShared(objPtr
)) {
7277 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7278 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7282 /* Key not found. If it's an [unset] operation
7283 * this is an error. Only the last key may not
7285 if (newObjPtr
== NULL
) {
7288 /* Otherwise set an empty dictionary
7289 * as key's value. */
7290 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7291 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7294 /* XXX: Is this necessary? */
7295 Jim_InvalidateStringRep(objPtr
);
7296 Jim_InvalidateStringRep(varObjPtr
);
7297 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7300 Jim_SetResult(interp
, varObjPtr
);
7304 Jim_FreeNewObj(interp
, varObjPtr
);
7309 /* -----------------------------------------------------------------------------
7311 * ---------------------------------------------------------------------------*/
7312 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7313 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7315 static const Jim_ObjType indexObjType
= {
7319 UpdateStringOfIndex
,
7323 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7325 if (objPtr
->internalRep
.intValue
== -1) {
7326 JimSetStringBytes(objPtr
, "end");
7329 char buf
[JIM_INTEGER_SPACE
+ 1];
7330 if (objPtr
->internalRep
.intValue
>= 0) {
7331 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7335 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7337 JimSetStringBytes(objPtr
, buf
);
7341 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7347 /* Get the string representation */
7348 str
= Jim_String(objPtr
);
7350 /* Try to convert into an index */
7351 if (strncmp(str
, "end", 3) == 0) {
7357 idx
= jim_strtol(str
, &endptr
);
7359 if (endptr
== str
) {
7365 /* Now str may include or +<num> or -<num> */
7366 if (*str
== '+' || *str
== '-') {
7367 int sign
= (*str
== '+' ? 1 : -1);
7369 idx
+= sign
* jim_strtol(++str
, &endptr
);
7370 if (str
== endptr
|| *endptr
) {
7375 /* The only thing left should be spaces */
7376 while (isspace(UCHAR(*str
))) {
7387 /* end-1 is repesented as -2 */
7395 /* Free the old internal repr and set the new one. */
7396 Jim_FreeIntRep(interp
, objPtr
);
7397 objPtr
->typePtr
= &indexObjType
;
7398 objPtr
->internalRep
.intValue
= idx
;
7402 Jim_SetResultFormatted(interp
,
7403 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7407 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7409 /* Avoid shimmering if the object is an integer. */
7410 if (objPtr
->typePtr
== &intObjType
) {
7411 jim_wide val
= JimWideValue(objPtr
);
7414 *indexPtr
= -INT_MAX
;
7415 else if (val
> INT_MAX
)
7416 *indexPtr
= INT_MAX
;
7418 *indexPtr
= (int)val
;
7421 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7423 *indexPtr
= objPtr
->internalRep
.intValue
;
7427 /* -----------------------------------------------------------------------------
7428 * Return Code Object.
7429 * ---------------------------------------------------------------------------*/
7431 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7432 static const char * const jimReturnCodes
[] = {
7444 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7446 static const Jim_ObjType returnCodeObjType
= {
7454 /* Converts a (standard) return code to a string. Returns "?" for
7455 * non-standard return codes.
7457 const char *Jim_ReturnCode(int code
)
7459 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7463 return jimReturnCodes
[code
];
7467 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7472 /* Try to convert into an integer */
7473 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7474 returnCode
= (int)wideValue
;
7475 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7476 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7479 /* Free the old internal repr and set the new one. */
7480 Jim_FreeIntRep(interp
, objPtr
);
7481 objPtr
->typePtr
= &returnCodeObjType
;
7482 objPtr
->internalRep
.intValue
= returnCode
;
7486 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7488 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7490 *intPtr
= objPtr
->internalRep
.intValue
;
7494 /* -----------------------------------------------------------------------------
7495 * Expression Parsing
7496 * ---------------------------------------------------------------------------*/
7497 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7498 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7499 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7501 /* Exrp's Stack machine operators opcodes. */
7503 /* Binary operators (numbers) */
7506 /* Continues on from the JIM_TT_ space */
7508 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7523 JIM_EXPROP_BITAND
, /* 35 */
7527 /* Note must keep these together */
7528 JIM_EXPROP_LOGICAND
, /* 38 */
7529 JIM_EXPROP_LOGICAND_LEFT
,
7530 JIM_EXPROP_LOGICAND_RIGHT
,
7533 JIM_EXPROP_LOGICOR
, /* 41 */
7534 JIM_EXPROP_LOGICOR_LEFT
,
7535 JIM_EXPROP_LOGICOR_RIGHT
,
7538 /* Ternary operators */
7539 JIM_EXPROP_TERNARY
, /* 44 */
7540 JIM_EXPROP_TERNARY_LEFT
,
7541 JIM_EXPROP_TERNARY_RIGHT
,
7544 JIM_EXPROP_COLON
, /* 47 */
7545 JIM_EXPROP_COLON_LEFT
,
7546 JIM_EXPROP_COLON_RIGHT
,
7548 JIM_EXPROP_POW
, /* 50 */
7550 /* Binary operators (strings) */
7551 JIM_EXPROP_STREQ
, /* 51 */
7556 /* Unary operators (numbers) */
7557 JIM_EXPROP_NOT
, /* 55 */
7559 JIM_EXPROP_UNARYMINUS
,
7560 JIM_EXPROP_UNARYPLUS
,
7563 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7564 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7565 JIM_EXPROP_FUNC_WIDE
,
7566 JIM_EXPROP_FUNC_ABS
,
7567 JIM_EXPROP_FUNC_DOUBLE
,
7568 JIM_EXPROP_FUNC_ROUND
,
7569 JIM_EXPROP_FUNC_RAND
,
7570 JIM_EXPROP_FUNC_SRAND
,
7572 /* math functions from libm */
7573 JIM_EXPROP_FUNC_SIN
, /* 65 */
7574 JIM_EXPROP_FUNC_COS
,
7575 JIM_EXPROP_FUNC_TAN
,
7576 JIM_EXPROP_FUNC_ASIN
,
7577 JIM_EXPROP_FUNC_ACOS
,
7578 JIM_EXPROP_FUNC_ATAN
,
7579 JIM_EXPROP_FUNC_SINH
,
7580 JIM_EXPROP_FUNC_COSH
,
7581 JIM_EXPROP_FUNC_TANH
,
7582 JIM_EXPROP_FUNC_CEIL
,
7583 JIM_EXPROP_FUNC_FLOOR
,
7584 JIM_EXPROP_FUNC_EXP
,
7585 JIM_EXPROP_FUNC_LOG
,
7586 JIM_EXPROP_FUNC_LOG10
,
7587 JIM_EXPROP_FUNC_SQRT
,
7588 JIM_EXPROP_FUNC_POW
,
7599 /* Operators table */
7600 typedef struct Jim_ExprOperator
7603 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7604 unsigned char precedence
;
7605 unsigned char arity
;
7607 unsigned char namelen
;
7610 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7612 Jim_IncrRefCount(obj
);
7613 e
->stack
[e
->stacklen
++] = obj
;
7616 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7618 return e
->stack
[--e
->stacklen
];
7621 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7625 Jim_Obj
*A
= ExprPop(e
);
7627 jim_wide wA
, wC
= 0;
7629 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7630 switch (e
->opcode
) {
7631 case JIM_EXPROP_FUNC_INT
:
7632 case JIM_EXPROP_FUNC_WIDE
:
7633 case JIM_EXPROP_FUNC_ROUND
:
7634 case JIM_EXPROP_UNARYPLUS
:
7637 case JIM_EXPROP_FUNC_DOUBLE
:
7641 case JIM_EXPROP_FUNC_ABS
:
7642 wC
= wA
>= 0 ? wA
: -wA
;
7644 case JIM_EXPROP_UNARYMINUS
:
7647 case JIM_EXPROP_NOT
:
7654 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7655 switch (e
->opcode
) {
7656 case JIM_EXPROP_FUNC_INT
:
7657 case JIM_EXPROP_FUNC_WIDE
:
7660 case JIM_EXPROP_FUNC_ROUND
:
7661 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7663 case JIM_EXPROP_FUNC_DOUBLE
:
7664 case JIM_EXPROP_UNARYPLUS
:
7668 case JIM_EXPROP_FUNC_ABS
:
7669 dC
= dA
>= 0 ? dA
: -dA
;
7672 case JIM_EXPROP_UNARYMINUS
:
7676 case JIM_EXPROP_NOT
:
7686 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7689 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7693 Jim_DecrRefCount(interp
, A
);
7698 static double JimRandDouble(Jim_Interp
*interp
)
7701 JimRandomBytes(interp
, &x
, sizeof(x
));
7703 return (double)x
/ (unsigned long)~0;
7706 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7708 Jim_Obj
*A
= ExprPop(e
);
7711 int rc
= Jim_GetWide(interp
, A
, &wA
);
7713 switch (e
->opcode
) {
7714 case JIM_EXPROP_BITNOT
:
7715 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7717 case JIM_EXPROP_FUNC_SRAND
:
7718 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7719 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7726 Jim_DecrRefCount(interp
, A
);
7731 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7733 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7735 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7740 #ifdef JIM_MATH_FUNCTIONS
7741 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7744 Jim_Obj
*A
= ExprPop(e
);
7747 rc
= Jim_GetDouble(interp
, A
, &dA
);
7749 switch (e
->opcode
) {
7750 case JIM_EXPROP_FUNC_SIN
:
7753 case JIM_EXPROP_FUNC_COS
:
7756 case JIM_EXPROP_FUNC_TAN
:
7759 case JIM_EXPROP_FUNC_ASIN
:
7762 case JIM_EXPROP_FUNC_ACOS
:
7765 case JIM_EXPROP_FUNC_ATAN
:
7768 case JIM_EXPROP_FUNC_SINH
:
7771 case JIM_EXPROP_FUNC_COSH
:
7774 case JIM_EXPROP_FUNC_TANH
:
7777 case JIM_EXPROP_FUNC_CEIL
:
7780 case JIM_EXPROP_FUNC_FLOOR
:
7783 case JIM_EXPROP_FUNC_EXP
:
7786 case JIM_EXPROP_FUNC_LOG
:
7789 case JIM_EXPROP_FUNC_LOG10
:
7792 case JIM_EXPROP_FUNC_SQRT
:
7798 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7801 Jim_DecrRefCount(interp
, A
);
7807 /* A binary operation on two ints */
7808 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7810 Jim_Obj
*B
= ExprPop(e
);
7811 Jim_Obj
*A
= ExprPop(e
);
7815 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7820 switch (e
->opcode
) {
7821 case JIM_EXPROP_LSHIFT
:
7824 case JIM_EXPROP_RSHIFT
:
7827 case JIM_EXPROP_BITAND
:
7830 case JIM_EXPROP_BITXOR
:
7833 case JIM_EXPROP_BITOR
:
7836 case JIM_EXPROP_MOD
:
7839 Jim_SetResultString(interp
, "Division by zero", -1);
7846 * This code is tricky: C doesn't guarantee much
7847 * about the quotient or remainder, but Tcl does.
7848 * The remainder always has the same sign as the
7849 * divisor and a smaller absolute value.
7867 case JIM_EXPROP_ROTL
:
7868 case JIM_EXPROP_ROTR
:{
7869 /* uint32_t would be better. But not everyone has inttypes.h? */
7870 unsigned long uA
= (unsigned long)wA
;
7871 unsigned long uB
= (unsigned long)wB
;
7872 const unsigned int S
= sizeof(unsigned long) * 8;
7874 /* Shift left by the word size or more is undefined. */
7877 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7880 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7886 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7890 Jim_DecrRefCount(interp
, A
);
7891 Jim_DecrRefCount(interp
, B
);
7897 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7898 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7902 double dA
, dB
, dC
= 0;
7903 jim_wide wA
, wB
, wC
= 0;
7905 Jim_Obj
*B
= ExprPop(e
);
7906 Jim_Obj
*A
= ExprPop(e
);
7908 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7909 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7910 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7914 switch (e
->opcode
) {
7915 case JIM_EXPROP_POW
:
7916 case JIM_EXPROP_FUNC_POW
:
7917 wC
= JimPowWide(wA
, wB
);
7919 case JIM_EXPROP_ADD
:
7922 case JIM_EXPROP_SUB
:
7925 case JIM_EXPROP_MUL
:
7928 case JIM_EXPROP_DIV
:
7930 Jim_SetResultString(interp
, "Division by zero", -1);
7937 * This code is tricky: C doesn't guarantee much
7938 * about the quotient or remainder, but Tcl does.
7939 * The remainder always has the same sign as the
7940 * divisor and a smaller absolute value.
7958 case JIM_EXPROP_LTE
:
7961 case JIM_EXPROP_GTE
:
7964 case JIM_EXPROP_NUMEQ
:
7967 case JIM_EXPROP_NUMNE
:
7974 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
7976 switch (e
->opcode
) {
7977 case JIM_EXPROP_POW
:
7978 case JIM_EXPROP_FUNC_POW
:
7979 #ifdef JIM_MATH_FUNCTIONS
7982 Jim_SetResultString(interp
, "unsupported", -1);
7986 case JIM_EXPROP_ADD
:
7989 case JIM_EXPROP_SUB
:
7992 case JIM_EXPROP_MUL
:
7995 case JIM_EXPROP_DIV
:
7998 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
8000 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8015 case JIM_EXPROP_LTE
:
8019 case JIM_EXPROP_GTE
:
8023 case JIM_EXPROP_NUMEQ
:
8027 case JIM_EXPROP_NUMNE
:
8036 /* Handle the string case */
8038 /* XXX: Could optimise the eq/ne case by checking lengths */
8039 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8041 switch (e
->opcode
) {
8048 case JIM_EXPROP_LTE
:
8051 case JIM_EXPROP_GTE
:
8054 case JIM_EXPROP_NUMEQ
:
8057 case JIM_EXPROP_NUMNE
:
8068 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8071 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8075 Jim_DecrRefCount(interp
, A
);
8076 Jim_DecrRefCount(interp
, B
);
8081 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8086 listlen
= Jim_ListLength(interp
, listObjPtr
);
8087 for (i
= 0; i
< listlen
; i
++) {
8088 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8095 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8097 Jim_Obj
*B
= ExprPop(e
);
8098 Jim_Obj
*A
= ExprPop(e
);
8102 switch (e
->opcode
) {
8103 case JIM_EXPROP_STREQ
:
8104 case JIM_EXPROP_STRNE
:
8105 wC
= Jim_StringEqObj(A
, B
);
8106 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8110 case JIM_EXPROP_STRIN
:
8111 wC
= JimSearchList(interp
, B
, A
);
8113 case JIM_EXPROP_STRNI
:
8114 wC
= !JimSearchList(interp
, B
, A
);
8119 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8121 Jim_DecrRefCount(interp
, A
);
8122 Jim_DecrRefCount(interp
, B
);
8127 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8132 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8135 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8141 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8143 Jim_Obj
*skip
= ExprPop(e
);
8144 Jim_Obj
*A
= ExprPop(e
);
8147 switch (ExprBool(interp
, A
)) {
8149 /* false, so skip RHS opcodes with a 0 result */
8150 e
->skip
= JimWideValue(skip
);
8151 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8155 /* true so continue */
8162 Jim_DecrRefCount(interp
, A
);
8163 Jim_DecrRefCount(interp
, skip
);
8168 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8170 Jim_Obj
*skip
= ExprPop(e
);
8171 Jim_Obj
*A
= ExprPop(e
);
8174 switch (ExprBool(interp
, A
)) {
8176 /* false, so do nothing */
8180 /* true so skip RHS opcodes with a 1 result */
8181 e
->skip
= JimWideValue(skip
);
8182 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8190 Jim_DecrRefCount(interp
, A
);
8191 Jim_DecrRefCount(interp
, skip
);
8196 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8198 Jim_Obj
*A
= ExprPop(e
);
8201 switch (ExprBool(interp
, A
)) {
8203 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8207 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8215 Jim_DecrRefCount(interp
, A
);
8220 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8222 Jim_Obj
*skip
= ExprPop(e
);
8223 Jim_Obj
*A
= ExprPop(e
);
8229 switch (ExprBool(interp
, A
)) {
8231 /* false, skip RHS opcodes */
8232 e
->skip
= JimWideValue(skip
);
8233 /* Push a dummy value */
8234 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8238 /* true so do nothing */
8246 Jim_DecrRefCount(interp
, A
);
8247 Jim_DecrRefCount(interp
, skip
);
8252 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8254 Jim_Obj
*skip
= ExprPop(e
);
8255 Jim_Obj
*B
= ExprPop(e
);
8256 Jim_Obj
*A
= ExprPop(e
);
8258 /* No need to check for A as non-boolean */
8259 if (ExprBool(interp
, A
)) {
8260 /* true, so skip RHS opcodes */
8261 e
->skip
= JimWideValue(skip
);
8262 /* Repush B as the answer */
8266 Jim_DecrRefCount(interp
, skip
);
8267 Jim_DecrRefCount(interp
, A
);
8268 Jim_DecrRefCount(interp
, B
);
8272 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8285 /* name - precedence - arity - opcode
8287 * This array *must* be kept in sync with the JIM_EXPROP enum.
8289 * The following macros pre-compute the string length at compile time.
8291 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8292 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8294 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8295 OPRINIT("*", 110, 2, JimExprOpBin
),
8296 OPRINIT("/", 110, 2, JimExprOpBin
),
8297 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8299 OPRINIT("-", 100, 2, JimExprOpBin
),
8300 OPRINIT("+", 100, 2, JimExprOpBin
),
8302 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8303 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8305 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8306 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8308 OPRINIT("<", 80, 2, JimExprOpBin
),
8309 OPRINIT(">", 80, 2, JimExprOpBin
),
8310 OPRINIT("<=", 80, 2, JimExprOpBin
),
8311 OPRINIT(">=", 80, 2, JimExprOpBin
),
8313 OPRINIT("==", 70, 2, JimExprOpBin
),
8314 OPRINIT("!=", 70, 2, JimExprOpBin
),
8316 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8317 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8318 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8320 OPRINIT_LAZY("&&", 10, 2, NULL
, LAZY_OP
),
8321 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8322 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8324 OPRINIT_LAZY("||", 9, 2, NULL
, LAZY_OP
),
8325 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8326 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8328 OPRINIT_LAZY("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8329 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8330 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8332 OPRINIT_LAZY(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8333 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8334 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8336 OPRINIT("**", 250, 2, JimExprOpBin
),
8338 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8339 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8341 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8342 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8344 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8345 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8346 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8347 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8351 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8352 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8353 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8354 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8355 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8356 OPRINIT("rand", 200, 0, JimExprOpNone
),
8357 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8359 #ifdef JIM_MATH_FUNCTIONS
8360 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8361 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8362 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8363 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8364 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8365 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8366 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8367 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8368 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8369 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8370 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8371 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8372 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8373 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8374 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8375 OPRINIT("pow", 200, 2, JimExprOpBin
),
8381 #define JIM_EXPR_OPERATORS_NUM \
8382 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8384 static int JimParseExpression(struct JimParserCtx
*pc
)
8386 /* Discard spaces and quoted newline */
8387 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8388 if (*pc
->p
== '\n') {
8396 pc
->tline
= pc
->linenr
;
8401 pc
->tt
= JIM_TT_EOL
;
8407 pc
->tt
= JIM_TT_SUBEXPR_START
;
8410 pc
->tt
= JIM_TT_SUBEXPR_END
;
8413 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8420 return JimParseCmd(pc
);
8422 if (JimParseVar(pc
) == JIM_ERR
)
8423 return JimParseExprOperator(pc
);
8425 /* Don't allow expr sugar in expressions */
8426 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8443 return JimParseExprNumber(pc
);
8445 return JimParseQuote(pc
);
8447 return JimParseBrace(pc
);
8453 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8454 return JimParseExprOperator(pc
);
8457 return JimParseExprOperator(pc
);
8463 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8467 /* Assume an integer for now */
8468 pc
->tt
= JIM_TT_EXPR_INT
;
8470 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8471 /* Tried as an integer, but perhaps it parses as a double */
8472 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8473 /* Some stupid compilers insist they are cleverer that
8474 * we are. Even a (void) cast doesn't prevent this warning!
8476 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8477 if (end
== pc
->tstart
)
8480 /* Yes, double captured more chars */
8481 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8485 pc
->tend
= pc
->p
- 1;
8486 pc
->len
-= (pc
->p
- pc
->tstart
);
8490 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8492 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8495 for (i
= 0; irrationals
[i
]; i
++) {
8496 const char *irr
= irrationals
[i
];
8498 if (strncmp(irr
, pc
->p
, 3) == 0) {
8501 pc
->tend
= pc
->p
- 1;
8502 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8509 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8512 int bestIdx
= -1, bestLen
= 0;
8514 /* Try to get the longest match. */
8515 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8516 const char * const opname
= Jim_ExprOperators
[i
].name
;
8517 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8519 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8523 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8524 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8528 if (bestIdx
== -1) {
8532 /* Validate paretheses around function arguments */
8533 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8534 const char *p
= pc
->p
+ bestLen
;
8535 int len
= pc
->len
- bestLen
;
8537 while (len
&& isspace(UCHAR(*p
))) {
8545 pc
->tend
= pc
->p
+ bestLen
- 1;
8553 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8555 static Jim_ExprOperator dummy_op
;
8556 if (opcode
< JIM_TT_EXPR_OP
) {
8559 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8562 const char *jim_tt_name(int type
)
8564 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8565 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8567 if (type
< JIM_TT_EXPR_OP
) {
8568 return tt_names
[type
];
8571 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8572 static char buf
[20];
8577 sprintf(buf
, "(%d)", type
);
8582 /* -----------------------------------------------------------------------------
8584 * ---------------------------------------------------------------------------*/
8585 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8586 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8587 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8589 static const Jim_ObjType exprObjType
= {
8591 FreeExprInternalRep
,
8594 JIM_TYPE_REFERENCES
,
8597 /* Expr bytecode structure */
8598 typedef struct ExprByteCode
8600 ScriptToken
*token
; /* Tokens array. */
8601 int len
; /* Length as number of tokens. */
8602 int inUse
; /* Used for sharing. */
8605 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8609 for (i
= 0; i
< expr
->len
; i
++) {
8610 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8612 Jim_Free(expr
->token
);
8616 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8618 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8621 if (--expr
->inUse
!= 0) {
8625 ExprFreeByteCode(interp
, expr
);
8629 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8631 JIM_NOTUSED(interp
);
8632 JIM_NOTUSED(srcPtr
);
8634 /* Just returns an simple string. */
8635 dupPtr
->typePtr
= NULL
;
8638 /* Check if an expr program looks correct. */
8639 static int ExprCheckCorrectness(ExprByteCode
* expr
)
8645 /* Try to check if there are stack underflows,
8646 * and make sure at the end of the program there is
8647 * a single result on the stack. */
8648 for (i
= 0; i
< expr
->len
; i
++) {
8649 ScriptToken
*t
= &expr
->token
[i
];
8650 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8652 stacklen
-= op
->arity
;
8656 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8659 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8663 /* All operations and operands add one to the stack */
8666 if (stacklen
!= 1 || ternary
!= 0) {
8672 /* This procedure converts every occurrence of || and && opereators
8673 * in lazy unary versions.
8675 * a b || is converted into:
8677 * a <offset> |L b |R
8679 * a b && is converted into:
8681 * a <offset> &L b &R
8683 * "|L" checks if 'a' is true:
8684 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8685 * the opcode just after |R.
8686 * 2) if it is false does nothing.
8687 * "|R" checks if 'b' is true:
8688 * 1) if it is true pushes 1, otherwise pushes 0.
8690 * "&L" checks if 'a' is true:
8691 * 1) if it is true does nothing.
8692 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8693 * the opcode just after &R
8694 * "&R" checks if 'a' is true:
8695 * if it is true pushes 1, otherwise pushes 0.
8697 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8701 int leftindex
, arity
, offset
;
8703 /* Search for the end of the first operator */
8704 leftindex
= expr
->len
- 1;
8708 ScriptToken
*tt
= &expr
->token
[leftindex
];
8710 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8711 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8714 if (--leftindex
< 0) {
8721 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8722 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8724 offset
= (expr
->len
- leftindex
) - 1;
8726 /* Now we rely on the fact that the left and right version have opcodes
8727 * 1 and 2 after the main opcode respectively
8729 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8730 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8732 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8733 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8735 /* Now add the 'R' operator */
8736 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8737 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8740 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8741 for (i
= leftindex
- 1; i
> 0; i
--) {
8742 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8743 if (op
->lazy
== LAZY_LEFT
) {
8744 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8745 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8752 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8754 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8755 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8757 if (op
->lazy
== LAZY_OP
) {
8758 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8759 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8764 token
->objPtr
= interp
->emptyObj
;
8765 token
->type
= t
->type
;
8772 * Returns the index of the COLON_LEFT to the left of 'right_index'
8773 * taking into account nesting.
8775 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8777 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8779 int ternary_count
= 1;
8783 while (right_index
> 1) {
8784 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8787 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8790 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8801 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8803 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8804 * Otherwise returns 0.
8806 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8808 int i
= right_index
- 1;
8809 int ternary_count
= 1;
8812 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8813 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8814 *prev_right_index
= i
- 2;
8815 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8819 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8820 if (ternary_count
== 0) {
8831 * ExprTernaryReorderExpression description
8832 * ========================================
8834 * ?: is right-to-left associative which doesn't work with the stack-based
8835 * expression engine. The fix is to reorder the bytecode.
8841 * Has initial bytecode:
8843 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8844 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8846 * The fix involves simulating this expression instead:
8850 * With the following bytecode:
8852 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8853 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8855 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8856 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8857 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8858 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8860 * ExprTernaryReorderExpression works thus as follows :
8861 * - start from the end of the stack
8862 * - while walking towards the beginning of the stack
8863 * if token=JIM_EXPROP_COLON_RIGHT then
8864 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8865 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8866 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8868 * perform the rotation
8869 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8873 * Note: care has to be taken for nested ternary constructs!!!
8875 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
8879 for (i
= expr
->len
- 1; i
> 1; i
--) {
8880 int prev_right_index
;
8881 int prev_left_index
;
8885 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
8889 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8890 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
8895 ** rotate tokens down
8897 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8906 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8908 tmp
= expr
->token
[prev_right_index
];
8909 for (j
= prev_right_index
; j
< i
; j
++) {
8910 expr
->token
[j
] = expr
->token
[j
+ 1];
8912 expr
->token
[i
] = tmp
;
8914 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8916 * This is 'colon left increment' = i - prev_right_index
8918 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8919 * [prev_left_index-1] : skip_count
8922 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
8924 /* Adjust for i-- in the loop */
8929 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*fileNameObj
)
8935 int prevtt
= JIM_TT_NONE
;
8936 int have_ternary
= 0;
8939 int count
= tokenlist
->count
- 1;
8941 expr
= Jim_Alloc(sizeof(*expr
));
8945 Jim_InitStack(&stack
);
8947 /* Need extra bytecodes for lazy operators.
8948 * Also check for the ternary operator
8950 for (i
= 0; i
< tokenlist
->count
; i
++) {
8951 ParseToken
*t
= &tokenlist
->list
[i
];
8952 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8954 if (op
->lazy
== LAZY_OP
) {
8956 /* Ternary is a lazy op but also needs reordering */
8957 if (t
->type
== JIM_EXPROP_TERNARY
) {
8963 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
8965 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
8966 ParseToken
*t
= &tokenlist
->list
[i
];
8968 /* Next token will be stored here */
8969 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8971 if (t
->type
== JIM_TT_EOL
) {
8979 case JIM_TT_DICTSUGAR
:
8980 case JIM_TT_EXPRSUGAR
:
8982 token
->type
= t
->type
;
8984 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
8985 if (t
->type
== JIM_TT_CMD
) {
8986 /* Only commands need source info */
8987 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
8992 case JIM_TT_EXPR_INT
:
8993 case JIM_TT_EXPR_DOUBLE
:
8996 if (t
->type
== JIM_TT_EXPR_INT
) {
8997 token
->objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
9000 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9002 if (endptr
!= t
->token
+ t
->len
) {
9003 /* Conversion failed, so just store it as a string */
9004 Jim_FreeNewObj(interp
, token
->objPtr
);
9005 token
->type
= JIM_TT_STR
;
9008 token
->type
= t
->type
;
9013 case JIM_TT_SUBEXPR_START
:
9014 Jim_StackPush(&stack
, t
);
9015 prevtt
= JIM_TT_NONE
;
9018 case JIM_TT_SUBEXPR_COMMA
:
9019 /* Simple approach. Comma is simply ignored */
9022 case JIM_TT_SUBEXPR_END
:
9024 while (Jim_StackLen(&stack
)) {
9025 ParseToken
*tt
= Jim_StackPop(&stack
);
9027 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9032 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9037 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
9044 /* Must be an operator */
9045 const struct Jim_ExprOperator
*op
;
9048 /* Convert -/+ to unary minus or unary plus if necessary */
9049 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
9050 if (t
->type
== JIM_EXPROP_SUB
) {
9051 t
->type
= JIM_EXPROP_UNARYMINUS
;
9053 else if (t
->type
== JIM_EXPROP_ADD
) {
9054 t
->type
= JIM_EXPROP_UNARYPLUS
;
9058 op
= JimExprOperatorInfoByOpcode(t
->type
);
9060 /* Now handle precedence */
9061 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9062 const struct Jim_ExprOperator
*tt_op
=
9063 JimExprOperatorInfoByOpcode(tt
->type
);
9065 /* Note that right-to-left associativity of ?: operator is handled later */
9067 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9068 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9072 Jim_StackPop(&stack
);
9078 Jim_StackPush(&stack
, t
);
9085 /* Reduce any remaining subexpr */
9086 while (Jim_StackLen(&stack
)) {
9087 ParseToken
*tt
= Jim_StackPop(&stack
);
9089 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9091 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9094 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9101 ExprTernaryReorderExpression(interp
, expr
);
9105 /* Free the stack used for the compilation. */
9106 Jim_FreeStack(&stack
);
9108 for (i
= 0; i
< expr
->len
; i
++) {
9109 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9113 ExprFreeByteCode(interp
, expr
);
9121 /* This method takes the string representation of an expression
9122 * and generates a program for the Expr's stack-based VM. */
9123 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9126 const char *exprText
;
9127 struct JimParserCtx parser
;
9128 struct ExprByteCode
*expr
;
9129 ParseTokenList tokenlist
;
9131 Jim_Obj
*fileNameObj
;
9134 /* Try to get information about filename / line number */
9135 if (objPtr
->typePtr
== &sourceObjType
) {
9136 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9137 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9140 fileNameObj
= interp
->emptyObj
;
9143 Jim_IncrRefCount(fileNameObj
);
9145 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9147 /* Initially tokenise the expression into tokenlist */
9148 ScriptTokenListInit(&tokenlist
);
9150 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9151 while (!parser
.eof
) {
9152 if (JimParseExpression(&parser
) != JIM_OK
) {
9153 ScriptTokenListFree(&tokenlist
);
9155 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9160 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9164 #ifdef DEBUG_SHOW_EXPR_TOKENS
9167 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9168 for (i
= 0; i
< tokenlist
.count
; i
++) {
9169 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9170 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9175 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9176 ScriptTokenListFree(&tokenlist
);
9177 Jim_DecrRefCount(interp
, fileNameObj
);
9181 /* Now create the expression bytecode from the tokenlist */
9182 expr
= ExprCreateByteCode(interp
, &tokenlist
, fileNameObj
);
9184 /* No longer need the token list */
9185 ScriptTokenListFree(&tokenlist
);
9191 #ifdef DEBUG_SHOW_EXPR
9195 printf("==== Expr ====\n");
9196 for (i
= 0; i
< expr
->len
; i
++) {
9197 ScriptToken
*t
= &expr
->token
[i
];
9199 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9204 /* Check program correctness. */
9205 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
9206 ExprFreeByteCode(interp
, expr
);
9213 /* Free the old internal rep and set the new one. */
9214 Jim_DecrRefCount(interp
, fileNameObj
);
9215 Jim_FreeIntRep(interp
, objPtr
);
9216 Jim_SetIntRepPtr(objPtr
, expr
);
9217 objPtr
->typePtr
= &exprObjType
;
9221 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9223 if (objPtr
->typePtr
!= &exprObjType
) {
9224 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9228 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9231 #ifdef JIM_OPTIMIZATION
9232 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9234 if (token
->type
== JIM_TT_EXPR_INT
)
9235 return token
->objPtr
;
9236 else if (token
->type
== JIM_TT_VAR
)
9237 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9238 else if (token
->type
== JIM_TT_DICTSUGAR
)
9239 return JimExpandDictSugar(interp
, token
->objPtr
);
9245 /* -----------------------------------------------------------------------------
9246 * Expressions evaluation.
9247 * Jim uses a specialized stack-based virtual machine for expressions,
9248 * that takes advantage of the fact that expr's operators
9249 * can't be redefined.
9251 * Jim_EvalExpression() uses the bytecode compiled by
9252 * SetExprFromAny() method of the "expression" object.
9254 * On success a Tcl Object containing the result of the evaluation
9255 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9257 * On error the function returns a retcode != to JIM_OK and set a suitable
9258 * error on the interp.
9259 * ---------------------------------------------------------------------------*/
9260 #define JIM_EE_STATICSTACK_LEN 10
9262 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9265 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9267 int retcode
= JIM_OK
;
9268 struct JimExprState e
;
9270 expr
= JimGetExpression(interp
, exprObjPtr
);
9272 return JIM_ERR
; /* error in expression. */
9275 #ifdef JIM_OPTIMIZATION
9276 /* Check for one of the following common expressions used by while/for
9281 * $a < CONST, $a < $b
9282 * $a <= CONST, $a <= $b
9283 * $a > CONST, $a > $b
9284 * $a >= CONST, $a >= $b
9285 * $a != CONST, $a != $b
9286 * $a == CONST, $a == $b
9291 /* STEP 1 -- Check if there are the conditions to run the specialized
9292 * version of while */
9294 switch (expr
->len
) {
9296 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9298 Jim_IncrRefCount(objPtr
);
9299 *exprResultPtrPtr
= objPtr
;
9305 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9306 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9308 if (objPtr
&& JimIsWide(objPtr
)) {
9309 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9310 Jim_IncrRefCount(*exprResultPtrPtr
);
9317 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9318 if (objPtr
&& JimIsWide(objPtr
)) {
9319 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9320 if (objPtr2
&& JimIsWide(objPtr2
)) {
9321 jim_wide wideValueA
= JimWideValue(objPtr
);
9322 jim_wide wideValueB
= JimWideValue(objPtr2
);
9324 switch (expr
->token
[2].type
) {
9326 cmpRes
= wideValueA
< wideValueB
;
9328 case JIM_EXPROP_LTE
:
9329 cmpRes
= wideValueA
<= wideValueB
;
9332 cmpRes
= wideValueA
> wideValueB
;
9334 case JIM_EXPROP_GTE
:
9335 cmpRes
= wideValueA
>= wideValueB
;
9337 case JIM_EXPROP_NUMEQ
:
9338 cmpRes
= wideValueA
== wideValueB
;
9340 case JIM_EXPROP_NUMNE
:
9341 cmpRes
= wideValueA
!= wideValueB
;
9346 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9347 Jim_IncrRefCount(*exprResultPtrPtr
);
9357 /* In order to avoid that the internal repr gets freed due to
9358 * shimmering of the exprObjPtr's object, we make the internal rep
9362 /* The stack-based expr VM itself */
9364 /* Stack allocation. Expr programs have the feature that
9365 * a program of length N can't require a stack longer than
9367 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9368 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9370 e
.stack
= staticStack
;
9374 /* Execute every instruction */
9375 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9378 switch (expr
->token
[i
].type
) {
9379 case JIM_TT_EXPR_INT
:
9380 case JIM_TT_EXPR_DOUBLE
:
9382 ExprPush(&e
, expr
->token
[i
].objPtr
);
9386 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9388 ExprPush(&e
, objPtr
);
9395 case JIM_TT_DICTSUGAR
:
9396 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9398 ExprPush(&e
, objPtr
);
9406 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9407 if (retcode
== JIM_OK
) {
9408 ExprPush(&e
, objPtr
);
9413 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9414 if (retcode
== JIM_OK
) {
9415 ExprPush(&e
, Jim_GetResult(interp
));
9420 /* Find and execute the operation */
9422 e
.opcode
= expr
->token
[i
].type
;
9424 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9425 /* Skip some opcodes if necessary */
9434 if (retcode
== JIM_OK
) {
9435 *exprResultPtrPtr
= ExprPop(&e
);
9438 for (i
= 0; i
< e
.stacklen
; i
++) {
9439 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9442 if (e
.stack
!= staticStack
) {
9448 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9453 Jim_Obj
*exprResultPtr
;
9455 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9456 if (retcode
!= JIM_OK
)
9459 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9460 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9461 Jim_DecrRefCount(interp
, exprResultPtr
);
9465 Jim_DecrRefCount(interp
, exprResultPtr
);
9466 *boolPtr
= doubleValue
!= 0;
9470 *boolPtr
= wideValue
!= 0;
9472 Jim_DecrRefCount(interp
, exprResultPtr
);
9476 /* -----------------------------------------------------------------------------
9477 * ScanFormat String Object
9478 * ---------------------------------------------------------------------------*/
9480 /* This Jim_Obj will held a parsed representation of a format string passed to
9481 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9482 * to be parsed in its entirely first and then, if correct, can be used for
9483 * scanning. To avoid endless re-parsing, the parsed representation will be
9484 * stored in an internal representation and re-used for performance reason. */
9486 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9487 * scanformat string. This part will later be used to extract information
9488 * out from the string to be parsed by Jim_ScanString */
9490 typedef struct ScanFmtPartDescr
9492 char *arg
; /* Specification of a CHARSET conversion */
9493 char *prefix
; /* Prefix to be scanned literally before conversion */
9494 size_t width
; /* Maximal width of input to be converted */
9495 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9496 char type
; /* Type of conversion (e.g. c, d, f) */
9497 char modifier
; /* Modify type (e.g. l - long, h - short */
9500 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9501 * string parsed and separated in part descriptions. Furthermore it contains
9502 * the original string representation of the scanformat string to allow for
9503 * fast update of the Jim_Obj's string representation part.
9505 * As an add-on the internal object representation adds some scratch pad area
9506 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9507 * memory for purpose of string scanning.
9509 * The error member points to a static allocated string in case of a mal-
9510 * formed scanformat string or it contains '0' (NULL) in case of a valid
9511 * parse representation.
9513 * The whole memory of the internal representation is allocated as a single
9514 * area of memory that will be internally separated. So freeing and duplicating
9515 * of such an object is cheap */
9517 typedef struct ScanFmtStringObj
9519 jim_wide size
; /* Size of internal repr in bytes */
9520 char *stringRep
; /* Original string representation */
9521 size_t count
; /* Number of ScanFmtPartDescr contained */
9522 size_t convCount
; /* Number of conversions that will assign */
9523 size_t maxPos
; /* Max position index if XPG3 is used */
9524 const char *error
; /* Ptr to error text (NULL if no error */
9525 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9526 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9530 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9531 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9532 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9534 static const Jim_ObjType scanFmtStringObjType
= {
9536 FreeScanFmtInternalRep
,
9537 DupScanFmtInternalRep
,
9538 UpdateStringOfScanFmt
,
9542 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9544 JIM_NOTUSED(interp
);
9545 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9546 objPtr
->internalRep
.ptr
= 0;
9549 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9551 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9552 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9554 JIM_NOTUSED(interp
);
9555 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9556 dupPtr
->internalRep
.ptr
= newVec
;
9557 dupPtr
->typePtr
= &scanFmtStringObjType
;
9560 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9562 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9565 /* SetScanFmtFromAny will parse a given string and create the internal
9566 * representation of the format specification. In case of an error
9567 * the error data member of the internal representation will be set
9568 * to an descriptive error text and the function will be left with
9569 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9572 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9574 ScanFmtStringObj
*fmtObj
;
9576 int maxCount
, i
, approxSize
, lastPos
= -1;
9577 const char *fmt
= objPtr
->bytes
;
9578 int maxFmtLen
= objPtr
->length
;
9579 const char *fmtEnd
= fmt
+ maxFmtLen
;
9582 Jim_FreeIntRep(interp
, objPtr
);
9583 /* Count how many conversions could take place maximally */
9584 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9587 /* Calculate an approximation of the memory necessary */
9588 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9589 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9590 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9591 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9592 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9593 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9594 +1; /* safety byte */
9595 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9596 memset(fmtObj
, 0, approxSize
);
9597 fmtObj
->size
= approxSize
;
9599 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9600 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9601 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9602 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9603 objPtr
->internalRep
.ptr
= fmtObj
;
9604 objPtr
->typePtr
= &scanFmtStringObjType
;
9605 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9606 int width
= 0, skip
;
9607 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9610 descr
->width
= 0; /* Assume width unspecified */
9611 /* Overread and store any "literal" prefix */
9612 if (*fmt
!= '%' || fmt
[1] == '%') {
9614 descr
->prefix
= &buffer
[i
];
9615 for (; fmt
< fmtEnd
; ++fmt
) {
9625 /* Skip the conversion introducing '%' sign */
9627 /* End reached due to non-conversion literal only? */
9630 descr
->pos
= 0; /* Assume "natural" positioning */
9632 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9636 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9637 /* Check if next token is a number (could be width or pos */
9638 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9640 /* Was the number a XPG3 position specifier? */
9641 if (descr
->pos
!= -1 && *fmt
== '$') {
9647 /* Look if "natural" postioning and XPG3 one was mixed */
9648 if ((lastPos
== 0 && descr
->pos
> 0)
9649 || (lastPos
> 0 && descr
->pos
== 0)) {
9650 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9653 /* Look if this position was already used */
9654 for (prev
= 0; prev
< curr
; ++prev
) {
9655 if (fmtObj
->descr
[prev
].pos
== -1)
9657 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9659 "variable is assigned by multiple \"%n$\" conversion specifiers";
9663 /* Try to find a width after the XPG3 specifier */
9664 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9665 descr
->width
= width
;
9668 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9669 fmtObj
->maxPos
= descr
->pos
;
9672 /* Number was not a XPG3, so it has to be a width */
9673 descr
->width
= width
;
9676 /* If positioning mode was undetermined yet, fix this */
9678 lastPos
= descr
->pos
;
9679 /* Handle CHARSET conversion type ... */
9681 int swapped
= 1, beg
= i
, end
, j
;
9684 descr
->arg
= &buffer
[i
];
9687 buffer
[i
++] = *fmt
++;
9689 buffer
[i
++] = *fmt
++;
9690 while (*fmt
&& *fmt
!= ']')
9691 buffer
[i
++] = *fmt
++;
9693 fmtObj
->error
= "unmatched [ in format string";
9698 /* In case a range fence was given "backwards", swap it */
9701 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9702 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9703 char tmp
= buffer
[j
- 1];
9705 buffer
[j
- 1] = buffer
[j
+ 1];
9706 buffer
[j
+ 1] = tmp
;
9713 /* Remember any valid modifier if given */
9714 if (strchr("hlL", *fmt
) != 0)
9715 descr
->modifier
= tolower((int)*fmt
++);
9718 if (strchr("efgcsndoxui", *fmt
) == 0) {
9719 fmtObj
->error
= "bad scan conversion character";
9722 else if (*fmt
== 'c' && descr
->width
!= 0) {
9723 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9726 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9727 fmtObj
->error
= "unsigned wide not supported";
9737 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9739 #define FormatGetCnvCount(_fo_) \
9740 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9741 #define FormatGetMaxPos(_fo_) \
9742 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9743 #define FormatGetError(_fo_) \
9744 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9746 /* JimScanAString is used to scan an unspecified string that ends with
9747 * next WS, or a string that is specified via a charset.
9750 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9752 char *buffer
= Jim_StrDup(str
);
9759 if (!sdescr
&& isspace(UCHAR(*str
)))
9760 break; /* EOS via WS if unspecified */
9762 n
= utf8_tounicode(str
, &c
);
9763 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9769 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9772 /* ScanOneEntry will scan one entry out of the string passed as argument.
9773 * It use the sscanf() function for this task. After extracting and
9774 * converting of the value, the count of scanned characters will be
9775 * returned of -1 in case of no conversion tool place and string was
9776 * already scanned thru */
9778 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9779 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9782 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9784 size_t anchor
= pos
;
9786 Jim_Obj
*tmpObj
= NULL
;
9788 /* First pessimistically assume, we will not scan anything :-) */
9790 if (descr
->prefix
) {
9791 /* There was a prefix given before the conversion, skip it and adjust
9792 * the string-to-be-parsed accordingly */
9793 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9794 /* If prefix require, skip WS */
9795 if (isspace(UCHAR(descr
->prefix
[i
])))
9796 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9798 else if (descr
->prefix
[i
] != str
[pos
])
9799 break; /* Prefix do not match here, leave the loop */
9801 ++pos
; /* Prefix matched so far, next round */
9803 if (pos
>= strLen
) {
9804 return -1; /* All of str consumed: EOF condition */
9806 else if (descr
->prefix
[i
] != 0)
9807 return 0; /* Not whole prefix consumed, no conversion possible */
9809 /* For all but following conversion, skip leading WS */
9810 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9811 while (isspace(UCHAR(str
[pos
])))
9813 /* Determine how much skipped/scanned so far */
9814 scanned
= pos
- anchor
;
9816 /* %c is a special, simple case. no width */
9817 if (descr
->type
== 'n') {
9818 /* Return pseudo conversion means: how much scanned so far? */
9819 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9821 else if (pos
>= strLen
) {
9822 /* Cannot scan anything, as str is totally consumed */
9825 else if (descr
->type
== 'c') {
9827 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9828 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9832 /* Processing of conversions follows ... */
9833 if (descr
->width
> 0) {
9834 /* Do not try to scan as fas as possible but only the given width.
9835 * To ensure this, we copy the part that should be scanned. */
9836 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9837 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9839 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9840 tok
= tmpObj
->bytes
;
9843 /* As no width was given, simply refer to the original string */
9846 switch (descr
->type
) {
9852 char *endp
; /* Position where the number finished */
9855 int base
= descr
->type
== 'o' ? 8
9856 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
9858 /* Try to scan a number with the given base */
9860 w
= jim_strtoull(tok
, &endp
);
9863 w
= strtoull(tok
, &endp
, base
);
9867 /* There was some number sucessfully scanned! */
9868 *valObjPtr
= Jim_NewIntObj(interp
, w
);
9870 /* Adjust the number-of-chars scanned so far */
9871 scanned
+= endp
- tok
;
9874 /* Nothing was scanned. We have to determine if this
9875 * happened due to e.g. prefix mismatch or input str
9877 scanned
= *tok
? 0 : -1;
9883 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
9884 scanned
+= Jim_Length(*valObjPtr
);
9891 double value
= strtod(tok
, &endp
);
9894 /* There was some number sucessfully scanned! */
9895 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
9896 /* Adjust the number-of-chars scanned so far */
9897 scanned
+= endp
- tok
;
9900 /* Nothing was scanned. We have to determine if this
9901 * happened due to e.g. prefix mismatch or input str
9903 scanned
= *tok
? 0 : -1;
9908 /* If a substring was allocated (due to pre-defined width) do not
9909 * forget to free it */
9911 Jim_FreeNewObj(interp
, tmpObj
);
9917 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9918 * string and returns all converted (and not ignored) values in a list back
9919 * to the caller. If an error occured, a NULL pointer will be returned */
9921 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
9925 const char *str
= Jim_String(strObjPtr
);
9926 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
9927 Jim_Obj
*resultList
= 0;
9928 Jim_Obj
**resultVec
= 0;
9930 Jim_Obj
*emptyStr
= 0;
9931 ScanFmtStringObj
*fmtObj
;
9933 /* This should never happen. The format object should already be of the correct type */
9934 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
9936 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
9937 /* Check if format specification was valid */
9938 if (fmtObj
->error
!= 0) {
9939 if (flags
& JIM_ERRMSG
)
9940 Jim_SetResultString(interp
, fmtObj
->error
, -1);
9943 /* Allocate a new "shared" empty string for all unassigned conversions */
9944 emptyStr
= Jim_NewEmptyStringObj(interp
);
9945 Jim_IncrRefCount(emptyStr
);
9946 /* Create a list and fill it with empty strings up to max specified XPG3 */
9947 resultList
= Jim_NewListObj(interp
, NULL
, 0);
9948 if (fmtObj
->maxPos
> 0) {
9949 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
9950 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
9951 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
9953 /* Now handle every partial format description */
9954 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
9955 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
9958 /* Only last type may be "literal" w/o conversion - skip it! */
9959 if (descr
->type
== 0)
9961 /* As long as any conversion could be done, we will proceed */
9963 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
9964 /* In case our first try results in EOF, we will leave */
9965 if (scanned
== -1 && i
== 0)
9967 /* Advance next pos-to-be-scanned for the amount scanned already */
9970 /* value == 0 means no conversion took place so take empty string */
9972 value
= Jim_NewEmptyStringObj(interp
);
9973 /* If value is a non-assignable one, skip it */
9974 if (descr
->pos
== -1) {
9975 Jim_FreeNewObj(interp
, value
);
9977 else if (descr
->pos
== 0)
9978 /* Otherwise append it to the result list if no XPG3 was given */
9979 Jim_ListAppendElement(interp
, resultList
, value
);
9980 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
9981 /* But due to given XPG3, put the value into the corr. slot */
9982 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
9983 Jim_IncrRefCount(value
);
9984 resultVec
[descr
->pos
- 1] = value
;
9987 /* Otherwise, the slot was already used - free obj and ERROR */
9988 Jim_FreeNewObj(interp
, value
);
9992 Jim_DecrRefCount(interp
, emptyStr
);
9995 Jim_DecrRefCount(interp
, emptyStr
);
9996 Jim_FreeNewObj(interp
, resultList
);
9997 return (Jim_Obj
*)EOF
;
9999 Jim_DecrRefCount(interp
, emptyStr
);
10000 Jim_FreeNewObj(interp
, resultList
);
10004 /* -----------------------------------------------------------------------------
10005 * Pseudo Random Number Generation
10006 * ---------------------------------------------------------------------------*/
10007 /* Initialize the sbox with the numbers from 0 to 255 */
10008 static void JimPrngInit(Jim_Interp
*interp
)
10010 #define PRNG_SEED_SIZE 256
10012 unsigned int *seed
;
10013 time_t t
= time(NULL
);
10015 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10017 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10018 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10019 seed
[i
] = (rand() ^ t
^ clock());
10021 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10025 /* Generates N bytes of random data */
10026 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10028 Jim_PrngState
*prng
;
10029 unsigned char *destByte
= (unsigned char *)dest
;
10030 unsigned int si
, sj
, x
;
10032 /* initialization, only needed the first time */
10033 if (interp
->prngState
== NULL
)
10034 JimPrngInit(interp
);
10035 prng
= interp
->prngState
;
10036 /* generates 'len' bytes of pseudo-random numbers */
10037 for (x
= 0; x
< len
; x
++) {
10038 prng
->i
= (prng
->i
+ 1) & 0xff;
10039 si
= prng
->sbox
[prng
->i
];
10040 prng
->j
= (prng
->j
+ si
) & 0xff;
10041 sj
= prng
->sbox
[prng
->j
];
10042 prng
->sbox
[prng
->i
] = sj
;
10043 prng
->sbox
[prng
->j
] = si
;
10044 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10048 /* Re-seed the generator with user-provided bytes */
10049 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10052 Jim_PrngState
*prng
;
10054 /* initialization, only needed the first time */
10055 if (interp
->prngState
== NULL
)
10056 JimPrngInit(interp
);
10057 prng
= interp
->prngState
;
10059 /* Set the sbox[i] with i */
10060 for (i
= 0; i
< 256; i
++)
10062 /* Now use the seed to perform a random permutation of the sbox */
10063 for (i
= 0; i
< seedLen
; i
++) {
10066 t
= prng
->sbox
[i
& 0xFF];
10067 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10068 prng
->sbox
[seed
[i
]] = t
;
10070 prng
->i
= prng
->j
= 0;
10072 /* discard at least the first 256 bytes of stream.
10073 * borrow the seed buffer for this
10075 for (i
= 0; i
< 256; i
+= seedLen
) {
10076 JimRandomBytes(interp
, seed
, seedLen
);
10081 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10083 jim_wide wideValue
, increment
= 1;
10084 Jim_Obj
*intObjPtr
;
10086 if (argc
!= 2 && argc
!= 3) {
10087 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10091 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10094 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10096 /* Set missing variable to 0 */
10099 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10102 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10103 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10104 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10105 Jim_FreeNewObj(interp
, intObjPtr
);
10110 /* Can do it the quick way */
10111 Jim_InvalidateStringRep(intObjPtr
);
10112 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10114 /* The following step is required in order to invalidate the
10115 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10116 if (argv
[1]->typePtr
!= &variableObjType
) {
10117 /* Note that this can't fail since GetVariable already succeeded */
10118 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10121 Jim_SetResult(interp
, intObjPtr
);
10126 /* -----------------------------------------------------------------------------
10128 * ---------------------------------------------------------------------------*/
10129 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10130 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10132 /* Handle calls to the [unknown] command */
10133 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10137 /* If JimUnknown() is recursively called too many times...
10140 if (interp
->unknown_called
> 50) {
10144 /* The object interp->unknown just contains
10145 * the "unknown" string, it is used in order to
10146 * avoid to lookup the unknown command every time
10147 * but instead to cache the result. */
10149 /* If the [unknown] command does not exist ... */
10150 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10153 interp
->unknown_called
++;
10154 /* XXX: Are we losing fileNameObj and linenr? */
10155 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10156 interp
->unknown_called
--;
10161 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10169 for (j
= 0; j
< objc
; j
++) {
10170 printf(" '%s'", Jim_String(objv
[j
]));
10175 if (interp
->framePtr
->tailcallCmd
) {
10176 /* Special tailcall command was pre-resolved */
10177 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10178 interp
->framePtr
->tailcallCmd
= NULL
;
10181 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10182 if (cmdPtr
== NULL
) {
10183 return JimUnknown(interp
, objc
, objv
);
10185 JimIncrCmdRefCount(cmdPtr
);
10188 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10189 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10193 interp
->evalDepth
++;
10195 /* Call it -- Make sure result is an empty object. */
10196 Jim_SetEmptyResult(interp
);
10197 if (cmdPtr
->isproc
) {
10198 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10201 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10202 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10204 interp
->evalDepth
--;
10207 JimDecrCmdRefCount(interp
, cmdPtr
);
10212 /* Eval the object vector 'objv' composed of 'objc' elements.
10213 * Every element is used as single argument.
10214 * Jim_EvalObj() will call this function every time its object
10215 * argument is of "list" type, with no string representation.
10217 * This is possible because the string representation of a
10218 * list object generated by the UpdateStringOfList is made
10219 * in a way that ensures that every list element is a different
10220 * command argument. */
10221 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10225 /* Incr refcount of arguments. */
10226 for (i
= 0; i
< objc
; i
++)
10227 Jim_IncrRefCount(objv
[i
]);
10229 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10231 /* Decr refcount of arguments and return the retcode */
10232 for (i
= 0; i
< objc
; i
++)
10233 Jim_DecrRefCount(interp
, objv
[i
]);
10239 * Invokes 'prefix' as a command with the objv array as arguments.
10241 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10244 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10247 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10248 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10253 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10255 if (!interp
->errorFlag
) {
10256 /* This is the first error, so save the file/line information and reset the stack */
10257 interp
->errorFlag
= 1;
10258 Jim_IncrRefCount(script
->fileNameObj
);
10259 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10260 interp
->errorFileNameObj
= script
->fileNameObj
;
10261 interp
->errorLine
= script
->linenr
;
10263 JimResetStackTrace(interp
);
10264 /* Always add a level where the error first occurs */
10265 interp
->addStackTrace
++;
10268 /* Now if this is an "interesting" level, add it to the stack trace */
10269 if (interp
->addStackTrace
> 0) {
10270 /* Add the stack info for the current level */
10272 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10274 /* Note: if we didn't have a filename for this level,
10275 * don't clear the addStackTrace flag
10276 * so we can pick it up at the next level
10278 if (Jim_Length(script
->fileNameObj
)) {
10279 interp
->addStackTrace
= 0;
10282 Jim_DecrRefCount(interp
, interp
->errorProc
);
10283 interp
->errorProc
= interp
->emptyObj
;
10284 Jim_IncrRefCount(interp
->errorProc
);
10288 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10292 switch (token
->type
) {
10295 objPtr
= token
->objPtr
;
10298 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10300 case JIM_TT_DICTSUGAR
:
10301 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10303 case JIM_TT_EXPRSUGAR
:
10304 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10307 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10310 objPtr
= interp
->result
;
10313 /* Stop substituting */
10316 /* just skip this one */
10317 return JIM_CONTINUE
;
10324 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10329 *objPtrPtr
= objPtr
;
10335 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10336 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10337 * The returned object has refcount = 0.
10339 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10343 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10347 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10350 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10352 /* Compute every token forming the argument
10353 * in the intv objects vector. */
10354 for (i
= 0; i
< tokens
; i
++) {
10355 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10360 if (flags
& JIM_SUBST_FLAG
) {
10365 /* XXX: Should probably set an error about break outside loop */
10366 /* fall through to error */
10368 if (flags
& JIM_SUBST_FLAG
) {
10372 /* XXX: Ditto continue outside loop */
10373 /* fall through to error */
10376 Jim_DecrRefCount(interp
, intv
[i
]);
10378 if (intv
!= sintv
) {
10383 Jim_IncrRefCount(intv
[i
]);
10384 Jim_String(intv
[i
]);
10385 totlen
+= intv
[i
]->length
;
10388 /* Fast path return for a single token */
10389 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10390 Jim_DecrRefCount(interp
, intv
[0]);
10394 /* Concatenate every token in an unique
10396 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10398 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10399 && token
[2].type
== JIM_TT_VAR
) {
10400 /* May be able to do fast interpolated object -> dictSubst */
10401 objPtr
->typePtr
= &interpolatedObjType
;
10402 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10403 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10404 Jim_IncrRefCount(intv
[2]);
10406 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10407 /* The first interpolated token is source, so preserve the source info */
10408 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10412 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10413 objPtr
->length
= totlen
;
10414 for (i
= 0; i
< tokens
; i
++) {
10416 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10417 s
+= intv
[i
]->length
;
10418 Jim_DecrRefCount(interp
, intv
[i
]);
10421 objPtr
->bytes
[totlen
] = '\0';
10422 /* Free the intv vector if not static. */
10423 if (intv
!= sintv
) {
10431 /* listPtr *must* be a list.
10432 * The contents of the list is evaluated with the first element as the command and
10433 * the remaining elements as the arguments.
10435 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10437 int retcode
= JIM_OK
;
10439 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10441 if (listPtr
->internalRep
.listValue
.len
) {
10442 Jim_IncrRefCount(listPtr
);
10443 retcode
= JimInvokeCommand(interp
,
10444 listPtr
->internalRep
.listValue
.len
,
10445 listPtr
->internalRep
.listValue
.ele
);
10446 Jim_DecrRefCount(interp
, listPtr
);
10451 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10453 SetListFromAny(interp
, listPtr
);
10454 return JimEvalObjList(interp
, listPtr
);
10457 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10461 ScriptToken
*token
;
10462 int retcode
= JIM_OK
;
10463 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10464 Jim_Obj
*prevScriptObj
;
10466 /* If the object is of type "list", with no string rep we can call
10467 * a specialized version of Jim_EvalObj() */
10468 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10469 return JimEvalObjList(interp
, scriptObjPtr
);
10472 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10473 script
= JimGetScript(interp
, scriptObjPtr
);
10474 if (!JimScriptValid(interp
, script
)) {
10475 Jim_DecrRefCount(interp
, scriptObjPtr
);
10479 /* Reset the interpreter result. This is useful to
10480 * return the empty result in the case of empty program. */
10481 Jim_SetEmptyResult(interp
);
10483 token
= script
->token
;
10485 #ifdef JIM_OPTIMIZATION
10486 /* Check for one of the following common scripts used by for, while
10491 if (script
->len
== 0) {
10492 Jim_DecrRefCount(interp
, scriptObjPtr
);
10495 if (script
->len
== 3
10496 && token
[1].objPtr
->typePtr
== &commandObjType
10497 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10498 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10499 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10501 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10503 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10504 JimWideValue(objPtr
)++;
10505 Jim_InvalidateStringRep(objPtr
);
10506 Jim_DecrRefCount(interp
, scriptObjPtr
);
10507 Jim_SetResult(interp
, objPtr
);
10513 /* Now we have to make sure the internal repr will not be
10514 * freed on shimmering.
10516 * Think for example to this:
10518 * set x {llength $x; ... some more code ...}; eval $x
10520 * In order to preserve the internal rep, we increment the
10521 * inUse field of the script internal rep structure. */
10524 /* Stash the current script */
10525 prevScriptObj
= interp
->currentScriptObj
;
10526 interp
->currentScriptObj
= scriptObjPtr
;
10528 interp
->errorFlag
= 0;
10531 /* Execute every command sequentially until the end of the script
10532 * or an error occurs.
10534 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10538 /* First token of the line is always JIM_TT_LINE */
10539 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10540 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10542 /* Allocate the arguments vector if required */
10543 if (argc
> JIM_EVAL_SARGV_LEN
)
10544 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10546 /* Skip the JIM_TT_LINE token */
10549 /* Populate the arguments objects.
10550 * If an error occurs, retcode will be set and
10551 * 'j' will be set to the number of args expanded
10553 for (j
= 0; j
< argc
; j
++) {
10554 long wordtokens
= 1;
10556 Jim_Obj
*wordObjPtr
= NULL
;
10558 if (token
[i
].type
== JIM_TT_WORD
) {
10559 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10560 if (wordtokens
< 0) {
10562 wordtokens
= -wordtokens
;
10566 if (wordtokens
== 1) {
10567 /* Fast path if the token does not
10568 * need interpolation */
10570 switch (token
[i
].type
) {
10573 wordObjPtr
= token
[i
].objPtr
;
10576 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10578 case JIM_TT_EXPRSUGAR
:
10579 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10581 case JIM_TT_DICTSUGAR
:
10582 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10585 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10586 if (retcode
== JIM_OK
) {
10587 wordObjPtr
= Jim_GetResult(interp
);
10591 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10595 /* For interpolation we call a helper
10596 * function to do the work for us. */
10597 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10601 if (retcode
== JIM_OK
) {
10607 Jim_IncrRefCount(wordObjPtr
);
10611 argv
[j
] = wordObjPtr
;
10614 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10615 int len
= Jim_ListLength(interp
, wordObjPtr
);
10616 int newargc
= argc
+ len
- 1;
10620 if (argv
== sargv
) {
10621 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10622 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10623 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10627 /* Need to realloc to make room for (len - 1) more entries */
10628 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10632 /* Now copy in the expanded version */
10633 for (k
= 0; k
< len
; k
++) {
10634 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10635 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10638 /* The original object reference is no longer needed,
10639 * after the expansion it is no longer present on
10640 * the argument vector, but the single elements are
10642 Jim_DecrRefCount(interp
, wordObjPtr
);
10644 /* And update the indexes */
10650 if (retcode
== JIM_OK
&& argc
) {
10651 /* Invoke the command */
10652 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10653 /* Check for a signal after each command */
10654 if (Jim_CheckSignal(interp
)) {
10655 retcode
= JIM_SIGNAL
;
10659 /* Finished with the command, so decrement ref counts of each argument */
10661 Jim_DecrRefCount(interp
, argv
[j
]);
10664 if (argv
!= sargv
) {
10670 /* Possibly add to the error stack trace */
10671 if (retcode
== JIM_ERR
) {
10672 JimAddErrorToStack(interp
, script
);
10674 /* Propagate the addStackTrace value through 'return -code error' */
10675 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10676 /* No need to add stack trace */
10677 interp
->addStackTrace
= 0;
10680 /* Restore the current script */
10681 interp
->currentScriptObj
= prevScriptObj
;
10683 /* Note that we don't have to decrement inUse, because the
10684 * following code transfers our use of the reference again to
10685 * the script object. */
10686 Jim_FreeIntRep(interp
, scriptObjPtr
);
10687 scriptObjPtr
->typePtr
= &scriptObjType
;
10688 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10689 Jim_DecrRefCount(interp
, scriptObjPtr
);
10694 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10697 /* If argObjPtr begins with '&', do an automatic upvar */
10698 const char *varname
= Jim_String(argNameObj
);
10699 if (*varname
== '&') {
10700 /* First check that the target variable exists */
10702 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10704 interp
->framePtr
= interp
->framePtr
->parent
;
10705 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10706 interp
->framePtr
= savedCallFrame
;
10711 /* It exists, so perform the binding. */
10712 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10713 Jim_IncrRefCount(objPtr
);
10714 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10715 Jim_DecrRefCount(interp
, objPtr
);
10718 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10724 * Sets the interp result to be an error message indicating the required proc args.
10726 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10728 /* Create a nice error message, consistent with Tcl 8.5 */
10729 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10732 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10733 Jim_AppendString(interp
, argmsg
, " ", 1);
10735 if (i
== cmd
->u
.proc
.argsPos
) {
10736 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10738 Jim_AppendString(interp
, argmsg
, "?", 1);
10739 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10740 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10743 /* We have plain args */
10744 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10748 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10749 Jim_AppendString(interp
, argmsg
, "?", 1);
10750 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10751 Jim_AppendString(interp
, argmsg
, "?", 1);
10754 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10758 Jim_AppendString(interp
, argmsg
, arg
, -1);
10762 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10763 Jim_FreeNewObj(interp
, argmsg
);
10766 #ifdef jim_ext_namespace
10770 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10772 Jim_CallFrame
*callFramePtr
;
10775 /* Create a new callframe */
10776 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10777 callFramePtr
->argv
= &interp
->emptyObj
;
10778 callFramePtr
->argc
= 0;
10779 callFramePtr
->procArgsObjPtr
= NULL
;
10780 callFramePtr
->procBodyObjPtr
= scriptObj
;
10781 callFramePtr
->staticVars
= NULL
;
10782 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10783 callFramePtr
->line
= 0;
10784 Jim_IncrRefCount(scriptObj
);
10785 interp
->framePtr
= callFramePtr
;
10787 /* Check if there are too nested calls */
10788 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10789 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10793 /* Eval the body */
10794 retcode
= Jim_EvalObj(interp
, scriptObj
);
10797 /* Destroy the callframe */
10798 interp
->framePtr
= interp
->framePtr
->parent
;
10799 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10805 /* Call a procedure implemented in Tcl.
10806 * It's possible to speed-up a lot this function, currently
10807 * the callframes are not cached, but allocated and
10808 * destroied every time. What is expecially costly is
10809 * to create/destroy the local vars hash table every time.
10811 * This can be fixed just implementing callframes caching
10812 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10813 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10815 Jim_CallFrame
*callFramePtr
;
10816 int i
, d
, retcode
, optargs
;
10820 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10821 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10822 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10826 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10827 /* Optimise for procedure with no body - useful for optional debugging */
10831 /* Check if there are too nested calls */
10832 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10833 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10837 /* Create a new callframe */
10838 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10839 callFramePtr
->argv
= argv
;
10840 callFramePtr
->argc
= argc
;
10841 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10842 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10843 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10845 /* Remember where we were called from. */
10846 script
= JimGetScript(interp
, interp
->currentScriptObj
);
10847 callFramePtr
->fileNameObj
= script
->fileNameObj
;
10848 callFramePtr
->line
= script
->linenr
;
10850 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
10851 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
10852 interp
->framePtr
= callFramePtr
;
10854 /* How many optional args are available */
10855 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
10857 /* Step 'i' along the actual args, and step 'd' along the formal args */
10859 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
10860 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
10861 if (d
== cmd
->u
.proc
.argsPos
) {
10863 Jim_Obj
*listObjPtr
;
10865 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
10866 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
10868 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
10870 /* It is possible to rename args. */
10871 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
10872 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
10874 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
10875 if (retcode
!= JIM_OK
) {
10883 /* Optional or required? */
10884 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
10885 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
10888 /* Ran out, so use the default */
10889 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
10891 if (retcode
!= JIM_OK
) {
10896 /* Eval the body */
10897 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
10901 /* Free the callframe */
10902 interp
->framePtr
= interp
->framePtr
->parent
;
10903 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10905 /* Now chain any tailcalls in the parent frame */
10906 if (interp
->framePtr
->tailcallObj
) {
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
;
10931 /* Handle the JIM_RETURN return code */
10932 if (retcode
== JIM_RETURN
) {
10933 if (--interp
->returnLevel
<= 0) {
10934 retcode
= interp
->returnCode
;
10935 interp
->returnCode
= JIM_OK
;
10936 interp
->returnLevel
= 0;
10939 else if (retcode
== JIM_ERR
) {
10940 interp
->addStackTrace
++;
10941 Jim_DecrRefCount(interp
, interp
->errorProc
);
10942 interp
->errorProc
= argv
[0];
10943 Jim_IncrRefCount(interp
->errorProc
);
10949 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
10952 Jim_Obj
*scriptObjPtr
;
10954 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
10955 Jim_IncrRefCount(scriptObjPtr
);
10958 Jim_Obj
*prevScriptObj
;
10960 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
10962 prevScriptObj
= interp
->currentScriptObj
;
10963 interp
->currentScriptObj
= scriptObjPtr
;
10965 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10967 interp
->currentScriptObj
= prevScriptObj
;
10970 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10972 Jim_DecrRefCount(interp
, scriptObjPtr
);
10976 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
10978 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
10981 /* Execute script in the scope of the global level */
10982 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
10985 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10987 interp
->framePtr
= interp
->topFramePtr
;
10988 retval
= Jim_Eval(interp
, script
);
10989 interp
->framePtr
= savedFramePtr
;
10994 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
10997 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10999 interp
->framePtr
= interp
->topFramePtr
;
11000 retval
= Jim_EvalFile(interp
, filename
);
11001 interp
->framePtr
= savedFramePtr
;
11006 #include <sys/stat.h>
11008 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11012 Jim_Obj
*scriptObjPtr
;
11013 Jim_Obj
*prevScriptObj
;
11018 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11019 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11022 if (sb
.st_size
== 0) {
11027 buf
= Jim_Alloc(sb
.st_size
+ 1);
11028 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11032 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11038 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11039 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11040 Jim_IncrRefCount(scriptObjPtr
);
11042 prevScriptObj
= interp
->currentScriptObj
;
11043 interp
->currentScriptObj
= scriptObjPtr
;
11045 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11047 /* Handle the JIM_RETURN return code */
11048 if (retcode
== JIM_RETURN
) {
11049 if (--interp
->returnLevel
<= 0) {
11050 retcode
= interp
->returnCode
;
11051 interp
->returnCode
= JIM_OK
;
11052 interp
->returnLevel
= 0;
11055 if (retcode
== JIM_ERR
) {
11056 /* EvalFile changes context, so add a stack frame here */
11057 interp
->addStackTrace
++;
11060 interp
->currentScriptObj
= prevScriptObj
;
11062 Jim_DecrRefCount(interp
, scriptObjPtr
);
11067 /* -----------------------------------------------------------------------------
11069 * ---------------------------------------------------------------------------*/
11070 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11072 pc
->tstart
= pc
->p
;
11073 pc
->tline
= pc
->linenr
;
11075 if (pc
->len
== 0) {
11077 pc
->tt
= JIM_TT_EOL
;
11081 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11085 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11086 if (JimParseVar(pc
) == JIM_OK
) {
11089 /* Not a var, so treat as a string */
11090 pc
->tstart
= pc
->p
;
11091 flags
|= JIM_SUBST_NOVAR
;
11094 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11097 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11100 if (*pc
->p
== '\\' && pc
->len
> 1) {
11107 pc
->tend
= pc
->p
- 1;
11108 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11111 /* The subst object type reuses most of the data structures and functions
11112 * of the script object. Script's data structures are a bit more complex
11113 * for what is needed for [subst]itution tasks, but the reuse helps to
11114 * deal with a single data structure at the cost of some more memory
11115 * usage for substitutions. */
11117 /* This method takes the string representation of an object
11118 * as a Tcl string where to perform [subst]itution, and generates
11119 * the pre-parsed internal representation. */
11120 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11123 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11124 struct JimParserCtx parser
;
11125 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11126 ParseTokenList tokenlist
;
11128 /* Initially parse the subst into tokens (in tokenlist) */
11129 ScriptTokenListInit(&tokenlist
);
11131 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11133 JimParseSubst(&parser
, flags
);
11135 /* Note that subst doesn't need the EOL token */
11138 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11142 /* Create the "real" subst/script tokens from the initial token list */
11144 script
->substFlags
= flags
;
11145 script
->fileNameObj
= interp
->emptyObj
;
11146 Jim_IncrRefCount(script
->fileNameObj
);
11147 SubstObjAddTokens(interp
, script
, &tokenlist
);
11149 /* No longer need the token list */
11150 ScriptTokenListFree(&tokenlist
);
11152 #ifdef DEBUG_SHOW_SUBST
11156 printf("==== Subst ====\n");
11157 for (i
= 0; i
< script
->len
; i
++) {
11158 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11159 Jim_String(script
->token
[i
].objPtr
));
11164 /* Free the old internal rep and set the new one. */
11165 Jim_FreeIntRep(interp
, objPtr
);
11166 Jim_SetIntRepPtr(objPtr
, script
);
11167 objPtr
->typePtr
= &scriptObjType
;
11171 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11173 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11174 SetSubstFromAny(interp
, objPtr
, flags
);
11175 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11178 /* Performs commands,variables,blackslashes substitution,
11179 * storing the result object (with refcount 0) into
11181 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11183 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11185 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11186 /* In order to preserve the internal rep, we increment the
11187 * inUse field of the script internal rep structure. */
11190 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11193 Jim_DecrRefCount(interp
, substObjPtr
);
11194 if (*resObjPtrPtr
== NULL
) {
11200 /* -----------------------------------------------------------------------------
11201 * Core commands utility functions
11202 * ---------------------------------------------------------------------------*/
11203 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11206 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11209 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11211 Jim_IncrRefCount(listObjPtr
);
11212 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11213 Jim_DecrRefCount(interp
, listObjPtr
);
11215 Jim_IncrRefCount(objPtr
);
11216 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11217 Jim_DecrRefCount(interp
, objPtr
);
11221 * May add the key and/or value to the list.
11223 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11224 Jim_HashEntry
*he
, int type
);
11226 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11229 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11230 * invoke the callback to add entries to a list.
11231 * Returns the list.
11233 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11234 JimHashtableIteratorCallbackType
*callback
, int type
)
11237 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11239 /* Check for the non-pattern case. We can do this much more efficiently. */
11240 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11241 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11243 callback(interp
, listObjPtr
, he
, type
);
11247 Jim_HashTableIterator htiter
;
11248 JimInitHashTableIterator(ht
, &htiter
);
11249 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11250 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11251 callback(interp
, listObjPtr
, he
, type
);
11258 /* Keep these in order */
11259 #define JIM_CMDLIST_COMMANDS 0
11260 #define JIM_CMDLIST_PROCS 1
11261 #define JIM_CMDLIST_CHANNELS 2
11264 * Adds matching command names (procs, channels) to the list.
11266 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11267 Jim_HashEntry
*he
, int type
)
11269 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11272 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11277 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11278 Jim_IncrRefCount(objPtr
);
11280 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11281 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11283 Jim_DecrRefCount(interp
, objPtr
);
11286 /* type is JIM_CMDLIST_xxx */
11287 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11289 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11292 /* Keep these in order */
11293 #define JIM_VARLIST_GLOBALS 0
11294 #define JIM_VARLIST_LOCALS 1
11295 #define JIM_VARLIST_VARS 2
11297 #define JIM_VARLIST_VALUES 0x1000
11300 * Adds matching variable names to the list.
11302 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11303 Jim_HashEntry
*he
, int type
)
11305 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11307 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11308 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11309 if (type
& JIM_VARLIST_VALUES
) {
11310 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11315 /* mode is JIM_VARLIST_xxx */
11316 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11318 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11319 /* For [info locals], if we are at top level an emtpy list
11320 * is returned. I don't agree, but we aim at compatibility (SS) */
11321 return interp
->emptyObj
;
11324 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11325 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11329 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11330 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11332 Jim_CallFrame
*targetCallFrame
;
11334 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11335 if (targetCallFrame
== NULL
) {
11338 /* No proc call at toplevel callframe */
11339 if (targetCallFrame
== interp
->topFramePtr
) {
11340 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11343 if (info_level_cmd
) {
11344 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11347 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11349 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11350 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11351 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11352 *objPtrPtr
= listObj
;
11357 /* -----------------------------------------------------------------------------
11359 * ---------------------------------------------------------------------------*/
11361 /* fake [puts] -- not the real puts, just for debugging. */
11362 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11364 if (argc
!= 2 && argc
!= 3) {
11365 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11369 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11370 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11374 fputs(Jim_String(argv
[2]), stdout
);
11378 puts(Jim_String(argv
[1]));
11383 /* Helper for [+] and [*] */
11384 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11386 jim_wide wideValue
, res
;
11387 double doubleValue
, doubleRes
;
11390 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11392 for (i
= 1; i
< argc
; i
++) {
11393 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11395 if (op
== JIM_EXPROP_ADD
)
11400 Jim_SetResultInt(interp
, res
);
11403 doubleRes
= (double)res
;
11404 for (; i
< argc
; i
++) {
11405 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11407 if (op
== JIM_EXPROP_ADD
)
11408 doubleRes
+= doubleValue
;
11410 doubleRes
*= doubleValue
;
11412 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11416 /* Helper for [-] and [/] */
11417 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11419 jim_wide wideValue
, res
= 0;
11420 double doubleValue
, doubleRes
= 0;
11424 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11427 else if (argc
== 2) {
11428 /* The arity = 2 case is different. For [- x] returns -x,
11429 * while [/ x] returns 1/x. */
11430 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11431 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11435 if (op
== JIM_EXPROP_SUB
)
11436 doubleRes
= -doubleValue
;
11438 doubleRes
= 1.0 / doubleValue
;
11439 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11443 if (op
== JIM_EXPROP_SUB
) {
11445 Jim_SetResultInt(interp
, res
);
11448 doubleRes
= 1.0 / wideValue
;
11449 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11454 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11455 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11464 for (i
= 2; i
< argc
; i
++) {
11465 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11466 doubleRes
= (double)res
;
11469 if (op
== JIM_EXPROP_SUB
)
11474 Jim_SetResultInt(interp
, res
);
11477 for (; i
< argc
; i
++) {
11478 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11480 if (op
== JIM_EXPROP_SUB
)
11481 doubleRes
-= doubleValue
;
11483 doubleRes
/= doubleValue
;
11485 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11491 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11493 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11497 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11499 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11503 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11505 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11509 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11511 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11515 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11517 if (argc
!= 2 && argc
!= 3) {
11518 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11524 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11527 Jim_SetResult(interp
, objPtr
);
11530 /* argc == 3 case. */
11531 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11533 Jim_SetResult(interp
, argv
[2]);
11539 * unset ?-nocomplain? ?--? ?varName ...?
11541 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11547 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11551 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11560 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11570 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11573 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11577 /* The general purpose implementation of while starts here */
11579 int boolean
, retval
;
11581 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11586 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11600 Jim_SetEmptyResult(interp
);
11605 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11609 Jim_Obj
*varNamePtr
= NULL
;
11610 Jim_Obj
*stopVarNamePtr
= NULL
;
11613 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11617 /* Do the initialisation */
11618 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11622 /* And do the first test now. Better for optimisation
11623 * if we can do next/test at the bottom of the loop
11625 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11627 /* Ready to do the body as follows:
11629 * body // check retcode
11630 * next // check retcode
11631 * test // check retcode/test bool
11635 #ifdef JIM_OPTIMIZATION
11636 /* Check if the for is on the form:
11637 * for ... {$i < CONST} {incr i}
11638 * for ... {$i < $j} {incr i}
11640 if (retval
== JIM_OK
&& boolean
) {
11641 ScriptObj
*incrScript
;
11642 ExprByteCode
*expr
;
11643 jim_wide stop
, currentVal
;
11647 /* Do it only if there aren't shared arguments */
11648 expr
= JimGetExpression(interp
, argv
[2]);
11649 incrScript
= JimGetScript(interp
, argv
[3]);
11651 /* Ensure proper lengths to start */
11652 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11655 /* Ensure proper token types. */
11656 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11657 expr
->token
[0].type
!= JIM_TT_VAR
||
11658 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11662 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11665 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11672 /* Update command must be incr */
11673 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11677 /* incr, expression must be about the same variable */
11678 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11682 /* Get the stop condition (must be a variable or integer) */
11683 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11684 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11689 stopVarNamePtr
= expr
->token
[1].objPtr
;
11690 Jim_IncrRefCount(stopVarNamePtr
);
11691 /* Keep the compiler happy */
11695 /* Initialization */
11696 varNamePtr
= expr
->token
[0].objPtr
;
11697 Jim_IncrRefCount(varNamePtr
);
11699 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11700 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11704 /* --- OPTIMIZED FOR --- */
11705 while (retval
== JIM_OK
) {
11706 /* === Check condition === */
11707 /* Note that currentVal is already set here */
11709 /* Immediate or Variable? get the 'stop' value if the latter. */
11710 if (stopVarNamePtr
) {
11711 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11712 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11717 if (currentVal
>= stop
+ cmpOffset
) {
11722 retval
= Jim_EvalObj(interp
, argv
[4]);
11723 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11726 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11729 if (objPtr
== NULL
) {
11733 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11734 currentVal
= ++JimWideValue(objPtr
);
11735 Jim_InvalidateStringRep(objPtr
);
11738 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11739 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11740 ++currentVal
)) != JIM_OK
) {
11751 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11753 retval
= Jim_EvalObj(interp
, argv
[4]);
11755 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11758 retval
= Jim_EvalObj(interp
, argv
[3]);
11759 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11762 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11767 if (stopVarNamePtr
) {
11768 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11771 Jim_DecrRefCount(interp
, varNamePtr
);
11774 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11775 Jim_SetEmptyResult(interp
);
11783 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11789 Jim_Obj
*bodyObjPtr
;
11791 if (argc
!= 5 && argc
!= 6) {
11792 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11796 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11797 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11798 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11801 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11803 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11805 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11806 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11807 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11808 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11815 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11816 if (argv
[1]->typePtr
!= &variableObjType
) {
11817 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11821 JimWideValue(objPtr
) = i
;
11822 Jim_InvalidateStringRep(objPtr
);
11824 /* The following step is required in order to invalidate the
11825 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11826 if (argv
[1]->typePtr
!= &variableObjType
) {
11827 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11834 objPtr
= Jim_NewIntObj(interp
, i
);
11835 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11836 if (retval
!= JIM_OK
) {
11837 Jim_FreeNewObj(interp
, objPtr
);
11843 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11844 Jim_SetEmptyResult(interp
);
11850 /* List iterators make it easy to iterate over a list.
11851 * At some point iterators will be expanded to support generators.
11859 * Initialise the iterator at the start of the list.
11861 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
11863 iter
->objPtr
= objPtr
;
11868 * Returns the next object from the list, or NULL on end-of-list.
11870 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11872 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
11875 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
11879 * Returns 1 if end-of-list has been reached.
11881 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11883 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
11886 /* foreach + lmap implementation. */
11887 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
11889 int result
= JIM_OK
;
11891 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
11892 Jim_ListIter
*iters
;
11894 Jim_Obj
*resultObj
;
11896 if (argc
< 4 || argc
% 2 != 0) {
11897 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
11900 script
= argv
[argc
- 1]; /* Last argument is a script */
11901 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
11903 if (numargs
== 2) {
11907 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
11909 for (i
= 0; i
< numargs
; i
++) {
11910 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11911 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
11915 if (result
!= JIM_OK
) {
11916 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
11921 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
11924 resultObj
= interp
->emptyObj
;
11926 Jim_IncrRefCount(resultObj
);
11929 /* Have we expired all lists? */
11930 for (i
= 0; i
< numargs
; i
+= 2) {
11931 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
11935 if (i
== numargs
) {
11940 /* For each list */
11941 for (i
= 0; i
< numargs
; i
+= 2) {
11945 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11946 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
11947 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
11949 /* Ran out, so store the empty string */
11950 valObj
= interp
->emptyObj
;
11952 /* Avoid shimmering */
11953 Jim_IncrRefCount(valObj
);
11954 result
= Jim_SetVariable(interp
, varName
, valObj
);
11955 Jim_DecrRefCount(interp
, valObj
);
11956 if (result
!= JIM_OK
) {
11961 switch (result
= Jim_EvalObj(interp
, script
)) {
11964 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
11977 Jim_SetResult(interp
, resultObj
);
11979 Jim_DecrRefCount(interp
, resultObj
);
11987 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11989 return JimForeachMapHelper(interp
, argc
, argv
, 0);
11993 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11995 return JimForeachMapHelper(interp
, argc
, argv
, 1);
11999 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12001 int result
= JIM_ERR
;
12004 Jim_Obj
*resultObj
;
12007 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12011 JimListIterInit(&iter
, argv
[1]);
12013 for (i
= 2; i
< argc
; i
++) {
12014 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12015 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12016 if (result
!= JIM_OK
) {
12021 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12022 while (!JimListIterDone(interp
, &iter
)) {
12023 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12026 Jim_SetResult(interp
, resultObj
);
12032 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12034 int boolean
, retval
, current
= 1, falsebody
= 0;
12038 /* Far not enough arguments given! */
12039 if (current
>= argc
)
12041 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12044 /* There lacks something, isn't it? */
12045 if (current
>= argc
)
12047 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12049 /* Tsk tsk, no then-clause? */
12050 if (current
>= argc
)
12053 return Jim_EvalObj(interp
, argv
[current
]);
12054 /* Ok: no else-clause follows */
12055 if (++current
>= argc
) {
12056 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12059 falsebody
= current
++;
12060 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12061 /* IIICKS - else-clause isn't last cmd? */
12062 if (current
!= argc
- 1)
12064 return Jim_EvalObj(interp
, argv
[current
]);
12066 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12067 /* Ok: elseif follows meaning all the stuff
12068 * again (how boring...) */
12070 /* OOPS - else-clause is not last cmd? */
12071 else if (falsebody
!= argc
- 1)
12073 return Jim_EvalObj(interp
, argv
[falsebody
]);
12078 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12083 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12084 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12085 Jim_Obj
*stringObj
, int nocase
)
12092 parms
[argc
++] = commandObj
;
12094 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12096 parms
[argc
++] = patternObj
;
12097 parms
[argc
++] = stringObj
;
12099 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12101 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12109 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12112 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12114 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12115 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12116 Jim_Obj
*script
= 0;
12120 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12121 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12124 for (opt
= 1; opt
< argc
; ++opt
) {
12125 const char *option
= Jim_String(argv
[opt
]);
12127 if (*option
!= '-')
12129 else if (strncmp(option
, "--", 2) == 0) {
12133 else if (strncmp(option
, "-exact", 2) == 0)
12134 matchOpt
= SWITCH_EXACT
;
12135 else if (strncmp(option
, "-glob", 2) == 0)
12136 matchOpt
= SWITCH_GLOB
;
12137 else if (strncmp(option
, "-regexp", 2) == 0)
12138 matchOpt
= SWITCH_RE
;
12139 else if (strncmp(option
, "-command", 2) == 0) {
12140 matchOpt
= SWITCH_CMD
;
12141 if ((argc
- opt
) < 2)
12143 command
= argv
[++opt
];
12146 Jim_SetResultFormatted(interp
,
12147 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12151 if ((argc
- opt
) < 2)
12154 strObj
= argv
[opt
++];
12155 patCount
= argc
- opt
;
12156 if (patCount
== 1) {
12159 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12163 caseList
= &argv
[opt
];
12164 if (patCount
== 0 || patCount
% 2 != 0)
12166 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12167 Jim_Obj
*patObj
= caseList
[i
];
12169 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12170 || i
< (patCount
- 2)) {
12171 switch (matchOpt
) {
12173 if (Jim_StringEqObj(strObj
, patObj
))
12174 script
= caseList
[i
+ 1];
12177 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12178 script
= caseList
[i
+ 1];
12181 command
= Jim_NewStringObj(interp
, "regexp", -1);
12182 /* Fall thru intentionally */
12184 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12186 /* After the execution of a command we need to
12187 * make sure to reconvert the object into a list
12188 * again. Only for the single-list style [switch]. */
12189 if (argc
- opt
== 1) {
12192 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12195 /* command is here already decref'd */
12200 script
= caseList
[i
+ 1];
12206 script
= caseList
[i
+ 1];
12209 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12210 script
= caseList
[i
+ 1];
12211 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12212 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12215 Jim_SetEmptyResult(interp
);
12217 return Jim_EvalObj(interp
, script
);
12223 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12225 Jim_Obj
*listObjPtr
;
12227 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12228 Jim_SetResult(interp
, listObjPtr
);
12233 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12235 Jim_Obj
*objPtr
, *listObjPtr
;
12240 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12244 Jim_IncrRefCount(objPtr
);
12245 for (i
= 2; i
< argc
; i
++) {
12246 listObjPtr
= objPtr
;
12247 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12248 Jim_DecrRefCount(interp
, listObjPtr
);
12251 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12252 /* Returns an empty object if the index
12253 * is out of range. */
12254 Jim_DecrRefCount(interp
, listObjPtr
);
12255 Jim_SetEmptyResult(interp
);
12258 Jim_IncrRefCount(objPtr
);
12259 Jim_DecrRefCount(interp
, listObjPtr
);
12261 Jim_SetResult(interp
, objPtr
);
12262 Jim_DecrRefCount(interp
, objPtr
);
12267 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12270 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12273 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12278 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12280 static const char * const options
[] = {
12281 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12285 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12290 int opt_nocase
= 0;
12292 int opt_inline
= 0;
12293 int opt_match
= OPT_EXACT
;
12296 Jim_Obj
*listObjPtr
= NULL
;
12297 Jim_Obj
*commandObj
= NULL
;
12301 Jim_WrongNumArgs(interp
, 1, argv
,
12302 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12306 for (i
= 1; i
< argc
- 2; i
++) {
12309 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12331 if (i
>= argc
- 2) {
12334 commandObj
= argv
[++i
];
12339 opt_match
= option
;
12347 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12349 if (opt_match
== OPT_REGEXP
) {
12350 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12353 Jim_IncrRefCount(commandObj
);
12356 listlen
= Jim_ListLength(interp
, argv
[0]);
12357 for (i
= 0; i
< listlen
; i
++) {
12359 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12361 switch (opt_match
) {
12363 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12367 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12372 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12375 Jim_FreeNewObj(interp
, listObjPtr
);
12383 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12384 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12388 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12389 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12390 Jim_Obj
*resultObj
;
12393 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12395 else if (!opt_inline
) {
12396 resultObj
= Jim_NewIntObj(interp
, i
);
12399 resultObj
= objPtr
;
12403 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12406 Jim_SetResult(interp
, resultObj
);
12413 Jim_SetResult(interp
, listObjPtr
);
12418 Jim_SetResultBool(interp
, opt_not
);
12420 else if (!opt_inline
) {
12421 Jim_SetResultInt(interp
, -1);
12427 Jim_DecrRefCount(interp
, commandObj
);
12433 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12435 Jim_Obj
*listObjPtr
;
12439 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12442 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12444 /* Create the list if it does not exist */
12445 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12446 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12447 Jim_FreeNewObj(interp
, listObjPtr
);
12451 shared
= Jim_IsShared(listObjPtr
);
12453 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12454 for (i
= 2; i
< argc
; i
++)
12455 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12456 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12458 Jim_FreeNewObj(interp
, listObjPtr
);
12461 Jim_SetResult(interp
, listObjPtr
);
12466 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12472 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12476 if (Jim_IsShared(listPtr
))
12477 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12478 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12480 len
= Jim_ListLength(interp
, listPtr
);
12484 idx
= len
+ idx
+ 1;
12485 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12486 Jim_SetResult(interp
, listPtr
);
12489 if (listPtr
!= argv
[1]) {
12490 Jim_FreeNewObj(interp
, listPtr
);
12496 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12498 int first
, last
, len
, rangeLen
;
12500 Jim_Obj
*newListObj
;
12503 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12506 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12507 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12512 len
= Jim_ListLength(interp
, listObj
);
12514 first
= JimRelToAbsIndex(len
, first
);
12515 last
= JimRelToAbsIndex(len
, last
);
12516 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12518 /* Now construct a new list which consists of:
12519 * <elements before first> <supplied elements> <elements after last>
12522 /* Check to see if trying to replace past the end of the list */
12524 /* OK. Not past the end */
12526 else if (len
== 0) {
12527 /* Special for empty list, adjust first to 0 */
12531 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12532 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12536 /* Add the first set of elements */
12537 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12539 /* Add supplied elements */
12540 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12542 /* Add the remaining elements */
12543 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12545 Jim_SetResult(interp
, newListObj
);
12550 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12553 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12556 else if (argc
== 3) {
12557 /* With no indexes, simply implements [set] */
12558 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12560 Jim_SetResult(interp
, argv
[2]);
12563 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12567 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12569 static const char * const options
[] = {
12570 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12573 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12578 struct lsort_info info
;
12581 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12585 info
.type
= JIM_LSORT_ASCII
;
12589 info
.command
= NULL
;
12590 info
.interp
= interp
;
12592 for (i
= 1; i
< (argc
- 1); i
++) {
12595 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12600 info
.type
= JIM_LSORT_ASCII
;
12603 info
.type
= JIM_LSORT_NOCASE
;
12606 info
.type
= JIM_LSORT_INTEGER
;
12609 info
.type
= JIM_LSORT_REAL
;
12611 case OPT_INCREASING
:
12614 case OPT_DECREASING
:
12621 if (i
>= (argc
- 2)) {
12622 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12625 info
.type
= JIM_LSORT_COMMAND
;
12626 info
.command
= argv
[i
+ 1];
12630 if (i
>= (argc
- 2)) {
12631 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12634 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12642 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12643 retCode
= ListSortElements(interp
, resObj
, &info
);
12644 if (retCode
== JIM_OK
) {
12645 Jim_SetResult(interp
, resObj
);
12648 Jim_FreeNewObj(interp
, resObj
);
12654 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12656 Jim_Obj
*stringObjPtr
;
12660 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12664 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12670 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12671 if (!stringObjPtr
) {
12672 /* Create the string if it doesn't exist */
12673 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12676 else if (Jim_IsShared(stringObjPtr
)) {
12678 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12680 for (i
= 2; i
< argc
; i
++) {
12681 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12683 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12685 Jim_FreeNewObj(interp
, stringObjPtr
);
12690 Jim_SetResult(interp
, stringObjPtr
);
12695 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12697 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12698 static const char * const options
[] = {
12699 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12705 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12706 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12711 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12714 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12716 if (option
== OPT_REFCOUNT
) {
12718 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12721 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12724 else if (option
== OPT_OBJCOUNT
) {
12725 int freeobj
= 0, liveobj
= 0;
12730 Jim_WrongNumArgs(interp
, 2, argv
, "");
12733 /* Count the number of free objects. */
12734 objPtr
= interp
->freeList
;
12737 objPtr
= objPtr
->nextObjPtr
;
12739 /* Count the number of live objects. */
12740 objPtr
= interp
->liveList
;
12743 objPtr
= objPtr
->nextObjPtr
;
12745 /* Set the result string and return. */
12746 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12747 Jim_SetResultString(interp
, buf
, -1);
12750 else if (option
== OPT_OBJECTS
) {
12751 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12753 /* Count the number of live objects. */
12754 objPtr
= interp
->liveList
;
12755 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12758 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12760 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12761 sprintf(buf
, "%p", objPtr
);
12762 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12763 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12764 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12765 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12766 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12767 objPtr
= objPtr
->nextObjPtr
;
12769 Jim_SetResult(interp
, listObjPtr
);
12772 else if (option
== OPT_INVSTR
) {
12776 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12780 if (objPtr
->typePtr
!= NULL
)
12781 Jim_InvalidateStringRep(objPtr
);
12782 Jim_SetEmptyResult(interp
);
12785 else if (option
== OPT_SHOW
) {
12790 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12793 s
= Jim_GetString(argv
[2], &len
);
12795 charlen
= utf8_strlen(s
, len
);
12799 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12800 printf("chars (%d): <<%s>>\n", charlen
, s
);
12801 printf("bytes (%d):", len
);
12803 printf(" %02x", (unsigned char)*s
++);
12808 else if (option
== OPT_SCRIPTLEN
) {
12812 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12815 script
= JimGetScript(interp
, argv
[2]);
12816 if (script
== NULL
)
12818 Jim_SetResultInt(interp
, script
->len
);
12821 else if (option
== OPT_EXPRLEN
) {
12822 ExprByteCode
*expr
;
12825 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12828 expr
= JimGetExpression(interp
, argv
[2]);
12831 Jim_SetResultInt(interp
, expr
->len
);
12834 else if (option
== OPT_EXPRBC
) {
12836 ExprByteCode
*expr
;
12840 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12843 expr
= JimGetExpression(interp
, argv
[2]);
12846 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12847 for (i
= 0; i
< expr
->len
; i
++) {
12849 const Jim_ExprOperator
*op
;
12850 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
12852 switch (expr
->token
[i
].type
) {
12853 case JIM_TT_EXPR_INT
:
12856 case JIM_TT_EXPR_DOUBLE
:
12865 case JIM_TT_DICTSUGAR
:
12866 type
= "dictsugar";
12868 case JIM_TT_EXPRSUGAR
:
12869 type
= "exprsugar";
12878 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
12885 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
12888 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
12889 Jim_ListAppendElement(interp
, objPtr
, obj
);
12891 Jim_SetResult(interp
, objPtr
);
12895 Jim_SetResultString(interp
,
12896 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12900 #endif /* JIM_BOOTSTRAP */
12901 #if !defined(JIM_DEBUG_COMMAND)
12902 Jim_SetResultString(interp
, "unsupported", -1);
12908 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12913 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
12918 rc
= Jim_EvalObj(interp
, argv
[1]);
12921 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12924 if (rc
== JIM_ERR
) {
12925 /* eval is "interesting", so add a stack frame here */
12926 interp
->addStackTrace
++;
12932 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12936 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
12939 /* Save the old callframe pointer */
12940 savedCallFrame
= interp
->framePtr
;
12942 /* Lookup the target frame pointer */
12943 str
= Jim_String(argv
[1]);
12944 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
12945 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
12950 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
12952 if (targetCallFrame
== NULL
) {
12956 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
12959 /* Eval the code in the target callframe. */
12960 interp
->framePtr
= targetCallFrame
;
12962 retcode
= Jim_EvalObj(interp
, argv
[1]);
12965 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12967 interp
->framePtr
= savedCallFrame
;
12971 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
12977 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12979 Jim_Obj
*exprResultPtr
;
12983 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
12985 else if (argc
> 2) {
12988 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
12989 Jim_IncrRefCount(objPtr
);
12990 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
12991 Jim_DecrRefCount(interp
, objPtr
);
12994 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
12997 if (retcode
!= JIM_OK
)
12999 Jim_SetResult(interp
, exprResultPtr
);
13000 Jim_DecrRefCount(interp
, exprResultPtr
);
13005 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13008 Jim_WrongNumArgs(interp
, 1, argv
, "");
13015 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13018 Jim_WrongNumArgs(interp
, 1, argv
, "");
13021 return JIM_CONTINUE
;
13025 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13028 Jim_Obj
*stackTraceObj
= NULL
;
13029 Jim_Obj
*errorCodeObj
= NULL
;
13030 int returnCode
= JIM_OK
;
13033 for (i
= 1; i
< argc
- 1; i
+= 2) {
13034 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13035 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13039 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13040 stackTraceObj
= argv
[i
+ 1];
13042 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13043 errorCodeObj
= argv
[i
+ 1];
13045 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13046 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13047 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13056 if (i
!= argc
- 1 && i
!= argc
) {
13057 Jim_WrongNumArgs(interp
, 1, argv
,
13058 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13061 /* If a stack trace is supplied and code is error, set the stack trace */
13062 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13063 JimSetStackTrace(interp
, stackTraceObj
);
13065 /* If an error code list is supplied, set the global $errorCode */
13066 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13067 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13069 interp
->returnCode
= returnCode
;
13070 interp
->returnLevel
= level
;
13072 if (i
== argc
- 1) {
13073 Jim_SetResult(interp
, argv
[i
]);
13079 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13081 if (interp
->framePtr
->level
== 0) {
13082 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13085 else if (argc
>= 2) {
13086 /* Need to resolve the tailcall command in the current context */
13087 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13089 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13090 if (cmdPtr
== NULL
) {
13094 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13096 /* And stash this pre-resolved command */
13097 JimIncrCmdRefCount(cmdPtr
);
13098 cf
->tailcallCmd
= cmdPtr
;
13100 /* And stash the command list */
13101 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13103 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13104 Jim_IncrRefCount(cf
->tailcallObj
);
13106 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13112 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13115 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13117 /* prefixListObj is a list to which the args need to be appended */
13118 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13119 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13121 return JimEvalObjList(interp
, cmdList
);
13124 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13126 Jim_Obj
*prefixListObj
= privData
;
13127 Jim_DecrRefCount(interp
, prefixListObj
);
13130 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13132 Jim_Obj
*prefixListObj
;
13133 const char *newname
;
13136 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13140 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13141 Jim_IncrRefCount(prefixListObj
);
13142 newname
= Jim_String(argv
[1]);
13143 if (newname
[0] == ':' && newname
[1] == ':') {
13144 while (*++newname
== ':') {
13148 Jim_SetResult(interp
, argv
[1]);
13150 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13154 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13158 if (argc
!= 4 && argc
!= 5) {
13159 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13163 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13168 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13171 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13175 /* Add the new command */
13176 Jim_Obj
*qualifiedCmdNameObj
;
13177 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13179 JimCreateCommand(interp
, cmdname
, cmd
);
13181 /* Calculate and set the namespace for this proc */
13182 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13184 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13186 /* Unlike Tcl, set the name of the proc as the result */
13187 Jim_SetResult(interp
, argv
[1]);
13194 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13199 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13203 /* Evaluate the arguments with 'local' in force */
13205 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13209 /* If OK, and the result is a proc, add it to the list of local procs */
13210 if (retcode
== 0) {
13211 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13213 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13216 if (interp
->framePtr
->localCommands
== NULL
) {
13217 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13218 Jim_InitStack(interp
->framePtr
->localCommands
);
13220 Jim_IncrRefCount(cmdNameObj
);
13221 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13228 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13231 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13237 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13238 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13239 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13242 /* OK. Mark this command as being in an upcall */
13243 cmdPtr
->u
.proc
.upcall
++;
13244 JimIncrCmdRefCount(cmdPtr
);
13246 /* Invoke the command as normal */
13247 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13249 /* No longer in an upcall */
13250 cmdPtr
->u
.proc
.upcall
--;
13251 JimDecrCmdRefCount(interp
, cmdPtr
);
13258 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13261 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13267 Jim_Obj
*argListObjPtr
;
13268 Jim_Obj
*bodyObjPtr
;
13269 Jim_Obj
*nsObj
= NULL
;
13272 int len
= Jim_ListLength(interp
, argv
[1]);
13273 if (len
!= 2 && len
!= 3) {
13274 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13279 #ifdef jim_ext_namespace
13280 /* Need to canonicalise the given namespace. */
13281 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13283 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13287 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13288 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13290 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13293 /* Create a new argv array with a dummy argv[0], for error messages */
13294 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13295 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13296 Jim_IncrRefCount(nargv
[0]);
13297 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13298 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13299 Jim_DecrRefCount(interp
, nargv
[0]);
13302 JimDecrCmdRefCount(interp
, cmd
);
13311 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13313 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13318 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13321 Jim_CallFrame
*targetCallFrame
;
13323 /* Lookup the target frame pointer */
13324 if (argc
> 3 && (argc
% 2 == 0)) {
13325 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13330 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13332 if (targetCallFrame
== NULL
) {
13336 /* Check for arity */
13338 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13342 /* Now... for every other/local couple: */
13343 for (i
= 1; i
< argc
; i
+= 2) {
13344 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13351 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13356 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13359 /* Link every var to the toplevel having the same name */
13360 if (interp
->framePtr
->level
== 0)
13361 return JIM_OK
; /* global at toplevel... */
13362 for (i
= 1; i
< argc
; i
++) {
13363 /* global ::blah does nothing */
13364 const char *name
= Jim_String(argv
[i
]);
13365 if (name
[0] != ':' || name
[1] != ':') {
13366 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13373 /* does the [string map] operation. On error NULL is returned,
13374 * otherwise a new string object with the result, having refcount = 0,
13376 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13377 Jim_Obj
*objPtr
, int nocase
)
13380 const char *str
, *noMatchStart
= NULL
;
13382 Jim_Obj
*resultObjPtr
;
13384 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13386 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13390 str
= Jim_String(objPtr
);
13391 strLen
= Jim_Utf8Length(interp
, objPtr
);
13394 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13396 for (i
= 0; i
< numMaps
; i
+= 2) {
13401 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13402 k
= Jim_String(objPtr
);
13403 kl
= Jim_Utf8Length(interp
, objPtr
);
13405 if (strLen
>= kl
&& kl
) {
13407 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13409 if (noMatchStart
) {
13410 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13411 noMatchStart
= NULL
;
13413 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13414 str
+= utf8_index(str
, kl
);
13420 if (i
== numMaps
) { /* no match */
13422 if (noMatchStart
== NULL
)
13423 noMatchStart
= str
;
13424 str
+= utf8_tounicode(str
, &c
);
13428 if (noMatchStart
) {
13429 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13431 return resultObjPtr
;
13435 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13440 static const char * const options
[] = {
13441 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13442 "map", "repeat", "reverse", "index", "first", "last", "cat",
13443 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13447 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13448 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13449 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13451 static const char * const nocase_options
[] = {
13454 static const char * const nocase_length_options
[] = {
13455 "-nocase", "-length", NULL
13459 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13462 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13463 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13468 case OPT_BYTELENGTH
:
13470 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13473 if (option
== OPT_LENGTH
) {
13474 len
= Jim_Utf8Length(interp
, argv
[2]);
13477 len
= Jim_Length(argv
[2]);
13479 Jim_SetResultInt(interp
, len
);
13485 /* optimise the one-arg case */
13491 objPtr
= Jim_NewStringObj(interp
, "", 0);
13493 for (i
= 2; i
< argc
; i
++) {
13494 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13497 Jim_SetResult(interp
, objPtr
);
13504 /* n is the number of remaining option args */
13505 long opt_length
= -1;
13510 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13511 JIM_ENUM_ABBREV
) != JIM_OK
) {
13513 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13524 goto badcompareargs
;
13526 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13533 goto badcompareargs
;
13536 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13537 /* Fast version - [string equal], case sensitive, no length */
13538 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13541 if (opt_length
>= 0) {
13542 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13545 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13547 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13555 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13556 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13557 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13560 if (opt_case
== 0) {
13563 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13571 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13572 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13573 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13577 if (opt_case
== 0) {
13580 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13581 if (objPtr
== NULL
) {
13584 Jim_SetResult(interp
, objPtr
);
13589 case OPT_BYTERANGE
:{
13593 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13596 if (option
== OPT_RANGE
) {
13597 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13601 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13604 if (objPtr
== NULL
) {
13607 Jim_SetResult(interp
, objPtr
);
13614 if (argc
!= 5 && argc
!= 6) {
13615 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13618 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13619 if (objPtr
== NULL
) {
13622 Jim_SetResult(interp
, objPtr
);
13632 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13635 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13638 objPtr
= Jim_NewStringObj(interp
, "", 0);
13641 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13644 Jim_SetResult(interp
, objPtr
);
13655 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13659 str
= Jim_GetString(argv
[2], &len
);
13660 buf
= Jim_Alloc(len
+ 1);
13663 for (i
= 0; i
< len
; ) {
13665 int l
= utf8_tounicode(str
, &c
);
13666 memcpy(p
- l
, str
, l
);
13671 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13680 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13683 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13686 str
= Jim_String(argv
[2]);
13687 len
= Jim_Utf8Length(interp
, argv
[2]);
13688 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13689 idx
= JimRelToAbsIndex(len
, idx
);
13691 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13692 Jim_SetResultString(interp
, "", 0);
13694 else if (len
== Jim_Length(argv
[2])) {
13695 /* ASCII optimisation */
13696 Jim_SetResultString(interp
, str
+ idx
, 1);
13700 int i
= utf8_index(str
, idx
);
13701 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13708 int idx
= 0, l1
, l2
;
13709 const char *s1
, *s2
;
13711 if (argc
!= 4 && argc
!= 5) {
13712 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13715 s1
= Jim_String(argv
[2]);
13716 s2
= Jim_String(argv
[3]);
13717 l1
= Jim_Utf8Length(interp
, argv
[2]);
13718 l2
= Jim_Utf8Length(interp
, argv
[3]);
13720 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13723 idx
= JimRelToAbsIndex(l2
, idx
);
13725 else if (option
== OPT_LAST
) {
13728 if (option
== OPT_FIRST
) {
13729 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13733 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13735 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13743 case OPT_TRIMRIGHT
:{
13744 Jim_Obj
*trimchars
;
13746 if (argc
!= 3 && argc
!= 4) {
13747 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13750 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13751 if (option
== OPT_TRIM
) {
13752 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13754 else if (option
== OPT_TRIMLEFT
) {
13755 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13757 else if (option
== OPT_TRIMRIGHT
) {
13758 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13767 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13770 if (option
== OPT_TOLOWER
) {
13771 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13773 else if (option
== OPT_TOUPPER
) {
13774 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13777 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13782 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13783 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13785 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13792 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13795 jim_wide start
, elapsed
;
13797 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13800 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13804 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13810 start
= JimClock();
13814 retval
= Jim_EvalObj(interp
, argv
[1]);
13815 if (retval
!= JIM_OK
) {
13819 elapsed
= JimClock() - start
;
13820 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13821 Jim_SetResultString(interp
, buf
, -1);
13826 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13831 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13835 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13838 interp
->exitCode
= exitCode
;
13843 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13849 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13850 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
13851 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
13853 /* Reset the error code before catch.
13854 * Note that this is not strictly correct.
13856 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
13858 for (i
= 1; i
< argc
- 1; i
++) {
13859 const char *arg
= Jim_String(argv
[i
]);
13863 /* It's a pity we can't use Jim_GetEnum here :-( */
13864 if (strcmp(arg
, "--") == 0) {
13872 if (strncmp(arg
, "-no", 3) == 0) {
13881 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
13885 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
13892 ignore_mask
|= (1 << option
);
13895 ignore_mask
&= ~(1 << option
);
13900 if (argc
< 1 || argc
> 3) {
13902 Jim_WrongNumArgs(interp
, 1, argv
,
13903 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13908 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
13912 interp
->signal_level
+= sig
;
13913 if (Jim_CheckSignal(interp
)) {
13914 /* If a signal is set, don't even try to execute the body */
13915 exitCode
= JIM_SIGNAL
;
13918 exitCode
= Jim_EvalObj(interp
, argv
[0]);
13919 /* Don't want any caught error included in a later stack trace */
13920 interp
->errorFlag
= 0;
13922 interp
->signal_level
-= sig
;
13924 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13925 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
13926 /* Not caught, pass it up */
13930 if (sig
&& exitCode
== JIM_SIGNAL
) {
13931 /* Catch the signal at this level */
13932 if (interp
->signal_set_result
) {
13933 interp
->signal_set_result(interp
, interp
->sigmask
);
13936 Jim_SetResultInt(interp
, interp
->sigmask
);
13938 interp
->sigmask
= 0;
13942 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
13946 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
13948 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
13949 Jim_ListAppendElement(interp
, optListObj
,
13950 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
13951 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
13952 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
13953 if (exitCode
== JIM_ERR
) {
13954 Jim_Obj
*errorCode
;
13955 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
13957 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
13959 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
13961 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
13962 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
13965 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
13970 Jim_SetResultInt(interp
, exitCode
);
13974 #ifdef JIM_REFERENCES
13977 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13979 if (argc
!= 3 && argc
!= 4) {
13980 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
13984 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
13987 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
13993 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13995 Jim_Reference
*refPtr
;
13998 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14001 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14003 Jim_SetResult(interp
, refPtr
->objPtr
);
14008 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14010 Jim_Reference
*refPtr
;
14013 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14016 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14018 Jim_IncrRefCount(argv
[2]);
14019 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14020 refPtr
->objPtr
= argv
[2];
14021 Jim_SetResult(interp
, argv
[2]);
14026 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14029 Jim_WrongNumArgs(interp
, 1, argv
, "");
14032 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14034 /* Free all the freed objects. */
14035 while (interp
->freeList
) {
14036 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14037 Jim_Free(interp
->freeList
);
14038 interp
->freeList
= nextObjPtr
;
14044 /* [finalize] reference ?newValue? */
14045 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14047 if (argc
!= 2 && argc
!= 3) {
14048 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14052 Jim_Obj
*cmdNamePtr
;
14054 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14056 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14057 Jim_SetResult(interp
, cmdNamePtr
);
14060 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14062 Jim_SetResult(interp
, argv
[2]);
14067 /* [info references] */
14068 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14070 Jim_Obj
*listObjPtr
;
14071 Jim_HashTableIterator htiter
;
14074 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14076 JimInitHashTableIterator(&interp
->references
, &htiter
);
14077 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14078 char buf
[JIM_REFERENCE_SPACE
+ 1];
14079 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14080 const unsigned long *refId
= he
->key
;
14082 JimFormatReference(buf
, refPtr
, *refId
);
14083 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14085 Jim_SetResult(interp
, listObjPtr
);
14091 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14094 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14098 if (JimValidName(interp
, "new procedure", argv
[2])) {
14102 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14105 #define JIM_DICTMATCH_VALUES 0x0001
14107 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14109 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14111 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14112 if (type
& JIM_DICTMATCH_VALUES
) {
14113 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14118 * Like JimHashtablePatternMatch, but for dictionaries.
14120 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14121 JimDictMatchCallbackType
*callback
, int type
)
14124 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14126 /* Check for the non-pattern case. We can do this much more efficiently. */
14127 Jim_HashTableIterator htiter
;
14128 JimInitHashTableIterator(ht
, &htiter
);
14129 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14130 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14131 callback(interp
, listObjPtr
, he
, type
);
14139 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14141 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14144 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14148 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14150 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14153 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14157 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14159 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14162 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14165 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14170 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14174 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14176 /* Note that this uses internal knowledge of the hash table */
14177 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14179 for (i
= 0; i
< ht
->size
; i
++) {
14180 Jim_HashEntry
*he
= ht
->table
[i
];
14186 printf(" %s", Jim_String(he
->key
));
14195 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14197 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14199 Jim_AppendString(interp
, prefixObj
, " ", 1);
14200 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14202 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14206 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14210 static const char * const options
[] = {
14211 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14212 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14213 "replace", "update", NULL
14217 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14218 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14219 OPT_REPLACE
, OPT_UPDATE
,
14223 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14227 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14234 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14237 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14238 JIM_ERRMSG
) != JIM_OK
) {
14241 Jim_SetResult(interp
, objPtr
);
14246 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14249 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14253 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14257 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14261 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14267 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14270 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14276 if (argc
!= 3 && argc
!= 4) {
14277 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14280 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14284 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14287 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14290 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14297 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14300 /* Handle as ensemble */
14304 if (argc
< 6 || argc
% 2) {
14305 /* Better error message */
14312 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14315 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14316 Jim_SetResult(interp
, objPtr
);
14321 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14324 return Jim_DictInfo(interp
, argv
[2]);
14326 /* Handle command as an ensemble */
14327 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14331 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14333 static const char * const options
[] = {
14334 "-nobackslashes", "-nocommands", "-novariables", NULL
14337 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14339 int flags
= JIM_SUBST_FLAG
;
14343 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14346 for (i
= 1; i
< (argc
- 1); i
++) {
14349 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14350 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14354 case OPT_NOBACKSLASHES
:
14355 flags
|= JIM_SUBST_NOESC
;
14357 case OPT_NOCOMMANDS
:
14358 flags
|= JIM_SUBST_NOCMD
;
14360 case OPT_NOVARIABLES
:
14361 flags
|= JIM_SUBST_NOVAR
;
14365 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14368 Jim_SetResult(interp
, objPtr
);
14373 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14379 static const char * const commands
[] = {
14380 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14381 "vars", "version", "patchlevel", "complete", "args", "hostname",
14382 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14383 "references", "alias", NULL
14386 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14387 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14388 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14389 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14392 #ifdef jim_ext_namespace
14395 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14396 /* This is for internal use only */
14404 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14407 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14412 /* Test for the most common commands first, just in case it makes a difference */
14416 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14419 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14426 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14429 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14432 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14433 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14436 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14440 case INFO_CHANNELS
:
14441 mode
++; /* JIM_CMDLIST_CHANNELS */
14442 #ifndef jim_ext_aio
14443 Jim_SetResultString(interp
, "aio not enabled", -1);
14448 mode
++; /* JIM_CMDLIST_PROCS */
14450 case INFO_COMMANDS
:
14451 /* mode 0 => JIM_CMDLIST_COMMANDS */
14452 if (argc
!= 2 && argc
!= 3) {
14453 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14456 #ifdef jim_ext_namespace
14458 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14459 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14463 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14467 mode
++; /* JIM_VARLIST_VARS */
14470 mode
++; /* JIM_VARLIST_LOCALS */
14473 /* mode 0 => JIM_VARLIST_GLOBALS */
14474 if (argc
!= 2 && argc
!= 3) {
14475 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14478 #ifdef jim_ext_namespace
14480 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14481 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14485 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14490 Jim_WrongNumArgs(interp
, 2, argv
, "");
14493 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14498 Jim_Obj
*resObjPtr
;
14499 Jim_Obj
*fileNameObj
;
14501 if (argc
!= 3 && argc
!= 5) {
14502 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14506 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14509 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14510 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14513 if (argv
[2]->typePtr
== &sourceObjType
) {
14514 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14515 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14517 else if (argv
[2]->typePtr
== &scriptObjType
) {
14518 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14519 fileNameObj
= script
->fileNameObj
;
14520 line
= script
->firstline
;
14523 fileNameObj
= interp
->emptyObj
;
14526 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14527 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14528 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14530 Jim_SetResult(interp
, resObjPtr
);
14534 case INFO_STACKTRACE
:
14535 Jim_SetResult(interp
, interp
->stackTrace
);
14542 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14546 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14549 Jim_SetResult(interp
, objPtr
);
14553 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14564 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14567 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14570 if (!cmdPtr
->isproc
) {
14571 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14576 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14579 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14582 if (cmdPtr
->u
.proc
.staticVars
) {
14583 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14584 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14585 NULL
, JimVariablesMatch
, mode
));
14593 case INFO_PATCHLEVEL
:{
14594 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14596 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14597 Jim_SetResultString(interp
, buf
, -1);
14601 case INFO_COMPLETE
:
14602 if (argc
!= 3 && argc
!= 4) {
14603 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14608 const char *s
= Jim_GetString(argv
[2], &len
);
14611 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
14612 if (missing
!= ' ' && argc
== 4) {
14613 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14618 case INFO_HOSTNAME
:
14619 /* Redirect to os.gethostname if it exists */
14620 return Jim_Eval(interp
, "os.gethostname");
14622 case INFO_NAMEOFEXECUTABLE
:
14623 /* Redirect to Tcl proc */
14624 return Jim_Eval(interp
, "{info nameofexecutable}");
14626 case INFO_RETURNCODES
:
14629 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14631 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14632 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14633 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14634 jimReturnCodes
[i
], -1));
14637 Jim_SetResult(interp
, listObjPtr
);
14639 else if (argc
== 3) {
14643 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14646 name
= Jim_ReturnCode(code
);
14647 if (*name
== '?') {
14648 Jim_SetResultInt(interp
, code
);
14651 Jim_SetResultString(interp
, name
, -1);
14655 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14659 case INFO_REFERENCES
:
14660 #ifdef JIM_REFERENCES
14661 return JimInfoReferences(interp
, argc
, argv
);
14663 Jim_SetResultString(interp
, "not supported", -1);
14671 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14676 static const char * const options
[] = {
14677 "-command", "-proc", "-alias", "-var", NULL
14681 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14689 else if (argc
== 3) {
14690 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14696 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14700 if (option
== OPT_VAR
) {
14701 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14704 /* Now different kinds of commands */
14705 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14714 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14718 result
= cmd
->isproc
;
14723 Jim_SetResultBool(interp
, result
);
14728 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14730 const char *str
, *splitChars
, *noMatchStart
;
14731 int splitLen
, strLen
;
14732 Jim_Obj
*resObjPtr
;
14736 if (argc
!= 2 && argc
!= 3) {
14737 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14741 str
= Jim_GetString(argv
[1], &len
);
14745 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14749 splitChars
= " \n\t\r";
14753 splitChars
= Jim_String(argv
[2]);
14754 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14757 noMatchStart
= str
;
14758 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14764 const char *sc
= splitChars
;
14765 int scLen
= splitLen
;
14766 int sl
= utf8_tounicode(str
, &c
);
14769 sc
+= utf8_tounicode(sc
, &pc
);
14771 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14772 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14773 noMatchStart
= str
+ sl
;
14779 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14780 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14783 /* This handles the special case of splitchars eq {}
14784 * Optimise by sharing common (ASCII) characters
14786 Jim_Obj
**commonObj
= NULL
;
14787 #define NUM_COMMON (128 - 9)
14789 int n
= utf8_tounicode(str
, &c
);
14790 #ifdef JIM_OPTIMIZATION
14791 if (c
>= 9 && c
< 128) {
14792 /* Common ASCII char. Note that 9 is the tab character */
14795 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14796 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14798 if (!commonObj
[c
]) {
14799 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14801 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14806 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14809 Jim_Free(commonObj
);
14812 Jim_SetResult(interp
, resObjPtr
);
14817 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14819 const char *joinStr
;
14822 if (argc
!= 2 && argc
!= 3) {
14823 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14832 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14834 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14839 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14844 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
14847 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
14848 if (objPtr
== NULL
)
14850 Jim_SetResult(interp
, objPtr
);
14855 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14857 Jim_Obj
*listPtr
, **outVec
;
14861 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
14864 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
14865 SetScanFmtFromAny(interp
, argv
[2]);
14866 if (FormatGetError(argv
[2]) != 0) {
14867 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
14871 int maxPos
= FormatGetMaxPos(argv
[2]);
14872 int count
= FormatGetCnvCount(argv
[2]);
14874 if (maxPos
> argc
- 3) {
14875 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
14878 else if (count
> argc
- 3) {
14879 Jim_SetResultString(interp
, "different numbers of variable names and "
14880 "field specifiers", -1);
14883 else if (count
< argc
- 3) {
14884 Jim_SetResultString(interp
, "variable is not assigned by any "
14885 "conversion specifiers", -1);
14889 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
14896 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
14897 int len
= Jim_ListLength(interp
, listPtr
);
14900 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
14901 for (i
= 0; i
< outc
; ++i
) {
14902 if (Jim_Length(outVec
[i
]) > 0) {
14904 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
14910 Jim_FreeNewObj(interp
, listPtr
);
14915 if (rc
== JIM_OK
) {
14916 Jim_SetResultInt(interp
, count
);
14921 if (listPtr
== (Jim_Obj
*)EOF
) {
14922 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
14925 Jim_SetResult(interp
, listPtr
);
14931 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14933 if (argc
!= 2 && argc
!= 3) {
14934 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
14937 Jim_SetResult(interp
, argv
[1]);
14939 JimSetStackTrace(interp
, argv
[2]);
14942 interp
->addStackTrace
++;
14947 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14952 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
14955 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
14957 Jim_SetResult(interp
, objPtr
);
14962 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14967 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
14968 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
14972 if (count
== 0 || argc
== 2) {
14979 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
14981 ListInsertElements(objPtr
, -1, argc
, argv
);
14984 Jim_SetResult(interp
, objPtr
);
14988 char **Jim_GetEnviron(void)
14990 #if defined(HAVE__NSGETENVIRON)
14991 return *_NSGetEnviron();
14993 #if !defined(NO_ENVIRON_EXTERN)
14994 extern char **environ
;
15001 void Jim_SetEnviron(char **env
)
15003 #if defined(HAVE__NSGETENVIRON)
15004 *_NSGetEnviron() = env
;
15006 #if !defined(NO_ENVIRON_EXTERN)
15007 extern char **environ
;
15015 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15021 char **e
= Jim_GetEnviron();
15024 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15026 for (i
= 0; e
[i
]; i
++) {
15027 const char *equals
= strchr(e
[i
], '=');
15030 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15032 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15036 Jim_SetResult(interp
, listObjPtr
);
15041 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15044 key
= Jim_String(argv
[1]);
15048 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15051 val
= Jim_String(argv
[2]);
15053 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15058 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15063 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15066 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15067 if (retval
== JIM_RETURN
)
15073 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15075 Jim_Obj
*revObjPtr
, **ele
;
15079 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15082 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15084 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15086 ListAppendElement(revObjPtr
, ele
[len
--]);
15087 Jim_SetResult(interp
, revObjPtr
);
15091 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15099 else if (step
> 0 && start
> end
)
15101 else if (step
< 0 && end
> start
)
15105 len
= -len
; /* abs(len) */
15107 step
= -step
; /* abs(step) */
15108 len
= 1 + ((len
- 1) / step
);
15109 /* We can truncate safely to INT_MAX, the range command
15110 * will always return an error for a such long range
15111 * because Tcl lists can't be so long. */
15114 return (int)((len
< 0) ? -1 : len
);
15118 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15120 jim_wide start
= 0, end
, step
= 1;
15124 if (argc
< 2 || argc
> 4) {
15125 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15129 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15133 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15134 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15136 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15139 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15140 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15143 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15144 for (i
= 0; i
< len
; i
++)
15145 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15146 Jim_SetResult(interp
, objPtr
);
15151 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15153 jim_wide min
= 0, max
= 0, len
, maxMul
;
15155 if (argc
< 1 || argc
> 3) {
15156 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15160 max
= JIM_WIDE_MAX
;
15161 } else if (argc
== 2) {
15162 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15164 } else if (argc
== 3) {
15165 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15166 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15171 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15174 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15178 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15179 if (r
< 0 || r
>= maxMul
) continue;
15180 r
= (len
== 0) ? 0 : r
%len
;
15181 Jim_SetResultInt(interp
, min
+r
);
15186 static const struct {
15188 Jim_CmdProc
*cmdProc
;
15189 } Jim_CoreCommandsTable
[] = {
15190 {"alias", Jim_AliasCoreCommand
},
15191 {"set", Jim_SetCoreCommand
},
15192 {"unset", Jim_UnsetCoreCommand
},
15193 {"puts", Jim_PutsCoreCommand
},
15194 {"+", Jim_AddCoreCommand
},
15195 {"*", Jim_MulCoreCommand
},
15196 {"-", Jim_SubCoreCommand
},
15197 {"/", Jim_DivCoreCommand
},
15198 {"incr", Jim_IncrCoreCommand
},
15199 {"while", Jim_WhileCoreCommand
},
15200 {"loop", Jim_LoopCoreCommand
},
15201 {"for", Jim_ForCoreCommand
},
15202 {"foreach", Jim_ForeachCoreCommand
},
15203 {"lmap", Jim_LmapCoreCommand
},
15204 {"lassign", Jim_LassignCoreCommand
},
15205 {"if", Jim_IfCoreCommand
},
15206 {"switch", Jim_SwitchCoreCommand
},
15207 {"list", Jim_ListCoreCommand
},
15208 {"lindex", Jim_LindexCoreCommand
},
15209 {"lset", Jim_LsetCoreCommand
},
15210 {"lsearch", Jim_LsearchCoreCommand
},
15211 {"llength", Jim_LlengthCoreCommand
},
15212 {"lappend", Jim_LappendCoreCommand
},
15213 {"linsert", Jim_LinsertCoreCommand
},
15214 {"lreplace", Jim_LreplaceCoreCommand
},
15215 {"lsort", Jim_LsortCoreCommand
},
15216 {"append", Jim_AppendCoreCommand
},
15217 {"debug", Jim_DebugCoreCommand
},
15218 {"eval", Jim_EvalCoreCommand
},
15219 {"uplevel", Jim_UplevelCoreCommand
},
15220 {"expr", Jim_ExprCoreCommand
},
15221 {"break", Jim_BreakCoreCommand
},
15222 {"continue", Jim_ContinueCoreCommand
},
15223 {"proc", Jim_ProcCoreCommand
},
15224 {"concat", Jim_ConcatCoreCommand
},
15225 {"return", Jim_ReturnCoreCommand
},
15226 {"upvar", Jim_UpvarCoreCommand
},
15227 {"global", Jim_GlobalCoreCommand
},
15228 {"string", Jim_StringCoreCommand
},
15229 {"time", Jim_TimeCoreCommand
},
15230 {"exit", Jim_ExitCoreCommand
},
15231 {"catch", Jim_CatchCoreCommand
},
15232 #ifdef JIM_REFERENCES
15233 {"ref", Jim_RefCoreCommand
},
15234 {"getref", Jim_GetrefCoreCommand
},
15235 {"setref", Jim_SetrefCoreCommand
},
15236 {"finalize", Jim_FinalizeCoreCommand
},
15237 {"collect", Jim_CollectCoreCommand
},
15239 {"rename", Jim_RenameCoreCommand
},
15240 {"dict", Jim_DictCoreCommand
},
15241 {"subst", Jim_SubstCoreCommand
},
15242 {"info", Jim_InfoCoreCommand
},
15243 {"exists", Jim_ExistsCoreCommand
},
15244 {"split", Jim_SplitCoreCommand
},
15245 {"join", Jim_JoinCoreCommand
},
15246 {"format", Jim_FormatCoreCommand
},
15247 {"scan", Jim_ScanCoreCommand
},
15248 {"error", Jim_ErrorCoreCommand
},
15249 {"lrange", Jim_LrangeCoreCommand
},
15250 {"lrepeat", Jim_LrepeatCoreCommand
},
15251 {"env", Jim_EnvCoreCommand
},
15252 {"source", Jim_SourceCoreCommand
},
15253 {"lreverse", Jim_LreverseCoreCommand
},
15254 {"range", Jim_RangeCoreCommand
},
15255 {"rand", Jim_RandCoreCommand
},
15256 {"tailcall", Jim_TailcallCoreCommand
},
15257 {"local", Jim_LocalCoreCommand
},
15258 {"upcall", Jim_UpcallCoreCommand
},
15259 {"apply", Jim_ApplyCoreCommand
},
15263 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15267 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15268 Jim_CreateCommand(interp
,
15269 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15274 /* -----------------------------------------------------------------------------
15275 * Interactive prompt
15276 * ---------------------------------------------------------------------------*/
15277 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15281 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15282 argv
[1] = interp
->result
;
15284 Jim_EvalObjVector(interp
, 2, argv
);
15287 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15288 const char *prefix
, const char *const *tablePtr
, const char *name
)
15291 char **tablePtrSorted
;
15294 for (count
= 0; tablePtr
[count
]; count
++) {
15297 if (name
== NULL
) {
15301 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15302 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15303 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15304 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15305 for (i
= 0; i
< count
; i
++) {
15306 if (i
+ 1 == count
&& count
> 1) {
15307 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15309 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15310 if (i
+ 1 != count
) {
15311 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15314 Jim_Free(tablePtrSorted
);
15317 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15318 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15320 const char *bad
= "bad ";
15321 const char *const *entryPtr
= NULL
;
15325 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15329 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15330 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15331 /* Found an exact match */
15335 if (flags
& JIM_ENUM_ABBREV
) {
15336 /* Accept an unambiguous abbreviation.
15337 * Note that '-' doesnt' consitute a valid abbreviation
15339 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15340 if (*arg
== '-' && arglen
== 1) {
15344 bad
= "ambiguous ";
15352 /* If we had an unambiguous partial match */
15359 if (flags
& JIM_ERRMSG
) {
15360 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15365 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15369 for (i
= 0; i
< (int)len
; i
++) {
15370 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15377 int Jim_IsDict(Jim_Obj
*objPtr
)
15379 return objPtr
->typePtr
== &dictObjType
;
15382 int Jim_IsList(Jim_Obj
*objPtr
)
15384 return objPtr
->typePtr
== &listObjType
;
15388 * Very simple printf-like formatting, designed for error messages.
15390 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15391 * The resulting string is created and set as the result.
15393 * Each '%s' should correspond to a regular string parameter.
15394 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15395 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15397 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15399 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15401 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15403 /* Initial space needed */
15404 int len
= strlen(format
);
15407 const char *params
[5];
15412 va_start(args
, format
);
15414 for (i
= 0; i
< len
&& n
< 5; i
++) {
15417 if (strncmp(format
+ i
, "%s", 2) == 0) {
15418 params
[n
] = va_arg(args
, char *);
15420 l
= strlen(params
[n
]);
15422 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15423 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15425 params
[n
] = Jim_GetString(objPtr
, &l
);
15428 if (format
[i
] == '%') {
15438 buf
= Jim_Alloc(len
+ 1);
15439 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15443 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15447 #ifndef jim_ext_package
15448 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15453 #ifndef jim_ext_aio
15454 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15456 Jim_SetResultString(interp
, "aio not enabled", -1);
15463 * Local Variables: ***
15464 * c-basic-offset: 4 ***