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
1146 #define JIM_TT_EXPR_BOOLEAN 16
1148 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1150 /* Operator token types start here */
1151 #define JIM_TT_EXPR_OP 20
1153 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1156 * Results of missing quotes, braces, etc. from parsing.
1158 struct JimParseMissing
{
1159 int ch
; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1160 int line
; /* Line number starting the missing token */
1163 /* Parser context structure. The same context is used both to parse
1164 * Tcl scripts and lists. */
1167 const char *p
; /* Pointer to the point of the program we are parsing */
1168 int len
; /* Remaining length */
1169 int linenr
; /* Current line number */
1171 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1172 int tline
; /* Line number of the returned token */
1173 int tt
; /* Token type */
1174 int eof
; /* Non zero if EOF condition is true. */
1175 int inquote
; /* Parsing a quoted string */
1176 int comment
; /* Non zero if the next chars may be a comment. */
1177 struct JimParseMissing missing
; /* Details of any missing quotes, etc. */
1180 static int JimParseScript(struct JimParserCtx
*pc
);
1181 static int JimParseSep(struct JimParserCtx
*pc
);
1182 static int JimParseEol(struct JimParserCtx
*pc
);
1183 static int JimParseCmd(struct JimParserCtx
*pc
);
1184 static int JimParseQuote(struct JimParserCtx
*pc
);
1185 static int JimParseVar(struct JimParserCtx
*pc
);
1186 static int JimParseBrace(struct JimParserCtx
*pc
);
1187 static int JimParseStr(struct JimParserCtx
*pc
);
1188 static int JimParseComment(struct JimParserCtx
*pc
);
1189 static void JimParseSubCmd(struct JimParserCtx
*pc
);
1190 static int JimParseSubQuote(struct JimParserCtx
*pc
);
1191 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
1193 /* Initialize a parser context.
1194 * 'prg' is a pointer to the program text, linenr is the line
1195 * number of the first line contained in the program. */
1196 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1203 pc
->tt
= JIM_TT_NONE
;
1206 pc
->linenr
= linenr
;
1208 pc
->missing
.ch
= ' ';
1209 pc
->missing
.line
= linenr
;
1212 static int JimParseScript(struct JimParserCtx
*pc
)
1214 while (1) { /* the while is used to reiterate with continue if needed */
1217 pc
->tend
= pc
->p
- 1;
1218 pc
->tline
= pc
->linenr
;
1219 pc
->tt
= JIM_TT_EOL
;
1225 if (*(pc
->p
+ 1) == '\n' && !pc
->inquote
) {
1226 return JimParseSep(pc
);
1229 return JimParseStr(pc
);
1235 return JimParseSep(pc
);
1237 return JimParseStr(pc
);
1242 return JimParseEol(pc
);
1243 return JimParseStr(pc
);
1246 return JimParseCmd(pc
);
1249 if (JimParseVar(pc
) == JIM_ERR
) {
1250 /* An orphan $. Create as a separate token */
1251 pc
->tstart
= pc
->tend
= pc
->p
++;
1253 pc
->tt
= JIM_TT_ESC
;
1258 JimParseComment(pc
);
1261 return JimParseStr(pc
);
1264 return JimParseStr(pc
);
1270 static int JimParseSep(struct JimParserCtx
*pc
)
1273 pc
->tline
= pc
->linenr
;
1274 while (isspace(UCHAR(*pc
->p
)) || (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1275 if (*pc
->p
== '\n') {
1278 if (*pc
->p
== '\\') {
1286 pc
->tend
= pc
->p
- 1;
1287 pc
->tt
= JIM_TT_SEP
;
1291 static int JimParseEol(struct JimParserCtx
*pc
)
1294 pc
->tline
= pc
->linenr
;
1295 while (isspace(UCHAR(*pc
->p
)) || *pc
->p
== ';') {
1301 pc
->tend
= pc
->p
- 1;
1302 pc
->tt
= JIM_TT_EOL
;
1307 ** Here are the rules for parsing:
1308 ** {braced expression}
1309 ** - Count open and closing braces
1310 ** - Backslash escapes meaning of braces
1312 ** "quoted expression"
1313 ** - First double quote at start of word terminates the expression
1314 ** - Backslash escapes quote and bracket
1315 ** - [commands brackets] are counted/nested
1316 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1318 ** [command expression]
1319 ** - Count open and closing brackets
1320 ** - Backslash escapes quote, bracket and brace
1321 ** - [commands brackets] are counted/nested
1322 ** - "quoted expressions" are parsed according to quoting rules
1323 ** - {braced expressions} are parsed according to brace rules
1325 ** For everything, backslash escapes the next char, newline increments current line
1329 * Parses a braced expression starting at pc->p.
1331 * Positions the parser at the end of the braced expression,
1332 * sets pc->tend and possibly pc->missing.
1334 static void JimParseSubBrace(struct JimParserCtx
*pc
)
1338 /* Skip the brace */
1345 if (*++pc
->p
== '\n') {
1358 pc
->tend
= pc
->p
- 1;
1372 pc
->missing
.ch
= '{';
1373 pc
->missing
.line
= pc
->tline
;
1374 pc
->tend
= pc
->p
- 1;
1378 * Parses a quoted expression starting at pc->p.
1380 * Positions the parser at the end of the quoted expression,
1381 * sets pc->tend and possibly pc->missing.
1383 * Returns the type of the token of the string,
1384 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1387 static int JimParseSubQuote(struct JimParserCtx
*pc
)
1389 int tt
= JIM_TT_STR
;
1390 int line
= pc
->tline
;
1392 /* Skip the quote */
1399 if (*++pc
->p
== '\n') {
1408 pc
->tend
= pc
->p
- 1;
1429 pc
->missing
.ch
= '"';
1430 pc
->missing
.line
= line
;
1431 pc
->tend
= pc
->p
- 1;
1436 * Parses a [command] expression starting at pc->p.
1438 * Positions the parser at the end of the command expression,
1439 * sets pc->tend and possibly pc->missing.
1441 static void JimParseSubCmd(struct JimParserCtx
*pc
)
1444 int startofword
= 1;
1445 int line
= pc
->tline
;
1447 /* Skip the bracket */
1454 if (*++pc
->p
== '\n') {
1467 pc
->tend
= pc
->p
- 1;
1476 JimParseSubQuote(pc
);
1482 JimParseSubBrace(pc
);
1490 startofword
= isspace(UCHAR(*pc
->p
));
1494 pc
->missing
.ch
= '[';
1495 pc
->missing
.line
= line
;
1496 pc
->tend
= pc
->p
- 1;
1499 static int JimParseBrace(struct JimParserCtx
*pc
)
1501 pc
->tstart
= pc
->p
+ 1;
1502 pc
->tline
= pc
->linenr
;
1503 pc
->tt
= JIM_TT_STR
;
1504 JimParseSubBrace(pc
);
1508 static int JimParseCmd(struct JimParserCtx
*pc
)
1510 pc
->tstart
= pc
->p
+ 1;
1511 pc
->tline
= pc
->linenr
;
1512 pc
->tt
= JIM_TT_CMD
;
1517 static int JimParseQuote(struct JimParserCtx
*pc
)
1519 pc
->tstart
= pc
->p
+ 1;
1520 pc
->tline
= pc
->linenr
;
1521 pc
->tt
= JimParseSubQuote(pc
);
1525 static int JimParseVar(struct JimParserCtx
*pc
)
1531 #ifdef EXPRSUGAR_BRACKET
1532 if (*pc
->p
== '[') {
1533 /* Parse $[...] expr shorthand syntax */
1535 pc
->tt
= JIM_TT_EXPRSUGAR
;
1541 pc
->tt
= JIM_TT_VAR
;
1542 pc
->tline
= pc
->linenr
;
1544 if (*pc
->p
== '{') {
1545 pc
->tstart
= ++pc
->p
;
1548 while (pc
->len
&& *pc
->p
!= '}') {
1549 if (*pc
->p
== '\n') {
1555 pc
->tend
= pc
->p
- 1;
1563 /* Skip double colon, but not single colon! */
1564 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
1565 while (*pc
->p
== ':') {
1571 /* Note that any char >= 0x80 must be part of a utf-8 char.
1572 * We consider all unicode points outside of ASCII as letters
1574 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_' || UCHAR(*pc
->p
) >= 0x80) {
1581 /* Parse [dict get] syntax sugar. */
1582 if (*pc
->p
== '(') {
1584 const char *paren
= NULL
;
1586 pc
->tt
= JIM_TT_DICTSUGAR
;
1588 while (count
&& pc
->len
) {
1591 if (*pc
->p
== '\\' && pc
->len
>= 1) {
1595 else if (*pc
->p
== '(') {
1598 else if (*pc
->p
== ')') {
1608 /* Did not find a matching paren. Back up */
1610 pc
->len
+= (pc
->p
- paren
);
1613 #ifndef EXPRSUGAR_BRACKET
1614 if (*pc
->tstart
== '(') {
1615 pc
->tt
= JIM_TT_EXPRSUGAR
;
1619 pc
->tend
= pc
->p
- 1;
1621 /* Check if we parsed just the '$' character.
1622 * That's not a variable so an error is returned
1623 * to tell the state machine to consider this '$' just
1625 if (pc
->tstart
== pc
->p
) {
1633 static int JimParseStr(struct JimParserCtx
*pc
)
1635 if (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1636 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
) {
1637 /* Starting a new word */
1638 if (*pc
->p
== '{') {
1639 return JimParseBrace(pc
);
1641 if (*pc
->p
== '"') {
1645 /* In case the end quote is missing */
1646 pc
->missing
.line
= pc
->tline
;
1650 pc
->tline
= pc
->linenr
;
1654 pc
->missing
.ch
= '"';
1656 pc
->tend
= pc
->p
- 1;
1657 pc
->tt
= JIM_TT_ESC
;
1662 if (!pc
->inquote
&& *(pc
->p
+ 1) == '\n') {
1663 pc
->tend
= pc
->p
- 1;
1664 pc
->tt
= JIM_TT_ESC
;
1668 if (*(pc
->p
+ 1) == '\n') {
1674 else if (pc
->len
== 1) {
1675 /* End of script with trailing backslash */
1676 pc
->missing
.ch
= '\\';
1680 /* If the following token is not '$' just keep going */
1681 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1686 /* Only need a separate ')' token if the previous was a var */
1687 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1688 if (pc
->p
== pc
->tstart
) {
1689 /* At the start of the token, so just return this char */
1693 pc
->tend
= pc
->p
- 1;
1694 pc
->tt
= JIM_TT_ESC
;
1701 pc
->tend
= pc
->p
- 1;
1702 pc
->tt
= JIM_TT_ESC
;
1711 pc
->tend
= pc
->p
- 1;
1712 pc
->tt
= JIM_TT_ESC
;
1715 else if (*pc
->p
== '\n') {
1721 pc
->tend
= pc
->p
- 1;
1722 pc
->tt
= JIM_TT_ESC
;
1733 return JIM_OK
; /* unreached */
1736 static int JimParseComment(struct JimParserCtx
*pc
)
1739 if (*pc
->p
== '\\') {
1743 pc
->missing
.ch
= '\\';
1746 if (*pc
->p
== '\n') {
1750 else if (*pc
->p
== '\n') {
1762 /* xdigitval and odigitval are helper functions for JimEscape() */
1763 static int xdigitval(int c
)
1765 if (c
>= '0' && c
<= '9')
1767 if (c
>= 'a' && c
<= 'f')
1768 return c
- 'a' + 10;
1769 if (c
>= 'A' && c
<= 'F')
1770 return c
- 'A' + 10;
1774 static int odigitval(int c
)
1776 if (c
>= '0' && c
<= '7')
1781 /* Perform Tcl escape substitution of 's', storing the result
1782 * string into 'dest'. The escaped string is guaranteed to
1783 * be the same length or shorted than the source string.
1784 * Slen is the length of the string at 's'.
1786 * The function returns the length of the resulting string. */
1787 static int JimEscape(char *dest
, const char *s
, int slen
)
1792 for (i
= 0; i
< slen
; i
++) {
1823 /* A unicode or hex sequence.
1824 * \x Expect 1-2 hex chars and convert to hex.
1825 * \u Expect 1-4 hex chars and convert to utf-8.
1826 * \U Expect 1-8 hex chars and convert to utf-8.
1827 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1828 * An invalid sequence means simply the escaped char.
1840 else if (s
[i
] == 'u') {
1841 if (s
[i
+ 1] == '{') {
1850 for (k
= 0; k
< maxchars
; k
++) {
1851 int c
= xdigitval(s
[i
+ k
+ 1]);
1855 val
= (val
<< 4) | c
;
1857 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1859 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1865 /* Skip the closing brace */
1870 /* Got a valid sequence, so convert */
1875 p
+= utf8_fromunicode(p
, val
);
1880 /* Not a valid codepoint, just an escaped char */
1893 /* Replace all spaces and tabs after backslash newline with a single space*/
1897 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1910 int c
= odigitval(s
[i
+ 1]);
1913 c
= odigitval(s
[i
+ 2]);
1919 val
= (val
* 8) + c
;
1920 c
= odigitval(s
[i
+ 3]);
1926 val
= (val
* 8) + c
;
1947 /* Returns a dynamically allocated copy of the current token in the
1948 * parser context. The function performs conversion of escapes if
1949 * the token is of type JIM_TT_ESC.
1951 * Note that after the conversion, tokens that are grouped with
1952 * braces in the source code, are always recognizable from the
1953 * identical string obtained in a different way from the type.
1955 * For example the string:
1959 * will return as first token "*", of type JIM_TT_STR
1965 * will return as first token "*", of type JIM_TT_ESC
1967 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
1969 const char *start
, *end
;
1977 token
= Jim_Alloc(1);
1981 len
= (end
- start
) + 1;
1982 token
= Jim_Alloc(len
+ 1);
1983 if (pc
->tt
!= JIM_TT_ESC
) {
1984 /* No escape conversion needed? Just copy it. */
1985 memcpy(token
, start
, len
);
1989 /* Else convert the escape chars. */
1990 len
= JimEscape(token
, start
, len
);
1994 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
1997 /* -----------------------------------------------------------------------------
1999 * ---------------------------------------------------------------------------*/
2000 static int JimParseListSep(struct JimParserCtx
*pc
);
2001 static int JimParseListStr(struct JimParserCtx
*pc
);
2002 static int JimParseListQuote(struct JimParserCtx
*pc
);
2004 static int JimParseList(struct JimParserCtx
*pc
)
2006 if (isspace(UCHAR(*pc
->p
))) {
2007 return JimParseListSep(pc
);
2011 return JimParseListQuote(pc
);
2014 return JimParseBrace(pc
);
2018 return JimParseListStr(pc
);
2023 pc
->tstart
= pc
->tend
= pc
->p
;
2024 pc
->tline
= pc
->linenr
;
2025 pc
->tt
= JIM_TT_EOL
;
2030 static int JimParseListSep(struct JimParserCtx
*pc
)
2033 pc
->tline
= pc
->linenr
;
2034 while (isspace(UCHAR(*pc
->p
))) {
2035 if (*pc
->p
== '\n') {
2041 pc
->tend
= pc
->p
- 1;
2042 pc
->tt
= JIM_TT_SEP
;
2046 static int JimParseListQuote(struct JimParserCtx
*pc
)
2052 pc
->tline
= pc
->linenr
;
2053 pc
->tt
= JIM_TT_STR
;
2058 pc
->tt
= JIM_TT_ESC
;
2059 if (--pc
->len
== 0) {
2060 /* Trailing backslash */
2070 pc
->tend
= pc
->p
- 1;
2079 pc
->tend
= pc
->p
- 1;
2083 static int JimParseListStr(struct JimParserCtx
*pc
)
2086 pc
->tline
= pc
->linenr
;
2087 pc
->tt
= JIM_TT_STR
;
2090 if (isspace(UCHAR(*pc
->p
))) {
2091 pc
->tend
= pc
->p
- 1;
2094 if (*pc
->p
== '\\') {
2095 if (--pc
->len
== 0) {
2096 /* Trailing backslash */
2100 pc
->tt
= JIM_TT_ESC
;
2106 pc
->tend
= pc
->p
- 1;
2110 /* -----------------------------------------------------------------------------
2111 * Jim_Obj related functions
2112 * ---------------------------------------------------------------------------*/
2114 /* Return a new initialized object. */
2115 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2119 /* -- Check if there are objects in the free list -- */
2120 if (interp
->freeList
!= NULL
) {
2121 /* -- Unlink the object from the free list -- */
2122 objPtr
= interp
->freeList
;
2123 interp
->freeList
= objPtr
->nextObjPtr
;
2126 /* -- No ready to use objects: allocate a new one -- */
2127 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2130 /* Object is returned with refCount of 0. Every
2131 * kind of GC implemented should take care to don't try
2132 * to scan objects with refCount == 0. */
2133 objPtr
->refCount
= 0;
2134 /* All the other fields are left not initialized to save time.
2135 * The caller will probably want to set them to the right
2138 /* -- Put the object into the live list -- */
2139 objPtr
->prevObjPtr
= NULL
;
2140 objPtr
->nextObjPtr
= interp
->liveList
;
2141 if (interp
->liveList
)
2142 interp
->liveList
->prevObjPtr
= objPtr
;
2143 interp
->liveList
= objPtr
;
2148 /* Free an object. Actually objects are never freed, but
2149 * just moved to the free objects list, where they will be
2150 * reused by Jim_NewObj(). */
2151 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2153 /* Check if the object was already freed, panic. */
2154 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2155 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2157 /* Free the internal representation */
2158 Jim_FreeIntRep(interp
, objPtr
);
2159 /* Free the string representation */
2160 if (objPtr
->bytes
!= NULL
) {
2161 if (objPtr
->bytes
!= JimEmptyStringRep
)
2162 Jim_Free(objPtr
->bytes
);
2164 /* Unlink the object from the live objects list */
2165 if (objPtr
->prevObjPtr
)
2166 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2167 if (objPtr
->nextObjPtr
)
2168 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2169 if (interp
->liveList
== objPtr
)
2170 interp
->liveList
= objPtr
->nextObjPtr
;
2171 #ifdef JIM_DISABLE_OBJECT_POOL
2174 /* Link the object into the free objects list */
2175 objPtr
->prevObjPtr
= NULL
;
2176 objPtr
->nextObjPtr
= interp
->freeList
;
2177 if (interp
->freeList
)
2178 interp
->freeList
->prevObjPtr
= objPtr
;
2179 interp
->freeList
= objPtr
;
2180 objPtr
->refCount
= -1;
2184 /* Invalidate the string representation of an object. */
2185 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2187 if (objPtr
->bytes
!= NULL
) {
2188 if (objPtr
->bytes
!= JimEmptyStringRep
)
2189 Jim_Free(objPtr
->bytes
);
2191 objPtr
->bytes
= NULL
;
2194 /* Duplicate an object. The returned object has refcount = 0. */
2195 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2199 dupPtr
= Jim_NewObj(interp
);
2200 if (objPtr
->bytes
== NULL
) {
2201 /* Object does not have a valid string representation. */
2202 dupPtr
->bytes
= NULL
;
2204 else if (objPtr
->length
== 0) {
2205 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2206 dupPtr
->bytes
= JimEmptyStringRep
;
2208 dupPtr
->typePtr
= NULL
;
2212 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2213 dupPtr
->length
= objPtr
->length
;
2214 /* Copy the null byte too */
2215 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2218 /* By default, the new object has the same type as the old object */
2219 dupPtr
->typePtr
= objPtr
->typePtr
;
2220 if (objPtr
->typePtr
!= NULL
) {
2221 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2222 dupPtr
->internalRep
= objPtr
->internalRep
;
2225 /* The dup proc may set a different type, e.g. NULL */
2226 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2232 /* Return the string representation for objPtr. If the object's
2233 * string representation is invalid, calls the updateStringProc method to create
2234 * a new one from the internal representation of the object.
2236 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2238 if (objPtr
->bytes
== NULL
) {
2239 /* Invalid string repr. Generate it. */
2240 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2241 objPtr
->typePtr
->updateStringProc(objPtr
);
2244 *lenPtr
= objPtr
->length
;
2245 return objPtr
->bytes
;
2248 /* Just returns the length of the object's string rep */
2249 int Jim_Length(Jim_Obj
*objPtr
)
2251 if (objPtr
->bytes
== NULL
) {
2252 /* Invalid string repr. Generate it. */
2253 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2254 objPtr
->typePtr
->updateStringProc(objPtr
);
2256 return objPtr
->length
;
2259 /* Just returns object's string rep */
2260 const char *Jim_String(Jim_Obj
*objPtr
)
2262 if (objPtr
->bytes
== NULL
) {
2263 /* Invalid string repr. Generate it. */
2264 JimPanic((objPtr
->typePtr
== NULL
, "UpdateStringProc called against typeless value."));
2265 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2266 objPtr
->typePtr
->updateStringProc(objPtr
);
2268 return objPtr
->bytes
;
2271 static void JimSetStringBytes(Jim_Obj
*objPtr
, const char *str
)
2273 objPtr
->bytes
= Jim_StrDup(str
);
2274 objPtr
->length
= strlen(str
);
2277 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2278 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2280 static const Jim_ObjType dictSubstObjType
= {
2281 "dict-substitution",
2282 FreeDictSubstInternalRep
,
2283 DupDictSubstInternalRep
,
2288 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2290 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
2293 static const Jim_ObjType interpolatedObjType
= {
2295 FreeInterpolatedInternalRep
,
2301 /* -----------------------------------------------------------------------------
2303 * ---------------------------------------------------------------------------*/
2304 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2305 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2307 static const Jim_ObjType stringObjType
= {
2310 DupStringInternalRep
,
2312 JIM_TYPE_REFERENCES
,
2315 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2317 JIM_NOTUSED(interp
);
2319 /* This is a bit subtle: the only caller of this function
2320 * should be Jim_DuplicateObj(), that will copy the
2321 * string representaion. After the copy, the duplicated
2322 * object will not have more room in the buffer than
2323 * srcPtr->length bytes. So we just set it to length. */
2324 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
2325 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
2328 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2330 if (objPtr
->typePtr
!= &stringObjType
) {
2331 /* Get a fresh string representation. */
2332 if (objPtr
->bytes
== NULL
) {
2333 /* Invalid string repr. Generate it. */
2334 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2335 objPtr
->typePtr
->updateStringProc(objPtr
);
2337 /* Free any other internal representation. */
2338 Jim_FreeIntRep(interp
, objPtr
);
2339 /* Set it as string, i.e. just set the maxLength field. */
2340 objPtr
->typePtr
= &stringObjType
;
2341 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
2342 /* Don't know the utf-8 length yet */
2343 objPtr
->internalRep
.strValue
.charLength
= -1;
2349 * Returns the length of the object string in chars, not bytes.
2351 * These may be different for a utf-8 string.
2353 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2356 SetStringFromAny(interp
, objPtr
);
2358 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
2359 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
2361 return objPtr
->internalRep
.strValue
.charLength
;
2363 return Jim_Length(objPtr
);
2367 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2368 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
2370 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2372 /* Need to find out how many bytes the string requires */
2375 /* Alloc/Set the string rep. */
2377 objPtr
->bytes
= JimEmptyStringRep
;
2380 objPtr
->bytes
= Jim_Alloc(len
+ 1);
2381 memcpy(objPtr
->bytes
, s
, len
);
2382 objPtr
->bytes
[len
] = '\0';
2384 objPtr
->length
= len
;
2386 /* No typePtr field for the vanilla string object. */
2387 objPtr
->typePtr
= NULL
;
2391 /* charlen is in characters -- see also Jim_NewStringObj() */
2392 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
2395 /* Need to find out how many bytes the string requires */
2396 int bytelen
= utf8_index(s
, charlen
);
2398 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
2400 /* Remember the utf8 length, so set the type */
2401 objPtr
->typePtr
= &stringObjType
;
2402 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
2403 objPtr
->internalRep
.strValue
.charLength
= charlen
;
2407 return Jim_NewStringObj(interp
, s
, charlen
);
2411 /* This version does not try to duplicate the 's' pointer, but
2412 * use it directly. */
2413 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2415 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2418 objPtr
->length
= (len
== -1) ? strlen(s
) : len
;
2419 objPtr
->typePtr
= NULL
;
2423 /* Low-level string append. Use it only against unshared objects
2424 * of type "string". */
2425 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2431 needlen
= objPtr
->length
+ len
;
2432 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2433 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2435 /* Inefficient to malloc() for less than 8 bytes */
2439 if (objPtr
->bytes
== JimEmptyStringRep
) {
2440 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
2443 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
2445 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
2447 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2448 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2450 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
2451 /* Update the utf-8 char length */
2452 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
2454 objPtr
->length
+= len
;
2457 /* Higher level API to append strings to objects.
2458 * Object must not be unshared for each of these.
2460 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2462 JimPanic((Jim_IsShared(objPtr
), "Jim_AppendString called with shared object"));
2463 SetStringFromAny(interp
, objPtr
);
2464 StringAppendString(objPtr
, str
, len
);
2467 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2470 const char *str
= Jim_GetString(appendObjPtr
, &len
);
2471 Jim_AppendString(interp
, objPtr
, str
, len
);
2474 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2478 SetStringFromAny(interp
, objPtr
);
2479 va_start(ap
, objPtr
);
2481 const char *s
= va_arg(ap
, const char *);
2485 Jim_AppendString(interp
, objPtr
, s
, -1);
2490 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
2492 if (aObjPtr
== bObjPtr
) {
2497 const char *sA
= Jim_GetString(aObjPtr
, &Alen
);
2498 const char *sB
= Jim_GetString(bObjPtr
, &Blen
);
2500 return Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0;
2505 * Note. Does not support embedded nulls in either the pattern or the object.
2507 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2509 return JimGlobMatch(Jim_String(patternObjPtr
), Jim_String(objPtr
), nocase
);
2513 * Note: does not support embedded nulls for the nocase option.
2515 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2518 const char *s1
= Jim_GetString(firstObjPtr
, &l1
);
2519 const char *s2
= Jim_GetString(secondObjPtr
, &l2
);
2522 /* Do a character compare for nocase */
2523 return JimStringCompareLen(s1
, s2
, -1, nocase
);
2525 return JimStringCompare(s1
, l1
, s2
, l2
);
2529 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2531 * Note: does not support embedded nulls
2533 int Jim_StringCompareLenObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2535 const char *s1
= Jim_String(firstObjPtr
);
2536 const char *s2
= Jim_String(secondObjPtr
);
2538 return JimStringCompareLen(s1
, s2
, Jim_Utf8Length(interp
, firstObjPtr
), nocase
);
2541 /* Convert a range, as returned by Jim_GetRange(), into
2542 * an absolute index into an object of the specified length.
2543 * This function may return negative values, or values
2544 * greater than or equal to the length of the list if the index
2545 * is out of range. */
2546 static int JimRelToAbsIndex(int len
, int idx
)
2553 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2554 * into a form suitable for implementation of commands like [string range] and [lrange].
2556 * The resulting range is guaranteed to address valid elements of
2559 static void JimRelToAbsRange(int len
, int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2563 if (*firstPtr
> *lastPtr
) {
2567 rangeLen
= *lastPtr
- *firstPtr
+ 1;
2569 if (*firstPtr
< 0) {
2570 rangeLen
+= *firstPtr
;
2573 if (*lastPtr
>= len
) {
2574 rangeLen
-= (*lastPtr
- (len
- 1));
2582 *rangeLenPtr
= rangeLen
;
2585 static int JimStringGetRange(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
,
2586 int len
, int *first
, int *last
, int *range
)
2588 if (Jim_GetIndex(interp
, firstObjPtr
, first
) != JIM_OK
) {
2591 if (Jim_GetIndex(interp
, lastObjPtr
, last
) != JIM_OK
) {
2594 *first
= JimRelToAbsIndex(len
, *first
);
2595 *last
= JimRelToAbsIndex(len
, *last
);
2596 JimRelToAbsRange(len
, first
, last
, range
);
2600 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
2601 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2608 str
= Jim_GetString(strObjPtr
, &bytelen
);
2610 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, bytelen
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2614 if (first
== 0 && rangeLen
== bytelen
) {
2617 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2620 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2621 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2629 str
= Jim_GetString(strObjPtr
, &bytelen
);
2630 len
= Jim_Utf8Length(interp
, strObjPtr
);
2632 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2636 if (first
== 0 && rangeLen
== len
) {
2639 if (len
== bytelen
) {
2640 /* ASCII optimisation */
2641 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2643 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
2645 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
2649 Jim_Obj
*JimStringReplaceObj(Jim_Interp
*interp
,
2650 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
, Jim_Obj
*newStrObj
)
2657 len
= Jim_Utf8Length(interp
, strObjPtr
);
2659 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2667 str
= Jim_String(strObjPtr
);
2670 objPtr
= Jim_NewStringObjUtf8(interp
, str
, first
);
2674 Jim_AppendObj(interp
, objPtr
, newStrObj
);
2678 Jim_AppendString(interp
, objPtr
, str
+ utf8_index(str
, last
+ 1), len
- last
- 1);
2684 * Note: does not support embedded nulls.
2686 static void JimStrCopyUpperLower(char *dest
, const char *str
, int uc
)
2690 str
+= utf8_tounicode(str
, &c
);
2691 dest
+= utf8_getchars(dest
, uc
? utf8_upper(c
) : utf8_lower(c
));
2697 * Note: does not support embedded nulls.
2699 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2705 SetStringFromAny(interp
, strObjPtr
);
2707 str
= Jim_GetString(strObjPtr
, &len
);
2710 /* Case mapping can change the utf-8 length of the string.
2711 * But at worst it will be by one extra byte per char
2715 buf
= Jim_Alloc(len
+ 1);
2716 JimStrCopyUpperLower(buf
, str
, 0);
2717 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2721 * Note: does not support embedded nulls.
2723 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2729 if (strObjPtr
->typePtr
!= &stringObjType
) {
2730 SetStringFromAny(interp
, strObjPtr
);
2733 str
= Jim_GetString(strObjPtr
, &len
);
2736 /* Case mapping can change the utf-8 length of the string.
2737 * But at worst it will be by one extra byte per char
2741 buf
= Jim_Alloc(len
+ 1);
2742 JimStrCopyUpperLower(buf
, str
, 1);
2743 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2747 * Note: does not support embedded nulls.
2749 static Jim_Obj
*JimStringToTitle(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2756 str
= Jim_GetString(strObjPtr
, &len
);
2761 /* Case mapping can change the utf-8 length of the string.
2762 * But at worst it will be by one extra byte per char
2766 buf
= p
= Jim_Alloc(len
+ 1);
2768 str
+= utf8_tounicode(str
, &c
);
2769 p
+= utf8_getchars(p
, utf8_title(c
));
2771 JimStrCopyUpperLower(p
, str
, 0);
2773 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2776 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2777 * for unicode character 'c'.
2778 * Returns the position if found or NULL if not
2780 static const char *utf8_memchr(const char *str
, int len
, int c
)
2785 int n
= utf8_tounicode(str
, &sc
);
2794 return memchr(str
, c
, len
);
2799 * Searches for the first non-trim char in string (str, len)
2801 * If none is found, returns just past the last char.
2803 * Lengths are in bytes.
2805 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
2809 int n
= utf8_tounicode(str
, &c
);
2811 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2812 /* Not a trim char, so stop */
2822 * Searches backwards for a non-trim char in string (str, len).
2824 * Returns a pointer to just after the non-trim char, or NULL if not found.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
2834 int n
= utf8_prev_len(str
, len
);
2839 n
= utf8_tounicode(str
, &c
);
2841 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2849 static const char default_trim_chars
[] = " \t\n\r";
2850 /* sizeof() here includes the null byte */
2851 static int default_trim_chars_len
= sizeof(default_trim_chars
);
2853 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2856 const char *str
= Jim_GetString(strObjPtr
, &len
);
2857 const char *trimchars
= default_trim_chars
;
2858 int trimcharslen
= default_trim_chars_len
;
2861 if (trimcharsObjPtr
) {
2862 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2865 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
2866 if (newstr
== str
) {
2870 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
2873 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2876 const char *trimchars
= default_trim_chars
;
2877 int trimcharslen
= default_trim_chars_len
;
2878 const char *nontrim
;
2880 if (trimcharsObjPtr
) {
2881 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2884 SetStringFromAny(interp
, strObjPtr
);
2886 len
= Jim_Length(strObjPtr
);
2887 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
2889 if (nontrim
== NULL
) {
2890 /* All trim, so return a zero-length string */
2891 return Jim_NewEmptyStringObj(interp
);
2893 if (nontrim
== strObjPtr
->bytes
+ len
) {
2894 /* All non-trim, so return the original object */
2898 if (Jim_IsShared(strObjPtr
)) {
2899 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
2902 /* Can modify this string in place */
2903 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
2904 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
2910 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2912 /* First trim left. */
2913 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
2915 /* Now trim right */
2916 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
2918 /* Note: refCount check is needed since objPtr may be emptyObj */
2919 if (objPtr
!= strObjPtr
&& objPtr
->refCount
== 0) {
2920 /* We don't want this object to be leaked */
2921 Jim_FreeNewObj(interp
, objPtr
);
2927 /* Some platforms don't have isascii - need a non-macro version */
2929 #define jim_isascii isascii
2931 static int jim_isascii(int c
)
2933 return !(c
& ~0x7f);
2937 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2939 static const char * const strclassnames
[] = {
2940 "integer", "alpha", "alnum", "ascii", "digit",
2941 "double", "lower", "upper", "space", "xdigit",
2942 "control", "print", "graph", "punct", "boolean",
2946 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2947 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2948 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
, STR_IS_BOOLEAN
,
2954 int (*isclassfunc
)(int c
) = NULL
;
2956 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2960 str
= Jim_GetString(strObjPtr
, &len
);
2962 Jim_SetResultBool(interp
, !strict
);
2967 case STR_IS_INTEGER
:
2970 Jim_SetResultBool(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
2977 Jim_SetResultBool(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
2981 case STR_IS_BOOLEAN
:
2984 Jim_SetResultBool(interp
, Jim_GetBoolean(interp
, strObjPtr
, &b
) == JIM_OK
);
2988 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
2989 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
2990 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
2991 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
2992 case STR_IS_LOWER
: isclassfunc
= islower
; break;
2993 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
2994 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
2995 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
2996 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
2997 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
2998 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
2999 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3004 for (i
= 0; i
< len
; i
++) {
3005 if (!isclassfunc(str
[i
])) {
3006 Jim_SetResultBool(interp
, 0);
3010 Jim_SetResultBool(interp
, 1);
3014 /* -----------------------------------------------------------------------------
3015 * Compared String Object
3016 * ---------------------------------------------------------------------------*/
3018 /* This is strange object that allows comparison of a C literal string
3019 * with a Jim object in a very short time if the same comparison is done
3020 * multiple times. For example every time the [if] command is executed,
3021 * Jim has to check if a given argument is "else".
3022 * If the code has no errors, this comparison is true most of the time,
3023 * so we can cache the pointer of the string of the last matching
3024 * comparison inside the object. Because most C compilers perform literal sharing,
3025 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3026 * this works pretty well even if comparisons are at different places
3027 * inside the C code. */
3029 static const Jim_ObjType comparedStringObjType
= {
3034 JIM_TYPE_REFERENCES
,
3037 /* The only way this object is exposed to the API is via the following
3038 * function. Returns true if the string and the object string repr.
3039 * are the same, otherwise zero is returned.
3041 * Note: this isn't binary safe, but it hardly needs to be.*/
3042 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3044 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3048 const char *objStr
= Jim_String(objPtr
);
3050 if (strcmp(str
, objStr
) != 0)
3053 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3054 Jim_FreeIntRep(interp
, objPtr
);
3055 objPtr
->typePtr
= &comparedStringObjType
;
3057 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3062 static int qsortCompareStringPointers(const void *a
, const void *b
)
3064 char *const *sa
= (char *const *)a
;
3065 char *const *sb
= (char *const *)b
;
3067 return strcmp(*sa
, *sb
);
3071 /* -----------------------------------------------------------------------------
3074 * This object is just a string from the language point of view, but
3075 * the internal representation contains the filename and line number
3076 * where this token was read. This information is used by
3077 * Jim_EvalObj() if the object passed happens to be of type "source".
3079 * This allows propagation of the information about line numbers and file
3080 * names and gives error messages with absolute line numbers.
3082 * Note that this object uses the internal representation of the Jim_Object,
3083 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3085 * Also the object will be converted to something else if the given
3086 * token it represents in the source file is not something to be
3087 * evaluated (not a script), and will be specialized in some other way,
3088 * so the time overhead is also almost zero.
3089 * ---------------------------------------------------------------------------*/
3091 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3092 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3094 static const Jim_ObjType sourceObjType
= {
3096 FreeSourceInternalRep
,
3097 DupSourceInternalRep
,
3099 JIM_TYPE_REFERENCES
,
3102 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3104 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3107 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3109 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3110 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3113 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3114 Jim_Obj
*fileNameObj
, int lineNumber
)
3116 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3117 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3118 Jim_IncrRefCount(fileNameObj
);
3119 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3120 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3121 objPtr
->typePtr
= &sourceObjType
;
3124 /* -----------------------------------------------------------------------------
3127 * This object is used only in the Script internal represenation.
3128 * For each line of the script, it holds the number of tokens on the line
3129 * and the source line number.
3131 static const Jim_ObjType scriptLineObjType
= {
3139 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3143 #ifdef DEBUG_SHOW_SCRIPT
3145 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3146 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3148 objPtr
= Jim_NewEmptyStringObj(interp
);
3150 objPtr
->typePtr
= &scriptLineObjType
;
3151 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3152 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3157 /* -----------------------------------------------------------------------------
3160 * This object holds the parsed internal representation of a script.
3161 * This representation is help within an allocated ScriptObj (see below)
3163 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3164 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3166 static const Jim_ObjType scriptObjType
= {
3168 FreeScriptInternalRep
,
3169 DupScriptInternalRep
,
3171 JIM_TYPE_REFERENCES
,
3174 /* Each token of a script is represented by a ScriptToken.
3175 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3176 * can be specialized by commands operating on it.
3178 typedef struct ScriptToken
3184 /* This is the script object internal representation. An array of
3185 * ScriptToken structures, including a pre-computed representation of the
3186 * command length and arguments.
3188 * For example the script:
3191 * set $i $x$y [foo]BAR
3193 * will produce a ScriptObj with the following ScriptToken's:
3208 * "puts hello" has two args (LIN 2), composed of single tokens.
3209 * (Note that the WRD token is omitted for the common case of a single token.)
3211 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3212 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3214 * The precomputation of the command structure makes Jim_Eval() faster,
3215 * and simpler because there aren't dynamic lengths / allocations.
3217 * -- {expand}/{*} handling --
3219 * Expand is handled in a special way.
3221 * If a "word" begins with {*}, the word token count is -ve.
3223 * For example the command:
3227 * Will produce the following cmdstruct array:
3234 * Note that the 'LIN' token also contains the source information for the
3235 * first word of the line for error reporting purposes
3237 * -- the substFlags field of the structure --
3239 * The scriptObj structure is used to represent both "script" objects
3240 * and "subst" objects. In the second case, there are no LIN and WRD
3241 * tokens. Instead SEP and EOL tokens are added as-is.
3242 * In addition, the field 'substFlags' is used to represent the flags used to turn
3243 * the string into the internal representation.
3244 * If these flags do not match what the application requires,
3245 * the scriptObj is created again. For example the script:
3247 * subst -nocommands $string
3248 * subst -novariables $string
3250 * Will (re)create the internal representation of the $string object
3253 typedef struct ScriptObj
3255 ScriptToken
*token
; /* Tokens array. */
3256 Jim_Obj
*fileNameObj
; /* Filename */
3257 int len
; /* Length of token[] */
3258 int substFlags
; /* flags used for the compilation of "subst" objects */
3259 int inUse
; /* Used to share a ScriptObj. Currently
3260 only used by Jim_EvalObj() as protection against
3261 shimmering of the currently evaluated object. */
3262 int firstline
; /* Line number of the first line */
3263 int linenr
; /* Error line number, if any */
3264 int missing
; /* Missing char if script failed to parse, (or space or backslash if OK) */
3267 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3268 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3269 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3271 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3274 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3276 if (--script
->inUse
!= 0)
3278 for (i
= 0; i
< script
->len
; i
++) {
3279 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3281 Jim_Free(script
->token
);
3282 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3286 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3288 JIM_NOTUSED(interp
);
3289 JIM_NOTUSED(srcPtr
);
3291 /* Just return a simple string. We don't try to preserve the source info
3292 * since in practice scripts are never duplicated
3294 dupPtr
->typePtr
= NULL
;
3297 /* A simple parse token.
3298 * As the script is parsed, the created tokens point into the script string rep.
3302 const char *token
; /* Pointer to the start of the token */
3303 int len
; /* Length of this token */
3304 int type
; /* Token type */
3305 int line
; /* Line number */
3308 /* A list of parsed tokens representing a script.
3309 * Tokens are added to this list as the script is parsed.
3310 * It grows as needed.
3314 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3315 ParseToken
*list
; /* Array of tokens */
3316 int size
; /* Current size of the list */
3317 int count
; /* Number of entries used */
3318 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3321 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3323 tokenlist
->list
= tokenlist
->static_list
;
3324 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3325 tokenlist
->count
= 0;
3328 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3330 if (tokenlist
->list
!= tokenlist
->static_list
) {
3331 Jim_Free(tokenlist
->list
);
3336 * Adds the new token to the tokenlist.
3337 * The token has the given length, type and line number.
3338 * The token list is resized as necessary.
3340 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3345 if (tokenlist
->count
== tokenlist
->size
) {
3346 /* Resize the list */
3347 tokenlist
->size
*= 2;
3348 if (tokenlist
->list
!= tokenlist
->static_list
) {
3350 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3353 /* The list needs to become allocated */
3354 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3355 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3356 tokenlist
->count
* sizeof(*tokenlist
->list
));
3359 t
= &tokenlist
->list
[tokenlist
->count
++];
3366 /* Counts the number of adjoining non-separator tokens.
3368 * Returns -ve if the first token is the expansion
3369 * operator (in which case the count doesn't include
3372 static int JimCountWordTokens(ParseToken
*t
)
3377 /* Is the first word {*} or {expand}? */
3378 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3379 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3380 /* Create an expand token */
3386 /* Now count non-separator words */
3387 while (!TOKEN_IS_SEP(t
->type
)) {
3392 return count
* expand
;
3396 * Create a script/subst object from the given token.
3398 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3402 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3403 /* Convert backlash escapes. The result will never be longer than the original */
3405 char *str
= Jim_Alloc(len
+ 1);
3406 len
= JimEscape(str
, t
->token
, len
);
3407 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3410 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3411 * with a single space.
3413 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3419 * Takes a tokenlist and creates the allocated list of script tokens
3420 * in script->token, of length script->len.
3422 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3425 * Also sets script->line to the line number of the first token
3427 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3428 ParseTokenList
*tokenlist
)
3431 struct ScriptToken
*token
;
3432 /* Number of tokens so far for the current command */
3434 /* This is the first token for the current command */
3435 ScriptToken
*linefirst
;
3439 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3440 printf("==== Tokens ====\n");
3441 for (i
= 0; i
< tokenlist
->count
; i
++) {
3442 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3443 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3447 /* May need up to one extra script token for each EOL in the worst case */
3448 count
= tokenlist
->count
;
3449 for (i
= 0; i
< tokenlist
->count
; i
++) {
3450 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3454 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3456 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3458 /* This is the first token for the current command */
3459 linefirst
= token
++;
3461 for (i
= 0; i
< tokenlist
->count
; ) {
3462 /* Look ahead to find out how many tokens make up the next word */
3465 /* Skip any leading separators */
3466 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3470 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3472 if (wordtokens
== 0) {
3473 /* None, so at end of line */
3475 linefirst
->type
= JIM_TT_LINE
;
3476 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3477 Jim_IncrRefCount(linefirst
->objPtr
);
3479 /* Reset for new line */
3481 linefirst
= token
++;
3486 else if (wordtokens
!= 1) {
3487 /* More than 1, or {*}, so insert a WORD token */
3488 token
->type
= JIM_TT_WORD
;
3489 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3490 Jim_IncrRefCount(token
->objPtr
);
3492 if (wordtokens
< 0) {
3493 /* Skip the expand token */
3495 wordtokens
= -wordtokens
- 1;
3500 if (lineargs
== 0) {
3501 /* First real token on the line, so record the line number */
3502 linenr
= tokenlist
->list
[i
].line
;
3506 /* Add each non-separator word token to the line */
3507 while (wordtokens
--) {
3508 const ParseToken
*t
= &tokenlist
->list
[i
++];
3510 token
->type
= t
->type
;
3511 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3512 Jim_IncrRefCount(token
->objPtr
);
3514 /* Every object is initially a string of type 'source', but the
3515 * internal type may be specialized during execution of the
3517 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3522 if (lineargs
== 0) {
3526 script
->len
= token
- script
->token
;
3528 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3530 #ifdef DEBUG_SHOW_SCRIPT
3531 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3532 for (i
= 0; i
< script
->len
; i
++) {
3533 const ScriptToken
*t
= &script
->token
[i
];
3534 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3540 /* Parses the given string object to determine if it represents a complete script.
3542 * This is useful for interactive shells implementation, for [info complete].
3544 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3545 * '{' on scripts incomplete missing one or more '}' to be balanced.
3546 * '[' on scripts incomplete missing one or more ']' to be balanced.
3547 * '"' on scripts incomplete missing a '"' char.
3548 * '\\' on scripts with a trailing backslash.
3550 * If the script is complete, 1 is returned, otherwise 0.
3552 int Jim_ScriptIsComplete(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, char *stateCharPtr
)
3554 ScriptObj
*script
= JimGetScript(interp
, scriptObj
);
3556 *stateCharPtr
= script
->missing
;
3558 return (script
->missing
== ' ');
3562 * Sets an appropriate error message for a missing script/expression terminator.
3564 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3566 * Note that a trailing backslash is not considered to be an error.
3568 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3578 msg
= "unmatched \"[\"";
3581 msg
= "missing close-brace";
3585 msg
= "missing quote";
3589 Jim_SetResultString(interp
, msg
, -1);
3594 * Similar to ScriptObjAddTokens(), but for subst objects.
3596 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3597 ParseTokenList
*tokenlist
)
3600 struct ScriptToken
*token
;
3602 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3604 for (i
= 0; i
< tokenlist
->count
; i
++) {
3605 const ParseToken
*t
= &tokenlist
->list
[i
];
3607 /* Create a token for 't' */
3608 token
->type
= t
->type
;
3609 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3610 Jim_IncrRefCount(token
->objPtr
);
3617 /* This method takes the string representation of an object
3618 * as a Tcl script, and generates the pre-parsed internal representation
3621 * On parse error, sets an error message and returns JIM_ERR
3622 * (Note: the object is still converted to a script, even if an error occurs)
3624 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3627 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3628 struct JimParserCtx parser
;
3629 struct ScriptObj
*script
;
3630 ParseTokenList tokenlist
;
3633 /* Try to get information about filename / line number */
3634 if (objPtr
->typePtr
== &sourceObjType
) {
3635 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3638 /* Initially parse the script into tokens (in tokenlist) */
3639 ScriptTokenListInit(&tokenlist
);
3641 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3642 while (!parser
.eof
) {
3643 JimParseScript(&parser
);
3644 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3648 /* Add a final EOF token */
3649 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3651 /* Create the "real" script tokens from the parsed tokens */
3652 script
= Jim_Alloc(sizeof(*script
));
3653 memset(script
, 0, sizeof(*script
));
3655 if (objPtr
->typePtr
== &sourceObjType
) {
3656 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3659 script
->fileNameObj
= interp
->emptyObj
;
3661 Jim_IncrRefCount(script
->fileNameObj
);
3662 script
->missing
= parser
.missing
.ch
;
3663 script
->linenr
= parser
.missing
.line
;
3665 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3667 /* No longer need the token list */
3668 ScriptTokenListFree(&tokenlist
);
3670 /* Free the old internal rep and set the new one. */
3671 Jim_FreeIntRep(interp
, objPtr
);
3672 Jim_SetIntRepPtr(objPtr
, script
);
3673 objPtr
->typePtr
= &scriptObjType
;
3676 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
);
3679 * Returns the parsed script.
3680 * Note that if there is any possibility that the script is not valid,
3681 * call JimScriptValid() to check
3683 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3685 if (objPtr
== interp
->emptyObj
) {
3686 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3687 objPtr
= interp
->nullScriptObj
;
3690 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3691 JimSetScriptFromAny(interp
, objPtr
);
3694 return (ScriptObj
*)Jim_GetIntRepPtr(objPtr
);
3698 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3699 * and leaves an error message in the interp result.
3702 static int JimScriptValid(Jim_Interp
*interp
, ScriptObj
*script
)
3704 if (JimParseCheckMissing(interp
, script
->missing
) == JIM_ERR
) {
3705 JimAddErrorToStack(interp
, script
);
3712 /* -----------------------------------------------------------------------------
3714 * ---------------------------------------------------------------------------*/
3715 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3720 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3722 if (--cmdPtr
->inUse
== 0) {
3723 if (cmdPtr
->isproc
) {
3724 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3725 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3726 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3727 if (cmdPtr
->u
.proc
.staticVars
) {
3728 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3729 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3734 if (cmdPtr
->u
.native
.delProc
) {
3735 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3738 if (cmdPtr
->prevCmd
) {
3739 /* Delete any pushed command too */
3740 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3746 /* Variables HashTable Type.
3748 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3751 /* Variables HashTable Type.
3753 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3754 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3756 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3760 static const Jim_HashTableType JimVariablesHashTableType
= {
3761 JimStringCopyHTHashFunction
, /* hash function */
3762 JimStringCopyHTDup
, /* key dup */
3764 JimStringCopyHTKeyCompare
, /* key compare */
3765 JimStringCopyHTKeyDestructor
, /* key destructor */
3766 JimVariablesHTValDestructor
/* val destructor */
3769 /* Commands HashTable Type.
3771 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3773 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3775 JimDecrCmdRefCount(interp
, val
);
3778 static const Jim_HashTableType JimCommandsHashTableType
= {
3779 JimStringCopyHTHashFunction
, /* hash function */
3780 JimStringCopyHTDup
, /* key dup */
3782 JimStringCopyHTKeyCompare
, /* key compare */
3783 JimStringCopyHTKeyDestructor
, /* key destructor */
3784 JimCommandsHT_ValDestructor
/* val destructor */
3787 /* ------------------------- Commands related functions --------------------- */
3789 #ifdef jim_ext_namespace
3791 * Returns the "unscoped" version of the given namespace.
3792 * That is, the fully qualified name without the leading ::
3793 * The returned value is either nsObj, or an object with a zero ref count.
3795 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3797 const char *name
= Jim_String(nsObj
);
3798 if (name
[0] == ':' && name
[1] == ':') {
3799 /* This command is being defined in the global namespace */
3800 while (*++name
== ':') {
3802 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3804 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3805 /* This command is being defined in a non-global namespace */
3806 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3807 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3812 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3816 const char *name
= Jim_String(nameObjPtr
);
3817 if (name
[0] == ':' && name
[1] == ':') {
3820 Jim_IncrRefCount(nameObjPtr
);
3821 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3822 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3823 Jim_DecrRefCount(interp
, nameObjPtr
);
3829 * An efficient version of JimQualifyNameObj() where the name is
3830 * available (and needed) as a 'const char *'.
3831 * Avoids creating an object if not necessary.
3832 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3834 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3836 Jim_Obj
*objPtr
= interp
->emptyObj
;
3838 if (name
[0] == ':' && name
[1] == ':') {
3839 /* This command is being defined in the global namespace */
3840 while (*++name
== ':') {
3843 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3844 /* This command is being defined in a non-global namespace */
3845 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3846 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3847 name
= Jim_String(objPtr
);
3849 Jim_IncrRefCount(objPtr
);
3850 *objPtrPtr
= objPtr
;
3854 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3857 /* We can be more efficient in the no-namespace case */
3858 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3859 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3861 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3867 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3869 /* It may already exist, so we try to delete the old one.
3870 * Note that reference count means that it won't be deleted yet if
3871 * it exists in the call stack.
3873 * BUT, if 'local' is in force, instead of deleting the existing
3874 * proc, we stash a reference to the old proc here.
3876 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3878 /* There was an old cmd with the same name,
3879 * so this requires a 'proc epoch' update. */
3881 /* If a procedure with the same name didn't exist there is no need
3882 * to increment the 'proc epoch' because creation of a new procedure
3883 * can never affect existing cached commands. We don't do
3884 * negative caching. */
3885 Jim_InterpIncrProcEpoch(interp
);
3888 if (he
&& interp
->local
) {
3889 /* Push this command over the top of the previous one */
3890 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3891 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3895 /* Replace the existing command */
3896 Jim_DeleteHashEntry(&interp
->commands
, name
);
3899 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3905 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3906 Jim_CmdProc
*cmdProc
, void *privData
, Jim_DelCmdProc
*delProc
)
3908 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3910 /* Store the new details for this command */
3911 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3913 cmdPtr
->u
.native
.delProc
= delProc
;
3914 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3915 cmdPtr
->u
.native
.privData
= privData
;
3917 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3922 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3926 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3931 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3932 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3933 for (i
= 0; i
< len
; i
++) {
3934 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3938 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3939 /* Check if it's composed of two elements. */
3940 subLen
= Jim_ListLength(interp
, objPtr
);
3941 if (subLen
== 1 || subLen
== 2) {
3942 /* Try to get the variable value from the current
3944 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3946 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3947 if (initObjPtr
== NULL
) {
3948 Jim_SetResultFormatted(interp
,
3949 "variable for initialization of static \"%#s\" not found in the local context",
3955 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3957 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3961 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3962 varPtr
->objPtr
= initObjPtr
;
3963 Jim_IncrRefCount(initObjPtr
);
3964 varPtr
->linkFramePtr
= NULL
;
3965 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3966 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3967 Jim_SetResultFormatted(interp
,
3968 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3969 Jim_DecrRefCount(interp
, initObjPtr
);
3975 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
3983 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
3985 #ifdef jim_ext_namespace
3986 if (cmdPtr
->isproc
) {
3987 /* XXX: Really need JimNamespaceSplit() */
3988 const char *pt
= strrchr(cmdname
, ':');
3989 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
3990 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3991 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
3992 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
3994 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
3995 /* This commands shadows a global command, so a proc epoch update is required */
3996 Jim_InterpIncrProcEpoch(interp
);
4003 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
4004 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4010 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4012 /* Allocate space for both the command pointer and the arg list */
4013 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4014 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4017 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4018 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4019 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4020 cmdPtr
->u
.proc
.argsPos
= -1;
4021 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4022 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4023 Jim_IncrRefCount(argListObjPtr
);
4024 Jim_IncrRefCount(bodyObjPtr
);
4025 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4027 /* Create the statics hash table. */
4028 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4032 /* Parse the args out into arglist, validating as we go */
4033 /* Examine the argument list for default parameters and 'args' */
4034 for (i
= 0; i
< argListLen
; i
++) {
4036 Jim_Obj
*nameObjPtr
;
4037 Jim_Obj
*defaultObjPtr
;
4040 /* Examine a parameter */
4041 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4042 len
= Jim_ListLength(interp
, argPtr
);
4044 Jim_SetResultString(interp
, "argument with no name", -1);
4046 JimDecrCmdRefCount(interp
, cmdPtr
);
4050 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4055 /* Optional parameter */
4056 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4057 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4060 /* Required parameter */
4061 nameObjPtr
= argPtr
;
4062 defaultObjPtr
= NULL
;
4066 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4067 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4068 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4071 cmdPtr
->u
.proc
.argsPos
= i
;
4075 cmdPtr
->u
.proc
.optArity
++;
4078 cmdPtr
->u
.proc
.reqArity
++;
4082 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4083 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4089 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4092 Jim_Obj
*qualifiedNameObj
;
4093 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4095 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4096 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4100 Jim_InterpIncrProcEpoch(interp
);
4103 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4108 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4113 Jim_Obj
*qualifiedOldNameObj
;
4114 Jim_Obj
*qualifiedNewNameObj
;
4118 if (newName
[0] == 0) {
4119 return Jim_DeleteCommand(interp
, oldName
);
4122 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4123 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4125 /* Does it exist? */
4126 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4128 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4130 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4131 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4134 /* Add the new name first */
4135 cmdPtr
= Jim_GetHashEntryVal(he
);
4136 JimIncrCmdRefCount(cmdPtr
);
4137 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4138 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4140 /* Now remove the old name */
4141 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4143 /* Increment the epoch */
4144 Jim_InterpIncrProcEpoch(interp
);
4149 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4150 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4155 /* -----------------------------------------------------------------------------
4157 * ---------------------------------------------------------------------------*/
4159 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4161 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4164 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4166 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4167 dupPtr
->typePtr
= srcPtr
->typePtr
;
4168 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4171 static const Jim_ObjType commandObjType
= {
4173 FreeCommandInternalRep
,
4174 DupCommandInternalRep
,
4176 JIM_TYPE_REFERENCES
,
4179 /* This function returns the command structure for the command name
4180 * stored in objPtr. It tries to specialize the objPtr to contain
4181 * a cached info instead to perform the lookup into the hash table
4182 * every time. The information cached may not be uptodate, in such
4183 * a case the lookup is performed and the cache updated.
4185 * Respects the 'upcall' setting
4187 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4191 /* In order to be valid, the proc epoch must match and
4192 * the lookup must have occurred in the same namespace
4194 if (objPtr
->typePtr
!= &commandObjType
||
4195 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4196 #ifdef jim_ext_namespace
4197 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4200 /* Not cached or out of date, so lookup */
4202 /* Do we need to try the local namespace? */
4203 const char *name
= Jim_String(objPtr
);
4206 if (name
[0] == ':' && name
[1] == ':') {
4207 while (*++name
== ':') {
4210 #ifdef jim_ext_namespace
4211 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4212 /* This command is being defined in a non-global namespace */
4213 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4214 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4215 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4216 Jim_FreeNewObj(interp
, nameObj
);
4223 /* Lookup in the global namespace */
4224 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4226 if (flags
& JIM_ERRMSG
) {
4227 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4231 #ifdef jim_ext_namespace
4234 cmd
= Jim_GetHashEntryVal(he
);
4236 /* Free the old internal repr and set the new one. */
4237 Jim_FreeIntRep(interp
, objPtr
);
4238 objPtr
->typePtr
= &commandObjType
;
4239 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4240 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4241 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4242 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4245 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4247 while (cmd
->u
.proc
.upcall
) {
4253 /* -----------------------------------------------------------------------------
4255 * ---------------------------------------------------------------------------*/
4257 /* -----------------------------------------------------------------------------
4259 * ---------------------------------------------------------------------------*/
4261 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4263 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4265 static const Jim_ObjType variableObjType
= {
4270 JIM_TYPE_REFERENCES
,
4274 * Check that the name does not contain embedded nulls.
4276 * Variable and procedure names are manipulated as null terminated strings, so
4277 * don't allow names with embedded nulls.
4279 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4281 /* Variable names and proc names can't contain embedded nulls */
4282 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4284 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4285 if (memchr(str
, '\0', len
)) {
4286 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4293 /* This method should be called only by the variable API.
4294 * It returns JIM_OK on success (variable already exists),
4295 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4296 * a variable name, but syntax glue for [dict] i.e. the last
4297 * character is ')' */
4298 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4300 const char *varName
;
4301 Jim_CallFrame
*framePtr
;
4306 /* Check if the object is already an uptodate variable */
4307 if (objPtr
->typePtr
== &variableObjType
) {
4308 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4309 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4313 /* Need to re-resolve the variable in the updated callframe */
4315 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4316 return JIM_DICT_SUGAR
;
4318 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4323 varName
= Jim_GetString(objPtr
, &len
);
4325 /* Make sure it's not syntax glue to get/set dict. */
4326 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4327 return JIM_DICT_SUGAR
;
4330 if (varName
[0] == ':' && varName
[1] == ':') {
4331 while (*++varName
== ':') {
4334 framePtr
= interp
->topFramePtr
;
4338 framePtr
= interp
->framePtr
;
4341 /* Resolve this name in the variables hash table */
4342 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4344 if (!global
&& framePtr
->staticVars
) {
4345 /* Try with static vars. */
4346 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4353 /* Free the old internal repr and set the new one. */
4354 Jim_FreeIntRep(interp
, objPtr
);
4355 objPtr
->typePtr
= &variableObjType
;
4356 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4357 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4358 objPtr
->internalRep
.varValue
.global
= global
;
4362 /* -------------------- Variables related functions ------------------------- */
4363 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4364 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4366 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4369 Jim_CallFrame
*framePtr
;
4372 /* New variable to create */
4373 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4375 var
->objPtr
= valObjPtr
;
4376 Jim_IncrRefCount(valObjPtr
);
4377 var
->linkFramePtr
= NULL
;
4379 name
= Jim_String(nameObjPtr
);
4380 if (name
[0] == ':' && name
[1] == ':') {
4381 while (*++name
== ':') {
4383 framePtr
= interp
->topFramePtr
;
4387 framePtr
= interp
->framePtr
;
4391 /* Insert the new variable */
4392 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4394 /* Make the object int rep a variable */
4395 Jim_FreeIntRep(interp
, nameObjPtr
);
4396 nameObjPtr
->typePtr
= &variableObjType
;
4397 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4398 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4399 nameObjPtr
->internalRep
.varValue
.global
= global
;
4404 /* For now that's dummy. Variables lookup should be optimized
4405 * in many ways, with caching of lookups, and possibly with
4406 * a table of pre-allocated vars in every CallFrame for local vars.
4407 * All the caching should also have an 'epoch' mechanism similar
4408 * to the one used by Tcl for procedures lookup caching. */
4410 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4415 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4416 case JIM_DICT_SUGAR
:
4417 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4420 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4423 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4427 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4428 if (var
->linkFramePtr
== NULL
) {
4429 Jim_IncrRefCount(valObjPtr
);
4430 Jim_DecrRefCount(interp
, var
->objPtr
);
4431 var
->objPtr
= valObjPtr
;
4433 else { /* Else handle the link */
4434 Jim_CallFrame
*savedCallFrame
;
4436 savedCallFrame
= interp
->framePtr
;
4437 interp
->framePtr
= var
->linkFramePtr
;
4438 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4439 interp
->framePtr
= savedCallFrame
;
4447 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4449 Jim_Obj
*nameObjPtr
;
4452 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4453 Jim_IncrRefCount(nameObjPtr
);
4454 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4455 Jim_DecrRefCount(interp
, nameObjPtr
);
4459 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4461 Jim_CallFrame
*savedFramePtr
;
4464 savedFramePtr
= interp
->framePtr
;
4465 interp
->framePtr
= interp
->topFramePtr
;
4466 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4467 interp
->framePtr
= savedFramePtr
;
4471 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4473 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4476 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4477 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4478 Jim_IncrRefCount(nameObjPtr
);
4479 Jim_IncrRefCount(valObjPtr
);
4480 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4481 Jim_DecrRefCount(interp
, nameObjPtr
);
4482 Jim_DecrRefCount(interp
, valObjPtr
);
4486 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4487 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4489 const char *varName
;
4490 const char *targetName
;
4491 Jim_CallFrame
*framePtr
;
4494 /* Check for an existing variable or link */
4495 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4496 case JIM_DICT_SUGAR
:
4497 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4498 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4502 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4504 if (varPtr
->linkFramePtr
== NULL
) {
4505 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4509 /* It exists, but is a link, so first delete the link */
4510 varPtr
->linkFramePtr
= NULL
;
4514 /* Resolve the call frames for both variables */
4515 /* XXX: SetVariableFromAny() already did this! */
4516 varName
= Jim_String(nameObjPtr
);
4518 if (varName
[0] == ':' && varName
[1] == ':') {
4519 while (*++varName
== ':') {
4521 /* Linking a global var does nothing */
4522 framePtr
= interp
->topFramePtr
;
4525 framePtr
= interp
->framePtr
;
4528 targetName
= Jim_String(targetNameObjPtr
);
4529 if (targetName
[0] == ':' && targetName
[1] == ':') {
4530 while (*++targetName
== ':') {
4532 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4533 targetCallFrame
= interp
->topFramePtr
;
4535 Jim_IncrRefCount(targetNameObjPtr
);
4537 if (framePtr
->level
< targetCallFrame
->level
) {
4538 Jim_SetResultFormatted(interp
,
4539 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4541 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4545 /* Check for cycles. */
4546 if (framePtr
== targetCallFrame
) {
4547 Jim_Obj
*objPtr
= targetNameObjPtr
;
4549 /* Cycles are only possible with 'uplevel 0' */
4551 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4552 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4553 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4556 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4558 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4559 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4561 objPtr
= varPtr
->objPtr
;
4565 /* Perform the binding */
4566 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4567 /* We are now sure 'nameObjPtr' type is variableObjType */
4568 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4569 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4573 /* Return the Jim_Obj pointer associated with a variable name,
4574 * or NULL if the variable was not found in the current context.
4575 * The same optimization discussed in the comment to the
4576 * 'SetVariable' function should apply here.
4578 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4579 * in a dictionary which is shared, the array variable value is duplicated first.
4580 * This allows the array element to be updated (e.g. append, lappend) without
4581 * affecting other references to the dictionary.
4583 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4585 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4587 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4589 if (varPtr
->linkFramePtr
== NULL
) {
4590 return varPtr
->objPtr
;
4595 /* The variable is a link? Resolve it. */
4596 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4598 interp
->framePtr
= varPtr
->linkFramePtr
;
4599 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4600 interp
->framePtr
= savedCallFrame
;
4604 /* Error, so fall through to the error message */
4609 case JIM_DICT_SUGAR
:
4610 /* [dict] syntax sugar. */
4611 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4613 if (flags
& JIM_ERRMSG
) {
4614 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4619 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4621 Jim_CallFrame
*savedFramePtr
;
4624 savedFramePtr
= interp
->framePtr
;
4625 interp
->framePtr
= interp
->topFramePtr
;
4626 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4627 interp
->framePtr
= savedFramePtr
;
4632 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4634 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4636 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4637 Jim_IncrRefCount(nameObjPtr
);
4638 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4639 Jim_DecrRefCount(interp
, nameObjPtr
);
4643 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4645 Jim_CallFrame
*savedFramePtr
;
4648 savedFramePtr
= interp
->framePtr
;
4649 interp
->framePtr
= interp
->topFramePtr
;
4650 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4651 interp
->framePtr
= savedFramePtr
;
4656 /* Unset a variable.
4657 * Note: On success unset invalidates all the variable objects created
4658 * in the current call frame incrementing. */
4659 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4663 Jim_CallFrame
*framePtr
;
4665 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4666 if (retval
== JIM_DICT_SUGAR
) {
4667 /* [dict] syntax sugar. */
4668 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4670 else if (retval
== JIM_OK
) {
4671 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4673 /* If it's a link call UnsetVariable recursively */
4674 if (varPtr
->linkFramePtr
) {
4675 framePtr
= interp
->framePtr
;
4676 interp
->framePtr
= varPtr
->linkFramePtr
;
4677 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4678 interp
->framePtr
= framePtr
;
4681 const char *name
= Jim_String(nameObjPtr
);
4682 if (nameObjPtr
->internalRep
.varValue
.global
) {
4684 framePtr
= interp
->topFramePtr
;
4687 framePtr
= interp
->framePtr
;
4690 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4691 if (retval
== JIM_OK
) {
4692 /* Change the callframe id, invalidating var lookup caching */
4693 framePtr
->id
= interp
->callFrameEpoch
++;
4697 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4698 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4703 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4705 /* Given a variable name for [dict] operation syntax sugar,
4706 * this function returns two objects, the first with the name
4707 * of the variable to set, and the second with the respective key.
4708 * For example "foo(bar)" will return objects with string repr. of
4711 * The returned objects have refcount = 1. The function can't fail. */
4712 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4713 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4715 const char *str
, *p
;
4717 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4719 str
= Jim_GetString(objPtr
, &len
);
4721 p
= strchr(str
, '(');
4722 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4724 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4727 keyLen
= (str
+ len
) - p
;
4728 if (str
[len
- 1] == ')') {
4732 /* Create the objects with the variable name and key. */
4733 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4735 Jim_IncrRefCount(varObjPtr
);
4736 Jim_IncrRefCount(keyObjPtr
);
4737 *varPtrPtr
= varObjPtr
;
4738 *keyPtrPtr
= keyObjPtr
;
4741 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4742 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4743 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4747 SetDictSubstFromAny(interp
, objPtr
);
4749 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4750 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4752 if (err
== JIM_OK
) {
4753 /* Don't keep an extra ref to the result */
4754 Jim_SetEmptyResult(interp
);
4758 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4759 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4760 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4765 /* Make the error more informative and Tcl-compatible */
4766 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4767 (valObjPtr
? "set" : "unset"), objPtr
);
4773 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4775 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4776 * and stored back to the variable before expansion.
4778 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4779 Jim_Obj
*keyObjPtr
, int flags
)
4781 Jim_Obj
*dictObjPtr
;
4782 Jim_Obj
*resObjPtr
= NULL
;
4785 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4790 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4791 if (ret
!= JIM_OK
) {
4792 Jim_SetResultFormatted(interp
,
4793 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4794 ret
< 0 ? "variable isn't" : "no such element in");
4796 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4797 /* Update the variable to have an unshared copy */
4798 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4804 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4805 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4807 SetDictSubstFromAny(interp
, objPtr
);
4809 return JimDictExpandArrayVariable(interp
,
4810 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4811 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4814 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4816 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4818 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4819 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4822 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4824 JIM_NOTUSED(interp
);
4826 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4827 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4828 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4829 dupPtr
->typePtr
= &dictSubstObjType
;
4832 /* Note: The object *must* be in dict-sugar format */
4833 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4835 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4836 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4838 if (objPtr
->typePtr
== &interpolatedObjType
) {
4839 /* An interpolated object in dict-sugar form */
4841 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4842 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4844 Jim_IncrRefCount(varObjPtr
);
4845 Jim_IncrRefCount(keyObjPtr
);
4848 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4851 Jim_FreeIntRep(interp
, objPtr
);
4852 objPtr
->typePtr
= &dictSubstObjType
;
4853 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4854 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4858 /* This function is used to expand [dict get] sugar in the form
4859 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4860 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4861 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4862 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4863 * the [dict]ionary contained in variable VARNAME. */
4864 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4866 Jim_Obj
*resObjPtr
= NULL
;
4867 Jim_Obj
*substKeyObjPtr
= NULL
;
4869 SetDictSubstFromAny(interp
, objPtr
);
4871 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4872 &substKeyObjPtr
, JIM_NONE
)
4876 Jim_IncrRefCount(substKeyObjPtr
);
4878 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4880 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4885 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4887 Jim_Obj
*resultObjPtr
;
4889 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4890 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4891 resultObjPtr
->refCount
--;
4892 return resultObjPtr
;
4897 /* -----------------------------------------------------------------------------
4899 * ---------------------------------------------------------------------------*/
4901 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4905 if (interp
->freeFramesList
) {
4906 cf
= interp
->freeFramesList
;
4907 interp
->freeFramesList
= cf
->next
;
4911 cf
->procArgsObjPtr
= NULL
;
4912 cf
->procBodyObjPtr
= NULL
;
4914 cf
->staticVars
= NULL
;
4915 cf
->localCommands
= NULL
;
4916 cf
->tailcallObj
= NULL
;
4917 cf
->tailcallCmd
= NULL
;
4920 cf
= Jim_Alloc(sizeof(*cf
));
4921 memset(cf
, 0, sizeof(*cf
));
4923 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4926 cf
->id
= interp
->callFrameEpoch
++;
4927 cf
->parent
= parent
;
4928 cf
->level
= parent
? parent
->level
+ 1 : 0;
4930 Jim_IncrRefCount(nsObj
);
4935 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
)
4937 /* Delete any local procs */
4938 if (localCommands
) {
4939 Jim_Obj
*cmdNameObj
;
4941 while ((cmdNameObj
= Jim_StackPop(localCommands
)) != NULL
) {
4944 Jim_HashTable
*ht
= &interp
->commands
;
4946 const char *fqname
= JimQualifyName(interp
, Jim_String(cmdNameObj
), &fqObjName
);
4948 he
= Jim_FindHashEntry(ht
, fqname
);
4951 Jim_Cmd
*cmd
= Jim_GetHashEntryVal(he
);
4953 Jim_Cmd
*prevCmd
= cmd
->prevCmd
;
4954 cmd
->prevCmd
= NULL
;
4956 /* Delete the old command */
4957 JimDecrCmdRefCount(interp
, cmd
);
4959 /* And restore the original */
4960 Jim_SetHashVal(ht
, he
, prevCmd
);
4963 Jim_DeleteHashEntry(ht
, fqname
);
4964 Jim_InterpIncrProcEpoch(interp
);
4967 Jim_DecrRefCount(interp
, cmdNameObj
);
4968 JimFreeQualifiedName(interp
, fqObjName
);
4970 Jim_FreeStack(localCommands
);
4971 Jim_Free(localCommands
);
4977 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4978 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4979 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
)
4981 JimDeleteLocalProcs(interp
, cf
->localCommands
);
4983 if (cf
->procArgsObjPtr
)
4984 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
4985 if (cf
->procBodyObjPtr
)
4986 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
4987 Jim_DecrRefCount(interp
, cf
->nsObj
);
4988 if (action
== JIM_FCF_FULL
|| cf
->vars
.size
!= JIM_HT_INITIAL_SIZE
)
4989 Jim_FreeHashTable(&cf
->vars
);
4992 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
4994 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
4996 while (he
!= NULL
) {
4997 Jim_HashEntry
*nextEntry
= he
->next
;
4998 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
5000 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
5001 Jim_Free(Jim_GetHashEntryKey(he
));
5010 cf
->next
= interp
->freeFramesList
;
5011 interp
->freeFramesList
= cf
;
5015 /* -----------------------------------------------------------------------------
5017 * ---------------------------------------------------------------------------*/
5018 #ifdef JIM_REFERENCES
5020 /* References HashTable Type.
5022 * Keys are unsigned long integers, dynamically allocated for now but in the
5023 * future it's worth to cache this 4 bytes objects. Values are pointers
5024 * to Jim_References. */
5025 static void JimReferencesHTValDestructor(void *interp
, void *val
)
5027 Jim_Reference
*refPtr
= (void *)val
;
5029 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
5030 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
5031 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5036 static unsigned int JimReferencesHTHashFunction(const void *key
)
5038 /* Only the least significant bits are used. */
5039 const unsigned long *widePtr
= key
;
5040 unsigned int intValue
= (unsigned int)*widePtr
;
5042 return Jim_IntHashFunction(intValue
);
5045 static void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
5047 void *copy
= Jim_Alloc(sizeof(unsigned long));
5049 JIM_NOTUSED(privdata
);
5051 memcpy(copy
, key
, sizeof(unsigned long));
5055 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5057 JIM_NOTUSED(privdata
);
5059 return memcmp(key1
, key2
, sizeof(unsigned long)) == 0;
5062 static void JimReferencesHTKeyDestructor(void *privdata
, void *key
)
5064 JIM_NOTUSED(privdata
);
5069 static const Jim_HashTableType JimReferencesHashTableType
= {
5070 JimReferencesHTHashFunction
, /* hash function */
5071 JimReferencesHTKeyDup
, /* key dup */
5073 JimReferencesHTKeyCompare
, /* key compare */
5074 JimReferencesHTKeyDestructor
, /* key destructor */
5075 JimReferencesHTValDestructor
/* val destructor */
5078 /* -----------------------------------------------------------------------------
5079 * Reference object type and References API
5080 * ---------------------------------------------------------------------------*/
5082 /* The string representation of references has two features in order
5083 * to make the GC faster. The first is that every reference starts
5084 * with a non common character '<', in order to make the string matching
5085 * faster. The second is that the reference string rep is 42 characters
5086 * in length, this means that it is not necessary to check any object with a string
5087 * repr < 42, and usually there aren't many of these objects. */
5089 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5091 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, unsigned long id
)
5093 const char *fmt
= "<reference.<%s>.%020lu>";
5095 sprintf(buf
, fmt
, refPtr
->tag
, id
);
5096 return JIM_REFERENCE_SPACE
;
5099 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
5101 static const Jim_ObjType referenceObjType
= {
5105 UpdateStringOfReference
,
5106 JIM_TYPE_REFERENCES
,
5109 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
5111 char buf
[JIM_REFERENCE_SPACE
+ 1];
5113 JimFormatReference(buf
, objPtr
->internalRep
.refValue
.refPtr
, objPtr
->internalRep
.refValue
.id
);
5114 JimSetStringBytes(objPtr
, buf
);
5117 /* returns true if 'c' is a valid reference tag character.
5118 * i.e. inside the range [_a-zA-Z0-9] */
5119 static int isrefchar(int c
)
5121 return (c
== '_' || isalnum(c
));
5124 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5126 unsigned long value
;
5128 const char *str
, *start
, *end
;
5130 Jim_Reference
*refPtr
;
5134 /* Get the string representation */
5135 str
= Jim_GetString(objPtr
, &len
);
5136 /* Check if it looks like a reference */
5137 if (len
< JIM_REFERENCE_SPACE
)
5141 end
= str
+ len
- 1;
5142 while (*start
== ' ')
5144 while (*end
== ' ' && end
> start
)
5146 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
5148 /* <reference.<1234567>.%020> */
5149 if (memcmp(start
, "<reference.<", 12) != 0)
5151 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
5153 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5154 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5155 if (!isrefchar(start
[12 + i
]))
5158 /* Extract info from the reference. */
5159 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
5161 /* Try to convert the ID into an unsigned long */
5162 value
= strtoul(refId
, &endptr
, 10);
5163 if (JimCheckConversion(refId
, endptr
) != JIM_OK
)
5165 /* Check if the reference really exists! */
5166 he
= Jim_FindHashEntry(&interp
->references
, &value
);
5168 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
5171 refPtr
= Jim_GetHashEntryVal(he
);
5172 /* Free the old internal repr and set the new one. */
5173 Jim_FreeIntRep(interp
, objPtr
);
5174 objPtr
->typePtr
= &referenceObjType
;
5175 objPtr
->internalRep
.refValue
.id
= value
;
5176 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5180 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
5184 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5185 * as finalizer command (or NULL if there is no finalizer).
5186 * The returned reference object has refcount = 0. */
5187 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
5189 struct Jim_Reference
*refPtr
;
5195 /* Perform the Garbage Collection if needed. */
5196 Jim_CollectIfNeeded(interp
);
5198 refPtr
= Jim_Alloc(sizeof(*refPtr
));
5199 refPtr
->objPtr
= objPtr
;
5200 Jim_IncrRefCount(objPtr
);
5201 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5203 Jim_IncrRefCount(cmdNamePtr
);
5204 id
= interp
->referenceNextId
++;
5205 Jim_AddHashEntry(&interp
->references
, &id
, refPtr
);
5206 refObjPtr
= Jim_NewObj(interp
);
5207 refObjPtr
->typePtr
= &referenceObjType
;
5208 refObjPtr
->bytes
= NULL
;
5209 refObjPtr
->internalRep
.refValue
.id
= id
;
5210 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5211 interp
->referenceNextId
++;
5212 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5213 * that does not pass the 'isrefchar' test is replaced with '_' */
5214 tag
= Jim_GetString(tagPtr
, &tagLen
);
5215 if (tagLen
> JIM_REFERENCE_TAGLEN
)
5216 tagLen
= JIM_REFERENCE_TAGLEN
;
5217 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5218 if (i
< tagLen
&& isrefchar(tag
[i
]))
5219 refPtr
->tag
[i
] = tag
[i
];
5221 refPtr
->tag
[i
] = '_';
5223 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
5227 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5229 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
5231 return objPtr
->internalRep
.refValue
.refPtr
;
5234 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
5236 Jim_Reference
*refPtr
;
5238 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5240 Jim_IncrRefCount(cmdNamePtr
);
5241 if (refPtr
->finalizerCmdNamePtr
)
5242 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5243 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5247 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
5249 Jim_Reference
*refPtr
;
5251 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5253 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
5257 /* -----------------------------------------------------------------------------
5258 * References Garbage Collection
5259 * ---------------------------------------------------------------------------*/
5261 /* This the hash table type for the "MARK" phase of the GC */
5262 static const Jim_HashTableType JimRefMarkHashTableType
= {
5263 JimReferencesHTHashFunction
, /* hash function */
5264 JimReferencesHTKeyDup
, /* key dup */
5266 JimReferencesHTKeyCompare
, /* key compare */
5267 JimReferencesHTKeyDestructor
, /* key destructor */
5268 NULL
/* val destructor */
5271 /* Performs the garbage collection. */
5272 int Jim_Collect(Jim_Interp
*interp
)
5275 #ifndef JIM_BOOTSTRAP
5276 Jim_HashTable marks
;
5277 Jim_HashTableIterator htiter
;
5281 /* Avoid recursive calls */
5282 if (interp
->lastCollectId
== -1) {
5283 /* Jim_Collect() already running. Return just now. */
5286 interp
->lastCollectId
= -1;
5288 /* Mark all the references found into the 'mark' hash table.
5289 * The references are searched in every live object that
5290 * is of a type that can contain references. */
5291 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
5292 objPtr
= interp
->liveList
;
5294 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
5295 const char *str
, *p
;
5298 /* If the object is of type reference, to get the
5299 * Id is simple... */
5300 if (objPtr
->typePtr
== &referenceObjType
) {
5301 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
5303 printf("MARK (reference): %d refcount: %d\n",
5304 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
5306 objPtr
= objPtr
->nextObjPtr
;
5309 /* Get the string repr of the object we want
5310 * to scan for references. */
5311 p
= str
= Jim_GetString(objPtr
, &len
);
5312 /* Skip objects too little to contain references. */
5313 if (len
< JIM_REFERENCE_SPACE
) {
5314 objPtr
= objPtr
->nextObjPtr
;
5317 /* Extract references from the object string repr. */
5322 if ((p
= strstr(p
, "<reference.<")) == NULL
)
5324 /* Check if it's a valid reference. */
5325 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
5327 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
5329 for (i
= 21; i
<= 40; i
++)
5330 if (!isdigit(UCHAR(p
[i
])))
5333 id
= strtoul(p
+ 21, NULL
, 10);
5335 /* Ok, a reference for the given ID
5336 * was found. Mark it. */
5337 Jim_AddHashEntry(&marks
, &id
, NULL
);
5339 printf("MARK: %d\n", (int)id
);
5341 p
+= JIM_REFERENCE_SPACE
;
5344 objPtr
= objPtr
->nextObjPtr
;
5347 /* Run the references hash table to destroy every reference that
5348 * is not referenced outside (not present in the mark HT). */
5349 JimInitHashTableIterator(&interp
->references
, &htiter
);
5350 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
5351 const unsigned long *refId
;
5352 Jim_Reference
*refPtr
;
5355 /* Check if in the mark phase we encountered
5356 * this reference. */
5357 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
5359 printf("COLLECTING %d\n", (int)*refId
);
5362 /* Drop the reference, but call the
5363 * finalizer first if registered. */
5364 refPtr
= Jim_GetHashEntryVal(he
);
5365 if (refPtr
->finalizerCmdNamePtr
) {
5366 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
5367 Jim_Obj
*objv
[3], *oldResult
;
5369 JimFormatReference(refstr
, refPtr
, *refId
);
5371 objv
[0] = refPtr
->finalizerCmdNamePtr
;
5372 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, JIM_REFERENCE_SPACE
);
5373 objv
[2] = refPtr
->objPtr
;
5375 /* Drop the reference itself */
5376 /* Avoid the finaliser being freed here */
5377 Jim_IncrRefCount(objv
[0]);
5378 /* Don't remove the reference from the hash table just yet
5379 * since that will free refPtr, and hence refPtr->objPtr
5382 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5383 oldResult
= interp
->result
;
5384 Jim_IncrRefCount(oldResult
);
5385 Jim_EvalObjVector(interp
, 3, objv
);
5386 Jim_SetResult(interp
, oldResult
);
5387 Jim_DecrRefCount(interp
, oldResult
);
5389 Jim_DecrRefCount(interp
, objv
[0]);
5391 Jim_DeleteHashEntry(&interp
->references
, refId
);
5394 Jim_FreeHashTable(&marks
);
5395 interp
->lastCollectId
= interp
->referenceNextId
;
5396 interp
->lastCollectTime
= time(NULL
);
5397 #endif /* JIM_BOOTSTRAP */
5401 #define JIM_COLLECT_ID_PERIOD 5000
5402 #define JIM_COLLECT_TIME_PERIOD 300
5404 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
5406 unsigned long elapsedId
;
5409 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
5410 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
5413 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
5414 Jim_Collect(interp
);
5419 int Jim_IsBigEndian(void)
5426 return uval
.c
[0] == 1;
5429 /* -----------------------------------------------------------------------------
5430 * Interpreter related functions
5431 * ---------------------------------------------------------------------------*/
5433 Jim_Interp
*Jim_CreateInterp(void)
5435 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
5437 memset(i
, 0, sizeof(*i
));
5439 i
->maxCallFrameDepth
= JIM_MAX_CALLFRAME_DEPTH
;
5440 i
->maxEvalDepth
= JIM_MAX_EVAL_DEPTH
;
5441 i
->lastCollectTime
= time(NULL
);
5443 /* Note that we can create objects only after the
5444 * interpreter liveList and freeList pointers are
5445 * initialized to NULL. */
5446 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
5447 #ifdef JIM_REFERENCES
5448 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
5450 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
5451 Jim_InitHashTable(&i
->packages
, &JimPackageHashTableType
, NULL
);
5452 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
5453 i
->trueObj
= Jim_NewIntObj(i
, 1);
5454 i
->falseObj
= Jim_NewIntObj(i
, 0);
5455 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
, i
->emptyObj
);
5456 i
->errorFileNameObj
= i
->emptyObj
;
5457 i
->result
= i
->emptyObj
;
5458 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
5459 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
5460 i
->errorProc
= i
->emptyObj
;
5461 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
5462 i
->nullScriptObj
= Jim_NewEmptyStringObj(i
);
5463 Jim_IncrRefCount(i
->emptyObj
);
5464 Jim_IncrRefCount(i
->errorFileNameObj
);
5465 Jim_IncrRefCount(i
->result
);
5466 Jim_IncrRefCount(i
->stackTrace
);
5467 Jim_IncrRefCount(i
->unknown
);
5468 Jim_IncrRefCount(i
->currentScriptObj
);
5469 Jim_IncrRefCount(i
->nullScriptObj
);
5470 Jim_IncrRefCount(i
->errorProc
);
5471 Jim_IncrRefCount(i
->trueObj
);
5472 Jim_IncrRefCount(i
->falseObj
);
5474 /* Initialize key variables every interpreter should contain */
5475 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
5476 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
5478 Jim_SetVariableStrWithStr(i
, "tcl_platform(engine)", "Jim");
5479 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5480 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5481 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5482 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5483 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5484 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5485 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5490 void Jim_FreeInterp(Jim_Interp
*i
)
5492 Jim_CallFrame
*cf
, *cfx
;
5494 Jim_Obj
*objPtr
, *nextObjPtr
;
5496 /* Free the active call frames list - must be done before i->commands is destroyed */
5497 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5499 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5502 Jim_DecrRefCount(i
, i
->emptyObj
);
5503 Jim_DecrRefCount(i
, i
->trueObj
);
5504 Jim_DecrRefCount(i
, i
->falseObj
);
5505 Jim_DecrRefCount(i
, i
->result
);
5506 Jim_DecrRefCount(i
, i
->stackTrace
);
5507 Jim_DecrRefCount(i
, i
->errorProc
);
5508 Jim_DecrRefCount(i
, i
->unknown
);
5509 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5510 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5511 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5512 Jim_FreeHashTable(&i
->commands
);
5513 #ifdef JIM_REFERENCES
5514 Jim_FreeHashTable(&i
->references
);
5516 Jim_FreeHashTable(&i
->packages
);
5517 Jim_Free(i
->prngState
);
5518 Jim_FreeHashTable(&i
->assocData
);
5520 /* Check that the live object list is empty, otherwise
5521 * there is a memory leak. */
5522 #ifdef JIM_MAINTAINER
5523 if (i
->liveList
!= NULL
) {
5524 objPtr
= i
->liveList
;
5526 printf("\n-------------------------------------\n");
5527 printf("Objects still in the free list:\n");
5529 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5531 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5532 printf("%p (%d) %-10s: '%.20s...'\n",
5533 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5536 printf("%p (%d) %-10s: '%s'\n",
5537 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5539 if (objPtr
->typePtr
== &sourceObjType
) {
5540 printf("FILE %s LINE %d\n",
5541 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5542 objPtr
->internalRep
.sourceValue
.lineNumber
);
5544 objPtr
= objPtr
->nextObjPtr
;
5546 printf("-------------------------------------\n\n");
5547 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5551 /* Free all the freed objects. */
5552 objPtr
= i
->freeList
;
5554 nextObjPtr
= objPtr
->nextObjPtr
;
5556 objPtr
= nextObjPtr
;
5559 /* Free the free call frames list */
5560 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5563 Jim_FreeHashTable(&cf
->vars
);
5567 /* Free the interpreter structure. */
5571 /* Returns the call frame relative to the level represented by
5572 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5574 * This function accepts the 'level' argument in the form
5575 * of the commands [uplevel] and [upvar].
5577 * Returns NULL on error.
5579 * Note: for a function accepting a relative integer as level suitable
5580 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5582 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5586 Jim_CallFrame
*framePtr
;
5589 str
= Jim_String(levelObjPtr
);
5590 if (str
[0] == '#') {
5593 level
= jim_strtol(str
+ 1, &endptr
);
5594 if (str
[1] == '\0' || endptr
[0] != '\0') {
5599 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5603 /* Convert from a relative to an absolute level */
5604 level
= interp
->framePtr
->level
- level
;
5609 str
= "1"; /* Needed to format the error message. */
5610 level
= interp
->framePtr
->level
- 1;
5614 return interp
->topFramePtr
;
5618 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5619 if (framePtr
->level
== level
) {
5625 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5629 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5630 * as a relative integer like in the [info level ?level?] command.
5632 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5635 Jim_CallFrame
*framePtr
;
5637 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5639 /* Convert from a relative to an absolute level */
5640 level
= interp
->framePtr
->level
+ level
;
5644 return interp
->topFramePtr
;
5648 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5649 if (framePtr
->level
== level
) {
5655 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5659 static void JimResetStackTrace(Jim_Interp
*interp
)
5661 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5662 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5663 Jim_IncrRefCount(interp
->stackTrace
);
5666 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5670 /* Increment reference first in case these are the same object */
5671 Jim_IncrRefCount(stackTraceObj
);
5672 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5673 interp
->stackTrace
= stackTraceObj
;
5674 interp
->errorFlag
= 1;
5676 /* This is a bit ugly.
5677 * If the filename of the last entry of the stack trace is empty,
5678 * the next stack level should be added.
5680 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5682 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5683 interp
->addStackTrace
= 1;
5688 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5689 Jim_Obj
*fileNameObj
, int linenr
)
5691 if (strcmp(procname
, "unknown") == 0) {
5694 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5695 /* No useful info here */
5699 if (Jim_IsShared(interp
->stackTrace
)) {
5700 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5701 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5702 Jim_IncrRefCount(interp
->stackTrace
);
5705 /* If we have no procname but the previous element did, merge with that frame */
5706 if (!*procname
&& Jim_Length(fileNameObj
)) {
5707 /* Just a filename. Check the previous entry */
5708 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5711 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5712 if (Jim_Length(objPtr
)) {
5713 /* Yes, the previous level had procname */
5714 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5715 if (Jim_Length(objPtr
) == 0) {
5716 /* But no filename, so merge the new info with that frame */
5717 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5718 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5725 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5726 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5727 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5730 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5733 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5735 assocEntryPtr
->delProc
= delProc
;
5736 assocEntryPtr
->data
= data
;
5737 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5740 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5742 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5744 if (entryPtr
!= NULL
) {
5745 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5746 return assocEntryPtr
->data
;
5751 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5753 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5756 int Jim_GetExitCode(Jim_Interp
*interp
)
5758 return interp
->exitCode
;
5761 /* -----------------------------------------------------------------------------
5763 * ---------------------------------------------------------------------------*/
5764 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5765 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5767 static const Jim_ObjType intObjType
= {
5775 /* A coerced double is closer to an int than a double.
5776 * It is an int value temporarily masquerading as a double value.
5777 * i.e. it has the same string value as an int and Jim_GetWide()
5778 * succeeds, but also Jim_GetDouble() returns the value directly.
5780 static const Jim_ObjType coercedDoubleObjType
= {
5789 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5791 char buf
[JIM_INTEGER_SPACE
+ 1];
5792 jim_wide wideValue
= JimWideValue(objPtr
);
5795 if (wideValue
== 0) {
5799 char tmp
[JIM_INTEGER_SPACE
];
5803 if (wideValue
< 0) {
5806 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5807 * whereas C99 is always -6
5808 * coverity[dead_error_line]
5810 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5815 tmp
[num
++] = wideValue
% 10;
5819 for (i
= 0; i
< num
; i
++) {
5820 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5825 JimSetStringBytes(objPtr
, buf
);
5828 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5833 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5835 objPtr
->typePtr
= &intObjType
;
5839 /* Get the string representation */
5840 str
= Jim_String(objPtr
);
5841 /* Try to convert into a jim_wide */
5842 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5843 if (flags
& JIM_ERRMSG
) {
5844 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5848 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5849 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5852 /* Free the old internal repr and set the new one. */
5853 Jim_FreeIntRep(interp
, objPtr
);
5854 objPtr
->typePtr
= &intObjType
;
5855 objPtr
->internalRep
.wideValue
= wideValue
;
5859 #ifdef JIM_OPTIMIZATION
5860 static int JimIsWide(Jim_Obj
*objPtr
)
5862 return objPtr
->typePtr
== &intObjType
;
5866 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5868 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5870 *widePtr
= JimWideValue(objPtr
);
5874 /* Get a wide but does not set an error if the format is bad. */
5875 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5877 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5879 *widePtr
= JimWideValue(objPtr
);
5883 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5888 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5889 if (retval
== JIM_OK
) {
5890 *longPtr
= (long)wideValue
;
5896 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5900 objPtr
= Jim_NewObj(interp
);
5901 objPtr
->typePtr
= &intObjType
;
5902 objPtr
->bytes
= NULL
;
5903 objPtr
->internalRep
.wideValue
= wideValue
;
5907 /* -----------------------------------------------------------------------------
5909 * ---------------------------------------------------------------------------*/
5910 #define JIM_DOUBLE_SPACE 30
5912 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5913 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5915 static const Jim_ObjType doubleObjType
= {
5919 UpdateStringOfDouble
,
5925 #define isnan(X) ((X) != (X))
5929 #define isinf(X) (1.0 / (X) == 0.0)
5932 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5934 double value
= objPtr
->internalRep
.doubleValue
;
5937 JimSetStringBytes(objPtr
, "NaN");
5942 JimSetStringBytes(objPtr
, "-Inf");
5945 JimSetStringBytes(objPtr
, "Inf");
5950 char buf
[JIM_DOUBLE_SPACE
+ 1];
5952 int len
= sprintf(buf
, "%.12g", value
);
5954 /* Add a final ".0" if necessary */
5955 for (i
= 0; i
< len
; i
++) {
5956 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5957 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5958 /* If 'buf' ends in e-0nn or e+0nn, remove
5959 * the 0 after the + or - and reduce the length by 1
5961 char *e
= strchr(buf
, 'e');
5962 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5965 memmove(e
, e
+ 1, len
- (e
- buf
));
5971 if (buf
[i
] == '\0') {
5976 JimSetStringBytes(objPtr
, buf
);
5980 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5986 /* Preserve the string representation.
5987 * Needed so we can convert back to int without loss
5989 str
= Jim_String(objPtr
);
5991 #ifdef HAVE_LONG_LONG
5992 /* Assume a 53 bit mantissa */
5993 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5994 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5996 if (objPtr
->typePtr
== &intObjType
5997 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
5998 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6000 /* Direct conversion to coerced double */
6001 objPtr
->typePtr
= &coercedDoubleObjType
;
6006 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6007 /* Managed to convert to an int, so we can use this as a cooerced double */
6008 Jim_FreeIntRep(interp
, objPtr
);
6009 objPtr
->typePtr
= &coercedDoubleObjType
;
6010 objPtr
->internalRep
.wideValue
= wideValue
;
6014 /* Try to convert into a double */
6015 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6016 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6019 /* Free the old internal repr and set the new one. */
6020 Jim_FreeIntRep(interp
, objPtr
);
6022 objPtr
->typePtr
= &doubleObjType
;
6023 objPtr
->internalRep
.doubleValue
= doubleValue
;
6027 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6029 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6030 *doublePtr
= JimWideValue(objPtr
);
6033 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6036 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6037 *doublePtr
= JimWideValue(objPtr
);
6040 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6045 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6049 objPtr
= Jim_NewObj(interp
);
6050 objPtr
->typePtr
= &doubleObjType
;
6051 objPtr
->bytes
= NULL
;
6052 objPtr
->internalRep
.doubleValue
= doubleValue
;
6056 /* -----------------------------------------------------------------------------
6057 * Boolean conversion
6058 * ---------------------------------------------------------------------------*/
6059 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
6061 int Jim_GetBoolean(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int * booleanPtr
)
6063 if (objPtr
->typePtr
!= &intObjType
&& SetBooleanFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
6065 *booleanPtr
= (int) JimWideValue(objPtr
);
6069 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
6071 static const char * const falses
[] = {
6072 "0", "false", "no", "off", NULL
6074 static const char * const trues
[] = {
6075 "1", "true", "yes", "on", NULL
6081 if (Jim_GetEnum(interp
, objPtr
, falses
, &index
, NULL
, 0) == JIM_OK
) {
6083 } else if (Jim_GetEnum(interp
, objPtr
, trues
, &index
, NULL
, 0) == JIM_OK
) {
6086 if (flags
& JIM_ERRMSG
) {
6087 Jim_SetResultFormatted(interp
, "expected boolean but got \"%#s\"", objPtr
);
6092 /* Free the old internal repr and set the new one. */
6093 Jim_FreeIntRep(interp
, objPtr
);
6094 objPtr
->typePtr
= &intObjType
;
6095 objPtr
->internalRep
.wideValue
= boolean
;
6099 /* -----------------------------------------------------------------------------
6101 * ---------------------------------------------------------------------------*/
6102 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6103 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6104 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6105 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6106 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6107 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6109 /* Note that while the elements of the list may contain references,
6110 * the list object itself can't. This basically means that the
6111 * list object string representation as a whole can't contain references
6112 * that are not presents in the single elements. */
6113 static const Jim_ObjType listObjType
= {
6115 FreeListInternalRep
,
6121 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6125 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6126 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6128 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6131 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6135 JIM_NOTUSED(interp
);
6137 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6138 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6139 dupPtr
->internalRep
.listValue
.ele
=
6140 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6141 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6142 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6143 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6144 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6146 dupPtr
->typePtr
= &listObjType
;
6149 /* The following function checks if a given string can be encoded
6150 * into a list element without any kind of quoting, surrounded by braces,
6151 * or using escapes to quote. */
6152 #define JIM_ELESTR_SIMPLE 0
6153 #define JIM_ELESTR_BRACE 1
6154 #define JIM_ELESTR_QUOTE 2
6155 static unsigned char ListElementQuotingType(const char *s
, int len
)
6157 int i
, level
, blevel
, trySimple
= 1;
6159 /* Try with the SIMPLE case */
6161 return JIM_ELESTR_BRACE
;
6162 if (s
[0] == '"' || s
[0] == '{') {
6166 for (i
= 0; i
< len
; i
++) {
6187 return JIM_ELESTR_SIMPLE
;
6190 /* Test if it's possible to do with braces */
6191 if (s
[len
- 1] == '\\')
6192 return JIM_ELESTR_QUOTE
;
6195 for (i
= 0; i
< len
; i
++) {
6203 return JIM_ELESTR_QUOTE
;
6212 if (s
[i
+ 1] == '\n')
6213 return JIM_ELESTR_QUOTE
;
6214 else if (s
[i
+ 1] != '\0')
6220 return JIM_ELESTR_QUOTE
;
6225 return JIM_ELESTR_BRACE
;
6226 for (i
= 0; i
< len
; i
++) {
6240 return JIM_ELESTR_BRACE
;
6244 return JIM_ELESTR_SIMPLE
;
6246 return JIM_ELESTR_QUOTE
;
6249 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6250 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6252 * Returns the length of the result.
6254 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6307 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6309 #define STATIC_QUOTING_LEN 32
6310 int i
, bufLen
, realLength
;
6313 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6315 /* Estimate the space needed. */
6316 if (objc
> STATIC_QUOTING_LEN
) {
6317 quotingType
= Jim_Alloc(objc
);
6320 quotingType
= staticQuoting
;
6323 for (i
= 0; i
< objc
; i
++) {
6326 strRep
= Jim_GetString(objv
[i
], &len
);
6327 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6328 switch (quotingType
[i
]) {
6329 case JIM_ELESTR_SIMPLE
:
6330 if (i
!= 0 || strRep
[0] != '#') {
6334 /* Special case '#' on first element needs braces */
6335 quotingType
[i
] = JIM_ELESTR_BRACE
;
6337 case JIM_ELESTR_BRACE
:
6340 case JIM_ELESTR_QUOTE
:
6344 bufLen
++; /* elements separator. */
6348 /* Generate the string rep. */
6349 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6351 for (i
= 0; i
< objc
; i
++) {
6354 strRep
= Jim_GetString(objv
[i
], &len
);
6356 switch (quotingType
[i
]) {
6357 case JIM_ELESTR_SIMPLE
:
6358 memcpy(p
, strRep
, len
);
6362 case JIM_ELESTR_BRACE
:
6364 memcpy(p
, strRep
, len
);
6367 realLength
+= len
+ 2;
6369 case JIM_ELESTR_QUOTE
:
6370 if (i
== 0 && strRep
[0] == '#') {
6374 qlen
= BackslashQuoteString(strRep
, len
, p
);
6379 /* Add a separating space */
6380 if (i
+ 1 != objc
) {
6385 *p
= '\0'; /* nul term. */
6386 objPtr
->length
= realLength
;
6388 if (quotingType
!= staticQuoting
) {
6389 Jim_Free(quotingType
);
6393 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6395 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6398 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6400 struct JimParserCtx parser
;
6403 Jim_Obj
*fileNameObj
;
6406 if (objPtr
->typePtr
== &listObjType
) {
6410 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6411 * it also preserves any source location of the dict elements
6412 * which can be very useful
6414 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6415 Jim_Obj
**listObjPtrPtr
;
6419 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6420 for (i
= 0; i
< len
; i
++) {
6421 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6424 /* Now just switch the internal rep */
6425 Jim_FreeIntRep(interp
, objPtr
);
6426 objPtr
->typePtr
= &listObjType
;
6427 objPtr
->internalRep
.listValue
.len
= len
;
6428 objPtr
->internalRep
.listValue
.maxLen
= len
;
6429 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6434 /* Try to preserve information about filename / line number */
6435 if (objPtr
->typePtr
== &sourceObjType
) {
6436 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6437 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6440 fileNameObj
= interp
->emptyObj
;
6443 Jim_IncrRefCount(fileNameObj
);
6445 /* Get the string representation */
6446 str
= Jim_GetString(objPtr
, &strLen
);
6448 /* Free the old internal repr just now and initialize the
6449 * new one just now. The string->list conversion can't fail. */
6450 Jim_FreeIntRep(interp
, objPtr
);
6451 objPtr
->typePtr
= &listObjType
;
6452 objPtr
->internalRep
.listValue
.len
= 0;
6453 objPtr
->internalRep
.listValue
.maxLen
= 0;
6454 objPtr
->internalRep
.listValue
.ele
= NULL
;
6456 /* Convert into a list */
6458 JimParserInit(&parser
, str
, strLen
, linenr
);
6459 while (!parser
.eof
) {
6460 Jim_Obj
*elementPtr
;
6462 JimParseList(&parser
);
6463 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6465 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6466 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6467 ListAppendElement(objPtr
, elementPtr
);
6470 Jim_DecrRefCount(interp
, fileNameObj
);
6474 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6478 objPtr
= Jim_NewObj(interp
);
6479 objPtr
->typePtr
= &listObjType
;
6480 objPtr
->bytes
= NULL
;
6481 objPtr
->internalRep
.listValue
.ele
= NULL
;
6482 objPtr
->internalRep
.listValue
.len
= 0;
6483 objPtr
->internalRep
.listValue
.maxLen
= 0;
6486 ListInsertElements(objPtr
, 0, len
, elements
);
6492 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6493 * length of the vector. Note that the user of this function should make
6494 * sure that the list object can't shimmer while the vector returned
6495 * is in use, this vector is the one stored inside the internal representation
6496 * of the list object. This function is not exported, extensions should
6497 * always access to the List object elements using Jim_ListIndex(). */
6498 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6501 *listLen
= Jim_ListLength(interp
, listObj
);
6502 *listVec
= listObj
->internalRep
.listValue
.ele
;
6505 /* Sorting uses ints, but commands may return wide */
6506 static int JimSign(jim_wide w
)
6517 /* ListSortElements type values */
6533 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6536 static struct lsort_info
*sort_info
;
6538 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6540 Jim_Obj
*lObj
, *rObj
;
6542 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6543 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6544 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6546 return sort_info
->subfn(&lObj
, &rObj
);
6549 /* Sort the internal rep of a list. */
6550 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6552 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6555 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6557 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6560 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6562 jim_wide lhs
= 0, rhs
= 0;
6564 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6565 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6566 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6569 return JimSign(lhs
- rhs
) * sort_info
->order
;
6572 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6574 double lhs
= 0, rhs
= 0;
6576 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6577 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6578 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6584 return sort_info
->order
;
6586 return -sort_info
->order
;
6589 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6591 Jim_Obj
*compare_script
;
6596 /* This must be a valid list */
6597 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6598 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6599 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6601 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6603 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6604 longjmp(sort_info
->jmpbuf
, rc
);
6607 return JimSign(ret
) * sort_info
->order
;
6610 /* Remove duplicate elements from the (sorted) list in-place, according to the
6611 * comparison function, comp.
6613 * Note that the last unique value is kept, not the first
6615 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6619 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6621 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6622 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6623 /* Match, so replace the dest with the current source */
6624 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6627 /* No match, so keep the current source and move to the next destination */
6630 ele
[dst
] = ele
[src
];
6632 /* At end of list, keep the final element */
6633 ele
[++dst
] = ele
[src
];
6635 /* Set the new length */
6636 listObjPtr
->internalRep
.listValue
.len
= dst
;
6639 /* Sort a list *in place*. MUST be called with a non-shared list. */
6640 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6642 struct lsort_info
*prev_info
;
6644 typedef int (qsort_comparator
) (const void *, const void *);
6645 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6650 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6651 SetListFromAny(interp
, listObjPtr
);
6653 /* Allow lsort to be called reentrantly */
6654 prev_info
= sort_info
;
6657 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6658 len
= listObjPtr
->internalRep
.listValue
.len
;
6659 switch (info
->type
) {
6660 case JIM_LSORT_ASCII
:
6661 fn
= ListSortString
;
6663 case JIM_LSORT_NOCASE
:
6664 fn
= ListSortStringNoCase
;
6666 case JIM_LSORT_INTEGER
:
6667 fn
= ListSortInteger
;
6669 case JIM_LSORT_REAL
:
6672 case JIM_LSORT_COMMAND
:
6673 fn
= ListSortCommand
;
6676 fn
= NULL
; /* avoid warning */
6677 JimPanic((1, "ListSort called with invalid sort type"));
6678 return -1; /* Should not be run but keeps static analysers happy */
6681 if (info
->indexed
) {
6682 /* Need to interpose a "list index" function */
6684 fn
= ListSortIndexHelper
;
6687 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6688 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6690 if (info
->unique
&& len
> 1) {
6691 ListRemoveDuplicates(listObjPtr
, fn
);
6694 Jim_InvalidateStringRep(listObjPtr
);
6696 sort_info
= prev_info
;
6701 /* This is the low-level function to insert elements into a list.
6702 * The higher-level Jim_ListInsertElements() performs shared object
6703 * check and invalidates the string repr. This version is used
6704 * in the internals of the List Object and is not exported.
6706 * NOTE: this function can be called only against objects
6707 * with internal type of List.
6709 * An insertion point (idx) of -1 means end-of-list.
6711 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6713 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6714 int requiredLen
= currentLen
+ elemc
;
6718 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6719 if (requiredLen
< 2) {
6720 /* Don't do allocations of under 4 pointers. */
6727 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6728 sizeof(Jim_Obj
*) * requiredLen
);
6730 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6735 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6736 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6737 for (i
= 0; i
< elemc
; ++i
) {
6738 point
[i
] = elemVec
[i
];
6739 Jim_IncrRefCount(point
[i
]);
6741 listPtr
->internalRep
.listValue
.len
+= elemc
;
6744 /* Convenience call to ListInsertElements() to append a single element.
6746 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6748 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6751 /* Appends every element of appendListPtr into listPtr.
6752 * Both have to be of the list type.
6753 * Convenience call to ListInsertElements()
6755 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6757 ListInsertElements(listPtr
, -1,
6758 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6761 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6763 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6764 SetListFromAny(interp
, listPtr
);
6765 Jim_InvalidateStringRep(listPtr
);
6766 ListAppendElement(listPtr
, objPtr
);
6769 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6771 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6772 SetListFromAny(interp
, listPtr
);
6773 SetListFromAny(interp
, appendListPtr
);
6774 Jim_InvalidateStringRep(listPtr
);
6775 ListAppendList(listPtr
, appendListPtr
);
6778 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6780 SetListFromAny(interp
, objPtr
);
6781 return objPtr
->internalRep
.listValue
.len
;
6784 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6785 int objc
, Jim_Obj
*const *objVec
)
6787 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6788 SetListFromAny(interp
, listPtr
);
6789 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6790 idx
= listPtr
->internalRep
.listValue
.len
;
6793 Jim_InvalidateStringRep(listPtr
);
6794 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6797 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6799 SetListFromAny(interp
, listPtr
);
6800 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6801 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6805 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6806 return listPtr
->internalRep
.listValue
.ele
[idx
];
6809 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6811 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6812 if (*objPtrPtr
== NULL
) {
6813 if (flags
& JIM_ERRMSG
) {
6814 Jim_SetResultString(interp
, "list index out of range", -1);
6821 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6822 Jim_Obj
*newObjPtr
, int flags
)
6824 SetListFromAny(interp
, listPtr
);
6825 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6826 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6827 if (flags
& JIM_ERRMSG
) {
6828 Jim_SetResultString(interp
, "list index out of range", -1);
6833 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6834 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6835 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6836 Jim_IncrRefCount(newObjPtr
);
6840 /* Modify the list stored in the variable named 'varNamePtr'
6841 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6842 * with the new element 'newObjptr'. (implements the [lset] command) */
6843 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6844 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6846 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6849 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6852 if ((shared
= Jim_IsShared(objPtr
)))
6853 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6854 for (i
= 0; i
< indexc
- 1; i
++) {
6855 listObjPtr
= objPtr
;
6856 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6858 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6861 if (Jim_IsShared(objPtr
)) {
6862 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6863 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6865 Jim_InvalidateStringRep(listObjPtr
);
6867 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6869 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6871 Jim_InvalidateStringRep(objPtr
);
6872 Jim_InvalidateStringRep(varObjPtr
);
6873 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6875 Jim_SetResult(interp
, varObjPtr
);
6879 Jim_FreeNewObj(interp
, varObjPtr
);
6884 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6887 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6888 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6890 for (i
= 0; i
< listLen
; ) {
6891 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6892 if (++i
!= listLen
) {
6893 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6899 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6903 /* If all the objects in objv are lists,
6904 * it's possible to return a list as result, that's the
6905 * concatenation of all the lists. */
6906 for (i
= 0; i
< objc
; i
++) {
6907 if (!Jim_IsList(objv
[i
]))
6911 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6913 for (i
= 0; i
< objc
; i
++)
6914 ListAppendList(objPtr
, objv
[i
]);
6918 /* Else... we have to glue strings together */
6919 int len
= 0, objLen
;
6922 /* Compute the length */
6923 for (i
= 0; i
< objc
; i
++) {
6924 len
+= Jim_Length(objv
[i
]);
6928 /* Create the string rep, and a string object holding it. */
6929 p
= bytes
= Jim_Alloc(len
+ 1);
6930 for (i
= 0; i
< objc
; i
++) {
6931 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6933 /* Remove leading space */
6934 while (objLen
&& isspace(UCHAR(*s
))) {
6939 /* And trailing space */
6940 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6941 /* Handle trailing backslash-space case */
6942 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6948 memcpy(p
, s
, objLen
);
6950 if (i
+ 1 != objc
) {
6954 /* Drop the space calculated for this
6955 * element that is instead null. */
6961 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6965 /* Returns a list composed of the elements in the specified range.
6966 * first and start are directly accepted as Jim_Objects and
6967 * processed for the end?-index? case. */
6968 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6969 Jim_Obj
*lastObjPtr
)
6974 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6975 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
6977 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
6978 first
= JimRelToAbsIndex(len
, first
);
6979 last
= JimRelToAbsIndex(len
, last
);
6980 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
6981 if (first
== 0 && last
== len
) {
6984 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
6987 /* -----------------------------------------------------------------------------
6989 * ---------------------------------------------------------------------------*/
6990 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6991 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6992 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
6993 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6995 /* Dict HashTable Type.
6997 * Keys and Values are Jim objects. */
6999 static unsigned int JimObjectHTHashFunction(const void *key
)
7002 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
7003 return Jim_GenHashFunction((const unsigned char *)str
, len
);
7006 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
7008 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
7011 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
7013 Jim_IncrRefCount((Jim_Obj
*)val
);
7017 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
7019 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
7022 static const Jim_HashTableType JimDictHashTableType
= {
7023 JimObjectHTHashFunction
, /* hash function */
7024 JimObjectHTKeyValDup
, /* key dup */
7025 JimObjectHTKeyValDup
, /* val dup */
7026 JimObjectHTKeyCompare
, /* key compare */
7027 JimObjectHTKeyValDestructor
, /* key destructor */
7028 JimObjectHTKeyValDestructor
/* val destructor */
7031 /* Note that while the elements of the dict may contain references,
7032 * the list object itself can't. This basically means that the
7033 * dict object string representation as a whole can't contain references
7034 * that are not presents in the single elements. */
7035 static const Jim_ObjType dictObjType
= {
7037 FreeDictInternalRep
,
7043 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7045 JIM_NOTUSED(interp
);
7047 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7048 Jim_Free(objPtr
->internalRep
.ptr
);
7051 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7053 Jim_HashTable
*ht
, *dupHt
;
7054 Jim_HashTableIterator htiter
;
7057 /* Create a new hash table */
7058 ht
= srcPtr
->internalRep
.ptr
;
7059 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7060 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7062 Jim_ExpandHashTable(dupHt
, ht
->size
);
7063 /* Copy every element from the source to the dup hash table */
7064 JimInitHashTableIterator(ht
, &htiter
);
7065 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7066 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7069 dupPtr
->internalRep
.ptr
= dupHt
;
7070 dupPtr
->typePtr
= &dictObjType
;
7073 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7076 Jim_HashTableIterator htiter
;
7081 ht
= dictPtr
->internalRep
.ptr
;
7083 /* Turn the hash table into a flat vector of Jim_Objects. */
7084 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7085 JimInitHashTableIterator(ht
, &htiter
);
7087 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7088 objv
[i
++] = Jim_GetHashEntryKey(he
);
7089 objv
[i
++] = Jim_GetHashEntryVal(he
);
7095 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7097 /* Turn the hash table into a flat vector of Jim_Objects. */
7099 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7101 /* And now generate the string rep as a list */
7102 JimMakeListStringRep(objPtr
, objv
, len
);
7107 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7111 if (objPtr
->typePtr
== &dictObjType
) {
7115 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7116 /* A shared list, so get the string representation now to avoid
7117 * changing the order in case of fast conversion to dict.
7122 /* For simplicity, convert a non-list object to a list and then to a dict */
7123 listlen
= Jim_ListLength(interp
, objPtr
);
7125 Jim_SetResultString(interp
, "missing value to go with key", -1);
7129 /* Converting from a list to a dict can't fail */
7133 ht
= Jim_Alloc(sizeof(*ht
));
7134 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7136 for (i
= 0; i
< listlen
; i
+= 2) {
7137 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7138 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7140 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7143 Jim_FreeIntRep(interp
, objPtr
);
7144 objPtr
->typePtr
= &dictObjType
;
7145 objPtr
->internalRep
.ptr
= ht
;
7151 /* Dict object API */
7153 /* Add an element to a dict. objPtr must be of the "dict" type.
7154 * The higher-level exported function is Jim_DictAddElement().
7155 * If an element with the specified key already exists, the value
7156 * associated is replaced with the new one.
7158 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7159 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7160 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7162 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7164 if (valueObjPtr
== NULL
) { /* unset */
7165 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7167 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7171 /* Add an element, higher-level interface for DictAddElement().
7172 * If valueObjPtr == NULL, the key is removed if it exists. */
7173 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7174 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7176 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7177 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7180 Jim_InvalidateStringRep(objPtr
);
7181 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7184 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7189 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7191 objPtr
= Jim_NewObj(interp
);
7192 objPtr
->typePtr
= &dictObjType
;
7193 objPtr
->bytes
= NULL
;
7194 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7195 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7196 for (i
= 0; i
< len
; i
+= 2)
7197 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7201 /* Return the value associated to the specified dict key
7202 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7204 * Sets *objPtrPtr to non-NULL only upon success.
7206 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7207 Jim_Obj
**objPtrPtr
, int flags
)
7212 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7215 ht
= dictPtr
->internalRep
.ptr
;
7216 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7217 if (flags
& JIM_ERRMSG
) {
7218 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7222 *objPtrPtr
= he
->u
.val
;
7226 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7227 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7229 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7232 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7238 /* Return the value associated to the specified dict keys */
7239 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7240 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7245 *objPtrPtr
= dictPtr
;
7249 for (i
= 0; i
< keyc
; i
++) {
7252 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7258 *objPtrPtr
= dictPtr
;
7262 /* Modify the dict stored into the variable named 'varNamePtr'
7263 * setting the element specified by the 'keyc' keys objects in 'keyv',
7264 * with the new value of the element 'newObjPtr'.
7266 * If newObjPtr == NULL the operation is to remove the given key
7267 * from the dictionary.
7269 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7270 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7272 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7273 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7275 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7278 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7279 if (objPtr
== NULL
) {
7280 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7281 /* Cannot remove a key from non existing var */
7284 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7285 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7286 Jim_FreeNewObj(interp
, varObjPtr
);
7290 if ((shared
= Jim_IsShared(objPtr
)))
7291 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7292 for (i
= 0; i
< keyc
; i
++) {
7293 dictObjPtr
= objPtr
;
7295 /* Check if it's a valid dictionary */
7296 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7300 if (i
== keyc
- 1) {
7301 /* Last key: Note that error on unset with missing last key is OK */
7302 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7303 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7310 /* Check if the given key exists. */
7311 Jim_InvalidateStringRep(dictObjPtr
);
7312 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7313 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7314 /* This key exists at the current level.
7315 * Make sure it's not shared!. */
7316 if (Jim_IsShared(objPtr
)) {
7317 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7318 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7322 /* Key not found. If it's an [unset] operation
7323 * this is an error. Only the last key may not
7325 if (newObjPtr
== NULL
) {
7328 /* Otherwise set an empty dictionary
7329 * as key's value. */
7330 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7331 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7334 /* XXX: Is this necessary? */
7335 Jim_InvalidateStringRep(objPtr
);
7336 Jim_InvalidateStringRep(varObjPtr
);
7337 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7340 Jim_SetResult(interp
, varObjPtr
);
7344 Jim_FreeNewObj(interp
, varObjPtr
);
7349 /* -----------------------------------------------------------------------------
7351 * ---------------------------------------------------------------------------*/
7352 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7353 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7355 static const Jim_ObjType indexObjType
= {
7359 UpdateStringOfIndex
,
7363 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7365 if (objPtr
->internalRep
.intValue
== -1) {
7366 JimSetStringBytes(objPtr
, "end");
7369 char buf
[JIM_INTEGER_SPACE
+ 1];
7370 if (objPtr
->internalRep
.intValue
>= 0) {
7371 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7375 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7377 JimSetStringBytes(objPtr
, buf
);
7381 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7387 /* Get the string representation */
7388 str
= Jim_String(objPtr
);
7390 /* Try to convert into an index */
7391 if (strncmp(str
, "end", 3) == 0) {
7397 idx
= jim_strtol(str
, &endptr
);
7399 if (endptr
== str
) {
7405 /* Now str may include or +<num> or -<num> */
7406 if (*str
== '+' || *str
== '-') {
7407 int sign
= (*str
== '+' ? 1 : -1);
7409 idx
+= sign
* jim_strtol(++str
, &endptr
);
7410 if (str
== endptr
|| *endptr
) {
7415 /* The only thing left should be spaces */
7416 while (isspace(UCHAR(*str
))) {
7427 /* end-1 is repesented as -2 */
7435 /* Free the old internal repr and set the new one. */
7436 Jim_FreeIntRep(interp
, objPtr
);
7437 objPtr
->typePtr
= &indexObjType
;
7438 objPtr
->internalRep
.intValue
= idx
;
7442 Jim_SetResultFormatted(interp
,
7443 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7447 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7449 /* Avoid shimmering if the object is an integer. */
7450 if (objPtr
->typePtr
== &intObjType
) {
7451 jim_wide val
= JimWideValue(objPtr
);
7454 *indexPtr
= -INT_MAX
;
7455 else if (val
> INT_MAX
)
7456 *indexPtr
= INT_MAX
;
7458 *indexPtr
= (int)val
;
7461 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7463 *indexPtr
= objPtr
->internalRep
.intValue
;
7467 /* -----------------------------------------------------------------------------
7468 * Return Code Object.
7469 * ---------------------------------------------------------------------------*/
7471 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7472 static const char * const jimReturnCodes
[] = {
7484 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7486 static const Jim_ObjType returnCodeObjType
= {
7494 /* Converts a (standard) return code to a string. Returns "?" for
7495 * non-standard return codes.
7497 const char *Jim_ReturnCode(int code
)
7499 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7503 return jimReturnCodes
[code
];
7507 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7512 /* Try to convert into an integer */
7513 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7514 returnCode
= (int)wideValue
;
7515 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7516 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7519 /* Free the old internal repr and set the new one. */
7520 Jim_FreeIntRep(interp
, objPtr
);
7521 objPtr
->typePtr
= &returnCodeObjType
;
7522 objPtr
->internalRep
.intValue
= returnCode
;
7526 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7528 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7530 *intPtr
= objPtr
->internalRep
.intValue
;
7534 /* -----------------------------------------------------------------------------
7535 * Expression Parsing
7536 * ---------------------------------------------------------------------------*/
7537 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7538 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7539 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7540 static int JimParseExprBoolean(struct JimParserCtx
*pc
);
7542 /* Exrp's Stack machine operators opcodes. */
7544 /* Binary operators (numbers) */
7547 /* Continues on from the JIM_TT_ space */
7549 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7564 JIM_EXPROP_BITAND
, /* 35 */
7568 /* Note must keep these together */
7569 JIM_EXPROP_LOGICAND
, /* 38 */
7570 JIM_EXPROP_LOGICAND_LEFT
,
7571 JIM_EXPROP_LOGICAND_RIGHT
,
7574 JIM_EXPROP_LOGICOR
, /* 41 */
7575 JIM_EXPROP_LOGICOR_LEFT
,
7576 JIM_EXPROP_LOGICOR_RIGHT
,
7579 /* Ternary operators */
7580 JIM_EXPROP_TERNARY
, /* 44 */
7581 JIM_EXPROP_TERNARY_LEFT
,
7582 JIM_EXPROP_TERNARY_RIGHT
,
7585 JIM_EXPROP_COLON
, /* 47 */
7586 JIM_EXPROP_COLON_LEFT
,
7587 JIM_EXPROP_COLON_RIGHT
,
7589 JIM_EXPROP_POW
, /* 50 */
7591 /* Binary operators (strings) */
7592 JIM_EXPROP_STREQ
, /* 51 */
7597 /* Unary operators (numbers) */
7598 JIM_EXPROP_NOT
, /* 55 */
7600 JIM_EXPROP_UNARYMINUS
,
7601 JIM_EXPROP_UNARYPLUS
,
7604 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7605 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7606 JIM_EXPROP_FUNC_WIDE
,
7607 JIM_EXPROP_FUNC_ABS
,
7608 JIM_EXPROP_FUNC_DOUBLE
,
7609 JIM_EXPROP_FUNC_ROUND
,
7610 JIM_EXPROP_FUNC_RAND
,
7611 JIM_EXPROP_FUNC_SRAND
,
7613 /* math functions from libm */
7614 JIM_EXPROP_FUNC_SIN
, /* 65 */
7615 JIM_EXPROP_FUNC_COS
,
7616 JIM_EXPROP_FUNC_TAN
,
7617 JIM_EXPROP_FUNC_ASIN
,
7618 JIM_EXPROP_FUNC_ACOS
,
7619 JIM_EXPROP_FUNC_ATAN
,
7620 JIM_EXPROP_FUNC_ATAN2
,
7621 JIM_EXPROP_FUNC_SINH
,
7622 JIM_EXPROP_FUNC_COSH
,
7623 JIM_EXPROP_FUNC_TANH
,
7624 JIM_EXPROP_FUNC_CEIL
,
7625 JIM_EXPROP_FUNC_FLOOR
,
7626 JIM_EXPROP_FUNC_EXP
,
7627 JIM_EXPROP_FUNC_LOG
,
7628 JIM_EXPROP_FUNC_LOG10
,
7629 JIM_EXPROP_FUNC_SQRT
,
7630 JIM_EXPROP_FUNC_POW
,
7631 JIM_EXPROP_FUNC_HYPOT
,
7632 JIM_EXPROP_FUNC_FMOD
,
7643 /* Operators table */
7644 typedef struct Jim_ExprOperator
7647 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7648 unsigned char precedence
;
7649 unsigned char arity
;
7651 unsigned char namelen
;
7654 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7656 Jim_IncrRefCount(obj
);
7657 e
->stack
[e
->stacklen
++] = obj
;
7660 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7662 return e
->stack
[--e
->stacklen
];
7665 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7669 Jim_Obj
*A
= ExprPop(e
);
7671 jim_wide wA
, wC
= 0;
7673 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7674 switch (e
->opcode
) {
7675 case JIM_EXPROP_FUNC_INT
:
7676 case JIM_EXPROP_FUNC_WIDE
:
7677 case JIM_EXPROP_FUNC_ROUND
:
7678 case JIM_EXPROP_UNARYPLUS
:
7681 case JIM_EXPROP_FUNC_DOUBLE
:
7685 case JIM_EXPROP_FUNC_ABS
:
7686 wC
= wA
>= 0 ? wA
: -wA
;
7688 case JIM_EXPROP_UNARYMINUS
:
7691 case JIM_EXPROP_NOT
:
7698 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7699 switch (e
->opcode
) {
7700 case JIM_EXPROP_FUNC_INT
:
7701 case JIM_EXPROP_FUNC_WIDE
:
7704 case JIM_EXPROP_FUNC_ROUND
:
7705 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7707 case JIM_EXPROP_FUNC_DOUBLE
:
7708 case JIM_EXPROP_UNARYPLUS
:
7712 case JIM_EXPROP_FUNC_ABS
:
7713 dC
= dA
>= 0 ? dA
: -dA
;
7716 case JIM_EXPROP_UNARYMINUS
:
7720 case JIM_EXPROP_NOT
:
7730 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7733 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7737 Jim_DecrRefCount(interp
, A
);
7742 static double JimRandDouble(Jim_Interp
*interp
)
7745 JimRandomBytes(interp
, &x
, sizeof(x
));
7747 return (double)x
/ (unsigned long)~0;
7750 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7752 Jim_Obj
*A
= ExprPop(e
);
7755 int rc
= Jim_GetWide(interp
, A
, &wA
);
7757 switch (e
->opcode
) {
7758 case JIM_EXPROP_BITNOT
:
7759 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7761 case JIM_EXPROP_FUNC_SRAND
:
7762 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7763 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7770 Jim_DecrRefCount(interp
, A
);
7775 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7777 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7779 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7784 #ifdef JIM_MATH_FUNCTIONS
7785 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7788 Jim_Obj
*A
= ExprPop(e
);
7791 rc
= Jim_GetDouble(interp
, A
, &dA
);
7793 switch (e
->opcode
) {
7794 case JIM_EXPROP_FUNC_SIN
:
7797 case JIM_EXPROP_FUNC_COS
:
7800 case JIM_EXPROP_FUNC_TAN
:
7803 case JIM_EXPROP_FUNC_ASIN
:
7806 case JIM_EXPROP_FUNC_ACOS
:
7809 case JIM_EXPROP_FUNC_ATAN
:
7812 case JIM_EXPROP_FUNC_SINH
:
7815 case JIM_EXPROP_FUNC_COSH
:
7818 case JIM_EXPROP_FUNC_TANH
:
7821 case JIM_EXPROP_FUNC_CEIL
:
7824 case JIM_EXPROP_FUNC_FLOOR
:
7827 case JIM_EXPROP_FUNC_EXP
:
7830 case JIM_EXPROP_FUNC_LOG
:
7833 case JIM_EXPROP_FUNC_LOG10
:
7836 case JIM_EXPROP_FUNC_SQRT
:
7842 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7845 Jim_DecrRefCount(interp
, A
);
7851 /* A binary operation on two ints */
7852 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7854 Jim_Obj
*B
= ExprPop(e
);
7855 Jim_Obj
*A
= ExprPop(e
);
7859 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7864 switch (e
->opcode
) {
7865 case JIM_EXPROP_LSHIFT
:
7868 case JIM_EXPROP_RSHIFT
:
7871 case JIM_EXPROP_BITAND
:
7874 case JIM_EXPROP_BITXOR
:
7877 case JIM_EXPROP_BITOR
:
7880 case JIM_EXPROP_MOD
:
7883 Jim_SetResultString(interp
, "Division by zero", -1);
7890 * This code is tricky: C doesn't guarantee much
7891 * about the quotient or remainder, but Tcl does.
7892 * The remainder always has the same sign as the
7893 * divisor and a smaller absolute value.
7911 case JIM_EXPROP_ROTL
:
7912 case JIM_EXPROP_ROTR
:{
7913 /* uint32_t would be better. But not everyone has inttypes.h? */
7914 unsigned long uA
= (unsigned long)wA
;
7915 unsigned long uB
= (unsigned long)wB
;
7916 const unsigned int S
= sizeof(unsigned long) * 8;
7918 /* Shift left by the word size or more is undefined. */
7921 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7924 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7930 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7934 Jim_DecrRefCount(interp
, A
);
7935 Jim_DecrRefCount(interp
, B
);
7941 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7942 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7945 double dA
, dB
, dC
= 0;
7946 jim_wide wA
, wB
, wC
= 0;
7948 Jim_Obj
*B
= ExprPop(e
);
7949 Jim_Obj
*A
= ExprPop(e
);
7951 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7952 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7953 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7957 switch (e
->opcode
) {
7958 case JIM_EXPROP_POW
:
7959 case JIM_EXPROP_FUNC_POW
:
7960 wC
= JimPowWide(wA
, wB
);
7962 case JIM_EXPROP_ADD
:
7965 case JIM_EXPROP_SUB
:
7968 case JIM_EXPROP_MUL
:
7971 case JIM_EXPROP_DIV
:
7973 Jim_SetResultString(interp
, "Division by zero", -1);
7981 * This code is tricky: C doesn't guarantee much
7982 * about the quotient or remainder, but Tcl does.
7983 * The remainder always has the same sign as the
7984 * divisor and a smaller absolute value.
8002 case JIM_EXPROP_LTE
:
8005 case JIM_EXPROP_GTE
:
8008 case JIM_EXPROP_NUMEQ
:
8011 case JIM_EXPROP_NUMNE
:
8016 if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
8017 switch (e
->opcode
) {
8018 #ifndef JIM_MATH_FUNCTIONS
8019 case JIM_EXPROP_POW
:
8020 case JIM_EXPROP_FUNC_POW
:
8021 case JIM_EXPROP_FUNC_ATAN2
:
8022 case JIM_EXPROP_FUNC_HYPOT
:
8023 case JIM_EXPROP_FUNC_FMOD
:
8024 Jim_SetResultString(interp
, "unsupported", -1);
8028 case JIM_EXPROP_POW
:
8029 case JIM_EXPROP_FUNC_POW
:
8032 case JIM_EXPROP_FUNC_ATAN2
:
8035 case JIM_EXPROP_FUNC_HYPOT
:
8038 case JIM_EXPROP_FUNC_FMOD
:
8042 case JIM_EXPROP_ADD
:
8045 case JIM_EXPROP_SUB
:
8048 case JIM_EXPROP_MUL
:
8051 case JIM_EXPROP_DIV
:
8054 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
8056 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8069 case JIM_EXPROP_LTE
:
8072 case JIM_EXPROP_GTE
:
8075 case JIM_EXPROP_NUMEQ
:
8078 case JIM_EXPROP_NUMNE
:
8084 /* Handle the string case */
8086 /* XXX: Could optimise the eq/ne case by checking lengths */
8087 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8089 switch (e
->opcode
) {
8096 case JIM_EXPROP_LTE
:
8099 case JIM_EXPROP_GTE
:
8102 case JIM_EXPROP_NUMEQ
:
8105 case JIM_EXPROP_NUMNE
:
8110 /* If we get here, it is an error */
8113 Jim_DecrRefCount(interp
, A
);
8114 Jim_DecrRefCount(interp
, B
);
8117 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8120 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8124 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8129 listlen
= Jim_ListLength(interp
, listObjPtr
);
8130 for (i
= 0; i
< listlen
; i
++) {
8131 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8138 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8140 Jim_Obj
*B
= ExprPop(e
);
8141 Jim_Obj
*A
= ExprPop(e
);
8145 switch (e
->opcode
) {
8146 case JIM_EXPROP_STREQ
:
8147 case JIM_EXPROP_STRNE
:
8148 wC
= Jim_StringEqObj(A
, B
);
8149 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8153 case JIM_EXPROP_STRIN
:
8154 wC
= JimSearchList(interp
, B
, A
);
8156 case JIM_EXPROP_STRNI
:
8157 wC
= !JimSearchList(interp
, B
, A
);
8162 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8164 Jim_DecrRefCount(interp
, A
);
8165 Jim_DecrRefCount(interp
, B
);
8170 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8176 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8179 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8182 if (Jim_GetBoolean(interp
, obj
, &b
) == JIM_OK
) {
8188 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8190 Jim_Obj
*skip
= ExprPop(e
);
8191 Jim_Obj
*A
= ExprPop(e
);
8194 switch (ExprBool(interp
, A
)) {
8196 /* false, so skip RHS opcodes with a 0 result */
8197 e
->skip
= JimWideValue(skip
);
8198 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8202 /* true so continue */
8209 Jim_DecrRefCount(interp
, A
);
8210 Jim_DecrRefCount(interp
, skip
);
8215 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8217 Jim_Obj
*skip
= ExprPop(e
);
8218 Jim_Obj
*A
= ExprPop(e
);
8221 switch (ExprBool(interp
, A
)) {
8223 /* false, so do nothing */
8227 /* true so skip RHS opcodes with a 1 result */
8228 e
->skip
= JimWideValue(skip
);
8229 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8237 Jim_DecrRefCount(interp
, A
);
8238 Jim_DecrRefCount(interp
, skip
);
8243 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8245 Jim_Obj
*A
= ExprPop(e
);
8248 switch (ExprBool(interp
, A
)) {
8250 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8254 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8262 Jim_DecrRefCount(interp
, A
);
8267 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8269 Jim_Obj
*skip
= ExprPop(e
);
8270 Jim_Obj
*A
= ExprPop(e
);
8276 switch (ExprBool(interp
, A
)) {
8278 /* false, skip RHS opcodes */
8279 e
->skip
= JimWideValue(skip
);
8280 /* Push a dummy value */
8281 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8285 /* true so do nothing */
8293 Jim_DecrRefCount(interp
, A
);
8294 Jim_DecrRefCount(interp
, skip
);
8299 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8301 Jim_Obj
*skip
= ExprPop(e
);
8302 Jim_Obj
*B
= ExprPop(e
);
8303 Jim_Obj
*A
= ExprPop(e
);
8305 /* No need to check for A as non-boolean */
8306 if (ExprBool(interp
, A
)) {
8307 /* true, so skip RHS opcodes */
8308 e
->skip
= JimWideValue(skip
);
8309 /* Repush B as the answer */
8313 Jim_DecrRefCount(interp
, skip
);
8314 Jim_DecrRefCount(interp
, A
);
8315 Jim_DecrRefCount(interp
, B
);
8319 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8332 /* name - precedence - arity - opcode
8334 * This array *must* be kept in sync with the JIM_EXPROP enum.
8336 * The following macros pre-compute the string length at compile time.
8338 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8339 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8341 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8342 OPRINIT("*", 110, 2, JimExprOpBin
),
8343 OPRINIT("/", 110, 2, JimExprOpBin
),
8344 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8346 OPRINIT("-", 100, 2, JimExprOpBin
),
8347 OPRINIT("+", 100, 2, JimExprOpBin
),
8349 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8350 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8352 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8353 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8355 OPRINIT("<", 80, 2, JimExprOpBin
),
8356 OPRINIT(">", 80, 2, JimExprOpBin
),
8357 OPRINIT("<=", 80, 2, JimExprOpBin
),
8358 OPRINIT(">=", 80, 2, JimExprOpBin
),
8360 OPRINIT("==", 70, 2, JimExprOpBin
),
8361 OPRINIT("!=", 70, 2, JimExprOpBin
),
8363 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8364 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8365 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8367 OPRINIT_LAZY("&&", 10, 2, NULL
, LAZY_OP
),
8368 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8369 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8371 OPRINIT_LAZY("||", 9, 2, NULL
, LAZY_OP
),
8372 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8373 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8375 OPRINIT_LAZY("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8376 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8377 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8379 OPRINIT_LAZY(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8380 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8381 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8383 OPRINIT("**", 250, 2, JimExprOpBin
),
8385 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8386 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8388 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8389 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8391 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8392 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8393 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8394 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8398 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8399 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8400 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8401 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8402 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8403 OPRINIT("rand", 200, 0, JimExprOpNone
),
8404 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8406 #ifdef JIM_MATH_FUNCTIONS
8407 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8408 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8409 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8410 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8411 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8412 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8413 OPRINIT("atan2", 200, 2, JimExprOpBin
),
8414 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8415 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8416 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8417 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8418 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8419 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8420 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8421 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8422 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8423 OPRINIT("pow", 200, 2, JimExprOpBin
),
8424 OPRINIT("hypot", 200, 2, JimExprOpBin
),
8425 OPRINIT("fmod", 200, 2, JimExprOpBin
),
8431 #define JIM_EXPR_OPERATORS_NUM \
8432 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8434 static int JimParseExpression(struct JimParserCtx
*pc
)
8436 /* Discard spaces and quoted newline */
8437 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8438 if (*pc
->p
== '\n') {
8446 pc
->tline
= pc
->linenr
;
8451 pc
->tt
= JIM_TT_EOL
;
8457 pc
->tt
= JIM_TT_SUBEXPR_START
;
8460 pc
->tt
= JIM_TT_SUBEXPR_END
;
8463 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8470 return JimParseCmd(pc
);
8472 if (JimParseVar(pc
) == JIM_ERR
)
8473 return JimParseExprOperator(pc
);
8475 /* Don't allow expr sugar in expressions */
8476 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8493 return JimParseExprNumber(pc
);
8495 return JimParseQuote(pc
);
8497 return JimParseBrace(pc
);
8503 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8504 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8505 return JimParseExprOperator(pc
);
8511 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8512 return JimParseExprOperator(pc
);
8515 return JimParseExprOperator(pc
);
8521 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8525 /* Assume an integer for now */
8526 pc
->tt
= JIM_TT_EXPR_INT
;
8528 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8529 /* Tried as an integer, but perhaps it parses as a double */
8530 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8531 /* Some stupid compilers insist they are cleverer that
8532 * we are. Even a (void) cast doesn't prevent this warning!
8534 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8535 if (end
== pc
->tstart
)
8538 /* Yes, double captured more chars */
8539 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8543 pc
->tend
= pc
->p
- 1;
8544 pc
->len
-= (pc
->p
- pc
->tstart
);
8548 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8550 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8553 for (i
= 0; irrationals
[i
]; i
++) {
8554 const char *irr
= irrationals
[i
];
8556 if (strncmp(irr
, pc
->p
, 3) == 0) {
8559 pc
->tend
= pc
->p
- 1;
8560 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8567 static int JimParseExprBoolean(struct JimParserCtx
*pc
)
8569 const char *booleans
[] = { "false", "no", "off", "true", "yes", "on", NULL
};
8570 const int lengths
[] = { 5, 2, 3, 4, 3, 2, 0 };
8573 for (i
= 0; booleans
[i
]; i
++) {
8574 const char *boolean
= booleans
[i
];
8575 int length
= lengths
[i
];
8577 if (strncmp(boolean
, pc
->p
, length
) == 0) {
8580 pc
->tend
= pc
->p
- 1;
8581 pc
->tt
= JIM_TT_EXPR_BOOLEAN
;
8588 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8591 int bestIdx
= -1, bestLen
= 0;
8593 /* Try to get the longest match. */
8594 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8595 const char * const opname
= Jim_ExprOperators
[i
].name
;
8596 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8598 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8602 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8603 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8607 if (bestIdx
== -1) {
8611 /* Validate paretheses around function arguments */
8612 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8613 const char *p
= pc
->p
+ bestLen
;
8614 int len
= pc
->len
- bestLen
;
8616 while (len
&& isspace(UCHAR(*p
))) {
8624 pc
->tend
= pc
->p
+ bestLen
- 1;
8632 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8634 static Jim_ExprOperator dummy_op
;
8635 if (opcode
< JIM_TT_EXPR_OP
) {
8638 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8641 const char *jim_tt_name(int type
)
8643 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8644 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8645 "DBL", "BOO", "$()" };
8646 if (type
< JIM_TT_EXPR_OP
) {
8647 return tt_names
[type
];
8650 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8651 static char buf
[20];
8656 sprintf(buf
, "(%d)", type
);
8661 /* -----------------------------------------------------------------------------
8663 * ---------------------------------------------------------------------------*/
8664 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8665 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8666 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8668 static const Jim_ObjType exprObjType
= {
8670 FreeExprInternalRep
,
8673 JIM_TYPE_REFERENCES
,
8676 /* Expr bytecode structure */
8677 typedef struct ExprByteCode
8679 ScriptToken
*token
; /* Tokens array. */
8680 int len
; /* Length as number of tokens. */
8681 int inUse
; /* Used for sharing. */
8684 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8688 for (i
= 0; i
< expr
->len
; i
++) {
8689 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8691 Jim_Free(expr
->token
);
8695 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8697 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8700 if (--expr
->inUse
!= 0) {
8704 ExprFreeByteCode(interp
, expr
);
8708 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8710 JIM_NOTUSED(interp
);
8711 JIM_NOTUSED(srcPtr
);
8713 /* Just returns an simple string. */
8714 dupPtr
->typePtr
= NULL
;
8717 /* Check if an expr program looks correct. */
8718 static int ExprCheckCorrectness(ExprByteCode
* expr
)
8724 /* Try to check if there are stack underflows,
8725 * and make sure at the end of the program there is
8726 * a single result on the stack. */
8727 for (i
= 0; i
< expr
->len
; i
++) {
8728 ScriptToken
*t
= &expr
->token
[i
];
8729 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8731 stacklen
-= op
->arity
;
8735 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8738 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8742 /* All operations and operands add one to the stack */
8745 if (stacklen
!= 1 || ternary
!= 0) {
8751 /* This procedure converts every occurrence of || and && opereators
8752 * in lazy unary versions.
8754 * a b || is converted into:
8756 * a <offset> |L b |R
8758 * a b && is converted into:
8760 * a <offset> &L b &R
8762 * "|L" checks if 'a' is true:
8763 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8764 * the opcode just after |R.
8765 * 2) if it is false does nothing.
8766 * "|R" checks if 'b' is true:
8767 * 1) if it is true pushes 1, otherwise pushes 0.
8769 * "&L" checks if 'a' is true:
8770 * 1) if it is true does nothing.
8771 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8772 * the opcode just after &R
8773 * "&R" checks if 'a' is true:
8774 * if it is true pushes 1, otherwise pushes 0.
8776 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8780 int leftindex
, arity
, offset
;
8782 /* Search for the end of the first operator */
8783 leftindex
= expr
->len
- 1;
8787 ScriptToken
*tt
= &expr
->token
[leftindex
];
8789 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8790 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8793 if (--leftindex
< 0) {
8800 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8801 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8803 offset
= (expr
->len
- leftindex
) - 1;
8805 /* Now we rely on the fact that the left and right version have opcodes
8806 * 1 and 2 after the main opcode respectively
8808 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8809 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8811 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8812 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8814 /* Now add the 'R' operator */
8815 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8816 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8819 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8820 for (i
= leftindex
- 1; i
> 0; i
--) {
8821 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8822 if (op
->lazy
== LAZY_LEFT
) {
8823 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8824 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8831 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8833 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8834 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8836 if (op
->lazy
== LAZY_OP
) {
8837 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8838 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8843 token
->objPtr
= interp
->emptyObj
;
8844 token
->type
= t
->type
;
8851 * Returns the index of the COLON_LEFT to the left of 'right_index'
8852 * taking into account nesting.
8854 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8856 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8858 int ternary_count
= 1;
8862 while (right_index
> 1) {
8863 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8866 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8869 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8880 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8882 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8883 * Otherwise returns 0.
8885 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8887 int i
= right_index
- 1;
8888 int ternary_count
= 1;
8891 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8892 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8893 *prev_right_index
= i
- 2;
8894 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8898 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8899 if (ternary_count
== 0) {
8910 * ExprTernaryReorderExpression description
8911 * ========================================
8913 * ?: is right-to-left associative which doesn't work with the stack-based
8914 * expression engine. The fix is to reorder the bytecode.
8920 * Has initial bytecode:
8922 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8923 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8925 * The fix involves simulating this expression instead:
8929 * With the following bytecode:
8931 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8932 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8934 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8935 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8936 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8937 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8939 * ExprTernaryReorderExpression works thus as follows :
8940 * - start from the end of the stack
8941 * - while walking towards the beginning of the stack
8942 * if token=JIM_EXPROP_COLON_RIGHT then
8943 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8944 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8945 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8947 * perform the rotation
8948 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8952 * Note: care has to be taken for nested ternary constructs!!!
8954 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
8958 for (i
= expr
->len
- 1; i
> 1; i
--) {
8959 int prev_right_index
;
8960 int prev_left_index
;
8964 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
8968 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8969 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
8974 ** rotate tokens down
8976 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8985 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8987 tmp
= expr
->token
[prev_right_index
];
8988 for (j
= prev_right_index
; j
< i
; j
++) {
8989 expr
->token
[j
] = expr
->token
[j
+ 1];
8991 expr
->token
[i
] = tmp
;
8993 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8995 * This is 'colon left increment' = i - prev_right_index
8997 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8998 * [prev_left_index-1] : skip_count
9001 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
9003 /* Adjust for i-- in the loop */
9008 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*fileNameObj
)
9014 int prevtt
= JIM_TT_NONE
;
9015 int have_ternary
= 0;
9018 int count
= tokenlist
->count
- 1;
9020 expr
= Jim_Alloc(sizeof(*expr
));
9024 Jim_InitStack(&stack
);
9026 /* Need extra bytecodes for lazy operators.
9027 * Also check for the ternary operator
9029 for (i
= 0; i
< tokenlist
->count
; i
++) {
9030 ParseToken
*t
= &tokenlist
->list
[i
];
9031 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
9033 if (op
->lazy
== LAZY_OP
) {
9035 /* Ternary is a lazy op but also needs reordering */
9036 if (t
->type
== JIM_EXPROP_TERNARY
) {
9042 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
9044 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
9045 ParseToken
*t
= &tokenlist
->list
[i
];
9047 /* Next token will be stored here */
9048 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
9050 if (t
->type
== JIM_TT_EOL
) {
9058 case JIM_TT_DICTSUGAR
:
9059 case JIM_TT_EXPRSUGAR
:
9061 case JIM_TT_EXPR_BOOLEAN
:
9062 token
->type
= t
->type
;
9064 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
9065 if (t
->type
== JIM_TT_CMD
) {
9066 /* Only commands need source info */
9067 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
9072 case JIM_TT_EXPR_INT
:
9073 case JIM_TT_EXPR_DOUBLE
:
9076 if (t
->type
== JIM_TT_EXPR_INT
) {
9077 token
->objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
9080 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9082 if (endptr
!= t
->token
+ t
->len
) {
9083 /* Conversion failed, so just store it as a string */
9084 Jim_FreeNewObj(interp
, token
->objPtr
);
9085 token
->type
= JIM_TT_STR
;
9088 token
->type
= t
->type
;
9093 case JIM_TT_SUBEXPR_START
:
9094 Jim_StackPush(&stack
, t
);
9095 prevtt
= JIM_TT_NONE
;
9098 case JIM_TT_SUBEXPR_COMMA
:
9099 /* Simple approach. Comma is simply ignored */
9102 case JIM_TT_SUBEXPR_END
:
9104 while (Jim_StackLen(&stack
)) {
9105 ParseToken
*tt
= Jim_StackPop(&stack
);
9107 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9112 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9117 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
9124 /* Must be an operator */
9125 const struct Jim_ExprOperator
*op
;
9128 /* Convert -/+ to unary minus or unary plus if necessary */
9129 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
9130 if (t
->type
== JIM_EXPROP_SUB
) {
9131 t
->type
= JIM_EXPROP_UNARYMINUS
;
9133 else if (t
->type
== JIM_EXPROP_ADD
) {
9134 t
->type
= JIM_EXPROP_UNARYPLUS
;
9138 op
= JimExprOperatorInfoByOpcode(t
->type
);
9140 /* Now handle precedence */
9141 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9142 const struct Jim_ExprOperator
*tt_op
=
9143 JimExprOperatorInfoByOpcode(tt
->type
);
9145 /* Note that right-to-left associativity of ?: operator is handled later */
9147 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9148 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9152 Jim_StackPop(&stack
);
9158 Jim_StackPush(&stack
, t
);
9165 /* Reduce any remaining subexpr */
9166 while (Jim_StackLen(&stack
)) {
9167 ParseToken
*tt
= Jim_StackPop(&stack
);
9169 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9171 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9174 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9181 ExprTernaryReorderExpression(interp
, expr
);
9185 /* Free the stack used for the compilation. */
9186 Jim_FreeStack(&stack
);
9188 for (i
= 0; i
< expr
->len
; i
++) {
9189 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9193 ExprFreeByteCode(interp
, expr
);
9201 /* This method takes the string representation of an expression
9202 * and generates a program for the Expr's stack-based VM. */
9203 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9206 const char *exprText
;
9207 struct JimParserCtx parser
;
9208 struct ExprByteCode
*expr
;
9209 ParseTokenList tokenlist
;
9211 Jim_Obj
*fileNameObj
;
9214 /* Try to get information about filename / line number */
9215 if (objPtr
->typePtr
== &sourceObjType
) {
9216 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9217 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9220 fileNameObj
= interp
->emptyObj
;
9223 Jim_IncrRefCount(fileNameObj
);
9225 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9227 /* Initially tokenise the expression into tokenlist */
9228 ScriptTokenListInit(&tokenlist
);
9230 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9231 while (!parser
.eof
) {
9232 if (JimParseExpression(&parser
) != JIM_OK
) {
9233 ScriptTokenListFree(&tokenlist
);
9235 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9240 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9244 #ifdef DEBUG_SHOW_EXPR_TOKENS
9247 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9248 for (i
= 0; i
< tokenlist
.count
; i
++) {
9249 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9250 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9255 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9256 ScriptTokenListFree(&tokenlist
);
9257 Jim_DecrRefCount(interp
, fileNameObj
);
9261 /* Now create the expression bytecode from the tokenlist */
9262 expr
= ExprCreateByteCode(interp
, &tokenlist
, fileNameObj
);
9264 /* No longer need the token list */
9265 ScriptTokenListFree(&tokenlist
);
9271 #ifdef DEBUG_SHOW_EXPR
9275 printf("==== Expr ====\n");
9276 for (i
= 0; i
< expr
->len
; i
++) {
9277 ScriptToken
*t
= &expr
->token
[i
];
9279 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9284 /* Check program correctness. */
9285 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
9286 ExprFreeByteCode(interp
, expr
);
9293 /* Free the old internal rep and set the new one. */
9294 Jim_DecrRefCount(interp
, fileNameObj
);
9295 Jim_FreeIntRep(interp
, objPtr
);
9296 Jim_SetIntRepPtr(objPtr
, expr
);
9297 objPtr
->typePtr
= &exprObjType
;
9301 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9303 if (objPtr
->typePtr
!= &exprObjType
) {
9304 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9308 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9311 #ifdef JIM_OPTIMIZATION
9312 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9314 if (token
->type
== JIM_TT_EXPR_INT
)
9315 return token
->objPtr
;
9316 else if (token
->type
== JIM_TT_VAR
)
9317 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9318 else if (token
->type
== JIM_TT_DICTSUGAR
)
9319 return JimExpandDictSugar(interp
, token
->objPtr
);
9325 /* -----------------------------------------------------------------------------
9326 * Expressions evaluation.
9327 * Jim uses a specialized stack-based virtual machine for expressions,
9328 * that takes advantage of the fact that expr's operators
9329 * can't be redefined.
9331 * Jim_EvalExpression() uses the bytecode compiled by
9332 * SetExprFromAny() method of the "expression" object.
9334 * On success a Tcl Object containing the result of the evaluation
9335 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9337 * On error the function returns a retcode != to JIM_OK and set a suitable
9338 * error on the interp.
9339 * ---------------------------------------------------------------------------*/
9340 #define JIM_EE_STATICSTACK_LEN 10
9342 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9345 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9347 int retcode
= JIM_OK
;
9348 struct JimExprState e
;
9350 expr
= JimGetExpression(interp
, exprObjPtr
);
9352 return JIM_ERR
; /* error in expression. */
9355 #ifdef JIM_OPTIMIZATION
9356 /* Check for one of the following common expressions used by while/for
9361 * $a < CONST, $a < $b
9362 * $a <= CONST, $a <= $b
9363 * $a > CONST, $a > $b
9364 * $a >= CONST, $a >= $b
9365 * $a != CONST, $a != $b
9366 * $a == CONST, $a == $b
9371 /* STEP 1 -- Check if there are the conditions to run the specialized
9372 * version of while */
9374 switch (expr
->len
) {
9376 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9378 Jim_IncrRefCount(objPtr
);
9379 *exprResultPtrPtr
= objPtr
;
9385 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9386 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9388 if (objPtr
&& JimIsWide(objPtr
)) {
9389 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9390 Jim_IncrRefCount(*exprResultPtrPtr
);
9397 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9398 if (objPtr
&& JimIsWide(objPtr
)) {
9399 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9400 if (objPtr2
&& JimIsWide(objPtr2
)) {
9401 jim_wide wideValueA
= JimWideValue(objPtr
);
9402 jim_wide wideValueB
= JimWideValue(objPtr2
);
9404 switch (expr
->token
[2].type
) {
9406 cmpRes
= wideValueA
< wideValueB
;
9408 case JIM_EXPROP_LTE
:
9409 cmpRes
= wideValueA
<= wideValueB
;
9412 cmpRes
= wideValueA
> wideValueB
;
9414 case JIM_EXPROP_GTE
:
9415 cmpRes
= wideValueA
>= wideValueB
;
9417 case JIM_EXPROP_NUMEQ
:
9418 cmpRes
= wideValueA
== wideValueB
;
9420 case JIM_EXPROP_NUMNE
:
9421 cmpRes
= wideValueA
!= wideValueB
;
9426 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9427 Jim_IncrRefCount(*exprResultPtrPtr
);
9437 /* In order to avoid that the internal repr gets freed due to
9438 * shimmering of the exprObjPtr's object, we make the internal rep
9442 /* The stack-based expr VM itself */
9444 /* Stack allocation. Expr programs have the feature that
9445 * a program of length N can't require a stack longer than
9447 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9448 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9450 e
.stack
= staticStack
;
9454 /* Execute every instruction */
9455 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9458 switch (expr
->token
[i
].type
) {
9459 case JIM_TT_EXPR_INT
:
9460 case JIM_TT_EXPR_DOUBLE
:
9461 case JIM_TT_EXPR_BOOLEAN
:
9463 ExprPush(&e
, expr
->token
[i
].objPtr
);
9467 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9469 ExprPush(&e
, objPtr
);
9476 case JIM_TT_DICTSUGAR
:
9477 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9479 ExprPush(&e
, objPtr
);
9487 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9488 if (retcode
== JIM_OK
) {
9489 ExprPush(&e
, objPtr
);
9494 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9495 if (retcode
== JIM_OK
) {
9496 ExprPush(&e
, Jim_GetResult(interp
));
9501 /* Find and execute the operation */
9503 e
.opcode
= expr
->token
[i
].type
;
9505 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9506 /* Skip some opcodes if necessary */
9515 if (retcode
== JIM_OK
) {
9516 *exprResultPtrPtr
= ExprPop(&e
);
9519 for (i
= 0; i
< e
.stacklen
; i
++) {
9520 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9523 if (e
.stack
!= staticStack
) {
9529 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9535 Jim_Obj
*exprResultPtr
;
9537 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9538 if (retcode
!= JIM_OK
)
9541 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9542 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9543 if (Jim_GetBoolean(interp
, exprResultPtr
, &booleanValue
) != JIM_OK
) {
9544 Jim_DecrRefCount(interp
, exprResultPtr
);
9547 Jim_DecrRefCount(interp
, exprResultPtr
);
9548 *boolPtr
= booleanValue
;
9553 Jim_DecrRefCount(interp
, exprResultPtr
);
9554 *boolPtr
= doubleValue
!= 0;
9558 *boolPtr
= wideValue
!= 0;
9560 Jim_DecrRefCount(interp
, exprResultPtr
);
9564 /* -----------------------------------------------------------------------------
9565 * ScanFormat String Object
9566 * ---------------------------------------------------------------------------*/
9568 /* This Jim_Obj will held a parsed representation of a format string passed to
9569 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9570 * to be parsed in its entirely first and then, if correct, can be used for
9571 * scanning. To avoid endless re-parsing, the parsed representation will be
9572 * stored in an internal representation and re-used for performance reason. */
9574 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9575 * scanformat string. This part will later be used to extract information
9576 * out from the string to be parsed by Jim_ScanString */
9578 typedef struct ScanFmtPartDescr
9580 char *arg
; /* Specification of a CHARSET conversion */
9581 char *prefix
; /* Prefix to be scanned literally before conversion */
9582 size_t width
; /* Maximal width of input to be converted */
9583 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9584 char type
; /* Type of conversion (e.g. c, d, f) */
9585 char modifier
; /* Modify type (e.g. l - long, h - short */
9588 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9589 * string parsed and separated in part descriptions. Furthermore it contains
9590 * the original string representation of the scanformat string to allow for
9591 * fast update of the Jim_Obj's string representation part.
9593 * As an add-on the internal object representation adds some scratch pad area
9594 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9595 * memory for purpose of string scanning.
9597 * The error member points to a static allocated string in case of a mal-
9598 * formed scanformat string or it contains '0' (NULL) in case of a valid
9599 * parse representation.
9601 * The whole memory of the internal representation is allocated as a single
9602 * area of memory that will be internally separated. So freeing and duplicating
9603 * of such an object is cheap */
9605 typedef struct ScanFmtStringObj
9607 jim_wide size
; /* Size of internal repr in bytes */
9608 char *stringRep
; /* Original string representation */
9609 size_t count
; /* Number of ScanFmtPartDescr contained */
9610 size_t convCount
; /* Number of conversions that will assign */
9611 size_t maxPos
; /* Max position index if XPG3 is used */
9612 const char *error
; /* Ptr to error text (NULL if no error */
9613 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9614 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9618 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9619 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9620 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9622 static const Jim_ObjType scanFmtStringObjType
= {
9624 FreeScanFmtInternalRep
,
9625 DupScanFmtInternalRep
,
9626 UpdateStringOfScanFmt
,
9630 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9632 JIM_NOTUSED(interp
);
9633 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9634 objPtr
->internalRep
.ptr
= 0;
9637 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9639 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9640 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9642 JIM_NOTUSED(interp
);
9643 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9644 dupPtr
->internalRep
.ptr
= newVec
;
9645 dupPtr
->typePtr
= &scanFmtStringObjType
;
9648 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9650 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9653 /* SetScanFmtFromAny will parse a given string and create the internal
9654 * representation of the format specification. In case of an error
9655 * the error data member of the internal representation will be set
9656 * to an descriptive error text and the function will be left with
9657 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9660 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9662 ScanFmtStringObj
*fmtObj
;
9664 int maxCount
, i
, approxSize
, lastPos
= -1;
9665 const char *fmt
= objPtr
->bytes
;
9666 int maxFmtLen
= objPtr
->length
;
9667 const char *fmtEnd
= fmt
+ maxFmtLen
;
9670 Jim_FreeIntRep(interp
, objPtr
);
9671 /* Count how many conversions could take place maximally */
9672 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9675 /* Calculate an approximation of the memory necessary */
9676 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9677 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9678 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9679 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9680 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9681 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9682 +1; /* safety byte */
9683 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9684 memset(fmtObj
, 0, approxSize
);
9685 fmtObj
->size
= approxSize
;
9687 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9688 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9689 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9690 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9691 objPtr
->internalRep
.ptr
= fmtObj
;
9692 objPtr
->typePtr
= &scanFmtStringObjType
;
9693 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9694 int width
= 0, skip
;
9695 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9698 descr
->width
= 0; /* Assume width unspecified */
9699 /* Overread and store any "literal" prefix */
9700 if (*fmt
!= '%' || fmt
[1] == '%') {
9702 descr
->prefix
= &buffer
[i
];
9703 for (; fmt
< fmtEnd
; ++fmt
) {
9713 /* Skip the conversion introducing '%' sign */
9715 /* End reached due to non-conversion literal only? */
9718 descr
->pos
= 0; /* Assume "natural" positioning */
9720 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9724 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9725 /* Check if next token is a number (could be width or pos */
9726 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9728 /* Was the number a XPG3 position specifier? */
9729 if (descr
->pos
!= -1 && *fmt
== '$') {
9735 /* Look if "natural" postioning and XPG3 one was mixed */
9736 if ((lastPos
== 0 && descr
->pos
> 0)
9737 || (lastPos
> 0 && descr
->pos
== 0)) {
9738 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9741 /* Look if this position was already used */
9742 for (prev
= 0; prev
< curr
; ++prev
) {
9743 if (fmtObj
->descr
[prev
].pos
== -1)
9745 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9747 "variable is assigned by multiple \"%n$\" conversion specifiers";
9751 /* Try to find a width after the XPG3 specifier */
9752 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9753 descr
->width
= width
;
9756 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9757 fmtObj
->maxPos
= descr
->pos
;
9760 /* Number was not a XPG3, so it has to be a width */
9761 descr
->width
= width
;
9764 /* If positioning mode was undetermined yet, fix this */
9766 lastPos
= descr
->pos
;
9767 /* Handle CHARSET conversion type ... */
9769 int swapped
= 1, beg
= i
, end
, j
;
9772 descr
->arg
= &buffer
[i
];
9775 buffer
[i
++] = *fmt
++;
9777 buffer
[i
++] = *fmt
++;
9778 while (*fmt
&& *fmt
!= ']')
9779 buffer
[i
++] = *fmt
++;
9781 fmtObj
->error
= "unmatched [ in format string";
9786 /* In case a range fence was given "backwards", swap it */
9789 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9790 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9791 char tmp
= buffer
[j
- 1];
9793 buffer
[j
- 1] = buffer
[j
+ 1];
9794 buffer
[j
+ 1] = tmp
;
9801 /* Remember any valid modifier if given */
9802 if (strchr("hlL", *fmt
) != 0)
9803 descr
->modifier
= tolower((int)*fmt
++);
9806 if (strchr("efgcsndoxui", *fmt
) == 0) {
9807 fmtObj
->error
= "bad scan conversion character";
9810 else if (*fmt
== 'c' && descr
->width
!= 0) {
9811 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9814 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9815 fmtObj
->error
= "unsigned wide not supported";
9825 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9827 #define FormatGetCnvCount(_fo_) \
9828 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9829 #define FormatGetMaxPos(_fo_) \
9830 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9831 #define FormatGetError(_fo_) \
9832 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9834 /* JimScanAString is used to scan an unspecified string that ends with
9835 * next WS, or a string that is specified via a charset.
9838 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9840 char *buffer
= Jim_StrDup(str
);
9847 if (!sdescr
&& isspace(UCHAR(*str
)))
9848 break; /* EOS via WS if unspecified */
9850 n
= utf8_tounicode(str
, &c
);
9851 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9857 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9860 /* ScanOneEntry will scan one entry out of the string passed as argument.
9861 * It use the sscanf() function for this task. After extracting and
9862 * converting of the value, the count of scanned characters will be
9863 * returned of -1 in case of no conversion tool place and string was
9864 * already scanned thru */
9866 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9867 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9870 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9872 size_t anchor
= pos
;
9874 Jim_Obj
*tmpObj
= NULL
;
9876 /* First pessimistically assume, we will not scan anything :-) */
9878 if (descr
->prefix
) {
9879 /* There was a prefix given before the conversion, skip it and adjust
9880 * the string-to-be-parsed accordingly */
9881 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9882 /* If prefix require, skip WS */
9883 if (isspace(UCHAR(descr
->prefix
[i
])))
9884 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9886 else if (descr
->prefix
[i
] != str
[pos
])
9887 break; /* Prefix do not match here, leave the loop */
9889 ++pos
; /* Prefix matched so far, next round */
9891 if (pos
>= strLen
) {
9892 return -1; /* All of str consumed: EOF condition */
9894 else if (descr
->prefix
[i
] != 0)
9895 return 0; /* Not whole prefix consumed, no conversion possible */
9897 /* For all but following conversion, skip leading WS */
9898 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9899 while (isspace(UCHAR(str
[pos
])))
9901 /* Determine how much skipped/scanned so far */
9902 scanned
= pos
- anchor
;
9904 /* %c is a special, simple case. no width */
9905 if (descr
->type
== 'n') {
9906 /* Return pseudo conversion means: how much scanned so far? */
9907 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9909 else if (pos
>= strLen
) {
9910 /* Cannot scan anything, as str is totally consumed */
9913 else if (descr
->type
== 'c') {
9915 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9916 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9920 /* Processing of conversions follows ... */
9921 if (descr
->width
> 0) {
9922 /* Do not try to scan as fas as possible but only the given width.
9923 * To ensure this, we copy the part that should be scanned. */
9924 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9925 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9927 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9928 tok
= tmpObj
->bytes
;
9931 /* As no width was given, simply refer to the original string */
9934 switch (descr
->type
) {
9940 char *endp
; /* Position where the number finished */
9943 int base
= descr
->type
== 'o' ? 8
9944 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
9946 /* Try to scan a number with the given base */
9948 w
= jim_strtoull(tok
, &endp
);
9951 w
= strtoull(tok
, &endp
, base
);
9955 /* There was some number sucessfully scanned! */
9956 *valObjPtr
= Jim_NewIntObj(interp
, w
);
9958 /* Adjust the number-of-chars scanned so far */
9959 scanned
+= endp
- tok
;
9962 /* Nothing was scanned. We have to determine if this
9963 * happened due to e.g. prefix mismatch or input str
9965 scanned
= *tok
? 0 : -1;
9971 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
9972 scanned
+= Jim_Length(*valObjPtr
);
9979 double value
= strtod(tok
, &endp
);
9982 /* There was some number sucessfully scanned! */
9983 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
9984 /* Adjust the number-of-chars scanned so far */
9985 scanned
+= endp
- tok
;
9988 /* Nothing was scanned. We have to determine if this
9989 * happened due to e.g. prefix mismatch or input str
9991 scanned
= *tok
? 0 : -1;
9996 /* If a substring was allocated (due to pre-defined width) do not
9997 * forget to free it */
9999 Jim_FreeNewObj(interp
, tmpObj
);
10005 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10006 * string and returns all converted (and not ignored) values in a list back
10007 * to the caller. If an error occured, a NULL pointer will be returned */
10009 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
10013 const char *str
= Jim_String(strObjPtr
);
10014 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
10015 Jim_Obj
*resultList
= 0;
10016 Jim_Obj
**resultVec
= 0;
10018 Jim_Obj
*emptyStr
= 0;
10019 ScanFmtStringObj
*fmtObj
;
10021 /* This should never happen. The format object should already be of the correct type */
10022 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
10024 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
10025 /* Check if format specification was valid */
10026 if (fmtObj
->error
!= 0) {
10027 if (flags
& JIM_ERRMSG
)
10028 Jim_SetResultString(interp
, fmtObj
->error
, -1);
10031 /* Allocate a new "shared" empty string for all unassigned conversions */
10032 emptyStr
= Jim_NewEmptyStringObj(interp
);
10033 Jim_IncrRefCount(emptyStr
);
10034 /* Create a list and fill it with empty strings up to max specified XPG3 */
10035 resultList
= Jim_NewListObj(interp
, NULL
, 0);
10036 if (fmtObj
->maxPos
> 0) {
10037 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
10038 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
10039 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
10041 /* Now handle every partial format description */
10042 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
10043 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
10044 Jim_Obj
*value
= 0;
10046 /* Only last type may be "literal" w/o conversion - skip it! */
10047 if (descr
->type
== 0)
10049 /* As long as any conversion could be done, we will proceed */
10051 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
10052 /* In case our first try results in EOF, we will leave */
10053 if (scanned
== -1 && i
== 0)
10055 /* Advance next pos-to-be-scanned for the amount scanned already */
10058 /* value == 0 means no conversion took place so take empty string */
10060 value
= Jim_NewEmptyStringObj(interp
);
10061 /* If value is a non-assignable one, skip it */
10062 if (descr
->pos
== -1) {
10063 Jim_FreeNewObj(interp
, value
);
10065 else if (descr
->pos
== 0)
10066 /* Otherwise append it to the result list if no XPG3 was given */
10067 Jim_ListAppendElement(interp
, resultList
, value
);
10068 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
10069 /* But due to given XPG3, put the value into the corr. slot */
10070 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
10071 Jim_IncrRefCount(value
);
10072 resultVec
[descr
->pos
- 1] = value
;
10075 /* Otherwise, the slot was already used - free obj and ERROR */
10076 Jim_FreeNewObj(interp
, value
);
10080 Jim_DecrRefCount(interp
, emptyStr
);
10083 Jim_DecrRefCount(interp
, emptyStr
);
10084 Jim_FreeNewObj(interp
, resultList
);
10085 return (Jim_Obj
*)EOF
;
10087 Jim_DecrRefCount(interp
, emptyStr
);
10088 Jim_FreeNewObj(interp
, resultList
);
10092 /* -----------------------------------------------------------------------------
10093 * Pseudo Random Number Generation
10094 * ---------------------------------------------------------------------------*/
10095 /* Initialize the sbox with the numbers from 0 to 255 */
10096 static void JimPrngInit(Jim_Interp
*interp
)
10098 #define PRNG_SEED_SIZE 256
10100 unsigned int *seed
;
10101 time_t t
= time(NULL
);
10103 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10105 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10106 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10107 seed
[i
] = (rand() ^ t
^ clock());
10109 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10113 /* Generates N bytes of random data */
10114 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10116 Jim_PrngState
*prng
;
10117 unsigned char *destByte
= (unsigned char *)dest
;
10118 unsigned int si
, sj
, x
;
10120 /* initialization, only needed the first time */
10121 if (interp
->prngState
== NULL
)
10122 JimPrngInit(interp
);
10123 prng
= interp
->prngState
;
10124 /* generates 'len' bytes of pseudo-random numbers */
10125 for (x
= 0; x
< len
; x
++) {
10126 prng
->i
= (prng
->i
+ 1) & 0xff;
10127 si
= prng
->sbox
[prng
->i
];
10128 prng
->j
= (prng
->j
+ si
) & 0xff;
10129 sj
= prng
->sbox
[prng
->j
];
10130 prng
->sbox
[prng
->i
] = sj
;
10131 prng
->sbox
[prng
->j
] = si
;
10132 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10136 /* Re-seed the generator with user-provided bytes */
10137 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10140 Jim_PrngState
*prng
;
10142 /* initialization, only needed the first time */
10143 if (interp
->prngState
== NULL
)
10144 JimPrngInit(interp
);
10145 prng
= interp
->prngState
;
10147 /* Set the sbox[i] with i */
10148 for (i
= 0; i
< 256; i
++)
10150 /* Now use the seed to perform a random permutation of the sbox */
10151 for (i
= 0; i
< seedLen
; i
++) {
10154 t
= prng
->sbox
[i
& 0xFF];
10155 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10156 prng
->sbox
[seed
[i
]] = t
;
10158 prng
->i
= prng
->j
= 0;
10160 /* discard at least the first 256 bytes of stream.
10161 * borrow the seed buffer for this
10163 for (i
= 0; i
< 256; i
+= seedLen
) {
10164 JimRandomBytes(interp
, seed
, seedLen
);
10169 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10171 jim_wide wideValue
, increment
= 1;
10172 Jim_Obj
*intObjPtr
;
10174 if (argc
!= 2 && argc
!= 3) {
10175 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10179 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10182 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10184 /* Set missing variable to 0 */
10187 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10190 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10191 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10192 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10193 Jim_FreeNewObj(interp
, intObjPtr
);
10198 /* Can do it the quick way */
10199 Jim_InvalidateStringRep(intObjPtr
);
10200 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10202 /* The following step is required in order to invalidate the
10203 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10204 if (argv
[1]->typePtr
!= &variableObjType
) {
10205 /* Note that this can't fail since GetVariable already succeeded */
10206 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10209 Jim_SetResult(interp
, intObjPtr
);
10214 /* -----------------------------------------------------------------------------
10216 * ---------------------------------------------------------------------------*/
10217 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10218 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10220 /* Handle calls to the [unknown] command */
10221 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10225 /* If JimUnknown() is recursively called too many times...
10228 if (interp
->unknown_called
> 50) {
10232 /* The object interp->unknown just contains
10233 * the "unknown" string, it is used in order to
10234 * avoid to lookup the unknown command every time
10235 * but instead to cache the result. */
10237 /* If the [unknown] command does not exist ... */
10238 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10241 interp
->unknown_called
++;
10242 /* XXX: Are we losing fileNameObj and linenr? */
10243 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10244 interp
->unknown_called
--;
10249 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10257 for (j
= 0; j
< objc
; j
++) {
10258 printf(" '%s'", Jim_String(objv
[j
]));
10263 if (interp
->framePtr
->tailcallCmd
) {
10264 /* Special tailcall command was pre-resolved */
10265 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10266 interp
->framePtr
->tailcallCmd
= NULL
;
10269 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10270 if (cmdPtr
== NULL
) {
10271 return JimUnknown(interp
, objc
, objv
);
10273 JimIncrCmdRefCount(cmdPtr
);
10276 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10277 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10281 interp
->evalDepth
++;
10283 /* Call it -- Make sure result is an empty object. */
10284 Jim_SetEmptyResult(interp
);
10285 if (cmdPtr
->isproc
) {
10286 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10289 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10290 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10292 interp
->evalDepth
--;
10295 JimDecrCmdRefCount(interp
, cmdPtr
);
10300 /* Eval the object vector 'objv' composed of 'objc' elements.
10301 * Every element is used as single argument.
10302 * Jim_EvalObj() will call this function every time its object
10303 * argument is of "list" type, with no string representation.
10305 * This is possible because the string representation of a
10306 * list object generated by the UpdateStringOfList is made
10307 * in a way that ensures that every list element is a different
10308 * command argument. */
10309 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10313 /* Incr refcount of arguments. */
10314 for (i
= 0; i
< objc
; i
++)
10315 Jim_IncrRefCount(objv
[i
]);
10317 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10319 /* Decr refcount of arguments and return the retcode */
10320 for (i
= 0; i
< objc
; i
++)
10321 Jim_DecrRefCount(interp
, objv
[i
]);
10327 * Invokes 'prefix' as a command with the objv array as arguments.
10329 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10332 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10335 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10336 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10341 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10343 if (!interp
->errorFlag
) {
10344 /* This is the first error, so save the file/line information and reset the stack */
10345 interp
->errorFlag
= 1;
10346 Jim_IncrRefCount(script
->fileNameObj
);
10347 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10348 interp
->errorFileNameObj
= script
->fileNameObj
;
10349 interp
->errorLine
= script
->linenr
;
10351 JimResetStackTrace(interp
);
10352 /* Always add a level where the error first occurs */
10353 interp
->addStackTrace
++;
10356 /* Now if this is an "interesting" level, add it to the stack trace */
10357 if (interp
->addStackTrace
> 0) {
10358 /* Add the stack info for the current level */
10360 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10362 /* Note: if we didn't have a filename for this level,
10363 * don't clear the addStackTrace flag
10364 * so we can pick it up at the next level
10366 if (Jim_Length(script
->fileNameObj
)) {
10367 interp
->addStackTrace
= 0;
10370 Jim_DecrRefCount(interp
, interp
->errorProc
);
10371 interp
->errorProc
= interp
->emptyObj
;
10372 Jim_IncrRefCount(interp
->errorProc
);
10376 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10380 switch (token
->type
) {
10383 objPtr
= token
->objPtr
;
10386 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10388 case JIM_TT_DICTSUGAR
:
10389 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10391 case JIM_TT_EXPRSUGAR
:
10392 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10395 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10398 objPtr
= interp
->result
;
10401 /* Stop substituting */
10404 /* just skip this one */
10405 return JIM_CONTINUE
;
10412 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10417 *objPtrPtr
= objPtr
;
10423 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10424 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10425 * The returned object has refcount = 0.
10427 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10431 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10435 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10438 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10440 /* Compute every token forming the argument
10441 * in the intv objects vector. */
10442 for (i
= 0; i
< tokens
; i
++) {
10443 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10448 if (flags
& JIM_SUBST_FLAG
) {
10453 /* XXX: Should probably set an error about break outside loop */
10454 /* fall through to error */
10456 if (flags
& JIM_SUBST_FLAG
) {
10460 /* XXX: Ditto continue outside loop */
10461 /* fall through to error */
10464 Jim_DecrRefCount(interp
, intv
[i
]);
10466 if (intv
!= sintv
) {
10471 Jim_IncrRefCount(intv
[i
]);
10472 Jim_String(intv
[i
]);
10473 totlen
+= intv
[i
]->length
;
10476 /* Fast path return for a single token */
10477 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10478 Jim_DecrRefCount(interp
, intv
[0]);
10482 /* Concatenate every token in an unique
10484 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10486 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10487 && token
[2].type
== JIM_TT_VAR
) {
10488 /* May be able to do fast interpolated object -> dictSubst */
10489 objPtr
->typePtr
= &interpolatedObjType
;
10490 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10491 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10492 Jim_IncrRefCount(intv
[2]);
10494 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10495 /* The first interpolated token is source, so preserve the source info */
10496 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10500 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10501 objPtr
->length
= totlen
;
10502 for (i
= 0; i
< tokens
; i
++) {
10504 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10505 s
+= intv
[i
]->length
;
10506 Jim_DecrRefCount(interp
, intv
[i
]);
10509 objPtr
->bytes
[totlen
] = '\0';
10510 /* Free the intv vector if not static. */
10511 if (intv
!= sintv
) {
10519 /* listPtr *must* be a list.
10520 * The contents of the list is evaluated with the first element as the command and
10521 * the remaining elements as the arguments.
10523 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10525 int retcode
= JIM_OK
;
10527 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10529 if (listPtr
->internalRep
.listValue
.len
) {
10530 Jim_IncrRefCount(listPtr
);
10531 retcode
= JimInvokeCommand(interp
,
10532 listPtr
->internalRep
.listValue
.len
,
10533 listPtr
->internalRep
.listValue
.ele
);
10534 Jim_DecrRefCount(interp
, listPtr
);
10539 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10541 SetListFromAny(interp
, listPtr
);
10542 return JimEvalObjList(interp
, listPtr
);
10545 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10549 ScriptToken
*token
;
10550 int retcode
= JIM_OK
;
10551 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10552 Jim_Obj
*prevScriptObj
;
10554 /* If the object is of type "list", with no string rep we can call
10555 * a specialized version of Jim_EvalObj() */
10556 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10557 return JimEvalObjList(interp
, scriptObjPtr
);
10560 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10561 script
= JimGetScript(interp
, scriptObjPtr
);
10562 if (!JimScriptValid(interp
, script
)) {
10563 Jim_DecrRefCount(interp
, scriptObjPtr
);
10567 /* Reset the interpreter result. This is useful to
10568 * return the empty result in the case of empty program. */
10569 Jim_SetEmptyResult(interp
);
10571 token
= script
->token
;
10573 #ifdef JIM_OPTIMIZATION
10574 /* Check for one of the following common scripts used by for, while
10579 if (script
->len
== 0) {
10580 Jim_DecrRefCount(interp
, scriptObjPtr
);
10583 if (script
->len
== 3
10584 && token
[1].objPtr
->typePtr
== &commandObjType
10585 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10586 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10587 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10589 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10591 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10592 JimWideValue(objPtr
)++;
10593 Jim_InvalidateStringRep(objPtr
);
10594 Jim_DecrRefCount(interp
, scriptObjPtr
);
10595 Jim_SetResult(interp
, objPtr
);
10601 /* Now we have to make sure the internal repr will not be
10602 * freed on shimmering.
10604 * Think for example to this:
10606 * set x {llength $x; ... some more code ...}; eval $x
10608 * In order to preserve the internal rep, we increment the
10609 * inUse field of the script internal rep structure. */
10612 /* Stash the current script */
10613 prevScriptObj
= interp
->currentScriptObj
;
10614 interp
->currentScriptObj
= scriptObjPtr
;
10616 interp
->errorFlag
= 0;
10619 /* Execute every command sequentially until the end of the script
10620 * or an error occurs.
10622 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10626 /* First token of the line is always JIM_TT_LINE */
10627 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10628 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10630 /* Allocate the arguments vector if required */
10631 if (argc
> JIM_EVAL_SARGV_LEN
)
10632 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10634 /* Skip the JIM_TT_LINE token */
10637 /* Populate the arguments objects.
10638 * If an error occurs, retcode will be set and
10639 * 'j' will be set to the number of args expanded
10641 for (j
= 0; j
< argc
; j
++) {
10642 long wordtokens
= 1;
10644 Jim_Obj
*wordObjPtr
= NULL
;
10646 if (token
[i
].type
== JIM_TT_WORD
) {
10647 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10648 if (wordtokens
< 0) {
10650 wordtokens
= -wordtokens
;
10654 if (wordtokens
== 1) {
10655 /* Fast path if the token does not
10656 * need interpolation */
10658 switch (token
[i
].type
) {
10661 wordObjPtr
= token
[i
].objPtr
;
10664 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10666 case JIM_TT_EXPRSUGAR
:
10667 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10669 case JIM_TT_DICTSUGAR
:
10670 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10673 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10674 if (retcode
== JIM_OK
) {
10675 wordObjPtr
= Jim_GetResult(interp
);
10679 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10683 /* For interpolation we call a helper
10684 * function to do the work for us. */
10685 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10689 if (retcode
== JIM_OK
) {
10695 Jim_IncrRefCount(wordObjPtr
);
10699 argv
[j
] = wordObjPtr
;
10702 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10703 int len
= Jim_ListLength(interp
, wordObjPtr
);
10704 int newargc
= argc
+ len
- 1;
10708 if (argv
== sargv
) {
10709 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10710 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10711 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10715 /* Need to realloc to make room for (len - 1) more entries */
10716 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10720 /* Now copy in the expanded version */
10721 for (k
= 0; k
< len
; k
++) {
10722 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10723 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10726 /* The original object reference is no longer needed,
10727 * after the expansion it is no longer present on
10728 * the argument vector, but the single elements are
10730 Jim_DecrRefCount(interp
, wordObjPtr
);
10732 /* And update the indexes */
10738 if (retcode
== JIM_OK
&& argc
) {
10739 /* Invoke the command */
10740 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10741 /* Check for a signal after each command */
10742 if (Jim_CheckSignal(interp
)) {
10743 retcode
= JIM_SIGNAL
;
10747 /* Finished with the command, so decrement ref counts of each argument */
10749 Jim_DecrRefCount(interp
, argv
[j
]);
10752 if (argv
!= sargv
) {
10758 /* Possibly add to the error stack trace */
10759 if (retcode
== JIM_ERR
) {
10760 JimAddErrorToStack(interp
, script
);
10762 /* Propagate the addStackTrace value through 'return -code error' */
10763 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10764 /* No need to add stack trace */
10765 interp
->addStackTrace
= 0;
10768 /* Restore the current script */
10769 interp
->currentScriptObj
= prevScriptObj
;
10771 /* Note that we don't have to decrement inUse, because the
10772 * following code transfers our use of the reference again to
10773 * the script object. */
10774 Jim_FreeIntRep(interp
, scriptObjPtr
);
10775 scriptObjPtr
->typePtr
= &scriptObjType
;
10776 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10777 Jim_DecrRefCount(interp
, scriptObjPtr
);
10782 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10785 /* If argObjPtr begins with '&', do an automatic upvar */
10786 const char *varname
= Jim_String(argNameObj
);
10787 if (*varname
== '&') {
10788 /* First check that the target variable exists */
10790 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10792 interp
->framePtr
= interp
->framePtr
->parent
;
10793 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10794 interp
->framePtr
= savedCallFrame
;
10799 /* It exists, so perform the binding. */
10800 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10801 Jim_IncrRefCount(objPtr
);
10802 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10803 Jim_DecrRefCount(interp
, objPtr
);
10806 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10812 * Sets the interp result to be an error message indicating the required proc args.
10814 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10816 /* Create a nice error message, consistent with Tcl 8.5 */
10817 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10820 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10821 Jim_AppendString(interp
, argmsg
, " ", 1);
10823 if (i
== cmd
->u
.proc
.argsPos
) {
10824 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10826 Jim_AppendString(interp
, argmsg
, "?", 1);
10827 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10828 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10831 /* We have plain args */
10832 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10836 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10837 Jim_AppendString(interp
, argmsg
, "?", 1);
10838 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10839 Jim_AppendString(interp
, argmsg
, "?", 1);
10842 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10846 Jim_AppendString(interp
, argmsg
, arg
, -1);
10850 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10851 Jim_FreeNewObj(interp
, argmsg
);
10854 #ifdef jim_ext_namespace
10858 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10860 Jim_CallFrame
*callFramePtr
;
10863 /* Create a new callframe */
10864 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10865 callFramePtr
->argv
= &interp
->emptyObj
;
10866 callFramePtr
->argc
= 0;
10867 callFramePtr
->procArgsObjPtr
= NULL
;
10868 callFramePtr
->procBodyObjPtr
= scriptObj
;
10869 callFramePtr
->staticVars
= NULL
;
10870 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10871 callFramePtr
->line
= 0;
10872 Jim_IncrRefCount(scriptObj
);
10873 interp
->framePtr
= callFramePtr
;
10875 /* Check if there are too nested calls */
10876 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10877 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10881 /* Eval the body */
10882 retcode
= Jim_EvalObj(interp
, scriptObj
);
10885 /* Destroy the callframe */
10886 interp
->framePtr
= interp
->framePtr
->parent
;
10887 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10893 /* Call a procedure implemented in Tcl.
10894 * It's possible to speed-up a lot this function, currently
10895 * the callframes are not cached, but allocated and
10896 * destroied every time. What is expecially costly is
10897 * to create/destroy the local vars hash table every time.
10899 * This can be fixed just implementing callframes caching
10900 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10901 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10903 Jim_CallFrame
*callFramePtr
;
10904 int i
, d
, retcode
, optargs
;
10908 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10909 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10910 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10914 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10915 /* Optimise for procedure with no body - useful for optional debugging */
10919 /* Check if there are too nested calls */
10920 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10921 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10925 /* Create a new callframe */
10926 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10927 callFramePtr
->argv
= argv
;
10928 callFramePtr
->argc
= argc
;
10929 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10930 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10931 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10933 /* Remember where we were called from. */
10934 script
= JimGetScript(interp
, interp
->currentScriptObj
);
10935 callFramePtr
->fileNameObj
= script
->fileNameObj
;
10936 callFramePtr
->line
= script
->linenr
;
10938 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
10939 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
10940 interp
->framePtr
= callFramePtr
;
10942 /* How many optional args are available */
10943 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
10945 /* Step 'i' along the actual args, and step 'd' along the formal args */
10947 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
10948 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
10949 if (d
== cmd
->u
.proc
.argsPos
) {
10951 Jim_Obj
*listObjPtr
;
10953 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
10954 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
10956 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
10958 /* It is possible to rename args. */
10959 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
10960 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
10962 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
10963 if (retcode
!= JIM_OK
) {
10971 /* Optional or required? */
10972 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
10973 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
10976 /* Ran out, so use the default */
10977 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
10979 if (retcode
!= JIM_OK
) {
10984 /* Eval the body */
10985 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
10989 /* Free the callframe */
10990 interp
->framePtr
= interp
->framePtr
->parent
;
10991 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10993 /* Now chain any tailcalls in the parent frame */
10994 if (interp
->framePtr
->tailcallObj
) {
10996 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
10998 interp
->framePtr
->tailcallObj
= NULL
;
11000 if (retcode
== JIM_EVAL
) {
11001 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
11002 if (retcode
== JIM_RETURN
) {
11003 /* If the result of the tailcall is 'return', push
11004 * it up to the caller
11006 interp
->returnLevel
++;
11009 Jim_DecrRefCount(interp
, tailcallObj
);
11010 } while (interp
->framePtr
->tailcallObj
);
11012 /* If the tailcall chain finished early, may need to manually discard the command */
11013 if (interp
->framePtr
->tailcallCmd
) {
11014 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
11015 interp
->framePtr
->tailcallCmd
= NULL
;
11019 /* Handle the JIM_RETURN return code */
11020 if (retcode
== JIM_RETURN
) {
11021 if (--interp
->returnLevel
<= 0) {
11022 retcode
= interp
->returnCode
;
11023 interp
->returnCode
= JIM_OK
;
11024 interp
->returnLevel
= 0;
11027 else if (retcode
== JIM_ERR
) {
11028 interp
->addStackTrace
++;
11029 Jim_DecrRefCount(interp
, interp
->errorProc
);
11030 interp
->errorProc
= argv
[0];
11031 Jim_IncrRefCount(interp
->errorProc
);
11037 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
11040 Jim_Obj
*scriptObjPtr
;
11042 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
11043 Jim_IncrRefCount(scriptObjPtr
);
11046 Jim_Obj
*prevScriptObj
;
11048 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
11050 prevScriptObj
= interp
->currentScriptObj
;
11051 interp
->currentScriptObj
= scriptObjPtr
;
11053 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11055 interp
->currentScriptObj
= prevScriptObj
;
11058 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11060 Jim_DecrRefCount(interp
, scriptObjPtr
);
11064 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
11066 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
11069 /* Execute script in the scope of the global level */
11070 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
11073 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11075 interp
->framePtr
= interp
->topFramePtr
;
11076 retval
= Jim_Eval(interp
, script
);
11077 interp
->framePtr
= savedFramePtr
;
11082 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
11085 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11087 interp
->framePtr
= interp
->topFramePtr
;
11088 retval
= Jim_EvalFile(interp
, filename
);
11089 interp
->framePtr
= savedFramePtr
;
11094 #include <sys/stat.h>
11096 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11100 Jim_Obj
*scriptObjPtr
;
11101 Jim_Obj
*prevScriptObj
;
11106 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11107 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11110 if (sb
.st_size
== 0) {
11115 buf
= Jim_Alloc(sb
.st_size
+ 1);
11116 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11120 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11126 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11127 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11128 Jim_IncrRefCount(scriptObjPtr
);
11130 prevScriptObj
= interp
->currentScriptObj
;
11131 interp
->currentScriptObj
= scriptObjPtr
;
11133 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11135 /* Handle the JIM_RETURN return code */
11136 if (retcode
== JIM_RETURN
) {
11137 if (--interp
->returnLevel
<= 0) {
11138 retcode
= interp
->returnCode
;
11139 interp
->returnCode
= JIM_OK
;
11140 interp
->returnLevel
= 0;
11143 if (retcode
== JIM_ERR
) {
11144 /* EvalFile changes context, so add a stack frame here */
11145 interp
->addStackTrace
++;
11148 interp
->currentScriptObj
= prevScriptObj
;
11150 Jim_DecrRefCount(interp
, scriptObjPtr
);
11155 /* -----------------------------------------------------------------------------
11157 * ---------------------------------------------------------------------------*/
11158 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11160 pc
->tstart
= pc
->p
;
11161 pc
->tline
= pc
->linenr
;
11163 if (pc
->len
== 0) {
11165 pc
->tt
= JIM_TT_EOL
;
11169 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11173 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11174 if (JimParseVar(pc
) == JIM_OK
) {
11177 /* Not a var, so treat as a string */
11178 pc
->tstart
= pc
->p
;
11179 flags
|= JIM_SUBST_NOVAR
;
11182 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11185 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11188 if (*pc
->p
== '\\' && pc
->len
> 1) {
11195 pc
->tend
= pc
->p
- 1;
11196 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11199 /* The subst object type reuses most of the data structures and functions
11200 * of the script object. Script's data structures are a bit more complex
11201 * for what is needed for [subst]itution tasks, but the reuse helps to
11202 * deal with a single data structure at the cost of some more memory
11203 * usage for substitutions. */
11205 /* This method takes the string representation of an object
11206 * as a Tcl string where to perform [subst]itution, and generates
11207 * the pre-parsed internal representation. */
11208 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11211 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11212 struct JimParserCtx parser
;
11213 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11214 ParseTokenList tokenlist
;
11216 /* Initially parse the subst into tokens (in tokenlist) */
11217 ScriptTokenListInit(&tokenlist
);
11219 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11221 JimParseSubst(&parser
, flags
);
11223 /* Note that subst doesn't need the EOL token */
11226 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11230 /* Create the "real" subst/script tokens from the initial token list */
11232 script
->substFlags
= flags
;
11233 script
->fileNameObj
= interp
->emptyObj
;
11234 Jim_IncrRefCount(script
->fileNameObj
);
11235 SubstObjAddTokens(interp
, script
, &tokenlist
);
11237 /* No longer need the token list */
11238 ScriptTokenListFree(&tokenlist
);
11240 #ifdef DEBUG_SHOW_SUBST
11244 printf("==== Subst ====\n");
11245 for (i
= 0; i
< script
->len
; i
++) {
11246 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11247 Jim_String(script
->token
[i
].objPtr
));
11252 /* Free the old internal rep and set the new one. */
11253 Jim_FreeIntRep(interp
, objPtr
);
11254 Jim_SetIntRepPtr(objPtr
, script
);
11255 objPtr
->typePtr
= &scriptObjType
;
11259 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11261 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11262 SetSubstFromAny(interp
, objPtr
, flags
);
11263 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11266 /* Performs commands,variables,blackslashes substitution,
11267 * storing the result object (with refcount 0) into
11269 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11271 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11273 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11274 /* In order to preserve the internal rep, we increment the
11275 * inUse field of the script internal rep structure. */
11278 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11281 Jim_DecrRefCount(interp
, substObjPtr
);
11282 if (*resObjPtrPtr
== NULL
) {
11288 /* -----------------------------------------------------------------------------
11289 * Core commands utility functions
11290 * ---------------------------------------------------------------------------*/
11291 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11294 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11297 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11299 Jim_IncrRefCount(listObjPtr
);
11300 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11301 Jim_DecrRefCount(interp
, listObjPtr
);
11303 Jim_IncrRefCount(objPtr
);
11304 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11305 Jim_DecrRefCount(interp
, objPtr
);
11309 * May add the key and/or value to the list.
11311 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11312 Jim_HashEntry
*he
, int type
);
11314 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11317 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11318 * invoke the callback to add entries to a list.
11319 * Returns the list.
11321 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11322 JimHashtableIteratorCallbackType
*callback
, int type
)
11325 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11327 /* Check for the non-pattern case. We can do this much more efficiently. */
11328 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11329 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11331 callback(interp
, listObjPtr
, he
, type
);
11335 Jim_HashTableIterator htiter
;
11336 JimInitHashTableIterator(ht
, &htiter
);
11337 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11338 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11339 callback(interp
, listObjPtr
, he
, type
);
11346 /* Keep these in order */
11347 #define JIM_CMDLIST_COMMANDS 0
11348 #define JIM_CMDLIST_PROCS 1
11349 #define JIM_CMDLIST_CHANNELS 2
11352 * Adds matching command names (procs, channels) to the list.
11354 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11355 Jim_HashEntry
*he
, int type
)
11357 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11360 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11365 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11366 Jim_IncrRefCount(objPtr
);
11368 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11369 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11371 Jim_DecrRefCount(interp
, objPtr
);
11374 /* type is JIM_CMDLIST_xxx */
11375 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11377 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11380 /* Keep these in order */
11381 #define JIM_VARLIST_GLOBALS 0
11382 #define JIM_VARLIST_LOCALS 1
11383 #define JIM_VARLIST_VARS 2
11385 #define JIM_VARLIST_VALUES 0x1000
11388 * Adds matching variable names to the list.
11390 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11391 Jim_HashEntry
*he
, int type
)
11393 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11395 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11396 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11397 if (type
& JIM_VARLIST_VALUES
) {
11398 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11403 /* mode is JIM_VARLIST_xxx */
11404 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11406 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11407 /* For [info locals], if we are at top level an emtpy list
11408 * is returned. I don't agree, but we aim at compatibility (SS) */
11409 return interp
->emptyObj
;
11412 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11413 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11417 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11418 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11420 Jim_CallFrame
*targetCallFrame
;
11422 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11423 if (targetCallFrame
== NULL
) {
11426 /* No proc call at toplevel callframe */
11427 if (targetCallFrame
== interp
->topFramePtr
) {
11428 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11431 if (info_level_cmd
) {
11432 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11435 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11437 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11438 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11439 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11440 *objPtrPtr
= listObj
;
11445 /* -----------------------------------------------------------------------------
11447 * ---------------------------------------------------------------------------*/
11449 /* fake [puts] -- not the real puts, just for debugging. */
11450 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11452 if (argc
!= 2 && argc
!= 3) {
11453 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11457 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11458 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11462 fputs(Jim_String(argv
[2]), stdout
);
11466 puts(Jim_String(argv
[1]));
11471 /* Helper for [+] and [*] */
11472 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11474 jim_wide wideValue
, res
;
11475 double doubleValue
, doubleRes
;
11478 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11480 for (i
= 1; i
< argc
; i
++) {
11481 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11483 if (op
== JIM_EXPROP_ADD
)
11488 Jim_SetResultInt(interp
, res
);
11491 doubleRes
= (double)res
;
11492 for (; i
< argc
; i
++) {
11493 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11495 if (op
== JIM_EXPROP_ADD
)
11496 doubleRes
+= doubleValue
;
11498 doubleRes
*= doubleValue
;
11500 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11504 /* Helper for [-] and [/] */
11505 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11507 jim_wide wideValue
, res
= 0;
11508 double doubleValue
, doubleRes
= 0;
11512 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11515 else if (argc
== 2) {
11516 /* The arity = 2 case is different. For [- x] returns -x,
11517 * while [/ x] returns 1/x. */
11518 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11519 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11523 if (op
== JIM_EXPROP_SUB
)
11524 doubleRes
= -doubleValue
;
11526 doubleRes
= 1.0 / doubleValue
;
11527 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11531 if (op
== JIM_EXPROP_SUB
) {
11533 Jim_SetResultInt(interp
, res
);
11536 doubleRes
= 1.0 / wideValue
;
11537 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11542 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11543 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11552 for (i
= 2; i
< argc
; i
++) {
11553 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11554 doubleRes
= (double)res
;
11557 if (op
== JIM_EXPROP_SUB
)
11562 Jim_SetResultInt(interp
, res
);
11565 for (; i
< argc
; i
++) {
11566 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11568 if (op
== JIM_EXPROP_SUB
)
11569 doubleRes
-= doubleValue
;
11571 doubleRes
/= doubleValue
;
11573 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11579 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11581 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11585 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11587 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11591 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11593 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11597 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11599 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11603 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11605 if (argc
!= 2 && argc
!= 3) {
11606 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11612 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11615 Jim_SetResult(interp
, objPtr
);
11618 /* argc == 3 case. */
11619 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11621 Jim_SetResult(interp
, argv
[2]);
11627 * unset ?-nocomplain? ?--? ?varName ...?
11629 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11635 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11639 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11648 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11658 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11661 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11665 /* The general purpose implementation of while starts here */
11667 int boolean
, retval
;
11669 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11674 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11688 Jim_SetEmptyResult(interp
);
11693 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11697 Jim_Obj
*varNamePtr
= NULL
;
11698 Jim_Obj
*stopVarNamePtr
= NULL
;
11701 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11705 /* Do the initialisation */
11706 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11710 /* And do the first test now. Better for optimisation
11711 * if we can do next/test at the bottom of the loop
11713 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11715 /* Ready to do the body as follows:
11717 * body // check retcode
11718 * next // check retcode
11719 * test // check retcode/test bool
11723 #ifdef JIM_OPTIMIZATION
11724 /* Check if the for is on the form:
11725 * for ... {$i < CONST} {incr i}
11726 * for ... {$i < $j} {incr i}
11728 if (retval
== JIM_OK
&& boolean
) {
11729 ScriptObj
*incrScript
;
11730 ExprByteCode
*expr
;
11731 jim_wide stop
, currentVal
;
11735 /* Do it only if there aren't shared arguments */
11736 expr
= JimGetExpression(interp
, argv
[2]);
11737 incrScript
= JimGetScript(interp
, argv
[3]);
11739 /* Ensure proper lengths to start */
11740 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11743 /* Ensure proper token types. */
11744 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11745 expr
->token
[0].type
!= JIM_TT_VAR
||
11746 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11750 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11753 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11760 /* Update command must be incr */
11761 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11765 /* incr, expression must be about the same variable */
11766 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11770 /* Get the stop condition (must be a variable or integer) */
11771 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11772 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11777 stopVarNamePtr
= expr
->token
[1].objPtr
;
11778 Jim_IncrRefCount(stopVarNamePtr
);
11779 /* Keep the compiler happy */
11783 /* Initialization */
11784 varNamePtr
= expr
->token
[0].objPtr
;
11785 Jim_IncrRefCount(varNamePtr
);
11787 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11788 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11792 /* --- OPTIMIZED FOR --- */
11793 while (retval
== JIM_OK
) {
11794 /* === Check condition === */
11795 /* Note that currentVal is already set here */
11797 /* Immediate or Variable? get the 'stop' value if the latter. */
11798 if (stopVarNamePtr
) {
11799 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11800 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11805 if (currentVal
>= stop
+ cmpOffset
) {
11810 retval
= Jim_EvalObj(interp
, argv
[4]);
11811 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11814 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11817 if (objPtr
== NULL
) {
11821 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11822 currentVal
= ++JimWideValue(objPtr
);
11823 Jim_InvalidateStringRep(objPtr
);
11826 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11827 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11828 ++currentVal
)) != JIM_OK
) {
11839 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11841 retval
= Jim_EvalObj(interp
, argv
[4]);
11843 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11846 retval
= Jim_EvalObj(interp
, argv
[3]);
11847 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11850 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11855 if (stopVarNamePtr
) {
11856 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11859 Jim_DecrRefCount(interp
, varNamePtr
);
11862 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11863 Jim_SetEmptyResult(interp
);
11871 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11877 Jim_Obj
*bodyObjPtr
;
11879 if (argc
!= 5 && argc
!= 6) {
11880 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11884 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11885 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11886 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11889 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11891 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11893 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11894 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11895 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11896 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11903 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11904 if (argv
[1]->typePtr
!= &variableObjType
) {
11905 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11909 JimWideValue(objPtr
) = i
;
11910 Jim_InvalidateStringRep(objPtr
);
11912 /* The following step is required in order to invalidate the
11913 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11914 if (argv
[1]->typePtr
!= &variableObjType
) {
11915 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11922 objPtr
= Jim_NewIntObj(interp
, i
);
11923 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11924 if (retval
!= JIM_OK
) {
11925 Jim_FreeNewObj(interp
, objPtr
);
11931 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11932 Jim_SetEmptyResult(interp
);
11938 /* List iterators make it easy to iterate over a list.
11939 * At some point iterators will be expanded to support generators.
11947 * Initialise the iterator at the start of the list.
11949 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
11951 iter
->objPtr
= objPtr
;
11956 * Returns the next object from the list, or NULL on end-of-list.
11958 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11960 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
11963 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
11967 * Returns 1 if end-of-list has been reached.
11969 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11971 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
11974 /* foreach + lmap implementation. */
11975 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
11977 int result
= JIM_OK
;
11979 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
11980 Jim_ListIter
*iters
;
11982 Jim_Obj
*resultObj
;
11984 if (argc
< 4 || argc
% 2 != 0) {
11985 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
11988 script
= argv
[argc
- 1]; /* Last argument is a script */
11989 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
11991 if (numargs
== 2) {
11995 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
11997 for (i
= 0; i
< numargs
; i
++) {
11998 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11999 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
12003 if (result
!= JIM_OK
) {
12004 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
12009 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12012 resultObj
= interp
->emptyObj
;
12014 Jim_IncrRefCount(resultObj
);
12017 /* Have we expired all lists? */
12018 for (i
= 0; i
< numargs
; i
+= 2) {
12019 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
12023 if (i
== numargs
) {
12028 /* For each list */
12029 for (i
= 0; i
< numargs
; i
+= 2) {
12033 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12034 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
12035 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
12037 /* Ran out, so store the empty string */
12038 valObj
= interp
->emptyObj
;
12040 /* Avoid shimmering */
12041 Jim_IncrRefCount(valObj
);
12042 result
= Jim_SetVariable(interp
, varName
, valObj
);
12043 Jim_DecrRefCount(interp
, valObj
);
12044 if (result
!= JIM_OK
) {
12049 switch (result
= Jim_EvalObj(interp
, script
)) {
12052 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
12065 Jim_SetResult(interp
, resultObj
);
12067 Jim_DecrRefCount(interp
, resultObj
);
12075 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12077 return JimForeachMapHelper(interp
, argc
, argv
, 0);
12081 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12083 return JimForeachMapHelper(interp
, argc
, argv
, 1);
12087 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12089 int result
= JIM_ERR
;
12092 Jim_Obj
*resultObj
;
12095 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12099 JimListIterInit(&iter
, argv
[1]);
12101 for (i
= 2; i
< argc
; i
++) {
12102 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12103 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12104 if (result
!= JIM_OK
) {
12109 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12110 while (!JimListIterDone(interp
, &iter
)) {
12111 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12114 Jim_SetResult(interp
, resultObj
);
12120 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12122 int boolean
, retval
, current
= 1, falsebody
= 0;
12126 /* Far not enough arguments given! */
12127 if (current
>= argc
)
12129 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12132 /* There lacks something, isn't it? */
12133 if (current
>= argc
)
12135 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12137 /* Tsk tsk, no then-clause? */
12138 if (current
>= argc
)
12141 return Jim_EvalObj(interp
, argv
[current
]);
12142 /* Ok: no else-clause follows */
12143 if (++current
>= argc
) {
12144 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12147 falsebody
= current
++;
12148 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12149 /* IIICKS - else-clause isn't last cmd? */
12150 if (current
!= argc
- 1)
12152 return Jim_EvalObj(interp
, argv
[current
]);
12154 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12155 /* Ok: elseif follows meaning all the stuff
12156 * again (how boring...) */
12158 /* OOPS - else-clause is not last cmd? */
12159 else if (falsebody
!= argc
- 1)
12161 return Jim_EvalObj(interp
, argv
[falsebody
]);
12166 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12171 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12172 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12173 Jim_Obj
*stringObj
, int nocase
)
12180 parms
[argc
++] = commandObj
;
12182 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12184 parms
[argc
++] = patternObj
;
12185 parms
[argc
++] = stringObj
;
12187 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12189 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12197 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12200 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12202 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12203 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12204 Jim_Obj
*script
= 0;
12208 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12209 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12212 for (opt
= 1; opt
< argc
; ++opt
) {
12213 const char *option
= Jim_String(argv
[opt
]);
12215 if (*option
!= '-')
12217 else if (strncmp(option
, "--", 2) == 0) {
12221 else if (strncmp(option
, "-exact", 2) == 0)
12222 matchOpt
= SWITCH_EXACT
;
12223 else if (strncmp(option
, "-glob", 2) == 0)
12224 matchOpt
= SWITCH_GLOB
;
12225 else if (strncmp(option
, "-regexp", 2) == 0)
12226 matchOpt
= SWITCH_RE
;
12227 else if (strncmp(option
, "-command", 2) == 0) {
12228 matchOpt
= SWITCH_CMD
;
12229 if ((argc
- opt
) < 2)
12231 command
= argv
[++opt
];
12234 Jim_SetResultFormatted(interp
,
12235 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12239 if ((argc
- opt
) < 2)
12242 strObj
= argv
[opt
++];
12243 patCount
= argc
- opt
;
12244 if (patCount
== 1) {
12247 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12251 caseList
= &argv
[opt
];
12252 if (patCount
== 0 || patCount
% 2 != 0)
12254 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12255 Jim_Obj
*patObj
= caseList
[i
];
12257 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12258 || i
< (patCount
- 2)) {
12259 switch (matchOpt
) {
12261 if (Jim_StringEqObj(strObj
, patObj
))
12262 script
= caseList
[i
+ 1];
12265 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12266 script
= caseList
[i
+ 1];
12269 command
= Jim_NewStringObj(interp
, "regexp", -1);
12270 /* Fall thru intentionally */
12272 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12274 /* After the execution of a command we need to
12275 * make sure to reconvert the object into a list
12276 * again. Only for the single-list style [switch]. */
12277 if (argc
- opt
== 1) {
12280 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12283 /* command is here already decref'd */
12288 script
= caseList
[i
+ 1];
12294 script
= caseList
[i
+ 1];
12297 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12298 script
= caseList
[i
+ 1];
12299 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12300 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12303 Jim_SetEmptyResult(interp
);
12305 return Jim_EvalObj(interp
, script
);
12311 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12313 Jim_Obj
*listObjPtr
;
12315 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12316 Jim_SetResult(interp
, listObjPtr
);
12321 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12323 Jim_Obj
*objPtr
, *listObjPtr
;
12328 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12332 Jim_IncrRefCount(objPtr
);
12333 for (i
= 2; i
< argc
; i
++) {
12334 listObjPtr
= objPtr
;
12335 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12336 Jim_DecrRefCount(interp
, listObjPtr
);
12339 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12340 /* Returns an empty object if the index
12341 * is out of range. */
12342 Jim_DecrRefCount(interp
, listObjPtr
);
12343 Jim_SetEmptyResult(interp
);
12346 Jim_IncrRefCount(objPtr
);
12347 Jim_DecrRefCount(interp
, listObjPtr
);
12349 Jim_SetResult(interp
, objPtr
);
12350 Jim_DecrRefCount(interp
, objPtr
);
12355 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12358 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12361 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12366 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12368 static const char * const options
[] = {
12369 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12373 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12378 int opt_nocase
= 0;
12380 int opt_inline
= 0;
12381 int opt_match
= OPT_EXACT
;
12384 Jim_Obj
*listObjPtr
= NULL
;
12385 Jim_Obj
*commandObj
= NULL
;
12389 Jim_WrongNumArgs(interp
, 1, argv
,
12390 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12394 for (i
= 1; i
< argc
- 2; i
++) {
12397 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12419 if (i
>= argc
- 2) {
12422 commandObj
= argv
[++i
];
12427 opt_match
= option
;
12435 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12437 if (opt_match
== OPT_REGEXP
) {
12438 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12441 Jim_IncrRefCount(commandObj
);
12444 listlen
= Jim_ListLength(interp
, argv
[0]);
12445 for (i
= 0; i
< listlen
; i
++) {
12447 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12449 switch (opt_match
) {
12451 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12455 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12460 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12463 Jim_FreeNewObj(interp
, listObjPtr
);
12471 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12472 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12476 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12477 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12478 Jim_Obj
*resultObj
;
12481 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12483 else if (!opt_inline
) {
12484 resultObj
= Jim_NewIntObj(interp
, i
);
12487 resultObj
= objPtr
;
12491 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12494 Jim_SetResult(interp
, resultObj
);
12501 Jim_SetResult(interp
, listObjPtr
);
12506 Jim_SetResultBool(interp
, opt_not
);
12508 else if (!opt_inline
) {
12509 Jim_SetResultInt(interp
, -1);
12515 Jim_DecrRefCount(interp
, commandObj
);
12521 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12523 Jim_Obj
*listObjPtr
;
12528 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12531 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12533 /* Create the list if it does not exist */
12534 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12537 else if (Jim_IsShared(listObjPtr
)) {
12538 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12541 for (i
= 2; i
< argc
; i
++)
12542 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12543 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12545 Jim_FreeNewObj(interp
, listObjPtr
);
12548 Jim_SetResult(interp
, listObjPtr
);
12553 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12559 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12563 if (Jim_IsShared(listPtr
))
12564 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12565 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12567 len
= Jim_ListLength(interp
, listPtr
);
12571 idx
= len
+ idx
+ 1;
12572 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12573 Jim_SetResult(interp
, listPtr
);
12576 if (listPtr
!= argv
[1]) {
12577 Jim_FreeNewObj(interp
, listPtr
);
12583 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12585 int first
, last
, len
, rangeLen
;
12587 Jim_Obj
*newListObj
;
12590 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12593 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12594 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12599 len
= Jim_ListLength(interp
, listObj
);
12601 first
= JimRelToAbsIndex(len
, first
);
12602 last
= JimRelToAbsIndex(len
, last
);
12603 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12605 /* Now construct a new list which consists of:
12606 * <elements before first> <supplied elements> <elements after last>
12609 /* Check to see if trying to replace past the end of the list */
12611 /* OK. Not past the end */
12613 else if (len
== 0) {
12614 /* Special for empty list, adjust first to 0 */
12618 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12619 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12623 /* Add the first set of elements */
12624 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12626 /* Add supplied elements */
12627 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12629 /* Add the remaining elements */
12630 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12632 Jim_SetResult(interp
, newListObj
);
12637 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12640 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12643 else if (argc
== 3) {
12644 /* With no indexes, simply implements [set] */
12645 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12647 Jim_SetResult(interp
, argv
[2]);
12650 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12654 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12656 static const char * const options
[] = {
12657 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12660 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12665 struct lsort_info info
;
12668 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12672 info
.type
= JIM_LSORT_ASCII
;
12676 info
.command
= NULL
;
12677 info
.interp
= interp
;
12679 for (i
= 1; i
< (argc
- 1); i
++) {
12682 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12687 info
.type
= JIM_LSORT_ASCII
;
12690 info
.type
= JIM_LSORT_NOCASE
;
12693 info
.type
= JIM_LSORT_INTEGER
;
12696 info
.type
= JIM_LSORT_REAL
;
12698 case OPT_INCREASING
:
12701 case OPT_DECREASING
:
12708 if (i
>= (argc
- 2)) {
12709 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12712 info
.type
= JIM_LSORT_COMMAND
;
12713 info
.command
= argv
[i
+ 1];
12717 if (i
>= (argc
- 2)) {
12718 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12721 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12729 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12730 retCode
= ListSortElements(interp
, resObj
, &info
);
12731 if (retCode
== JIM_OK
) {
12732 Jim_SetResult(interp
, resObj
);
12735 Jim_FreeNewObj(interp
, resObj
);
12741 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12743 Jim_Obj
*stringObjPtr
;
12747 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12751 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12757 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12758 if (!stringObjPtr
) {
12759 /* Create the string if it doesn't exist */
12760 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12763 else if (Jim_IsShared(stringObjPtr
)) {
12765 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12767 for (i
= 2; i
< argc
; i
++) {
12768 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12770 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12772 Jim_FreeNewObj(interp
, stringObjPtr
);
12777 Jim_SetResult(interp
, stringObjPtr
);
12782 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12784 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12785 static const char * const options
[] = {
12786 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12792 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12793 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12798 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12801 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12803 if (option
== OPT_REFCOUNT
) {
12805 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12808 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12811 else if (option
== OPT_OBJCOUNT
) {
12812 int freeobj
= 0, liveobj
= 0;
12817 Jim_WrongNumArgs(interp
, 2, argv
, "");
12820 /* Count the number of free objects. */
12821 objPtr
= interp
->freeList
;
12824 objPtr
= objPtr
->nextObjPtr
;
12826 /* Count the number of live objects. */
12827 objPtr
= interp
->liveList
;
12830 objPtr
= objPtr
->nextObjPtr
;
12832 /* Set the result string and return. */
12833 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12834 Jim_SetResultString(interp
, buf
, -1);
12837 else if (option
== OPT_OBJECTS
) {
12838 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12840 /* Count the number of live objects. */
12841 objPtr
= interp
->liveList
;
12842 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12845 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12847 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12848 sprintf(buf
, "%p", objPtr
);
12849 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12850 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12851 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12852 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12853 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12854 objPtr
= objPtr
->nextObjPtr
;
12856 Jim_SetResult(interp
, listObjPtr
);
12859 else if (option
== OPT_INVSTR
) {
12863 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12867 if (objPtr
->typePtr
!= NULL
)
12868 Jim_InvalidateStringRep(objPtr
);
12869 Jim_SetEmptyResult(interp
);
12872 else if (option
== OPT_SHOW
) {
12877 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12880 s
= Jim_GetString(argv
[2], &len
);
12882 charlen
= utf8_strlen(s
, len
);
12886 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12887 printf("chars (%d): <<%s>>\n", charlen
, s
);
12888 printf("bytes (%d):", len
);
12890 printf(" %02x", (unsigned char)*s
++);
12895 else if (option
== OPT_SCRIPTLEN
) {
12899 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12902 script
= JimGetScript(interp
, argv
[2]);
12903 if (script
== NULL
)
12905 Jim_SetResultInt(interp
, script
->len
);
12908 else if (option
== OPT_EXPRLEN
) {
12909 ExprByteCode
*expr
;
12912 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12915 expr
= JimGetExpression(interp
, argv
[2]);
12918 Jim_SetResultInt(interp
, expr
->len
);
12921 else if (option
== OPT_EXPRBC
) {
12923 ExprByteCode
*expr
;
12927 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12930 expr
= JimGetExpression(interp
, argv
[2]);
12933 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12934 for (i
= 0; i
< expr
->len
; i
++) {
12936 const Jim_ExprOperator
*op
;
12937 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
12939 switch (expr
->token
[i
].type
) {
12940 case JIM_TT_EXPR_INT
:
12943 case JIM_TT_EXPR_DOUBLE
:
12946 case JIM_TT_EXPR_BOOLEAN
:
12955 case JIM_TT_DICTSUGAR
:
12956 type
= "dictsugar";
12958 case JIM_TT_EXPRSUGAR
:
12959 type
= "exprsugar";
12968 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
12975 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
12978 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
12979 Jim_ListAppendElement(interp
, objPtr
, obj
);
12981 Jim_SetResult(interp
, objPtr
);
12985 Jim_SetResultString(interp
,
12986 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12990 #endif /* JIM_BOOTSTRAP */
12991 #if !defined(JIM_DEBUG_COMMAND)
12992 Jim_SetResultString(interp
, "unsupported", -1);
12998 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13003 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
13008 rc
= Jim_EvalObj(interp
, argv
[1]);
13011 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13014 if (rc
== JIM_ERR
) {
13015 /* eval is "interesting", so add a stack frame here */
13016 interp
->addStackTrace
++;
13022 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13026 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
13029 /* Save the old callframe pointer */
13030 savedCallFrame
= interp
->framePtr
;
13032 /* Lookup the target frame pointer */
13033 str
= Jim_String(argv
[1]);
13034 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
13035 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13040 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13042 if (targetCallFrame
== NULL
) {
13046 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
13049 /* Eval the code in the target callframe. */
13050 interp
->framePtr
= targetCallFrame
;
13052 retcode
= Jim_EvalObj(interp
, argv
[1]);
13055 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13057 interp
->framePtr
= savedCallFrame
;
13061 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
13067 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13069 Jim_Obj
*exprResultPtr
;
13073 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
13075 else if (argc
> 2) {
13078 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
13079 Jim_IncrRefCount(objPtr
);
13080 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
13081 Jim_DecrRefCount(interp
, objPtr
);
13084 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
13087 if (retcode
!= JIM_OK
)
13089 Jim_SetResult(interp
, exprResultPtr
);
13090 Jim_DecrRefCount(interp
, exprResultPtr
);
13095 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13098 Jim_WrongNumArgs(interp
, 1, argv
, "");
13105 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13108 Jim_WrongNumArgs(interp
, 1, argv
, "");
13111 return JIM_CONTINUE
;
13115 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13118 Jim_Obj
*stackTraceObj
= NULL
;
13119 Jim_Obj
*errorCodeObj
= NULL
;
13120 int returnCode
= JIM_OK
;
13123 for (i
= 1; i
< argc
- 1; i
+= 2) {
13124 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13125 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13129 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13130 stackTraceObj
= argv
[i
+ 1];
13132 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13133 errorCodeObj
= argv
[i
+ 1];
13135 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13136 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13137 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13146 if (i
!= argc
- 1 && i
!= argc
) {
13147 Jim_WrongNumArgs(interp
, 1, argv
,
13148 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13151 /* If a stack trace is supplied and code is error, set the stack trace */
13152 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13153 JimSetStackTrace(interp
, stackTraceObj
);
13155 /* If an error code list is supplied, set the global $errorCode */
13156 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13157 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13159 interp
->returnCode
= returnCode
;
13160 interp
->returnLevel
= level
;
13162 if (i
== argc
- 1) {
13163 Jim_SetResult(interp
, argv
[i
]);
13169 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13171 if (interp
->framePtr
->level
== 0) {
13172 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13175 else if (argc
>= 2) {
13176 /* Need to resolve the tailcall command in the current context */
13177 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13179 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13180 if (cmdPtr
== NULL
) {
13184 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13186 /* And stash this pre-resolved command */
13187 JimIncrCmdRefCount(cmdPtr
);
13188 cf
->tailcallCmd
= cmdPtr
;
13190 /* And stash the command list */
13191 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13193 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13194 Jim_IncrRefCount(cf
->tailcallObj
);
13196 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13202 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13205 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13207 /* prefixListObj is a list to which the args need to be appended */
13208 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13209 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13211 return JimEvalObjList(interp
, cmdList
);
13214 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13216 Jim_Obj
*prefixListObj
= privData
;
13217 Jim_DecrRefCount(interp
, prefixListObj
);
13220 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13222 Jim_Obj
*prefixListObj
;
13223 const char *newname
;
13226 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13230 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13231 Jim_IncrRefCount(prefixListObj
);
13232 newname
= Jim_String(argv
[1]);
13233 if (newname
[0] == ':' && newname
[1] == ':') {
13234 while (*++newname
== ':') {
13238 Jim_SetResult(interp
, argv
[1]);
13240 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13244 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13248 if (argc
!= 4 && argc
!= 5) {
13249 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13253 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13258 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13261 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13265 /* Add the new command */
13266 Jim_Obj
*qualifiedCmdNameObj
;
13267 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13269 JimCreateCommand(interp
, cmdname
, cmd
);
13271 /* Calculate and set the namespace for this proc */
13272 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13274 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13276 /* Unlike Tcl, set the name of the proc as the result */
13277 Jim_SetResult(interp
, argv
[1]);
13284 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13289 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13293 /* Evaluate the arguments with 'local' in force */
13295 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13299 /* If OK, and the result is a proc, add it to the list of local procs */
13300 if (retcode
== 0) {
13301 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13303 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13306 if (interp
->framePtr
->localCommands
== NULL
) {
13307 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13308 Jim_InitStack(interp
->framePtr
->localCommands
);
13310 Jim_IncrRefCount(cmdNameObj
);
13311 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13318 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13321 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13327 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13328 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13329 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13332 /* OK. Mark this command as being in an upcall */
13333 cmdPtr
->u
.proc
.upcall
++;
13334 JimIncrCmdRefCount(cmdPtr
);
13336 /* Invoke the command as normal */
13337 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13339 /* No longer in an upcall */
13340 cmdPtr
->u
.proc
.upcall
--;
13341 JimDecrCmdRefCount(interp
, cmdPtr
);
13348 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13351 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13357 Jim_Obj
*argListObjPtr
;
13358 Jim_Obj
*bodyObjPtr
;
13359 Jim_Obj
*nsObj
= NULL
;
13362 int len
= Jim_ListLength(interp
, argv
[1]);
13363 if (len
!= 2 && len
!= 3) {
13364 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13369 #ifdef jim_ext_namespace
13370 /* Need to canonicalise the given namespace. */
13371 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13373 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13377 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13378 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13380 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13383 /* Create a new argv array with a dummy argv[0], for error messages */
13384 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13385 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13386 Jim_IncrRefCount(nargv
[0]);
13387 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13388 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13389 Jim_DecrRefCount(interp
, nargv
[0]);
13392 JimDecrCmdRefCount(interp
, cmd
);
13401 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13403 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13408 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13411 Jim_CallFrame
*targetCallFrame
;
13413 /* Lookup the target frame pointer */
13414 if (argc
> 3 && (argc
% 2 == 0)) {
13415 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13420 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13422 if (targetCallFrame
== NULL
) {
13426 /* Check for arity */
13428 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13432 /* Now... for every other/local couple: */
13433 for (i
= 1; i
< argc
; i
+= 2) {
13434 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13441 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13446 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13449 /* Link every var to the toplevel having the same name */
13450 if (interp
->framePtr
->level
== 0)
13451 return JIM_OK
; /* global at toplevel... */
13452 for (i
= 1; i
< argc
; i
++) {
13453 /* global ::blah does nothing */
13454 const char *name
= Jim_String(argv
[i
]);
13455 if (name
[0] != ':' || name
[1] != ':') {
13456 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13463 /* does the [string map] operation. On error NULL is returned,
13464 * otherwise a new string object with the result, having refcount = 0,
13466 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13467 Jim_Obj
*objPtr
, int nocase
)
13470 const char *str
, *noMatchStart
= NULL
;
13472 Jim_Obj
*resultObjPtr
;
13474 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13476 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13480 str
= Jim_String(objPtr
);
13481 strLen
= Jim_Utf8Length(interp
, objPtr
);
13484 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13486 for (i
= 0; i
< numMaps
; i
+= 2) {
13491 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13492 k
= Jim_String(objPtr
);
13493 kl
= Jim_Utf8Length(interp
, objPtr
);
13495 if (strLen
>= kl
&& kl
) {
13497 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13499 if (noMatchStart
) {
13500 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13501 noMatchStart
= NULL
;
13503 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13504 str
+= utf8_index(str
, kl
);
13510 if (i
== numMaps
) { /* no match */
13512 if (noMatchStart
== NULL
)
13513 noMatchStart
= str
;
13514 str
+= utf8_tounicode(str
, &c
);
13518 if (noMatchStart
) {
13519 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13521 return resultObjPtr
;
13525 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13530 static const char * const options
[] = {
13531 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13532 "map", "repeat", "reverse", "index", "first", "last", "cat",
13533 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13537 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13538 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13539 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13541 static const char * const nocase_options
[] = {
13544 static const char * const nocase_length_options
[] = {
13545 "-nocase", "-length", NULL
13549 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13552 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13553 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13558 case OPT_BYTELENGTH
:
13560 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13563 if (option
== OPT_LENGTH
) {
13564 len
= Jim_Utf8Length(interp
, argv
[2]);
13567 len
= Jim_Length(argv
[2]);
13569 Jim_SetResultInt(interp
, len
);
13575 /* optimise the one-arg case */
13581 objPtr
= Jim_NewStringObj(interp
, "", 0);
13583 for (i
= 2; i
< argc
; i
++) {
13584 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13587 Jim_SetResult(interp
, objPtr
);
13594 /* n is the number of remaining option args */
13595 long opt_length
= -1;
13600 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13601 JIM_ENUM_ABBREV
) != JIM_OK
) {
13603 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13614 goto badcompareargs
;
13616 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13623 goto badcompareargs
;
13626 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13627 /* Fast version - [string equal], case sensitive, no length */
13628 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13631 if (opt_length
>= 0) {
13632 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13635 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13637 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13645 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13646 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13647 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13650 if (opt_case
== 0) {
13653 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13661 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13662 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13663 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13667 if (opt_case
== 0) {
13670 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13671 if (objPtr
== NULL
) {
13674 Jim_SetResult(interp
, objPtr
);
13679 case OPT_BYTERANGE
:{
13683 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13686 if (option
== OPT_RANGE
) {
13687 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13691 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13694 if (objPtr
== NULL
) {
13697 Jim_SetResult(interp
, objPtr
);
13704 if (argc
!= 5 && argc
!= 6) {
13705 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13708 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13709 if (objPtr
== NULL
) {
13712 Jim_SetResult(interp
, objPtr
);
13722 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13725 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13728 objPtr
= Jim_NewStringObj(interp
, "", 0);
13731 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13734 Jim_SetResult(interp
, objPtr
);
13745 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13749 str
= Jim_GetString(argv
[2], &len
);
13750 buf
= Jim_Alloc(len
+ 1);
13753 for (i
= 0; i
< len
; ) {
13755 int l
= utf8_tounicode(str
, &c
);
13756 memcpy(p
- l
, str
, l
);
13761 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13770 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13773 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13776 str
= Jim_String(argv
[2]);
13777 len
= Jim_Utf8Length(interp
, argv
[2]);
13778 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13779 idx
= JimRelToAbsIndex(len
, idx
);
13781 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13782 Jim_SetResultString(interp
, "", 0);
13784 else if (len
== Jim_Length(argv
[2])) {
13785 /* ASCII optimisation */
13786 Jim_SetResultString(interp
, str
+ idx
, 1);
13790 int i
= utf8_index(str
, idx
);
13791 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13798 int idx
= 0, l1
, l2
;
13799 const char *s1
, *s2
;
13801 if (argc
!= 4 && argc
!= 5) {
13802 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13805 s1
= Jim_String(argv
[2]);
13806 s2
= Jim_String(argv
[3]);
13807 l1
= Jim_Utf8Length(interp
, argv
[2]);
13808 l2
= Jim_Utf8Length(interp
, argv
[3]);
13810 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13813 idx
= JimRelToAbsIndex(l2
, idx
);
13815 else if (option
== OPT_LAST
) {
13818 if (option
== OPT_FIRST
) {
13819 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13823 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13825 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13833 case OPT_TRIMRIGHT
:{
13834 Jim_Obj
*trimchars
;
13836 if (argc
!= 3 && argc
!= 4) {
13837 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13840 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13841 if (option
== OPT_TRIM
) {
13842 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13844 else if (option
== OPT_TRIMLEFT
) {
13845 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13847 else if (option
== OPT_TRIMRIGHT
) {
13848 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13857 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13860 if (option
== OPT_TOLOWER
) {
13861 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13863 else if (option
== OPT_TOUPPER
) {
13864 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13867 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13872 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13873 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13875 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13882 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13885 jim_wide start
, elapsed
;
13887 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13890 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13894 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13900 start
= JimClock();
13904 retval
= Jim_EvalObj(interp
, argv
[1]);
13905 if (retval
!= JIM_OK
) {
13909 elapsed
= JimClock() - start
;
13910 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13911 Jim_SetResultString(interp
, buf
, -1);
13916 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13921 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13925 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13928 interp
->exitCode
= exitCode
;
13933 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13939 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13940 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
13941 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
13943 /* Reset the error code before catch.
13944 * Note that this is not strictly correct.
13946 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
13948 for (i
= 1; i
< argc
- 1; i
++) {
13949 const char *arg
= Jim_String(argv
[i
]);
13953 /* It's a pity we can't use Jim_GetEnum here :-( */
13954 if (strcmp(arg
, "--") == 0) {
13962 if (strncmp(arg
, "-no", 3) == 0) {
13971 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
13975 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
13982 ignore_mask
|= ((jim_wide
)1 << option
);
13985 ignore_mask
&= (~((jim_wide
)1 << option
));
13990 if (argc
< 1 || argc
> 3) {
13992 Jim_WrongNumArgs(interp
, 1, argv
,
13993 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13998 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
14002 interp
->signal_level
+= sig
;
14003 if (Jim_CheckSignal(interp
)) {
14004 /* If a signal is set, don't even try to execute the body */
14005 exitCode
= JIM_SIGNAL
;
14008 exitCode
= Jim_EvalObj(interp
, argv
[0]);
14009 /* Don't want any caught error included in a later stack trace */
14010 interp
->errorFlag
= 0;
14012 interp
->signal_level
-= sig
;
14014 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14015 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
14016 /* Not caught, pass it up */
14020 if (sig
&& exitCode
== JIM_SIGNAL
) {
14021 /* Catch the signal at this level */
14022 if (interp
->signal_set_result
) {
14023 interp
->signal_set_result(interp
, interp
->sigmask
);
14026 Jim_SetResultInt(interp
, interp
->sigmask
);
14028 interp
->sigmask
= 0;
14032 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
14036 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
14038 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
14039 Jim_ListAppendElement(interp
, optListObj
,
14040 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
14041 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
14042 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
14043 if (exitCode
== JIM_ERR
) {
14044 Jim_Obj
*errorCode
;
14045 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
14047 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
14049 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
14051 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
14052 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
14055 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
14060 Jim_SetResultInt(interp
, exitCode
);
14064 #ifdef JIM_REFERENCES
14067 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14069 if (argc
!= 3 && argc
!= 4) {
14070 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
14074 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
14077 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
14083 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14085 Jim_Reference
*refPtr
;
14088 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14091 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14093 Jim_SetResult(interp
, refPtr
->objPtr
);
14098 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14100 Jim_Reference
*refPtr
;
14103 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14106 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14108 Jim_IncrRefCount(argv
[2]);
14109 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14110 refPtr
->objPtr
= argv
[2];
14111 Jim_SetResult(interp
, argv
[2]);
14116 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14119 Jim_WrongNumArgs(interp
, 1, argv
, "");
14122 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14124 /* Free all the freed objects. */
14125 while (interp
->freeList
) {
14126 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14127 Jim_Free(interp
->freeList
);
14128 interp
->freeList
= nextObjPtr
;
14134 /* [finalize] reference ?newValue? */
14135 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14137 if (argc
!= 2 && argc
!= 3) {
14138 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14142 Jim_Obj
*cmdNamePtr
;
14144 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14146 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14147 Jim_SetResult(interp
, cmdNamePtr
);
14150 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14152 Jim_SetResult(interp
, argv
[2]);
14157 /* [info references] */
14158 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14160 Jim_Obj
*listObjPtr
;
14161 Jim_HashTableIterator htiter
;
14164 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14166 JimInitHashTableIterator(&interp
->references
, &htiter
);
14167 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14168 char buf
[JIM_REFERENCE_SPACE
+ 1];
14169 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14170 const unsigned long *refId
= he
->key
;
14172 JimFormatReference(buf
, refPtr
, *refId
);
14173 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14175 Jim_SetResult(interp
, listObjPtr
);
14181 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14184 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14188 if (JimValidName(interp
, "new procedure", argv
[2])) {
14192 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14195 #define JIM_DICTMATCH_VALUES 0x0001
14197 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14199 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14201 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14202 if (type
& JIM_DICTMATCH_VALUES
) {
14203 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14208 * Like JimHashtablePatternMatch, but for dictionaries.
14210 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14211 JimDictMatchCallbackType
*callback
, int type
)
14214 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14216 /* Check for the non-pattern case. We can do this much more efficiently. */
14217 Jim_HashTableIterator htiter
;
14218 JimInitHashTableIterator(ht
, &htiter
);
14219 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14220 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14221 callback(interp
, listObjPtr
, he
, type
);
14229 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14231 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14234 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14238 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14240 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14243 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14247 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14249 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14252 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14255 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14260 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14264 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14266 /* Note that this uses internal knowledge of the hash table */
14267 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14269 for (i
= 0; i
< ht
->size
; i
++) {
14270 Jim_HashEntry
*he
= ht
->table
[i
];
14276 printf(" %s", Jim_String(he
->key
));
14285 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14287 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14289 Jim_AppendString(interp
, prefixObj
, " ", 1);
14290 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14292 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14296 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14300 static const char * const options
[] = {
14301 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14302 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14303 "replace", "update", NULL
14307 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14308 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14309 OPT_REPLACE
, OPT_UPDATE
,
14313 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14317 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14324 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14327 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14328 JIM_ERRMSG
) != JIM_OK
) {
14331 Jim_SetResult(interp
, objPtr
);
14336 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14339 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14343 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14347 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14351 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14357 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14360 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14366 if (argc
!= 3 && argc
!= 4) {
14367 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14370 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14374 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14377 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14380 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14387 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14390 /* Handle as ensemble */
14394 if (argc
< 6 || argc
% 2) {
14395 /* Better error message */
14402 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14405 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14406 Jim_SetResult(interp
, objPtr
);
14411 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14414 return Jim_DictInfo(interp
, argv
[2]);
14416 /* Handle command as an ensemble */
14417 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14421 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14423 static const char * const options
[] = {
14424 "-nobackslashes", "-nocommands", "-novariables", NULL
14427 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14429 int flags
= JIM_SUBST_FLAG
;
14433 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14436 for (i
= 1; i
< (argc
- 1); i
++) {
14439 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14440 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14444 case OPT_NOBACKSLASHES
:
14445 flags
|= JIM_SUBST_NOESC
;
14447 case OPT_NOCOMMANDS
:
14448 flags
|= JIM_SUBST_NOCMD
;
14450 case OPT_NOVARIABLES
:
14451 flags
|= JIM_SUBST_NOVAR
;
14455 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14458 Jim_SetResult(interp
, objPtr
);
14463 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14469 static const char * const commands
[] = {
14470 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14471 "vars", "version", "patchlevel", "complete", "args", "hostname",
14472 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14473 "references", "alias", NULL
14476 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14477 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14478 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14479 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14482 #ifdef jim_ext_namespace
14485 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14486 /* This is for internal use only */
14494 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14497 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14502 /* Test for the most common commands first, just in case it makes a difference */
14506 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14509 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14516 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14519 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14522 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14523 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14526 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14530 case INFO_CHANNELS
:
14531 mode
++; /* JIM_CMDLIST_CHANNELS */
14532 #ifndef jim_ext_aio
14533 Jim_SetResultString(interp
, "aio not enabled", -1);
14538 mode
++; /* JIM_CMDLIST_PROCS */
14540 case INFO_COMMANDS
:
14541 /* mode 0 => JIM_CMDLIST_COMMANDS */
14542 if (argc
!= 2 && argc
!= 3) {
14543 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14546 #ifdef jim_ext_namespace
14548 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14549 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14553 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14557 mode
++; /* JIM_VARLIST_VARS */
14560 mode
++; /* JIM_VARLIST_LOCALS */
14563 /* mode 0 => JIM_VARLIST_GLOBALS */
14564 if (argc
!= 2 && argc
!= 3) {
14565 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14568 #ifdef jim_ext_namespace
14570 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14571 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14575 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14580 Jim_WrongNumArgs(interp
, 2, argv
, "");
14583 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14588 Jim_Obj
*resObjPtr
;
14589 Jim_Obj
*fileNameObj
;
14591 if (argc
!= 3 && argc
!= 5) {
14592 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14596 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14599 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14600 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14603 if (argv
[2]->typePtr
== &sourceObjType
) {
14604 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14605 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14607 else if (argv
[2]->typePtr
== &scriptObjType
) {
14608 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14609 fileNameObj
= script
->fileNameObj
;
14610 line
= script
->firstline
;
14613 fileNameObj
= interp
->emptyObj
;
14616 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14617 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14618 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14620 Jim_SetResult(interp
, resObjPtr
);
14624 case INFO_STACKTRACE
:
14625 Jim_SetResult(interp
, interp
->stackTrace
);
14632 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14636 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14639 Jim_SetResult(interp
, objPtr
);
14643 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14654 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14657 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14660 if (!cmdPtr
->isproc
) {
14661 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14666 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14669 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14672 if (cmdPtr
->u
.proc
.staticVars
) {
14673 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14674 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14675 NULL
, JimVariablesMatch
, mode
));
14683 case INFO_PATCHLEVEL
:{
14684 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14686 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14687 Jim_SetResultString(interp
, buf
, -1);
14691 case INFO_COMPLETE
:
14692 if (argc
!= 3 && argc
!= 4) {
14693 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14699 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(interp
, argv
[2], &missing
));
14700 if (missing
!= ' ' && argc
== 4) {
14701 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14706 case INFO_HOSTNAME
:
14707 /* Redirect to os.gethostname if it exists */
14708 return Jim_Eval(interp
, "os.gethostname");
14710 case INFO_NAMEOFEXECUTABLE
:
14711 /* Redirect to Tcl proc */
14712 return Jim_Eval(interp
, "{info nameofexecutable}");
14714 case INFO_RETURNCODES
:
14717 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14719 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14720 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14721 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14722 jimReturnCodes
[i
], -1));
14725 Jim_SetResult(interp
, listObjPtr
);
14727 else if (argc
== 3) {
14731 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14734 name
= Jim_ReturnCode(code
);
14735 if (*name
== '?') {
14736 Jim_SetResultInt(interp
, code
);
14739 Jim_SetResultString(interp
, name
, -1);
14743 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14747 case INFO_REFERENCES
:
14748 #ifdef JIM_REFERENCES
14749 return JimInfoReferences(interp
, argc
, argv
);
14751 Jim_SetResultString(interp
, "not supported", -1);
14759 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14764 static const char * const options
[] = {
14765 "-command", "-proc", "-alias", "-var", NULL
14769 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14777 else if (argc
== 3) {
14778 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14784 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14788 if (option
== OPT_VAR
) {
14789 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14792 /* Now different kinds of commands */
14793 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14802 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14806 result
= cmd
->isproc
;
14811 Jim_SetResultBool(interp
, result
);
14816 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14818 const char *str
, *splitChars
, *noMatchStart
;
14819 int splitLen
, strLen
;
14820 Jim_Obj
*resObjPtr
;
14824 if (argc
!= 2 && argc
!= 3) {
14825 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14829 str
= Jim_GetString(argv
[1], &len
);
14833 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14837 splitChars
= " \n\t\r";
14841 splitChars
= Jim_String(argv
[2]);
14842 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14845 noMatchStart
= str
;
14846 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14852 const char *sc
= splitChars
;
14853 int scLen
= splitLen
;
14854 int sl
= utf8_tounicode(str
, &c
);
14857 sc
+= utf8_tounicode(sc
, &pc
);
14859 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14860 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14861 noMatchStart
= str
+ sl
;
14867 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14868 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14871 /* This handles the special case of splitchars eq {}
14872 * Optimise by sharing common (ASCII) characters
14874 Jim_Obj
**commonObj
= NULL
;
14875 #define NUM_COMMON (128 - 9)
14877 int n
= utf8_tounicode(str
, &c
);
14878 #ifdef JIM_OPTIMIZATION
14879 if (c
>= 9 && c
< 128) {
14880 /* Common ASCII char. Note that 9 is the tab character */
14883 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14884 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14886 if (!commonObj
[c
]) {
14887 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14889 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14894 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14897 Jim_Free(commonObj
);
14900 Jim_SetResult(interp
, resObjPtr
);
14905 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14907 const char *joinStr
;
14910 if (argc
!= 2 && argc
!= 3) {
14911 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14920 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14922 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14927 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14932 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
14935 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
14936 if (objPtr
== NULL
)
14938 Jim_SetResult(interp
, objPtr
);
14943 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14945 Jim_Obj
*listPtr
, **outVec
;
14949 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
14952 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
14953 SetScanFmtFromAny(interp
, argv
[2]);
14954 if (FormatGetError(argv
[2]) != 0) {
14955 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
14959 int maxPos
= FormatGetMaxPos(argv
[2]);
14960 int count
= FormatGetCnvCount(argv
[2]);
14962 if (maxPos
> argc
- 3) {
14963 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
14966 else if (count
> argc
- 3) {
14967 Jim_SetResultString(interp
, "different numbers of variable names and "
14968 "field specifiers", -1);
14971 else if (count
< argc
- 3) {
14972 Jim_SetResultString(interp
, "variable is not assigned by any "
14973 "conversion specifiers", -1);
14977 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
14984 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
14985 int len
= Jim_ListLength(interp
, listPtr
);
14988 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
14989 for (i
= 0; i
< outc
; ++i
) {
14990 if (Jim_Length(outVec
[i
]) > 0) {
14992 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
14998 Jim_FreeNewObj(interp
, listPtr
);
15003 if (rc
== JIM_OK
) {
15004 Jim_SetResultInt(interp
, count
);
15009 if (listPtr
== (Jim_Obj
*)EOF
) {
15010 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
15013 Jim_SetResult(interp
, listPtr
);
15019 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15021 if (argc
!= 2 && argc
!= 3) {
15022 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
15025 Jim_SetResult(interp
, argv
[1]);
15027 JimSetStackTrace(interp
, argv
[2]);
15030 interp
->addStackTrace
++;
15035 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15040 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
15043 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
15045 Jim_SetResult(interp
, objPtr
);
15050 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15055 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
15056 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
15060 if (count
== 0 || argc
== 2) {
15067 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
15069 ListInsertElements(objPtr
, -1, argc
, argv
);
15072 Jim_SetResult(interp
, objPtr
);
15076 char **Jim_GetEnviron(void)
15078 #if defined(HAVE__NSGETENVIRON)
15079 return *_NSGetEnviron();
15081 #if !defined(NO_ENVIRON_EXTERN)
15082 extern char **environ
;
15089 void Jim_SetEnviron(char **env
)
15091 #if defined(HAVE__NSGETENVIRON)
15092 *_NSGetEnviron() = env
;
15094 #if !defined(NO_ENVIRON_EXTERN)
15095 extern char **environ
;
15103 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15109 char **e
= Jim_GetEnviron();
15112 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15114 for (i
= 0; e
[i
]; i
++) {
15115 const char *equals
= strchr(e
[i
], '=');
15118 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15120 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15124 Jim_SetResult(interp
, listObjPtr
);
15129 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15132 key
= Jim_String(argv
[1]);
15136 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15139 val
= Jim_String(argv
[2]);
15141 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15146 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15151 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15154 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15155 if (retval
== JIM_RETURN
)
15161 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15163 Jim_Obj
*revObjPtr
, **ele
;
15167 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15170 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15172 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15174 ListAppendElement(revObjPtr
, ele
[len
--]);
15175 Jim_SetResult(interp
, revObjPtr
);
15179 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15187 else if (step
> 0 && start
> end
)
15189 else if (step
< 0 && end
> start
)
15193 len
= -len
; /* abs(len) */
15195 step
= -step
; /* abs(step) */
15196 len
= 1 + ((len
- 1) / step
);
15197 /* We can truncate safely to INT_MAX, the range command
15198 * will always return an error for a such long range
15199 * because Tcl lists can't be so long. */
15202 return (int)((len
< 0) ? -1 : len
);
15206 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15208 jim_wide start
= 0, end
, step
= 1;
15212 if (argc
< 2 || argc
> 4) {
15213 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15217 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15221 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15222 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15224 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15227 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15228 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15231 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15232 for (i
= 0; i
< len
; i
++)
15233 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15234 Jim_SetResult(interp
, objPtr
);
15239 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15241 jim_wide min
= 0, max
= 0, len
, maxMul
;
15243 if (argc
< 1 || argc
> 3) {
15244 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15248 max
= JIM_WIDE_MAX
;
15249 } else if (argc
== 2) {
15250 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15252 } else if (argc
== 3) {
15253 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15254 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15259 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15262 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15266 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15267 if (r
< 0 || r
>= maxMul
) continue;
15268 r
= (len
== 0) ? 0 : r
%len
;
15269 Jim_SetResultInt(interp
, min
+r
);
15274 static const struct {
15276 Jim_CmdProc
*cmdProc
;
15277 } Jim_CoreCommandsTable
[] = {
15278 {"alias", Jim_AliasCoreCommand
},
15279 {"set", Jim_SetCoreCommand
},
15280 {"unset", Jim_UnsetCoreCommand
},
15281 {"puts", Jim_PutsCoreCommand
},
15282 {"+", Jim_AddCoreCommand
},
15283 {"*", Jim_MulCoreCommand
},
15284 {"-", Jim_SubCoreCommand
},
15285 {"/", Jim_DivCoreCommand
},
15286 {"incr", Jim_IncrCoreCommand
},
15287 {"while", Jim_WhileCoreCommand
},
15288 {"loop", Jim_LoopCoreCommand
},
15289 {"for", Jim_ForCoreCommand
},
15290 {"foreach", Jim_ForeachCoreCommand
},
15291 {"lmap", Jim_LmapCoreCommand
},
15292 {"lassign", Jim_LassignCoreCommand
},
15293 {"if", Jim_IfCoreCommand
},
15294 {"switch", Jim_SwitchCoreCommand
},
15295 {"list", Jim_ListCoreCommand
},
15296 {"lindex", Jim_LindexCoreCommand
},
15297 {"lset", Jim_LsetCoreCommand
},
15298 {"lsearch", Jim_LsearchCoreCommand
},
15299 {"llength", Jim_LlengthCoreCommand
},
15300 {"lappend", Jim_LappendCoreCommand
},
15301 {"linsert", Jim_LinsertCoreCommand
},
15302 {"lreplace", Jim_LreplaceCoreCommand
},
15303 {"lsort", Jim_LsortCoreCommand
},
15304 {"append", Jim_AppendCoreCommand
},
15305 {"debug", Jim_DebugCoreCommand
},
15306 {"eval", Jim_EvalCoreCommand
},
15307 {"uplevel", Jim_UplevelCoreCommand
},
15308 {"expr", Jim_ExprCoreCommand
},
15309 {"break", Jim_BreakCoreCommand
},
15310 {"continue", Jim_ContinueCoreCommand
},
15311 {"proc", Jim_ProcCoreCommand
},
15312 {"concat", Jim_ConcatCoreCommand
},
15313 {"return", Jim_ReturnCoreCommand
},
15314 {"upvar", Jim_UpvarCoreCommand
},
15315 {"global", Jim_GlobalCoreCommand
},
15316 {"string", Jim_StringCoreCommand
},
15317 {"time", Jim_TimeCoreCommand
},
15318 {"exit", Jim_ExitCoreCommand
},
15319 {"catch", Jim_CatchCoreCommand
},
15320 #ifdef JIM_REFERENCES
15321 {"ref", Jim_RefCoreCommand
},
15322 {"getref", Jim_GetrefCoreCommand
},
15323 {"setref", Jim_SetrefCoreCommand
},
15324 {"finalize", Jim_FinalizeCoreCommand
},
15325 {"collect", Jim_CollectCoreCommand
},
15327 {"rename", Jim_RenameCoreCommand
},
15328 {"dict", Jim_DictCoreCommand
},
15329 {"subst", Jim_SubstCoreCommand
},
15330 {"info", Jim_InfoCoreCommand
},
15331 {"exists", Jim_ExistsCoreCommand
},
15332 {"split", Jim_SplitCoreCommand
},
15333 {"join", Jim_JoinCoreCommand
},
15334 {"format", Jim_FormatCoreCommand
},
15335 {"scan", Jim_ScanCoreCommand
},
15336 {"error", Jim_ErrorCoreCommand
},
15337 {"lrange", Jim_LrangeCoreCommand
},
15338 {"lrepeat", Jim_LrepeatCoreCommand
},
15339 {"env", Jim_EnvCoreCommand
},
15340 {"source", Jim_SourceCoreCommand
},
15341 {"lreverse", Jim_LreverseCoreCommand
},
15342 {"range", Jim_RangeCoreCommand
},
15343 {"rand", Jim_RandCoreCommand
},
15344 {"tailcall", Jim_TailcallCoreCommand
},
15345 {"local", Jim_LocalCoreCommand
},
15346 {"upcall", Jim_UpcallCoreCommand
},
15347 {"apply", Jim_ApplyCoreCommand
},
15351 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15355 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15356 Jim_CreateCommand(interp
,
15357 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15362 /* -----------------------------------------------------------------------------
15363 * Interactive prompt
15364 * ---------------------------------------------------------------------------*/
15365 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15369 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15370 argv
[1] = interp
->result
;
15372 Jim_EvalObjVector(interp
, 2, argv
);
15375 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15376 const char *prefix
, const char *const *tablePtr
, const char *name
)
15379 char **tablePtrSorted
;
15382 for (count
= 0; tablePtr
[count
]; count
++) {
15385 if (name
== NULL
) {
15389 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15390 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15391 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15392 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15393 for (i
= 0; i
< count
; i
++) {
15394 if (i
+ 1 == count
&& count
> 1) {
15395 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15397 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15398 if (i
+ 1 != count
) {
15399 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15402 Jim_Free(tablePtrSorted
);
15405 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15406 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15408 const char *bad
= "bad ";
15409 const char *const *entryPtr
= NULL
;
15413 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15417 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15418 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15419 /* Found an exact match */
15423 if (flags
& JIM_ENUM_ABBREV
) {
15424 /* Accept an unambiguous abbreviation.
15425 * Note that '-' doesnt' consitute a valid abbreviation
15427 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15428 if (*arg
== '-' && arglen
== 1) {
15432 bad
= "ambiguous ";
15440 /* If we had an unambiguous partial match */
15447 if (flags
& JIM_ERRMSG
) {
15448 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15453 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15457 for (i
= 0; i
< (int)len
; i
++) {
15458 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15465 int Jim_IsDict(Jim_Obj
*objPtr
)
15467 return objPtr
->typePtr
== &dictObjType
;
15470 int Jim_IsList(Jim_Obj
*objPtr
)
15472 return objPtr
->typePtr
== &listObjType
;
15476 * Very simple printf-like formatting, designed for error messages.
15478 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15479 * The resulting string is created and set as the result.
15481 * Each '%s' should correspond to a regular string parameter.
15482 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15483 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15485 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15487 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15489 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15491 /* Initial space needed */
15492 int len
= strlen(format
);
15495 const char *params
[5];
15500 va_start(args
, format
);
15502 for (i
= 0; i
< len
&& n
< 5; i
++) {
15505 if (strncmp(format
+ i
, "%s", 2) == 0) {
15506 params
[n
] = va_arg(args
, char *);
15508 l
= strlen(params
[n
]);
15510 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15511 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15513 params
[n
] = Jim_GetString(objPtr
, &l
);
15516 if (format
[i
] == '%') {
15526 buf
= Jim_Alloc(len
+ 1);
15527 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15531 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15535 #ifndef jim_ext_package
15536 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15541 #ifndef jim_ext_aio
15542 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15544 Jim_SetResultString(interp
, "aio not enabled", -1);
15551 * Local Variables: ***
15552 * c-basic-offset: 4 ***