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, the 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(os)", TCL_PLATFORM_OS
);
5483 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5484 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5485 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5486 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5487 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5488 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5493 void Jim_FreeInterp(Jim_Interp
*i
)
5495 Jim_CallFrame
*cf
, *cfx
;
5497 Jim_Obj
*objPtr
, *nextObjPtr
;
5499 /* Free the active call frames list - must be done before i->commands is destroyed */
5500 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5502 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5505 Jim_DecrRefCount(i
, i
->emptyObj
);
5506 Jim_DecrRefCount(i
, i
->trueObj
);
5507 Jim_DecrRefCount(i
, i
->falseObj
);
5508 Jim_DecrRefCount(i
, i
->result
);
5509 Jim_DecrRefCount(i
, i
->stackTrace
);
5510 Jim_DecrRefCount(i
, i
->errorProc
);
5511 Jim_DecrRefCount(i
, i
->unknown
);
5512 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5513 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5514 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5515 Jim_FreeHashTable(&i
->commands
);
5516 #ifdef JIM_REFERENCES
5517 Jim_FreeHashTable(&i
->references
);
5519 Jim_FreeHashTable(&i
->packages
);
5520 Jim_Free(i
->prngState
);
5521 Jim_FreeHashTable(&i
->assocData
);
5523 /* Check that the live object list is empty, otherwise
5524 * there is a memory leak. */
5525 #ifdef JIM_MAINTAINER
5526 if (i
->liveList
!= NULL
) {
5527 objPtr
= i
->liveList
;
5529 printf("\n-------------------------------------\n");
5530 printf("Objects still in the free list:\n");
5532 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5534 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5535 printf("%p (%d) %-10s: '%.20s...'\n",
5536 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5539 printf("%p (%d) %-10s: '%s'\n",
5540 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5542 if (objPtr
->typePtr
== &sourceObjType
) {
5543 printf("FILE %s LINE %d\n",
5544 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5545 objPtr
->internalRep
.sourceValue
.lineNumber
);
5547 objPtr
= objPtr
->nextObjPtr
;
5549 printf("-------------------------------------\n\n");
5550 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5554 /* Free all the freed objects. */
5555 objPtr
= i
->freeList
;
5557 nextObjPtr
= objPtr
->nextObjPtr
;
5559 objPtr
= nextObjPtr
;
5562 /* Free the free call frames list */
5563 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5566 Jim_FreeHashTable(&cf
->vars
);
5570 /* Free the interpreter structure. */
5574 /* Returns the call frame relative to the level represented by
5575 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5577 * This function accepts the 'level' argument in the form
5578 * of the commands [uplevel] and [upvar].
5580 * Returns NULL on error.
5582 * Note: for a function accepting a relative integer as level suitable
5583 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5585 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5589 Jim_CallFrame
*framePtr
;
5592 str
= Jim_String(levelObjPtr
);
5593 if (str
[0] == '#') {
5596 level
= jim_strtol(str
+ 1, &endptr
);
5597 if (str
[1] == '\0' || endptr
[0] != '\0') {
5602 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5606 /* Convert from a relative to an absolute level */
5607 level
= interp
->framePtr
->level
- level
;
5612 str
= "1"; /* Needed to format the error message. */
5613 level
= interp
->framePtr
->level
- 1;
5617 return interp
->topFramePtr
;
5621 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5622 if (framePtr
->level
== level
) {
5628 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5632 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5633 * as a relative integer like in the [info level ?level?] command.
5635 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5638 Jim_CallFrame
*framePtr
;
5640 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5642 /* Convert from a relative to an absolute level */
5643 level
= interp
->framePtr
->level
+ level
;
5647 return interp
->topFramePtr
;
5651 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5652 if (framePtr
->level
== level
) {
5658 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5662 static void JimResetStackTrace(Jim_Interp
*interp
)
5664 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5665 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5666 Jim_IncrRefCount(interp
->stackTrace
);
5669 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5673 /* Increment reference first in case these are the same object */
5674 Jim_IncrRefCount(stackTraceObj
);
5675 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5676 interp
->stackTrace
= stackTraceObj
;
5677 interp
->errorFlag
= 1;
5679 /* This is a bit ugly.
5680 * If the filename of the last entry of the stack trace is empty,
5681 * the next stack level should be added.
5683 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5685 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5686 interp
->addStackTrace
= 1;
5691 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5692 Jim_Obj
*fileNameObj
, int linenr
)
5694 if (strcmp(procname
, "unknown") == 0) {
5697 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5698 /* No useful info here */
5702 if (Jim_IsShared(interp
->stackTrace
)) {
5703 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5704 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5705 Jim_IncrRefCount(interp
->stackTrace
);
5708 /* If we have no procname but the previous element did, merge with that frame */
5709 if (!*procname
&& Jim_Length(fileNameObj
)) {
5710 /* Just a filename. Check the previous entry */
5711 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5714 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5715 if (Jim_Length(objPtr
)) {
5716 /* Yes, the previous level had procname */
5717 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5718 if (Jim_Length(objPtr
) == 0) {
5719 /* But no filename, so merge the new info with that frame */
5720 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5721 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5728 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5729 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5730 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5733 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5736 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5738 assocEntryPtr
->delProc
= delProc
;
5739 assocEntryPtr
->data
= data
;
5740 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5743 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5745 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5747 if (entryPtr
!= NULL
) {
5748 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5749 return assocEntryPtr
->data
;
5754 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5756 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5759 int Jim_GetExitCode(Jim_Interp
*interp
)
5761 return interp
->exitCode
;
5764 /* -----------------------------------------------------------------------------
5766 * ---------------------------------------------------------------------------*/
5767 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5768 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5770 static const Jim_ObjType intObjType
= {
5778 /* A coerced double is closer to an int than a double.
5779 * It is an int value temporarily masquerading as a double value.
5780 * i.e. it has the same string value as an int and Jim_GetWide()
5781 * succeeds, but also Jim_GetDouble() returns the value directly.
5783 static const Jim_ObjType coercedDoubleObjType
= {
5792 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5794 char buf
[JIM_INTEGER_SPACE
+ 1];
5795 jim_wide wideValue
= JimWideValue(objPtr
);
5798 if (wideValue
== 0) {
5802 char tmp
[JIM_INTEGER_SPACE
];
5806 if (wideValue
< 0) {
5809 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5810 * whereas C99 is always -6
5811 * coverity[dead_error_line]
5813 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5818 tmp
[num
++] = wideValue
% 10;
5822 for (i
= 0; i
< num
; i
++) {
5823 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5828 JimSetStringBytes(objPtr
, buf
);
5831 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5836 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5838 objPtr
->typePtr
= &intObjType
;
5842 /* Get the string representation */
5843 str
= Jim_String(objPtr
);
5844 /* Try to convert into a jim_wide */
5845 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5846 if (flags
& JIM_ERRMSG
) {
5847 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5851 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5852 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5855 /* Free the old internal repr and set the new one. */
5856 Jim_FreeIntRep(interp
, objPtr
);
5857 objPtr
->typePtr
= &intObjType
;
5858 objPtr
->internalRep
.wideValue
= wideValue
;
5862 #ifdef JIM_OPTIMIZATION
5863 static int JimIsWide(Jim_Obj
*objPtr
)
5865 return objPtr
->typePtr
== &intObjType
;
5869 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5871 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5873 *widePtr
= JimWideValue(objPtr
);
5877 /* Get a wide but does not set an error if the format is bad. */
5878 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5880 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5882 *widePtr
= JimWideValue(objPtr
);
5886 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5891 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5892 if (retval
== JIM_OK
) {
5893 *longPtr
= (long)wideValue
;
5899 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5903 objPtr
= Jim_NewObj(interp
);
5904 objPtr
->typePtr
= &intObjType
;
5905 objPtr
->bytes
= NULL
;
5906 objPtr
->internalRep
.wideValue
= wideValue
;
5910 /* -----------------------------------------------------------------------------
5912 * ---------------------------------------------------------------------------*/
5913 #define JIM_DOUBLE_SPACE 30
5915 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5916 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5918 static const Jim_ObjType doubleObjType
= {
5922 UpdateStringOfDouble
,
5928 #define isnan(X) ((X) != (X))
5932 #define isinf(X) (1.0 / (X) == 0.0)
5935 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5937 double value
= objPtr
->internalRep
.doubleValue
;
5940 JimSetStringBytes(objPtr
, "NaN");
5945 JimSetStringBytes(objPtr
, "-Inf");
5948 JimSetStringBytes(objPtr
, "Inf");
5953 char buf
[JIM_DOUBLE_SPACE
+ 1];
5955 int len
= sprintf(buf
, "%.12g", value
);
5957 /* Add a final ".0" if necessary */
5958 for (i
= 0; i
< len
; i
++) {
5959 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5960 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5961 /* If 'buf' ends in e-0nn or e+0nn, remove
5962 * the 0 after the + or - and reduce the length by 1
5964 char *e
= strchr(buf
, 'e');
5965 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5968 memmove(e
, e
+ 1, len
- (e
- buf
));
5974 if (buf
[i
] == '\0') {
5979 JimSetStringBytes(objPtr
, buf
);
5983 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5989 /* Preserve the string representation.
5990 * Needed so we can convert back to int without loss
5992 str
= Jim_String(objPtr
);
5994 #ifdef HAVE_LONG_LONG
5995 /* Assume a 53 bit mantissa */
5996 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5997 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5999 if (objPtr
->typePtr
== &intObjType
6000 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
6001 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6003 /* Direct conversion to coerced double */
6004 objPtr
->typePtr
= &coercedDoubleObjType
;
6009 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6010 /* Managed to convert to an int, so we can use this as a cooerced double */
6011 Jim_FreeIntRep(interp
, objPtr
);
6012 objPtr
->typePtr
= &coercedDoubleObjType
;
6013 objPtr
->internalRep
.wideValue
= wideValue
;
6017 /* Try to convert into a double */
6018 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6019 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6022 /* Free the old internal repr and set the new one. */
6023 Jim_FreeIntRep(interp
, objPtr
);
6025 objPtr
->typePtr
= &doubleObjType
;
6026 objPtr
->internalRep
.doubleValue
= doubleValue
;
6030 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6032 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6033 *doublePtr
= JimWideValue(objPtr
);
6036 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6039 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6040 *doublePtr
= JimWideValue(objPtr
);
6043 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6048 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6052 objPtr
= Jim_NewObj(interp
);
6053 objPtr
->typePtr
= &doubleObjType
;
6054 objPtr
->bytes
= NULL
;
6055 objPtr
->internalRep
.doubleValue
= doubleValue
;
6059 /* -----------------------------------------------------------------------------
6061 * ---------------------------------------------------------------------------*/
6062 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6063 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6064 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6065 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6066 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6067 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6069 /* Note that while the elements of the list may contain references,
6070 * the list object itself can't. This basically means that the
6071 * list object string representation as a whole can't contain references
6072 * that are not presents in the single elements. */
6073 static const Jim_ObjType listObjType
= {
6075 FreeListInternalRep
,
6081 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6085 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6086 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6088 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6091 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6095 JIM_NOTUSED(interp
);
6097 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6098 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6099 dupPtr
->internalRep
.listValue
.ele
=
6100 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6101 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6102 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6103 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6104 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6106 dupPtr
->typePtr
= &listObjType
;
6109 /* The following function checks if a given string can be encoded
6110 * into a list element without any kind of quoting, surrounded by braces,
6111 * or using escapes to quote. */
6112 #define JIM_ELESTR_SIMPLE 0
6113 #define JIM_ELESTR_BRACE 1
6114 #define JIM_ELESTR_QUOTE 2
6115 static unsigned char ListElementQuotingType(const char *s
, int len
)
6117 int i
, level
, blevel
, trySimple
= 1;
6119 /* Try with the SIMPLE case */
6121 return JIM_ELESTR_BRACE
;
6122 if (s
[0] == '"' || s
[0] == '{') {
6126 for (i
= 0; i
< len
; i
++) {
6147 return JIM_ELESTR_SIMPLE
;
6150 /* Test if it's possible to do with braces */
6151 if (s
[len
- 1] == '\\')
6152 return JIM_ELESTR_QUOTE
;
6155 for (i
= 0; i
< len
; i
++) {
6163 return JIM_ELESTR_QUOTE
;
6172 if (s
[i
+ 1] == '\n')
6173 return JIM_ELESTR_QUOTE
;
6174 else if (s
[i
+ 1] != '\0')
6180 return JIM_ELESTR_QUOTE
;
6185 return JIM_ELESTR_BRACE
;
6186 for (i
= 0; i
< len
; i
++) {
6200 return JIM_ELESTR_BRACE
;
6204 return JIM_ELESTR_SIMPLE
;
6206 return JIM_ELESTR_QUOTE
;
6209 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6210 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6212 * Returns the length of the result.
6214 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6267 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6269 #define STATIC_QUOTING_LEN 32
6270 int i
, bufLen
, realLength
;
6273 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6275 /* Estimate the space needed. */
6276 if (objc
> STATIC_QUOTING_LEN
) {
6277 quotingType
= Jim_Alloc(objc
);
6280 quotingType
= staticQuoting
;
6283 for (i
= 0; i
< objc
; i
++) {
6286 strRep
= Jim_GetString(objv
[i
], &len
);
6287 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6288 switch (quotingType
[i
]) {
6289 case JIM_ELESTR_SIMPLE
:
6290 if (i
!= 0 || strRep
[0] != '#') {
6294 /* Special case '#' on first element needs braces */
6295 quotingType
[i
] = JIM_ELESTR_BRACE
;
6297 case JIM_ELESTR_BRACE
:
6300 case JIM_ELESTR_QUOTE
:
6304 bufLen
++; /* elements separator. */
6308 /* Generate the string rep. */
6309 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6311 for (i
= 0; i
< objc
; i
++) {
6314 strRep
= Jim_GetString(objv
[i
], &len
);
6316 switch (quotingType
[i
]) {
6317 case JIM_ELESTR_SIMPLE
:
6318 memcpy(p
, strRep
, len
);
6322 case JIM_ELESTR_BRACE
:
6324 memcpy(p
, strRep
, len
);
6327 realLength
+= len
+ 2;
6329 case JIM_ELESTR_QUOTE
:
6330 if (i
== 0 && strRep
[0] == '#') {
6334 qlen
= BackslashQuoteString(strRep
, len
, p
);
6339 /* Add a separating space */
6340 if (i
+ 1 != objc
) {
6345 *p
= '\0'; /* nul term. */
6346 objPtr
->length
= realLength
;
6348 if (quotingType
!= staticQuoting
) {
6349 Jim_Free(quotingType
);
6353 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6355 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6358 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6360 struct JimParserCtx parser
;
6363 Jim_Obj
*fileNameObj
;
6366 if (objPtr
->typePtr
== &listObjType
) {
6370 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6371 * it also preserves any source location of the dict elements
6372 * which can be very useful
6374 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6375 Jim_Obj
**listObjPtrPtr
;
6379 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6380 for (i
= 0; i
< len
; i
++) {
6381 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6384 /* Now just switch the internal rep */
6385 Jim_FreeIntRep(interp
, objPtr
);
6386 objPtr
->typePtr
= &listObjType
;
6387 objPtr
->internalRep
.listValue
.len
= len
;
6388 objPtr
->internalRep
.listValue
.maxLen
= len
;
6389 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6394 /* Try to preserve information about filename / line number */
6395 if (objPtr
->typePtr
== &sourceObjType
) {
6396 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6397 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6400 fileNameObj
= interp
->emptyObj
;
6403 Jim_IncrRefCount(fileNameObj
);
6405 /* Get the string representation */
6406 str
= Jim_GetString(objPtr
, &strLen
);
6408 /* Free the old internal repr just now and initialize the
6409 * new one just now. The string->list conversion can't fail. */
6410 Jim_FreeIntRep(interp
, objPtr
);
6411 objPtr
->typePtr
= &listObjType
;
6412 objPtr
->internalRep
.listValue
.len
= 0;
6413 objPtr
->internalRep
.listValue
.maxLen
= 0;
6414 objPtr
->internalRep
.listValue
.ele
= NULL
;
6416 /* Convert into a list */
6418 JimParserInit(&parser
, str
, strLen
, linenr
);
6419 while (!parser
.eof
) {
6420 Jim_Obj
*elementPtr
;
6422 JimParseList(&parser
);
6423 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6425 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6426 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6427 ListAppendElement(objPtr
, elementPtr
);
6430 Jim_DecrRefCount(interp
, fileNameObj
);
6434 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6438 objPtr
= Jim_NewObj(interp
);
6439 objPtr
->typePtr
= &listObjType
;
6440 objPtr
->bytes
= NULL
;
6441 objPtr
->internalRep
.listValue
.ele
= NULL
;
6442 objPtr
->internalRep
.listValue
.len
= 0;
6443 objPtr
->internalRep
.listValue
.maxLen
= 0;
6446 ListInsertElements(objPtr
, 0, len
, elements
);
6452 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6453 * length of the vector. Note that the user of this function should make
6454 * sure that the list object can't shimmer while the vector returned
6455 * is in use, this vector is the one stored inside the internal representation
6456 * of the list object. This function is not exported, extensions should
6457 * always access to the List object elements using Jim_ListIndex(). */
6458 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6461 *listLen
= Jim_ListLength(interp
, listObj
);
6462 *listVec
= listObj
->internalRep
.listValue
.ele
;
6465 /* Sorting uses ints, but commands may return wide */
6466 static int JimSign(jim_wide w
)
6477 /* ListSortElements type values */
6493 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6496 static struct lsort_info
*sort_info
;
6498 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6500 Jim_Obj
*lObj
, *rObj
;
6502 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6503 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6504 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6506 return sort_info
->subfn(&lObj
, &rObj
);
6509 /* Sort the internal rep of a list. */
6510 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6512 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6515 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6517 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6520 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6522 jim_wide lhs
= 0, rhs
= 0;
6524 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6525 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6526 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6529 return JimSign(lhs
- rhs
) * sort_info
->order
;
6532 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6534 double lhs
= 0, rhs
= 0;
6536 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6537 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6538 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6544 return sort_info
->order
;
6546 return -sort_info
->order
;
6549 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6551 Jim_Obj
*compare_script
;
6556 /* This must be a valid list */
6557 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6558 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6559 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6561 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6563 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6564 longjmp(sort_info
->jmpbuf
, rc
);
6567 return JimSign(ret
) * sort_info
->order
;
6570 /* Remove duplicate elements from the (sorted) list in-place, according to the
6571 * comparison function, comp.
6573 * Note that the last unique value is kept, not the first
6575 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6579 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6581 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6582 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6583 /* Match, so replace the dest with the current source */
6584 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6587 /* No match, so keep the current source and move to the next destination */
6590 ele
[dst
] = ele
[src
];
6592 /* At end of list, keep the final element */
6593 ele
[++dst
] = ele
[src
];
6595 /* Set the new length */
6596 listObjPtr
->internalRep
.listValue
.len
= dst
;
6599 /* Sort a list *in place*. MUST be called with a non-shared list. */
6600 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6602 struct lsort_info
*prev_info
;
6604 typedef int (qsort_comparator
) (const void *, const void *);
6605 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6610 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6611 SetListFromAny(interp
, listObjPtr
);
6613 /* Allow lsort to be called reentrantly */
6614 prev_info
= sort_info
;
6617 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6618 len
= listObjPtr
->internalRep
.listValue
.len
;
6619 switch (info
->type
) {
6620 case JIM_LSORT_ASCII
:
6621 fn
= ListSortString
;
6623 case JIM_LSORT_NOCASE
:
6624 fn
= ListSortStringNoCase
;
6626 case JIM_LSORT_INTEGER
:
6627 fn
= ListSortInteger
;
6629 case JIM_LSORT_REAL
:
6632 case JIM_LSORT_COMMAND
:
6633 fn
= ListSortCommand
;
6636 fn
= NULL
; /* avoid warning */
6637 JimPanic((1, "ListSort called with invalid sort type"));
6640 if (info
->indexed
) {
6641 /* Need to interpose a "list index" function */
6643 fn
= ListSortIndexHelper
;
6646 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6647 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6649 if (info
->unique
&& len
> 1) {
6650 ListRemoveDuplicates(listObjPtr
, fn
);
6653 Jim_InvalidateStringRep(listObjPtr
);
6655 sort_info
= prev_info
;
6660 /* This is the low-level function to insert elements into a list.
6661 * The higher-level Jim_ListInsertElements() performs shared object
6662 * check and invalidates the string repr. This version is used
6663 * in the internals of the List Object and is not exported.
6665 * NOTE: this function can be called only against objects
6666 * with internal type of List.
6668 * An insertion point (idx) of -1 means end-of-list.
6670 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6672 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6673 int requiredLen
= currentLen
+ elemc
;
6677 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6678 if (requiredLen
< 2) {
6679 /* Don't do allocations of under 4 pointers. */
6686 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6687 sizeof(Jim_Obj
*) * requiredLen
);
6689 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6694 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6695 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6696 for (i
= 0; i
< elemc
; ++i
) {
6697 point
[i
] = elemVec
[i
];
6698 Jim_IncrRefCount(point
[i
]);
6700 listPtr
->internalRep
.listValue
.len
+= elemc
;
6703 /* Convenience call to ListInsertElements() to append a single element.
6705 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6707 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6710 /* Appends every element of appendListPtr into listPtr.
6711 * Both have to be of the list type.
6712 * Convenience call to ListInsertElements()
6714 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6716 ListInsertElements(listPtr
, -1,
6717 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6720 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6722 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6723 SetListFromAny(interp
, listPtr
);
6724 Jim_InvalidateStringRep(listPtr
);
6725 ListAppendElement(listPtr
, objPtr
);
6728 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6730 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6731 SetListFromAny(interp
, listPtr
);
6732 SetListFromAny(interp
, appendListPtr
);
6733 Jim_InvalidateStringRep(listPtr
);
6734 ListAppendList(listPtr
, appendListPtr
);
6737 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6739 SetListFromAny(interp
, objPtr
);
6740 return objPtr
->internalRep
.listValue
.len
;
6743 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6744 int objc
, Jim_Obj
*const *objVec
)
6746 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6747 SetListFromAny(interp
, listPtr
);
6748 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6749 idx
= listPtr
->internalRep
.listValue
.len
;
6752 Jim_InvalidateStringRep(listPtr
);
6753 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6756 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6758 SetListFromAny(interp
, listPtr
);
6759 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6760 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6764 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6765 return listPtr
->internalRep
.listValue
.ele
[idx
];
6768 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6770 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6771 if (*objPtrPtr
== NULL
) {
6772 if (flags
& JIM_ERRMSG
) {
6773 Jim_SetResultString(interp
, "list index out of range", -1);
6780 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6781 Jim_Obj
*newObjPtr
, int flags
)
6783 SetListFromAny(interp
, listPtr
);
6784 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6785 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6786 if (flags
& JIM_ERRMSG
) {
6787 Jim_SetResultString(interp
, "list index out of range", -1);
6792 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6793 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6794 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6795 Jim_IncrRefCount(newObjPtr
);
6799 /* Modify the list stored in the variable named 'varNamePtr'
6800 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6801 * with the new element 'newObjptr'. (implements the [lset] command) */
6802 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6803 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6805 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6808 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6811 if ((shared
= Jim_IsShared(objPtr
)))
6812 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6813 for (i
= 0; i
< indexc
- 1; i
++) {
6814 listObjPtr
= objPtr
;
6815 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6817 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6820 if (Jim_IsShared(objPtr
)) {
6821 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6822 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6824 Jim_InvalidateStringRep(listObjPtr
);
6826 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6828 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6830 Jim_InvalidateStringRep(objPtr
);
6831 Jim_InvalidateStringRep(varObjPtr
);
6832 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6834 Jim_SetResult(interp
, varObjPtr
);
6838 Jim_FreeNewObj(interp
, varObjPtr
);
6843 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6846 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6847 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6849 for (i
= 0; i
< listLen
; ) {
6850 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6851 if (++i
!= listLen
) {
6852 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6858 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6862 /* If all the objects in objv are lists,
6863 * it's possible to return a list as result, that's the
6864 * concatenation of all the lists. */
6865 for (i
= 0; i
< objc
; i
++) {
6866 if (!Jim_IsList(objv
[i
]))
6870 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6872 for (i
= 0; i
< objc
; i
++)
6873 ListAppendList(objPtr
, objv
[i
]);
6877 /* Else... we have to glue strings together */
6878 int len
= 0, objLen
;
6881 /* Compute the length */
6882 for (i
= 0; i
< objc
; i
++) {
6883 len
+= Jim_Length(objv
[i
]);
6887 /* Create the string rep, and a string object holding it. */
6888 p
= bytes
= Jim_Alloc(len
+ 1);
6889 for (i
= 0; i
< objc
; i
++) {
6890 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6892 /* Remove leading space */
6893 while (objLen
&& isspace(UCHAR(*s
))) {
6898 /* And trailing space */
6899 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6900 /* Handle trailing backslash-space case */
6901 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6907 memcpy(p
, s
, objLen
);
6909 if (i
+ 1 != objc
) {
6913 /* Drop the space calculated for this
6914 * element that is instead null. */
6920 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6924 /* Returns a list composed of the elements in the specified range.
6925 * first and start are directly accepted as Jim_Objects and
6926 * processed for the end?-index? case. */
6927 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6928 Jim_Obj
*lastObjPtr
)
6933 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6934 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
6936 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
6937 first
= JimRelToAbsIndex(len
, first
);
6938 last
= JimRelToAbsIndex(len
, last
);
6939 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
6940 if (first
== 0 && last
== len
) {
6943 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
6946 /* -----------------------------------------------------------------------------
6948 * ---------------------------------------------------------------------------*/
6949 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6950 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6951 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
6952 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6954 /* Dict HashTable Type.
6956 * Keys and Values are Jim objects. */
6958 static unsigned int JimObjectHTHashFunction(const void *key
)
6961 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
6962 return Jim_GenHashFunction((const unsigned char *)str
, len
);
6965 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
6967 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
6970 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
6972 Jim_IncrRefCount((Jim_Obj
*)val
);
6976 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
6978 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
6981 static const Jim_HashTableType JimDictHashTableType
= {
6982 JimObjectHTHashFunction
, /* hash function */
6983 JimObjectHTKeyValDup
, /* key dup */
6984 JimObjectHTKeyValDup
, /* val dup */
6985 JimObjectHTKeyCompare
, /* key compare */
6986 JimObjectHTKeyValDestructor
, /* key destructor */
6987 JimObjectHTKeyValDestructor
/* val destructor */
6990 /* Note that while the elements of the dict may contain references,
6991 * the list object itself can't. This basically means that the
6992 * dict object string representation as a whole can't contain references
6993 * that are not presents in the single elements. */
6994 static const Jim_ObjType dictObjType
= {
6996 FreeDictInternalRep
,
7002 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7004 JIM_NOTUSED(interp
);
7006 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7007 Jim_Free(objPtr
->internalRep
.ptr
);
7010 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7012 Jim_HashTable
*ht
, *dupHt
;
7013 Jim_HashTableIterator htiter
;
7016 /* Create a new hash table */
7017 ht
= srcPtr
->internalRep
.ptr
;
7018 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7019 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7021 Jim_ExpandHashTable(dupHt
, ht
->size
);
7022 /* Copy every element from the source to the dup hash table */
7023 JimInitHashTableIterator(ht
, &htiter
);
7024 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7025 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7028 dupPtr
->internalRep
.ptr
= dupHt
;
7029 dupPtr
->typePtr
= &dictObjType
;
7032 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7035 Jim_HashTableIterator htiter
;
7040 ht
= dictPtr
->internalRep
.ptr
;
7042 /* Turn the hash table into a flat vector of Jim_Objects. */
7043 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7044 JimInitHashTableIterator(ht
, &htiter
);
7046 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7047 objv
[i
++] = Jim_GetHashEntryKey(he
);
7048 objv
[i
++] = Jim_GetHashEntryVal(he
);
7054 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7056 /* Turn the hash table into a flat vector of Jim_Objects. */
7058 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7060 /* And now generate the string rep as a list */
7061 JimMakeListStringRep(objPtr
, objv
, len
);
7066 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7070 if (objPtr
->typePtr
== &dictObjType
) {
7074 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7075 /* A shared list, so get the string representation now to avoid
7076 * changing the order in case of fast conversion to dict.
7081 /* For simplicity, convert a non-list object to a list and then to a dict */
7082 listlen
= Jim_ListLength(interp
, objPtr
);
7084 Jim_SetResultString(interp
, "missing value to go with key", -1);
7088 /* Converting from a list to a dict can't fail */
7092 ht
= Jim_Alloc(sizeof(*ht
));
7093 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7095 for (i
= 0; i
< listlen
; i
+= 2) {
7096 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7097 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7099 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7102 Jim_FreeIntRep(interp
, objPtr
);
7103 objPtr
->typePtr
= &dictObjType
;
7104 objPtr
->internalRep
.ptr
= ht
;
7110 /* Dict object API */
7112 /* Add an element to a dict. objPtr must be of the "dict" type.
7113 * The higher-level exported function is Jim_DictAddElement().
7114 * If an element with the specified key already exists, the value
7115 * associated is replaced with the new one.
7117 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7118 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7119 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7121 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7123 if (valueObjPtr
== NULL
) { /* unset */
7124 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7126 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7130 /* Add an element, higher-level interface for DictAddElement().
7131 * If valueObjPtr == NULL, the key is removed if it exists. */
7132 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7133 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7135 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7136 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7139 Jim_InvalidateStringRep(objPtr
);
7140 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7143 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7148 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7150 objPtr
= Jim_NewObj(interp
);
7151 objPtr
->typePtr
= &dictObjType
;
7152 objPtr
->bytes
= NULL
;
7153 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7154 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7155 for (i
= 0; i
< len
; i
+= 2)
7156 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7160 /* Return the value associated to the specified dict key
7161 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7163 * Sets *objPtrPtr to non-NULL only upon success.
7165 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7166 Jim_Obj
**objPtrPtr
, int flags
)
7171 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7174 ht
= dictPtr
->internalRep
.ptr
;
7175 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7176 if (flags
& JIM_ERRMSG
) {
7177 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7181 *objPtrPtr
= he
->u
.val
;
7185 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7186 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7188 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7191 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7197 /* Return the value associated to the specified dict keys */
7198 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7199 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7204 *objPtrPtr
= dictPtr
;
7208 for (i
= 0; i
< keyc
; i
++) {
7211 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7217 *objPtrPtr
= dictPtr
;
7221 /* Modify the dict stored into the variable named 'varNamePtr'
7222 * setting the element specified by the 'keyc' keys objects in 'keyv',
7223 * with the new value of the element 'newObjPtr'.
7225 * If newObjPtr == NULL the operation is to remove the given key
7226 * from the dictionary.
7228 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7229 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7231 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7232 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7234 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7237 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7238 if (objPtr
== NULL
) {
7239 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7240 /* Cannot remove a key from non existing var */
7243 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7244 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7245 Jim_FreeNewObj(interp
, varObjPtr
);
7249 if ((shared
= Jim_IsShared(objPtr
)))
7250 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7251 for (i
= 0; i
< keyc
; i
++) {
7252 dictObjPtr
= objPtr
;
7254 /* Check if it's a valid dictionary */
7255 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7259 if (i
== keyc
- 1) {
7260 /* Last key: Note that error on unset with missing last key is OK */
7261 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7262 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7269 /* Check if the given key exists. */
7270 Jim_InvalidateStringRep(dictObjPtr
);
7271 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7272 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7273 /* This key exists at the current level.
7274 * Make sure it's not shared!. */
7275 if (Jim_IsShared(objPtr
)) {
7276 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7277 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7281 /* Key not found. If it's an [unset] operation
7282 * this is an error. Only the last key may not
7284 if (newObjPtr
== NULL
) {
7287 /* Otherwise set an empty dictionary
7288 * as key's value. */
7289 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7290 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7293 /* XXX: Is this necessary? */
7294 Jim_InvalidateStringRep(objPtr
);
7295 Jim_InvalidateStringRep(varObjPtr
);
7296 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7299 Jim_SetResult(interp
, varObjPtr
);
7303 Jim_FreeNewObj(interp
, varObjPtr
);
7308 /* -----------------------------------------------------------------------------
7310 * ---------------------------------------------------------------------------*/
7311 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7312 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7314 static const Jim_ObjType indexObjType
= {
7318 UpdateStringOfIndex
,
7322 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7324 if (objPtr
->internalRep
.intValue
== -1) {
7325 JimSetStringBytes(objPtr
, "end");
7328 char buf
[JIM_INTEGER_SPACE
+ 1];
7329 if (objPtr
->internalRep
.intValue
>= 0) {
7330 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7334 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7336 JimSetStringBytes(objPtr
, buf
);
7340 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7346 /* Get the string representation */
7347 str
= Jim_String(objPtr
);
7349 /* Try to convert into an index */
7350 if (strncmp(str
, "end", 3) == 0) {
7356 idx
= jim_strtol(str
, &endptr
);
7358 if (endptr
== str
) {
7364 /* Now str may include or +<num> or -<num> */
7365 if (*str
== '+' || *str
== '-') {
7366 int sign
= (*str
== '+' ? 1 : -1);
7368 idx
+= sign
* jim_strtol(++str
, &endptr
);
7369 if (str
== endptr
|| *endptr
) {
7374 /* The only thing left should be spaces */
7375 while (isspace(UCHAR(*str
))) {
7386 /* end-1 is repesented as -2 */
7394 /* Free the old internal repr and set the new one. */
7395 Jim_FreeIntRep(interp
, objPtr
);
7396 objPtr
->typePtr
= &indexObjType
;
7397 objPtr
->internalRep
.intValue
= idx
;
7401 Jim_SetResultFormatted(interp
,
7402 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7406 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7408 /* Avoid shimmering if the object is an integer. */
7409 if (objPtr
->typePtr
== &intObjType
) {
7410 jim_wide val
= JimWideValue(objPtr
);
7413 *indexPtr
= -INT_MAX
;
7414 else if (val
> INT_MAX
)
7415 *indexPtr
= INT_MAX
;
7417 *indexPtr
= (int)val
;
7420 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7422 *indexPtr
= objPtr
->internalRep
.intValue
;
7426 /* -----------------------------------------------------------------------------
7427 * Return Code Object.
7428 * ---------------------------------------------------------------------------*/
7430 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7431 static const char * const jimReturnCodes
[] = {
7443 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7445 static const Jim_ObjType returnCodeObjType
= {
7453 /* Converts a (standard) return code to a string. Returns "?" for
7454 * non-standard return codes.
7456 const char *Jim_ReturnCode(int code
)
7458 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7462 return jimReturnCodes
[code
];
7466 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7471 /* Try to convert into an integer */
7472 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7473 returnCode
= (int)wideValue
;
7474 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7475 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7478 /* Free the old internal repr and set the new one. */
7479 Jim_FreeIntRep(interp
, objPtr
);
7480 objPtr
->typePtr
= &returnCodeObjType
;
7481 objPtr
->internalRep
.intValue
= returnCode
;
7485 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7487 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7489 *intPtr
= objPtr
->internalRep
.intValue
;
7493 /* -----------------------------------------------------------------------------
7494 * Expression Parsing
7495 * ---------------------------------------------------------------------------*/
7496 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7497 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7498 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7500 /* Exrp's Stack machine operators opcodes. */
7502 /* Binary operators (numbers) */
7505 /* Continues on from the JIM_TT_ space */
7507 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7522 JIM_EXPROP_BITAND
, /* 35 */
7526 /* Note must keep these together */
7527 JIM_EXPROP_LOGICAND
, /* 38 */
7528 JIM_EXPROP_LOGICAND_LEFT
,
7529 JIM_EXPROP_LOGICAND_RIGHT
,
7532 JIM_EXPROP_LOGICOR
, /* 41 */
7533 JIM_EXPROP_LOGICOR_LEFT
,
7534 JIM_EXPROP_LOGICOR_RIGHT
,
7537 /* Ternary operators */
7538 JIM_EXPROP_TERNARY
, /* 44 */
7539 JIM_EXPROP_TERNARY_LEFT
,
7540 JIM_EXPROP_TERNARY_RIGHT
,
7543 JIM_EXPROP_COLON
, /* 47 */
7544 JIM_EXPROP_COLON_LEFT
,
7545 JIM_EXPROP_COLON_RIGHT
,
7547 JIM_EXPROP_POW
, /* 50 */
7549 /* Binary operators (strings) */
7550 JIM_EXPROP_STREQ
, /* 51 */
7555 /* Unary operators (numbers) */
7556 JIM_EXPROP_NOT
, /* 55 */
7558 JIM_EXPROP_UNARYMINUS
,
7559 JIM_EXPROP_UNARYPLUS
,
7562 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7563 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7564 JIM_EXPROP_FUNC_WIDE
,
7565 JIM_EXPROP_FUNC_ABS
,
7566 JIM_EXPROP_FUNC_DOUBLE
,
7567 JIM_EXPROP_FUNC_ROUND
,
7568 JIM_EXPROP_FUNC_RAND
,
7569 JIM_EXPROP_FUNC_SRAND
,
7571 /* math functions from libm */
7572 JIM_EXPROP_FUNC_SIN
, /* 65 */
7573 JIM_EXPROP_FUNC_COS
,
7574 JIM_EXPROP_FUNC_TAN
,
7575 JIM_EXPROP_FUNC_ASIN
,
7576 JIM_EXPROP_FUNC_ACOS
,
7577 JIM_EXPROP_FUNC_ATAN
,
7578 JIM_EXPROP_FUNC_SINH
,
7579 JIM_EXPROP_FUNC_COSH
,
7580 JIM_EXPROP_FUNC_TANH
,
7581 JIM_EXPROP_FUNC_CEIL
,
7582 JIM_EXPROP_FUNC_FLOOR
,
7583 JIM_EXPROP_FUNC_EXP
,
7584 JIM_EXPROP_FUNC_LOG
,
7585 JIM_EXPROP_FUNC_LOG10
,
7586 JIM_EXPROP_FUNC_SQRT
,
7587 JIM_EXPROP_FUNC_POW
,
7598 /* Operators table */
7599 typedef struct Jim_ExprOperator
7602 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7603 unsigned char precedence
;
7604 unsigned char arity
;
7606 unsigned char namelen
;
7609 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7611 Jim_IncrRefCount(obj
);
7612 e
->stack
[e
->stacklen
++] = obj
;
7615 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7617 return e
->stack
[--e
->stacklen
];
7620 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7624 Jim_Obj
*A
= ExprPop(e
);
7626 jim_wide wA
, wC
= 0;
7628 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7629 switch (e
->opcode
) {
7630 case JIM_EXPROP_FUNC_INT
:
7631 case JIM_EXPROP_FUNC_WIDE
:
7632 case JIM_EXPROP_FUNC_ROUND
:
7633 case JIM_EXPROP_UNARYPLUS
:
7636 case JIM_EXPROP_FUNC_DOUBLE
:
7640 case JIM_EXPROP_FUNC_ABS
:
7641 wC
= wA
>= 0 ? wA
: -wA
;
7643 case JIM_EXPROP_UNARYMINUS
:
7646 case JIM_EXPROP_NOT
:
7653 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7654 switch (e
->opcode
) {
7655 case JIM_EXPROP_FUNC_INT
:
7656 case JIM_EXPROP_FUNC_WIDE
:
7659 case JIM_EXPROP_FUNC_ROUND
:
7660 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7662 case JIM_EXPROP_FUNC_DOUBLE
:
7663 case JIM_EXPROP_UNARYPLUS
:
7667 case JIM_EXPROP_FUNC_ABS
:
7668 dC
= dA
>= 0 ? dA
: -dA
;
7671 case JIM_EXPROP_UNARYMINUS
:
7675 case JIM_EXPROP_NOT
:
7685 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7688 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7692 Jim_DecrRefCount(interp
, A
);
7697 static double JimRandDouble(Jim_Interp
*interp
)
7700 JimRandomBytes(interp
, &x
, sizeof(x
));
7702 return (double)x
/ (unsigned long)~0;
7705 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7707 Jim_Obj
*A
= ExprPop(e
);
7710 int rc
= Jim_GetWide(interp
, A
, &wA
);
7712 switch (e
->opcode
) {
7713 case JIM_EXPROP_BITNOT
:
7714 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7716 case JIM_EXPROP_FUNC_SRAND
:
7717 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7718 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7725 Jim_DecrRefCount(interp
, A
);
7730 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7732 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7734 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7739 #ifdef JIM_MATH_FUNCTIONS
7740 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7743 Jim_Obj
*A
= ExprPop(e
);
7746 rc
= Jim_GetDouble(interp
, A
, &dA
);
7748 switch (e
->opcode
) {
7749 case JIM_EXPROP_FUNC_SIN
:
7752 case JIM_EXPROP_FUNC_COS
:
7755 case JIM_EXPROP_FUNC_TAN
:
7758 case JIM_EXPROP_FUNC_ASIN
:
7761 case JIM_EXPROP_FUNC_ACOS
:
7764 case JIM_EXPROP_FUNC_ATAN
:
7767 case JIM_EXPROP_FUNC_SINH
:
7770 case JIM_EXPROP_FUNC_COSH
:
7773 case JIM_EXPROP_FUNC_TANH
:
7776 case JIM_EXPROP_FUNC_CEIL
:
7779 case JIM_EXPROP_FUNC_FLOOR
:
7782 case JIM_EXPROP_FUNC_EXP
:
7785 case JIM_EXPROP_FUNC_LOG
:
7788 case JIM_EXPROP_FUNC_LOG10
:
7791 case JIM_EXPROP_FUNC_SQRT
:
7797 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7800 Jim_DecrRefCount(interp
, A
);
7806 /* A binary operation on two ints */
7807 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7809 Jim_Obj
*B
= ExprPop(e
);
7810 Jim_Obj
*A
= ExprPop(e
);
7814 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7819 switch (e
->opcode
) {
7820 case JIM_EXPROP_LSHIFT
:
7823 case JIM_EXPROP_RSHIFT
:
7826 case JIM_EXPROP_BITAND
:
7829 case JIM_EXPROP_BITXOR
:
7832 case JIM_EXPROP_BITOR
:
7835 case JIM_EXPROP_MOD
:
7838 Jim_SetResultString(interp
, "Division by zero", -1);
7845 * This code is tricky: C doesn't guarantee much
7846 * about the quotient or remainder, but Tcl does.
7847 * The remainder always has the same sign as the
7848 * divisor and a smaller absolute value.
7866 case JIM_EXPROP_ROTL
:
7867 case JIM_EXPROP_ROTR
:{
7868 /* uint32_t would be better. But not everyone has inttypes.h? */
7869 unsigned long uA
= (unsigned long)wA
;
7870 unsigned long uB
= (unsigned long)wB
;
7871 const unsigned int S
= sizeof(unsigned long) * 8;
7873 /* Shift left by the word size or more is undefined. */
7876 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7879 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7885 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7889 Jim_DecrRefCount(interp
, A
);
7890 Jim_DecrRefCount(interp
, B
);
7896 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7897 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7901 double dA
, dB
, dC
= 0;
7902 jim_wide wA
, wB
, wC
= 0;
7904 Jim_Obj
*B
= ExprPop(e
);
7905 Jim_Obj
*A
= ExprPop(e
);
7907 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7908 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7909 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7913 switch (e
->opcode
) {
7914 case JIM_EXPROP_POW
:
7915 case JIM_EXPROP_FUNC_POW
:
7916 wC
= JimPowWide(wA
, wB
);
7918 case JIM_EXPROP_ADD
:
7921 case JIM_EXPROP_SUB
:
7924 case JIM_EXPROP_MUL
:
7927 case JIM_EXPROP_DIV
:
7929 Jim_SetResultString(interp
, "Division by zero", -1);
7936 * This code is tricky: C doesn't guarantee much
7937 * about the quotient or remainder, but Tcl does.
7938 * The remainder always has the same sign as the
7939 * divisor and a smaller absolute value.
7957 case JIM_EXPROP_LTE
:
7960 case JIM_EXPROP_GTE
:
7963 case JIM_EXPROP_NUMEQ
:
7966 case JIM_EXPROP_NUMNE
:
7973 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
7975 switch (e
->opcode
) {
7976 case JIM_EXPROP_POW
:
7977 case JIM_EXPROP_FUNC_POW
:
7978 #ifdef JIM_MATH_FUNCTIONS
7981 Jim_SetResultString(interp
, "unsupported", -1);
7985 case JIM_EXPROP_ADD
:
7988 case JIM_EXPROP_SUB
:
7991 case JIM_EXPROP_MUL
:
7994 case JIM_EXPROP_DIV
:
7997 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
7999 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8014 case JIM_EXPROP_LTE
:
8018 case JIM_EXPROP_GTE
:
8022 case JIM_EXPROP_NUMEQ
:
8026 case JIM_EXPROP_NUMNE
:
8035 /* Handle the string case */
8037 /* XXX: Could optimise the eq/ne case by checking lengths */
8038 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8040 switch (e
->opcode
) {
8047 case JIM_EXPROP_LTE
:
8050 case JIM_EXPROP_GTE
:
8053 case JIM_EXPROP_NUMEQ
:
8056 case JIM_EXPROP_NUMNE
:
8067 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8070 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8074 Jim_DecrRefCount(interp
, A
);
8075 Jim_DecrRefCount(interp
, B
);
8080 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8085 listlen
= Jim_ListLength(interp
, listObjPtr
);
8086 for (i
= 0; i
< listlen
; i
++) {
8087 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8094 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8096 Jim_Obj
*B
= ExprPop(e
);
8097 Jim_Obj
*A
= ExprPop(e
);
8101 switch (e
->opcode
) {
8102 case JIM_EXPROP_STREQ
:
8103 case JIM_EXPROP_STRNE
:
8104 wC
= Jim_StringEqObj(A
, B
);
8105 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8109 case JIM_EXPROP_STRIN
:
8110 wC
= JimSearchList(interp
, B
, A
);
8112 case JIM_EXPROP_STRNI
:
8113 wC
= !JimSearchList(interp
, B
, A
);
8118 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8120 Jim_DecrRefCount(interp
, A
);
8121 Jim_DecrRefCount(interp
, B
);
8126 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8131 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8134 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8140 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8142 Jim_Obj
*skip
= ExprPop(e
);
8143 Jim_Obj
*A
= ExprPop(e
);
8146 switch (ExprBool(interp
, A
)) {
8148 /* false, so skip RHS opcodes with a 0 result */
8149 e
->skip
= JimWideValue(skip
);
8150 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8154 /* true so continue */
8161 Jim_DecrRefCount(interp
, A
);
8162 Jim_DecrRefCount(interp
, skip
);
8167 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8169 Jim_Obj
*skip
= ExprPop(e
);
8170 Jim_Obj
*A
= ExprPop(e
);
8173 switch (ExprBool(interp
, A
)) {
8175 /* false, so do nothing */
8179 /* true so skip RHS opcodes with a 1 result */
8180 e
->skip
= JimWideValue(skip
);
8181 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8189 Jim_DecrRefCount(interp
, A
);
8190 Jim_DecrRefCount(interp
, skip
);
8195 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8197 Jim_Obj
*A
= ExprPop(e
);
8200 switch (ExprBool(interp
, A
)) {
8202 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8206 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8214 Jim_DecrRefCount(interp
, A
);
8219 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8221 Jim_Obj
*skip
= ExprPop(e
);
8222 Jim_Obj
*A
= ExprPop(e
);
8228 switch (ExprBool(interp
, A
)) {
8230 /* false, skip RHS opcodes */
8231 e
->skip
= JimWideValue(skip
);
8232 /* Push a dummy value */
8233 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8237 /* true so do nothing */
8245 Jim_DecrRefCount(interp
, A
);
8246 Jim_DecrRefCount(interp
, skip
);
8251 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8253 Jim_Obj
*skip
= ExprPop(e
);
8254 Jim_Obj
*B
= ExprPop(e
);
8255 Jim_Obj
*A
= ExprPop(e
);
8257 /* No need to check for A as non-boolean */
8258 if (ExprBool(interp
, A
)) {
8259 /* true, so skip RHS opcodes */
8260 e
->skip
= JimWideValue(skip
);
8261 /* Repush B as the answer */
8265 Jim_DecrRefCount(interp
, skip
);
8266 Jim_DecrRefCount(interp
, A
);
8267 Jim_DecrRefCount(interp
, B
);
8271 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8284 /* name - precedence - arity - opcode
8286 * This array *must* be kept in sync with the JIM_EXPROP enum.
8288 * The following macros pre-compute the string length at compile time.
8290 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8291 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8293 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8294 OPRINIT("*", 110, 2, JimExprOpBin
),
8295 OPRINIT("/", 110, 2, JimExprOpBin
),
8296 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8298 OPRINIT("-", 100, 2, JimExprOpBin
),
8299 OPRINIT("+", 100, 2, JimExprOpBin
),
8301 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8302 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8304 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8305 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8307 OPRINIT("<", 80, 2, JimExprOpBin
),
8308 OPRINIT(">", 80, 2, JimExprOpBin
),
8309 OPRINIT("<=", 80, 2, JimExprOpBin
),
8310 OPRINIT(">=", 80, 2, JimExprOpBin
),
8312 OPRINIT("==", 70, 2, JimExprOpBin
),
8313 OPRINIT("!=", 70, 2, JimExprOpBin
),
8315 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8316 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8317 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8319 OPRINIT_LAZY("&&", 10, 2, NULL
, LAZY_OP
),
8320 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8321 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8323 OPRINIT_LAZY("||", 9, 2, NULL
, LAZY_OP
),
8324 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8325 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8327 OPRINIT_LAZY("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8328 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8329 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8331 OPRINIT_LAZY(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8332 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8333 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8335 OPRINIT("**", 250, 2, JimExprOpBin
),
8337 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8338 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8340 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8341 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8343 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8344 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8345 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8346 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8350 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8351 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8352 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8353 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8354 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8355 OPRINIT("rand", 200, 0, JimExprOpNone
),
8356 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8358 #ifdef JIM_MATH_FUNCTIONS
8359 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8360 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8361 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8362 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8363 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8364 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8365 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8366 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8367 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8368 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8369 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8370 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8371 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8372 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8373 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8374 OPRINIT("pow", 200, 2, JimExprOpBin
),
8380 #define JIM_EXPR_OPERATORS_NUM \
8381 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8383 static int JimParseExpression(struct JimParserCtx
*pc
)
8385 /* Discard spaces and quoted newline */
8386 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8387 if (*pc
->p
== '\n') {
8395 pc
->tline
= pc
->linenr
;
8400 pc
->tt
= JIM_TT_EOL
;
8406 pc
->tt
= JIM_TT_SUBEXPR_START
;
8409 pc
->tt
= JIM_TT_SUBEXPR_END
;
8412 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8419 return JimParseCmd(pc
);
8421 if (JimParseVar(pc
) == JIM_ERR
)
8422 return JimParseExprOperator(pc
);
8424 /* Don't allow expr sugar in expressions */
8425 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8442 return JimParseExprNumber(pc
);
8444 return JimParseQuote(pc
);
8446 return JimParseBrace(pc
);
8452 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8453 return JimParseExprOperator(pc
);
8456 return JimParseExprOperator(pc
);
8462 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8466 /* Assume an integer for now */
8467 pc
->tt
= JIM_TT_EXPR_INT
;
8469 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8470 /* Tried as an integer, but perhaps it parses as a double */
8471 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8472 /* Some stupid compilers insist they are cleverer that
8473 * we are. Even a (void) cast doesn't prevent this warning!
8475 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8476 if (end
== pc
->tstart
)
8479 /* Yes, double captured more chars */
8480 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8484 pc
->tend
= pc
->p
- 1;
8485 pc
->len
-= (pc
->p
- pc
->tstart
);
8489 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8491 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8494 for (i
= 0; irrationals
[i
]; i
++) {
8495 const char *irr
= irrationals
[i
];
8497 if (strncmp(irr
, pc
->p
, 3) == 0) {
8500 pc
->tend
= pc
->p
- 1;
8501 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8508 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8511 int bestIdx
= -1, bestLen
= 0;
8513 /* Try to get the longest match. */
8514 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8515 const char * const opname
= Jim_ExprOperators
[i
].name
;
8516 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8518 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8522 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8523 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8527 if (bestIdx
== -1) {
8531 /* Validate paretheses around function arguments */
8532 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8533 const char *p
= pc
->p
+ bestLen
;
8534 int len
= pc
->len
- bestLen
;
8536 while (len
&& isspace(UCHAR(*p
))) {
8544 pc
->tend
= pc
->p
+ bestLen
- 1;
8552 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8554 static Jim_ExprOperator dummy_op
;
8555 if (opcode
< JIM_TT_EXPR_OP
) {
8558 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8561 const char *jim_tt_name(int type
)
8563 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8564 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8566 if (type
< JIM_TT_EXPR_OP
) {
8567 return tt_names
[type
];
8570 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8571 static char buf
[20];
8576 sprintf(buf
, "(%d)", type
);
8581 /* -----------------------------------------------------------------------------
8583 * ---------------------------------------------------------------------------*/
8584 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8585 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8586 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8588 static const Jim_ObjType exprObjType
= {
8590 FreeExprInternalRep
,
8593 JIM_TYPE_REFERENCES
,
8596 /* Expr bytecode structure */
8597 typedef struct ExprByteCode
8599 ScriptToken
*token
; /* Tokens array. */
8600 int len
; /* Length as number of tokens. */
8601 int inUse
; /* Used for sharing. */
8604 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8608 for (i
= 0; i
< expr
->len
; i
++) {
8609 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8611 Jim_Free(expr
->token
);
8615 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8617 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8620 if (--expr
->inUse
!= 0) {
8624 ExprFreeByteCode(interp
, expr
);
8628 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8630 JIM_NOTUSED(interp
);
8631 JIM_NOTUSED(srcPtr
);
8633 /* Just returns an simple string. */
8634 dupPtr
->typePtr
= NULL
;
8637 /* Check if an expr program looks correct. */
8638 static int ExprCheckCorrectness(ExprByteCode
* expr
)
8644 /* Try to check if there are stack underflows,
8645 * and make sure at the end of the program there is
8646 * a single result on the stack. */
8647 for (i
= 0; i
< expr
->len
; i
++) {
8648 ScriptToken
*t
= &expr
->token
[i
];
8649 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8651 stacklen
-= op
->arity
;
8655 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8658 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8662 /* All operations and operands add one to the stack */
8665 if (stacklen
!= 1 || ternary
!= 0) {
8671 /* This procedure converts every occurrence of || and && opereators
8672 * in lazy unary versions.
8674 * a b || is converted into:
8676 * a <offset> |L b |R
8678 * a b && is converted into:
8680 * a <offset> &L b &R
8682 * "|L" checks if 'a' is true:
8683 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8684 * the opcode just after |R.
8685 * 2) if it is false does nothing.
8686 * "|R" checks if 'b' is true:
8687 * 1) if it is true pushes 1, otherwise pushes 0.
8689 * "&L" checks if 'a' is true:
8690 * 1) if it is true does nothing.
8691 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8692 * the opcode just after &R
8693 * "&R" checks if 'a' is true:
8694 * if it is true pushes 1, otherwise pushes 0.
8696 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8700 int leftindex
, arity
, offset
;
8702 /* Search for the end of the first operator */
8703 leftindex
= expr
->len
- 1;
8707 ScriptToken
*tt
= &expr
->token
[leftindex
];
8709 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8710 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8713 if (--leftindex
< 0) {
8720 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8721 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8723 offset
= (expr
->len
- leftindex
) - 1;
8725 /* Now we rely on the fact the the left and right version have opcodes
8726 * 1 and 2 after the main opcode respectively
8728 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8729 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8731 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8732 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8734 /* Now add the 'R' operator */
8735 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8736 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8739 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8740 for (i
= leftindex
- 1; i
> 0; i
--) {
8741 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8742 if (op
->lazy
== LAZY_LEFT
) {
8743 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8744 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8751 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8753 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8754 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8756 if (op
->lazy
== LAZY_OP
) {
8757 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8758 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8763 token
->objPtr
= interp
->emptyObj
;
8764 token
->type
= t
->type
;
8771 * Returns the index of the COLON_LEFT to the left of 'right_index'
8772 * taking into account nesting.
8774 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8776 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8778 int ternary_count
= 1;
8782 while (right_index
> 1) {
8783 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8786 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8789 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8800 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8802 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8803 * Otherwise returns 0.
8805 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8807 int i
= right_index
- 1;
8808 int ternary_count
= 1;
8811 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8812 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8813 *prev_right_index
= i
- 2;
8814 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8818 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8819 if (ternary_count
== 0) {
8830 * ExprTernaryReorderExpression description
8831 * ========================================
8833 * ?: is right-to-left associative which doesn't work with the stack-based
8834 * expression engine. The fix is to reorder the bytecode.
8840 * Has initial bytecode:
8842 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8843 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8845 * The fix involves simulating this expression instead:
8849 * With the following bytecode:
8851 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8852 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8854 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8855 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8856 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8857 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8859 * ExprTernaryReorderExpression works thus as follows :
8860 * - start from the end of the stack
8861 * - while walking towards the beginning of the stack
8862 * if token=JIM_EXPROP_COLON_RIGHT then
8863 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8864 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8865 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8867 * perform the rotation
8868 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8872 * Note: care has to be taken for nested ternary constructs!!!
8874 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
8878 for (i
= expr
->len
- 1; i
> 1; i
--) {
8879 int prev_right_index
;
8880 int prev_left_index
;
8884 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
8888 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8889 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
8894 ** rotate tokens down
8896 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8905 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8907 tmp
= expr
->token
[prev_right_index
];
8908 for (j
= prev_right_index
; j
< i
; j
++) {
8909 expr
->token
[j
] = expr
->token
[j
+ 1];
8911 expr
->token
[i
] = tmp
;
8913 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8915 * This is 'colon left increment' = i - prev_right_index
8917 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8918 * [prev_left_index-1] : skip_count
8921 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
8923 /* Adjust for i-- in the loop */
8928 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*fileNameObj
)
8934 int prevtt
= JIM_TT_NONE
;
8935 int have_ternary
= 0;
8938 int count
= tokenlist
->count
- 1;
8940 expr
= Jim_Alloc(sizeof(*expr
));
8944 Jim_InitStack(&stack
);
8946 /* Need extra bytecodes for lazy operators.
8947 * Also check for the ternary operator
8949 for (i
= 0; i
< tokenlist
->count
; i
++) {
8950 ParseToken
*t
= &tokenlist
->list
[i
];
8951 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8953 if (op
->lazy
== LAZY_OP
) {
8955 /* Ternary is a lazy op but also needs reordering */
8956 if (t
->type
== JIM_EXPROP_TERNARY
) {
8962 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
8964 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
8965 ParseToken
*t
= &tokenlist
->list
[i
];
8967 /* Next token will be stored here */
8968 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8970 if (t
->type
== JIM_TT_EOL
) {
8978 case JIM_TT_DICTSUGAR
:
8979 case JIM_TT_EXPRSUGAR
:
8981 token
->type
= t
->type
;
8983 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
8984 if (t
->type
== JIM_TT_CMD
) {
8985 /* Only commands need source info */
8986 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
8991 case JIM_TT_EXPR_INT
:
8992 case JIM_TT_EXPR_DOUBLE
:
8995 if (t
->type
== JIM_TT_EXPR_INT
) {
8996 token
->objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
8999 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9001 if (endptr
!= t
->token
+ t
->len
) {
9002 /* Conversion failed, so just store it as a string */
9003 Jim_FreeNewObj(interp
, token
->objPtr
);
9004 token
->type
= JIM_TT_STR
;
9007 token
->type
= t
->type
;
9012 case JIM_TT_SUBEXPR_START
:
9013 Jim_StackPush(&stack
, t
);
9014 prevtt
= JIM_TT_NONE
;
9017 case JIM_TT_SUBEXPR_COMMA
:
9018 /* Simple approach. Comma is simply ignored */
9021 case JIM_TT_SUBEXPR_END
:
9023 while (Jim_StackLen(&stack
)) {
9024 ParseToken
*tt
= Jim_StackPop(&stack
);
9026 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9031 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9036 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
9043 /* Must be an operator */
9044 const struct Jim_ExprOperator
*op
;
9047 /* Convert -/+ to unary minus or unary plus if necessary */
9048 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
9049 if (t
->type
== JIM_EXPROP_SUB
) {
9050 t
->type
= JIM_EXPROP_UNARYMINUS
;
9052 else if (t
->type
== JIM_EXPROP_ADD
) {
9053 t
->type
= JIM_EXPROP_UNARYPLUS
;
9057 op
= JimExprOperatorInfoByOpcode(t
->type
);
9059 /* Now handle precedence */
9060 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9061 const struct Jim_ExprOperator
*tt_op
=
9062 JimExprOperatorInfoByOpcode(tt
->type
);
9064 /* Note that right-to-left associativity of ?: operator is handled later */
9066 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9067 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9071 Jim_StackPop(&stack
);
9077 Jim_StackPush(&stack
, t
);
9084 /* Reduce any remaining subexpr */
9085 while (Jim_StackLen(&stack
)) {
9086 ParseToken
*tt
= Jim_StackPop(&stack
);
9088 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9090 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9093 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9100 ExprTernaryReorderExpression(interp
, expr
);
9104 /* Free the stack used for the compilation. */
9105 Jim_FreeStack(&stack
);
9107 for (i
= 0; i
< expr
->len
; i
++) {
9108 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9112 ExprFreeByteCode(interp
, expr
);
9120 /* This method takes the string representation of an expression
9121 * and generates a program for the Expr's stack-based VM. */
9122 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9125 const char *exprText
;
9126 struct JimParserCtx parser
;
9127 struct ExprByteCode
*expr
;
9128 ParseTokenList tokenlist
;
9130 Jim_Obj
*fileNameObj
;
9133 /* Try to get information about filename / line number */
9134 if (objPtr
->typePtr
== &sourceObjType
) {
9135 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9136 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9139 fileNameObj
= interp
->emptyObj
;
9142 Jim_IncrRefCount(fileNameObj
);
9144 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9146 /* Initially tokenise the expression into tokenlist */
9147 ScriptTokenListInit(&tokenlist
);
9149 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9150 while (!parser
.eof
) {
9151 if (JimParseExpression(&parser
) != JIM_OK
) {
9152 ScriptTokenListFree(&tokenlist
);
9154 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9159 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9163 #ifdef DEBUG_SHOW_EXPR_TOKENS
9166 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9167 for (i
= 0; i
< tokenlist
.count
; i
++) {
9168 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9169 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9174 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9175 ScriptTokenListFree(&tokenlist
);
9176 Jim_DecrRefCount(interp
, fileNameObj
);
9180 /* Now create the expression bytecode from the tokenlist */
9181 expr
= ExprCreateByteCode(interp
, &tokenlist
, fileNameObj
);
9183 /* No longer need the token list */
9184 ScriptTokenListFree(&tokenlist
);
9190 #ifdef DEBUG_SHOW_EXPR
9194 printf("==== Expr ====\n");
9195 for (i
= 0; i
< expr
->len
; i
++) {
9196 ScriptToken
*t
= &expr
->token
[i
];
9198 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9203 /* Check program correctness. */
9204 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
9205 ExprFreeByteCode(interp
, expr
);
9212 /* Free the old internal rep and set the new one. */
9213 Jim_DecrRefCount(interp
, fileNameObj
);
9214 Jim_FreeIntRep(interp
, objPtr
);
9215 Jim_SetIntRepPtr(objPtr
, expr
);
9216 objPtr
->typePtr
= &exprObjType
;
9220 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9222 if (objPtr
->typePtr
!= &exprObjType
) {
9223 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9227 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9230 #ifdef JIM_OPTIMIZATION
9231 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9233 if (token
->type
== JIM_TT_EXPR_INT
)
9234 return token
->objPtr
;
9235 else if (token
->type
== JIM_TT_VAR
)
9236 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9237 else if (token
->type
== JIM_TT_DICTSUGAR
)
9238 return JimExpandDictSugar(interp
, token
->objPtr
);
9244 /* -----------------------------------------------------------------------------
9245 * Expressions evaluation.
9246 * Jim uses a specialized stack-based virtual machine for expressions,
9247 * that takes advantage of the fact that expr's operators
9248 * can't be redefined.
9250 * Jim_EvalExpression() uses the bytecode compiled by
9251 * SetExprFromAny() method of the "expression" object.
9253 * On success a Tcl Object containing the result of the evaluation
9254 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9256 * On error the function returns a retcode != to JIM_OK and set a suitable
9257 * error on the interp.
9258 * ---------------------------------------------------------------------------*/
9259 #define JIM_EE_STATICSTACK_LEN 10
9261 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9264 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9266 int retcode
= JIM_OK
;
9267 struct JimExprState e
;
9269 expr
= JimGetExpression(interp
, exprObjPtr
);
9271 return JIM_ERR
; /* error in expression. */
9274 #ifdef JIM_OPTIMIZATION
9275 /* Check for one of the following common expressions used by while/for
9280 * $a < CONST, $a < $b
9281 * $a <= CONST, $a <= $b
9282 * $a > CONST, $a > $b
9283 * $a >= CONST, $a >= $b
9284 * $a != CONST, $a != $b
9285 * $a == CONST, $a == $b
9290 /* STEP 1 -- Check if there are the conditions to run the specialized
9291 * version of while */
9293 switch (expr
->len
) {
9295 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9297 Jim_IncrRefCount(objPtr
);
9298 *exprResultPtrPtr
= objPtr
;
9304 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9305 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9307 if (objPtr
&& JimIsWide(objPtr
)) {
9308 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9309 Jim_IncrRefCount(*exprResultPtrPtr
);
9316 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9317 if (objPtr
&& JimIsWide(objPtr
)) {
9318 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9319 if (objPtr2
&& JimIsWide(objPtr2
)) {
9320 jim_wide wideValueA
= JimWideValue(objPtr
);
9321 jim_wide wideValueB
= JimWideValue(objPtr2
);
9323 switch (expr
->token
[2].type
) {
9325 cmpRes
= wideValueA
< wideValueB
;
9327 case JIM_EXPROP_LTE
:
9328 cmpRes
= wideValueA
<= wideValueB
;
9331 cmpRes
= wideValueA
> wideValueB
;
9333 case JIM_EXPROP_GTE
:
9334 cmpRes
= wideValueA
>= wideValueB
;
9336 case JIM_EXPROP_NUMEQ
:
9337 cmpRes
= wideValueA
== wideValueB
;
9339 case JIM_EXPROP_NUMNE
:
9340 cmpRes
= wideValueA
!= wideValueB
;
9345 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9346 Jim_IncrRefCount(*exprResultPtrPtr
);
9356 /* In order to avoid that the internal repr gets freed due to
9357 * shimmering of the exprObjPtr's object, we make the internal rep
9361 /* The stack-based expr VM itself */
9363 /* Stack allocation. Expr programs have the feature that
9364 * a program of length N can't require a stack longer than
9366 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9367 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9369 e
.stack
= staticStack
;
9373 /* Execute every instruction */
9374 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9377 switch (expr
->token
[i
].type
) {
9378 case JIM_TT_EXPR_INT
:
9379 case JIM_TT_EXPR_DOUBLE
:
9381 ExprPush(&e
, expr
->token
[i
].objPtr
);
9385 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9387 ExprPush(&e
, objPtr
);
9394 case JIM_TT_DICTSUGAR
:
9395 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9397 ExprPush(&e
, objPtr
);
9405 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9406 if (retcode
== JIM_OK
) {
9407 ExprPush(&e
, objPtr
);
9412 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9413 if (retcode
== JIM_OK
) {
9414 ExprPush(&e
, Jim_GetResult(interp
));
9419 /* Find and execute the operation */
9421 e
.opcode
= expr
->token
[i
].type
;
9423 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9424 /* Skip some opcodes if necessary */
9433 if (retcode
== JIM_OK
) {
9434 *exprResultPtrPtr
= ExprPop(&e
);
9437 for (i
= 0; i
< e
.stacklen
; i
++) {
9438 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9441 if (e
.stack
!= staticStack
) {
9447 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9452 Jim_Obj
*exprResultPtr
;
9454 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9455 if (retcode
!= JIM_OK
)
9458 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9459 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9460 Jim_DecrRefCount(interp
, exprResultPtr
);
9464 Jim_DecrRefCount(interp
, exprResultPtr
);
9465 *boolPtr
= doubleValue
!= 0;
9469 *boolPtr
= wideValue
!= 0;
9471 Jim_DecrRefCount(interp
, exprResultPtr
);
9475 /* -----------------------------------------------------------------------------
9476 * ScanFormat String Object
9477 * ---------------------------------------------------------------------------*/
9479 /* This Jim_Obj will held a parsed representation of a format string passed to
9480 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9481 * to be parsed in its entirely first and then, if correct, can be used for
9482 * scanning. To avoid endless re-parsing, the parsed representation will be
9483 * stored in an internal representation and re-used for performance reason. */
9485 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9486 * scanformat string. This part will later be used to extract information
9487 * out from the string to be parsed by Jim_ScanString */
9489 typedef struct ScanFmtPartDescr
9491 char *arg
; /* Specification of a CHARSET conversion */
9492 char *prefix
; /* Prefix to be scanned literally before conversion */
9493 size_t width
; /* Maximal width of input to be converted */
9494 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9495 char type
; /* Type of conversion (e.g. c, d, f) */
9496 char modifier
; /* Modify type (e.g. l - long, h - short */
9499 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9500 * string parsed and separated in part descriptions. Furthermore it contains
9501 * the original string representation of the scanformat string to allow for
9502 * fast update of the Jim_Obj's string representation part.
9504 * As an add-on the internal object representation adds some scratch pad area
9505 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9506 * memory for purpose of string scanning.
9508 * The error member points to a static allocated string in case of a mal-
9509 * formed scanformat string or it contains '0' (NULL) in case of a valid
9510 * parse representation.
9512 * The whole memory of the internal representation is allocated as a single
9513 * area of memory that will be internally separated. So freeing and duplicating
9514 * of such an object is cheap */
9516 typedef struct ScanFmtStringObj
9518 jim_wide size
; /* Size of internal repr in bytes */
9519 char *stringRep
; /* Original string representation */
9520 size_t count
; /* Number of ScanFmtPartDescr contained */
9521 size_t convCount
; /* Number of conversions that will assign */
9522 size_t maxPos
; /* Max position index if XPG3 is used */
9523 const char *error
; /* Ptr to error text (NULL if no error */
9524 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9525 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9529 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9530 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9531 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9533 static const Jim_ObjType scanFmtStringObjType
= {
9535 FreeScanFmtInternalRep
,
9536 DupScanFmtInternalRep
,
9537 UpdateStringOfScanFmt
,
9541 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9543 JIM_NOTUSED(interp
);
9544 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9545 objPtr
->internalRep
.ptr
= 0;
9548 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9550 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9551 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9553 JIM_NOTUSED(interp
);
9554 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9555 dupPtr
->internalRep
.ptr
= newVec
;
9556 dupPtr
->typePtr
= &scanFmtStringObjType
;
9559 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9561 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9564 /* SetScanFmtFromAny will parse a given string and create the internal
9565 * representation of the format specification. In case of an error
9566 * the error data member of the internal representation will be set
9567 * to an descriptive error text and the function will be left with
9568 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9571 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9573 ScanFmtStringObj
*fmtObj
;
9575 int maxCount
, i
, approxSize
, lastPos
= -1;
9576 const char *fmt
= objPtr
->bytes
;
9577 int maxFmtLen
= objPtr
->length
;
9578 const char *fmtEnd
= fmt
+ maxFmtLen
;
9581 Jim_FreeIntRep(interp
, objPtr
);
9582 /* Count how many conversions could take place maximally */
9583 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9586 /* Calculate an approximation of the memory necessary */
9587 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9588 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9589 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9590 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9591 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9592 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9593 +1; /* safety byte */
9594 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9595 memset(fmtObj
, 0, approxSize
);
9596 fmtObj
->size
= approxSize
;
9598 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9599 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9600 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9601 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9602 objPtr
->internalRep
.ptr
= fmtObj
;
9603 objPtr
->typePtr
= &scanFmtStringObjType
;
9604 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9605 int width
= 0, skip
;
9606 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9609 descr
->width
= 0; /* Assume width unspecified */
9610 /* Overread and store any "literal" prefix */
9611 if (*fmt
!= '%' || fmt
[1] == '%') {
9613 descr
->prefix
= &buffer
[i
];
9614 for (; fmt
< fmtEnd
; ++fmt
) {
9624 /* Skip the conversion introducing '%' sign */
9626 /* End reached due to non-conversion literal only? */
9629 descr
->pos
= 0; /* Assume "natural" positioning */
9631 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9635 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9636 /* Check if next token is a number (could be width or pos */
9637 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9639 /* Was the number a XPG3 position specifier? */
9640 if (descr
->pos
!= -1 && *fmt
== '$') {
9646 /* Look if "natural" postioning and XPG3 one was mixed */
9647 if ((lastPos
== 0 && descr
->pos
> 0)
9648 || (lastPos
> 0 && descr
->pos
== 0)) {
9649 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9652 /* Look if this position was already used */
9653 for (prev
= 0; prev
< curr
; ++prev
) {
9654 if (fmtObj
->descr
[prev
].pos
== -1)
9656 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9658 "variable is assigned by multiple \"%n$\" conversion specifiers";
9662 /* Try to find a width after the XPG3 specifier */
9663 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9664 descr
->width
= width
;
9667 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9668 fmtObj
->maxPos
= descr
->pos
;
9671 /* Number was not a XPG3, so it has to be a width */
9672 descr
->width
= width
;
9675 /* If positioning mode was undetermined yet, fix this */
9677 lastPos
= descr
->pos
;
9678 /* Handle CHARSET conversion type ... */
9680 int swapped
= 1, beg
= i
, end
, j
;
9683 descr
->arg
= &buffer
[i
];
9686 buffer
[i
++] = *fmt
++;
9688 buffer
[i
++] = *fmt
++;
9689 while (*fmt
&& *fmt
!= ']')
9690 buffer
[i
++] = *fmt
++;
9692 fmtObj
->error
= "unmatched [ in format string";
9697 /* In case a range fence was given "backwards", swap it */
9700 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9701 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9702 char tmp
= buffer
[j
- 1];
9704 buffer
[j
- 1] = buffer
[j
+ 1];
9705 buffer
[j
+ 1] = tmp
;
9712 /* Remember any valid modifier if given */
9713 if (strchr("hlL", *fmt
) != 0)
9714 descr
->modifier
= tolower((int)*fmt
++);
9717 if (strchr("efgcsndoxui", *fmt
) == 0) {
9718 fmtObj
->error
= "bad scan conversion character";
9721 else if (*fmt
== 'c' && descr
->width
!= 0) {
9722 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9725 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9726 fmtObj
->error
= "unsigned wide not supported";
9736 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9738 #define FormatGetCnvCount(_fo_) \
9739 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9740 #define FormatGetMaxPos(_fo_) \
9741 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9742 #define FormatGetError(_fo_) \
9743 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9745 /* JimScanAString is used to scan an unspecified string that ends with
9746 * next WS, or a string that is specified via a charset.
9749 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9751 char *buffer
= Jim_StrDup(str
);
9758 if (!sdescr
&& isspace(UCHAR(*str
)))
9759 break; /* EOS via WS if unspecified */
9761 n
= utf8_tounicode(str
, &c
);
9762 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9768 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9771 /* ScanOneEntry will scan one entry out of the string passed as argument.
9772 * It use the sscanf() function for this task. After extracting and
9773 * converting of the value, the count of scanned characters will be
9774 * returned of -1 in case of no conversion tool place and string was
9775 * already scanned thru */
9777 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9778 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9781 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9783 size_t anchor
= pos
;
9785 Jim_Obj
*tmpObj
= NULL
;
9787 /* First pessimistically assume, we will not scan anything :-) */
9789 if (descr
->prefix
) {
9790 /* There was a prefix given before the conversion, skip it and adjust
9791 * the string-to-be-parsed accordingly */
9792 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9793 /* If prefix require, skip WS */
9794 if (isspace(UCHAR(descr
->prefix
[i
])))
9795 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9797 else if (descr
->prefix
[i
] != str
[pos
])
9798 break; /* Prefix do not match here, leave the loop */
9800 ++pos
; /* Prefix matched so far, next round */
9802 if (pos
>= strLen
) {
9803 return -1; /* All of str consumed: EOF condition */
9805 else if (descr
->prefix
[i
] != 0)
9806 return 0; /* Not whole prefix consumed, no conversion possible */
9808 /* For all but following conversion, skip leading WS */
9809 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9810 while (isspace(UCHAR(str
[pos
])))
9812 /* Determine how much skipped/scanned so far */
9813 scanned
= pos
- anchor
;
9815 /* %c is a special, simple case. no width */
9816 if (descr
->type
== 'n') {
9817 /* Return pseudo conversion means: how much scanned so far? */
9818 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9820 else if (pos
>= strLen
) {
9821 /* Cannot scan anything, as str is totally consumed */
9824 else if (descr
->type
== 'c') {
9826 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9827 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9831 /* Processing of conversions follows ... */
9832 if (descr
->width
> 0) {
9833 /* Do not try to scan as fas as possible but only the given width.
9834 * To ensure this, we copy the part that should be scanned. */
9835 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9836 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9838 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9839 tok
= tmpObj
->bytes
;
9842 /* As no width was given, simply refer to the original string */
9845 switch (descr
->type
) {
9851 char *endp
; /* Position where the number finished */
9854 int base
= descr
->type
== 'o' ? 8
9855 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
9857 /* Try to scan a number with the given base */
9859 w
= jim_strtoull(tok
, &endp
);
9862 w
= strtoull(tok
, &endp
, base
);
9866 /* There was some number sucessfully scanned! */
9867 *valObjPtr
= Jim_NewIntObj(interp
, w
);
9869 /* Adjust the number-of-chars scanned so far */
9870 scanned
+= endp
- tok
;
9873 /* Nothing was scanned. We have to determine if this
9874 * happened due to e.g. prefix mismatch or input str
9876 scanned
= *tok
? 0 : -1;
9882 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
9883 scanned
+= Jim_Length(*valObjPtr
);
9890 double value
= strtod(tok
, &endp
);
9893 /* There was some number sucessfully scanned! */
9894 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
9895 /* Adjust the number-of-chars scanned so far */
9896 scanned
+= endp
- tok
;
9899 /* Nothing was scanned. We have to determine if this
9900 * happened due to e.g. prefix mismatch or input str
9902 scanned
= *tok
? 0 : -1;
9907 /* If a substring was allocated (due to pre-defined width) do not
9908 * forget to free it */
9910 Jim_FreeNewObj(interp
, tmpObj
);
9916 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9917 * string and returns all converted (and not ignored) values in a list back
9918 * to the caller. If an error occured, a NULL pointer will be returned */
9920 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
9924 const char *str
= Jim_String(strObjPtr
);
9925 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
9926 Jim_Obj
*resultList
= 0;
9927 Jim_Obj
**resultVec
= 0;
9929 Jim_Obj
*emptyStr
= 0;
9930 ScanFmtStringObj
*fmtObj
;
9932 /* This should never happen. The format object should already be of the correct type */
9933 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
9935 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
9936 /* Check if format specification was valid */
9937 if (fmtObj
->error
!= 0) {
9938 if (flags
& JIM_ERRMSG
)
9939 Jim_SetResultString(interp
, fmtObj
->error
, -1);
9942 /* Allocate a new "shared" empty string for all unassigned conversions */
9943 emptyStr
= Jim_NewEmptyStringObj(interp
);
9944 Jim_IncrRefCount(emptyStr
);
9945 /* Create a list and fill it with empty strings up to max specified XPG3 */
9946 resultList
= Jim_NewListObj(interp
, NULL
, 0);
9947 if (fmtObj
->maxPos
> 0) {
9948 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
9949 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
9950 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
9952 /* Now handle every partial format description */
9953 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
9954 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
9957 /* Only last type may be "literal" w/o conversion - skip it! */
9958 if (descr
->type
== 0)
9960 /* As long as any conversion could be done, we will proceed */
9962 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
9963 /* In case our first try results in EOF, we will leave */
9964 if (scanned
== -1 && i
== 0)
9966 /* Advance next pos-to-be-scanned for the amount scanned already */
9969 /* value == 0 means no conversion took place so take empty string */
9971 value
= Jim_NewEmptyStringObj(interp
);
9972 /* If value is a non-assignable one, skip it */
9973 if (descr
->pos
== -1) {
9974 Jim_FreeNewObj(interp
, value
);
9976 else if (descr
->pos
== 0)
9977 /* Otherwise append it to the result list if no XPG3 was given */
9978 Jim_ListAppendElement(interp
, resultList
, value
);
9979 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
9980 /* But due to given XPG3, put the value into the corr. slot */
9981 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
9982 Jim_IncrRefCount(value
);
9983 resultVec
[descr
->pos
- 1] = value
;
9986 /* Otherwise, the slot was already used - free obj and ERROR */
9987 Jim_FreeNewObj(interp
, value
);
9991 Jim_DecrRefCount(interp
, emptyStr
);
9994 Jim_DecrRefCount(interp
, emptyStr
);
9995 Jim_FreeNewObj(interp
, resultList
);
9996 return (Jim_Obj
*)EOF
;
9998 Jim_DecrRefCount(interp
, emptyStr
);
9999 Jim_FreeNewObj(interp
, resultList
);
10003 /* -----------------------------------------------------------------------------
10004 * Pseudo Random Number Generation
10005 * ---------------------------------------------------------------------------*/
10006 /* Initialize the sbox with the numbers from 0 to 255 */
10007 static void JimPrngInit(Jim_Interp
*interp
)
10009 #define PRNG_SEED_SIZE 256
10011 unsigned int *seed
;
10012 time_t t
= time(NULL
);
10014 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10016 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10017 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10018 seed
[i
] = (rand() ^ t
^ clock());
10020 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10024 /* Generates N bytes of random data */
10025 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10027 Jim_PrngState
*prng
;
10028 unsigned char *destByte
= (unsigned char *)dest
;
10029 unsigned int si
, sj
, x
;
10031 /* initialization, only needed the first time */
10032 if (interp
->prngState
== NULL
)
10033 JimPrngInit(interp
);
10034 prng
= interp
->prngState
;
10035 /* generates 'len' bytes of pseudo-random numbers */
10036 for (x
= 0; x
< len
; x
++) {
10037 prng
->i
= (prng
->i
+ 1) & 0xff;
10038 si
= prng
->sbox
[prng
->i
];
10039 prng
->j
= (prng
->j
+ si
) & 0xff;
10040 sj
= prng
->sbox
[prng
->j
];
10041 prng
->sbox
[prng
->i
] = sj
;
10042 prng
->sbox
[prng
->j
] = si
;
10043 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10047 /* Re-seed the generator with user-provided bytes */
10048 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10051 Jim_PrngState
*prng
;
10053 /* initialization, only needed the first time */
10054 if (interp
->prngState
== NULL
)
10055 JimPrngInit(interp
);
10056 prng
= interp
->prngState
;
10058 /* Set the sbox[i] with i */
10059 for (i
= 0; i
< 256; i
++)
10061 /* Now use the seed to perform a random permutation of the sbox */
10062 for (i
= 0; i
< seedLen
; i
++) {
10065 t
= prng
->sbox
[i
& 0xFF];
10066 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10067 prng
->sbox
[seed
[i
]] = t
;
10069 prng
->i
= prng
->j
= 0;
10071 /* discard at least the first 256 bytes of stream.
10072 * borrow the seed buffer for this
10074 for (i
= 0; i
< 256; i
+= seedLen
) {
10075 JimRandomBytes(interp
, seed
, seedLen
);
10080 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10082 jim_wide wideValue
, increment
= 1;
10083 Jim_Obj
*intObjPtr
;
10085 if (argc
!= 2 && argc
!= 3) {
10086 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10090 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10093 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10095 /* Set missing variable to 0 */
10098 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10101 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10102 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10103 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10104 Jim_FreeNewObj(interp
, intObjPtr
);
10109 /* Can do it the quick way */
10110 Jim_InvalidateStringRep(intObjPtr
);
10111 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10113 /* The following step is required in order to invalidate the
10114 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10115 if (argv
[1]->typePtr
!= &variableObjType
) {
10116 /* Note that this can't fail since GetVariable already succeeded */
10117 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10120 Jim_SetResult(interp
, intObjPtr
);
10125 /* -----------------------------------------------------------------------------
10127 * ---------------------------------------------------------------------------*/
10128 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10129 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10131 /* Handle calls to the [unknown] command */
10132 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10136 /* If JimUnknown() is recursively called too many times...
10139 if (interp
->unknown_called
> 50) {
10143 /* The object interp->unknown just contains
10144 * the "unknown" string, it is used in order to
10145 * avoid to lookup the unknown command every time
10146 * but instead to cache the result. */
10148 /* If the [unknown] command does not exist ... */
10149 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10152 interp
->unknown_called
++;
10153 /* XXX: Are we losing fileNameObj and linenr? */
10154 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10155 interp
->unknown_called
--;
10160 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10168 for (j
= 0; j
< objc
; j
++) {
10169 printf(" '%s'", Jim_String(objv
[j
]));
10174 if (interp
->framePtr
->tailcallCmd
) {
10175 /* Special tailcall command was pre-resolved */
10176 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10177 interp
->framePtr
->tailcallCmd
= NULL
;
10180 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10181 if (cmdPtr
== NULL
) {
10182 return JimUnknown(interp
, objc
, objv
);
10184 JimIncrCmdRefCount(cmdPtr
);
10187 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10188 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10192 interp
->evalDepth
++;
10194 /* Call it -- Make sure result is an empty object. */
10195 Jim_SetEmptyResult(interp
);
10196 if (cmdPtr
->isproc
) {
10197 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10200 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10201 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10203 interp
->evalDepth
--;
10206 JimDecrCmdRefCount(interp
, cmdPtr
);
10211 /* Eval the object vector 'objv' composed of 'objc' elements.
10212 * Every element is used as single argument.
10213 * Jim_EvalObj() will call this function every time its object
10214 * argument is of "list" type, with no string representation.
10216 * This is possible because the string representation of a
10217 * list object generated by the UpdateStringOfList is made
10218 * in a way that ensures that every list element is a different
10219 * command argument. */
10220 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10224 /* Incr refcount of arguments. */
10225 for (i
= 0; i
< objc
; i
++)
10226 Jim_IncrRefCount(objv
[i
]);
10228 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10230 /* Decr refcount of arguments and return the retcode */
10231 for (i
= 0; i
< objc
; i
++)
10232 Jim_DecrRefCount(interp
, objv
[i
]);
10238 * Invokes 'prefix' as a command with the objv array as arguments.
10240 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10243 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10246 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10247 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10252 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10254 if (!interp
->errorFlag
) {
10255 /* This is the first error, so save the file/line information and reset the stack */
10256 interp
->errorFlag
= 1;
10257 Jim_IncrRefCount(script
->fileNameObj
);
10258 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10259 interp
->errorFileNameObj
= script
->fileNameObj
;
10260 interp
->errorLine
= script
->linenr
;
10262 JimResetStackTrace(interp
);
10263 /* Always add a level where the error first occurs */
10264 interp
->addStackTrace
++;
10267 /* Now if this is an "interesting" level, add it to the stack trace */
10268 if (interp
->addStackTrace
> 0) {
10269 /* Add the stack info for the current level */
10271 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10273 /* Note: if we didn't have a filename for this level,
10274 * don't clear the addStackTrace flag
10275 * so we can pick it up at the next level
10277 if (Jim_Length(script
->fileNameObj
)) {
10278 interp
->addStackTrace
= 0;
10281 Jim_DecrRefCount(interp
, interp
->errorProc
);
10282 interp
->errorProc
= interp
->emptyObj
;
10283 Jim_IncrRefCount(interp
->errorProc
);
10287 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10291 switch (token
->type
) {
10294 objPtr
= token
->objPtr
;
10297 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10299 case JIM_TT_DICTSUGAR
:
10300 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10302 case JIM_TT_EXPRSUGAR
:
10303 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10306 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10309 objPtr
= interp
->result
;
10312 /* Stop substituting */
10315 /* just skip this one */
10316 return JIM_CONTINUE
;
10323 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10328 *objPtrPtr
= objPtr
;
10334 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10335 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10336 * The returned object has refcount = 0.
10338 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10342 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10346 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10349 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10351 /* Compute every token forming the argument
10352 * in the intv objects vector. */
10353 for (i
= 0; i
< tokens
; i
++) {
10354 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10359 if (flags
& JIM_SUBST_FLAG
) {
10364 /* XXX: Should probably set an error about break outside loop */
10365 /* fall through to error */
10367 if (flags
& JIM_SUBST_FLAG
) {
10371 /* XXX: Ditto continue outside loop */
10372 /* fall through to error */
10375 Jim_DecrRefCount(interp
, intv
[i
]);
10377 if (intv
!= sintv
) {
10382 Jim_IncrRefCount(intv
[i
]);
10383 Jim_String(intv
[i
]);
10384 totlen
+= intv
[i
]->length
;
10387 /* Fast path return for a single token */
10388 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10389 Jim_DecrRefCount(interp
, intv
[0]);
10393 /* Concatenate every token in an unique
10395 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10397 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10398 && token
[2].type
== JIM_TT_VAR
) {
10399 /* May be able to do fast interpolated object -> dictSubst */
10400 objPtr
->typePtr
= &interpolatedObjType
;
10401 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10402 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10403 Jim_IncrRefCount(intv
[2]);
10405 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10406 /* The first interpolated token is source, so preserve the source info */
10407 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10411 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10412 objPtr
->length
= totlen
;
10413 for (i
= 0; i
< tokens
; i
++) {
10415 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10416 s
+= intv
[i
]->length
;
10417 Jim_DecrRefCount(interp
, intv
[i
]);
10420 objPtr
->bytes
[totlen
] = '\0';
10421 /* Free the intv vector if not static. */
10422 if (intv
!= sintv
) {
10430 /* listPtr *must* be a list.
10431 * The contents of the list is evaluated with the first element as the command and
10432 * the remaining elements as the arguments.
10434 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10436 int retcode
= JIM_OK
;
10438 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10440 if (listPtr
->internalRep
.listValue
.len
) {
10441 Jim_IncrRefCount(listPtr
);
10442 retcode
= JimInvokeCommand(interp
,
10443 listPtr
->internalRep
.listValue
.len
,
10444 listPtr
->internalRep
.listValue
.ele
);
10445 Jim_DecrRefCount(interp
, listPtr
);
10450 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10452 SetListFromAny(interp
, listPtr
);
10453 return JimEvalObjList(interp
, listPtr
);
10456 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10460 ScriptToken
*token
;
10461 int retcode
= JIM_OK
;
10462 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10463 Jim_Obj
*prevScriptObj
;
10465 /* If the object is of type "list", with no string rep we can call
10466 * a specialized version of Jim_EvalObj() */
10467 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10468 return JimEvalObjList(interp
, scriptObjPtr
);
10471 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10472 script
= JimGetScript(interp
, scriptObjPtr
);
10473 if (!JimScriptValid(interp
, script
)) {
10474 Jim_DecrRefCount(interp
, scriptObjPtr
);
10478 /* Reset the interpreter result. This is useful to
10479 * return the empty result in the case of empty program. */
10480 Jim_SetEmptyResult(interp
);
10482 token
= script
->token
;
10484 #ifdef JIM_OPTIMIZATION
10485 /* Check for one of the following common scripts used by for, while
10490 if (script
->len
== 0) {
10491 Jim_DecrRefCount(interp
, scriptObjPtr
);
10494 if (script
->len
== 3
10495 && token
[1].objPtr
->typePtr
== &commandObjType
10496 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10497 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10498 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10500 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10502 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10503 JimWideValue(objPtr
)++;
10504 Jim_InvalidateStringRep(objPtr
);
10505 Jim_DecrRefCount(interp
, scriptObjPtr
);
10506 Jim_SetResult(interp
, objPtr
);
10512 /* Now we have to make sure the internal repr will not be
10513 * freed on shimmering.
10515 * Think for example to this:
10517 * set x {llength $x; ... some more code ...}; eval $x
10519 * In order to preserve the internal rep, we increment the
10520 * inUse field of the script internal rep structure. */
10523 /* Stash the current script */
10524 prevScriptObj
= interp
->currentScriptObj
;
10525 interp
->currentScriptObj
= scriptObjPtr
;
10527 interp
->errorFlag
= 0;
10530 /* Execute every command sequentially until the end of the script
10531 * or an error occurs.
10533 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10537 /* First token of the line is always JIM_TT_LINE */
10538 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10539 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10541 /* Allocate the arguments vector if required */
10542 if (argc
> JIM_EVAL_SARGV_LEN
)
10543 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10545 /* Skip the JIM_TT_LINE token */
10548 /* Populate the arguments objects.
10549 * If an error occurs, retcode will be set and
10550 * 'j' will be set to the number of args expanded
10552 for (j
= 0; j
< argc
; j
++) {
10553 long wordtokens
= 1;
10555 Jim_Obj
*wordObjPtr
= NULL
;
10557 if (token
[i
].type
== JIM_TT_WORD
) {
10558 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10559 if (wordtokens
< 0) {
10561 wordtokens
= -wordtokens
;
10565 if (wordtokens
== 1) {
10566 /* Fast path if the token does not
10567 * need interpolation */
10569 switch (token
[i
].type
) {
10572 wordObjPtr
= token
[i
].objPtr
;
10575 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10577 case JIM_TT_EXPRSUGAR
:
10578 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10580 case JIM_TT_DICTSUGAR
:
10581 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10584 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10585 if (retcode
== JIM_OK
) {
10586 wordObjPtr
= Jim_GetResult(interp
);
10590 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10594 /* For interpolation we call a helper
10595 * function to do the work for us. */
10596 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10600 if (retcode
== JIM_OK
) {
10606 Jim_IncrRefCount(wordObjPtr
);
10610 argv
[j
] = wordObjPtr
;
10613 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10614 int len
= Jim_ListLength(interp
, wordObjPtr
);
10615 int newargc
= argc
+ len
- 1;
10619 if (argv
== sargv
) {
10620 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10621 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10622 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10626 /* Need to realloc to make room for (len - 1) more entries */
10627 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10631 /* Now copy in the expanded version */
10632 for (k
= 0; k
< len
; k
++) {
10633 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10634 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10637 /* The original object reference is no longer needed,
10638 * after the expansion it is no longer present on
10639 * the argument vector, but the single elements are
10641 Jim_DecrRefCount(interp
, wordObjPtr
);
10643 /* And update the indexes */
10649 if (retcode
== JIM_OK
&& argc
) {
10650 /* Invoke the command */
10651 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10652 /* Check for a signal after each command */
10653 if (Jim_CheckSignal(interp
)) {
10654 retcode
= JIM_SIGNAL
;
10658 /* Finished with the command, so decrement ref counts of each argument */
10660 Jim_DecrRefCount(interp
, argv
[j
]);
10663 if (argv
!= sargv
) {
10669 /* Possibly add to the error stack trace */
10670 if (retcode
== JIM_ERR
) {
10671 JimAddErrorToStack(interp
, script
);
10673 /* Propagate the addStackTrace value through 'return -code error' */
10674 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10675 /* No need to add stack trace */
10676 interp
->addStackTrace
= 0;
10679 /* Restore the current script */
10680 interp
->currentScriptObj
= prevScriptObj
;
10682 /* Note that we don't have to decrement inUse, because the
10683 * following code transfers our use of the reference again to
10684 * the script object. */
10685 Jim_FreeIntRep(interp
, scriptObjPtr
);
10686 scriptObjPtr
->typePtr
= &scriptObjType
;
10687 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10688 Jim_DecrRefCount(interp
, scriptObjPtr
);
10693 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10696 /* If argObjPtr begins with '&', do an automatic upvar */
10697 const char *varname
= Jim_String(argNameObj
);
10698 if (*varname
== '&') {
10699 /* First check that the target variable exists */
10701 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10703 interp
->framePtr
= interp
->framePtr
->parent
;
10704 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10705 interp
->framePtr
= savedCallFrame
;
10710 /* It exists, so perform the binding. */
10711 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10712 Jim_IncrRefCount(objPtr
);
10713 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10714 Jim_DecrRefCount(interp
, objPtr
);
10717 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10723 * Sets the interp result to be an error message indicating the required proc args.
10725 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10727 /* Create a nice error message, consistent with Tcl 8.5 */
10728 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10731 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10732 Jim_AppendString(interp
, argmsg
, " ", 1);
10734 if (i
== cmd
->u
.proc
.argsPos
) {
10735 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10737 Jim_AppendString(interp
, argmsg
, "?", 1);
10738 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10739 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10742 /* We have plain args */
10743 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10747 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10748 Jim_AppendString(interp
, argmsg
, "?", 1);
10749 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10750 Jim_AppendString(interp
, argmsg
, "?", 1);
10753 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10757 Jim_AppendString(interp
, argmsg
, arg
, -1);
10761 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10762 Jim_FreeNewObj(interp
, argmsg
);
10765 #ifdef jim_ext_namespace
10769 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10771 Jim_CallFrame
*callFramePtr
;
10774 /* Create a new callframe */
10775 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10776 callFramePtr
->argv
= &interp
->emptyObj
;
10777 callFramePtr
->argc
= 0;
10778 callFramePtr
->procArgsObjPtr
= NULL
;
10779 callFramePtr
->procBodyObjPtr
= scriptObj
;
10780 callFramePtr
->staticVars
= NULL
;
10781 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10782 callFramePtr
->line
= 0;
10783 Jim_IncrRefCount(scriptObj
);
10784 interp
->framePtr
= callFramePtr
;
10786 /* Check if there are too nested calls */
10787 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10788 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10792 /* Eval the body */
10793 retcode
= Jim_EvalObj(interp
, scriptObj
);
10796 /* Destroy the callframe */
10797 interp
->framePtr
= interp
->framePtr
->parent
;
10798 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10804 /* Call a procedure implemented in Tcl.
10805 * It's possible to speed-up a lot this function, currently
10806 * the callframes are not cached, but allocated and
10807 * destroied every time. What is expecially costly is
10808 * to create/destroy the local vars hash table every time.
10810 * This can be fixed just implementing callframes caching
10811 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10812 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10814 Jim_CallFrame
*callFramePtr
;
10815 int i
, d
, retcode
, optargs
;
10819 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10820 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10821 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10825 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10826 /* Optimise for procedure with no body - useful for optional debugging */
10830 /* Check if there are too nested calls */
10831 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10832 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10836 /* Create a new callframe */
10837 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10838 callFramePtr
->argv
= argv
;
10839 callFramePtr
->argc
= argc
;
10840 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10841 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10842 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10844 /* Remember where we were called from. */
10845 script
= JimGetScript(interp
, interp
->currentScriptObj
);
10846 callFramePtr
->fileNameObj
= script
->fileNameObj
;
10847 callFramePtr
->line
= script
->linenr
;
10849 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
10850 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
10851 interp
->framePtr
= callFramePtr
;
10853 /* How many optional args are available */
10854 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
10856 /* Step 'i' along the actual args, and step 'd' along the formal args */
10858 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
10859 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
10860 if (d
== cmd
->u
.proc
.argsPos
) {
10862 Jim_Obj
*listObjPtr
;
10864 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
10865 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
10867 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
10869 /* It is possible to rename args. */
10870 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
10871 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
10873 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
10874 if (retcode
!= JIM_OK
) {
10882 /* Optional or required? */
10883 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
10884 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
10887 /* Ran out, so use the default */
10888 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
10890 if (retcode
!= JIM_OK
) {
10895 /* Eval the body */
10896 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
10900 /* Free the callframe */
10901 interp
->framePtr
= interp
->framePtr
->parent
;
10902 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10904 /* Now chain any tailcalls in the parent frame */
10905 if (interp
->framePtr
->tailcallObj
) {
10907 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
10909 interp
->framePtr
->tailcallObj
= NULL
;
10911 if (retcode
== JIM_EVAL
) {
10912 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
10913 if (retcode
== JIM_RETURN
) {
10914 /* If the result of the tailcall is 'return', push
10915 * it up to the caller
10917 interp
->returnLevel
++;
10920 Jim_DecrRefCount(interp
, tailcallObj
);
10921 } while (interp
->framePtr
->tailcallObj
);
10923 /* If the tailcall chain finished early, may need to manually discard the command */
10924 if (interp
->framePtr
->tailcallCmd
) {
10925 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
10926 interp
->framePtr
->tailcallCmd
= NULL
;
10930 /* Handle the JIM_RETURN return code */
10931 if (retcode
== JIM_RETURN
) {
10932 if (--interp
->returnLevel
<= 0) {
10933 retcode
= interp
->returnCode
;
10934 interp
->returnCode
= JIM_OK
;
10935 interp
->returnLevel
= 0;
10938 else if (retcode
== JIM_ERR
) {
10939 interp
->addStackTrace
++;
10940 Jim_DecrRefCount(interp
, interp
->errorProc
);
10941 interp
->errorProc
= argv
[0];
10942 Jim_IncrRefCount(interp
->errorProc
);
10948 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
10951 Jim_Obj
*scriptObjPtr
;
10953 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
10954 Jim_IncrRefCount(scriptObjPtr
);
10957 Jim_Obj
*prevScriptObj
;
10959 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
10961 prevScriptObj
= interp
->currentScriptObj
;
10962 interp
->currentScriptObj
= scriptObjPtr
;
10964 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10966 interp
->currentScriptObj
= prevScriptObj
;
10969 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10971 Jim_DecrRefCount(interp
, scriptObjPtr
);
10975 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
10977 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
10980 /* Execute script in the scope of the global level */
10981 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
10984 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10986 interp
->framePtr
= interp
->topFramePtr
;
10987 retval
= Jim_Eval(interp
, script
);
10988 interp
->framePtr
= savedFramePtr
;
10993 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
10996 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10998 interp
->framePtr
= interp
->topFramePtr
;
10999 retval
= Jim_EvalFile(interp
, filename
);
11000 interp
->framePtr
= savedFramePtr
;
11005 #include <sys/stat.h>
11007 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11011 Jim_Obj
*scriptObjPtr
;
11012 Jim_Obj
*prevScriptObj
;
11017 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11018 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11021 if (sb
.st_size
== 0) {
11026 buf
= Jim_Alloc(sb
.st_size
+ 1);
11027 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11031 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11037 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11038 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11039 Jim_IncrRefCount(scriptObjPtr
);
11041 prevScriptObj
= interp
->currentScriptObj
;
11042 interp
->currentScriptObj
= scriptObjPtr
;
11044 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11046 /* Handle the JIM_RETURN return code */
11047 if (retcode
== JIM_RETURN
) {
11048 if (--interp
->returnLevel
<= 0) {
11049 retcode
= interp
->returnCode
;
11050 interp
->returnCode
= JIM_OK
;
11051 interp
->returnLevel
= 0;
11054 if (retcode
== JIM_ERR
) {
11055 /* EvalFile changes context, so add a stack frame here */
11056 interp
->addStackTrace
++;
11059 interp
->currentScriptObj
= prevScriptObj
;
11061 Jim_DecrRefCount(interp
, scriptObjPtr
);
11066 /* -----------------------------------------------------------------------------
11068 * ---------------------------------------------------------------------------*/
11069 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11071 pc
->tstart
= pc
->p
;
11072 pc
->tline
= pc
->linenr
;
11074 if (pc
->len
== 0) {
11076 pc
->tt
= JIM_TT_EOL
;
11080 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11084 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11085 if (JimParseVar(pc
) == JIM_OK
) {
11088 /* Not a var, so treat as a string */
11089 pc
->tstart
= pc
->p
;
11090 flags
|= JIM_SUBST_NOVAR
;
11093 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11096 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11099 if (*pc
->p
== '\\' && pc
->len
> 1) {
11106 pc
->tend
= pc
->p
- 1;
11107 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11110 /* The subst object type reuses most of the data structures and functions
11111 * of the script object. Script's data structures are a bit more complex
11112 * for what is needed for [subst]itution tasks, but the reuse helps to
11113 * deal with a single data structure at the cost of some more memory
11114 * usage for substitutions. */
11116 /* This method takes the string representation of an object
11117 * as a Tcl string where to perform [subst]itution, and generates
11118 * the pre-parsed internal representation. */
11119 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11122 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11123 struct JimParserCtx parser
;
11124 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11125 ParseTokenList tokenlist
;
11127 /* Initially parse the subst into tokens (in tokenlist) */
11128 ScriptTokenListInit(&tokenlist
);
11130 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11132 JimParseSubst(&parser
, flags
);
11134 /* Note that subst doesn't need the EOL token */
11137 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11141 /* Create the "real" subst/script tokens from the initial token list */
11143 script
->substFlags
= flags
;
11144 script
->fileNameObj
= interp
->emptyObj
;
11145 Jim_IncrRefCount(script
->fileNameObj
);
11146 SubstObjAddTokens(interp
, script
, &tokenlist
);
11148 /* No longer need the token list */
11149 ScriptTokenListFree(&tokenlist
);
11151 #ifdef DEBUG_SHOW_SUBST
11155 printf("==== Subst ====\n");
11156 for (i
= 0; i
< script
->len
; i
++) {
11157 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11158 Jim_String(script
->token
[i
].objPtr
));
11163 /* Free the old internal rep and set the new one. */
11164 Jim_FreeIntRep(interp
, objPtr
);
11165 Jim_SetIntRepPtr(objPtr
, script
);
11166 objPtr
->typePtr
= &scriptObjType
;
11170 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11172 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11173 SetSubstFromAny(interp
, objPtr
, flags
);
11174 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11177 /* Performs commands,variables,blackslashes substitution,
11178 * storing the result object (with refcount 0) into
11180 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11182 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11184 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11185 /* In order to preserve the internal rep, we increment the
11186 * inUse field of the script internal rep structure. */
11189 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11192 Jim_DecrRefCount(interp
, substObjPtr
);
11193 if (*resObjPtrPtr
== NULL
) {
11199 /* -----------------------------------------------------------------------------
11200 * Core commands utility functions
11201 * ---------------------------------------------------------------------------*/
11202 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11205 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11208 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11210 Jim_IncrRefCount(listObjPtr
);
11211 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11212 Jim_DecrRefCount(interp
, listObjPtr
);
11214 Jim_IncrRefCount(objPtr
);
11215 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11216 Jim_DecrRefCount(interp
, objPtr
);
11220 * May add the key and/or value to the list.
11222 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11223 Jim_HashEntry
*he
, int type
);
11225 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11228 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11229 * invoke the callback to add entries to a list.
11230 * Returns the list.
11232 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11233 JimHashtableIteratorCallbackType
*callback
, int type
)
11236 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11238 /* Check for the non-pattern case. We can do this much more efficiently. */
11239 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11240 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11242 callback(interp
, listObjPtr
, he
, type
);
11246 Jim_HashTableIterator htiter
;
11247 JimInitHashTableIterator(ht
, &htiter
);
11248 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11249 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11250 callback(interp
, listObjPtr
, he
, type
);
11257 /* Keep these in order */
11258 #define JIM_CMDLIST_COMMANDS 0
11259 #define JIM_CMDLIST_PROCS 1
11260 #define JIM_CMDLIST_CHANNELS 2
11263 * Adds matching command names (procs, channels) to the list.
11265 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11266 Jim_HashEntry
*he
, int type
)
11268 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11271 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11276 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11277 Jim_IncrRefCount(objPtr
);
11279 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11280 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11282 Jim_DecrRefCount(interp
, objPtr
);
11285 /* type is JIM_CMDLIST_xxx */
11286 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11288 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11291 /* Keep these in order */
11292 #define JIM_VARLIST_GLOBALS 0
11293 #define JIM_VARLIST_LOCALS 1
11294 #define JIM_VARLIST_VARS 2
11296 #define JIM_VARLIST_VALUES 0x1000
11299 * Adds matching variable names to the list.
11301 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11302 Jim_HashEntry
*he
, int type
)
11304 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11306 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11307 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11308 if (type
& JIM_VARLIST_VALUES
) {
11309 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11314 /* mode is JIM_VARLIST_xxx */
11315 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11317 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11318 /* For [info locals], if we are at top level an emtpy list
11319 * is returned. I don't agree, but we aim at compatibility (SS) */
11320 return interp
->emptyObj
;
11323 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11324 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11328 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11329 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11331 Jim_CallFrame
*targetCallFrame
;
11333 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11334 if (targetCallFrame
== NULL
) {
11337 /* No proc call at toplevel callframe */
11338 if (targetCallFrame
== interp
->topFramePtr
) {
11339 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11342 if (info_level_cmd
) {
11343 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11346 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11348 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11349 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11350 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11351 *objPtrPtr
= listObj
;
11356 /* -----------------------------------------------------------------------------
11358 * ---------------------------------------------------------------------------*/
11360 /* fake [puts] -- not the real puts, just for debugging. */
11361 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11363 if (argc
!= 2 && argc
!= 3) {
11364 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11368 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11369 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11373 fputs(Jim_String(argv
[2]), stdout
);
11377 puts(Jim_String(argv
[1]));
11382 /* Helper for [+] and [*] */
11383 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11385 jim_wide wideValue
, res
;
11386 double doubleValue
, doubleRes
;
11389 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11391 for (i
= 1; i
< argc
; i
++) {
11392 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11394 if (op
== JIM_EXPROP_ADD
)
11399 Jim_SetResultInt(interp
, res
);
11402 doubleRes
= (double)res
;
11403 for (; i
< argc
; i
++) {
11404 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11406 if (op
== JIM_EXPROP_ADD
)
11407 doubleRes
+= doubleValue
;
11409 doubleRes
*= doubleValue
;
11411 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11415 /* Helper for [-] and [/] */
11416 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11418 jim_wide wideValue
, res
= 0;
11419 double doubleValue
, doubleRes
= 0;
11423 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11426 else if (argc
== 2) {
11427 /* The arity = 2 case is different. For [- x] returns -x,
11428 * while [/ x] returns 1/x. */
11429 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11430 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11434 if (op
== JIM_EXPROP_SUB
)
11435 doubleRes
= -doubleValue
;
11437 doubleRes
= 1.0 / doubleValue
;
11438 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11442 if (op
== JIM_EXPROP_SUB
) {
11444 Jim_SetResultInt(interp
, res
);
11447 doubleRes
= 1.0 / wideValue
;
11448 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11453 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11454 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11463 for (i
= 2; i
< argc
; i
++) {
11464 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11465 doubleRes
= (double)res
;
11468 if (op
== JIM_EXPROP_SUB
)
11473 Jim_SetResultInt(interp
, res
);
11476 for (; i
< argc
; i
++) {
11477 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11479 if (op
== JIM_EXPROP_SUB
)
11480 doubleRes
-= doubleValue
;
11482 doubleRes
/= doubleValue
;
11484 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11490 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11492 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11496 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11498 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11502 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11504 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11508 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11510 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11514 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11516 if (argc
!= 2 && argc
!= 3) {
11517 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11523 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11526 Jim_SetResult(interp
, objPtr
);
11529 /* argc == 3 case. */
11530 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11532 Jim_SetResult(interp
, argv
[2]);
11538 * unset ?-nocomplain? ?--? ?varName ...?
11540 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11546 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11550 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11559 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11569 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11572 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11576 /* The general purpose implementation of while starts here */
11578 int boolean
, retval
;
11580 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11585 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11599 Jim_SetEmptyResult(interp
);
11604 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11608 Jim_Obj
*varNamePtr
= NULL
;
11609 Jim_Obj
*stopVarNamePtr
= NULL
;
11612 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11616 /* Do the initialisation */
11617 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11621 /* And do the first test now. Better for optimisation
11622 * if we can do next/test at the bottom of the loop
11624 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11626 /* Ready to do the body as follows:
11628 * body // check retcode
11629 * next // check retcode
11630 * test // check retcode/test bool
11634 #ifdef JIM_OPTIMIZATION
11635 /* Check if the for is on the form:
11636 * for ... {$i < CONST} {incr i}
11637 * for ... {$i < $j} {incr i}
11639 if (retval
== JIM_OK
&& boolean
) {
11640 ScriptObj
*incrScript
;
11641 ExprByteCode
*expr
;
11642 jim_wide stop
, currentVal
;
11646 /* Do it only if there aren't shared arguments */
11647 expr
= JimGetExpression(interp
, argv
[2]);
11648 incrScript
= JimGetScript(interp
, argv
[3]);
11650 /* Ensure proper lengths to start */
11651 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11654 /* Ensure proper token types. */
11655 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11656 expr
->token
[0].type
!= JIM_TT_VAR
||
11657 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11661 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11664 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11671 /* Update command must be incr */
11672 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11676 /* incr, expression must be about the same variable */
11677 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11681 /* Get the stop condition (must be a variable or integer) */
11682 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11683 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11688 stopVarNamePtr
= expr
->token
[1].objPtr
;
11689 Jim_IncrRefCount(stopVarNamePtr
);
11690 /* Keep the compiler happy */
11694 /* Initialization */
11695 varNamePtr
= expr
->token
[0].objPtr
;
11696 Jim_IncrRefCount(varNamePtr
);
11698 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11699 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11703 /* --- OPTIMIZED FOR --- */
11704 while (retval
== JIM_OK
) {
11705 /* === Check condition === */
11706 /* Note that currentVal is already set here */
11708 /* Immediate or Variable? get the 'stop' value if the latter. */
11709 if (stopVarNamePtr
) {
11710 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11711 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11716 if (currentVal
>= stop
+ cmpOffset
) {
11721 retval
= Jim_EvalObj(interp
, argv
[4]);
11722 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11725 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11728 if (objPtr
== NULL
) {
11732 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11733 currentVal
= ++JimWideValue(objPtr
);
11734 Jim_InvalidateStringRep(objPtr
);
11737 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11738 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11739 ++currentVal
)) != JIM_OK
) {
11750 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11752 retval
= Jim_EvalObj(interp
, argv
[4]);
11754 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11757 retval
= Jim_EvalObj(interp
, argv
[3]);
11758 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11761 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11766 if (stopVarNamePtr
) {
11767 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11770 Jim_DecrRefCount(interp
, varNamePtr
);
11773 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11774 Jim_SetEmptyResult(interp
);
11782 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11788 Jim_Obj
*bodyObjPtr
;
11790 if (argc
!= 5 && argc
!= 6) {
11791 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11795 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11796 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11797 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11800 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11802 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11804 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11805 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11806 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11807 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11814 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11815 if (argv
[1]->typePtr
!= &variableObjType
) {
11816 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11820 JimWideValue(objPtr
) = i
;
11821 Jim_InvalidateStringRep(objPtr
);
11823 /* The following step is required in order to invalidate the
11824 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11825 if (argv
[1]->typePtr
!= &variableObjType
) {
11826 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11833 objPtr
= Jim_NewIntObj(interp
, i
);
11834 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11835 if (retval
!= JIM_OK
) {
11836 Jim_FreeNewObj(interp
, objPtr
);
11842 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11843 Jim_SetEmptyResult(interp
);
11849 /* List iterators make it easy to iterate over a list.
11850 * At some point iterators will be expanded to support generators.
11858 * Initialise the iterator at the start of the list.
11860 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
11862 iter
->objPtr
= objPtr
;
11867 * Returns the next object from the list, or NULL on end-of-list.
11869 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11871 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
11874 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
11878 * Returns 1 if end-of-list has been reached.
11880 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11882 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
11885 /* foreach + lmap implementation. */
11886 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
11888 int result
= JIM_OK
;
11890 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
11891 Jim_ListIter
*iters
;
11893 Jim_Obj
*resultObj
;
11895 if (argc
< 4 || argc
% 2 != 0) {
11896 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
11899 script
= argv
[argc
- 1]; /* Last argument is a script */
11900 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
11902 if (numargs
== 2) {
11906 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
11908 for (i
= 0; i
< numargs
; i
++) {
11909 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11910 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
11914 if (result
!= JIM_OK
) {
11915 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
11920 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
11923 resultObj
= interp
->emptyObj
;
11925 Jim_IncrRefCount(resultObj
);
11928 /* Have we expired all lists? */
11929 for (i
= 0; i
< numargs
; i
+= 2) {
11930 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
11934 if (i
== numargs
) {
11939 /* For each list */
11940 for (i
= 0; i
< numargs
; i
+= 2) {
11944 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11945 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
11946 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
11948 /* Ran out, so store the empty string */
11949 valObj
= interp
->emptyObj
;
11951 /* Avoid shimmering */
11952 Jim_IncrRefCount(valObj
);
11953 result
= Jim_SetVariable(interp
, varName
, valObj
);
11954 Jim_DecrRefCount(interp
, valObj
);
11955 if (result
!= JIM_OK
) {
11960 switch (result
= Jim_EvalObj(interp
, script
)) {
11963 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
11976 Jim_SetResult(interp
, resultObj
);
11978 Jim_DecrRefCount(interp
, resultObj
);
11986 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11988 return JimForeachMapHelper(interp
, argc
, argv
, 0);
11992 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11994 return JimForeachMapHelper(interp
, argc
, argv
, 1);
11998 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12000 int result
= JIM_ERR
;
12003 Jim_Obj
*resultObj
;
12006 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12010 JimListIterInit(&iter
, argv
[1]);
12012 for (i
= 2; i
< argc
; i
++) {
12013 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12014 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12015 if (result
!= JIM_OK
) {
12020 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12021 while (!JimListIterDone(interp
, &iter
)) {
12022 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12025 Jim_SetResult(interp
, resultObj
);
12031 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12033 int boolean
, retval
, current
= 1, falsebody
= 0;
12037 /* Far not enough arguments given! */
12038 if (current
>= argc
)
12040 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12043 /* There lacks something, isn't it? */
12044 if (current
>= argc
)
12046 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12048 /* Tsk tsk, no then-clause? */
12049 if (current
>= argc
)
12052 return Jim_EvalObj(interp
, argv
[current
]);
12053 /* Ok: no else-clause follows */
12054 if (++current
>= argc
) {
12055 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12058 falsebody
= current
++;
12059 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12060 /* IIICKS - else-clause isn't last cmd? */
12061 if (current
!= argc
- 1)
12063 return Jim_EvalObj(interp
, argv
[current
]);
12065 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12066 /* Ok: elseif follows meaning all the stuff
12067 * again (how boring...) */
12069 /* OOPS - else-clause is not last cmd? */
12070 else if (falsebody
!= argc
- 1)
12072 return Jim_EvalObj(interp
, argv
[falsebody
]);
12077 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12082 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12083 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12084 Jim_Obj
*stringObj
, int nocase
)
12091 parms
[argc
++] = commandObj
;
12093 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12095 parms
[argc
++] = patternObj
;
12096 parms
[argc
++] = stringObj
;
12098 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12100 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12108 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12111 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12113 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12114 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12115 Jim_Obj
*script
= 0;
12119 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12120 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12123 for (opt
= 1; opt
< argc
; ++opt
) {
12124 const char *option
= Jim_String(argv
[opt
]);
12126 if (*option
!= '-')
12128 else if (strncmp(option
, "--", 2) == 0) {
12132 else if (strncmp(option
, "-exact", 2) == 0)
12133 matchOpt
= SWITCH_EXACT
;
12134 else if (strncmp(option
, "-glob", 2) == 0)
12135 matchOpt
= SWITCH_GLOB
;
12136 else if (strncmp(option
, "-regexp", 2) == 0)
12137 matchOpt
= SWITCH_RE
;
12138 else if (strncmp(option
, "-command", 2) == 0) {
12139 matchOpt
= SWITCH_CMD
;
12140 if ((argc
- opt
) < 2)
12142 command
= argv
[++opt
];
12145 Jim_SetResultFormatted(interp
,
12146 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12150 if ((argc
- opt
) < 2)
12153 strObj
= argv
[opt
++];
12154 patCount
= argc
- opt
;
12155 if (patCount
== 1) {
12158 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12162 caseList
= &argv
[opt
];
12163 if (patCount
== 0 || patCount
% 2 != 0)
12165 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12166 Jim_Obj
*patObj
= caseList
[i
];
12168 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12169 || i
< (patCount
- 2)) {
12170 switch (matchOpt
) {
12172 if (Jim_StringEqObj(strObj
, patObj
))
12173 script
= caseList
[i
+ 1];
12176 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12177 script
= caseList
[i
+ 1];
12180 command
= Jim_NewStringObj(interp
, "regexp", -1);
12181 /* Fall thru intentionally */
12183 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12185 /* After the execution of a command we need to
12186 * make sure to reconvert the object into a list
12187 * again. Only for the single-list style [switch]. */
12188 if (argc
- opt
== 1) {
12191 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12194 /* command is here already decref'd */
12199 script
= caseList
[i
+ 1];
12205 script
= caseList
[i
+ 1];
12208 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12209 script
= caseList
[i
+ 1];
12210 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12211 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12214 Jim_SetEmptyResult(interp
);
12216 return Jim_EvalObj(interp
, script
);
12222 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12224 Jim_Obj
*listObjPtr
;
12226 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12227 Jim_SetResult(interp
, listObjPtr
);
12232 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12234 Jim_Obj
*objPtr
, *listObjPtr
;
12239 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12243 Jim_IncrRefCount(objPtr
);
12244 for (i
= 2; i
< argc
; i
++) {
12245 listObjPtr
= objPtr
;
12246 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12247 Jim_DecrRefCount(interp
, listObjPtr
);
12250 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12251 /* Returns an empty object if the index
12252 * is out of range. */
12253 Jim_DecrRefCount(interp
, listObjPtr
);
12254 Jim_SetEmptyResult(interp
);
12257 Jim_IncrRefCount(objPtr
);
12258 Jim_DecrRefCount(interp
, listObjPtr
);
12260 Jim_SetResult(interp
, objPtr
);
12261 Jim_DecrRefCount(interp
, objPtr
);
12266 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12269 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12272 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12277 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12279 static const char * const options
[] = {
12280 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12284 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12289 int opt_nocase
= 0;
12291 int opt_inline
= 0;
12292 int opt_match
= OPT_EXACT
;
12295 Jim_Obj
*listObjPtr
= NULL
;
12296 Jim_Obj
*commandObj
= NULL
;
12300 Jim_WrongNumArgs(interp
, 1, argv
,
12301 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12305 for (i
= 1; i
< argc
- 2; i
++) {
12308 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12330 if (i
>= argc
- 2) {
12333 commandObj
= argv
[++i
];
12338 opt_match
= option
;
12346 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12348 if (opt_match
== OPT_REGEXP
) {
12349 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12352 Jim_IncrRefCount(commandObj
);
12355 listlen
= Jim_ListLength(interp
, argv
[0]);
12356 for (i
= 0; i
< listlen
; i
++) {
12358 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12360 switch (opt_match
) {
12362 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12366 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12371 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12374 Jim_FreeNewObj(interp
, listObjPtr
);
12382 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12383 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12387 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12388 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12389 Jim_Obj
*resultObj
;
12392 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12394 else if (!opt_inline
) {
12395 resultObj
= Jim_NewIntObj(interp
, i
);
12398 resultObj
= objPtr
;
12402 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12405 Jim_SetResult(interp
, resultObj
);
12412 Jim_SetResult(interp
, listObjPtr
);
12417 Jim_SetResultBool(interp
, opt_not
);
12419 else if (!opt_inline
) {
12420 Jim_SetResultInt(interp
, -1);
12426 Jim_DecrRefCount(interp
, commandObj
);
12432 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12434 Jim_Obj
*listObjPtr
;
12438 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12441 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12443 /* Create the list if it does not exist */
12444 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12445 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12446 Jim_FreeNewObj(interp
, listObjPtr
);
12450 shared
= Jim_IsShared(listObjPtr
);
12452 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12453 for (i
= 2; i
< argc
; i
++)
12454 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12455 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12457 Jim_FreeNewObj(interp
, listObjPtr
);
12460 Jim_SetResult(interp
, listObjPtr
);
12465 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12471 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12475 if (Jim_IsShared(listPtr
))
12476 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12477 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12479 len
= Jim_ListLength(interp
, listPtr
);
12483 idx
= len
+ idx
+ 1;
12484 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12485 Jim_SetResult(interp
, listPtr
);
12488 if (listPtr
!= argv
[1]) {
12489 Jim_FreeNewObj(interp
, listPtr
);
12495 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12497 int first
, last
, len
, rangeLen
;
12499 Jim_Obj
*newListObj
;
12502 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12505 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12506 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12511 len
= Jim_ListLength(interp
, listObj
);
12513 first
= JimRelToAbsIndex(len
, first
);
12514 last
= JimRelToAbsIndex(len
, last
);
12515 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12517 /* Now construct a new list which consists of:
12518 * <elements before first> <supplied elements> <elements after last>
12521 /* Check to see if trying to replace past the end of the list */
12523 /* OK. Not past the end */
12525 else if (len
== 0) {
12526 /* Special for empty list, adjust first to 0 */
12530 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12531 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12535 /* Add the first set of elements */
12536 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12538 /* Add supplied elements */
12539 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12541 /* Add the remaining elements */
12542 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12544 Jim_SetResult(interp
, newListObj
);
12549 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12552 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12555 else if (argc
== 3) {
12556 /* With no indexes, simply implements [set] */
12557 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12559 Jim_SetResult(interp
, argv
[2]);
12562 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12566 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12568 static const char * const options
[] = {
12569 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12572 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12577 struct lsort_info info
;
12580 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12584 info
.type
= JIM_LSORT_ASCII
;
12588 info
.command
= NULL
;
12589 info
.interp
= interp
;
12591 for (i
= 1; i
< (argc
- 1); i
++) {
12594 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12599 info
.type
= JIM_LSORT_ASCII
;
12602 info
.type
= JIM_LSORT_NOCASE
;
12605 info
.type
= JIM_LSORT_INTEGER
;
12608 info
.type
= JIM_LSORT_REAL
;
12610 case OPT_INCREASING
:
12613 case OPT_DECREASING
:
12620 if (i
>= (argc
- 2)) {
12621 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12624 info
.type
= JIM_LSORT_COMMAND
;
12625 info
.command
= argv
[i
+ 1];
12629 if (i
>= (argc
- 2)) {
12630 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12633 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12641 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12642 retCode
= ListSortElements(interp
, resObj
, &info
);
12643 if (retCode
== JIM_OK
) {
12644 Jim_SetResult(interp
, resObj
);
12647 Jim_FreeNewObj(interp
, resObj
);
12653 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12655 Jim_Obj
*stringObjPtr
;
12659 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12663 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12669 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12670 if (!stringObjPtr
) {
12671 /* Create the string if it doesn't exist */
12672 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12675 else if (Jim_IsShared(stringObjPtr
)) {
12677 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12679 for (i
= 2; i
< argc
; i
++) {
12680 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12682 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12684 Jim_FreeNewObj(interp
, stringObjPtr
);
12689 Jim_SetResult(interp
, stringObjPtr
);
12694 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12696 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12697 static const char * const options
[] = {
12698 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12704 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12705 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12710 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12713 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12715 if (option
== OPT_REFCOUNT
) {
12717 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12720 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12723 else if (option
== OPT_OBJCOUNT
) {
12724 int freeobj
= 0, liveobj
= 0;
12729 Jim_WrongNumArgs(interp
, 2, argv
, "");
12732 /* Count the number of free objects. */
12733 objPtr
= interp
->freeList
;
12736 objPtr
= objPtr
->nextObjPtr
;
12738 /* Count the number of live objects. */
12739 objPtr
= interp
->liveList
;
12742 objPtr
= objPtr
->nextObjPtr
;
12744 /* Set the result string and return. */
12745 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12746 Jim_SetResultString(interp
, buf
, -1);
12749 else if (option
== OPT_OBJECTS
) {
12750 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12752 /* Count the number of live objects. */
12753 objPtr
= interp
->liveList
;
12754 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12757 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12759 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12760 sprintf(buf
, "%p", objPtr
);
12761 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12762 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12763 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12764 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12765 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12766 objPtr
= objPtr
->nextObjPtr
;
12768 Jim_SetResult(interp
, listObjPtr
);
12771 else if (option
== OPT_INVSTR
) {
12775 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12779 if (objPtr
->typePtr
!= NULL
)
12780 Jim_InvalidateStringRep(objPtr
);
12781 Jim_SetEmptyResult(interp
);
12784 else if (option
== OPT_SHOW
) {
12789 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12792 s
= Jim_GetString(argv
[2], &len
);
12794 charlen
= utf8_strlen(s
, len
);
12798 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12799 printf("chars (%d): <<%s>>\n", charlen
, s
);
12800 printf("bytes (%d):", len
);
12802 printf(" %02x", (unsigned char)*s
++);
12807 else if (option
== OPT_SCRIPTLEN
) {
12811 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12814 script
= JimGetScript(interp
, argv
[2]);
12815 if (script
== NULL
)
12817 Jim_SetResultInt(interp
, script
->len
);
12820 else if (option
== OPT_EXPRLEN
) {
12821 ExprByteCode
*expr
;
12824 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12827 expr
= JimGetExpression(interp
, argv
[2]);
12830 Jim_SetResultInt(interp
, expr
->len
);
12833 else if (option
== OPT_EXPRBC
) {
12835 ExprByteCode
*expr
;
12839 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12842 expr
= JimGetExpression(interp
, argv
[2]);
12845 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12846 for (i
= 0; i
< expr
->len
; i
++) {
12848 const Jim_ExprOperator
*op
;
12849 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
12851 switch (expr
->token
[i
].type
) {
12852 case JIM_TT_EXPR_INT
:
12855 case JIM_TT_EXPR_DOUBLE
:
12864 case JIM_TT_DICTSUGAR
:
12865 type
= "dictsugar";
12867 case JIM_TT_EXPRSUGAR
:
12868 type
= "exprsugar";
12877 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
12884 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
12887 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
12888 Jim_ListAppendElement(interp
, objPtr
, obj
);
12890 Jim_SetResult(interp
, objPtr
);
12894 Jim_SetResultString(interp
,
12895 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12899 #endif /* JIM_BOOTSTRAP */
12900 #if !defined(JIM_DEBUG_COMMAND)
12901 Jim_SetResultString(interp
, "unsupported", -1);
12907 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12912 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
12917 rc
= Jim_EvalObj(interp
, argv
[1]);
12920 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12923 if (rc
== JIM_ERR
) {
12924 /* eval is "interesting", so add a stack frame here */
12925 interp
->addStackTrace
++;
12931 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12935 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
12938 /* Save the old callframe pointer */
12939 savedCallFrame
= interp
->framePtr
;
12941 /* Lookup the target frame pointer */
12942 str
= Jim_String(argv
[1]);
12943 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
12944 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
12949 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
12951 if (targetCallFrame
== NULL
) {
12955 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
12958 /* Eval the code in the target callframe. */
12959 interp
->framePtr
= targetCallFrame
;
12961 retcode
= Jim_EvalObj(interp
, argv
[1]);
12964 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12966 interp
->framePtr
= savedCallFrame
;
12970 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
12976 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12978 Jim_Obj
*exprResultPtr
;
12982 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
12984 else if (argc
> 2) {
12987 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
12988 Jim_IncrRefCount(objPtr
);
12989 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
12990 Jim_DecrRefCount(interp
, objPtr
);
12993 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
12996 if (retcode
!= JIM_OK
)
12998 Jim_SetResult(interp
, exprResultPtr
);
12999 Jim_DecrRefCount(interp
, exprResultPtr
);
13004 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13007 Jim_WrongNumArgs(interp
, 1, argv
, "");
13014 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13017 Jim_WrongNumArgs(interp
, 1, argv
, "");
13020 return JIM_CONTINUE
;
13024 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13027 Jim_Obj
*stackTraceObj
= NULL
;
13028 Jim_Obj
*errorCodeObj
= NULL
;
13029 int returnCode
= JIM_OK
;
13032 for (i
= 1; i
< argc
- 1; i
+= 2) {
13033 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13034 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13038 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13039 stackTraceObj
= argv
[i
+ 1];
13041 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13042 errorCodeObj
= argv
[i
+ 1];
13044 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13045 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13046 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13055 if (i
!= argc
- 1 && i
!= argc
) {
13056 Jim_WrongNumArgs(interp
, 1, argv
,
13057 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13060 /* If a stack trace is supplied and code is error, set the stack trace */
13061 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13062 JimSetStackTrace(interp
, stackTraceObj
);
13064 /* If an error code list is supplied, set the global $errorCode */
13065 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13066 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13068 interp
->returnCode
= returnCode
;
13069 interp
->returnLevel
= level
;
13071 if (i
== argc
- 1) {
13072 Jim_SetResult(interp
, argv
[i
]);
13078 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13080 if (interp
->framePtr
->level
== 0) {
13081 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13084 else if (argc
>= 2) {
13085 /* Need to resolve the tailcall command in the current context */
13086 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13088 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13089 if (cmdPtr
== NULL
) {
13093 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13095 /* And stash this pre-resolved command */
13096 JimIncrCmdRefCount(cmdPtr
);
13097 cf
->tailcallCmd
= cmdPtr
;
13099 /* And stash the command list */
13100 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13102 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13103 Jim_IncrRefCount(cf
->tailcallObj
);
13105 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13111 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13114 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13116 /* prefixListObj is a list to which the args need to be appended */
13117 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13118 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13120 return JimEvalObjList(interp
, cmdList
);
13123 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13125 Jim_Obj
*prefixListObj
= privData
;
13126 Jim_DecrRefCount(interp
, prefixListObj
);
13129 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13131 Jim_Obj
*prefixListObj
;
13132 const char *newname
;
13135 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13139 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13140 Jim_IncrRefCount(prefixListObj
);
13141 newname
= Jim_String(argv
[1]);
13142 if (newname
[0] == ':' && newname
[1] == ':') {
13143 while (*++newname
== ':') {
13147 Jim_SetResult(interp
, argv
[1]);
13149 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13153 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13157 if (argc
!= 4 && argc
!= 5) {
13158 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13162 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13167 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13170 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13174 /* Add the new command */
13175 Jim_Obj
*qualifiedCmdNameObj
;
13176 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13178 JimCreateCommand(interp
, cmdname
, cmd
);
13180 /* Calculate and set the namespace for this proc */
13181 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13183 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13185 /* Unlike Tcl, set the name of the proc as the result */
13186 Jim_SetResult(interp
, argv
[1]);
13193 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13198 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13202 /* Evaluate the arguments with 'local' in force */
13204 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13208 /* If OK, and the result is a proc, add it to the list of local procs */
13209 if (retcode
== 0) {
13210 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13212 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13215 if (interp
->framePtr
->localCommands
== NULL
) {
13216 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13217 Jim_InitStack(interp
->framePtr
->localCommands
);
13219 Jim_IncrRefCount(cmdNameObj
);
13220 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13227 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13230 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13236 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13237 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13238 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13241 /* OK. Mark this command as being in an upcall */
13242 cmdPtr
->u
.proc
.upcall
++;
13243 JimIncrCmdRefCount(cmdPtr
);
13245 /* Invoke the command as normal */
13246 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13248 /* No longer in an upcall */
13249 cmdPtr
->u
.proc
.upcall
--;
13250 JimDecrCmdRefCount(interp
, cmdPtr
);
13257 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13260 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13266 Jim_Obj
*argListObjPtr
;
13267 Jim_Obj
*bodyObjPtr
;
13268 Jim_Obj
*nsObj
= NULL
;
13271 int len
= Jim_ListLength(interp
, argv
[1]);
13272 if (len
!= 2 && len
!= 3) {
13273 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13278 #ifdef jim_ext_namespace
13279 /* Need to canonicalise the given namespace. */
13280 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13282 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13286 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13287 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13289 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13292 /* Create a new argv array with a dummy argv[0], for error messages */
13293 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13294 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13295 Jim_IncrRefCount(nargv
[0]);
13296 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13297 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13298 Jim_DecrRefCount(interp
, nargv
[0]);
13301 JimDecrCmdRefCount(interp
, cmd
);
13310 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13312 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13317 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13320 Jim_CallFrame
*targetCallFrame
;
13322 /* Lookup the target frame pointer */
13323 if (argc
> 3 && (argc
% 2 == 0)) {
13324 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13329 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13331 if (targetCallFrame
== NULL
) {
13335 /* Check for arity */
13337 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13341 /* Now... for every other/local couple: */
13342 for (i
= 1; i
< argc
; i
+= 2) {
13343 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13350 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13355 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13358 /* Link every var to the toplevel having the same name */
13359 if (interp
->framePtr
->level
== 0)
13360 return JIM_OK
; /* global at toplevel... */
13361 for (i
= 1; i
< argc
; i
++) {
13362 /* global ::blah does nothing */
13363 const char *name
= Jim_String(argv
[i
]);
13364 if (name
[0] != ':' || name
[1] != ':') {
13365 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13372 /* does the [string map] operation. On error NULL is returned,
13373 * otherwise a new string object with the result, having refcount = 0,
13375 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13376 Jim_Obj
*objPtr
, int nocase
)
13379 const char *str
, *noMatchStart
= NULL
;
13381 Jim_Obj
*resultObjPtr
;
13383 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13385 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13389 str
= Jim_String(objPtr
);
13390 strLen
= Jim_Utf8Length(interp
, objPtr
);
13393 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13395 for (i
= 0; i
< numMaps
; i
+= 2) {
13400 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13401 k
= Jim_String(objPtr
);
13402 kl
= Jim_Utf8Length(interp
, objPtr
);
13404 if (strLen
>= kl
&& kl
) {
13406 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13408 if (noMatchStart
) {
13409 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13410 noMatchStart
= NULL
;
13412 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13413 str
+= utf8_index(str
, kl
);
13419 if (i
== numMaps
) { /* no match */
13421 if (noMatchStart
== NULL
)
13422 noMatchStart
= str
;
13423 str
+= utf8_tounicode(str
, &c
);
13427 if (noMatchStart
) {
13428 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13430 return resultObjPtr
;
13434 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13439 static const char * const options
[] = {
13440 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13441 "map", "repeat", "reverse", "index", "first", "last", "cat",
13442 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13446 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13447 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13448 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13450 static const char * const nocase_options
[] = {
13453 static const char * const nocase_length_options
[] = {
13454 "-nocase", "-length", NULL
13458 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13461 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13462 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13467 case OPT_BYTELENGTH
:
13469 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13472 if (option
== OPT_LENGTH
) {
13473 len
= Jim_Utf8Length(interp
, argv
[2]);
13476 len
= Jim_Length(argv
[2]);
13478 Jim_SetResultInt(interp
, len
);
13484 /* optimise the one-arg case */
13490 objPtr
= Jim_NewStringObj(interp
, "", 0);
13492 for (i
= 2; i
< argc
; i
++) {
13493 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13496 Jim_SetResult(interp
, objPtr
);
13503 /* n is the number of remaining option args */
13504 long opt_length
= -1;
13509 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13510 JIM_ENUM_ABBREV
) != JIM_OK
) {
13512 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13523 goto badcompareargs
;
13525 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13532 goto badcompareargs
;
13535 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13536 /* Fast version - [string equal], case sensitive, no length */
13537 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13540 if (opt_length
>= 0) {
13541 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13544 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13546 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13554 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13555 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13556 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13559 if (opt_case
== 0) {
13562 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13570 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13571 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13572 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13576 if (opt_case
== 0) {
13579 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13580 if (objPtr
== NULL
) {
13583 Jim_SetResult(interp
, objPtr
);
13588 case OPT_BYTERANGE
:{
13592 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13595 if (option
== OPT_RANGE
) {
13596 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13600 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13603 if (objPtr
== NULL
) {
13606 Jim_SetResult(interp
, objPtr
);
13613 if (argc
!= 5 && argc
!= 6) {
13614 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13617 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13618 if (objPtr
== NULL
) {
13621 Jim_SetResult(interp
, objPtr
);
13631 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13634 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13637 objPtr
= Jim_NewStringObj(interp
, "", 0);
13640 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13643 Jim_SetResult(interp
, objPtr
);
13654 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13658 str
= Jim_GetString(argv
[2], &len
);
13659 buf
= Jim_Alloc(len
+ 1);
13662 for (i
= 0; i
< len
; ) {
13664 int l
= utf8_tounicode(str
, &c
);
13665 memcpy(p
- l
, str
, l
);
13670 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13679 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13682 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13685 str
= Jim_String(argv
[2]);
13686 len
= Jim_Utf8Length(interp
, argv
[2]);
13687 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13688 idx
= JimRelToAbsIndex(len
, idx
);
13690 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13691 Jim_SetResultString(interp
, "", 0);
13693 else if (len
== Jim_Length(argv
[2])) {
13694 /* ASCII optimisation */
13695 Jim_SetResultString(interp
, str
+ idx
, 1);
13699 int i
= utf8_index(str
, idx
);
13700 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13707 int idx
= 0, l1
, l2
;
13708 const char *s1
, *s2
;
13710 if (argc
!= 4 && argc
!= 5) {
13711 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13714 s1
= Jim_String(argv
[2]);
13715 s2
= Jim_String(argv
[3]);
13716 l1
= Jim_Utf8Length(interp
, argv
[2]);
13717 l2
= Jim_Utf8Length(interp
, argv
[3]);
13719 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13722 idx
= JimRelToAbsIndex(l2
, idx
);
13724 else if (option
== OPT_LAST
) {
13727 if (option
== OPT_FIRST
) {
13728 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13732 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13734 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13742 case OPT_TRIMRIGHT
:{
13743 Jim_Obj
*trimchars
;
13745 if (argc
!= 3 && argc
!= 4) {
13746 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13749 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13750 if (option
== OPT_TRIM
) {
13751 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13753 else if (option
== OPT_TRIMLEFT
) {
13754 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13756 else if (option
== OPT_TRIMRIGHT
) {
13757 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13766 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13769 if (option
== OPT_TOLOWER
) {
13770 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13772 else if (option
== OPT_TOUPPER
) {
13773 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13776 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13781 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13782 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13784 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13791 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13794 jim_wide start
, elapsed
;
13796 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13799 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13803 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13809 start
= JimClock();
13813 retval
= Jim_EvalObj(interp
, argv
[1]);
13814 if (retval
!= JIM_OK
) {
13818 elapsed
= JimClock() - start
;
13819 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13820 Jim_SetResultString(interp
, buf
, -1);
13825 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13830 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13834 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13837 interp
->exitCode
= exitCode
;
13842 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13848 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13849 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
13850 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
13852 /* Reset the error code before catch.
13853 * Note that this is not strictly correct.
13855 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
13857 for (i
= 1; i
< argc
- 1; i
++) {
13858 const char *arg
= Jim_String(argv
[i
]);
13862 /* It's a pity we can't use Jim_GetEnum here :-( */
13863 if (strcmp(arg
, "--") == 0) {
13871 if (strncmp(arg
, "-no", 3) == 0) {
13880 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
13884 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
13891 ignore_mask
|= (1 << option
);
13894 ignore_mask
&= ~(1 << option
);
13899 if (argc
< 1 || argc
> 3) {
13901 Jim_WrongNumArgs(interp
, 1, argv
,
13902 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13907 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
13911 interp
->signal_level
+= sig
;
13912 if (Jim_CheckSignal(interp
)) {
13913 /* If a signal is set, don't even try to execute the body */
13914 exitCode
= JIM_SIGNAL
;
13917 exitCode
= Jim_EvalObj(interp
, argv
[0]);
13918 /* Don't want any caught error included in a later stack trace */
13919 interp
->errorFlag
= 0;
13921 interp
->signal_level
-= sig
;
13923 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13924 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
13925 /* Not caught, pass it up */
13929 if (sig
&& exitCode
== JIM_SIGNAL
) {
13930 /* Catch the signal at this level */
13931 if (interp
->signal_set_result
) {
13932 interp
->signal_set_result(interp
, interp
->sigmask
);
13935 Jim_SetResultInt(interp
, interp
->sigmask
);
13937 interp
->sigmask
= 0;
13941 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
13945 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
13947 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
13948 Jim_ListAppendElement(interp
, optListObj
,
13949 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
13950 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
13951 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
13952 if (exitCode
== JIM_ERR
) {
13953 Jim_Obj
*errorCode
;
13954 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
13956 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
13958 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
13960 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
13961 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
13964 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
13969 Jim_SetResultInt(interp
, exitCode
);
13973 #ifdef JIM_REFERENCES
13976 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13978 if (argc
!= 3 && argc
!= 4) {
13979 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
13983 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
13986 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
13992 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13994 Jim_Reference
*refPtr
;
13997 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14000 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14002 Jim_SetResult(interp
, refPtr
->objPtr
);
14007 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14009 Jim_Reference
*refPtr
;
14012 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14015 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14017 Jim_IncrRefCount(argv
[2]);
14018 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14019 refPtr
->objPtr
= argv
[2];
14020 Jim_SetResult(interp
, argv
[2]);
14025 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14028 Jim_WrongNumArgs(interp
, 1, argv
, "");
14031 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14033 /* Free all the freed objects. */
14034 while (interp
->freeList
) {
14035 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14036 Jim_Free(interp
->freeList
);
14037 interp
->freeList
= nextObjPtr
;
14043 /* [finalize] reference ?newValue? */
14044 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14046 if (argc
!= 2 && argc
!= 3) {
14047 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14051 Jim_Obj
*cmdNamePtr
;
14053 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14055 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14056 Jim_SetResult(interp
, cmdNamePtr
);
14059 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14061 Jim_SetResult(interp
, argv
[2]);
14066 /* [info references] */
14067 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14069 Jim_Obj
*listObjPtr
;
14070 Jim_HashTableIterator htiter
;
14073 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14075 JimInitHashTableIterator(&interp
->references
, &htiter
);
14076 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14077 char buf
[JIM_REFERENCE_SPACE
+ 1];
14078 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14079 const unsigned long *refId
= he
->key
;
14081 JimFormatReference(buf
, refPtr
, *refId
);
14082 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14084 Jim_SetResult(interp
, listObjPtr
);
14090 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14093 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14097 if (JimValidName(interp
, "new procedure", argv
[2])) {
14101 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14104 #define JIM_DICTMATCH_VALUES 0x0001
14106 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14108 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14110 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14111 if (type
& JIM_DICTMATCH_VALUES
) {
14112 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14117 * Like JimHashtablePatternMatch, but for dictionaries.
14119 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14120 JimDictMatchCallbackType
*callback
, int type
)
14123 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14125 /* Check for the non-pattern case. We can do this much more efficiently. */
14126 Jim_HashTableIterator htiter
;
14127 JimInitHashTableIterator(ht
, &htiter
);
14128 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14129 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14130 callback(interp
, listObjPtr
, he
, type
);
14138 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14140 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14143 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14147 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14149 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14152 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14156 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14158 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14161 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14164 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14169 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14173 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14175 /* Note that this uses internal knowledge of the hash table */
14176 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14178 for (i
= 0; i
< ht
->size
; i
++) {
14179 Jim_HashEntry
*he
= ht
->table
[i
];
14185 printf(" %s", Jim_String(he
->key
));
14194 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14196 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14198 Jim_AppendString(interp
, prefixObj
, " ", 1);
14199 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14201 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14205 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14209 static const char * const options
[] = {
14210 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14211 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14212 "replace", "update", NULL
14216 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14217 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14218 OPT_REPLACE
, OPT_UPDATE
,
14222 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14226 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14233 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14236 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14237 JIM_ERRMSG
) != JIM_OK
) {
14240 Jim_SetResult(interp
, objPtr
);
14245 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14248 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14252 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14256 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14260 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14266 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14269 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14275 if (argc
!= 3 && argc
!= 4) {
14276 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14279 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14283 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14286 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14289 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14296 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14299 /* Handle as ensemble */
14303 if (argc
< 6 || argc
% 2) {
14304 /* Better error message */
14311 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14314 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14315 Jim_SetResult(interp
, objPtr
);
14320 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14323 return Jim_DictInfo(interp
, argv
[2]);
14325 /* Handle command as an ensemble */
14326 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14330 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14332 static const char * const options
[] = {
14333 "-nobackslashes", "-nocommands", "-novariables", NULL
14336 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14338 int flags
= JIM_SUBST_FLAG
;
14342 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14345 for (i
= 1; i
< (argc
- 1); i
++) {
14348 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14349 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14353 case OPT_NOBACKSLASHES
:
14354 flags
|= JIM_SUBST_NOESC
;
14356 case OPT_NOCOMMANDS
:
14357 flags
|= JIM_SUBST_NOCMD
;
14359 case OPT_NOVARIABLES
:
14360 flags
|= JIM_SUBST_NOVAR
;
14364 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14367 Jim_SetResult(interp
, objPtr
);
14372 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14378 static const char * const commands
[] = {
14379 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14380 "vars", "version", "patchlevel", "complete", "args", "hostname",
14381 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14382 "references", "alias", NULL
14385 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14386 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14387 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14388 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14391 #ifdef jim_ext_namespace
14394 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14395 /* This is for internal use only */
14403 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14406 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14411 /* Test for the the most common commands first, just in case it makes a difference */
14415 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14418 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14425 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14428 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14431 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14432 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14435 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14439 case INFO_CHANNELS
:
14440 mode
++; /* JIM_CMDLIST_CHANNELS */
14441 #ifndef jim_ext_aio
14442 Jim_SetResultString(interp
, "aio not enabled", -1);
14447 mode
++; /* JIM_CMDLIST_PROCS */
14449 case INFO_COMMANDS
:
14450 /* mode 0 => JIM_CMDLIST_COMMANDS */
14451 if (argc
!= 2 && argc
!= 3) {
14452 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14455 #ifdef jim_ext_namespace
14457 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14458 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14462 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14466 mode
++; /* JIM_VARLIST_VARS */
14469 mode
++; /* JIM_VARLIST_LOCALS */
14472 /* mode 0 => JIM_VARLIST_GLOBALS */
14473 if (argc
!= 2 && argc
!= 3) {
14474 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14477 #ifdef jim_ext_namespace
14479 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14480 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14484 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14489 Jim_WrongNumArgs(interp
, 2, argv
, "");
14492 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14497 Jim_Obj
*resObjPtr
;
14498 Jim_Obj
*fileNameObj
;
14500 if (argc
!= 3 && argc
!= 5) {
14501 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14505 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14508 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14509 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14512 if (argv
[2]->typePtr
== &sourceObjType
) {
14513 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14514 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14516 else if (argv
[2]->typePtr
== &scriptObjType
) {
14517 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14518 fileNameObj
= script
->fileNameObj
;
14519 line
= script
->firstline
;
14522 fileNameObj
= interp
->emptyObj
;
14525 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14526 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14527 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14529 Jim_SetResult(interp
, resObjPtr
);
14533 case INFO_STACKTRACE
:
14534 Jim_SetResult(interp
, interp
->stackTrace
);
14541 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14545 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14548 Jim_SetResult(interp
, objPtr
);
14552 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14563 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14566 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14569 if (!cmdPtr
->isproc
) {
14570 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14575 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14578 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14581 if (cmdPtr
->u
.proc
.staticVars
) {
14582 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14583 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14584 NULL
, JimVariablesMatch
, mode
));
14592 case INFO_PATCHLEVEL
:{
14593 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14595 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14596 Jim_SetResultString(interp
, buf
, -1);
14600 case INFO_COMPLETE
:
14601 if (argc
!= 3 && argc
!= 4) {
14602 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14607 const char *s
= Jim_GetString(argv
[2], &len
);
14610 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
14611 if (missing
!= ' ' && argc
== 4) {
14612 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14617 case INFO_HOSTNAME
:
14618 /* Redirect to os.gethostname if it exists */
14619 return Jim_Eval(interp
, "os.gethostname");
14621 case INFO_NAMEOFEXECUTABLE
:
14622 /* Redirect to Tcl proc */
14623 return Jim_Eval(interp
, "{info nameofexecutable}");
14625 case INFO_RETURNCODES
:
14628 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14630 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14631 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14632 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14633 jimReturnCodes
[i
], -1));
14636 Jim_SetResult(interp
, listObjPtr
);
14638 else if (argc
== 3) {
14642 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14645 name
= Jim_ReturnCode(code
);
14646 if (*name
== '?') {
14647 Jim_SetResultInt(interp
, code
);
14650 Jim_SetResultString(interp
, name
, -1);
14654 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14658 case INFO_REFERENCES
:
14659 #ifdef JIM_REFERENCES
14660 return JimInfoReferences(interp
, argc
, argv
);
14662 Jim_SetResultString(interp
, "not supported", -1);
14670 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14675 static const char * const options
[] = {
14676 "-command", "-proc", "-alias", "-var", NULL
14680 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14688 else if (argc
== 3) {
14689 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14695 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14699 if (option
== OPT_VAR
) {
14700 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14703 /* Now different kinds of commands */
14704 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14713 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14717 result
= cmd
->isproc
;
14722 Jim_SetResultBool(interp
, result
);
14727 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14729 const char *str
, *splitChars
, *noMatchStart
;
14730 int splitLen
, strLen
;
14731 Jim_Obj
*resObjPtr
;
14735 if (argc
!= 2 && argc
!= 3) {
14736 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14740 str
= Jim_GetString(argv
[1], &len
);
14744 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14748 splitChars
= " \n\t\r";
14752 splitChars
= Jim_String(argv
[2]);
14753 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14756 noMatchStart
= str
;
14757 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14763 const char *sc
= splitChars
;
14764 int scLen
= splitLen
;
14765 int sl
= utf8_tounicode(str
, &c
);
14768 sc
+= utf8_tounicode(sc
, &pc
);
14770 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14771 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14772 noMatchStart
= str
+ sl
;
14778 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14779 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14782 /* This handles the special case of splitchars eq {}
14783 * Optimise by sharing common (ASCII) characters
14785 Jim_Obj
**commonObj
= NULL
;
14786 #define NUM_COMMON (128 - 9)
14788 int n
= utf8_tounicode(str
, &c
);
14789 #ifdef JIM_OPTIMIZATION
14790 if (c
>= 9 && c
< 128) {
14791 /* Common ASCII char. Note that 9 is the tab character */
14794 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14795 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14797 if (!commonObj
[c
]) {
14798 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14800 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14805 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14808 Jim_Free(commonObj
);
14811 Jim_SetResult(interp
, resObjPtr
);
14816 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14818 const char *joinStr
;
14821 if (argc
!= 2 && argc
!= 3) {
14822 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14831 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14833 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14838 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14843 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
14846 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
14847 if (objPtr
== NULL
)
14849 Jim_SetResult(interp
, objPtr
);
14854 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14856 Jim_Obj
*listPtr
, **outVec
;
14860 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
14863 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
14864 SetScanFmtFromAny(interp
, argv
[2]);
14865 if (FormatGetError(argv
[2]) != 0) {
14866 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
14870 int maxPos
= FormatGetMaxPos(argv
[2]);
14871 int count
= FormatGetCnvCount(argv
[2]);
14873 if (maxPos
> argc
- 3) {
14874 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
14877 else if (count
> argc
- 3) {
14878 Jim_SetResultString(interp
, "different numbers of variable names and "
14879 "field specifiers", -1);
14882 else if (count
< argc
- 3) {
14883 Jim_SetResultString(interp
, "variable is not assigned by any "
14884 "conversion specifiers", -1);
14888 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
14895 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
14896 int len
= Jim_ListLength(interp
, listPtr
);
14899 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
14900 for (i
= 0; i
< outc
; ++i
) {
14901 if (Jim_Length(outVec
[i
]) > 0) {
14903 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
14909 Jim_FreeNewObj(interp
, listPtr
);
14914 if (rc
== JIM_OK
) {
14915 Jim_SetResultInt(interp
, count
);
14920 if (listPtr
== (Jim_Obj
*)EOF
) {
14921 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
14924 Jim_SetResult(interp
, listPtr
);
14930 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14932 if (argc
!= 2 && argc
!= 3) {
14933 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
14936 Jim_SetResult(interp
, argv
[1]);
14938 JimSetStackTrace(interp
, argv
[2]);
14941 interp
->addStackTrace
++;
14946 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14951 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
14954 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
14956 Jim_SetResult(interp
, objPtr
);
14961 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14966 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
14967 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
14971 if (count
== 0 || argc
== 2) {
14978 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
14980 ListInsertElements(objPtr
, -1, argc
, argv
);
14983 Jim_SetResult(interp
, objPtr
);
14987 char **Jim_GetEnviron(void)
14989 #if defined(HAVE__NSGETENVIRON)
14990 return *_NSGetEnviron();
14992 #if !defined(NO_ENVIRON_EXTERN)
14993 extern char **environ
;
15000 void Jim_SetEnviron(char **env
)
15002 #if defined(HAVE__NSGETENVIRON)
15003 *_NSGetEnviron() = env
;
15005 #if !defined(NO_ENVIRON_EXTERN)
15006 extern char **environ
;
15014 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15020 char **e
= Jim_GetEnviron();
15023 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15025 for (i
= 0; e
[i
]; i
++) {
15026 const char *equals
= strchr(e
[i
], '=');
15029 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15031 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15035 Jim_SetResult(interp
, listObjPtr
);
15040 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15043 key
= Jim_String(argv
[1]);
15047 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15050 val
= Jim_String(argv
[2]);
15052 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15057 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15062 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15065 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15066 if (retval
== JIM_RETURN
)
15072 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15074 Jim_Obj
*revObjPtr
, **ele
;
15078 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15081 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15083 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15085 ListAppendElement(revObjPtr
, ele
[len
--]);
15086 Jim_SetResult(interp
, revObjPtr
);
15090 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15098 else if (step
> 0 && start
> end
)
15100 else if (step
< 0 && end
> start
)
15104 len
= -len
; /* abs(len) */
15106 step
= -step
; /* abs(step) */
15107 len
= 1 + ((len
- 1) / step
);
15108 /* We can truncate safely to INT_MAX, the range command
15109 * will always return an error for a such long range
15110 * because Tcl lists can't be so long. */
15113 return (int)((len
< 0) ? -1 : len
);
15117 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15119 jim_wide start
= 0, end
, step
= 1;
15123 if (argc
< 2 || argc
> 4) {
15124 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15128 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15132 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15133 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15135 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15138 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15139 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15142 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15143 for (i
= 0; i
< len
; i
++)
15144 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15145 Jim_SetResult(interp
, objPtr
);
15150 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15152 jim_wide min
= 0, max
= 0, len
, maxMul
;
15154 if (argc
< 1 || argc
> 3) {
15155 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15159 max
= JIM_WIDE_MAX
;
15160 } else if (argc
== 2) {
15161 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15163 } else if (argc
== 3) {
15164 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15165 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15170 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15173 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15177 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15178 if (r
< 0 || r
>= maxMul
) continue;
15179 r
= (len
== 0) ? 0 : r
%len
;
15180 Jim_SetResultInt(interp
, min
+r
);
15185 static const struct {
15187 Jim_CmdProc
*cmdProc
;
15188 } Jim_CoreCommandsTable
[] = {
15189 {"alias", Jim_AliasCoreCommand
},
15190 {"set", Jim_SetCoreCommand
},
15191 {"unset", Jim_UnsetCoreCommand
},
15192 {"puts", Jim_PutsCoreCommand
},
15193 {"+", Jim_AddCoreCommand
},
15194 {"*", Jim_MulCoreCommand
},
15195 {"-", Jim_SubCoreCommand
},
15196 {"/", Jim_DivCoreCommand
},
15197 {"incr", Jim_IncrCoreCommand
},
15198 {"while", Jim_WhileCoreCommand
},
15199 {"loop", Jim_LoopCoreCommand
},
15200 {"for", Jim_ForCoreCommand
},
15201 {"foreach", Jim_ForeachCoreCommand
},
15202 {"lmap", Jim_LmapCoreCommand
},
15203 {"lassign", Jim_LassignCoreCommand
},
15204 {"if", Jim_IfCoreCommand
},
15205 {"switch", Jim_SwitchCoreCommand
},
15206 {"list", Jim_ListCoreCommand
},
15207 {"lindex", Jim_LindexCoreCommand
},
15208 {"lset", Jim_LsetCoreCommand
},
15209 {"lsearch", Jim_LsearchCoreCommand
},
15210 {"llength", Jim_LlengthCoreCommand
},
15211 {"lappend", Jim_LappendCoreCommand
},
15212 {"linsert", Jim_LinsertCoreCommand
},
15213 {"lreplace", Jim_LreplaceCoreCommand
},
15214 {"lsort", Jim_LsortCoreCommand
},
15215 {"append", Jim_AppendCoreCommand
},
15216 {"debug", Jim_DebugCoreCommand
},
15217 {"eval", Jim_EvalCoreCommand
},
15218 {"uplevel", Jim_UplevelCoreCommand
},
15219 {"expr", Jim_ExprCoreCommand
},
15220 {"break", Jim_BreakCoreCommand
},
15221 {"continue", Jim_ContinueCoreCommand
},
15222 {"proc", Jim_ProcCoreCommand
},
15223 {"concat", Jim_ConcatCoreCommand
},
15224 {"return", Jim_ReturnCoreCommand
},
15225 {"upvar", Jim_UpvarCoreCommand
},
15226 {"global", Jim_GlobalCoreCommand
},
15227 {"string", Jim_StringCoreCommand
},
15228 {"time", Jim_TimeCoreCommand
},
15229 {"exit", Jim_ExitCoreCommand
},
15230 {"catch", Jim_CatchCoreCommand
},
15231 #ifdef JIM_REFERENCES
15232 {"ref", Jim_RefCoreCommand
},
15233 {"getref", Jim_GetrefCoreCommand
},
15234 {"setref", Jim_SetrefCoreCommand
},
15235 {"finalize", Jim_FinalizeCoreCommand
},
15236 {"collect", Jim_CollectCoreCommand
},
15238 {"rename", Jim_RenameCoreCommand
},
15239 {"dict", Jim_DictCoreCommand
},
15240 {"subst", Jim_SubstCoreCommand
},
15241 {"info", Jim_InfoCoreCommand
},
15242 {"exists", Jim_ExistsCoreCommand
},
15243 {"split", Jim_SplitCoreCommand
},
15244 {"join", Jim_JoinCoreCommand
},
15245 {"format", Jim_FormatCoreCommand
},
15246 {"scan", Jim_ScanCoreCommand
},
15247 {"error", Jim_ErrorCoreCommand
},
15248 {"lrange", Jim_LrangeCoreCommand
},
15249 {"lrepeat", Jim_LrepeatCoreCommand
},
15250 {"env", Jim_EnvCoreCommand
},
15251 {"source", Jim_SourceCoreCommand
},
15252 {"lreverse", Jim_LreverseCoreCommand
},
15253 {"range", Jim_RangeCoreCommand
},
15254 {"rand", Jim_RandCoreCommand
},
15255 {"tailcall", Jim_TailcallCoreCommand
},
15256 {"local", Jim_LocalCoreCommand
},
15257 {"upcall", Jim_UpcallCoreCommand
},
15258 {"apply", Jim_ApplyCoreCommand
},
15262 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15266 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15267 Jim_CreateCommand(interp
,
15268 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15273 /* -----------------------------------------------------------------------------
15274 * Interactive prompt
15275 * ---------------------------------------------------------------------------*/
15276 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15280 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15281 argv
[1] = interp
->result
;
15283 Jim_EvalObjVector(interp
, 2, argv
);
15286 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15287 const char *prefix
, const char *const *tablePtr
, const char *name
)
15290 char **tablePtrSorted
;
15293 for (count
= 0; tablePtr
[count
]; count
++) {
15296 if (name
== NULL
) {
15300 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15301 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15302 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15303 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15304 for (i
= 0; i
< count
; i
++) {
15305 if (i
+ 1 == count
&& count
> 1) {
15306 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15308 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15309 if (i
+ 1 != count
) {
15310 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15313 Jim_Free(tablePtrSorted
);
15316 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15317 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15319 const char *bad
= "bad ";
15320 const char *const *entryPtr
= NULL
;
15324 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15328 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15329 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15330 /* Found an exact match */
15334 if (flags
& JIM_ENUM_ABBREV
) {
15335 /* Accept an unambiguous abbreviation.
15336 * Note that '-' doesnt' consitute a valid abbreviation
15338 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15339 if (*arg
== '-' && arglen
== 1) {
15343 bad
= "ambiguous ";
15351 /* If we had an unambiguous partial match */
15358 if (flags
& JIM_ERRMSG
) {
15359 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15364 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15368 for (i
= 0; i
< (int)len
; i
++) {
15369 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15376 int Jim_IsDict(Jim_Obj
*objPtr
)
15378 return objPtr
->typePtr
== &dictObjType
;
15381 int Jim_IsList(Jim_Obj
*objPtr
)
15383 return objPtr
->typePtr
== &listObjType
;
15387 * Very simple printf-like formatting, designed for error messages.
15389 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15390 * The resulting string is created and set as the result.
15392 * Each '%s' should correspond to a regular string parameter.
15393 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15394 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15396 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15398 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15400 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15402 /* Initial space needed */
15403 int len
= strlen(format
);
15406 const char *params
[5];
15411 va_start(args
, format
);
15413 for (i
= 0; i
< len
&& n
< 5; i
++) {
15416 if (strncmp(format
+ i
, "%s", 2) == 0) {
15417 params
[n
] = va_arg(args
, char *);
15419 l
= strlen(params
[n
]);
15421 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15422 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15424 params
[n
] = Jim_GetString(objPtr
, &l
);
15427 if (format
[i
] == '%') {
15437 buf
= Jim_Alloc(len
+ 1);
15438 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15442 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15446 #ifndef jim_ext_package
15447 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15452 #ifndef jim_ext_aio
15453 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15455 Jim_SetResultString(interp
, "aio not enabled", -1);
15462 * Local Variables: ***
15463 * c-basic-offset: 4 ***