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 */
44 #define _GNU_SOURCE /* Mostly just for environ */
59 #include "jimautoconf.h"
62 #ifdef HAVE_SYS_TIME_H
68 #ifdef HAVE_CRT_EXTERNS_H
69 #include <crt_externs.h>
72 /* For INFINITY, even if math functions are not enabled */
75 /* We may decide to switch to using $[...] after all, so leave it as an option */
76 /*#define EXPRSUGAR_BRACKET*/
78 /* For the no-autoconf case */
80 #define TCL_LIBRARY "."
82 #ifndef TCL_PLATFORM_OS
83 #define TCL_PLATFORM_OS "unknown"
85 #ifndef TCL_PLATFORM_PLATFORM
86 #define TCL_PLATFORM_PLATFORM "unknown"
88 #ifndef TCL_PLATFORM_PATH_SEPARATOR
89 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 /*#define DEBUG_SHOW_SCRIPT*/
93 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
94 /*#define DEBUG_SHOW_SUBST*/
95 /*#define DEBUG_SHOW_EXPR*/
96 /*#define DEBUG_SHOW_EXPR_TOKENS*/
97 /*#define JIM_DEBUG_GC*/
99 #define JIM_DEBUG_COMMAND
100 #define JIM_DEBUG_PANIC
102 /* Enable this (in conjunction with valgrind) to help debug
103 * reference counting issues
105 /*#define JIM_DISABLE_OBJECT_POOL*/
107 /* Maximum size of an integer */
108 #define JIM_INTEGER_SPACE 24
110 const char *jim_tt_name(int type
);
112 #ifdef JIM_DEBUG_PANIC
113 static void JimPanicDump(int fail_condition
, const char *fmt
, ...);
114 #define JimPanic(X) JimPanicDump X
119 #ifdef JIM_OPTIMIZATION
120 #define JIM_IF_OPTIM(X) X
122 #define JIM_IF_OPTIM(X)
125 /* -----------------------------------------------------------------------------
127 * ---------------------------------------------------------------------------*/
129 /* A shared empty string for the objects string representation.
130 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
131 static char JimEmptyStringRep
[] = "";
133 /* -----------------------------------------------------------------------------
134 * Required prototypes of not exported functions
135 * ---------------------------------------------------------------------------*/
136 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
);
137 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int listindex
, Jim_Obj
*newObjPtr
,
139 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
);
140 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
141 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
142 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
);
143 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
144 const char *prefix
, const char *const *tablePtr
, const char *name
);
145 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
);
146 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
147 static int JimSign(jim_wide w
);
148 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
);
149 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
);
150 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
);
153 /* Fast access to the int (wide) value of an object which is known to be of int type */
154 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
156 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
158 static int utf8_tounicode_case(const char *s
, int *uc
, int upper
)
160 int l
= utf8_tounicode(s
, uc
);
162 *uc
= utf8_upper(*uc
);
167 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
168 #define JIM_CHARSET_SCAN 2
169 #define JIM_CHARSET_GLOB 0
172 * pattern points to a string like "[^a-z\ub5]"
174 * The pattern may contain trailing chars, which are ignored.
176 * The pattern is matched against unicode char 'c'.
178 * If (flags & JIM_NOCASE), case is ignored when matching.
179 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
180 * of the charset, per scan, rather than glob/string match.
182 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
183 * or the null character if the ']' is missing.
185 * Returns NULL on no match.
187 static const char *JimCharsetMatch(const char *pattern
, int c
, int flags
)
194 if (flags
& JIM_NOCASE
) {
199 if (flags
& JIM_CHARSET_SCAN
) {
200 if (*pattern
== '^') {
205 /* Special case. If the first char is ']', it is part of the set */
206 if (*pattern
== ']') {
211 while (*pattern
&& *pattern
!= ']') {
213 if (pattern
[0] == '\\') {
215 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
218 /* Is this a range? a-z */
222 pattern
+= utf8_tounicode_case(pattern
, &start
, nocase
);
223 if (pattern
[0] == '-' && pattern
[1]) {
225 pattern
+= utf8_tounicode(pattern
, &pchar
);
226 pattern
+= utf8_tounicode_case(pattern
, &end
, nocase
);
228 /* Handle reversed range too */
229 if ((c
>= start
&& c
<= end
) || (c
>= end
&& c
<= start
)) {
245 return match
? pattern
: NULL
;
248 /* Glob-style pattern matching. */
250 /* Note: string *must* be valid UTF-8 sequences
252 static int JimGlobMatch(const char *pattern
, const char *string
, int nocase
)
257 switch (pattern
[0]) {
259 while (pattern
[1] == '*') {
264 return 1; /* match */
267 /* Recursive call - Does the remaining pattern match anywhere? */
268 if (JimGlobMatch(pattern
, string
, nocase
))
269 return 1; /* match */
270 string
+= utf8_tounicode(string
, &c
);
272 return 0; /* no match */
275 string
+= utf8_tounicode(string
, &c
);
279 string
+= utf8_tounicode(string
, &c
);
280 pattern
= JimCharsetMatch(pattern
+ 1, c
, nocase
? JIM_NOCASE
: 0);
285 /* Ran out of pattern (no ']') */
296 string
+= utf8_tounicode_case(string
, &c
, nocase
);
297 utf8_tounicode_case(pattern
, &pchar
, nocase
);
303 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
305 while (*pattern
== '*') {
311 if (!*pattern
&& !*string
) {
318 * string comparison. Works on binary data.
322 * Note that the lengths are byte lengths, not char lengths.
324 static int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
)
327 return memcmp(s1
, s2
, l1
) <= 0 ? -1 : 1;
330 return memcmp(s1
, s2
, l2
) >= 0 ? 1 : -1;
333 return JimSign(memcmp(s1
, s2
, l1
));
338 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
339 * (or end of string if 'maxchars' is -1).
341 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
343 * Note: does not support embedded nulls.
345 static int JimStringCompareLen(const char *s1
, const char *s2
, int maxchars
, int nocase
)
347 while (*s1
&& *s2
&& maxchars
) {
349 s1
+= utf8_tounicode_case(s1
, &c1
, nocase
);
350 s2
+= utf8_tounicode_case(s2
, &c2
, nocase
);
352 return JimSign(c1
- c2
);
359 /* One string or both terminated */
369 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
370 * The index of the first occurrence of s1 in s2 is returned.
371 * If s1 is not found inside s2, -1 is returned. */
372 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int idx
)
377 if (!l1
|| !l2
|| l1
> l2
) {
382 s2
+= utf8_index(s2
, idx
);
384 l1bytelen
= utf8_index(s1
, l1
);
386 for (i
= idx
; i
<= l2
- l1
; i
++) {
388 if (memcmp(s2
, s1
, l1bytelen
) == 0) {
391 s2
+= utf8_tounicode(s2
, &c
);
397 * Note: Lengths and return value are in bytes, not chars.
399 static int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
403 if (!l1
|| !l2
|| l1
> l2
)
406 /* Now search for the needle */
407 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
408 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
417 * Note: Lengths and return value are in chars.
419 static int JimStringLastUtf8(const char *s1
, int l1
, const char *s2
, int l2
)
421 int n
= JimStringLast(s1
, utf8_index(s1
, l1
), s2
, utf8_index(s2
, l2
));
423 n
= utf8_strlen(s2
, n
);
430 * After an strtol()/strtod()-like conversion,
431 * check whether something was converted and that
432 * the only thing left is white space.
434 * Returns JIM_OK or JIM_ERR.
436 static int JimCheckConversion(const char *str
, const char *endptr
)
438 if (str
[0] == '\0' || str
== endptr
) {
442 if (endptr
[0] != '\0') {
444 if (!isspace(UCHAR(*endptr
))) {
453 /* Parses the front of a number to determine it's sign and base
454 * Returns the index to start parsing according to the given base
456 static int JimNumberBase(const char *str
, int *base
, int *sign
)
462 while (isspace(UCHAR(str
[i
]))) {
482 /* We have 0<x>, so see if we can convert it */
483 switch (str
[i
+ 1]) {
484 case 'x': case 'X': *base
= 16; break;
485 case 'o': case 'O': *base
= 8; break;
486 case 'b': case 'B': *base
= 2; break;
490 /* Ensure that (e.g.) 0x-5 fails to parse */
491 if (str
[i
] != '-' && str
[i
] != '+' && !isspace(UCHAR(str
[i
]))) {
492 /* Parse according to this base */
495 /* Parse as base 10 */
500 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
501 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
503 static long jim_strtol(const char *str
, char **endptr
)
507 int i
= JimNumberBase(str
, &base
, &sign
);
510 long value
= strtol(str
+ i
, endptr
, base
);
511 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
516 /* Can just do a regular base-10 conversion */
517 return strtol(str
, endptr
, 10);
521 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
522 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
524 static jim_wide
jim_strtoull(const char *str
, char **endptr
)
526 #ifdef HAVE_LONG_LONG
529 int i
= JimNumberBase(str
, &base
, &sign
);
532 jim_wide value
= strtoull(str
+ i
, endptr
, base
);
533 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
538 /* Can just do a regular base-10 conversion */
539 return strtoull(str
, endptr
, 10);
541 return (unsigned long)jim_strtol(str
, endptr
);
545 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
550 *widePtr
= strtoull(str
, &endptr
, base
);
553 *widePtr
= jim_strtoull(str
, &endptr
);
556 return JimCheckConversion(str
, endptr
);
559 int Jim_StringToDouble(const char *str
, double *doublePtr
)
563 /* Callers can check for underflow via ERANGE */
566 *doublePtr
= strtod(str
, &endptr
);
568 return JimCheckConversion(str
, endptr
);
571 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
584 /* Only special case is -1 ^ -n
602 /* -----------------------------------------------------------------------------
604 * ---------------------------------------------------------------------------*/
605 #ifdef JIM_DEBUG_PANIC
606 static void JimPanicDump(int condition
, const char *fmt
, ...)
616 fprintf(stderr
, "\nJIM INTERPRETER PANIC: ");
617 vfprintf(stderr
, fmt
, ap
);
618 fprintf(stderr
, "\n\n");
621 #ifdef HAVE_BACKTRACE
627 size
= backtrace(array
, 40);
628 strings
= backtrace_symbols(array
, size
);
629 for (i
= 0; i
< size
; i
++)
630 fprintf(stderr
, "[backtrace] %s\n", strings
[i
]);
631 fprintf(stderr
, "[backtrace] Include the above lines and the output\n");
632 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report.\n");
640 /* -----------------------------------------------------------------------------
642 * ---------------------------------------------------------------------------*/
644 void *Jim_Alloc(int size
)
646 return size
? malloc(size
) : NULL
;
649 void Jim_Free(void *ptr
)
654 void *Jim_Realloc(void *ptr
, int size
)
656 return realloc(ptr
, size
);
659 char *Jim_StrDup(const char *s
)
664 char *Jim_StrDupLen(const char *s
, int l
)
666 char *copy
= Jim_Alloc(l
+ 1);
668 memcpy(copy
, s
, l
+ 1);
669 copy
[l
] = 0; /* Just to be sure, original could be substring */
673 /* -----------------------------------------------------------------------------
674 * Time related functions
675 * ---------------------------------------------------------------------------*/
677 /* Returns current time in microseconds */
678 static jim_wide
JimClock(void)
682 gettimeofday(&tv
, NULL
);
683 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
686 /* -----------------------------------------------------------------------------
688 * ---------------------------------------------------------------------------*/
690 /* -------------------------- private prototypes ---------------------------- */
691 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
692 static unsigned int JimHashTableNextPower(unsigned int size
);
693 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
);
695 /* -------------------------- hash functions -------------------------------- */
697 /* Thomas Wang's 32 bit Mix Function */
698 unsigned int Jim_IntHashFunction(unsigned int key
)
709 /* Generic hash function (we are using to multiply by 9 and add the byte
711 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
716 h
+= (h
<< 3) + *buf
++;
720 /* ----------------------------- API implementation ------------------------- */
722 /* reset a hashtable already initialized */
723 static void JimResetHashTable(Jim_HashTable
*ht
)
730 #ifdef JIM_RANDOMISE_HASH
731 /* This is initialised to a random value to avoid a hash collision attack.
732 * See: n.runs-SA-2011.004
734 ht
->uniq
= (rand() ^ time(NULL
) ^ clock());
740 static void JimInitHashTableIterator(Jim_HashTable
*ht
, Jim_HashTableIterator
*iter
)
745 iter
->nextEntry
= NULL
;
748 /* Initialize the hash table */
749 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
751 JimResetHashTable(ht
);
753 ht
->privdata
= privDataPtr
;
757 /* Resize the table to the minimal size that contains all the elements,
758 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
759 void Jim_ResizeHashTable(Jim_HashTable
*ht
)
761 int minimal
= ht
->used
;
763 if (minimal
< JIM_HT_INITIAL_SIZE
)
764 minimal
= JIM_HT_INITIAL_SIZE
;
765 Jim_ExpandHashTable(ht
, minimal
);
768 /* Expand or create the hashtable */
769 void Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
771 Jim_HashTable n
; /* the new hashtable */
772 unsigned int realsize
= JimHashTableNextPower(size
), i
;
774 /* the size is invalid if it is smaller than the number of
775 * elements already inside the hashtable */
776 if (size
<= ht
->used
)
779 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
781 n
.sizemask
= realsize
- 1;
782 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
783 /* Keep the same 'uniq' as the original */
786 /* Initialize all the pointers to NULL */
787 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
789 /* Copy all the elements from the old to the new table:
790 * note that if the old hash table is empty ht->used is zero,
791 * so Jim_ExpandHashTable just creates an empty hash table. */
793 for (i
= 0; ht
->used
> 0; i
++) {
794 Jim_HashEntry
*he
, *nextHe
;
796 if (ht
->table
[i
] == NULL
)
799 /* For each hash entry on this slot... */
805 /* Get the new element index */
806 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
807 he
->next
= n
.table
[h
];
810 /* Pass to the next element */
814 assert(ht
->used
== 0);
817 /* Remap the new hashtable in the old */
821 /* Add an element to the target hash table */
822 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
824 Jim_HashEntry
*entry
;
826 /* Get the index of the new element, or -1 if
827 * the element already exists. */
828 entry
= JimInsertHashEntry(ht
, key
, 0);
832 /* Set the hash entry fields. */
833 Jim_SetHashKey(ht
, entry
, key
);
834 Jim_SetHashVal(ht
, entry
, val
);
838 /* Add an element, discarding the old if the key already exists */
839 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
842 Jim_HashEntry
*entry
;
844 /* Get the index of the new element, or -1 if
845 * the element already exists. */
846 entry
= JimInsertHashEntry(ht
, key
, 1);
848 /* It already exists, so only replace the value.
849 * Note if both a destructor and a duplicate function exist,
850 * need to dup before destroy. perhaps they are the same
851 * reference counted object
853 if (ht
->type
->valDestructor
&& ht
->type
->valDup
) {
854 void *newval
= ht
->type
->valDup(ht
->privdata
, val
);
855 ht
->type
->valDestructor(ht
->privdata
, entry
->u
.val
);
856 entry
->u
.val
= newval
;
859 Jim_FreeEntryVal(ht
, entry
);
860 Jim_SetHashVal(ht
, entry
, val
);
865 /* Doesn't exist, so set the key */
866 Jim_SetHashKey(ht
, entry
, key
);
867 Jim_SetHashVal(ht
, entry
, val
);
874 /* Search and remove an element */
875 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
878 Jim_HashEntry
*he
, *prevHe
;
882 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
887 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
888 /* Unlink the element from the list */
890 prevHe
->next
= he
->next
;
892 ht
->table
[h
] = he
->next
;
893 Jim_FreeEntryKey(ht
, he
);
894 Jim_FreeEntryVal(ht
, he
);
902 return JIM_ERR
; /* not found */
905 /* Destroy an entire hash table and leave it ready for reuse */
906 int Jim_FreeHashTable(Jim_HashTable
*ht
)
910 /* Free all the elements */
911 for (i
= 0; ht
->used
> 0; i
++) {
912 Jim_HashEntry
*he
, *nextHe
;
914 if ((he
= ht
->table
[i
]) == NULL
)
918 Jim_FreeEntryKey(ht
, he
);
919 Jim_FreeEntryVal(ht
, he
);
925 /* Free the table and the allocated cache structure */
927 /* Re-initialize the table */
928 JimResetHashTable(ht
);
929 return JIM_OK
; /* never fails */
932 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
939 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
942 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
949 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
951 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
952 JimInitHashTableIterator(ht
, iter
);
956 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
959 if (iter
->entry
== NULL
) {
961 if (iter
->index
>= (signed)iter
->ht
->size
)
963 iter
->entry
= iter
->ht
->table
[iter
->index
];
966 iter
->entry
= iter
->nextEntry
;
969 /* We need to save the 'next' here, the iterator user
970 * may delete the entry we are returning. */
971 iter
->nextEntry
= iter
->entry
->next
;
978 /* ------------------------- private functions ------------------------------ */
980 /* Expand the hash table if needed */
981 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
983 /* If the hash table is empty expand it to the intial size,
984 * if the table is "full" dobule its size. */
986 Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
987 if (ht
->size
== ht
->used
)
988 Jim_ExpandHashTable(ht
, ht
->size
* 2);
991 /* Our hash table capability is a power of two */
992 static unsigned int JimHashTableNextPower(unsigned int size
)
994 unsigned int i
= JIM_HT_INITIAL_SIZE
;
996 if (size
>= 2147483648U)
1005 /* Returns the index of a free slot that can be populated with
1006 * a hash entry for the given 'key'.
1007 * If the key already exists, -1 is returned. */
1008 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
)
1013 /* Expand the hashtable if needed */
1014 JimExpandHashTableIfNeeded(ht
);
1016 /* Compute the key hash value */
1017 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
1018 /* Search if this slot does not already contain the given key */
1021 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
1022 return replace
? he
: NULL
;
1026 /* Allocates the memory and stores key */
1027 he
= Jim_Alloc(sizeof(*he
));
1028 he
->next
= ht
->table
[h
];
1036 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1038 static unsigned int JimStringCopyHTHashFunction(const void *key
)
1040 return Jim_GenHashFunction(key
, strlen(key
));
1043 static void *JimStringCopyHTDup(void *privdata
, const void *key
)
1045 return Jim_StrDup(key
);
1048 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
1050 return strcmp(key1
, key2
) == 0;
1053 static void JimStringCopyHTKeyDestructor(void *privdata
, void *key
)
1058 static const Jim_HashTableType JimPackageHashTableType
= {
1059 JimStringCopyHTHashFunction
, /* hash function */
1060 JimStringCopyHTDup
, /* key dup */
1062 JimStringCopyHTKeyCompare
, /* key compare */
1063 JimStringCopyHTKeyDestructor
, /* key destructor */
1064 NULL
/* val destructor */
1067 typedef struct AssocDataValue
1069 Jim_InterpDeleteProc
*delProc
;
1073 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1075 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
1077 if (assocPtr
->delProc
!= NULL
)
1078 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1082 static const Jim_HashTableType JimAssocDataHashTableType
= {
1083 JimStringCopyHTHashFunction
, /* hash function */
1084 JimStringCopyHTDup
, /* key dup */
1086 JimStringCopyHTKeyCompare
, /* key compare */
1087 JimStringCopyHTKeyDestructor
, /* key destructor */
1088 JimAssocDataHashTableValueDestructor
/* val destructor */
1091 /* -----------------------------------------------------------------------------
1092 * Stack - This is a simple generic stack implementation. It is used for
1093 * example in the 'expr' expression compiler.
1094 * ---------------------------------------------------------------------------*/
1095 void Jim_InitStack(Jim_Stack
*stack
)
1099 stack
->vector
= NULL
;
1102 void Jim_FreeStack(Jim_Stack
*stack
)
1104 Jim_Free(stack
->vector
);
1107 int Jim_StackLen(Jim_Stack
*stack
)
1112 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
1114 int neededLen
= stack
->len
+ 1;
1116 if (neededLen
> stack
->maxlen
) {
1117 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
1118 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
1120 stack
->vector
[stack
->len
] = element
;
1124 void *Jim_StackPop(Jim_Stack
*stack
)
1126 if (stack
->len
== 0)
1129 return stack
->vector
[stack
->len
];
1132 void *Jim_StackPeek(Jim_Stack
*stack
)
1134 if (stack
->len
== 0)
1136 return stack
->vector
[stack
->len
- 1];
1139 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
1143 for (i
= 0; i
< stack
->len
; i
++)
1144 freeFunc(stack
->vector
[i
]);
1147 /* -----------------------------------------------------------------------------
1149 * ---------------------------------------------------------------------------*/
1152 #define JIM_TT_NONE 0 /* No token returned */
1153 #define JIM_TT_STR 1 /* simple string */
1154 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1155 #define JIM_TT_VAR 3 /* var substitution */
1156 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1157 #define JIM_TT_CMD 5 /* command substitution */
1158 /* Note: Keep these three together for TOKEN_IS_SEP() */
1159 #define JIM_TT_SEP 6 /* word separator (white space) */
1160 #define JIM_TT_EOL 7 /* line separator */
1161 #define JIM_TT_EOF 8 /* end of script */
1163 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1164 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1166 /* Additional token types needed for expressions */
1167 #define JIM_TT_SUBEXPR_START 11
1168 #define JIM_TT_SUBEXPR_END 12
1169 #define JIM_TT_SUBEXPR_COMMA 13
1170 #define JIM_TT_EXPR_INT 14
1171 #define JIM_TT_EXPR_DOUBLE 15
1172 #define JIM_TT_EXPR_BOOLEAN 16
1174 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1176 /* Operator token types start here */
1177 #define JIM_TT_EXPR_OP 20
1179 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1180 /* Can this token start an expression? */
1181 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1182 /* Is this token an expression operator? */
1183 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1186 * Results of missing quotes, braces, etc. from parsing.
1188 struct JimParseMissing
{
1189 int ch
; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1190 int line
; /* Line number starting the missing token */
1193 /* Parser context structure. The same context is used both to parse
1194 * Tcl scripts and lists. */
1197 const char *p
; /* Pointer to the point of the program we are parsing */
1198 int len
; /* Remaining length */
1199 int linenr
; /* Current line number */
1201 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1202 int tline
; /* Line number of the returned token */
1203 int tt
; /* Token type */
1204 int eof
; /* Non zero if EOF condition is true. */
1205 int inquote
; /* Parsing a quoted string */
1206 int comment
; /* Non zero if the next chars may be a comment. */
1207 struct JimParseMissing missing
; /* Details of any missing quotes, etc. */
1210 static int JimParseScript(struct JimParserCtx
*pc
);
1211 static int JimParseSep(struct JimParserCtx
*pc
);
1212 static int JimParseEol(struct JimParserCtx
*pc
);
1213 static int JimParseCmd(struct JimParserCtx
*pc
);
1214 static int JimParseQuote(struct JimParserCtx
*pc
);
1215 static int JimParseVar(struct JimParserCtx
*pc
);
1216 static int JimParseBrace(struct JimParserCtx
*pc
);
1217 static int JimParseStr(struct JimParserCtx
*pc
);
1218 static int JimParseComment(struct JimParserCtx
*pc
);
1219 static void JimParseSubCmd(struct JimParserCtx
*pc
);
1220 static int JimParseSubQuote(struct JimParserCtx
*pc
);
1221 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
1223 /* Initialize a parser context.
1224 * 'prg' is a pointer to the program text, linenr is the line
1225 * number of the first line contained in the program. */
1226 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1233 pc
->tt
= JIM_TT_NONE
;
1236 pc
->linenr
= linenr
;
1238 pc
->missing
.ch
= ' ';
1239 pc
->missing
.line
= linenr
;
1242 static int JimParseScript(struct JimParserCtx
*pc
)
1244 while (1) { /* the while is used to reiterate with continue if needed */
1247 pc
->tend
= pc
->p
- 1;
1248 pc
->tline
= pc
->linenr
;
1249 pc
->tt
= JIM_TT_EOL
;
1255 if (*(pc
->p
+ 1) == '\n' && !pc
->inquote
) {
1256 return JimParseSep(pc
);
1259 return JimParseStr(pc
);
1265 return JimParseSep(pc
);
1267 return JimParseStr(pc
);
1272 return JimParseEol(pc
);
1273 return JimParseStr(pc
);
1276 return JimParseCmd(pc
);
1279 if (JimParseVar(pc
) == JIM_ERR
) {
1280 /* An orphan $. Create as a separate token */
1281 pc
->tstart
= pc
->tend
= pc
->p
++;
1283 pc
->tt
= JIM_TT_ESC
;
1288 JimParseComment(pc
);
1291 return JimParseStr(pc
);
1294 return JimParseStr(pc
);
1300 static int JimParseSep(struct JimParserCtx
*pc
)
1303 pc
->tline
= pc
->linenr
;
1304 while (isspace(UCHAR(*pc
->p
)) || (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1305 if (*pc
->p
== '\n') {
1308 if (*pc
->p
== '\\') {
1316 pc
->tend
= pc
->p
- 1;
1317 pc
->tt
= JIM_TT_SEP
;
1321 static int JimParseEol(struct JimParserCtx
*pc
)
1324 pc
->tline
= pc
->linenr
;
1325 while (isspace(UCHAR(*pc
->p
)) || *pc
->p
== ';') {
1331 pc
->tend
= pc
->p
- 1;
1332 pc
->tt
= JIM_TT_EOL
;
1337 ** Here are the rules for parsing:
1338 ** {braced expression}
1339 ** - Count open and closing braces
1340 ** - Backslash escapes meaning of braces
1342 ** "quoted expression"
1343 ** - First double quote at start of word terminates the expression
1344 ** - Backslash escapes quote and bracket
1345 ** - [commands brackets] are counted/nested
1346 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1348 ** [command expression]
1349 ** - Count open and closing brackets
1350 ** - Backslash escapes quote, bracket and brace
1351 ** - [commands brackets] are counted/nested
1352 ** - "quoted expressions" are parsed according to quoting rules
1353 ** - {braced expressions} are parsed according to brace rules
1355 ** For everything, backslash escapes the next char, newline increments current line
1359 * Parses a braced expression starting at pc->p.
1361 * Positions the parser at the end of the braced expression,
1362 * sets pc->tend and possibly pc->missing.
1364 static void JimParseSubBrace(struct JimParserCtx
*pc
)
1368 /* Skip the brace */
1375 if (*++pc
->p
== '\n') {
1388 pc
->tend
= pc
->p
- 1;
1402 pc
->missing
.ch
= '{';
1403 pc
->missing
.line
= pc
->tline
;
1404 pc
->tend
= pc
->p
- 1;
1408 * Parses a quoted expression starting at pc->p.
1410 * Positions the parser at the end of the quoted expression,
1411 * sets pc->tend and possibly pc->missing.
1413 * Returns the type of the token of the string,
1414 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1417 static int JimParseSubQuote(struct JimParserCtx
*pc
)
1419 int tt
= JIM_TT_STR
;
1420 int line
= pc
->tline
;
1422 /* Skip the quote */
1429 if (*++pc
->p
== '\n') {
1438 pc
->tend
= pc
->p
- 1;
1459 pc
->missing
.ch
= '"';
1460 pc
->missing
.line
= line
;
1461 pc
->tend
= pc
->p
- 1;
1466 * Parses a [command] expression starting at pc->p.
1468 * Positions the parser at the end of the command expression,
1469 * sets pc->tend and possibly pc->missing.
1471 static void JimParseSubCmd(struct JimParserCtx
*pc
)
1474 int startofword
= 1;
1475 int line
= pc
->tline
;
1477 /* Skip the bracket */
1484 if (*++pc
->p
== '\n') {
1497 pc
->tend
= pc
->p
- 1;
1506 JimParseSubQuote(pc
);
1512 JimParseSubBrace(pc
);
1520 startofword
= isspace(UCHAR(*pc
->p
));
1524 pc
->missing
.ch
= '[';
1525 pc
->missing
.line
= line
;
1526 pc
->tend
= pc
->p
- 1;
1529 static int JimParseBrace(struct JimParserCtx
*pc
)
1531 pc
->tstart
= pc
->p
+ 1;
1532 pc
->tline
= pc
->linenr
;
1533 pc
->tt
= JIM_TT_STR
;
1534 JimParseSubBrace(pc
);
1538 static int JimParseCmd(struct JimParserCtx
*pc
)
1540 pc
->tstart
= pc
->p
+ 1;
1541 pc
->tline
= pc
->linenr
;
1542 pc
->tt
= JIM_TT_CMD
;
1547 static int JimParseQuote(struct JimParserCtx
*pc
)
1549 pc
->tstart
= pc
->p
+ 1;
1550 pc
->tline
= pc
->linenr
;
1551 pc
->tt
= JimParseSubQuote(pc
);
1555 static int JimParseVar(struct JimParserCtx
*pc
)
1561 #ifdef EXPRSUGAR_BRACKET
1562 if (*pc
->p
== '[') {
1563 /* Parse $[...] expr shorthand syntax */
1565 pc
->tt
= JIM_TT_EXPRSUGAR
;
1571 pc
->tt
= JIM_TT_VAR
;
1572 pc
->tline
= pc
->linenr
;
1574 if (*pc
->p
== '{') {
1575 pc
->tstart
= ++pc
->p
;
1578 while (pc
->len
&& *pc
->p
!= '}') {
1579 if (*pc
->p
== '\n') {
1585 pc
->tend
= pc
->p
- 1;
1593 /* Skip double colon, but not single colon! */
1594 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
1595 while (*pc
->p
== ':') {
1601 /* Note that any char >= 0x80 must be part of a utf-8 char.
1602 * We consider all unicode points outside of ASCII as letters
1604 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_' || UCHAR(*pc
->p
) >= 0x80) {
1611 /* Parse [dict get] syntax sugar. */
1612 if (*pc
->p
== '(') {
1614 const char *paren
= NULL
;
1616 pc
->tt
= JIM_TT_DICTSUGAR
;
1618 while (count
&& pc
->len
) {
1621 if (*pc
->p
== '\\' && pc
->len
>= 1) {
1625 else if (*pc
->p
== '(') {
1628 else if (*pc
->p
== ')') {
1638 /* Did not find a matching paren. Back up */
1640 pc
->len
+= (pc
->p
- paren
);
1643 #ifndef EXPRSUGAR_BRACKET
1644 if (*pc
->tstart
== '(') {
1645 pc
->tt
= JIM_TT_EXPRSUGAR
;
1649 pc
->tend
= pc
->p
- 1;
1651 /* Check if we parsed just the '$' character.
1652 * That's not a variable so an error is returned
1653 * to tell the state machine to consider this '$' just
1655 if (pc
->tstart
== pc
->p
) {
1663 static int JimParseStr(struct JimParserCtx
*pc
)
1665 if (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1666 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
) {
1667 /* Starting a new word */
1668 if (*pc
->p
== '{') {
1669 return JimParseBrace(pc
);
1671 if (*pc
->p
== '"') {
1675 /* In case the end quote is missing */
1676 pc
->missing
.line
= pc
->tline
;
1680 pc
->tline
= pc
->linenr
;
1684 pc
->missing
.ch
= '"';
1686 pc
->tend
= pc
->p
- 1;
1687 pc
->tt
= JIM_TT_ESC
;
1692 if (!pc
->inquote
&& *(pc
->p
+ 1) == '\n') {
1693 pc
->tend
= pc
->p
- 1;
1694 pc
->tt
= JIM_TT_ESC
;
1698 if (*(pc
->p
+ 1) == '\n') {
1704 else if (pc
->len
== 1) {
1705 /* End of script with trailing backslash */
1706 pc
->missing
.ch
= '\\';
1710 /* If the following token is not '$' just keep going */
1711 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1716 /* Only need a separate ')' token if the previous was a var */
1717 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1718 if (pc
->p
== pc
->tstart
) {
1719 /* At the start of the token, so just return this char */
1723 pc
->tend
= pc
->p
- 1;
1724 pc
->tt
= JIM_TT_ESC
;
1731 pc
->tend
= pc
->p
- 1;
1732 pc
->tt
= JIM_TT_ESC
;
1741 pc
->tend
= pc
->p
- 1;
1742 pc
->tt
= JIM_TT_ESC
;
1745 else if (*pc
->p
== '\n') {
1751 pc
->tend
= pc
->p
- 1;
1752 pc
->tt
= JIM_TT_ESC
;
1763 return JIM_OK
; /* unreached */
1766 static int JimParseComment(struct JimParserCtx
*pc
)
1769 if (*pc
->p
== '\\') {
1773 pc
->missing
.ch
= '\\';
1776 if (*pc
->p
== '\n') {
1780 else if (*pc
->p
== '\n') {
1792 /* xdigitval and odigitval are helper functions for JimEscape() */
1793 static int xdigitval(int c
)
1795 if (c
>= '0' && c
<= '9')
1797 if (c
>= 'a' && c
<= 'f')
1798 return c
- 'a' + 10;
1799 if (c
>= 'A' && c
<= 'F')
1800 return c
- 'A' + 10;
1804 static int odigitval(int c
)
1806 if (c
>= '0' && c
<= '7')
1811 /* Perform Tcl escape substitution of 's', storing the result
1812 * string into 'dest'. The escaped string is guaranteed to
1813 * be the same length or shorted than the source string.
1814 * Slen is the length of the string at 's'.
1816 * The function returns the length of the resulting string. */
1817 static int JimEscape(char *dest
, const char *s
, int slen
)
1822 for (i
= 0; i
< slen
; i
++) {
1853 /* A unicode or hex sequence.
1854 * \x Expect 1-2 hex chars and convert to hex.
1855 * \u Expect 1-4 hex chars and convert to utf-8.
1856 * \U Expect 1-8 hex chars and convert to utf-8.
1857 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1858 * An invalid sequence means simply the escaped char.
1870 else if (s
[i
] == 'u') {
1871 if (s
[i
+ 1] == '{') {
1880 for (k
= 0; k
< maxchars
; k
++) {
1881 int c
= xdigitval(s
[i
+ k
+ 1]);
1885 val
= (val
<< 4) | c
;
1887 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1889 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1895 /* Skip the closing brace */
1900 /* Got a valid sequence, so convert */
1905 p
+= utf8_fromunicode(p
, val
);
1910 /* Not a valid codepoint, just an escaped char */
1923 /* Replace all spaces and tabs after backslash newline with a single space*/
1927 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1940 int c
= odigitval(s
[i
+ 1]);
1943 c
= odigitval(s
[i
+ 2]);
1949 val
= (val
* 8) + c
;
1950 c
= odigitval(s
[i
+ 3]);
1956 val
= (val
* 8) + c
;
1977 /* Returns a dynamically allocated copy of the current token in the
1978 * parser context. The function performs conversion of escapes if
1979 * the token is of type JIM_TT_ESC.
1981 * Note that after the conversion, tokens that are grouped with
1982 * braces in the source code, are always recognizable from the
1983 * identical string obtained in a different way from the type.
1985 * For example the string:
1989 * will return as first token "*", of type JIM_TT_STR
1995 * will return as first token "*", of type JIM_TT_ESC
1997 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
1999 const char *start
, *end
;
2007 token
= Jim_Alloc(1);
2011 len
= (end
- start
) + 1;
2012 token
= Jim_Alloc(len
+ 1);
2013 if (pc
->tt
!= JIM_TT_ESC
) {
2014 /* No escape conversion needed? Just copy it. */
2015 memcpy(token
, start
, len
);
2019 /* Else convert the escape chars. */
2020 len
= JimEscape(token
, start
, len
);
2024 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
2027 /* -----------------------------------------------------------------------------
2029 * ---------------------------------------------------------------------------*/
2030 static int JimParseListSep(struct JimParserCtx
*pc
);
2031 static int JimParseListStr(struct JimParserCtx
*pc
);
2032 static int JimParseListQuote(struct JimParserCtx
*pc
);
2034 static int JimParseList(struct JimParserCtx
*pc
)
2036 if (isspace(UCHAR(*pc
->p
))) {
2037 return JimParseListSep(pc
);
2041 return JimParseListQuote(pc
);
2044 return JimParseBrace(pc
);
2048 return JimParseListStr(pc
);
2053 pc
->tstart
= pc
->tend
= pc
->p
;
2054 pc
->tline
= pc
->linenr
;
2055 pc
->tt
= JIM_TT_EOL
;
2060 static int JimParseListSep(struct JimParserCtx
*pc
)
2063 pc
->tline
= pc
->linenr
;
2064 while (isspace(UCHAR(*pc
->p
))) {
2065 if (*pc
->p
== '\n') {
2071 pc
->tend
= pc
->p
- 1;
2072 pc
->tt
= JIM_TT_SEP
;
2076 static int JimParseListQuote(struct JimParserCtx
*pc
)
2082 pc
->tline
= pc
->linenr
;
2083 pc
->tt
= JIM_TT_STR
;
2088 pc
->tt
= JIM_TT_ESC
;
2089 if (--pc
->len
== 0) {
2090 /* Trailing backslash */
2100 pc
->tend
= pc
->p
- 1;
2109 pc
->tend
= pc
->p
- 1;
2113 static int JimParseListStr(struct JimParserCtx
*pc
)
2116 pc
->tline
= pc
->linenr
;
2117 pc
->tt
= JIM_TT_STR
;
2120 if (isspace(UCHAR(*pc
->p
))) {
2121 pc
->tend
= pc
->p
- 1;
2124 if (*pc
->p
== '\\') {
2125 if (--pc
->len
== 0) {
2126 /* Trailing backslash */
2130 pc
->tt
= JIM_TT_ESC
;
2136 pc
->tend
= pc
->p
- 1;
2140 /* -----------------------------------------------------------------------------
2141 * Jim_Obj related functions
2142 * ---------------------------------------------------------------------------*/
2144 /* Return a new initialized object. */
2145 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2149 /* -- Check if there are objects in the free list -- */
2150 if (interp
->freeList
!= NULL
) {
2151 /* -- Unlink the object from the free list -- */
2152 objPtr
= interp
->freeList
;
2153 interp
->freeList
= objPtr
->nextObjPtr
;
2156 /* -- No ready to use objects: allocate a new one -- */
2157 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2160 /* Object is returned with refCount of 0. Every
2161 * kind of GC implemented should take care to don't try
2162 * to scan objects with refCount == 0. */
2163 objPtr
->refCount
= 0;
2164 /* All the other fields are left not initialized to save time.
2165 * The caller will probably want to set them to the right
2168 /* -- Put the object into the live list -- */
2169 objPtr
->prevObjPtr
= NULL
;
2170 objPtr
->nextObjPtr
= interp
->liveList
;
2171 if (interp
->liveList
)
2172 interp
->liveList
->prevObjPtr
= objPtr
;
2173 interp
->liveList
= objPtr
;
2178 /* Free an object. Actually objects are never freed, but
2179 * just moved to the free objects list, where they will be
2180 * reused by Jim_NewObj(). */
2181 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2183 /* Check if the object was already freed, panic. */
2184 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2185 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2187 /* Free the internal representation */
2188 Jim_FreeIntRep(interp
, objPtr
);
2189 /* Free the string representation */
2190 if (objPtr
->bytes
!= NULL
) {
2191 if (objPtr
->bytes
!= JimEmptyStringRep
)
2192 Jim_Free(objPtr
->bytes
);
2194 /* Unlink the object from the live objects list */
2195 if (objPtr
->prevObjPtr
)
2196 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2197 if (objPtr
->nextObjPtr
)
2198 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2199 if (interp
->liveList
== objPtr
)
2200 interp
->liveList
= objPtr
->nextObjPtr
;
2201 #ifdef JIM_DISABLE_OBJECT_POOL
2204 /* Link the object into the free objects list */
2205 objPtr
->prevObjPtr
= NULL
;
2206 objPtr
->nextObjPtr
= interp
->freeList
;
2207 if (interp
->freeList
)
2208 interp
->freeList
->prevObjPtr
= objPtr
;
2209 interp
->freeList
= objPtr
;
2210 objPtr
->refCount
= -1;
2214 /* Invalidate the string representation of an object. */
2215 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2217 if (objPtr
->bytes
!= NULL
) {
2218 if (objPtr
->bytes
!= JimEmptyStringRep
)
2219 Jim_Free(objPtr
->bytes
);
2221 objPtr
->bytes
= NULL
;
2224 /* Duplicate an object. The returned object has refcount = 0. */
2225 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2229 dupPtr
= Jim_NewObj(interp
);
2230 if (objPtr
->bytes
== NULL
) {
2231 /* Object does not have a valid string representation. */
2232 dupPtr
->bytes
= NULL
;
2234 else if (objPtr
->length
== 0) {
2235 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2236 dupPtr
->bytes
= JimEmptyStringRep
;
2238 dupPtr
->typePtr
= NULL
;
2242 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2243 dupPtr
->length
= objPtr
->length
;
2244 /* Copy the null byte too */
2245 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2248 /* By default, the new object has the same type as the old object */
2249 dupPtr
->typePtr
= objPtr
->typePtr
;
2250 if (objPtr
->typePtr
!= NULL
) {
2251 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2252 dupPtr
->internalRep
= objPtr
->internalRep
;
2255 /* The dup proc may set a different type, e.g. NULL */
2256 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2262 /* Return the string representation for objPtr. If the object's
2263 * string representation is invalid, calls the updateStringProc method to create
2264 * a new one from the internal representation of the object.
2266 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2268 if (objPtr
->bytes
== NULL
) {
2269 /* Invalid string repr. Generate it. */
2270 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2271 objPtr
->typePtr
->updateStringProc(objPtr
);
2274 *lenPtr
= objPtr
->length
;
2275 return objPtr
->bytes
;
2278 /* Just returns the length of the object's string rep */
2279 int Jim_Length(Jim_Obj
*objPtr
)
2281 if (objPtr
->bytes
== NULL
) {
2282 /* Invalid string repr. Generate it. */
2283 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2284 objPtr
->typePtr
->updateStringProc(objPtr
);
2286 return objPtr
->length
;
2289 /* Just returns object's string rep */
2290 const char *Jim_String(Jim_Obj
*objPtr
)
2292 if (objPtr
->bytes
== NULL
) {
2293 /* Invalid string repr. Generate it. */
2294 JimPanic((objPtr
->typePtr
== NULL
, "UpdateStringProc called against typeless value."));
2295 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2296 objPtr
->typePtr
->updateStringProc(objPtr
);
2298 return objPtr
->bytes
;
2301 static void JimSetStringBytes(Jim_Obj
*objPtr
, const char *str
)
2303 objPtr
->bytes
= Jim_StrDup(str
);
2304 objPtr
->length
= strlen(str
);
2307 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2308 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2310 static const Jim_ObjType dictSubstObjType
= {
2311 "dict-substitution",
2312 FreeDictSubstInternalRep
,
2313 DupDictSubstInternalRep
,
2318 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2320 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
2323 static const Jim_ObjType interpolatedObjType
= {
2325 FreeInterpolatedInternalRep
,
2331 /* -----------------------------------------------------------------------------
2333 * ---------------------------------------------------------------------------*/
2334 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2335 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2337 static const Jim_ObjType stringObjType
= {
2340 DupStringInternalRep
,
2342 JIM_TYPE_REFERENCES
,
2345 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2347 JIM_NOTUSED(interp
);
2349 /* This is a bit subtle: the only caller of this function
2350 * should be Jim_DuplicateObj(), that will copy the
2351 * string representaion. After the copy, the duplicated
2352 * object will not have more room in the buffer than
2353 * srcPtr->length bytes. So we just set it to length. */
2354 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
2355 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
2358 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2360 if (objPtr
->typePtr
!= &stringObjType
) {
2361 /* Get a fresh string representation. */
2362 if (objPtr
->bytes
== NULL
) {
2363 /* Invalid string repr. Generate it. */
2364 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2365 objPtr
->typePtr
->updateStringProc(objPtr
);
2367 /* Free any other internal representation. */
2368 Jim_FreeIntRep(interp
, objPtr
);
2369 /* Set it as string, i.e. just set the maxLength field. */
2370 objPtr
->typePtr
= &stringObjType
;
2371 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
2372 /* Don't know the utf-8 length yet */
2373 objPtr
->internalRep
.strValue
.charLength
= -1;
2379 * Returns the length of the object string in chars, not bytes.
2381 * These may be different for a utf-8 string.
2383 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2386 SetStringFromAny(interp
, objPtr
);
2388 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
2389 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
2391 return objPtr
->internalRep
.strValue
.charLength
;
2393 return Jim_Length(objPtr
);
2397 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2398 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
2400 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2402 /* Need to find out how many bytes the string requires */
2405 /* Alloc/Set the string rep. */
2407 objPtr
->bytes
= JimEmptyStringRep
;
2410 objPtr
->bytes
= Jim_Alloc(len
+ 1);
2411 memcpy(objPtr
->bytes
, s
, len
);
2412 objPtr
->bytes
[len
] = '\0';
2414 objPtr
->length
= len
;
2416 /* No typePtr field for the vanilla string object. */
2417 objPtr
->typePtr
= NULL
;
2421 /* charlen is in characters -- see also Jim_NewStringObj() */
2422 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
2425 /* Need to find out how many bytes the string requires */
2426 int bytelen
= utf8_index(s
, charlen
);
2428 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
2430 /* Remember the utf8 length, so set the type */
2431 objPtr
->typePtr
= &stringObjType
;
2432 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
2433 objPtr
->internalRep
.strValue
.charLength
= charlen
;
2437 return Jim_NewStringObj(interp
, s
, charlen
);
2441 /* This version does not try to duplicate the 's' pointer, but
2442 * use it directly. */
2443 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2445 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2448 objPtr
->length
= (len
== -1) ? strlen(s
) : len
;
2449 objPtr
->typePtr
= NULL
;
2453 /* Low-level string append. Use it only against unshared objects
2454 * of type "string". */
2455 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2461 needlen
= objPtr
->length
+ len
;
2462 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2463 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2465 /* Inefficient to malloc() for less than 8 bytes */
2469 if (objPtr
->bytes
== JimEmptyStringRep
) {
2470 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
2473 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
2475 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
2477 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2478 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2480 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
2481 /* Update the utf-8 char length */
2482 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
2484 objPtr
->length
+= len
;
2487 /* Higher level API to append strings to objects.
2488 * Object must not be unshared for each of these.
2490 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2492 JimPanic((Jim_IsShared(objPtr
), "Jim_AppendString called with shared object"));
2493 SetStringFromAny(interp
, objPtr
);
2494 StringAppendString(objPtr
, str
, len
);
2497 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2500 const char *str
= Jim_GetString(appendObjPtr
, &len
);
2501 Jim_AppendString(interp
, objPtr
, str
, len
);
2504 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2508 SetStringFromAny(interp
, objPtr
);
2509 va_start(ap
, objPtr
);
2511 const char *s
= va_arg(ap
, const char *);
2515 Jim_AppendString(interp
, objPtr
, s
, -1);
2520 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
2522 if (aObjPtr
== bObjPtr
) {
2527 const char *sA
= Jim_GetString(aObjPtr
, &Alen
);
2528 const char *sB
= Jim_GetString(bObjPtr
, &Blen
);
2530 return Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0;
2535 * Note. Does not support embedded nulls in either the pattern or the object.
2537 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2539 return JimGlobMatch(Jim_String(patternObjPtr
), Jim_String(objPtr
), nocase
);
2543 * Note: does not support embedded nulls for the nocase option.
2545 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2548 const char *s1
= Jim_GetString(firstObjPtr
, &l1
);
2549 const char *s2
= Jim_GetString(secondObjPtr
, &l2
);
2552 /* Do a character compare for nocase */
2553 return JimStringCompareLen(s1
, s2
, -1, nocase
);
2555 return JimStringCompare(s1
, l1
, s2
, l2
);
2559 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2561 * Note: does not support embedded nulls
2563 int Jim_StringCompareLenObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2565 const char *s1
= Jim_String(firstObjPtr
);
2566 const char *s2
= Jim_String(secondObjPtr
);
2568 return JimStringCompareLen(s1
, s2
, Jim_Utf8Length(interp
, firstObjPtr
), nocase
);
2571 /* Convert a range, as returned by Jim_GetRange(), into
2572 * an absolute index into an object of the specified length.
2573 * This function may return negative values, or values
2574 * greater than or equal to the length of the list if the index
2575 * is out of range. */
2576 static int JimRelToAbsIndex(int len
, int idx
)
2583 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2584 * into a form suitable for implementation of commands like [string range] and [lrange].
2586 * The resulting range is guaranteed to address valid elements of
2589 static void JimRelToAbsRange(int len
, int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2593 if (*firstPtr
> *lastPtr
) {
2597 rangeLen
= *lastPtr
- *firstPtr
+ 1;
2599 if (*firstPtr
< 0) {
2600 rangeLen
+= *firstPtr
;
2603 if (*lastPtr
>= len
) {
2604 rangeLen
-= (*lastPtr
- (len
- 1));
2612 *rangeLenPtr
= rangeLen
;
2615 static int JimStringGetRange(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
,
2616 int len
, int *first
, int *last
, int *range
)
2618 if (Jim_GetIndex(interp
, firstObjPtr
, first
) != JIM_OK
) {
2621 if (Jim_GetIndex(interp
, lastObjPtr
, last
) != JIM_OK
) {
2624 *first
= JimRelToAbsIndex(len
, *first
);
2625 *last
= JimRelToAbsIndex(len
, *last
);
2626 JimRelToAbsRange(len
, first
, last
, range
);
2630 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
2631 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2638 str
= Jim_GetString(strObjPtr
, &bytelen
);
2640 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, bytelen
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2644 if (first
== 0 && rangeLen
== bytelen
) {
2647 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2650 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2651 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2659 str
= Jim_GetString(strObjPtr
, &bytelen
);
2660 len
= Jim_Utf8Length(interp
, strObjPtr
);
2662 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2666 if (first
== 0 && rangeLen
== len
) {
2669 if (len
== bytelen
) {
2670 /* ASCII optimisation */
2671 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2673 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
2675 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
2679 Jim_Obj
*JimStringReplaceObj(Jim_Interp
*interp
,
2680 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
, Jim_Obj
*newStrObj
)
2687 len
= Jim_Utf8Length(interp
, strObjPtr
);
2689 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2697 str
= Jim_String(strObjPtr
);
2700 objPtr
= Jim_NewStringObjUtf8(interp
, str
, first
);
2704 Jim_AppendObj(interp
, objPtr
, newStrObj
);
2708 Jim_AppendString(interp
, objPtr
, str
+ utf8_index(str
, last
+ 1), len
- last
- 1);
2714 * Note: does not support embedded nulls.
2716 static void JimStrCopyUpperLower(char *dest
, const char *str
, int uc
)
2720 str
+= utf8_tounicode(str
, &c
);
2721 dest
+= utf8_getchars(dest
, uc
? utf8_upper(c
) : utf8_lower(c
));
2727 * Note: does not support embedded nulls.
2729 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2735 SetStringFromAny(interp
, strObjPtr
);
2737 str
= Jim_GetString(strObjPtr
, &len
);
2740 /* Case mapping can change the utf-8 length of the string.
2741 * But at worst it will be by one extra byte per char
2745 buf
= Jim_Alloc(len
+ 1);
2746 JimStrCopyUpperLower(buf
, str
, 0);
2747 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2751 * Note: does not support embedded nulls.
2753 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2759 if (strObjPtr
->typePtr
!= &stringObjType
) {
2760 SetStringFromAny(interp
, strObjPtr
);
2763 str
= Jim_GetString(strObjPtr
, &len
);
2766 /* Case mapping can change the utf-8 length of the string.
2767 * But at worst it will be by one extra byte per char
2771 buf
= Jim_Alloc(len
+ 1);
2772 JimStrCopyUpperLower(buf
, str
, 1);
2773 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2777 * Note: does not support embedded nulls.
2779 static Jim_Obj
*JimStringToTitle(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2786 str
= Jim_GetString(strObjPtr
, &len
);
2791 /* Case mapping can change the utf-8 length of the string.
2792 * But at worst it will be by one extra byte per char
2796 buf
= p
= Jim_Alloc(len
+ 1);
2798 str
+= utf8_tounicode(str
, &c
);
2799 p
+= utf8_getchars(p
, utf8_title(c
));
2801 JimStrCopyUpperLower(p
, str
, 0);
2803 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2806 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2807 * for unicode character 'c'.
2808 * Returns the position if found or NULL if not
2810 static const char *utf8_memchr(const char *str
, int len
, int c
)
2815 int n
= utf8_tounicode(str
, &sc
);
2824 return memchr(str
, c
, len
);
2829 * Searches for the first non-trim char in string (str, len)
2831 * If none is found, returns just past the last char.
2833 * Lengths are in bytes.
2835 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
2839 int n
= utf8_tounicode(str
, &c
);
2841 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2842 /* Not a trim char, so stop */
2852 * Searches backwards for a non-trim char in string (str, len).
2854 * Returns a pointer to just after the non-trim char, or NULL if not found.
2856 * Lengths are in bytes.
2858 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
2864 int n
= utf8_prev_len(str
, len
);
2869 n
= utf8_tounicode(str
, &c
);
2871 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2879 static const char default_trim_chars
[] = " \t\n\r";
2880 /* sizeof() here includes the null byte */
2881 static int default_trim_chars_len
= sizeof(default_trim_chars
);
2883 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2886 const char *str
= Jim_GetString(strObjPtr
, &len
);
2887 const char *trimchars
= default_trim_chars
;
2888 int trimcharslen
= default_trim_chars_len
;
2891 if (trimcharsObjPtr
) {
2892 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2895 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
2896 if (newstr
== str
) {
2900 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
2903 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2906 const char *trimchars
= default_trim_chars
;
2907 int trimcharslen
= default_trim_chars_len
;
2908 const char *nontrim
;
2910 if (trimcharsObjPtr
) {
2911 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2914 SetStringFromAny(interp
, strObjPtr
);
2916 len
= Jim_Length(strObjPtr
);
2917 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
2919 if (nontrim
== NULL
) {
2920 /* All trim, so return a zero-length string */
2921 return Jim_NewEmptyStringObj(interp
);
2923 if (nontrim
== strObjPtr
->bytes
+ len
) {
2924 /* All non-trim, so return the original object */
2928 if (Jim_IsShared(strObjPtr
)) {
2929 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
2932 /* Can modify this string in place */
2933 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
2934 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
2940 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2942 /* First trim left. */
2943 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
2945 /* Now trim right */
2946 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
2948 /* Note: refCount check is needed since objPtr may be emptyObj */
2949 if (objPtr
!= strObjPtr
&& objPtr
->refCount
== 0) {
2950 /* We don't want this object to be leaked */
2951 Jim_FreeNewObj(interp
, objPtr
);
2957 /* Some platforms don't have isascii - need a non-macro version */
2959 #define jim_isascii isascii
2961 static int jim_isascii(int c
)
2963 return !(c
& ~0x7f);
2967 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2969 static const char * const strclassnames
[] = {
2970 "integer", "alpha", "alnum", "ascii", "digit",
2971 "double", "lower", "upper", "space", "xdigit",
2972 "control", "print", "graph", "punct", "boolean",
2976 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2977 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2978 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
, STR_IS_BOOLEAN
,
2984 int (*isclassfunc
)(int c
) = NULL
;
2986 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2990 str
= Jim_GetString(strObjPtr
, &len
);
2992 Jim_SetResultBool(interp
, !strict
);
2997 case STR_IS_INTEGER
:
3000 Jim_SetResultBool(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
3007 Jim_SetResultBool(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
3011 case STR_IS_BOOLEAN
:
3014 Jim_SetResultBool(interp
, Jim_GetBoolean(interp
, strObjPtr
, &b
) == JIM_OK
);
3018 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
3019 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
3020 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
3021 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
3022 case STR_IS_LOWER
: isclassfunc
= islower
; break;
3023 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
3024 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
3025 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
3026 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
3027 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
3028 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
3029 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3034 for (i
= 0; i
< len
; i
++) {
3035 if (!isclassfunc(str
[i
])) {
3036 Jim_SetResultBool(interp
, 0);
3040 Jim_SetResultBool(interp
, 1);
3044 /* -----------------------------------------------------------------------------
3045 * Compared String Object
3046 * ---------------------------------------------------------------------------*/
3048 /* This is strange object that allows comparison of a C literal string
3049 * with a Jim object in a very short time if the same comparison is done
3050 * multiple times. For example every time the [if] command is executed,
3051 * Jim has to check if a given argument is "else".
3052 * If the code has no errors, this comparison is true most of the time,
3053 * so we can cache the pointer of the string of the last matching
3054 * comparison inside the object. Because most C compilers perform literal sharing,
3055 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3056 * this works pretty well even if comparisons are at different places
3057 * inside the C code. */
3059 static const Jim_ObjType comparedStringObjType
= {
3064 JIM_TYPE_REFERENCES
,
3067 /* The only way this object is exposed to the API is via the following
3068 * function. Returns true if the string and the object string repr.
3069 * are the same, otherwise zero is returned.
3071 * Note: this isn't binary safe, but it hardly needs to be.*/
3072 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3074 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3078 const char *objStr
= Jim_String(objPtr
);
3080 if (strcmp(str
, objStr
) != 0)
3083 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3084 Jim_FreeIntRep(interp
, objPtr
);
3085 objPtr
->typePtr
= &comparedStringObjType
;
3087 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3092 static int qsortCompareStringPointers(const void *a
, const void *b
)
3094 char *const *sa
= (char *const *)a
;
3095 char *const *sb
= (char *const *)b
;
3097 return strcmp(*sa
, *sb
);
3101 /* -----------------------------------------------------------------------------
3104 * This object is just a string from the language point of view, but
3105 * the internal representation contains the filename and line number
3106 * where this token was read. This information is used by
3107 * Jim_EvalObj() if the object passed happens to be of type "source".
3109 * This allows propagation of the information about line numbers and file
3110 * names and gives error messages with absolute line numbers.
3112 * Note that this object uses the internal representation of the Jim_Object,
3113 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3115 * Also the object will be converted to something else if the given
3116 * token it represents in the source file is not something to be
3117 * evaluated (not a script), and will be specialized in some other way,
3118 * so the time overhead is also almost zero.
3119 * ---------------------------------------------------------------------------*/
3121 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3122 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3124 static const Jim_ObjType sourceObjType
= {
3126 FreeSourceInternalRep
,
3127 DupSourceInternalRep
,
3129 JIM_TYPE_REFERENCES
,
3132 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3134 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3137 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3139 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3140 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3143 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3144 Jim_Obj
*fileNameObj
, int lineNumber
)
3146 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3147 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3148 Jim_IncrRefCount(fileNameObj
);
3149 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3150 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3151 objPtr
->typePtr
= &sourceObjType
;
3154 /* -----------------------------------------------------------------------------
3157 * This object is used only in the Script internal represenation.
3158 * For each line of the script, it holds the number of tokens on the line
3159 * and the source line number.
3161 static const Jim_ObjType scriptLineObjType
= {
3169 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3173 #ifdef DEBUG_SHOW_SCRIPT
3175 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3176 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3178 objPtr
= Jim_NewEmptyStringObj(interp
);
3180 objPtr
->typePtr
= &scriptLineObjType
;
3181 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3182 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3187 /* -----------------------------------------------------------------------------
3190 * This object holds the parsed internal representation of a script.
3191 * This representation is help within an allocated ScriptObj (see below)
3193 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3194 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3196 static const Jim_ObjType scriptObjType
= {
3198 FreeScriptInternalRep
,
3199 DupScriptInternalRep
,
3201 JIM_TYPE_REFERENCES
,
3204 /* Each token of a script is represented by a ScriptToken.
3205 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3206 * can be specialized by commands operating on it.
3208 typedef struct ScriptToken
3214 /* This is the script object internal representation. An array of
3215 * ScriptToken structures, including a pre-computed representation of the
3216 * command length and arguments.
3218 * For example the script:
3221 * set $i $x$y [foo]BAR
3223 * will produce a ScriptObj with the following ScriptToken's:
3238 * "puts hello" has two args (LIN 2), composed of single tokens.
3239 * (Note that the WRD token is omitted for the common case of a single token.)
3241 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3242 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3244 * The precomputation of the command structure makes Jim_Eval() faster,
3245 * and simpler because there aren't dynamic lengths / allocations.
3247 * -- {expand}/{*} handling --
3249 * Expand is handled in a special way.
3251 * If a "word" begins with {*}, the word token count is -ve.
3253 * For example the command:
3257 * Will produce the following cmdstruct array:
3264 * Note that the 'LIN' token also contains the source information for the
3265 * first word of the line for error reporting purposes
3267 * -- the substFlags field of the structure --
3269 * The scriptObj structure is used to represent both "script" objects
3270 * and "subst" objects. In the second case, there are no LIN and WRD
3271 * tokens. Instead SEP and EOL tokens are added as-is.
3272 * In addition, the field 'substFlags' is used to represent the flags used to turn
3273 * the string into the internal representation.
3274 * If these flags do not match what the application requires,
3275 * the scriptObj is created again. For example the script:
3277 * subst -nocommands $string
3278 * subst -novariables $string
3280 * Will (re)create the internal representation of the $string object
3283 typedef struct ScriptObj
3285 ScriptToken
*token
; /* Tokens array. */
3286 Jim_Obj
*fileNameObj
; /* Filename */
3287 int len
; /* Length of token[] */
3288 int substFlags
; /* flags used for the compilation of "subst" objects */
3289 int inUse
; /* Used to share a ScriptObj. Currently
3290 only used by Jim_EvalObj() as protection against
3291 shimmering of the currently evaluated object. */
3292 int firstline
; /* Line number of the first line */
3293 int linenr
; /* Error line number, if any */
3294 int missing
; /* Missing char if script failed to parse, (or space or backslash if OK) */
3297 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3298 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3299 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3301 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3304 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3306 if (--script
->inUse
!= 0)
3308 for (i
= 0; i
< script
->len
; i
++) {
3309 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3311 Jim_Free(script
->token
);
3312 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3316 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3318 JIM_NOTUSED(interp
);
3319 JIM_NOTUSED(srcPtr
);
3321 /* Just return a simple string. We don't try to preserve the source info
3322 * since in practice scripts are never duplicated
3324 dupPtr
->typePtr
= NULL
;
3327 /* A simple parse token.
3328 * As the script is parsed, the created tokens point into the script string rep.
3332 const char *token
; /* Pointer to the start of the token */
3333 int len
; /* Length of this token */
3334 int type
; /* Token type */
3335 int line
; /* Line number */
3338 /* A list of parsed tokens representing a script.
3339 * Tokens are added to this list as the script is parsed.
3340 * It grows as needed.
3344 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3345 ParseToken
*list
; /* Array of tokens */
3346 int size
; /* Current size of the list */
3347 int count
; /* Number of entries used */
3348 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3351 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3353 tokenlist
->list
= tokenlist
->static_list
;
3354 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3355 tokenlist
->count
= 0;
3358 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3360 if (tokenlist
->list
!= tokenlist
->static_list
) {
3361 Jim_Free(tokenlist
->list
);
3366 * Adds the new token to the tokenlist.
3367 * The token has the given length, type and line number.
3368 * The token list is resized as necessary.
3370 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3375 if (tokenlist
->count
== tokenlist
->size
) {
3376 /* Resize the list */
3377 tokenlist
->size
*= 2;
3378 if (tokenlist
->list
!= tokenlist
->static_list
) {
3380 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3383 /* The list needs to become allocated */
3384 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3385 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3386 tokenlist
->count
* sizeof(*tokenlist
->list
));
3389 t
= &tokenlist
->list
[tokenlist
->count
++];
3396 /* Counts the number of adjoining non-separator tokens.
3398 * Returns -ve if the first token is the expansion
3399 * operator (in which case the count doesn't include
3402 static int JimCountWordTokens(ParseToken
*t
)
3407 /* Is the first word {*} or {expand}? */
3408 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3409 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3410 /* Create an expand token */
3416 /* Now count non-separator words */
3417 while (!TOKEN_IS_SEP(t
->type
)) {
3422 return count
* expand
;
3426 * Create a script/subst object from the given token.
3428 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3432 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3433 /* Convert backlash escapes. The result will never be longer than the original */
3435 char *str
= Jim_Alloc(len
+ 1);
3436 len
= JimEscape(str
, t
->token
, len
);
3437 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3440 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3441 * with a single space.
3443 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3449 * Takes a tokenlist and creates the allocated list of script tokens
3450 * in script->token, of length script->len.
3452 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3455 * Also sets script->line to the line number of the first token
3457 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3458 ParseTokenList
*tokenlist
)
3461 struct ScriptToken
*token
;
3462 /* Number of tokens so far for the current command */
3464 /* This is the first token for the current command */
3465 ScriptToken
*linefirst
;
3469 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3470 printf("==== Tokens ====\n");
3471 for (i
= 0; i
< tokenlist
->count
; i
++) {
3472 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3473 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3477 /* May need up to one extra script token for each EOL in the worst case */
3478 count
= tokenlist
->count
;
3479 for (i
= 0; i
< tokenlist
->count
; i
++) {
3480 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3484 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3486 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3488 /* This is the first token for the current command */
3489 linefirst
= token
++;
3491 for (i
= 0; i
< tokenlist
->count
; ) {
3492 /* Look ahead to find out how many tokens make up the next word */
3495 /* Skip any leading separators */
3496 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3500 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3502 if (wordtokens
== 0) {
3503 /* None, so at end of line */
3505 linefirst
->type
= JIM_TT_LINE
;
3506 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3507 Jim_IncrRefCount(linefirst
->objPtr
);
3509 /* Reset for new line */
3511 linefirst
= token
++;
3516 else if (wordtokens
!= 1) {
3517 /* More than 1, or {*}, so insert a WORD token */
3518 token
->type
= JIM_TT_WORD
;
3519 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3520 Jim_IncrRefCount(token
->objPtr
);
3522 if (wordtokens
< 0) {
3523 /* Skip the expand token */
3525 wordtokens
= -wordtokens
- 1;
3530 if (lineargs
== 0) {
3531 /* First real token on the line, so record the line number */
3532 linenr
= tokenlist
->list
[i
].line
;
3536 /* Add each non-separator word token to the line */
3537 while (wordtokens
--) {
3538 const ParseToken
*t
= &tokenlist
->list
[i
++];
3540 token
->type
= t
->type
;
3541 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3542 Jim_IncrRefCount(token
->objPtr
);
3544 /* Every object is initially a string of type 'source', but the
3545 * internal type may be specialized during execution of the
3547 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3552 if (lineargs
== 0) {
3556 script
->len
= token
- script
->token
;
3558 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3560 #ifdef DEBUG_SHOW_SCRIPT
3561 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3562 for (i
= 0; i
< script
->len
; i
++) {
3563 const ScriptToken
*t
= &script
->token
[i
];
3564 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3570 /* Parses the given string object to determine if it represents a complete script.
3572 * This is useful for interactive shells implementation, for [info complete].
3574 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3575 * '{' on scripts incomplete missing one or more '}' to be balanced.
3576 * '[' on scripts incomplete missing one or more ']' to be balanced.
3577 * '"' on scripts incomplete missing a '"' char.
3578 * '\\' on scripts with a trailing backslash.
3580 * If the script is complete, 1 is returned, otherwise 0.
3582 int Jim_ScriptIsComplete(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, char *stateCharPtr
)
3584 ScriptObj
*script
= JimGetScript(interp
, scriptObj
);
3586 *stateCharPtr
= script
->missing
;
3588 return (script
->missing
== ' ');
3592 * Sets an appropriate error message for a missing script/expression terminator.
3594 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3596 * Note that a trailing backslash is not considered to be an error.
3598 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3608 msg
= "unmatched \"[\"";
3611 msg
= "missing close-brace";
3615 msg
= "missing quote";
3619 Jim_SetResultString(interp
, msg
, -1);
3624 * Similar to ScriptObjAddTokens(), but for subst objects.
3626 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3627 ParseTokenList
*tokenlist
)
3630 struct ScriptToken
*token
;
3632 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3634 for (i
= 0; i
< tokenlist
->count
; i
++) {
3635 const ParseToken
*t
= &tokenlist
->list
[i
];
3637 /* Create a token for 't' */
3638 token
->type
= t
->type
;
3639 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3640 Jim_IncrRefCount(token
->objPtr
);
3647 /* This method takes the string representation of an object
3648 * as a Tcl script, and generates the pre-parsed internal representation
3651 * On parse error, sets an error message and returns JIM_ERR
3652 * (Note: the object is still converted to a script, even if an error occurs)
3654 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3657 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3658 struct JimParserCtx parser
;
3659 struct ScriptObj
*script
;
3660 ParseTokenList tokenlist
;
3663 /* Try to get information about filename / line number */
3664 if (objPtr
->typePtr
== &sourceObjType
) {
3665 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3668 /* Initially parse the script into tokens (in tokenlist) */
3669 ScriptTokenListInit(&tokenlist
);
3671 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3672 while (!parser
.eof
) {
3673 JimParseScript(&parser
);
3674 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3678 /* Add a final EOF token */
3679 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3681 /* Create the "real" script tokens from the parsed tokens */
3682 script
= Jim_Alloc(sizeof(*script
));
3683 memset(script
, 0, sizeof(*script
));
3685 if (objPtr
->typePtr
== &sourceObjType
) {
3686 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3689 script
->fileNameObj
= interp
->emptyObj
;
3691 Jim_IncrRefCount(script
->fileNameObj
);
3692 script
->missing
= parser
.missing
.ch
;
3693 script
->linenr
= parser
.missing
.line
;
3695 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3697 /* No longer need the token list */
3698 ScriptTokenListFree(&tokenlist
);
3700 /* Free the old internal rep and set the new one. */
3701 Jim_FreeIntRep(interp
, objPtr
);
3702 Jim_SetIntRepPtr(objPtr
, script
);
3703 objPtr
->typePtr
= &scriptObjType
;
3706 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
);
3709 * Returns the parsed script.
3710 * Note that if there is any possibility that the script is not valid,
3711 * call JimScriptValid() to check
3713 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3715 if (objPtr
== interp
->emptyObj
) {
3716 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3717 objPtr
= interp
->nullScriptObj
;
3720 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3721 JimSetScriptFromAny(interp
, objPtr
);
3724 return (ScriptObj
*)Jim_GetIntRepPtr(objPtr
);
3728 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3729 * and leaves an error message in the interp result.
3732 static int JimScriptValid(Jim_Interp
*interp
, ScriptObj
*script
)
3734 if (JimParseCheckMissing(interp
, script
->missing
) == JIM_ERR
) {
3735 JimAddErrorToStack(interp
, script
);
3742 /* -----------------------------------------------------------------------------
3744 * ---------------------------------------------------------------------------*/
3745 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3750 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3752 if (--cmdPtr
->inUse
== 0) {
3753 if (cmdPtr
->isproc
) {
3754 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3755 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3756 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3757 if (cmdPtr
->u
.proc
.staticVars
) {
3758 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3759 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3764 if (cmdPtr
->u
.native
.delProc
) {
3765 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3768 if (cmdPtr
->prevCmd
) {
3769 /* Delete any pushed command too */
3770 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3776 /* Variables HashTable Type.
3778 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3781 /* Variables HashTable Type.
3783 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3784 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3786 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3790 static const Jim_HashTableType JimVariablesHashTableType
= {
3791 JimStringCopyHTHashFunction
, /* hash function */
3792 JimStringCopyHTDup
, /* key dup */
3794 JimStringCopyHTKeyCompare
, /* key compare */
3795 JimStringCopyHTKeyDestructor
, /* key destructor */
3796 JimVariablesHTValDestructor
/* val destructor */
3799 /* Commands HashTable Type.
3801 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3803 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3805 JimDecrCmdRefCount(interp
, val
);
3808 static const Jim_HashTableType JimCommandsHashTableType
= {
3809 JimStringCopyHTHashFunction
, /* hash function */
3810 JimStringCopyHTDup
, /* key dup */
3812 JimStringCopyHTKeyCompare
, /* key compare */
3813 JimStringCopyHTKeyDestructor
, /* key destructor */
3814 JimCommandsHT_ValDestructor
/* val destructor */
3817 /* ------------------------- Commands related functions --------------------- */
3819 #ifdef jim_ext_namespace
3821 * Returns the "unscoped" version of the given namespace.
3822 * That is, the fully qualified name without the leading ::
3823 * The returned value is either nsObj, or an object with a zero ref count.
3825 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3827 const char *name
= Jim_String(nsObj
);
3828 if (name
[0] == ':' && name
[1] == ':') {
3829 /* This command is being defined in the global namespace */
3830 while (*++name
== ':') {
3832 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3834 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3835 /* This command is being defined in a non-global namespace */
3836 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3837 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3842 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3846 const char *name
= Jim_String(nameObjPtr
);
3847 if (name
[0] == ':' && name
[1] == ':') {
3850 Jim_IncrRefCount(nameObjPtr
);
3851 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3852 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3853 Jim_DecrRefCount(interp
, nameObjPtr
);
3859 * An efficient version of JimQualifyNameObj() where the name is
3860 * available (and needed) as a 'const char *'.
3861 * Avoids creating an object if not necessary.
3862 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3864 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3866 Jim_Obj
*objPtr
= interp
->emptyObj
;
3868 if (name
[0] == ':' && name
[1] == ':') {
3869 /* This command is being defined in the global namespace */
3870 while (*++name
== ':') {
3873 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3874 /* This command is being defined in a non-global namespace */
3875 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3876 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3877 name
= Jim_String(objPtr
);
3879 Jim_IncrRefCount(objPtr
);
3880 *objPtrPtr
= objPtr
;
3884 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3887 /* We can be more efficient in the no-namespace case */
3888 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3889 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3891 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3897 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3899 /* It may already exist, so we try to delete the old one.
3900 * Note that reference count means that it won't be deleted yet if
3901 * it exists in the call stack.
3903 * BUT, if 'local' is in force, instead of deleting the existing
3904 * proc, we stash a reference to the old proc here.
3906 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3908 /* There was an old cmd with the same name,
3909 * so this requires a 'proc epoch' update. */
3911 /* If a procedure with the same name didn't exist there is no need
3912 * to increment the 'proc epoch' because creation of a new procedure
3913 * can never affect existing cached commands. We don't do
3914 * negative caching. */
3915 Jim_InterpIncrProcEpoch(interp
);
3918 if (he
&& interp
->local
) {
3919 /* Push this command over the top of the previous one */
3920 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3921 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3925 /* Replace the existing command */
3926 Jim_DeleteHashEntry(&interp
->commands
, name
);
3929 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3935 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3936 Jim_CmdProc
*cmdProc
, void *privData
, Jim_DelCmdProc
*delProc
)
3938 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3940 /* Store the new details for this command */
3941 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3943 cmdPtr
->u
.native
.delProc
= delProc
;
3944 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3945 cmdPtr
->u
.native
.privData
= privData
;
3947 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3952 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3956 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3961 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3962 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3963 for (i
= 0; i
< len
; i
++) {
3964 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3968 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3969 /* Check if it's composed of two elements. */
3970 subLen
= Jim_ListLength(interp
, objPtr
);
3971 if (subLen
== 1 || subLen
== 2) {
3972 /* Try to get the variable value from the current
3974 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3976 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3977 if (initObjPtr
== NULL
) {
3978 Jim_SetResultFormatted(interp
,
3979 "variable for initialization of static \"%#s\" not found in the local context",
3985 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3987 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3991 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3992 varPtr
->objPtr
= initObjPtr
;
3993 Jim_IncrRefCount(initObjPtr
);
3994 varPtr
->linkFramePtr
= NULL
;
3995 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3996 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3997 Jim_SetResultFormatted(interp
,
3998 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3999 Jim_DecrRefCount(interp
, initObjPtr
);
4005 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
4013 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
4015 #ifdef jim_ext_namespace
4016 if (cmdPtr
->isproc
) {
4017 /* XXX: Really need JimNamespaceSplit() */
4018 const char *pt
= strrchr(cmdname
, ':');
4019 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
4020 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
4021 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
4022 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4024 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
4025 /* This commands shadows a global command, so a proc epoch update is required */
4026 Jim_InterpIncrProcEpoch(interp
);
4033 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
4034 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4040 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4042 /* Allocate space for both the command pointer and the arg list */
4043 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4044 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4047 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4048 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4049 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4050 cmdPtr
->u
.proc
.argsPos
= -1;
4051 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4052 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4053 Jim_IncrRefCount(argListObjPtr
);
4054 Jim_IncrRefCount(bodyObjPtr
);
4055 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4057 /* Create the statics hash table. */
4058 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4062 /* Parse the args out into arglist, validating as we go */
4063 /* Examine the argument list for default parameters and 'args' */
4064 for (i
= 0; i
< argListLen
; i
++) {
4066 Jim_Obj
*nameObjPtr
;
4067 Jim_Obj
*defaultObjPtr
;
4070 /* Examine a parameter */
4071 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4072 len
= Jim_ListLength(interp
, argPtr
);
4074 Jim_SetResultString(interp
, "argument with no name", -1);
4076 JimDecrCmdRefCount(interp
, cmdPtr
);
4080 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4085 /* Optional parameter */
4086 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4087 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4090 /* Required parameter */
4091 nameObjPtr
= argPtr
;
4092 defaultObjPtr
= NULL
;
4096 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4097 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4098 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4101 cmdPtr
->u
.proc
.argsPos
= i
;
4105 cmdPtr
->u
.proc
.optArity
++;
4108 cmdPtr
->u
.proc
.reqArity
++;
4112 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4113 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4119 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4122 Jim_Obj
*qualifiedNameObj
;
4123 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4125 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4126 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4130 Jim_InterpIncrProcEpoch(interp
);
4133 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4138 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4143 Jim_Obj
*qualifiedOldNameObj
;
4144 Jim_Obj
*qualifiedNewNameObj
;
4148 if (newName
[0] == 0) {
4149 return Jim_DeleteCommand(interp
, oldName
);
4152 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4153 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4155 /* Does it exist? */
4156 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4158 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4160 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4161 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4164 /* Add the new name first */
4165 cmdPtr
= Jim_GetHashEntryVal(he
);
4166 JimIncrCmdRefCount(cmdPtr
);
4167 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4168 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4170 /* Now remove the old name */
4171 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4173 /* Increment the epoch */
4174 Jim_InterpIncrProcEpoch(interp
);
4179 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4180 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4185 /* -----------------------------------------------------------------------------
4187 * ---------------------------------------------------------------------------*/
4189 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4191 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4194 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4196 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4197 dupPtr
->typePtr
= srcPtr
->typePtr
;
4198 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4201 static const Jim_ObjType commandObjType
= {
4203 FreeCommandInternalRep
,
4204 DupCommandInternalRep
,
4206 JIM_TYPE_REFERENCES
,
4209 /* This function returns the command structure for the command name
4210 * stored in objPtr. It tries to specialize the objPtr to contain
4211 * a cached info instead to perform the lookup into the hash table
4212 * every time. The information cached may not be uptodate, in such
4213 * a case the lookup is performed and the cache updated.
4215 * Respects the 'upcall' setting
4217 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4221 /* In order to be valid, the proc epoch must match and
4222 * the lookup must have occurred in the same namespace
4224 if (objPtr
->typePtr
!= &commandObjType
||
4225 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4226 #ifdef jim_ext_namespace
4227 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4230 /* Not cached or out of date, so lookup */
4232 /* Do we need to try the local namespace? */
4233 const char *name
= Jim_String(objPtr
);
4236 if (name
[0] == ':' && name
[1] == ':') {
4237 while (*++name
== ':') {
4240 #ifdef jim_ext_namespace
4241 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4242 /* This command is being defined in a non-global namespace */
4243 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4244 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4245 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4246 Jim_FreeNewObj(interp
, nameObj
);
4253 /* Lookup in the global namespace */
4254 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4256 if (flags
& JIM_ERRMSG
) {
4257 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4261 #ifdef jim_ext_namespace
4264 cmd
= Jim_GetHashEntryVal(he
);
4266 /* Free the old internal repr and set the new one. */
4267 Jim_FreeIntRep(interp
, objPtr
);
4268 objPtr
->typePtr
= &commandObjType
;
4269 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4270 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4271 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4272 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4275 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4277 while (cmd
->u
.proc
.upcall
) {
4283 /* -----------------------------------------------------------------------------
4285 * ---------------------------------------------------------------------------*/
4287 /* -----------------------------------------------------------------------------
4289 * ---------------------------------------------------------------------------*/
4291 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4293 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4295 static const Jim_ObjType variableObjType
= {
4300 JIM_TYPE_REFERENCES
,
4304 * Check that the name does not contain embedded nulls.
4306 * Variable and procedure names are manipulated as null terminated strings, so
4307 * don't allow names with embedded nulls.
4309 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4311 /* Variable names and proc names can't contain embedded nulls */
4312 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4314 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4315 if (memchr(str
, '\0', len
)) {
4316 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4323 /* This method should be called only by the variable API.
4324 * It returns JIM_OK on success (variable already exists),
4325 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4326 * a variable name, but syntax glue for [dict] i.e. the last
4327 * character is ')' */
4328 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4330 const char *varName
;
4331 Jim_CallFrame
*framePtr
;
4336 /* Check if the object is already an uptodate variable */
4337 if (objPtr
->typePtr
== &variableObjType
) {
4338 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4339 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4343 /* Need to re-resolve the variable in the updated callframe */
4345 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4346 return JIM_DICT_SUGAR
;
4348 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4353 varName
= Jim_GetString(objPtr
, &len
);
4355 /* Make sure it's not syntax glue to get/set dict. */
4356 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4357 return JIM_DICT_SUGAR
;
4360 if (varName
[0] == ':' && varName
[1] == ':') {
4361 while (*++varName
== ':') {
4364 framePtr
= interp
->topFramePtr
;
4368 framePtr
= interp
->framePtr
;
4371 /* Resolve this name in the variables hash table */
4372 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4374 if (!global
&& framePtr
->staticVars
) {
4375 /* Try with static vars. */
4376 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4383 /* Free the old internal repr and set the new one. */
4384 Jim_FreeIntRep(interp
, objPtr
);
4385 objPtr
->typePtr
= &variableObjType
;
4386 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4387 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4388 objPtr
->internalRep
.varValue
.global
= global
;
4392 /* -------------------- Variables related functions ------------------------- */
4393 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4394 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4396 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4399 Jim_CallFrame
*framePtr
;
4402 /* New variable to create */
4403 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4405 var
->objPtr
= valObjPtr
;
4406 Jim_IncrRefCount(valObjPtr
);
4407 var
->linkFramePtr
= NULL
;
4409 name
= Jim_String(nameObjPtr
);
4410 if (name
[0] == ':' && name
[1] == ':') {
4411 while (*++name
== ':') {
4413 framePtr
= interp
->topFramePtr
;
4417 framePtr
= interp
->framePtr
;
4421 /* Insert the new variable */
4422 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4424 /* Make the object int rep a variable */
4425 Jim_FreeIntRep(interp
, nameObjPtr
);
4426 nameObjPtr
->typePtr
= &variableObjType
;
4427 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4428 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4429 nameObjPtr
->internalRep
.varValue
.global
= global
;
4434 /* For now that's dummy. Variables lookup should be optimized
4435 * in many ways, with caching of lookups, and possibly with
4436 * a table of pre-allocated vars in every CallFrame for local vars.
4437 * All the caching should also have an 'epoch' mechanism similar
4438 * to the one used by Tcl for procedures lookup caching. */
4440 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4445 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4446 case JIM_DICT_SUGAR
:
4447 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4450 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4453 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4457 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4458 if (var
->linkFramePtr
== NULL
) {
4459 Jim_IncrRefCount(valObjPtr
);
4460 Jim_DecrRefCount(interp
, var
->objPtr
);
4461 var
->objPtr
= valObjPtr
;
4463 else { /* Else handle the link */
4464 Jim_CallFrame
*savedCallFrame
;
4466 savedCallFrame
= interp
->framePtr
;
4467 interp
->framePtr
= var
->linkFramePtr
;
4468 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4469 interp
->framePtr
= savedCallFrame
;
4477 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4479 Jim_Obj
*nameObjPtr
;
4482 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4483 Jim_IncrRefCount(nameObjPtr
);
4484 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4485 Jim_DecrRefCount(interp
, nameObjPtr
);
4489 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4491 Jim_CallFrame
*savedFramePtr
;
4494 savedFramePtr
= interp
->framePtr
;
4495 interp
->framePtr
= interp
->topFramePtr
;
4496 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4497 interp
->framePtr
= savedFramePtr
;
4501 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4503 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4506 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4507 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4508 Jim_IncrRefCount(nameObjPtr
);
4509 Jim_IncrRefCount(valObjPtr
);
4510 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4511 Jim_DecrRefCount(interp
, nameObjPtr
);
4512 Jim_DecrRefCount(interp
, valObjPtr
);
4516 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4517 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4519 const char *varName
;
4520 const char *targetName
;
4521 Jim_CallFrame
*framePtr
;
4524 /* Check for an existing variable or link */
4525 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4526 case JIM_DICT_SUGAR
:
4527 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4528 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4532 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4534 if (varPtr
->linkFramePtr
== NULL
) {
4535 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4539 /* It exists, but is a link, so first delete the link */
4540 varPtr
->linkFramePtr
= NULL
;
4544 /* Resolve the call frames for both variables */
4545 /* XXX: SetVariableFromAny() already did this! */
4546 varName
= Jim_String(nameObjPtr
);
4548 if (varName
[0] == ':' && varName
[1] == ':') {
4549 while (*++varName
== ':') {
4551 /* Linking a global var does nothing */
4552 framePtr
= interp
->topFramePtr
;
4555 framePtr
= interp
->framePtr
;
4558 targetName
= Jim_String(targetNameObjPtr
);
4559 if (targetName
[0] == ':' && targetName
[1] == ':') {
4560 while (*++targetName
== ':') {
4562 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4563 targetCallFrame
= interp
->topFramePtr
;
4565 Jim_IncrRefCount(targetNameObjPtr
);
4567 if (framePtr
->level
< targetCallFrame
->level
) {
4568 Jim_SetResultFormatted(interp
,
4569 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4571 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4575 /* Check for cycles. */
4576 if (framePtr
== targetCallFrame
) {
4577 Jim_Obj
*objPtr
= targetNameObjPtr
;
4579 /* Cycles are only possible with 'uplevel 0' */
4581 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4582 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4583 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4586 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4588 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4589 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4591 objPtr
= varPtr
->objPtr
;
4595 /* Perform the binding */
4596 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4597 /* We are now sure 'nameObjPtr' type is variableObjType */
4598 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4599 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4603 /* Return the Jim_Obj pointer associated with a variable name,
4604 * or NULL if the variable was not found in the current context.
4605 * The same optimization discussed in the comment to the
4606 * 'SetVariable' function should apply here.
4608 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4609 * in a dictionary which is shared, the array variable value is duplicated first.
4610 * This allows the array element to be updated (e.g. append, lappend) without
4611 * affecting other references to the dictionary.
4613 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4615 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4617 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4619 if (varPtr
->linkFramePtr
== NULL
) {
4620 return varPtr
->objPtr
;
4625 /* The variable is a link? Resolve it. */
4626 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4628 interp
->framePtr
= varPtr
->linkFramePtr
;
4629 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4630 interp
->framePtr
= savedCallFrame
;
4634 /* Error, so fall through to the error message */
4639 case JIM_DICT_SUGAR
:
4640 /* [dict] syntax sugar. */
4641 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4643 if (flags
& JIM_ERRMSG
) {
4644 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4649 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4651 Jim_CallFrame
*savedFramePtr
;
4654 savedFramePtr
= interp
->framePtr
;
4655 interp
->framePtr
= interp
->topFramePtr
;
4656 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4657 interp
->framePtr
= savedFramePtr
;
4662 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4664 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4666 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4667 Jim_IncrRefCount(nameObjPtr
);
4668 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4669 Jim_DecrRefCount(interp
, nameObjPtr
);
4673 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4675 Jim_CallFrame
*savedFramePtr
;
4678 savedFramePtr
= interp
->framePtr
;
4679 interp
->framePtr
= interp
->topFramePtr
;
4680 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4681 interp
->framePtr
= savedFramePtr
;
4686 /* Unset a variable.
4687 * Note: On success unset invalidates all the variable objects created
4688 * in the current call frame incrementing. */
4689 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4693 Jim_CallFrame
*framePtr
;
4695 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4696 if (retval
== JIM_DICT_SUGAR
) {
4697 /* [dict] syntax sugar. */
4698 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4700 else if (retval
== JIM_OK
) {
4701 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4703 /* If it's a link call UnsetVariable recursively */
4704 if (varPtr
->linkFramePtr
) {
4705 framePtr
= interp
->framePtr
;
4706 interp
->framePtr
= varPtr
->linkFramePtr
;
4707 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4708 interp
->framePtr
= framePtr
;
4711 const char *name
= Jim_String(nameObjPtr
);
4712 if (nameObjPtr
->internalRep
.varValue
.global
) {
4714 framePtr
= interp
->topFramePtr
;
4717 framePtr
= interp
->framePtr
;
4720 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4721 if (retval
== JIM_OK
) {
4722 /* Change the callframe id, invalidating var lookup caching */
4723 framePtr
->id
= interp
->callFrameEpoch
++;
4727 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4728 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4733 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4735 /* Given a variable name for [dict] operation syntax sugar,
4736 * this function returns two objects, the first with the name
4737 * of the variable to set, and the second with the respective key.
4738 * For example "foo(bar)" will return objects with string repr. of
4741 * The returned objects have refcount = 1. The function can't fail. */
4742 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4743 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4745 const char *str
, *p
;
4747 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4749 str
= Jim_GetString(objPtr
, &len
);
4751 p
= strchr(str
, '(');
4752 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4754 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4757 keyLen
= (str
+ len
) - p
;
4758 if (str
[len
- 1] == ')') {
4762 /* Create the objects with the variable name and key. */
4763 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4765 Jim_IncrRefCount(varObjPtr
);
4766 Jim_IncrRefCount(keyObjPtr
);
4767 *varPtrPtr
= varObjPtr
;
4768 *keyPtrPtr
= keyObjPtr
;
4771 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4772 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4773 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4777 SetDictSubstFromAny(interp
, objPtr
);
4779 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4780 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4782 if (err
== JIM_OK
) {
4783 /* Don't keep an extra ref to the result */
4784 Jim_SetEmptyResult(interp
);
4788 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4789 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4790 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4795 /* Make the error more informative and Tcl-compatible */
4796 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4797 (valObjPtr
? "set" : "unset"), objPtr
);
4803 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4805 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4806 * and stored back to the variable before expansion.
4808 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4809 Jim_Obj
*keyObjPtr
, int flags
)
4811 Jim_Obj
*dictObjPtr
;
4812 Jim_Obj
*resObjPtr
= NULL
;
4815 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4820 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4821 if (ret
!= JIM_OK
) {
4822 Jim_SetResultFormatted(interp
,
4823 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4824 ret
< 0 ? "variable isn't" : "no such element in");
4826 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4827 /* Update the variable to have an unshared copy */
4828 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4834 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4835 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4837 SetDictSubstFromAny(interp
, objPtr
);
4839 return JimDictExpandArrayVariable(interp
,
4840 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4841 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4844 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4846 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4848 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4849 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4852 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4854 JIM_NOTUSED(interp
);
4856 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4857 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4858 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4859 dupPtr
->typePtr
= &dictSubstObjType
;
4862 /* Note: The object *must* be in dict-sugar format */
4863 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4865 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4866 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4868 if (objPtr
->typePtr
== &interpolatedObjType
) {
4869 /* An interpolated object in dict-sugar form */
4871 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4872 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4874 Jim_IncrRefCount(varObjPtr
);
4875 Jim_IncrRefCount(keyObjPtr
);
4878 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4881 Jim_FreeIntRep(interp
, objPtr
);
4882 objPtr
->typePtr
= &dictSubstObjType
;
4883 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4884 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4888 /* This function is used to expand [dict get] sugar in the form
4889 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4890 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4891 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4892 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4893 * the [dict]ionary contained in variable VARNAME. */
4894 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4896 Jim_Obj
*resObjPtr
= NULL
;
4897 Jim_Obj
*substKeyObjPtr
= NULL
;
4899 SetDictSubstFromAny(interp
, objPtr
);
4901 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4902 &substKeyObjPtr
, JIM_NONE
)
4906 Jim_IncrRefCount(substKeyObjPtr
);
4908 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4910 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4915 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4917 Jim_Obj
*resultObjPtr
;
4919 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4920 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4921 resultObjPtr
->refCount
--;
4922 return resultObjPtr
;
4927 /* -----------------------------------------------------------------------------
4929 * ---------------------------------------------------------------------------*/
4931 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4935 if (interp
->freeFramesList
) {
4936 cf
= interp
->freeFramesList
;
4937 interp
->freeFramesList
= cf
->next
;
4941 cf
->procArgsObjPtr
= NULL
;
4942 cf
->procBodyObjPtr
= NULL
;
4944 cf
->staticVars
= NULL
;
4945 cf
->localCommands
= NULL
;
4946 cf
->tailcallObj
= NULL
;
4947 cf
->tailcallCmd
= NULL
;
4950 cf
= Jim_Alloc(sizeof(*cf
));
4951 memset(cf
, 0, sizeof(*cf
));
4953 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4956 cf
->id
= interp
->callFrameEpoch
++;
4957 cf
->parent
= parent
;
4958 cf
->level
= parent
? parent
->level
+ 1 : 0;
4960 Jim_IncrRefCount(nsObj
);
4965 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
)
4967 /* Delete any local procs */
4968 if (localCommands
) {
4969 Jim_Obj
*cmdNameObj
;
4971 while ((cmdNameObj
= Jim_StackPop(localCommands
)) != NULL
) {
4974 Jim_HashTable
*ht
= &interp
->commands
;
4976 const char *fqname
= JimQualifyName(interp
, Jim_String(cmdNameObj
), &fqObjName
);
4978 he
= Jim_FindHashEntry(ht
, fqname
);
4981 Jim_Cmd
*cmd
= Jim_GetHashEntryVal(he
);
4983 Jim_Cmd
*prevCmd
= cmd
->prevCmd
;
4984 cmd
->prevCmd
= NULL
;
4986 /* Delete the old command */
4987 JimDecrCmdRefCount(interp
, cmd
);
4989 /* And restore the original */
4990 Jim_SetHashVal(ht
, he
, prevCmd
);
4993 Jim_DeleteHashEntry(ht
, fqname
);
4995 Jim_InterpIncrProcEpoch(interp
);
4997 Jim_DecrRefCount(interp
, cmdNameObj
);
4998 JimFreeQualifiedName(interp
, fqObjName
);
5000 Jim_FreeStack(localCommands
);
5001 Jim_Free(localCommands
);
5007 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5008 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5009 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
)
5011 JimDeleteLocalProcs(interp
, cf
->localCommands
);
5013 if (cf
->procArgsObjPtr
)
5014 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
5015 if (cf
->procBodyObjPtr
)
5016 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
5017 Jim_DecrRefCount(interp
, cf
->nsObj
);
5018 if (action
== JIM_FCF_FULL
|| cf
->vars
.size
!= JIM_HT_INITIAL_SIZE
)
5019 Jim_FreeHashTable(&cf
->vars
);
5022 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
5024 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
5026 while (he
!= NULL
) {
5027 Jim_HashEntry
*nextEntry
= he
->next
;
5028 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
5030 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
5031 Jim_Free(Jim_GetHashEntryKey(he
));
5040 cf
->next
= interp
->freeFramesList
;
5041 interp
->freeFramesList
= cf
;
5045 /* -----------------------------------------------------------------------------
5047 * ---------------------------------------------------------------------------*/
5048 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5050 /* References HashTable Type.
5052 * Keys are unsigned long integers, dynamically allocated for now but in the
5053 * future it's worth to cache this 4 bytes objects. Values are pointers
5054 * to Jim_References. */
5055 static void JimReferencesHTValDestructor(void *interp
, void *val
)
5057 Jim_Reference
*refPtr
= (void *)val
;
5059 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
5060 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
5061 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5066 static unsigned int JimReferencesHTHashFunction(const void *key
)
5068 /* Only the least significant bits are used. */
5069 const unsigned long *widePtr
= key
;
5070 unsigned int intValue
= (unsigned int)*widePtr
;
5072 return Jim_IntHashFunction(intValue
);
5075 static void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
5077 void *copy
= Jim_Alloc(sizeof(unsigned long));
5079 JIM_NOTUSED(privdata
);
5081 memcpy(copy
, key
, sizeof(unsigned long));
5085 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5087 JIM_NOTUSED(privdata
);
5089 return memcmp(key1
, key2
, sizeof(unsigned long)) == 0;
5092 static void JimReferencesHTKeyDestructor(void *privdata
, void *key
)
5094 JIM_NOTUSED(privdata
);
5099 static const Jim_HashTableType JimReferencesHashTableType
= {
5100 JimReferencesHTHashFunction
, /* hash function */
5101 JimReferencesHTKeyDup
, /* key dup */
5103 JimReferencesHTKeyCompare
, /* key compare */
5104 JimReferencesHTKeyDestructor
, /* key destructor */
5105 JimReferencesHTValDestructor
/* val destructor */
5108 /* -----------------------------------------------------------------------------
5109 * Reference object type and References API
5110 * ---------------------------------------------------------------------------*/
5112 /* The string representation of references has two features in order
5113 * to make the GC faster. The first is that every reference starts
5114 * with a non common character '<', in order to make the string matching
5115 * faster. The second is that the reference string rep is 42 characters
5116 * in length, this means that it is not necessary to check any object with a string
5117 * repr < 42, and usually there aren't many of these objects. */
5119 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5121 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, unsigned long id
)
5123 const char *fmt
= "<reference.<%s>.%020lu>";
5125 sprintf(buf
, fmt
, refPtr
->tag
, id
);
5126 return JIM_REFERENCE_SPACE
;
5129 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
5131 static const Jim_ObjType referenceObjType
= {
5135 UpdateStringOfReference
,
5136 JIM_TYPE_REFERENCES
,
5139 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
5141 char buf
[JIM_REFERENCE_SPACE
+ 1];
5143 JimFormatReference(buf
, objPtr
->internalRep
.refValue
.refPtr
, objPtr
->internalRep
.refValue
.id
);
5144 JimSetStringBytes(objPtr
, buf
);
5147 /* returns true if 'c' is a valid reference tag character.
5148 * i.e. inside the range [_a-zA-Z0-9] */
5149 static int isrefchar(int c
)
5151 return (c
== '_' || isalnum(c
));
5154 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5156 unsigned long value
;
5158 const char *str
, *start
, *end
;
5160 Jim_Reference
*refPtr
;
5164 /* Get the string representation */
5165 str
= Jim_GetString(objPtr
, &len
);
5166 /* Check if it looks like a reference */
5167 if (len
< JIM_REFERENCE_SPACE
)
5171 end
= str
+ len
- 1;
5172 while (*start
== ' ')
5174 while (*end
== ' ' && end
> start
)
5176 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
5178 /* <reference.<1234567>.%020> */
5179 if (memcmp(start
, "<reference.<", 12) != 0)
5181 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
5183 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5184 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5185 if (!isrefchar(start
[12 + i
]))
5188 /* Extract info from the reference. */
5189 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
5191 /* Try to convert the ID into an unsigned long */
5192 value
= strtoul(refId
, &endptr
, 10);
5193 if (JimCheckConversion(refId
, endptr
) != JIM_OK
)
5195 /* Check if the reference really exists! */
5196 he
= Jim_FindHashEntry(&interp
->references
, &value
);
5198 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
5201 refPtr
= Jim_GetHashEntryVal(he
);
5202 /* Free the old internal repr and set the new one. */
5203 Jim_FreeIntRep(interp
, objPtr
);
5204 objPtr
->typePtr
= &referenceObjType
;
5205 objPtr
->internalRep
.refValue
.id
= value
;
5206 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5210 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
5214 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5215 * as finalizer command (or NULL if there is no finalizer).
5216 * The returned reference object has refcount = 0. */
5217 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
5219 struct Jim_Reference
*refPtr
;
5225 /* Perform the Garbage Collection if needed. */
5226 Jim_CollectIfNeeded(interp
);
5228 refPtr
= Jim_Alloc(sizeof(*refPtr
));
5229 refPtr
->objPtr
= objPtr
;
5230 Jim_IncrRefCount(objPtr
);
5231 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5233 Jim_IncrRefCount(cmdNamePtr
);
5234 id
= interp
->referenceNextId
++;
5235 Jim_AddHashEntry(&interp
->references
, &id
, refPtr
);
5236 refObjPtr
= Jim_NewObj(interp
);
5237 refObjPtr
->typePtr
= &referenceObjType
;
5238 refObjPtr
->bytes
= NULL
;
5239 refObjPtr
->internalRep
.refValue
.id
= id
;
5240 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5241 interp
->referenceNextId
++;
5242 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5243 * that does not pass the 'isrefchar' test is replaced with '_' */
5244 tag
= Jim_GetString(tagPtr
, &tagLen
);
5245 if (tagLen
> JIM_REFERENCE_TAGLEN
)
5246 tagLen
= JIM_REFERENCE_TAGLEN
;
5247 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5248 if (i
< tagLen
&& isrefchar(tag
[i
]))
5249 refPtr
->tag
[i
] = tag
[i
];
5251 refPtr
->tag
[i
] = '_';
5253 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
5257 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5259 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
5261 return objPtr
->internalRep
.refValue
.refPtr
;
5264 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
5266 Jim_Reference
*refPtr
;
5268 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5270 Jim_IncrRefCount(cmdNamePtr
);
5271 if (refPtr
->finalizerCmdNamePtr
)
5272 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5273 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5277 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
5279 Jim_Reference
*refPtr
;
5281 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5283 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
5287 /* -----------------------------------------------------------------------------
5288 * References Garbage Collection
5289 * ---------------------------------------------------------------------------*/
5291 /* This the hash table type for the "MARK" phase of the GC */
5292 static const Jim_HashTableType JimRefMarkHashTableType
= {
5293 JimReferencesHTHashFunction
, /* hash function */
5294 JimReferencesHTKeyDup
, /* key dup */
5296 JimReferencesHTKeyCompare
, /* key compare */
5297 JimReferencesHTKeyDestructor
, /* key destructor */
5298 NULL
/* val destructor */
5301 /* Performs the garbage collection. */
5302 int Jim_Collect(Jim_Interp
*interp
)
5305 Jim_HashTable marks
;
5306 Jim_HashTableIterator htiter
;
5310 /* Avoid recursive calls */
5311 if (interp
->lastCollectId
== -1) {
5312 /* Jim_Collect() already running. Return just now. */
5315 interp
->lastCollectId
= -1;
5317 /* Mark all the references found into the 'mark' hash table.
5318 * The references are searched in every live object that
5319 * is of a type that can contain references. */
5320 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
5321 objPtr
= interp
->liveList
;
5323 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
5324 const char *str
, *p
;
5327 /* If the object is of type reference, to get the
5328 * Id is simple... */
5329 if (objPtr
->typePtr
== &referenceObjType
) {
5330 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
5332 printf("MARK (reference): %d refcount: %d\n",
5333 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
5335 objPtr
= objPtr
->nextObjPtr
;
5338 /* Get the string repr of the object we want
5339 * to scan for references. */
5340 p
= str
= Jim_GetString(objPtr
, &len
);
5341 /* Skip objects too little to contain references. */
5342 if (len
< JIM_REFERENCE_SPACE
) {
5343 objPtr
= objPtr
->nextObjPtr
;
5346 /* Extract references from the object string repr. */
5351 if ((p
= strstr(p
, "<reference.<")) == NULL
)
5353 /* Check if it's a valid reference. */
5354 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
5356 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
5358 for (i
= 21; i
<= 40; i
++)
5359 if (!isdigit(UCHAR(p
[i
])))
5362 id
= strtoul(p
+ 21, NULL
, 10);
5364 /* Ok, a reference for the given ID
5365 * was found. Mark it. */
5366 Jim_AddHashEntry(&marks
, &id
, NULL
);
5368 printf("MARK: %d\n", (int)id
);
5370 p
+= JIM_REFERENCE_SPACE
;
5373 objPtr
= objPtr
->nextObjPtr
;
5376 /* Run the references hash table to destroy every reference that
5377 * is not referenced outside (not present in the mark HT). */
5378 JimInitHashTableIterator(&interp
->references
, &htiter
);
5379 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
5380 const unsigned long *refId
;
5381 Jim_Reference
*refPtr
;
5384 /* Check if in the mark phase we encountered
5385 * this reference. */
5386 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
5388 printf("COLLECTING %d\n", (int)*refId
);
5391 /* Drop the reference, but call the
5392 * finalizer first if registered. */
5393 refPtr
= Jim_GetHashEntryVal(he
);
5394 if (refPtr
->finalizerCmdNamePtr
) {
5395 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
5396 Jim_Obj
*objv
[3], *oldResult
;
5398 JimFormatReference(refstr
, refPtr
, *refId
);
5400 objv
[0] = refPtr
->finalizerCmdNamePtr
;
5401 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, JIM_REFERENCE_SPACE
);
5402 objv
[2] = refPtr
->objPtr
;
5404 /* Drop the reference itself */
5405 /* Avoid the finaliser being freed here */
5406 Jim_IncrRefCount(objv
[0]);
5407 /* Don't remove the reference from the hash table just yet
5408 * since that will free refPtr, and hence refPtr->objPtr
5411 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5412 oldResult
= interp
->result
;
5413 Jim_IncrRefCount(oldResult
);
5414 Jim_EvalObjVector(interp
, 3, objv
);
5415 Jim_SetResult(interp
, oldResult
);
5416 Jim_DecrRefCount(interp
, oldResult
);
5418 Jim_DecrRefCount(interp
, objv
[0]);
5420 Jim_DeleteHashEntry(&interp
->references
, refId
);
5423 Jim_FreeHashTable(&marks
);
5424 interp
->lastCollectId
= interp
->referenceNextId
;
5425 interp
->lastCollectTime
= time(NULL
);
5429 #define JIM_COLLECT_ID_PERIOD 5000
5430 #define JIM_COLLECT_TIME_PERIOD 300
5432 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
5434 unsigned long elapsedId
;
5437 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
5438 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
5441 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
5442 Jim_Collect(interp
);
5445 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5447 int Jim_IsBigEndian(void)
5454 return uval
.c
[0] == 1;
5457 /* -----------------------------------------------------------------------------
5458 * Interpreter related functions
5459 * ---------------------------------------------------------------------------*/
5461 Jim_Interp
*Jim_CreateInterp(void)
5463 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
5465 memset(i
, 0, sizeof(*i
));
5467 i
->maxCallFrameDepth
= JIM_MAX_CALLFRAME_DEPTH
;
5468 i
->maxEvalDepth
= JIM_MAX_EVAL_DEPTH
;
5469 i
->lastCollectTime
= time(NULL
);
5471 /* Note that we can create objects only after the
5472 * interpreter liveList and freeList pointers are
5473 * initialized to NULL. */
5474 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
5475 #ifdef JIM_REFERENCES
5476 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
5478 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
5479 Jim_InitHashTable(&i
->packages
, &JimPackageHashTableType
, NULL
);
5480 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
5481 i
->trueObj
= Jim_NewIntObj(i
, 1);
5482 i
->falseObj
= Jim_NewIntObj(i
, 0);
5483 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
, i
->emptyObj
);
5484 i
->errorFileNameObj
= i
->emptyObj
;
5485 i
->result
= i
->emptyObj
;
5486 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
5487 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
5488 i
->errorProc
= i
->emptyObj
;
5489 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
5490 i
->nullScriptObj
= Jim_NewEmptyStringObj(i
);
5491 Jim_IncrRefCount(i
->emptyObj
);
5492 Jim_IncrRefCount(i
->errorFileNameObj
);
5493 Jim_IncrRefCount(i
->result
);
5494 Jim_IncrRefCount(i
->stackTrace
);
5495 Jim_IncrRefCount(i
->unknown
);
5496 Jim_IncrRefCount(i
->currentScriptObj
);
5497 Jim_IncrRefCount(i
->nullScriptObj
);
5498 Jim_IncrRefCount(i
->errorProc
);
5499 Jim_IncrRefCount(i
->trueObj
);
5500 Jim_IncrRefCount(i
->falseObj
);
5502 /* Initialize key variables every interpreter should contain */
5503 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
5504 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
5506 Jim_SetVariableStrWithStr(i
, "tcl_platform(engine)", "Jim");
5507 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5508 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5509 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5510 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5511 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5512 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5513 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5518 void Jim_FreeInterp(Jim_Interp
*i
)
5520 Jim_CallFrame
*cf
, *cfx
;
5522 Jim_Obj
*objPtr
, *nextObjPtr
;
5524 /* Free the active call frames list - must be done before i->commands is destroyed */
5525 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5527 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5530 Jim_DecrRefCount(i
, i
->emptyObj
);
5531 Jim_DecrRefCount(i
, i
->trueObj
);
5532 Jim_DecrRefCount(i
, i
->falseObj
);
5533 Jim_DecrRefCount(i
, i
->result
);
5534 Jim_DecrRefCount(i
, i
->stackTrace
);
5535 Jim_DecrRefCount(i
, i
->errorProc
);
5536 Jim_DecrRefCount(i
, i
->unknown
);
5537 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5538 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5539 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5540 Jim_FreeHashTable(&i
->commands
);
5541 #ifdef JIM_REFERENCES
5542 Jim_FreeHashTable(&i
->references
);
5544 Jim_FreeHashTable(&i
->packages
);
5545 Jim_Free(i
->prngState
);
5546 Jim_FreeHashTable(&i
->assocData
);
5548 /* Check that the live object list is empty, otherwise
5549 * there is a memory leak. */
5550 #ifdef JIM_MAINTAINER
5551 if (i
->liveList
!= NULL
) {
5552 objPtr
= i
->liveList
;
5554 printf("\n-------------------------------------\n");
5555 printf("Objects still in the free list:\n");
5557 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5559 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5560 printf("%p (%d) %-10s: '%.20s...'\n",
5561 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5564 printf("%p (%d) %-10s: '%s'\n",
5565 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5567 if (objPtr
->typePtr
== &sourceObjType
) {
5568 printf("FILE %s LINE %d\n",
5569 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5570 objPtr
->internalRep
.sourceValue
.lineNumber
);
5572 objPtr
= objPtr
->nextObjPtr
;
5574 printf("-------------------------------------\n\n");
5575 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5579 /* Free all the freed objects. */
5580 objPtr
= i
->freeList
;
5582 nextObjPtr
= objPtr
->nextObjPtr
;
5584 objPtr
= nextObjPtr
;
5587 /* Free the free call frames list */
5588 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5591 Jim_FreeHashTable(&cf
->vars
);
5595 /* Free the interpreter structure. */
5599 /* Returns the call frame relative to the level represented by
5600 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5602 * This function accepts the 'level' argument in the form
5603 * of the commands [uplevel] and [upvar].
5605 * Returns NULL on error.
5607 * Note: for a function accepting a relative integer as level suitable
5608 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5610 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5614 Jim_CallFrame
*framePtr
;
5617 str
= Jim_String(levelObjPtr
);
5618 if (str
[0] == '#') {
5621 level
= jim_strtol(str
+ 1, &endptr
);
5622 if (str
[1] == '\0' || endptr
[0] != '\0') {
5627 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5631 /* Convert from a relative to an absolute level */
5632 level
= interp
->framePtr
->level
- level
;
5637 str
= "1"; /* Needed to format the error message. */
5638 level
= interp
->framePtr
->level
- 1;
5642 return interp
->topFramePtr
;
5646 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5647 if (framePtr
->level
== level
) {
5653 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5657 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5658 * as a relative integer like in the [info level ?level?] command.
5660 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5663 Jim_CallFrame
*framePtr
;
5665 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5667 /* Convert from a relative to an absolute level */
5668 level
= interp
->framePtr
->level
+ level
;
5672 return interp
->topFramePtr
;
5676 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5677 if (framePtr
->level
== level
) {
5683 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5687 static void JimResetStackTrace(Jim_Interp
*interp
)
5689 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5690 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5691 Jim_IncrRefCount(interp
->stackTrace
);
5694 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5698 /* Increment reference first in case these are the same object */
5699 Jim_IncrRefCount(stackTraceObj
);
5700 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5701 interp
->stackTrace
= stackTraceObj
;
5702 interp
->errorFlag
= 1;
5704 /* This is a bit ugly.
5705 * If the filename of the last entry of the stack trace is empty,
5706 * the next stack level should be added.
5708 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5710 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5711 interp
->addStackTrace
= 1;
5716 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5717 Jim_Obj
*fileNameObj
, int linenr
)
5719 if (strcmp(procname
, "unknown") == 0) {
5722 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5723 /* No useful info here */
5727 if (Jim_IsShared(interp
->stackTrace
)) {
5728 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5729 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5730 Jim_IncrRefCount(interp
->stackTrace
);
5733 /* If we have no procname but the previous element did, merge with that frame */
5734 if (!*procname
&& Jim_Length(fileNameObj
)) {
5735 /* Just a filename. Check the previous entry */
5736 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5739 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5740 if (Jim_Length(objPtr
)) {
5741 /* Yes, the previous level had procname */
5742 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5743 if (Jim_Length(objPtr
) == 0) {
5744 /* But no filename, so merge the new info with that frame */
5745 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5746 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5753 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5754 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5755 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5758 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5761 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5763 assocEntryPtr
->delProc
= delProc
;
5764 assocEntryPtr
->data
= data
;
5765 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5768 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5770 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5772 if (entryPtr
!= NULL
) {
5773 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5774 return assocEntryPtr
->data
;
5779 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5781 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5784 int Jim_GetExitCode(Jim_Interp
*interp
)
5786 return interp
->exitCode
;
5789 /* -----------------------------------------------------------------------------
5791 * ---------------------------------------------------------------------------*/
5792 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5793 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5795 static const Jim_ObjType intObjType
= {
5803 /* A coerced double is closer to an int than a double.
5804 * It is an int value temporarily masquerading as a double value.
5805 * i.e. it has the same string value as an int and Jim_GetWide()
5806 * succeeds, but also Jim_GetDouble() returns the value directly.
5808 static const Jim_ObjType coercedDoubleObjType
= {
5817 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5819 char buf
[JIM_INTEGER_SPACE
+ 1];
5820 jim_wide wideValue
= JimWideValue(objPtr
);
5823 if (wideValue
== 0) {
5827 char tmp
[JIM_INTEGER_SPACE
];
5831 if (wideValue
< 0) {
5834 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5835 * whereas C99 is always -6
5836 * coverity[dead_error_line]
5838 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5843 tmp
[num
++] = wideValue
% 10;
5847 for (i
= 0; i
< num
; i
++) {
5848 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5853 JimSetStringBytes(objPtr
, buf
);
5856 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5861 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5863 objPtr
->typePtr
= &intObjType
;
5867 /* Get the string representation */
5868 str
= Jim_String(objPtr
);
5869 /* Try to convert into a jim_wide */
5870 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5871 if (flags
& JIM_ERRMSG
) {
5872 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5876 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5877 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5880 /* Free the old internal repr and set the new one. */
5881 Jim_FreeIntRep(interp
, objPtr
);
5882 objPtr
->typePtr
= &intObjType
;
5883 objPtr
->internalRep
.wideValue
= wideValue
;
5887 #ifdef JIM_OPTIMIZATION
5888 static int JimIsWide(Jim_Obj
*objPtr
)
5890 return objPtr
->typePtr
== &intObjType
;
5894 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5896 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5898 *widePtr
= JimWideValue(objPtr
);
5902 /* Get a wide but does not set an error if the format is bad. */
5903 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5905 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5907 *widePtr
= JimWideValue(objPtr
);
5911 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5916 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5917 if (retval
== JIM_OK
) {
5918 *longPtr
= (long)wideValue
;
5924 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5928 objPtr
= Jim_NewObj(interp
);
5929 objPtr
->typePtr
= &intObjType
;
5930 objPtr
->bytes
= NULL
;
5931 objPtr
->internalRep
.wideValue
= wideValue
;
5935 /* -----------------------------------------------------------------------------
5937 * ---------------------------------------------------------------------------*/
5938 #define JIM_DOUBLE_SPACE 30
5940 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5941 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5943 static const Jim_ObjType doubleObjType
= {
5947 UpdateStringOfDouble
,
5953 #define isnan(X) ((X) != (X))
5957 #define isinf(X) (1.0 / (X) == 0.0)
5960 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5962 double value
= objPtr
->internalRep
.doubleValue
;
5965 JimSetStringBytes(objPtr
, "NaN");
5970 JimSetStringBytes(objPtr
, "-Inf");
5973 JimSetStringBytes(objPtr
, "Inf");
5978 char buf
[JIM_DOUBLE_SPACE
+ 1];
5980 int len
= sprintf(buf
, "%.12g", value
);
5982 /* Add a final ".0" if necessary */
5983 for (i
= 0; i
< len
; i
++) {
5984 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5985 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5986 /* If 'buf' ends in e-0nn or e+0nn, remove
5987 * the 0 after the + or - and reduce the length by 1
5989 char *e
= strchr(buf
, 'e');
5990 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5993 memmove(e
, e
+ 1, len
- (e
- buf
));
5999 if (buf
[i
] == '\0') {
6004 JimSetStringBytes(objPtr
, buf
);
6008 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6014 /* Preserve the string representation.
6015 * Needed so we can convert back to int without loss
6017 str
= Jim_String(objPtr
);
6019 #ifdef HAVE_LONG_LONG
6020 /* Assume a 53 bit mantissa */
6021 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6022 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6024 if (objPtr
->typePtr
== &intObjType
6025 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
6026 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6028 /* Direct conversion to coerced double */
6029 objPtr
->typePtr
= &coercedDoubleObjType
;
6034 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6035 /* Managed to convert to an int, so we can use this as a cooerced double */
6036 Jim_FreeIntRep(interp
, objPtr
);
6037 objPtr
->typePtr
= &coercedDoubleObjType
;
6038 objPtr
->internalRep
.wideValue
= wideValue
;
6042 /* Try to convert into a double */
6043 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6044 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6047 /* Free the old internal repr and set the new one. */
6048 Jim_FreeIntRep(interp
, objPtr
);
6050 objPtr
->typePtr
= &doubleObjType
;
6051 objPtr
->internalRep
.doubleValue
= doubleValue
;
6055 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6057 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6058 *doublePtr
= JimWideValue(objPtr
);
6061 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6064 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6065 *doublePtr
= JimWideValue(objPtr
);
6068 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6073 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6077 objPtr
= Jim_NewObj(interp
);
6078 objPtr
->typePtr
= &doubleObjType
;
6079 objPtr
->bytes
= NULL
;
6080 objPtr
->internalRep
.doubleValue
= doubleValue
;
6084 /* -----------------------------------------------------------------------------
6085 * Boolean conversion
6086 * ---------------------------------------------------------------------------*/
6087 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
6089 int Jim_GetBoolean(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int * booleanPtr
)
6091 if (objPtr
->typePtr
!= &intObjType
&& SetBooleanFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
6093 *booleanPtr
= (int) JimWideValue(objPtr
);
6097 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
6099 static const char * const falses
[] = {
6100 "0", "false", "no", "off", NULL
6102 static const char * const trues
[] = {
6103 "1", "true", "yes", "on", NULL
6109 if (Jim_GetEnum(interp
, objPtr
, falses
, &index
, NULL
, 0) == JIM_OK
) {
6111 } else if (Jim_GetEnum(interp
, objPtr
, trues
, &index
, NULL
, 0) == JIM_OK
) {
6114 if (flags
& JIM_ERRMSG
) {
6115 Jim_SetResultFormatted(interp
, "expected boolean but got \"%#s\"", objPtr
);
6120 /* Free the old internal repr and set the new one. */
6121 Jim_FreeIntRep(interp
, objPtr
);
6122 objPtr
->typePtr
= &intObjType
;
6123 objPtr
->internalRep
.wideValue
= boolean
;
6127 /* -----------------------------------------------------------------------------
6129 * ---------------------------------------------------------------------------*/
6130 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6131 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6132 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6133 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6134 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6135 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6137 /* Note that while the elements of the list may contain references,
6138 * the list object itself can't. This basically means that the
6139 * list object string representation as a whole can't contain references
6140 * that are not presents in the single elements. */
6141 static const Jim_ObjType listObjType
= {
6143 FreeListInternalRep
,
6149 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6153 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6154 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6156 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6159 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6163 JIM_NOTUSED(interp
);
6165 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6166 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6167 dupPtr
->internalRep
.listValue
.ele
=
6168 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6169 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6170 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6171 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6172 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6174 dupPtr
->typePtr
= &listObjType
;
6177 /* The following function checks if a given string can be encoded
6178 * into a list element without any kind of quoting, surrounded by braces,
6179 * or using escapes to quote. */
6180 #define JIM_ELESTR_SIMPLE 0
6181 #define JIM_ELESTR_BRACE 1
6182 #define JIM_ELESTR_QUOTE 2
6183 static unsigned char ListElementQuotingType(const char *s
, int len
)
6185 int i
, level
, blevel
, trySimple
= 1;
6187 /* Try with the SIMPLE case */
6189 return JIM_ELESTR_BRACE
;
6190 if (s
[0] == '"' || s
[0] == '{') {
6194 for (i
= 0; i
< len
; i
++) {
6215 return JIM_ELESTR_SIMPLE
;
6218 /* Test if it's possible to do with braces */
6219 if (s
[len
- 1] == '\\')
6220 return JIM_ELESTR_QUOTE
;
6223 for (i
= 0; i
< len
; i
++) {
6231 return JIM_ELESTR_QUOTE
;
6240 if (s
[i
+ 1] == '\n')
6241 return JIM_ELESTR_QUOTE
;
6242 else if (s
[i
+ 1] != '\0')
6248 return JIM_ELESTR_QUOTE
;
6253 return JIM_ELESTR_BRACE
;
6254 for (i
= 0; i
< len
; i
++) {
6268 return JIM_ELESTR_BRACE
;
6272 return JIM_ELESTR_SIMPLE
;
6274 return JIM_ELESTR_QUOTE
;
6277 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6278 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6280 * Returns the length of the result.
6282 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6335 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6337 #define STATIC_QUOTING_LEN 32
6338 int i
, bufLen
, realLength
;
6341 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6343 /* Estimate the space needed. */
6344 if (objc
> STATIC_QUOTING_LEN
) {
6345 quotingType
= Jim_Alloc(objc
);
6348 quotingType
= staticQuoting
;
6351 for (i
= 0; i
< objc
; i
++) {
6354 strRep
= Jim_GetString(objv
[i
], &len
);
6355 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6356 switch (quotingType
[i
]) {
6357 case JIM_ELESTR_SIMPLE
:
6358 if (i
!= 0 || strRep
[0] != '#') {
6362 /* Special case '#' on first element needs braces */
6363 quotingType
[i
] = JIM_ELESTR_BRACE
;
6365 case JIM_ELESTR_BRACE
:
6368 case JIM_ELESTR_QUOTE
:
6372 bufLen
++; /* elements separator. */
6376 /* Generate the string rep. */
6377 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6379 for (i
= 0; i
< objc
; i
++) {
6382 strRep
= Jim_GetString(objv
[i
], &len
);
6384 switch (quotingType
[i
]) {
6385 case JIM_ELESTR_SIMPLE
:
6386 memcpy(p
, strRep
, len
);
6390 case JIM_ELESTR_BRACE
:
6392 memcpy(p
, strRep
, len
);
6395 realLength
+= len
+ 2;
6397 case JIM_ELESTR_QUOTE
:
6398 if (i
== 0 && strRep
[0] == '#') {
6402 qlen
= BackslashQuoteString(strRep
, len
, p
);
6407 /* Add a separating space */
6408 if (i
+ 1 != objc
) {
6413 *p
= '\0'; /* nul term. */
6414 objPtr
->length
= realLength
;
6416 if (quotingType
!= staticQuoting
) {
6417 Jim_Free(quotingType
);
6421 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6423 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6426 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6428 struct JimParserCtx parser
;
6431 Jim_Obj
*fileNameObj
;
6434 if (objPtr
->typePtr
== &listObjType
) {
6438 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6439 * it also preserves any source location of the dict elements
6440 * which can be very useful
6442 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6443 Jim_Obj
**listObjPtrPtr
;
6447 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6448 for (i
= 0; i
< len
; i
++) {
6449 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6452 /* Now just switch the internal rep */
6453 Jim_FreeIntRep(interp
, objPtr
);
6454 objPtr
->typePtr
= &listObjType
;
6455 objPtr
->internalRep
.listValue
.len
= len
;
6456 objPtr
->internalRep
.listValue
.maxLen
= len
;
6457 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6462 /* Try to preserve information about filename / line number */
6463 if (objPtr
->typePtr
== &sourceObjType
) {
6464 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6465 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6468 fileNameObj
= interp
->emptyObj
;
6471 Jim_IncrRefCount(fileNameObj
);
6473 /* Get the string representation */
6474 str
= Jim_GetString(objPtr
, &strLen
);
6476 /* Free the old internal repr just now and initialize the
6477 * new one just now. The string->list conversion can't fail. */
6478 Jim_FreeIntRep(interp
, objPtr
);
6479 objPtr
->typePtr
= &listObjType
;
6480 objPtr
->internalRep
.listValue
.len
= 0;
6481 objPtr
->internalRep
.listValue
.maxLen
= 0;
6482 objPtr
->internalRep
.listValue
.ele
= NULL
;
6484 /* Convert into a list */
6486 JimParserInit(&parser
, str
, strLen
, linenr
);
6487 while (!parser
.eof
) {
6488 Jim_Obj
*elementPtr
;
6490 JimParseList(&parser
);
6491 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6493 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6494 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6495 ListAppendElement(objPtr
, elementPtr
);
6498 Jim_DecrRefCount(interp
, fileNameObj
);
6502 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6506 objPtr
= Jim_NewObj(interp
);
6507 objPtr
->typePtr
= &listObjType
;
6508 objPtr
->bytes
= NULL
;
6509 objPtr
->internalRep
.listValue
.ele
= NULL
;
6510 objPtr
->internalRep
.listValue
.len
= 0;
6511 objPtr
->internalRep
.listValue
.maxLen
= 0;
6514 ListInsertElements(objPtr
, 0, len
, elements
);
6520 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6521 * length of the vector. Note that the user of this function should make
6522 * sure that the list object can't shimmer while the vector returned
6523 * is in use, this vector is the one stored inside the internal representation
6524 * of the list object. This function is not exported, extensions should
6525 * always access to the List object elements using Jim_ListIndex(). */
6526 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6529 *listLen
= Jim_ListLength(interp
, listObj
);
6530 *listVec
= listObj
->internalRep
.listValue
.ele
;
6533 /* Sorting uses ints, but commands may return wide */
6534 static int JimSign(jim_wide w
)
6545 /* ListSortElements type values */
6561 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6564 static struct lsort_info
*sort_info
;
6566 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6568 Jim_Obj
*lObj
, *rObj
;
6570 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6571 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6572 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6574 return sort_info
->subfn(&lObj
, &rObj
);
6577 /* Sort the internal rep of a list. */
6578 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6580 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6583 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6585 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6588 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6590 jim_wide lhs
= 0, rhs
= 0;
6592 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6593 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6594 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6597 return JimSign(lhs
- rhs
) * sort_info
->order
;
6600 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6602 double lhs
= 0, rhs
= 0;
6604 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6605 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6606 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6612 return sort_info
->order
;
6614 return -sort_info
->order
;
6617 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6619 Jim_Obj
*compare_script
;
6624 /* This must be a valid list */
6625 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6626 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6627 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6629 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6631 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6632 longjmp(sort_info
->jmpbuf
, rc
);
6635 return JimSign(ret
) * sort_info
->order
;
6638 /* Remove duplicate elements from the (sorted) list in-place, according to the
6639 * comparison function, comp.
6641 * Note that the last unique value is kept, not the first
6643 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6647 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6649 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6650 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6651 /* Match, so replace the dest with the current source */
6652 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6655 /* No match, so keep the current source and move to the next destination */
6658 ele
[dst
] = ele
[src
];
6660 /* At end of list, keep the final element */
6661 ele
[++dst
] = ele
[src
];
6663 /* Set the new length */
6664 listObjPtr
->internalRep
.listValue
.len
= dst
;
6667 /* Sort a list *in place*. MUST be called with a non-shared list. */
6668 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6670 struct lsort_info
*prev_info
;
6672 typedef int (qsort_comparator
) (const void *, const void *);
6673 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6678 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6679 SetListFromAny(interp
, listObjPtr
);
6681 /* Allow lsort to be called reentrantly */
6682 prev_info
= sort_info
;
6685 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6686 len
= listObjPtr
->internalRep
.listValue
.len
;
6687 switch (info
->type
) {
6688 case JIM_LSORT_ASCII
:
6689 fn
= ListSortString
;
6691 case JIM_LSORT_NOCASE
:
6692 fn
= ListSortStringNoCase
;
6694 case JIM_LSORT_INTEGER
:
6695 fn
= ListSortInteger
;
6697 case JIM_LSORT_REAL
:
6700 case JIM_LSORT_COMMAND
:
6701 fn
= ListSortCommand
;
6704 fn
= NULL
; /* avoid warning */
6705 JimPanic((1, "ListSort called with invalid sort type"));
6706 return -1; /* Should not be run but keeps static analysers happy */
6709 if (info
->indexed
) {
6710 /* Need to interpose a "list index" function */
6712 fn
= ListSortIndexHelper
;
6715 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6716 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6718 if (info
->unique
&& len
> 1) {
6719 ListRemoveDuplicates(listObjPtr
, fn
);
6722 Jim_InvalidateStringRep(listObjPtr
);
6724 sort_info
= prev_info
;
6729 /* This is the low-level function to insert elements into a list.
6730 * The higher-level Jim_ListInsertElements() performs shared object
6731 * check and invalidates the string repr. This version is used
6732 * in the internals of the List Object and is not exported.
6734 * NOTE: this function can be called only against objects
6735 * with internal type of List.
6737 * An insertion point (idx) of -1 means end-of-list.
6739 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6741 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6742 int requiredLen
= currentLen
+ elemc
;
6746 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6747 if (requiredLen
< 2) {
6748 /* Don't do allocations of under 4 pointers. */
6755 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6756 sizeof(Jim_Obj
*) * requiredLen
);
6758 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6763 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6764 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6765 for (i
= 0; i
< elemc
; ++i
) {
6766 point
[i
] = elemVec
[i
];
6767 Jim_IncrRefCount(point
[i
]);
6769 listPtr
->internalRep
.listValue
.len
+= elemc
;
6772 /* Convenience call to ListInsertElements() to append a single element.
6774 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6776 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6779 /* Appends every element of appendListPtr into listPtr.
6780 * Both have to be of the list type.
6781 * Convenience call to ListInsertElements()
6783 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6785 ListInsertElements(listPtr
, -1,
6786 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6789 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6791 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6792 SetListFromAny(interp
, listPtr
);
6793 Jim_InvalidateStringRep(listPtr
);
6794 ListAppendElement(listPtr
, objPtr
);
6797 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6799 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6800 SetListFromAny(interp
, listPtr
);
6801 SetListFromAny(interp
, appendListPtr
);
6802 Jim_InvalidateStringRep(listPtr
);
6803 ListAppendList(listPtr
, appendListPtr
);
6806 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6808 SetListFromAny(interp
, objPtr
);
6809 return objPtr
->internalRep
.listValue
.len
;
6812 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6813 int objc
, Jim_Obj
*const *objVec
)
6815 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6816 SetListFromAny(interp
, listPtr
);
6817 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6818 idx
= listPtr
->internalRep
.listValue
.len
;
6821 Jim_InvalidateStringRep(listPtr
);
6822 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6825 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6827 SetListFromAny(interp
, listPtr
);
6828 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6829 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6833 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6834 return listPtr
->internalRep
.listValue
.ele
[idx
];
6837 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6839 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6840 if (*objPtrPtr
== NULL
) {
6841 if (flags
& JIM_ERRMSG
) {
6842 Jim_SetResultString(interp
, "list index out of range", -1);
6849 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6850 Jim_Obj
*newObjPtr
, int flags
)
6852 SetListFromAny(interp
, listPtr
);
6853 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6854 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6855 if (flags
& JIM_ERRMSG
) {
6856 Jim_SetResultString(interp
, "list index out of range", -1);
6861 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6862 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6863 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6864 Jim_IncrRefCount(newObjPtr
);
6868 /* Modify the list stored in the variable named 'varNamePtr'
6869 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6870 * with the new element 'newObjptr'. (implements the [lset] command) */
6871 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6872 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6874 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6877 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6880 if ((shared
= Jim_IsShared(objPtr
)))
6881 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6882 for (i
= 0; i
< indexc
- 1; i
++) {
6883 listObjPtr
= objPtr
;
6884 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6886 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6889 if (Jim_IsShared(objPtr
)) {
6890 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6891 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6893 Jim_InvalidateStringRep(listObjPtr
);
6895 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6897 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6899 Jim_InvalidateStringRep(objPtr
);
6900 Jim_InvalidateStringRep(varObjPtr
);
6901 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6903 Jim_SetResult(interp
, varObjPtr
);
6907 Jim_FreeNewObj(interp
, varObjPtr
);
6912 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6915 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6916 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6918 for (i
= 0; i
< listLen
; ) {
6919 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6920 if (++i
!= listLen
) {
6921 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6927 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6931 /* If all the objects in objv are lists,
6932 * it's possible to return a list as result, that's the
6933 * concatenation of all the lists. */
6934 for (i
= 0; i
< objc
; i
++) {
6935 if (!Jim_IsList(objv
[i
]))
6939 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6941 for (i
= 0; i
< objc
; i
++)
6942 ListAppendList(objPtr
, objv
[i
]);
6946 /* Else... we have to glue strings together */
6947 int len
= 0, objLen
;
6950 /* Compute the length */
6951 for (i
= 0; i
< objc
; i
++) {
6952 len
+= Jim_Length(objv
[i
]);
6956 /* Create the string rep, and a string object holding it. */
6957 p
= bytes
= Jim_Alloc(len
+ 1);
6958 for (i
= 0; i
< objc
; i
++) {
6959 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6961 /* Remove leading space */
6962 while (objLen
&& isspace(UCHAR(*s
))) {
6967 /* And trailing space */
6968 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6969 /* Handle trailing backslash-space case */
6970 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6976 memcpy(p
, s
, objLen
);
6978 if (i
+ 1 != objc
) {
6982 /* Drop the space calculated for this
6983 * element that is instead null. */
6989 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6993 /* Returns a list composed of the elements in the specified range.
6994 * first and start are directly accepted as Jim_Objects and
6995 * processed for the end?-index? case. */
6996 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6997 Jim_Obj
*lastObjPtr
)
7002 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
7003 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
7005 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
7006 first
= JimRelToAbsIndex(len
, first
);
7007 last
= JimRelToAbsIndex(len
, last
);
7008 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
7009 if (first
== 0 && last
== len
) {
7012 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
7015 /* -----------------------------------------------------------------------------
7017 * ---------------------------------------------------------------------------*/
7018 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
7019 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
7020 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
7021 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7023 /* Dict HashTable Type.
7025 * Keys and Values are Jim objects. */
7027 static unsigned int JimObjectHTHashFunction(const void *key
)
7030 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
7031 return Jim_GenHashFunction((const unsigned char *)str
, len
);
7034 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
7036 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
7039 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
7041 Jim_IncrRefCount((Jim_Obj
*)val
);
7045 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
7047 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
7050 static const Jim_HashTableType JimDictHashTableType
= {
7051 JimObjectHTHashFunction
, /* hash function */
7052 JimObjectHTKeyValDup
, /* key dup */
7053 JimObjectHTKeyValDup
, /* val dup */
7054 JimObjectHTKeyCompare
, /* key compare */
7055 JimObjectHTKeyValDestructor
, /* key destructor */
7056 JimObjectHTKeyValDestructor
/* val destructor */
7059 /* Note that while the elements of the dict may contain references,
7060 * the list object itself can't. This basically means that the
7061 * dict object string representation as a whole can't contain references
7062 * that are not presents in the single elements. */
7063 static const Jim_ObjType dictObjType
= {
7065 FreeDictInternalRep
,
7071 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7073 JIM_NOTUSED(interp
);
7075 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7076 Jim_Free(objPtr
->internalRep
.ptr
);
7079 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7081 Jim_HashTable
*ht
, *dupHt
;
7082 Jim_HashTableIterator htiter
;
7085 /* Create a new hash table */
7086 ht
= srcPtr
->internalRep
.ptr
;
7087 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7088 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7090 Jim_ExpandHashTable(dupHt
, ht
->size
);
7091 /* Copy every element from the source to the dup hash table */
7092 JimInitHashTableIterator(ht
, &htiter
);
7093 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7094 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7097 dupPtr
->internalRep
.ptr
= dupHt
;
7098 dupPtr
->typePtr
= &dictObjType
;
7101 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7104 Jim_HashTableIterator htiter
;
7109 ht
= dictPtr
->internalRep
.ptr
;
7111 /* Turn the hash table into a flat vector of Jim_Objects. */
7112 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7113 JimInitHashTableIterator(ht
, &htiter
);
7115 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7116 objv
[i
++] = Jim_GetHashEntryKey(he
);
7117 objv
[i
++] = Jim_GetHashEntryVal(he
);
7123 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7125 /* Turn the hash table into a flat vector of Jim_Objects. */
7127 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7129 /* And now generate the string rep as a list */
7130 JimMakeListStringRep(objPtr
, objv
, len
);
7135 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7139 if (objPtr
->typePtr
== &dictObjType
) {
7143 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7144 /* A shared list, so get the string representation now to avoid
7145 * changing the order in case of fast conversion to dict.
7150 /* For simplicity, convert a non-list object to a list and then to a dict */
7151 listlen
= Jim_ListLength(interp
, objPtr
);
7153 Jim_SetResultString(interp
, "missing value to go with key", -1);
7157 /* Converting from a list to a dict can't fail */
7161 ht
= Jim_Alloc(sizeof(*ht
));
7162 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7164 for (i
= 0; i
< listlen
; i
+= 2) {
7165 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7166 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7168 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7171 Jim_FreeIntRep(interp
, objPtr
);
7172 objPtr
->typePtr
= &dictObjType
;
7173 objPtr
->internalRep
.ptr
= ht
;
7179 /* Dict object API */
7181 /* Add an element to a dict. objPtr must be of the "dict" type.
7182 * The higher-level exported function is Jim_DictAddElement().
7183 * If an element with the specified key already exists, the value
7184 * associated is replaced with the new one.
7186 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7187 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7188 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7190 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7192 if (valueObjPtr
== NULL
) { /* unset */
7193 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7195 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7199 /* Add an element, higher-level interface for DictAddElement().
7200 * If valueObjPtr == NULL, the key is removed if it exists. */
7201 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7202 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7204 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7205 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7208 Jim_InvalidateStringRep(objPtr
);
7209 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7212 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7217 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7219 objPtr
= Jim_NewObj(interp
);
7220 objPtr
->typePtr
= &dictObjType
;
7221 objPtr
->bytes
= NULL
;
7222 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7223 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7224 for (i
= 0; i
< len
; i
+= 2)
7225 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7229 /* Return the value associated to the specified dict key
7230 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7232 * Sets *objPtrPtr to non-NULL only upon success.
7234 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7235 Jim_Obj
**objPtrPtr
, int flags
)
7240 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7243 ht
= dictPtr
->internalRep
.ptr
;
7244 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7245 if (flags
& JIM_ERRMSG
) {
7246 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7251 *objPtrPtr
= Jim_GetHashEntryVal(he
);
7256 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7257 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7259 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7262 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7268 /* Return the value associated to the specified dict keys */
7269 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7270 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7275 *objPtrPtr
= dictPtr
;
7279 for (i
= 0; i
< keyc
; i
++) {
7282 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7288 *objPtrPtr
= dictPtr
;
7292 /* Modify the dict stored into the variable named 'varNamePtr'
7293 * setting the element specified by the 'keyc' keys objects in 'keyv',
7294 * with the new value of the element 'newObjPtr'.
7296 * If newObjPtr == NULL the operation is to remove the given key
7297 * from the dictionary.
7299 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7300 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7302 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7303 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7305 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7308 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7309 if (objPtr
== NULL
) {
7310 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7311 /* Cannot remove a key from non existing var */
7314 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7315 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7316 Jim_FreeNewObj(interp
, varObjPtr
);
7320 if ((shared
= Jim_IsShared(objPtr
)))
7321 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7322 for (i
= 0; i
< keyc
; i
++) {
7323 dictObjPtr
= objPtr
;
7325 /* Check if it's a valid dictionary */
7326 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7330 if (i
== keyc
- 1) {
7331 /* Last key: Note that error on unset with missing last key is OK */
7332 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7333 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7340 /* Check if the given key exists. */
7341 Jim_InvalidateStringRep(dictObjPtr
);
7342 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7343 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7344 /* This key exists at the current level.
7345 * Make sure it's not shared!. */
7346 if (Jim_IsShared(objPtr
)) {
7347 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7348 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7352 /* Key not found. If it's an [unset] operation
7353 * this is an error. Only the last key may not
7355 if (newObjPtr
== NULL
) {
7358 /* Otherwise set an empty dictionary
7359 * as key's value. */
7360 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7361 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7364 /* XXX: Is this necessary? */
7365 Jim_InvalidateStringRep(objPtr
);
7366 Jim_InvalidateStringRep(varObjPtr
);
7367 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7370 Jim_SetResult(interp
, varObjPtr
);
7374 Jim_FreeNewObj(interp
, varObjPtr
);
7379 /* -----------------------------------------------------------------------------
7381 * ---------------------------------------------------------------------------*/
7382 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7383 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7385 static const Jim_ObjType indexObjType
= {
7389 UpdateStringOfIndex
,
7393 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7395 if (objPtr
->internalRep
.intValue
== -1) {
7396 JimSetStringBytes(objPtr
, "end");
7399 char buf
[JIM_INTEGER_SPACE
+ 1];
7400 if (objPtr
->internalRep
.intValue
>= 0) {
7401 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7405 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7407 JimSetStringBytes(objPtr
, buf
);
7411 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7417 /* Get the string representation */
7418 str
= Jim_String(objPtr
);
7420 /* Try to convert into an index */
7421 if (strncmp(str
, "end", 3) == 0) {
7427 idx
= jim_strtol(str
, &endptr
);
7429 if (endptr
== str
) {
7435 /* Now str may include or +<num> or -<num> */
7436 if (*str
== '+' || *str
== '-') {
7437 int sign
= (*str
== '+' ? 1 : -1);
7439 idx
+= sign
* jim_strtol(++str
, &endptr
);
7440 if (str
== endptr
|| *endptr
) {
7445 /* The only thing left should be spaces */
7446 while (isspace(UCHAR(*str
))) {
7457 /* end-1 is repesented as -2 */
7465 /* Free the old internal repr and set the new one. */
7466 Jim_FreeIntRep(interp
, objPtr
);
7467 objPtr
->typePtr
= &indexObjType
;
7468 objPtr
->internalRep
.intValue
= idx
;
7472 Jim_SetResultFormatted(interp
,
7473 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7477 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7479 /* Avoid shimmering if the object is an integer. */
7480 if (objPtr
->typePtr
== &intObjType
) {
7481 jim_wide val
= JimWideValue(objPtr
);
7484 *indexPtr
= -INT_MAX
;
7485 else if (val
> INT_MAX
)
7486 *indexPtr
= INT_MAX
;
7488 *indexPtr
= (int)val
;
7491 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7493 *indexPtr
= objPtr
->internalRep
.intValue
;
7497 /* -----------------------------------------------------------------------------
7498 * Return Code Object.
7499 * ---------------------------------------------------------------------------*/
7501 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7502 static const char * const jimReturnCodes
[] = {
7514 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7516 static const Jim_ObjType returnCodeObjType
= {
7524 /* Converts a (standard) return code to a string. Returns "?" for
7525 * non-standard return codes.
7527 const char *Jim_ReturnCode(int code
)
7529 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7533 return jimReturnCodes
[code
];
7537 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7542 /* Try to convert into an integer */
7543 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7544 returnCode
= (int)wideValue
;
7545 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7546 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7549 /* Free the old internal repr and set the new one. */
7550 Jim_FreeIntRep(interp
, objPtr
);
7551 objPtr
->typePtr
= &returnCodeObjType
;
7552 objPtr
->internalRep
.intValue
= returnCode
;
7556 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7558 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7560 *intPtr
= objPtr
->internalRep
.intValue
;
7564 /* -----------------------------------------------------------------------------
7565 * Expression Parsing
7566 * ---------------------------------------------------------------------------*/
7567 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7568 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7569 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7570 static int JimParseExprBoolean(struct JimParserCtx
*pc
);
7572 /* Exrp's Stack machine operators opcodes. */
7574 /* Binary operators (numbers) */
7577 /* Continues on from the JIM_TT_ space */
7579 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7594 JIM_EXPROP_BITAND
, /* 35 */
7598 /* Note must keep these together */
7599 JIM_EXPROP_LOGICAND
, /* 38 */
7600 JIM_EXPROP_LOGICAND_LEFT
,
7601 JIM_EXPROP_LOGICAND_RIGHT
,
7604 JIM_EXPROP_LOGICOR
, /* 41 */
7605 JIM_EXPROP_LOGICOR_LEFT
,
7606 JIM_EXPROP_LOGICOR_RIGHT
,
7609 /* Ternary operators */
7610 JIM_EXPROP_TERNARY
, /* 44 */
7611 JIM_EXPROP_TERNARY_LEFT
,
7612 JIM_EXPROP_TERNARY_RIGHT
,
7615 JIM_EXPROP_COLON
, /* 47 */
7616 JIM_EXPROP_COLON_LEFT
,
7617 JIM_EXPROP_COLON_RIGHT
,
7619 JIM_EXPROP_POW
, /* 50 */
7621 /* Binary operators (strings) */
7622 JIM_EXPROP_STREQ
, /* 51 */
7627 /* Unary operators (numbers) */
7628 JIM_EXPROP_NOT
, /* 55 */
7630 JIM_EXPROP_UNARYMINUS
,
7631 JIM_EXPROP_UNARYPLUS
,
7634 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7635 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7636 JIM_EXPROP_FUNC_WIDE
,
7637 JIM_EXPROP_FUNC_ABS
,
7638 JIM_EXPROP_FUNC_DOUBLE
,
7639 JIM_EXPROP_FUNC_ROUND
,
7640 JIM_EXPROP_FUNC_RAND
,
7641 JIM_EXPROP_FUNC_SRAND
,
7643 /* math functions from libm */
7644 JIM_EXPROP_FUNC_SIN
, /* 65 */
7645 JIM_EXPROP_FUNC_COS
,
7646 JIM_EXPROP_FUNC_TAN
,
7647 JIM_EXPROP_FUNC_ASIN
,
7648 JIM_EXPROP_FUNC_ACOS
,
7649 JIM_EXPROP_FUNC_ATAN
,
7650 JIM_EXPROP_FUNC_ATAN2
,
7651 JIM_EXPROP_FUNC_SINH
,
7652 JIM_EXPROP_FUNC_COSH
,
7653 JIM_EXPROP_FUNC_TANH
,
7654 JIM_EXPROP_FUNC_CEIL
,
7655 JIM_EXPROP_FUNC_FLOOR
,
7656 JIM_EXPROP_FUNC_EXP
,
7657 JIM_EXPROP_FUNC_LOG
,
7658 JIM_EXPROP_FUNC_LOG10
,
7659 JIM_EXPROP_FUNC_SQRT
,
7660 JIM_EXPROP_FUNC_POW
,
7661 JIM_EXPROP_FUNC_HYPOT
,
7662 JIM_EXPROP_FUNC_FMOD
,
7673 /* Operators table */
7674 typedef struct Jim_ExprOperator
7677 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7678 unsigned char precedence
;
7679 unsigned char arity
;
7681 unsigned char namelen
;
7684 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7686 Jim_IncrRefCount(obj
);
7687 e
->stack
[e
->stacklen
++] = obj
;
7690 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7692 return e
->stack
[--e
->stacklen
];
7695 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7699 Jim_Obj
*A
= ExprPop(e
);
7701 jim_wide wA
, wC
= 0;
7703 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7704 switch (e
->opcode
) {
7705 case JIM_EXPROP_FUNC_INT
:
7706 case JIM_EXPROP_FUNC_WIDE
:
7707 case JIM_EXPROP_FUNC_ROUND
:
7708 case JIM_EXPROP_UNARYPLUS
:
7711 case JIM_EXPROP_FUNC_DOUBLE
:
7715 case JIM_EXPROP_FUNC_ABS
:
7716 wC
= wA
>= 0 ? wA
: -wA
;
7718 case JIM_EXPROP_UNARYMINUS
:
7721 case JIM_EXPROP_NOT
:
7728 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7729 switch (e
->opcode
) {
7730 case JIM_EXPROP_FUNC_INT
:
7731 case JIM_EXPROP_FUNC_WIDE
:
7734 case JIM_EXPROP_FUNC_ROUND
:
7735 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7737 case JIM_EXPROP_FUNC_DOUBLE
:
7738 case JIM_EXPROP_UNARYPLUS
:
7742 case JIM_EXPROP_FUNC_ABS
:
7743 #ifdef JIM_MATH_FUNCTIONS
7746 dC
= dA
>= 0 ? dA
: -dA
;
7750 case JIM_EXPROP_UNARYMINUS
:
7754 case JIM_EXPROP_NOT
:
7764 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7767 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7771 Jim_DecrRefCount(interp
, A
);
7776 static double JimRandDouble(Jim_Interp
*interp
)
7779 JimRandomBytes(interp
, &x
, sizeof(x
));
7781 return (double)x
/ (unsigned long)~0;
7784 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7786 Jim_Obj
*A
= ExprPop(e
);
7789 int rc
= Jim_GetWide(interp
, A
, &wA
);
7791 switch (e
->opcode
) {
7792 case JIM_EXPROP_BITNOT
:
7793 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7795 case JIM_EXPROP_FUNC_SRAND
:
7796 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7797 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7804 Jim_DecrRefCount(interp
, A
);
7809 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7811 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7813 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7818 #ifdef JIM_MATH_FUNCTIONS
7819 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7822 Jim_Obj
*A
= ExprPop(e
);
7825 rc
= Jim_GetDouble(interp
, A
, &dA
);
7827 switch (e
->opcode
) {
7828 case JIM_EXPROP_FUNC_SIN
:
7831 case JIM_EXPROP_FUNC_COS
:
7834 case JIM_EXPROP_FUNC_TAN
:
7837 case JIM_EXPROP_FUNC_ASIN
:
7840 case JIM_EXPROP_FUNC_ACOS
:
7843 case JIM_EXPROP_FUNC_ATAN
:
7846 case JIM_EXPROP_FUNC_SINH
:
7849 case JIM_EXPROP_FUNC_COSH
:
7852 case JIM_EXPROP_FUNC_TANH
:
7855 case JIM_EXPROP_FUNC_CEIL
:
7858 case JIM_EXPROP_FUNC_FLOOR
:
7861 case JIM_EXPROP_FUNC_EXP
:
7864 case JIM_EXPROP_FUNC_LOG
:
7867 case JIM_EXPROP_FUNC_LOG10
:
7870 case JIM_EXPROP_FUNC_SQRT
:
7876 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7879 Jim_DecrRefCount(interp
, A
);
7885 /* A binary operation on two ints */
7886 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7888 Jim_Obj
*B
= ExprPop(e
);
7889 Jim_Obj
*A
= ExprPop(e
);
7893 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7898 switch (e
->opcode
) {
7899 case JIM_EXPROP_LSHIFT
:
7902 case JIM_EXPROP_RSHIFT
:
7905 case JIM_EXPROP_BITAND
:
7908 case JIM_EXPROP_BITXOR
:
7911 case JIM_EXPROP_BITOR
:
7914 case JIM_EXPROP_MOD
:
7917 Jim_SetResultString(interp
, "Division by zero", -1);
7924 * This code is tricky: C doesn't guarantee much
7925 * about the quotient or remainder, but Tcl does.
7926 * The remainder always has the same sign as the
7927 * divisor and a smaller absolute value.
7945 case JIM_EXPROP_ROTL
:
7946 case JIM_EXPROP_ROTR
:{
7947 /* uint32_t would be better. But not everyone has inttypes.h? */
7948 unsigned long uA
= (unsigned long)wA
;
7949 unsigned long uB
= (unsigned long)wB
;
7950 const unsigned int S
= sizeof(unsigned long) * 8;
7952 /* Shift left by the word size or more is undefined. */
7955 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7958 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7964 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7968 Jim_DecrRefCount(interp
, A
);
7969 Jim_DecrRefCount(interp
, B
);
7975 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7976 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7979 double dA
, dB
, dC
= 0;
7980 jim_wide wA
, wB
, wC
= 0;
7982 Jim_Obj
*B
= ExprPop(e
);
7983 Jim_Obj
*A
= ExprPop(e
);
7985 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7986 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7987 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7991 switch (e
->opcode
) {
7992 case JIM_EXPROP_POW
:
7993 case JIM_EXPROP_FUNC_POW
:
7994 if (wA
== 0 && wB
< 0) {
7995 Jim_SetResultString(interp
, "exponentiation of zero by negative power", -1);
7999 wC
= JimPowWide(wA
, wB
);
8001 case JIM_EXPROP_ADD
:
8004 case JIM_EXPROP_SUB
:
8007 case JIM_EXPROP_MUL
:
8010 case JIM_EXPROP_DIV
:
8012 Jim_SetResultString(interp
, "Division by zero", -1);
8020 * This code is tricky: C doesn't guarantee much
8021 * about the quotient or remainder, but Tcl does.
8022 * The remainder always has the same sign as the
8023 * divisor and a smaller absolute value.
8041 case JIM_EXPROP_LTE
:
8044 case JIM_EXPROP_GTE
:
8047 case JIM_EXPROP_NUMEQ
:
8050 case JIM_EXPROP_NUMNE
:
8055 if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
8056 switch (e
->opcode
) {
8057 #ifndef JIM_MATH_FUNCTIONS
8058 case JIM_EXPROP_POW
:
8059 case JIM_EXPROP_FUNC_POW
:
8060 case JIM_EXPROP_FUNC_ATAN2
:
8061 case JIM_EXPROP_FUNC_HYPOT
:
8062 case JIM_EXPROP_FUNC_FMOD
:
8063 Jim_SetResultString(interp
, "unsupported", -1);
8067 case JIM_EXPROP_POW
:
8068 case JIM_EXPROP_FUNC_POW
:
8071 case JIM_EXPROP_FUNC_ATAN2
:
8074 case JIM_EXPROP_FUNC_HYPOT
:
8077 case JIM_EXPROP_FUNC_FMOD
:
8081 case JIM_EXPROP_ADD
:
8084 case JIM_EXPROP_SUB
:
8087 case JIM_EXPROP_MUL
:
8090 case JIM_EXPROP_DIV
:
8093 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
8095 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8108 case JIM_EXPROP_LTE
:
8111 case JIM_EXPROP_GTE
:
8114 case JIM_EXPROP_NUMEQ
:
8117 case JIM_EXPROP_NUMNE
:
8123 /* Handle the string case */
8125 /* XXX: Could optimise the eq/ne case by checking lengths */
8126 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8128 switch (e
->opcode
) {
8135 case JIM_EXPROP_LTE
:
8138 case JIM_EXPROP_GTE
:
8141 case JIM_EXPROP_NUMEQ
:
8144 case JIM_EXPROP_NUMNE
:
8149 /* If we get here, it is an error */
8152 Jim_DecrRefCount(interp
, A
);
8153 Jim_DecrRefCount(interp
, B
);
8156 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8159 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8163 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8168 listlen
= Jim_ListLength(interp
, listObjPtr
);
8169 for (i
= 0; i
< listlen
; i
++) {
8170 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8177 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8179 Jim_Obj
*B
= ExprPop(e
);
8180 Jim_Obj
*A
= ExprPop(e
);
8184 switch (e
->opcode
) {
8185 case JIM_EXPROP_STREQ
:
8186 case JIM_EXPROP_STRNE
:
8187 wC
= Jim_StringEqObj(A
, B
);
8188 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8192 case JIM_EXPROP_STRIN
:
8193 wC
= JimSearchList(interp
, B
, A
);
8195 case JIM_EXPROP_STRNI
:
8196 wC
= !JimSearchList(interp
, B
, A
);
8201 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8203 Jim_DecrRefCount(interp
, A
);
8204 Jim_DecrRefCount(interp
, B
);
8209 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8215 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8218 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8221 if (Jim_GetBoolean(interp
, obj
, &b
) == JIM_OK
) {
8227 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8229 Jim_Obj
*skip
= ExprPop(e
);
8230 Jim_Obj
*A
= ExprPop(e
);
8233 switch (ExprBool(interp
, A
)) {
8235 /* false, so skip RHS opcodes with a 0 result */
8236 e
->skip
= JimWideValue(skip
);
8237 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8241 /* true so continue */
8248 Jim_DecrRefCount(interp
, A
);
8249 Jim_DecrRefCount(interp
, skip
);
8254 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8256 Jim_Obj
*skip
= ExprPop(e
);
8257 Jim_Obj
*A
= ExprPop(e
);
8260 switch (ExprBool(interp
, A
)) {
8262 /* false, so do nothing */
8266 /* true so skip RHS opcodes with a 1 result */
8267 e
->skip
= JimWideValue(skip
);
8268 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8276 Jim_DecrRefCount(interp
, A
);
8277 Jim_DecrRefCount(interp
, skip
);
8282 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8284 Jim_Obj
*A
= ExprPop(e
);
8287 switch (ExprBool(interp
, A
)) {
8289 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8293 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8301 Jim_DecrRefCount(interp
, A
);
8306 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8308 Jim_Obj
*skip
= ExprPop(e
);
8309 Jim_Obj
*A
= ExprPop(e
);
8315 switch (ExprBool(interp
, A
)) {
8317 /* false, skip RHS opcodes */
8318 e
->skip
= JimWideValue(skip
);
8319 /* Push a dummy value */
8320 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8324 /* true so do nothing */
8332 Jim_DecrRefCount(interp
, A
);
8333 Jim_DecrRefCount(interp
, skip
);
8338 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8340 Jim_Obj
*skip
= ExprPop(e
);
8341 Jim_Obj
*B
= ExprPop(e
);
8342 Jim_Obj
*A
= ExprPop(e
);
8344 /* No need to check for A as non-boolean */
8345 if (ExprBool(interp
, A
)) {
8346 /* true, so skip RHS opcodes */
8347 e
->skip
= JimWideValue(skip
);
8348 /* Repush B as the answer */
8352 Jim_DecrRefCount(interp
, skip
);
8353 Jim_DecrRefCount(interp
, A
);
8354 Jim_DecrRefCount(interp
, B
);
8358 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8369 RIGHT_ASSOC
, /* reuse this field for right associativity too */
8372 /* name - precedence - arity - opcode
8374 * This array *must* be kept in sync with the JIM_EXPROP enum.
8376 * The following macros pre-compute the string length at compile time.
8378 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8379 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8381 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8382 OPRINIT("*", 110, 2, JimExprOpBin
),
8383 OPRINIT("/", 110, 2, JimExprOpBin
),
8384 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8386 OPRINIT("-", 100, 2, JimExprOpBin
),
8387 OPRINIT("+", 100, 2, JimExprOpBin
),
8389 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8390 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8392 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8393 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8395 OPRINIT("<", 80, 2, JimExprOpBin
),
8396 OPRINIT(">", 80, 2, JimExprOpBin
),
8397 OPRINIT("<=", 80, 2, JimExprOpBin
),
8398 OPRINIT(">=", 80, 2, JimExprOpBin
),
8400 OPRINIT("==", 70, 2, JimExprOpBin
),
8401 OPRINIT("!=", 70, 2, JimExprOpBin
),
8403 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8404 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8405 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8407 OPRINIT_ATTR("&&", 10, 2, NULL
, LAZY_OP
),
8408 OPRINIT_ATTR(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8409 OPRINIT_ATTR(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8411 OPRINIT_ATTR("||", 9, 2, NULL
, LAZY_OP
),
8412 OPRINIT_ATTR(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8413 OPRINIT_ATTR(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8415 OPRINIT_ATTR("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8416 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8417 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8419 OPRINIT_ATTR(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8420 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8421 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8423 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8424 OPRINIT_ATTR("**", 120, 2, JimExprOpBin
, RIGHT_ASSOC
),
8426 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8427 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8429 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8430 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8432 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8433 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8434 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8435 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8439 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8440 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8441 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8442 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8443 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8444 OPRINIT("rand", 200, 0, JimExprOpNone
),
8445 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8447 #ifdef JIM_MATH_FUNCTIONS
8448 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8449 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8450 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8451 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8452 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8453 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8454 OPRINIT("atan2", 200, 2, JimExprOpBin
),
8455 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8456 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8457 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8458 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8459 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8460 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8461 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8462 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8463 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8464 OPRINIT("pow", 200, 2, JimExprOpBin
),
8465 OPRINIT("hypot", 200, 2, JimExprOpBin
),
8466 OPRINIT("fmod", 200, 2, JimExprOpBin
),
8472 #define JIM_EXPR_OPERATORS_NUM \
8473 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8475 static int JimParseExpression(struct JimParserCtx
*pc
)
8477 /* Discard spaces and quoted newline */
8478 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8479 if (*pc
->p
== '\n') {
8487 pc
->tline
= pc
->linenr
;
8492 pc
->tt
= JIM_TT_EOL
;
8498 pc
->tt
= JIM_TT_SUBEXPR_START
;
8501 pc
->tt
= JIM_TT_SUBEXPR_END
;
8504 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8511 return JimParseCmd(pc
);
8513 if (JimParseVar(pc
) == JIM_ERR
)
8514 return JimParseExprOperator(pc
);
8516 /* Don't allow expr sugar in expressions */
8517 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8534 return JimParseExprNumber(pc
);
8536 return JimParseQuote(pc
);
8538 return JimParseBrace(pc
);
8544 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8545 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8546 return JimParseExprOperator(pc
);
8552 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8553 return JimParseExprOperator(pc
);
8556 return JimParseExprOperator(pc
);
8562 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8566 /* Assume an integer for now */
8567 pc
->tt
= JIM_TT_EXPR_INT
;
8569 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8570 /* Tried as an integer, but perhaps it parses as a double */
8571 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8572 /* Some stupid compilers insist they are cleverer that
8573 * we are. Even a (void) cast doesn't prevent this warning!
8575 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8576 if (end
== pc
->tstart
)
8579 /* Yes, double captured more chars */
8580 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8584 pc
->tend
= pc
->p
- 1;
8585 pc
->len
-= (pc
->p
- pc
->tstart
);
8589 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8591 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8594 for (i
= 0; irrationals
[i
]; i
++) {
8595 const char *irr
= irrationals
[i
];
8597 if (strncmp(irr
, pc
->p
, 3) == 0) {
8600 pc
->tend
= pc
->p
- 1;
8601 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8608 static int JimParseExprBoolean(struct JimParserCtx
*pc
)
8610 const char *booleans
[] = { "false", "no", "off", "true", "yes", "on", NULL
};
8611 const int lengths
[] = { 5, 2, 3, 4, 3, 2, 0 };
8614 for (i
= 0; booleans
[i
]; i
++) {
8615 const char *boolean
= booleans
[i
];
8616 int length
= lengths
[i
];
8618 if (strncmp(boolean
, pc
->p
, length
) == 0) {
8621 pc
->tend
= pc
->p
- 1;
8622 pc
->tt
= JIM_TT_EXPR_BOOLEAN
;
8629 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8632 int bestIdx
= -1, bestLen
= 0;
8634 /* Try to get the longest match. */
8635 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8636 const char * const opname
= Jim_ExprOperators
[i
].name
;
8637 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8639 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8643 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8644 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8648 if (bestIdx
== -1) {
8652 /* Validate paretheses around function arguments */
8653 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8654 const char *p
= pc
->p
+ bestLen
;
8655 int len
= pc
->len
- bestLen
;
8657 while (len
&& isspace(UCHAR(*p
))) {
8665 pc
->tend
= pc
->p
+ bestLen
- 1;
8673 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8675 static Jim_ExprOperator dummy_op
;
8676 if (opcode
< JIM_TT_EXPR_OP
) {
8679 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8682 const char *jim_tt_name(int type
)
8684 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8685 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8686 "DBL", "BOO", "$()" };
8687 if (type
< JIM_TT_EXPR_OP
) {
8688 return tt_names
[type
];
8690 else if (type
== JIM_EXPROP_UNARYMINUS
) {
8693 else if (type
== JIM_EXPROP_UNARYPLUS
) {
8697 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8698 static char buf
[20];
8703 sprintf(buf
, "(%d)", type
);
8708 /* -----------------------------------------------------------------------------
8710 * ---------------------------------------------------------------------------*/
8711 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8712 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8713 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8715 static const Jim_ObjType exprObjType
= {
8717 FreeExprInternalRep
,
8720 JIM_TYPE_REFERENCES
,
8723 /* Expr bytecode structure */
8724 typedef struct ExprByteCode
8726 ScriptToken
*token
; /* Tokens array. */
8727 int len
; /* Length as number of tokens. */
8728 int inUse
; /* Used for sharing. */
8731 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8735 for (i
= 0; i
< expr
->len
; i
++) {
8736 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8738 Jim_Free(expr
->token
);
8742 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8744 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8747 if (--expr
->inUse
!= 0) {
8751 ExprFreeByteCode(interp
, expr
);
8755 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8757 JIM_NOTUSED(interp
);
8758 JIM_NOTUSED(srcPtr
);
8760 /* Just returns an simple string. */
8761 dupPtr
->typePtr
= NULL
;
8764 /* Check if an expr program looks correct
8765 * Sets an error result on invalid
8767 static int ExprCheckCorrectness(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, ExprByteCode
* expr
)
8772 int lasttt
= JIM_TT_NONE
;
8775 /* Try to check if there are stack underflows,
8776 * and make sure at the end of the program there is
8777 * a single result on the stack. */
8778 for (i
= 0; i
< expr
->len
; i
++) {
8779 ScriptToken
*t
= &expr
->token
[i
];
8780 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8783 stacklen
-= op
->arity
;
8788 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8791 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8795 /* All operations and operands add one to the stack */
8798 if (stacklen
== 1 && ternary
== 0) {
8802 if (stacklen
<= 0) {
8804 if (lasttt
>= JIM_EXPROP_FUNC_FIRST
) {
8805 errmsg
= "too few arguments for math function";
8806 Jim_SetResultString(interp
, "too few arguments for math function", -1);
8808 errmsg
= "premature end of expression";
8811 else if (stacklen
> 1) {
8812 if (lasttt
>= JIM_EXPROP_FUNC_FIRST
) {
8813 errmsg
= "too many arguments for math function";
8815 errmsg
= "extra tokens at end of expression";
8819 errmsg
= "invalid ternary expression";
8821 Jim_SetResultFormatted(interp
, "syntax error in expression \"%#s\": %s", exprObjPtr
, errmsg
);
8825 /* This procedure converts every occurrence of || and && opereators
8826 * in lazy unary versions.
8828 * a b || is converted into:
8830 * a <offset> |L b |R
8832 * a b && is converted into:
8834 * a <offset> &L b &R
8836 * "|L" checks if 'a' is true:
8837 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8838 * the opcode just after |R.
8839 * 2) if it is false does nothing.
8840 * "|R" checks if 'b' is true:
8841 * 1) if it is true pushes 1, otherwise pushes 0.
8843 * "&L" checks if 'a' is true:
8844 * 1) if it is true does nothing.
8845 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8846 * the opcode just after &R
8847 * "&R" checks if 'a' is true:
8848 * if it is true pushes 1, otherwise pushes 0.
8850 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8854 int leftindex
, arity
, offset
;
8856 /* Search for the end of the first operator */
8857 leftindex
= expr
->len
- 1;
8861 ScriptToken
*tt
= &expr
->token
[leftindex
];
8863 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8864 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8867 if (--leftindex
< 0) {
8874 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8875 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8877 offset
= (expr
->len
- leftindex
) - 1;
8879 /* Now we rely on the fact that the left and right version have opcodes
8880 * 1 and 2 after the main opcode respectively
8882 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8883 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8885 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8886 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8888 /* Now add the 'R' operator */
8889 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8890 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8893 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8894 for (i
= leftindex
- 1; i
> 0; i
--) {
8895 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8896 if (op
->lazy
== LAZY_LEFT
) {
8897 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8898 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8905 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8907 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8908 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8910 if (op
->lazy
== LAZY_OP
) {
8911 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8912 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8917 token
->objPtr
= interp
->emptyObj
;
8918 token
->type
= t
->type
;
8925 * Returns the index of the COLON_LEFT to the left of 'right_index'
8926 * taking into account nesting.
8928 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8930 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8932 int ternary_count
= 1;
8936 while (right_index
> 1) {
8937 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8940 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8943 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8954 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8956 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8957 * Otherwise returns 0.
8959 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8961 int i
= right_index
- 1;
8962 int ternary_count
= 1;
8965 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8966 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8967 *prev_right_index
= i
- 2;
8968 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8972 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8973 if (ternary_count
== 0) {
8984 * ExprTernaryReorderExpression description
8985 * ========================================
8987 * ?: is right-to-left associative which doesn't work with the stack-based
8988 * expression engine. The fix is to reorder the bytecode.
8994 * Has initial bytecode:
8996 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8997 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8999 * The fix involves simulating this expression instead:
9003 * With the following bytecode:
9005 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9006 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9008 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9009 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9010 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9011 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9013 * ExprTernaryReorderExpression works thus as follows :
9014 * - start from the end of the stack
9015 * - while walking towards the beginning of the stack
9016 * if token=JIM_EXPROP_COLON_RIGHT then
9017 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9018 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9019 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9021 * perform the rotation
9022 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9026 * Note: care has to be taken for nested ternary constructs!!!
9028 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
9032 for (i
= expr
->len
- 1; i
> 1; i
--) {
9033 int prev_right_index
;
9034 int prev_left_index
;
9038 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
9042 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9043 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
9048 ** rotate tokens down
9050 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9059 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9061 tmp
= expr
->token
[prev_right_index
];
9062 for (j
= prev_right_index
; j
< i
; j
++) {
9063 expr
->token
[j
] = expr
->token
[j
+ 1];
9065 expr
->token
[i
] = tmp
;
9067 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9069 * This is 'colon left increment' = i - prev_right_index
9071 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9072 * [prev_left_index-1] : skip_count
9075 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
9077 /* Adjust for i-- in the loop */
9082 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*exprObjPtr
, Jim_Obj
*fileNameObj
)
9088 int prevtt
= JIM_TT_NONE
;
9089 int have_ternary
= 0;
9092 int count
= tokenlist
->count
- 1;
9094 expr
= Jim_Alloc(sizeof(*expr
));
9098 Jim_InitStack(&stack
);
9100 /* Need extra bytecodes for lazy operators.
9101 * Also check for the ternary operator
9103 for (i
= 0; i
< tokenlist
->count
; i
++) {
9104 ParseToken
*t
= &tokenlist
->list
[i
];
9105 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
9107 if (op
->lazy
== LAZY_OP
) {
9109 /* Ternary is a lazy op but also needs reordering */
9110 if (t
->type
== JIM_EXPROP_TERNARY
) {
9116 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
9118 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
9119 ParseToken
*t
= &tokenlist
->list
[i
];
9121 /* Next token will be stored here */
9122 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
9124 if (t
->type
== JIM_TT_EOL
) {
9128 if (TOKEN_IS_EXPR_OP(t
->type
)) {
9129 const struct Jim_ExprOperator
*op
;
9132 /* Convert -/+ to unary minus or unary plus if necessary */
9133 if (prevtt
== JIM_TT_NONE
|| prevtt
== JIM_TT_SUBEXPR_START
|| prevtt
== JIM_TT_SUBEXPR_COMMA
|| prevtt
>= JIM_TT_EXPR_OP
) {
9134 if (t
->type
== JIM_EXPROP_SUB
) {
9135 t
->type
= JIM_EXPROP_UNARYMINUS
;
9137 else if (t
->type
== JIM_EXPROP_ADD
) {
9138 t
->type
= JIM_EXPROP_UNARYPLUS
;
9142 op
= JimExprOperatorInfoByOpcode(t
->type
);
9144 /* Handle precedence */
9145 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9146 const struct Jim_ExprOperator
*tt_op
=
9147 JimExprOperatorInfoByOpcode(tt
->type
);
9149 /* Note that right-to-left associativity of ?: operator is handled later.
9152 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9153 /* Don't reduce if right associative with equal precedence? */
9154 if (tt_op
->precedence
== op
->precedence
&& tt_op
->lazy
== RIGHT_ASSOC
) {
9157 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9161 Jim_StackPop(&stack
);
9167 Jim_StackPush(&stack
, t
);
9169 else if (t
->type
== JIM_TT_SUBEXPR_START
) {
9170 Jim_StackPush(&stack
, t
);
9172 else if (t
->type
== JIM_TT_SUBEXPR_END
|| t
->type
== JIM_TT_SUBEXPR_COMMA
) {
9173 /* Reduce the expression back to the previous ( or , */
9175 while (Jim_StackLen(&stack
)) {
9176 ParseToken
*tt
= Jim_StackPop(&stack
);
9178 if (tt
->type
== JIM_TT_SUBEXPR_START
|| tt
->type
== JIM_TT_SUBEXPR_COMMA
) {
9179 if (t
->type
== JIM_TT_SUBEXPR_COMMA
) {
9180 /* Need to push back the previous START or COMMA in the case of comma */
9181 Jim_StackPush(&stack
, tt
);
9186 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9191 Jim_SetResultFormatted(interp
, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr
);
9196 Jim_Obj
*objPtr
= NULL
;
9198 /* This is a simple non-operator term, so create and push the appropriate object */
9199 token
->type
= t
->type
;
9201 /* Two consecutive terms without an operator is invalid */
9202 if (!TOKEN_IS_EXPR_START(prevtt
) && !TOKEN_IS_EXPR_OP(prevtt
)) {
9203 Jim_SetResultFormatted(interp
, "missing operator in expression: \"%#s\"", exprObjPtr
);
9208 /* Immediately create a double or int object? */
9209 if (t
->type
== JIM_TT_EXPR_INT
|| t
->type
== JIM_TT_EXPR_DOUBLE
) {
9211 if (t
->type
== JIM_TT_EXPR_INT
) {
9212 objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
9215 objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9217 if (endptr
!= t
->token
+ t
->len
) {
9218 /* Conversion failed, so just store it as a string */
9219 Jim_FreeNewObj(interp
, objPtr
);
9225 token
->objPtr
= objPtr
;
9228 /* Everything else is stored a simple string term */
9229 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
9230 if (t
->type
== JIM_TT_CMD
) {
9231 /* Only commands need source info */
9232 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
9240 /* Reduce any remaining subexpr */
9241 while (Jim_StackLen(&stack
)) {
9242 ParseToken
*tt
= Jim_StackPop(&stack
);
9244 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9246 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9249 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9256 ExprTernaryReorderExpression(interp
, expr
);
9260 /* Free the stack used for the compilation. */
9261 Jim_FreeStack(&stack
);
9263 for (i
= 0; i
< expr
->len
; i
++) {
9264 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9268 ExprFreeByteCode(interp
, expr
);
9276 /* This method takes the string representation of an expression
9277 * and generates a program for the Expr's stack-based VM. */
9278 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9281 const char *exprText
;
9282 struct JimParserCtx parser
;
9283 struct ExprByteCode
*expr
;
9284 ParseTokenList tokenlist
;
9286 Jim_Obj
*fileNameObj
;
9289 /* Try to get information about filename / line number */
9290 if (objPtr
->typePtr
== &sourceObjType
) {
9291 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9292 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9295 fileNameObj
= interp
->emptyObj
;
9298 Jim_IncrRefCount(fileNameObj
);
9300 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9302 /* Initially tokenise the expression into tokenlist */
9303 ScriptTokenListInit(&tokenlist
);
9305 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9306 while (!parser
.eof
) {
9307 if (JimParseExpression(&parser
) != JIM_OK
) {
9308 ScriptTokenListFree(&tokenlist
);
9309 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9314 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9318 #ifdef DEBUG_SHOW_EXPR_TOKENS
9321 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9322 for (i
= 0; i
< tokenlist
.count
; i
++) {
9323 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9324 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9329 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9330 ScriptTokenListFree(&tokenlist
);
9331 Jim_DecrRefCount(interp
, fileNameObj
);
9335 /* Now create the expression bytecode from the tokenlist */
9336 expr
= ExprCreateByteCode(interp
, &tokenlist
, objPtr
, fileNameObj
);
9338 /* No longer need the token list */
9339 ScriptTokenListFree(&tokenlist
);
9345 #ifdef DEBUG_SHOW_EXPR
9349 printf("==== Expr ====\n");
9350 for (i
= 0; i
< expr
->len
; i
++) {
9351 ScriptToken
*t
= &expr
->token
[i
];
9353 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9358 /* Check program correctness. */
9359 if (ExprCheckCorrectness(interp
, objPtr
, expr
) != JIM_OK
) {
9360 /* ExprCheckCorrectness set an error in this case */
9361 ExprFreeByteCode(interp
, expr
);
9369 /* Free the old internal rep and set the new one. */
9370 Jim_DecrRefCount(interp
, fileNameObj
);
9371 Jim_FreeIntRep(interp
, objPtr
);
9372 Jim_SetIntRepPtr(objPtr
, expr
);
9373 objPtr
->typePtr
= &exprObjType
;
9377 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9379 if (objPtr
->typePtr
!= &exprObjType
) {
9380 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9384 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9387 #ifdef JIM_OPTIMIZATION
9388 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9390 if (token
->type
== JIM_TT_EXPR_INT
)
9391 return token
->objPtr
;
9392 else if (token
->type
== JIM_TT_VAR
)
9393 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9394 else if (token
->type
== JIM_TT_DICTSUGAR
)
9395 return JimExpandDictSugar(interp
, token
->objPtr
);
9401 /* -----------------------------------------------------------------------------
9402 * Expressions evaluation.
9403 * Jim uses a specialized stack-based virtual machine for expressions,
9404 * that takes advantage of the fact that expr's operators
9405 * can't be redefined.
9407 * Jim_EvalExpression() uses the bytecode compiled by
9408 * SetExprFromAny() method of the "expression" object.
9410 * On success a Tcl Object containing the result of the evaluation
9411 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9413 * On error the function returns a retcode != to JIM_OK and set a suitable
9414 * error on the interp.
9415 * ---------------------------------------------------------------------------*/
9416 #define JIM_EE_STATICSTACK_LEN 10
9418 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9421 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9423 int retcode
= JIM_OK
;
9424 struct JimExprState e
;
9426 expr
= JimGetExpression(interp
, exprObjPtr
);
9428 return JIM_ERR
; /* error in expression. */
9431 #ifdef JIM_OPTIMIZATION
9432 /* Check for one of the following common expressions used by while/for
9437 * $a < CONST, $a < $b
9438 * $a <= CONST, $a <= $b
9439 * $a > CONST, $a > $b
9440 * $a >= CONST, $a >= $b
9441 * $a != CONST, $a != $b
9442 * $a == CONST, $a == $b
9447 /* STEP 1 -- Check if there are the conditions to run the specialized
9448 * version of while */
9450 switch (expr
->len
) {
9452 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9454 Jim_IncrRefCount(objPtr
);
9455 *exprResultPtrPtr
= objPtr
;
9461 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9462 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9464 if (objPtr
&& JimIsWide(objPtr
)) {
9465 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9466 Jim_IncrRefCount(*exprResultPtrPtr
);
9473 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9474 if (objPtr
&& JimIsWide(objPtr
)) {
9475 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9476 if (objPtr2
&& JimIsWide(objPtr2
)) {
9477 jim_wide wideValueA
= JimWideValue(objPtr
);
9478 jim_wide wideValueB
= JimWideValue(objPtr2
);
9480 switch (expr
->token
[2].type
) {
9482 cmpRes
= wideValueA
< wideValueB
;
9484 case JIM_EXPROP_LTE
:
9485 cmpRes
= wideValueA
<= wideValueB
;
9488 cmpRes
= wideValueA
> wideValueB
;
9490 case JIM_EXPROP_GTE
:
9491 cmpRes
= wideValueA
>= wideValueB
;
9493 case JIM_EXPROP_NUMEQ
:
9494 cmpRes
= wideValueA
== wideValueB
;
9496 case JIM_EXPROP_NUMNE
:
9497 cmpRes
= wideValueA
!= wideValueB
;
9502 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9503 Jim_IncrRefCount(*exprResultPtrPtr
);
9513 /* In order to avoid that the internal repr gets freed due to
9514 * shimmering of the exprObjPtr's object, we make the internal rep
9518 /* The stack-based expr VM itself */
9520 /* Stack allocation. Expr programs have the feature that
9521 * a program of length N can't require a stack longer than
9523 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9524 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9526 e
.stack
= staticStack
;
9530 /* Execute every instruction */
9531 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9534 switch (expr
->token
[i
].type
) {
9535 case JIM_TT_EXPR_INT
:
9536 case JIM_TT_EXPR_DOUBLE
:
9537 case JIM_TT_EXPR_BOOLEAN
:
9539 ExprPush(&e
, expr
->token
[i
].objPtr
);
9543 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9545 ExprPush(&e
, objPtr
);
9552 case JIM_TT_DICTSUGAR
:
9553 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9555 ExprPush(&e
, objPtr
);
9563 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9564 if (retcode
== JIM_OK
) {
9565 ExprPush(&e
, objPtr
);
9570 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9571 if (retcode
== JIM_OK
) {
9572 ExprPush(&e
, Jim_GetResult(interp
));
9577 /* Find and execute the operation */
9579 e
.opcode
= expr
->token
[i
].type
;
9581 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9582 /* Skip some opcodes if necessary */
9591 if (retcode
== JIM_OK
) {
9592 *exprResultPtrPtr
= ExprPop(&e
);
9595 for (i
= 0; i
< e
.stacklen
; i
++) {
9596 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9599 if (e
.stack
!= staticStack
) {
9605 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9611 Jim_Obj
*exprResultPtr
;
9613 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9614 if (retcode
!= JIM_OK
)
9617 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9618 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9619 if (Jim_GetBoolean(interp
, exprResultPtr
, &booleanValue
) != JIM_OK
) {
9620 Jim_DecrRefCount(interp
, exprResultPtr
);
9623 Jim_DecrRefCount(interp
, exprResultPtr
);
9624 *boolPtr
= booleanValue
;
9629 Jim_DecrRefCount(interp
, exprResultPtr
);
9630 *boolPtr
= doubleValue
!= 0;
9634 *boolPtr
= wideValue
!= 0;
9636 Jim_DecrRefCount(interp
, exprResultPtr
);
9640 /* -----------------------------------------------------------------------------
9641 * ScanFormat String Object
9642 * ---------------------------------------------------------------------------*/
9644 /* This Jim_Obj will held a parsed representation of a format string passed to
9645 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9646 * to be parsed in its entirely first and then, if correct, can be used for
9647 * scanning. To avoid endless re-parsing, the parsed representation will be
9648 * stored in an internal representation and re-used for performance reason. */
9650 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9651 * scanformat string. This part will later be used to extract information
9652 * out from the string to be parsed by Jim_ScanString */
9654 typedef struct ScanFmtPartDescr
9656 char *arg
; /* Specification of a CHARSET conversion */
9657 char *prefix
; /* Prefix to be scanned literally before conversion */
9658 size_t width
; /* Maximal width of input to be converted */
9659 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9660 char type
; /* Type of conversion (e.g. c, d, f) */
9661 char modifier
; /* Modify type (e.g. l - long, h - short */
9664 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9665 * string parsed and separated in part descriptions. Furthermore it contains
9666 * the original string representation of the scanformat string to allow for
9667 * fast update of the Jim_Obj's string representation part.
9669 * As an add-on the internal object representation adds some scratch pad area
9670 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9671 * memory for purpose of string scanning.
9673 * The error member points to a static allocated string in case of a mal-
9674 * formed scanformat string or it contains '0' (NULL) in case of a valid
9675 * parse representation.
9677 * The whole memory of the internal representation is allocated as a single
9678 * area of memory that will be internally separated. So freeing and duplicating
9679 * of such an object is cheap */
9681 typedef struct ScanFmtStringObj
9683 jim_wide size
; /* Size of internal repr in bytes */
9684 char *stringRep
; /* Original string representation */
9685 size_t count
; /* Number of ScanFmtPartDescr contained */
9686 size_t convCount
; /* Number of conversions that will assign */
9687 size_t maxPos
; /* Max position index if XPG3 is used */
9688 const char *error
; /* Ptr to error text (NULL if no error */
9689 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9690 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9694 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9695 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9696 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9698 static const Jim_ObjType scanFmtStringObjType
= {
9700 FreeScanFmtInternalRep
,
9701 DupScanFmtInternalRep
,
9702 UpdateStringOfScanFmt
,
9706 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9708 JIM_NOTUSED(interp
);
9709 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9710 objPtr
->internalRep
.ptr
= 0;
9713 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9715 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9716 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9718 JIM_NOTUSED(interp
);
9719 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9720 dupPtr
->internalRep
.ptr
= newVec
;
9721 dupPtr
->typePtr
= &scanFmtStringObjType
;
9724 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9726 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9729 /* SetScanFmtFromAny will parse a given string and create the internal
9730 * representation of the format specification. In case of an error
9731 * the error data member of the internal representation will be set
9732 * to an descriptive error text and the function will be left with
9733 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9736 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9738 ScanFmtStringObj
*fmtObj
;
9740 int maxCount
, i
, approxSize
, lastPos
= -1;
9741 const char *fmt
= objPtr
->bytes
;
9742 int maxFmtLen
= objPtr
->length
;
9743 const char *fmtEnd
= fmt
+ maxFmtLen
;
9746 Jim_FreeIntRep(interp
, objPtr
);
9747 /* Count how many conversions could take place maximally */
9748 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9751 /* Calculate an approximation of the memory necessary */
9752 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9753 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9754 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9755 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9756 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9757 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9758 +1; /* safety byte */
9759 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9760 memset(fmtObj
, 0, approxSize
);
9761 fmtObj
->size
= approxSize
;
9763 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9764 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9765 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9766 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9767 objPtr
->internalRep
.ptr
= fmtObj
;
9768 objPtr
->typePtr
= &scanFmtStringObjType
;
9769 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9770 int width
= 0, skip
;
9771 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9774 descr
->width
= 0; /* Assume width unspecified */
9775 /* Overread and store any "literal" prefix */
9776 if (*fmt
!= '%' || fmt
[1] == '%') {
9778 descr
->prefix
= &buffer
[i
];
9779 for (; fmt
< fmtEnd
; ++fmt
) {
9789 /* Skip the conversion introducing '%' sign */
9791 /* End reached due to non-conversion literal only? */
9794 descr
->pos
= 0; /* Assume "natural" positioning */
9796 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9800 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9801 /* Check if next token is a number (could be width or pos */
9802 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9804 /* Was the number a XPG3 position specifier? */
9805 if (descr
->pos
!= -1 && *fmt
== '$') {
9811 /* Look if "natural" postioning and XPG3 one was mixed */
9812 if ((lastPos
== 0 && descr
->pos
> 0)
9813 || (lastPos
> 0 && descr
->pos
== 0)) {
9814 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9817 /* Look if this position was already used */
9818 for (prev
= 0; prev
< curr
; ++prev
) {
9819 if (fmtObj
->descr
[prev
].pos
== -1)
9821 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9823 "variable is assigned by multiple \"%n$\" conversion specifiers";
9827 /* Try to find a width after the XPG3 specifier */
9828 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9829 descr
->width
= width
;
9832 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9833 fmtObj
->maxPos
= descr
->pos
;
9836 /* Number was not a XPG3, so it has to be a width */
9837 descr
->width
= width
;
9840 /* If positioning mode was undetermined yet, fix this */
9842 lastPos
= descr
->pos
;
9843 /* Handle CHARSET conversion type ... */
9845 int swapped
= 1, beg
= i
, end
, j
;
9848 descr
->arg
= &buffer
[i
];
9851 buffer
[i
++] = *fmt
++;
9853 buffer
[i
++] = *fmt
++;
9854 while (*fmt
&& *fmt
!= ']')
9855 buffer
[i
++] = *fmt
++;
9857 fmtObj
->error
= "unmatched [ in format string";
9862 /* In case a range fence was given "backwards", swap it */
9865 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9866 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9867 char tmp
= buffer
[j
- 1];
9869 buffer
[j
- 1] = buffer
[j
+ 1];
9870 buffer
[j
+ 1] = tmp
;
9877 /* Remember any valid modifier if given */
9878 if (strchr("hlL", *fmt
) != 0)
9879 descr
->modifier
= tolower((int)*fmt
++);
9882 if (strchr("efgcsndoxui", *fmt
) == 0) {
9883 fmtObj
->error
= "bad scan conversion character";
9886 else if (*fmt
== 'c' && descr
->width
!= 0) {
9887 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9890 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9891 fmtObj
->error
= "unsigned wide not supported";
9901 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9903 #define FormatGetCnvCount(_fo_) \
9904 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9905 #define FormatGetMaxPos(_fo_) \
9906 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9907 #define FormatGetError(_fo_) \
9908 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9910 /* JimScanAString is used to scan an unspecified string that ends with
9911 * next WS, or a string that is specified via a charset.
9914 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9916 char *buffer
= Jim_StrDup(str
);
9923 if (!sdescr
&& isspace(UCHAR(*str
)))
9924 break; /* EOS via WS if unspecified */
9926 n
= utf8_tounicode(str
, &c
);
9927 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9933 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9936 /* ScanOneEntry will scan one entry out of the string passed as argument.
9937 * It use the sscanf() function for this task. After extracting and
9938 * converting of the value, the count of scanned characters will be
9939 * returned of -1 in case of no conversion tool place and string was
9940 * already scanned thru */
9942 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9943 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9946 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9948 size_t anchor
= pos
;
9950 Jim_Obj
*tmpObj
= NULL
;
9952 /* First pessimistically assume, we will not scan anything :-) */
9954 if (descr
->prefix
) {
9955 /* There was a prefix given before the conversion, skip it and adjust
9956 * the string-to-be-parsed accordingly */
9957 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9958 /* If prefix require, skip WS */
9959 if (isspace(UCHAR(descr
->prefix
[i
])))
9960 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9962 else if (descr
->prefix
[i
] != str
[pos
])
9963 break; /* Prefix do not match here, leave the loop */
9965 ++pos
; /* Prefix matched so far, next round */
9967 if (pos
>= strLen
) {
9968 return -1; /* All of str consumed: EOF condition */
9970 else if (descr
->prefix
[i
] != 0)
9971 return 0; /* Not whole prefix consumed, no conversion possible */
9973 /* For all but following conversion, skip leading WS */
9974 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9975 while (isspace(UCHAR(str
[pos
])))
9977 /* Determine how much skipped/scanned so far */
9978 scanned
= pos
- anchor
;
9980 /* %c is a special, simple case. no width */
9981 if (descr
->type
== 'n') {
9982 /* Return pseudo conversion means: how much scanned so far? */
9983 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9985 else if (pos
>= strLen
) {
9986 /* Cannot scan anything, as str is totally consumed */
9989 else if (descr
->type
== 'c') {
9991 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9992 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9996 /* Processing of conversions follows ... */
9997 if (descr
->width
> 0) {
9998 /* Do not try to scan as fas as possible but only the given width.
9999 * To ensure this, we copy the part that should be scanned. */
10000 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
10001 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
10003 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
10004 tok
= tmpObj
->bytes
;
10007 /* As no width was given, simply refer to the original string */
10010 switch (descr
->type
) {
10016 char *endp
; /* Position where the number finished */
10019 int base
= descr
->type
== 'o' ? 8
10020 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
10022 /* Try to scan a number with the given base */
10024 w
= jim_strtoull(tok
, &endp
);
10027 w
= strtoull(tok
, &endp
, base
);
10031 /* There was some number sucessfully scanned! */
10032 *valObjPtr
= Jim_NewIntObj(interp
, w
);
10034 /* Adjust the number-of-chars scanned so far */
10035 scanned
+= endp
- tok
;
10038 /* Nothing was scanned. We have to determine if this
10039 * happened due to e.g. prefix mismatch or input str
10041 scanned
= *tok
? 0 : -1;
10047 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
10048 scanned
+= Jim_Length(*valObjPtr
);
10055 double value
= strtod(tok
, &endp
);
10058 /* There was some number sucessfully scanned! */
10059 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
10060 /* Adjust the number-of-chars scanned so far */
10061 scanned
+= endp
- tok
;
10064 /* Nothing was scanned. We have to determine if this
10065 * happened due to e.g. prefix mismatch or input str
10067 scanned
= *tok
? 0 : -1;
10072 /* If a substring was allocated (due to pre-defined width) do not
10073 * forget to free it */
10075 Jim_FreeNewObj(interp
, tmpObj
);
10081 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10082 * string and returns all converted (and not ignored) values in a list back
10083 * to the caller. If an error occured, a NULL pointer will be returned */
10085 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
10089 const char *str
= Jim_String(strObjPtr
);
10090 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
10091 Jim_Obj
*resultList
= 0;
10092 Jim_Obj
**resultVec
= 0;
10094 Jim_Obj
*emptyStr
= 0;
10095 ScanFmtStringObj
*fmtObj
;
10097 /* This should never happen. The format object should already be of the correct type */
10098 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
10100 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
10101 /* Check if format specification was valid */
10102 if (fmtObj
->error
!= 0) {
10103 if (flags
& JIM_ERRMSG
)
10104 Jim_SetResultString(interp
, fmtObj
->error
, -1);
10107 /* Allocate a new "shared" empty string for all unassigned conversions */
10108 emptyStr
= Jim_NewEmptyStringObj(interp
);
10109 Jim_IncrRefCount(emptyStr
);
10110 /* Create a list and fill it with empty strings up to max specified XPG3 */
10111 resultList
= Jim_NewListObj(interp
, NULL
, 0);
10112 if (fmtObj
->maxPos
> 0) {
10113 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
10114 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
10115 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
10117 /* Now handle every partial format description */
10118 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
10119 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
10120 Jim_Obj
*value
= 0;
10122 /* Only last type may be "literal" w/o conversion - skip it! */
10123 if (descr
->type
== 0)
10125 /* As long as any conversion could be done, we will proceed */
10127 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
10128 /* In case our first try results in EOF, we will leave */
10129 if (scanned
== -1 && i
== 0)
10131 /* Advance next pos-to-be-scanned for the amount scanned already */
10134 /* value == 0 means no conversion took place so take empty string */
10136 value
= Jim_NewEmptyStringObj(interp
);
10137 /* If value is a non-assignable one, skip it */
10138 if (descr
->pos
== -1) {
10139 Jim_FreeNewObj(interp
, value
);
10141 else if (descr
->pos
== 0)
10142 /* Otherwise append it to the result list if no XPG3 was given */
10143 Jim_ListAppendElement(interp
, resultList
, value
);
10144 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
10145 /* But due to given XPG3, put the value into the corr. slot */
10146 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
10147 Jim_IncrRefCount(value
);
10148 resultVec
[descr
->pos
- 1] = value
;
10151 /* Otherwise, the slot was already used - free obj and ERROR */
10152 Jim_FreeNewObj(interp
, value
);
10156 Jim_DecrRefCount(interp
, emptyStr
);
10159 Jim_DecrRefCount(interp
, emptyStr
);
10160 Jim_FreeNewObj(interp
, resultList
);
10161 return (Jim_Obj
*)EOF
;
10163 Jim_DecrRefCount(interp
, emptyStr
);
10164 Jim_FreeNewObj(interp
, resultList
);
10168 /* -----------------------------------------------------------------------------
10169 * Pseudo Random Number Generation
10170 * ---------------------------------------------------------------------------*/
10171 /* Initialize the sbox with the numbers from 0 to 255 */
10172 static void JimPrngInit(Jim_Interp
*interp
)
10174 #define PRNG_SEED_SIZE 256
10176 unsigned int *seed
;
10177 time_t t
= time(NULL
);
10179 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10181 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10182 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10183 seed
[i
] = (rand() ^ t
^ clock());
10185 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10189 /* Generates N bytes of random data */
10190 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10192 Jim_PrngState
*prng
;
10193 unsigned char *destByte
= (unsigned char *)dest
;
10194 unsigned int si
, sj
, x
;
10196 /* initialization, only needed the first time */
10197 if (interp
->prngState
== NULL
)
10198 JimPrngInit(interp
);
10199 prng
= interp
->prngState
;
10200 /* generates 'len' bytes of pseudo-random numbers */
10201 for (x
= 0; x
< len
; x
++) {
10202 prng
->i
= (prng
->i
+ 1) & 0xff;
10203 si
= prng
->sbox
[prng
->i
];
10204 prng
->j
= (prng
->j
+ si
) & 0xff;
10205 sj
= prng
->sbox
[prng
->j
];
10206 prng
->sbox
[prng
->i
] = sj
;
10207 prng
->sbox
[prng
->j
] = si
;
10208 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10212 /* Re-seed the generator with user-provided bytes */
10213 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10216 Jim_PrngState
*prng
;
10218 /* initialization, only needed the first time */
10219 if (interp
->prngState
== NULL
)
10220 JimPrngInit(interp
);
10221 prng
= interp
->prngState
;
10223 /* Set the sbox[i] with i */
10224 for (i
= 0; i
< 256; i
++)
10226 /* Now use the seed to perform a random permutation of the sbox */
10227 for (i
= 0; i
< seedLen
; i
++) {
10230 t
= prng
->sbox
[i
& 0xFF];
10231 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10232 prng
->sbox
[seed
[i
]] = t
;
10234 prng
->i
= prng
->j
= 0;
10236 /* discard at least the first 256 bytes of stream.
10237 * borrow the seed buffer for this
10239 for (i
= 0; i
< 256; i
+= seedLen
) {
10240 JimRandomBytes(interp
, seed
, seedLen
);
10245 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10247 jim_wide wideValue
, increment
= 1;
10248 Jim_Obj
*intObjPtr
;
10250 if (argc
!= 2 && argc
!= 3) {
10251 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10255 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10258 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10260 /* Set missing variable to 0 */
10263 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10266 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10267 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10268 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10269 Jim_FreeNewObj(interp
, intObjPtr
);
10274 /* Can do it the quick way */
10275 Jim_InvalidateStringRep(intObjPtr
);
10276 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10278 /* The following step is required in order to invalidate the
10279 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10280 if (argv
[1]->typePtr
!= &variableObjType
) {
10281 /* Note that this can't fail since GetVariable already succeeded */
10282 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10285 Jim_SetResult(interp
, intObjPtr
);
10290 /* -----------------------------------------------------------------------------
10292 * ---------------------------------------------------------------------------*/
10293 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10294 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10296 /* Handle calls to the [unknown] command */
10297 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10301 /* If JimUnknown() is recursively called too many times...
10304 if (interp
->unknown_called
> 50) {
10308 /* The object interp->unknown just contains
10309 * the "unknown" string, it is used in order to
10310 * avoid to lookup the unknown command every time
10311 * but instead to cache the result. */
10313 /* If the [unknown] command does not exist ... */
10314 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10317 interp
->unknown_called
++;
10318 /* XXX: Are we losing fileNameObj and linenr? */
10319 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10320 interp
->unknown_called
--;
10325 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10333 for (j
= 0; j
< objc
; j
++) {
10334 printf(" '%s'", Jim_String(objv
[j
]));
10339 if (interp
->framePtr
->tailcallCmd
) {
10340 /* Special tailcall command was pre-resolved */
10341 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10342 interp
->framePtr
->tailcallCmd
= NULL
;
10345 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10346 if (cmdPtr
== NULL
) {
10347 return JimUnknown(interp
, objc
, objv
);
10349 JimIncrCmdRefCount(cmdPtr
);
10352 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10353 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10357 interp
->evalDepth
++;
10359 /* Call it -- Make sure result is an empty object. */
10360 Jim_SetEmptyResult(interp
);
10361 if (cmdPtr
->isproc
) {
10362 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10365 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10366 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10368 interp
->evalDepth
--;
10371 JimDecrCmdRefCount(interp
, cmdPtr
);
10376 /* Eval the object vector 'objv' composed of 'objc' elements.
10377 * Every element is used as single argument.
10378 * Jim_EvalObj() will call this function every time its object
10379 * argument is of "list" type, with no string representation.
10381 * This is possible because the string representation of a
10382 * list object generated by the UpdateStringOfList is made
10383 * in a way that ensures that every list element is a different
10384 * command argument. */
10385 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10389 /* Incr refcount of arguments. */
10390 for (i
= 0; i
< objc
; i
++)
10391 Jim_IncrRefCount(objv
[i
]);
10393 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10395 /* Decr refcount of arguments and return the retcode */
10396 for (i
= 0; i
< objc
; i
++)
10397 Jim_DecrRefCount(interp
, objv
[i
]);
10403 * Invokes 'prefix' as a command with the objv array as arguments.
10405 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10408 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10411 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10412 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10417 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10419 if (!interp
->errorFlag
) {
10420 /* This is the first error, so save the file/line information and reset the stack */
10421 interp
->errorFlag
= 1;
10422 Jim_IncrRefCount(script
->fileNameObj
);
10423 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10424 interp
->errorFileNameObj
= script
->fileNameObj
;
10425 interp
->errorLine
= script
->linenr
;
10427 JimResetStackTrace(interp
);
10428 /* Always add a level where the error first occurs */
10429 interp
->addStackTrace
++;
10432 /* Now if this is an "interesting" level, add it to the stack trace */
10433 if (interp
->addStackTrace
> 0) {
10434 /* Add the stack info for the current level */
10436 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10438 /* Note: if we didn't have a filename for this level,
10439 * don't clear the addStackTrace flag
10440 * so we can pick it up at the next level
10442 if (Jim_Length(script
->fileNameObj
)) {
10443 interp
->addStackTrace
= 0;
10446 Jim_DecrRefCount(interp
, interp
->errorProc
);
10447 interp
->errorProc
= interp
->emptyObj
;
10448 Jim_IncrRefCount(interp
->errorProc
);
10452 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10456 switch (token
->type
) {
10459 objPtr
= token
->objPtr
;
10462 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10464 case JIM_TT_DICTSUGAR
:
10465 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10467 case JIM_TT_EXPRSUGAR
:
10468 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10471 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10474 objPtr
= interp
->result
;
10477 /* Stop substituting */
10480 /* just skip this one */
10481 return JIM_CONTINUE
;
10488 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10493 *objPtrPtr
= objPtr
;
10499 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10500 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10501 * The returned object has refcount = 0.
10503 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10507 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10511 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10514 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10516 /* Compute every token forming the argument
10517 * in the intv objects vector. */
10518 for (i
= 0; i
< tokens
; i
++) {
10519 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10524 if (flags
& JIM_SUBST_FLAG
) {
10529 /* XXX: Should probably set an error about break outside loop */
10530 /* fall through to error */
10532 if (flags
& JIM_SUBST_FLAG
) {
10536 /* XXX: Ditto continue outside loop */
10537 /* fall through to error */
10540 Jim_DecrRefCount(interp
, intv
[i
]);
10542 if (intv
!= sintv
) {
10547 Jim_IncrRefCount(intv
[i
]);
10548 Jim_String(intv
[i
]);
10549 totlen
+= intv
[i
]->length
;
10552 /* Fast path return for a single token */
10553 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10554 Jim_DecrRefCount(interp
, intv
[0]);
10558 /* Concatenate every token in an unique
10560 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10562 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10563 && token
[2].type
== JIM_TT_VAR
) {
10564 /* May be able to do fast interpolated object -> dictSubst */
10565 objPtr
->typePtr
= &interpolatedObjType
;
10566 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10567 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10568 Jim_IncrRefCount(intv
[2]);
10570 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10571 /* The first interpolated token is source, so preserve the source info */
10572 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10576 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10577 objPtr
->length
= totlen
;
10578 for (i
= 0; i
< tokens
; i
++) {
10580 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10581 s
+= intv
[i
]->length
;
10582 Jim_DecrRefCount(interp
, intv
[i
]);
10585 objPtr
->bytes
[totlen
] = '\0';
10586 /* Free the intv vector if not static. */
10587 if (intv
!= sintv
) {
10595 /* listPtr *must* be a list.
10596 * The contents of the list is evaluated with the first element as the command and
10597 * the remaining elements as the arguments.
10599 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10601 int retcode
= JIM_OK
;
10603 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10605 if (listPtr
->internalRep
.listValue
.len
) {
10606 Jim_IncrRefCount(listPtr
);
10607 retcode
= JimInvokeCommand(interp
,
10608 listPtr
->internalRep
.listValue
.len
,
10609 listPtr
->internalRep
.listValue
.ele
);
10610 Jim_DecrRefCount(interp
, listPtr
);
10615 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10617 SetListFromAny(interp
, listPtr
);
10618 return JimEvalObjList(interp
, listPtr
);
10621 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10625 ScriptToken
*token
;
10626 int retcode
= JIM_OK
;
10627 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10628 Jim_Obj
*prevScriptObj
;
10630 /* If the object is of type "list", with no string rep we can call
10631 * a specialized version of Jim_EvalObj() */
10632 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10633 return JimEvalObjList(interp
, scriptObjPtr
);
10636 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10637 script
= JimGetScript(interp
, scriptObjPtr
);
10638 if (!JimScriptValid(interp
, script
)) {
10639 Jim_DecrRefCount(interp
, scriptObjPtr
);
10643 /* Reset the interpreter result. This is useful to
10644 * return the empty result in the case of empty program. */
10645 Jim_SetEmptyResult(interp
);
10647 token
= script
->token
;
10649 #ifdef JIM_OPTIMIZATION
10650 /* Check for one of the following common scripts used by for, while
10655 if (script
->len
== 0) {
10656 Jim_DecrRefCount(interp
, scriptObjPtr
);
10659 if (script
->len
== 3
10660 && token
[1].objPtr
->typePtr
== &commandObjType
10661 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10662 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10663 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10665 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10667 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10668 JimWideValue(objPtr
)++;
10669 Jim_InvalidateStringRep(objPtr
);
10670 Jim_DecrRefCount(interp
, scriptObjPtr
);
10671 Jim_SetResult(interp
, objPtr
);
10677 /* Now we have to make sure the internal repr will not be
10678 * freed on shimmering.
10680 * Think for example to this:
10682 * set x {llength $x; ... some more code ...}; eval $x
10684 * In order to preserve the internal rep, we increment the
10685 * inUse field of the script internal rep structure. */
10688 /* Stash the current script */
10689 prevScriptObj
= interp
->currentScriptObj
;
10690 interp
->currentScriptObj
= scriptObjPtr
;
10692 interp
->errorFlag
= 0;
10695 /* Execute every command sequentially until the end of the script
10696 * or an error occurs.
10698 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10702 /* First token of the line is always JIM_TT_LINE */
10703 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10704 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10706 /* Allocate the arguments vector if required */
10707 if (argc
> JIM_EVAL_SARGV_LEN
)
10708 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10710 /* Skip the JIM_TT_LINE token */
10713 /* Populate the arguments objects.
10714 * If an error occurs, retcode will be set and
10715 * 'j' will be set to the number of args expanded
10717 for (j
= 0; j
< argc
; j
++) {
10718 long wordtokens
= 1;
10720 Jim_Obj
*wordObjPtr
= NULL
;
10722 if (token
[i
].type
== JIM_TT_WORD
) {
10723 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10724 if (wordtokens
< 0) {
10726 wordtokens
= -wordtokens
;
10730 if (wordtokens
== 1) {
10731 /* Fast path if the token does not
10732 * need interpolation */
10734 switch (token
[i
].type
) {
10737 wordObjPtr
= token
[i
].objPtr
;
10740 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10742 case JIM_TT_EXPRSUGAR
:
10743 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10745 case JIM_TT_DICTSUGAR
:
10746 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10749 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10750 if (retcode
== JIM_OK
) {
10751 wordObjPtr
= Jim_GetResult(interp
);
10755 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10759 /* For interpolation we call a helper
10760 * function to do the work for us. */
10761 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10765 if (retcode
== JIM_OK
) {
10771 Jim_IncrRefCount(wordObjPtr
);
10775 argv
[j
] = wordObjPtr
;
10778 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10779 int len
= Jim_ListLength(interp
, wordObjPtr
);
10780 int newargc
= argc
+ len
- 1;
10784 if (argv
== sargv
) {
10785 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10786 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10787 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10791 /* Need to realloc to make room for (len - 1) more entries */
10792 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10796 /* Now copy in the expanded version */
10797 for (k
= 0; k
< len
; k
++) {
10798 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10799 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10802 /* The original object reference is no longer needed,
10803 * after the expansion it is no longer present on
10804 * the argument vector, but the single elements are
10806 Jim_DecrRefCount(interp
, wordObjPtr
);
10808 /* And update the indexes */
10814 if (retcode
== JIM_OK
&& argc
) {
10815 /* Invoke the command */
10816 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10817 /* Check for a signal after each command */
10818 if (Jim_CheckSignal(interp
)) {
10819 retcode
= JIM_SIGNAL
;
10823 /* Finished with the command, so decrement ref counts of each argument */
10825 Jim_DecrRefCount(interp
, argv
[j
]);
10828 if (argv
!= sargv
) {
10834 /* Possibly add to the error stack trace */
10835 if (retcode
== JIM_ERR
) {
10836 JimAddErrorToStack(interp
, script
);
10838 /* Propagate the addStackTrace value through 'return -code error' */
10839 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10840 /* No need to add stack trace */
10841 interp
->addStackTrace
= 0;
10844 /* Restore the current script */
10845 interp
->currentScriptObj
= prevScriptObj
;
10847 /* Note that we don't have to decrement inUse, because the
10848 * following code transfers our use of the reference again to
10849 * the script object. */
10850 Jim_FreeIntRep(interp
, scriptObjPtr
);
10851 scriptObjPtr
->typePtr
= &scriptObjType
;
10852 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10853 Jim_DecrRefCount(interp
, scriptObjPtr
);
10858 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10861 /* If argObjPtr begins with '&', do an automatic upvar */
10862 const char *varname
= Jim_String(argNameObj
);
10863 if (*varname
== '&') {
10864 /* First check that the target variable exists */
10866 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10868 interp
->framePtr
= interp
->framePtr
->parent
;
10869 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10870 interp
->framePtr
= savedCallFrame
;
10875 /* It exists, so perform the binding. */
10876 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10877 Jim_IncrRefCount(objPtr
);
10878 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10879 Jim_DecrRefCount(interp
, objPtr
);
10882 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10888 * Sets the interp result to be an error message indicating the required proc args.
10890 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10892 /* Create a nice error message, consistent with Tcl 8.5 */
10893 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10896 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10897 Jim_AppendString(interp
, argmsg
, " ", 1);
10899 if (i
== cmd
->u
.proc
.argsPos
) {
10900 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10902 Jim_AppendString(interp
, argmsg
, "?", 1);
10903 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10904 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10907 /* We have plain args */
10908 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10912 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10913 Jim_AppendString(interp
, argmsg
, "?", 1);
10914 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10915 Jim_AppendString(interp
, argmsg
, "?", 1);
10918 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10922 Jim_AppendString(interp
, argmsg
, arg
, -1);
10926 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10927 Jim_FreeNewObj(interp
, argmsg
);
10930 #ifdef jim_ext_namespace
10934 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10936 Jim_CallFrame
*callFramePtr
;
10939 /* Create a new callframe */
10940 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10941 callFramePtr
->argv
= &interp
->emptyObj
;
10942 callFramePtr
->argc
= 0;
10943 callFramePtr
->procArgsObjPtr
= NULL
;
10944 callFramePtr
->procBodyObjPtr
= scriptObj
;
10945 callFramePtr
->staticVars
= NULL
;
10946 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10947 callFramePtr
->line
= 0;
10948 Jim_IncrRefCount(scriptObj
);
10949 interp
->framePtr
= callFramePtr
;
10951 /* Check if there are too nested calls */
10952 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10953 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10957 /* Eval the body */
10958 retcode
= Jim_EvalObj(interp
, scriptObj
);
10961 /* Destroy the callframe */
10962 interp
->framePtr
= interp
->framePtr
->parent
;
10963 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10969 /* Call a procedure implemented in Tcl.
10970 * It's possible to speed-up a lot this function, currently
10971 * the callframes are not cached, but allocated and
10972 * destroied every time. What is expecially costly is
10973 * to create/destroy the local vars hash table every time.
10975 * This can be fixed just implementing callframes caching
10976 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10977 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10979 Jim_CallFrame
*callFramePtr
;
10980 int i
, d
, retcode
, optargs
;
10984 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10985 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10986 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10990 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10991 /* Optimise for procedure with no body - useful for optional debugging */
10995 /* Check if there are too nested calls */
10996 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10997 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
11001 /* Create a new callframe */
11002 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
11003 callFramePtr
->argv
= argv
;
11004 callFramePtr
->argc
= argc
;
11005 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
11006 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
11007 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
11009 /* Remember where we were called from. */
11010 script
= JimGetScript(interp
, interp
->currentScriptObj
);
11011 callFramePtr
->fileNameObj
= script
->fileNameObj
;
11012 callFramePtr
->line
= script
->linenr
;
11014 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
11015 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
11016 interp
->framePtr
= callFramePtr
;
11018 /* How many optional args are available */
11019 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
11021 /* Step 'i' along the actual args, and step 'd' along the formal args */
11023 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
11024 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
11025 if (d
== cmd
->u
.proc
.argsPos
) {
11027 Jim_Obj
*listObjPtr
;
11029 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
11030 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
11032 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
11034 /* It is possible to rename args. */
11035 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
11036 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
11038 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
11039 if (retcode
!= JIM_OK
) {
11047 /* Optional or required? */
11048 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
11049 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
11052 /* Ran out, so use the default */
11053 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
11055 if (retcode
!= JIM_OK
) {
11060 /* Eval the body */
11061 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
11065 /* Free the callframe */
11066 interp
->framePtr
= interp
->framePtr
->parent
;
11067 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
11069 /* Now chain any tailcalls in the parent frame */
11070 if (interp
->framePtr
->tailcallObj
) {
11072 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
11074 interp
->framePtr
->tailcallObj
= NULL
;
11076 if (retcode
== JIM_EVAL
) {
11077 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
11078 if (retcode
== JIM_RETURN
) {
11079 /* If the result of the tailcall is 'return', push
11080 * it up to the caller
11082 interp
->returnLevel
++;
11085 Jim_DecrRefCount(interp
, tailcallObj
);
11086 } while (interp
->framePtr
->tailcallObj
);
11088 /* If the tailcall chain finished early, may need to manually discard the command */
11089 if (interp
->framePtr
->tailcallCmd
) {
11090 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
11091 interp
->framePtr
->tailcallCmd
= NULL
;
11095 /* Handle the JIM_RETURN return code */
11096 if (retcode
== JIM_RETURN
) {
11097 if (--interp
->returnLevel
<= 0) {
11098 retcode
= interp
->returnCode
;
11099 interp
->returnCode
= JIM_OK
;
11100 interp
->returnLevel
= 0;
11103 else if (retcode
== JIM_ERR
) {
11104 interp
->addStackTrace
++;
11105 Jim_DecrRefCount(interp
, interp
->errorProc
);
11106 interp
->errorProc
= argv
[0];
11107 Jim_IncrRefCount(interp
->errorProc
);
11113 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
11116 Jim_Obj
*scriptObjPtr
;
11118 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
11119 Jim_IncrRefCount(scriptObjPtr
);
11122 Jim_Obj
*prevScriptObj
;
11124 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
11126 prevScriptObj
= interp
->currentScriptObj
;
11127 interp
->currentScriptObj
= scriptObjPtr
;
11129 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11131 interp
->currentScriptObj
= prevScriptObj
;
11134 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11136 Jim_DecrRefCount(interp
, scriptObjPtr
);
11140 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
11142 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
11145 /* Execute script in the scope of the global level */
11146 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
11149 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11151 interp
->framePtr
= interp
->topFramePtr
;
11152 retval
= Jim_Eval(interp
, script
);
11153 interp
->framePtr
= savedFramePtr
;
11158 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
11161 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11163 interp
->framePtr
= interp
->topFramePtr
;
11164 retval
= Jim_EvalFile(interp
, filename
);
11165 interp
->framePtr
= savedFramePtr
;
11170 #include <sys/stat.h>
11172 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11176 Jim_Obj
*scriptObjPtr
;
11177 Jim_Obj
*prevScriptObj
;
11182 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11183 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11186 if (sb
.st_size
== 0) {
11191 buf
= Jim_Alloc(sb
.st_size
+ 1);
11192 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11196 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11202 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11203 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11204 Jim_IncrRefCount(scriptObjPtr
);
11206 prevScriptObj
= interp
->currentScriptObj
;
11207 interp
->currentScriptObj
= scriptObjPtr
;
11209 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11211 /* Handle the JIM_RETURN return code */
11212 if (retcode
== JIM_RETURN
) {
11213 if (--interp
->returnLevel
<= 0) {
11214 retcode
= interp
->returnCode
;
11215 interp
->returnCode
= JIM_OK
;
11216 interp
->returnLevel
= 0;
11219 if (retcode
== JIM_ERR
) {
11220 /* EvalFile changes context, so add a stack frame here */
11221 interp
->addStackTrace
++;
11224 interp
->currentScriptObj
= prevScriptObj
;
11226 Jim_DecrRefCount(interp
, scriptObjPtr
);
11231 /* -----------------------------------------------------------------------------
11233 * ---------------------------------------------------------------------------*/
11234 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11236 pc
->tstart
= pc
->p
;
11237 pc
->tline
= pc
->linenr
;
11239 if (pc
->len
== 0) {
11241 pc
->tt
= JIM_TT_EOL
;
11245 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11249 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11250 if (JimParseVar(pc
) == JIM_OK
) {
11253 /* Not a var, so treat as a string */
11254 pc
->tstart
= pc
->p
;
11255 flags
|= JIM_SUBST_NOVAR
;
11258 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11261 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11264 if (*pc
->p
== '\\' && pc
->len
> 1) {
11271 pc
->tend
= pc
->p
- 1;
11272 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11275 /* The subst object type reuses most of the data structures and functions
11276 * of the script object. Script's data structures are a bit more complex
11277 * for what is needed for [subst]itution tasks, but the reuse helps to
11278 * deal with a single data structure at the cost of some more memory
11279 * usage for substitutions. */
11281 /* This method takes the string representation of an object
11282 * as a Tcl string where to perform [subst]itution, and generates
11283 * the pre-parsed internal representation. */
11284 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11287 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11288 struct JimParserCtx parser
;
11289 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11290 ParseTokenList tokenlist
;
11292 /* Initially parse the subst into tokens (in tokenlist) */
11293 ScriptTokenListInit(&tokenlist
);
11295 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11297 JimParseSubst(&parser
, flags
);
11299 /* Note that subst doesn't need the EOL token */
11302 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11306 /* Create the "real" subst/script tokens from the initial token list */
11308 script
->substFlags
= flags
;
11309 script
->fileNameObj
= interp
->emptyObj
;
11310 Jim_IncrRefCount(script
->fileNameObj
);
11311 SubstObjAddTokens(interp
, script
, &tokenlist
);
11313 /* No longer need the token list */
11314 ScriptTokenListFree(&tokenlist
);
11316 #ifdef DEBUG_SHOW_SUBST
11320 printf("==== Subst ====\n");
11321 for (i
= 0; i
< script
->len
; i
++) {
11322 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11323 Jim_String(script
->token
[i
].objPtr
));
11328 /* Free the old internal rep and set the new one. */
11329 Jim_FreeIntRep(interp
, objPtr
);
11330 Jim_SetIntRepPtr(objPtr
, script
);
11331 objPtr
->typePtr
= &scriptObjType
;
11335 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11337 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11338 SetSubstFromAny(interp
, objPtr
, flags
);
11339 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11342 /* Performs commands,variables,blackslashes substitution,
11343 * storing the result object (with refcount 0) into
11345 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11347 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11349 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11350 /* In order to preserve the internal rep, we increment the
11351 * inUse field of the script internal rep structure. */
11354 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11357 Jim_DecrRefCount(interp
, substObjPtr
);
11358 if (*resObjPtrPtr
== NULL
) {
11364 /* -----------------------------------------------------------------------------
11365 * Core commands utility functions
11366 * ---------------------------------------------------------------------------*/
11367 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11370 Jim_Obj
*listObjPtr
;
11372 JimPanic((argc
== 0, "Jim_WrongNumArgs() called with argc=0"));
11374 listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11377 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11379 Jim_IncrRefCount(listObjPtr
);
11380 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11381 Jim_DecrRefCount(interp
, listObjPtr
);
11383 Jim_IncrRefCount(objPtr
);
11384 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11385 Jim_DecrRefCount(interp
, objPtr
);
11389 * May add the key and/or value to the list.
11391 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11392 Jim_HashEntry
*he
, int type
);
11394 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11397 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11398 * invoke the callback to add entries to a list.
11399 * Returns the list.
11401 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11402 JimHashtableIteratorCallbackType
*callback
, int type
)
11405 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11407 /* Check for the non-pattern case. We can do this much more efficiently. */
11408 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11409 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11411 callback(interp
, listObjPtr
, he
, type
);
11415 Jim_HashTableIterator htiter
;
11416 JimInitHashTableIterator(ht
, &htiter
);
11417 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11418 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11419 callback(interp
, listObjPtr
, he
, type
);
11426 /* Keep these in order */
11427 #define JIM_CMDLIST_COMMANDS 0
11428 #define JIM_CMDLIST_PROCS 1
11429 #define JIM_CMDLIST_CHANNELS 2
11432 * Adds matching command names (procs, channels) to the list.
11434 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11435 Jim_HashEntry
*he
, int type
)
11437 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11440 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11445 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11446 Jim_IncrRefCount(objPtr
);
11448 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11449 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11451 Jim_DecrRefCount(interp
, objPtr
);
11454 /* type is JIM_CMDLIST_xxx */
11455 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11457 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11460 /* Keep these in order */
11461 #define JIM_VARLIST_GLOBALS 0
11462 #define JIM_VARLIST_LOCALS 1
11463 #define JIM_VARLIST_VARS 2
11465 #define JIM_VARLIST_VALUES 0x1000
11468 * Adds matching variable names to the list.
11470 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11471 Jim_HashEntry
*he
, int type
)
11473 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11475 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11476 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11477 if (type
& JIM_VARLIST_VALUES
) {
11478 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11483 /* mode is JIM_VARLIST_xxx */
11484 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11486 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11487 /* For [info locals], if we are at top level an emtpy list
11488 * is returned. I don't agree, but we aim at compatibility (SS) */
11489 return interp
->emptyObj
;
11492 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11493 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11497 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11498 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11500 Jim_CallFrame
*targetCallFrame
;
11502 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11503 if (targetCallFrame
== NULL
) {
11506 /* No proc call at toplevel callframe */
11507 if (targetCallFrame
== interp
->topFramePtr
) {
11508 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11511 if (info_level_cmd
) {
11512 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11515 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11517 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11518 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11519 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11520 *objPtrPtr
= listObj
;
11525 /* -----------------------------------------------------------------------------
11527 * ---------------------------------------------------------------------------*/
11529 /* fake [puts] -- not the real puts, just for debugging. */
11530 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11532 if (argc
!= 2 && argc
!= 3) {
11533 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11537 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11538 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11542 fputs(Jim_String(argv
[2]), stdout
);
11546 puts(Jim_String(argv
[1]));
11551 /* Helper for [+] and [*] */
11552 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11554 jim_wide wideValue
, res
;
11555 double doubleValue
, doubleRes
;
11558 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11560 for (i
= 1; i
< argc
; i
++) {
11561 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11563 if (op
== JIM_EXPROP_ADD
)
11568 Jim_SetResultInt(interp
, res
);
11571 doubleRes
= (double)res
;
11572 for (; i
< argc
; i
++) {
11573 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11575 if (op
== JIM_EXPROP_ADD
)
11576 doubleRes
+= doubleValue
;
11578 doubleRes
*= doubleValue
;
11580 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11584 /* Helper for [-] and [/] */
11585 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11587 jim_wide wideValue
, res
= 0;
11588 double doubleValue
, doubleRes
= 0;
11592 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11595 else if (argc
== 2) {
11596 /* The arity = 2 case is different. For [- x] returns -x,
11597 * while [/ x] returns 1/x. */
11598 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11599 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11603 if (op
== JIM_EXPROP_SUB
)
11604 doubleRes
= -doubleValue
;
11606 doubleRes
= 1.0 / doubleValue
;
11607 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11611 if (op
== JIM_EXPROP_SUB
) {
11613 Jim_SetResultInt(interp
, res
);
11616 doubleRes
= 1.0 / wideValue
;
11617 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11622 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11623 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11632 for (i
= 2; i
< argc
; i
++) {
11633 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11634 doubleRes
= (double)res
;
11637 if (op
== JIM_EXPROP_SUB
)
11642 Jim_SetResultInt(interp
, res
);
11645 for (; i
< argc
; i
++) {
11646 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11648 if (op
== JIM_EXPROP_SUB
)
11649 doubleRes
-= doubleValue
;
11651 doubleRes
/= doubleValue
;
11653 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11659 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11661 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11665 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11667 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11671 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11673 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11677 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11679 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11683 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11685 if (argc
!= 2 && argc
!= 3) {
11686 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11692 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11695 Jim_SetResult(interp
, objPtr
);
11698 /* argc == 3 case. */
11699 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11701 Jim_SetResult(interp
, argv
[2]);
11707 * unset ?-nocomplain? ?--? ?varName ...?
11709 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11715 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11719 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11728 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11738 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11741 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11745 /* The general purpose implementation of while starts here */
11747 int boolean
, retval
;
11749 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11754 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11768 Jim_SetEmptyResult(interp
);
11773 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11777 Jim_Obj
*varNamePtr
= NULL
;
11778 Jim_Obj
*stopVarNamePtr
= NULL
;
11781 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11785 /* Do the initialisation */
11786 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11790 /* And do the first test now. Better for optimisation
11791 * if we can do next/test at the bottom of the loop
11793 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11795 /* Ready to do the body as follows:
11797 * body // check retcode
11798 * next // check retcode
11799 * test // check retcode/test bool
11803 #ifdef JIM_OPTIMIZATION
11804 /* Check if the for is on the form:
11805 * for ... {$i < CONST} {incr i}
11806 * for ... {$i < $j} {incr i}
11808 if (retval
== JIM_OK
&& boolean
) {
11809 ScriptObj
*incrScript
;
11810 ExprByteCode
*expr
;
11811 jim_wide stop
, currentVal
;
11815 /* Do it only if there aren't shared arguments */
11816 expr
= JimGetExpression(interp
, argv
[2]);
11817 incrScript
= JimGetScript(interp
, argv
[3]);
11819 /* Ensure proper lengths to start */
11820 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11823 /* Ensure proper token types. */
11824 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11825 expr
->token
[0].type
!= JIM_TT_VAR
||
11826 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11830 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11833 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11840 /* Update command must be incr */
11841 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11845 /* incr, expression must be about the same variable */
11846 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11850 /* Get the stop condition (must be a variable or integer) */
11851 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11852 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11857 stopVarNamePtr
= expr
->token
[1].objPtr
;
11858 Jim_IncrRefCount(stopVarNamePtr
);
11859 /* Keep the compiler happy */
11863 /* Initialization */
11864 varNamePtr
= expr
->token
[0].objPtr
;
11865 Jim_IncrRefCount(varNamePtr
);
11867 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11868 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11872 /* --- OPTIMIZED FOR --- */
11873 while (retval
== JIM_OK
) {
11874 /* === Check condition === */
11875 /* Note that currentVal is already set here */
11877 /* Immediate or Variable? get the 'stop' value if the latter. */
11878 if (stopVarNamePtr
) {
11879 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11880 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11885 if (currentVal
>= stop
+ cmpOffset
) {
11890 retval
= Jim_EvalObj(interp
, argv
[4]);
11891 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11894 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11897 if (objPtr
== NULL
) {
11901 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11902 currentVal
= ++JimWideValue(objPtr
);
11903 Jim_InvalidateStringRep(objPtr
);
11906 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11907 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11908 ++currentVal
)) != JIM_OK
) {
11919 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11921 retval
= Jim_EvalObj(interp
, argv
[4]);
11923 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11925 JIM_IF_OPTIM(evalnext
:)
11926 retval
= Jim_EvalObj(interp
, argv
[3]);
11927 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11929 JIM_IF_OPTIM(testcond
:)
11930 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11935 if (stopVarNamePtr
) {
11936 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11939 Jim_DecrRefCount(interp
, varNamePtr
);
11942 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11943 Jim_SetEmptyResult(interp
);
11951 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11957 Jim_Obj
*bodyObjPtr
;
11959 if (argc
!= 5 && argc
!= 6) {
11960 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11964 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11965 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11966 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11969 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11971 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11973 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11974 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11975 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11976 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11983 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11984 if (argv
[1]->typePtr
!= &variableObjType
) {
11985 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11989 JimWideValue(objPtr
) = i
;
11990 Jim_InvalidateStringRep(objPtr
);
11992 /* The following step is required in order to invalidate the
11993 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11994 if (argv
[1]->typePtr
!= &variableObjType
) {
11995 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
12002 objPtr
= Jim_NewIntObj(interp
, i
);
12003 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
12004 if (retval
!= JIM_OK
) {
12005 Jim_FreeNewObj(interp
, objPtr
);
12011 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
12012 Jim_SetEmptyResult(interp
);
12018 /* List iterators make it easy to iterate over a list.
12019 * At some point iterators will be expanded to support generators.
12027 * Initialise the iterator at the start of the list.
12029 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
12031 iter
->objPtr
= objPtr
;
12036 * Returns the next object from the list, or NULL on end-of-list.
12038 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
12040 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
12043 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
12047 * Returns 1 if end-of-list has been reached.
12049 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
12051 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
12054 /* foreach + lmap implementation. */
12055 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
12057 int result
= JIM_OK
;
12059 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
12060 Jim_ListIter
*iters
;
12062 Jim_Obj
*resultObj
;
12064 if (argc
< 4 || argc
% 2 != 0) {
12065 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
12068 script
= argv
[argc
- 1]; /* Last argument is a script */
12069 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
12071 if (numargs
== 2) {
12075 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
12077 for (i
= 0; i
< numargs
; i
++) {
12078 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12079 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
12083 if (result
!= JIM_OK
) {
12084 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
12089 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12092 resultObj
= interp
->emptyObj
;
12094 Jim_IncrRefCount(resultObj
);
12097 /* Have we expired all lists? */
12098 for (i
= 0; i
< numargs
; i
+= 2) {
12099 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
12103 if (i
== numargs
) {
12108 /* For each list */
12109 for (i
= 0; i
< numargs
; i
+= 2) {
12113 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12114 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
12115 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
12117 /* Ran out, so store the empty string */
12118 valObj
= interp
->emptyObj
;
12120 /* Avoid shimmering */
12121 Jim_IncrRefCount(valObj
);
12122 result
= Jim_SetVariable(interp
, varName
, valObj
);
12123 Jim_DecrRefCount(interp
, valObj
);
12124 if (result
!= JIM_OK
) {
12129 switch (result
= Jim_EvalObj(interp
, script
)) {
12132 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
12145 Jim_SetResult(interp
, resultObj
);
12147 Jim_DecrRefCount(interp
, resultObj
);
12155 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12157 return JimForeachMapHelper(interp
, argc
, argv
, 0);
12161 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12163 return JimForeachMapHelper(interp
, argc
, argv
, 1);
12167 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12169 int result
= JIM_ERR
;
12172 Jim_Obj
*resultObj
;
12175 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12179 JimListIterInit(&iter
, argv
[1]);
12181 for (i
= 2; i
< argc
; i
++) {
12182 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12183 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12184 if (result
!= JIM_OK
) {
12189 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12190 while (!JimListIterDone(interp
, &iter
)) {
12191 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12194 Jim_SetResult(interp
, resultObj
);
12200 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12202 int boolean
, retval
, current
= 1, falsebody
= 0;
12206 /* Far not enough arguments given! */
12207 if (current
>= argc
)
12209 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12212 /* There lacks something, isn't it? */
12213 if (current
>= argc
)
12215 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12217 /* Tsk tsk, no then-clause? */
12218 if (current
>= argc
)
12221 return Jim_EvalObj(interp
, argv
[current
]);
12222 /* Ok: no else-clause follows */
12223 if (++current
>= argc
) {
12224 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12227 falsebody
= current
++;
12228 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12229 /* IIICKS - else-clause isn't last cmd? */
12230 if (current
!= argc
- 1)
12232 return Jim_EvalObj(interp
, argv
[current
]);
12234 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12235 /* Ok: elseif follows meaning all the stuff
12236 * again (how boring...) */
12238 /* OOPS - else-clause is not last cmd? */
12239 else if (falsebody
!= argc
- 1)
12241 return Jim_EvalObj(interp
, argv
[falsebody
]);
12246 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12251 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12252 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12253 Jim_Obj
*stringObj
, int nocase
)
12260 parms
[argc
++] = commandObj
;
12262 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12264 parms
[argc
++] = patternObj
;
12265 parms
[argc
++] = stringObj
;
12267 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12269 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12277 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12280 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12282 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12283 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12284 Jim_Obj
*script
= 0;
12288 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12289 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12292 for (opt
= 1; opt
< argc
; ++opt
) {
12293 const char *option
= Jim_String(argv
[opt
]);
12295 if (*option
!= '-')
12297 else if (strncmp(option
, "--", 2) == 0) {
12301 else if (strncmp(option
, "-exact", 2) == 0)
12302 matchOpt
= SWITCH_EXACT
;
12303 else if (strncmp(option
, "-glob", 2) == 0)
12304 matchOpt
= SWITCH_GLOB
;
12305 else if (strncmp(option
, "-regexp", 2) == 0)
12306 matchOpt
= SWITCH_RE
;
12307 else if (strncmp(option
, "-command", 2) == 0) {
12308 matchOpt
= SWITCH_CMD
;
12309 if ((argc
- opt
) < 2)
12311 command
= argv
[++opt
];
12314 Jim_SetResultFormatted(interp
,
12315 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12319 if ((argc
- opt
) < 2)
12322 strObj
= argv
[opt
++];
12323 patCount
= argc
- opt
;
12324 if (patCount
== 1) {
12327 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12331 caseList
= &argv
[opt
];
12332 if (patCount
== 0 || patCount
% 2 != 0)
12334 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12335 Jim_Obj
*patObj
= caseList
[i
];
12337 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12338 || i
< (patCount
- 2)) {
12339 switch (matchOpt
) {
12341 if (Jim_StringEqObj(strObj
, patObj
))
12342 script
= caseList
[i
+ 1];
12345 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12346 script
= caseList
[i
+ 1];
12349 command
= Jim_NewStringObj(interp
, "regexp", -1);
12350 /* Fall thru intentionally */
12352 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12354 /* After the execution of a command we need to
12355 * make sure to reconvert the object into a list
12356 * again. Only for the single-list style [switch]. */
12357 if (argc
- opt
== 1) {
12360 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12363 /* command is here already decref'd */
12368 script
= caseList
[i
+ 1];
12374 script
= caseList
[i
+ 1];
12377 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12378 script
= caseList
[i
+ 1];
12379 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12380 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12383 Jim_SetEmptyResult(interp
);
12385 return Jim_EvalObj(interp
, script
);
12391 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12393 Jim_Obj
*listObjPtr
;
12395 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12396 Jim_SetResult(interp
, listObjPtr
);
12401 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12403 Jim_Obj
*objPtr
, *listObjPtr
;
12408 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12412 Jim_IncrRefCount(objPtr
);
12413 for (i
= 2; i
< argc
; i
++) {
12414 listObjPtr
= objPtr
;
12415 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12416 Jim_DecrRefCount(interp
, listObjPtr
);
12419 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12420 /* Returns an empty object if the index
12421 * is out of range. */
12422 Jim_DecrRefCount(interp
, listObjPtr
);
12423 Jim_SetEmptyResult(interp
);
12426 Jim_IncrRefCount(objPtr
);
12427 Jim_DecrRefCount(interp
, listObjPtr
);
12429 Jim_SetResult(interp
, objPtr
);
12430 Jim_DecrRefCount(interp
, objPtr
);
12435 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12438 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12441 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12446 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12448 static const char * const options
[] = {
12449 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12453 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12458 int opt_nocase
= 0;
12460 int opt_inline
= 0;
12461 int opt_match
= OPT_EXACT
;
12464 Jim_Obj
*listObjPtr
= NULL
;
12465 Jim_Obj
*commandObj
= NULL
;
12469 Jim_WrongNumArgs(interp
, 1, argv
,
12470 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12474 for (i
= 1; i
< argc
- 2; i
++) {
12477 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12499 if (i
>= argc
- 2) {
12502 commandObj
= argv
[++i
];
12507 opt_match
= option
;
12515 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12517 if (opt_match
== OPT_REGEXP
) {
12518 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12521 Jim_IncrRefCount(commandObj
);
12524 listlen
= Jim_ListLength(interp
, argv
[0]);
12525 for (i
= 0; i
< listlen
; i
++) {
12527 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12529 switch (opt_match
) {
12531 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12535 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12540 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12543 Jim_FreeNewObj(interp
, listObjPtr
);
12551 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12552 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12556 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12557 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12558 Jim_Obj
*resultObj
;
12561 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12563 else if (!opt_inline
) {
12564 resultObj
= Jim_NewIntObj(interp
, i
);
12567 resultObj
= objPtr
;
12571 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12574 Jim_SetResult(interp
, resultObj
);
12581 Jim_SetResult(interp
, listObjPtr
);
12586 Jim_SetResultBool(interp
, opt_not
);
12588 else if (!opt_inline
) {
12589 Jim_SetResultInt(interp
, -1);
12595 Jim_DecrRefCount(interp
, commandObj
);
12601 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12603 Jim_Obj
*listObjPtr
;
12608 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12611 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12613 /* Create the list if it does not exist */
12614 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12617 else if (Jim_IsShared(listObjPtr
)) {
12618 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12621 for (i
= 2; i
< argc
; i
++)
12622 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12623 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12625 Jim_FreeNewObj(interp
, listObjPtr
);
12628 Jim_SetResult(interp
, listObjPtr
);
12633 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12639 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12643 if (Jim_IsShared(listPtr
))
12644 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12645 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12647 len
= Jim_ListLength(interp
, listPtr
);
12651 idx
= len
+ idx
+ 1;
12652 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12653 Jim_SetResult(interp
, listPtr
);
12656 if (listPtr
!= argv
[1]) {
12657 Jim_FreeNewObj(interp
, listPtr
);
12663 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12665 int first
, last
, len
, rangeLen
;
12667 Jim_Obj
*newListObj
;
12670 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12673 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12674 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12679 len
= Jim_ListLength(interp
, listObj
);
12681 first
= JimRelToAbsIndex(len
, first
);
12682 last
= JimRelToAbsIndex(len
, last
);
12683 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12685 /* Now construct a new list which consists of:
12686 * <elements before first> <supplied elements> <elements after last>
12689 /* Check to see if trying to replace past the end of the list */
12691 /* OK. Not past the end */
12693 else if (len
== 0) {
12694 /* Special for empty list, adjust first to 0 */
12698 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12699 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12703 /* Add the first set of elements */
12704 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12706 /* Add supplied elements */
12707 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12709 /* Add the remaining elements */
12710 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12712 Jim_SetResult(interp
, newListObj
);
12717 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12720 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12723 else if (argc
== 3) {
12724 /* With no indexes, simply implements [set] */
12725 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12727 Jim_SetResult(interp
, argv
[2]);
12730 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12734 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12736 static const char * const options
[] = {
12737 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12740 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12745 struct lsort_info info
;
12748 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12752 info
.type
= JIM_LSORT_ASCII
;
12756 info
.command
= NULL
;
12757 info
.interp
= interp
;
12759 for (i
= 1; i
< (argc
- 1); i
++) {
12762 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12767 info
.type
= JIM_LSORT_ASCII
;
12770 info
.type
= JIM_LSORT_NOCASE
;
12773 info
.type
= JIM_LSORT_INTEGER
;
12776 info
.type
= JIM_LSORT_REAL
;
12778 case OPT_INCREASING
:
12781 case OPT_DECREASING
:
12788 if (i
>= (argc
- 2)) {
12789 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12792 info
.type
= JIM_LSORT_COMMAND
;
12793 info
.command
= argv
[i
+ 1];
12797 if (i
>= (argc
- 2)) {
12798 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12801 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12809 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12810 retCode
= ListSortElements(interp
, resObj
, &info
);
12811 if (retCode
== JIM_OK
) {
12812 Jim_SetResult(interp
, resObj
);
12815 Jim_FreeNewObj(interp
, resObj
);
12821 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12823 Jim_Obj
*stringObjPtr
;
12827 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12831 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12837 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12838 if (!stringObjPtr
) {
12839 /* Create the string if it doesn't exist */
12840 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12843 else if (Jim_IsShared(stringObjPtr
)) {
12845 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12847 for (i
= 2; i
< argc
; i
++) {
12848 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12850 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12852 Jim_FreeNewObj(interp
, stringObjPtr
);
12857 Jim_SetResult(interp
, stringObjPtr
);
12862 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12864 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12865 static const char * const options
[] = {
12866 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12872 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12873 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12878 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12881 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12882 return Jim_CheckShowCommands(interp
, argv
[1], options
);
12883 if (option
== OPT_REFCOUNT
) {
12885 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12888 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12891 else if (option
== OPT_OBJCOUNT
) {
12892 int freeobj
= 0, liveobj
= 0;
12897 Jim_WrongNumArgs(interp
, 2, argv
, "");
12900 /* Count the number of free objects. */
12901 objPtr
= interp
->freeList
;
12904 objPtr
= objPtr
->nextObjPtr
;
12906 /* Count the number of live objects. */
12907 objPtr
= interp
->liveList
;
12910 objPtr
= objPtr
->nextObjPtr
;
12912 /* Set the result string and return. */
12913 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12914 Jim_SetResultString(interp
, buf
, -1);
12917 else if (option
== OPT_OBJECTS
) {
12918 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12920 /* Count the number of live objects. */
12921 objPtr
= interp
->liveList
;
12922 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12925 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12927 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12928 sprintf(buf
, "%p", objPtr
);
12929 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12930 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12931 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12932 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12933 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12934 objPtr
= objPtr
->nextObjPtr
;
12936 Jim_SetResult(interp
, listObjPtr
);
12939 else if (option
== OPT_INVSTR
) {
12943 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12947 if (objPtr
->typePtr
!= NULL
)
12948 Jim_InvalidateStringRep(objPtr
);
12949 Jim_SetEmptyResult(interp
);
12952 else if (option
== OPT_SHOW
) {
12957 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12960 s
= Jim_GetString(argv
[2], &len
);
12962 charlen
= utf8_strlen(s
, len
);
12966 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12967 printf("chars (%d): <<%s>>\n", charlen
, s
);
12968 printf("bytes (%d):", len
);
12970 printf(" %02x", (unsigned char)*s
++);
12975 else if (option
== OPT_SCRIPTLEN
) {
12979 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12982 script
= JimGetScript(interp
, argv
[2]);
12983 if (script
== NULL
)
12985 Jim_SetResultInt(interp
, script
->len
);
12988 else if (option
== OPT_EXPRLEN
) {
12989 ExprByteCode
*expr
;
12992 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12995 expr
= JimGetExpression(interp
, argv
[2]);
12998 Jim_SetResultInt(interp
, expr
->len
);
13001 else if (option
== OPT_EXPRBC
) {
13003 ExprByteCode
*expr
;
13007 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
13010 expr
= JimGetExpression(interp
, argv
[2]);
13013 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
13014 for (i
= 0; i
< expr
->len
; i
++) {
13016 const Jim_ExprOperator
*op
;
13017 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
13019 switch (expr
->token
[i
].type
) {
13020 case JIM_TT_EXPR_INT
:
13023 case JIM_TT_EXPR_DOUBLE
:
13026 case JIM_TT_EXPR_BOOLEAN
:
13035 case JIM_TT_DICTSUGAR
:
13036 type
= "dictsugar";
13038 case JIM_TT_EXPRSUGAR
:
13039 type
= "exprsugar";
13048 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
13055 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
13058 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
13059 Jim_ListAppendElement(interp
, objPtr
, obj
);
13061 Jim_SetResult(interp
, objPtr
);
13065 Jim_SetResultString(interp
,
13066 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13070 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
13071 #if !defined(JIM_DEBUG_COMMAND)
13072 Jim_SetResultString(interp
, "unsupported", -1);
13078 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13083 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
13088 rc
= Jim_EvalObj(interp
, argv
[1]);
13091 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13094 if (rc
== JIM_ERR
) {
13095 /* eval is "interesting", so add a stack frame here */
13096 interp
->addStackTrace
++;
13102 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13106 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
13109 /* Save the old callframe pointer */
13110 savedCallFrame
= interp
->framePtr
;
13112 /* Lookup the target frame pointer */
13113 str
= Jim_String(argv
[1]);
13114 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
13115 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13120 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13122 if (targetCallFrame
== NULL
) {
13126 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
13129 /* Eval the code in the target callframe. */
13130 interp
->framePtr
= targetCallFrame
;
13132 retcode
= Jim_EvalObj(interp
, argv
[1]);
13135 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13137 interp
->framePtr
= savedCallFrame
;
13141 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
13147 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13149 Jim_Obj
*exprResultPtr
;
13153 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
13155 else if (argc
> 2) {
13158 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
13159 Jim_IncrRefCount(objPtr
);
13160 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
13161 Jim_DecrRefCount(interp
, objPtr
);
13164 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
13167 if (retcode
!= JIM_OK
)
13169 Jim_SetResult(interp
, exprResultPtr
);
13170 Jim_DecrRefCount(interp
, exprResultPtr
);
13175 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13178 Jim_WrongNumArgs(interp
, 1, argv
, "");
13185 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13188 Jim_WrongNumArgs(interp
, 1, argv
, "");
13191 return JIM_CONTINUE
;
13195 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13198 Jim_Obj
*stackTraceObj
= NULL
;
13199 Jim_Obj
*errorCodeObj
= NULL
;
13200 int returnCode
= JIM_OK
;
13203 for (i
= 1; i
< argc
- 1; i
+= 2) {
13204 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13205 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13209 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13210 stackTraceObj
= argv
[i
+ 1];
13212 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13213 errorCodeObj
= argv
[i
+ 1];
13215 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13216 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13217 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13226 if (i
!= argc
- 1 && i
!= argc
) {
13227 Jim_WrongNumArgs(interp
, 1, argv
,
13228 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13231 /* If a stack trace is supplied and code is error, set the stack trace */
13232 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13233 JimSetStackTrace(interp
, stackTraceObj
);
13235 /* If an error code list is supplied, set the global $errorCode */
13236 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13237 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13239 interp
->returnCode
= returnCode
;
13240 interp
->returnLevel
= level
;
13242 if (i
== argc
- 1) {
13243 Jim_SetResult(interp
, argv
[i
]);
13249 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13251 if (interp
->framePtr
->level
== 0) {
13252 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13255 else if (argc
>= 2) {
13256 /* Need to resolve the tailcall command in the current context */
13257 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13259 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13260 if (cmdPtr
== NULL
) {
13264 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13266 /* And stash this pre-resolved command */
13267 JimIncrCmdRefCount(cmdPtr
);
13268 cf
->tailcallCmd
= cmdPtr
;
13270 /* And stash the command list */
13271 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13273 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13274 Jim_IncrRefCount(cf
->tailcallObj
);
13276 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13282 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13285 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13287 /* prefixListObj is a list to which the args need to be appended */
13288 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13289 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13291 return JimEvalObjList(interp
, cmdList
);
13294 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13296 Jim_Obj
*prefixListObj
= privData
;
13297 Jim_DecrRefCount(interp
, prefixListObj
);
13300 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13302 Jim_Obj
*prefixListObj
;
13303 const char *newname
;
13306 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13310 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13311 Jim_IncrRefCount(prefixListObj
);
13312 newname
= Jim_String(argv
[1]);
13313 if (newname
[0] == ':' && newname
[1] == ':') {
13314 while (*++newname
== ':') {
13318 Jim_SetResult(interp
, argv
[1]);
13320 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13324 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13328 if (argc
!= 4 && argc
!= 5) {
13329 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13333 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13338 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13341 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13345 /* Add the new command */
13346 Jim_Obj
*qualifiedCmdNameObj
;
13347 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13349 JimCreateCommand(interp
, cmdname
, cmd
);
13351 /* Calculate and set the namespace for this proc */
13352 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13354 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13356 /* Unlike Tcl, set the name of the proc as the result */
13357 Jim_SetResult(interp
, argv
[1]);
13364 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13369 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13373 /* Evaluate the arguments with 'local' in force */
13375 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13379 /* If OK, and the result is a proc, add it to the list of local procs */
13380 if (retcode
== 0) {
13381 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13383 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13386 if (interp
->framePtr
->localCommands
== NULL
) {
13387 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13388 Jim_InitStack(interp
->framePtr
->localCommands
);
13390 Jim_IncrRefCount(cmdNameObj
);
13391 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13398 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13401 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13407 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13408 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13409 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13412 /* OK. Mark this command as being in an upcall */
13413 cmdPtr
->u
.proc
.upcall
++;
13414 JimIncrCmdRefCount(cmdPtr
);
13416 /* Invoke the command as normal */
13417 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13419 /* No longer in an upcall */
13420 cmdPtr
->u
.proc
.upcall
--;
13421 JimDecrCmdRefCount(interp
, cmdPtr
);
13428 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13431 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13437 Jim_Obj
*argListObjPtr
;
13438 Jim_Obj
*bodyObjPtr
;
13439 Jim_Obj
*nsObj
= NULL
;
13442 int len
= Jim_ListLength(interp
, argv
[1]);
13443 if (len
!= 2 && len
!= 3) {
13444 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13449 #ifdef jim_ext_namespace
13450 /* Need to canonicalise the given namespace. */
13451 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13453 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13457 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13458 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13460 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13463 /* Create a new argv array with a dummy argv[0], for error messages */
13464 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13465 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13466 Jim_IncrRefCount(nargv
[0]);
13467 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13468 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13469 Jim_DecrRefCount(interp
, nargv
[0]);
13472 JimDecrCmdRefCount(interp
, cmd
);
13481 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13483 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13488 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13491 Jim_CallFrame
*targetCallFrame
;
13493 /* Lookup the target frame pointer */
13494 if (argc
> 3 && (argc
% 2 == 0)) {
13495 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13500 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13502 if (targetCallFrame
== NULL
) {
13506 /* Check for arity */
13508 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13512 /* Now... for every other/local couple: */
13513 for (i
= 1; i
< argc
; i
+= 2) {
13514 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13521 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13526 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13529 /* Link every var to the toplevel having the same name */
13530 if (interp
->framePtr
->level
== 0)
13531 return JIM_OK
; /* global at toplevel... */
13532 for (i
= 1; i
< argc
; i
++) {
13533 /* global ::blah does nothing */
13534 const char *name
= Jim_String(argv
[i
]);
13535 if (name
[0] != ':' || name
[1] != ':') {
13536 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13543 /* does the [string map] operation. On error NULL is returned,
13544 * otherwise a new string object with the result, having refcount = 0,
13546 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13547 Jim_Obj
*objPtr
, int nocase
)
13550 const char *str
, *noMatchStart
= NULL
;
13552 Jim_Obj
*resultObjPtr
;
13554 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13556 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13560 str
= Jim_String(objPtr
);
13561 strLen
= Jim_Utf8Length(interp
, objPtr
);
13564 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13566 for (i
= 0; i
< numMaps
; i
+= 2) {
13567 Jim_Obj
*eachObjPtr
;
13571 eachObjPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13572 k
= Jim_String(eachObjPtr
);
13573 kl
= Jim_Utf8Length(interp
, eachObjPtr
);
13575 if (strLen
>= kl
&& kl
) {
13577 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13579 if (noMatchStart
) {
13580 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13581 noMatchStart
= NULL
;
13583 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13584 str
+= utf8_index(str
, kl
);
13590 if (i
== numMaps
) { /* no match */
13592 if (noMatchStart
== NULL
)
13593 noMatchStart
= str
;
13594 str
+= utf8_tounicode(str
, &c
);
13598 if (noMatchStart
) {
13599 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13601 return resultObjPtr
;
13605 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13610 static const char * const options
[] = {
13611 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13612 "map", "repeat", "reverse", "index", "first", "last", "cat",
13613 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13617 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13618 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13619 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13621 static const char * const nocase_options
[] = {
13624 static const char * const nocase_length_options
[] = {
13625 "-nocase", "-length", NULL
13629 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13632 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13633 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13634 return Jim_CheckShowCommands(interp
, argv
[1], options
);
13638 case OPT_BYTELENGTH
:
13640 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13643 if (option
== OPT_LENGTH
) {
13644 len
= Jim_Utf8Length(interp
, argv
[2]);
13647 len
= Jim_Length(argv
[2]);
13649 Jim_SetResultInt(interp
, len
);
13655 /* optimise the one-arg case */
13661 objPtr
= Jim_NewStringObj(interp
, "", 0);
13663 for (i
= 2; i
< argc
; i
++) {
13664 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13667 Jim_SetResult(interp
, objPtr
);
13674 /* n is the number of remaining option args */
13675 long opt_length
= -1;
13680 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13681 JIM_ENUM_ABBREV
) != JIM_OK
) {
13683 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13694 goto badcompareargs
;
13696 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13703 goto badcompareargs
;
13706 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13707 /* Fast version - [string equal], case sensitive, no length */
13708 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13711 if (opt_length
>= 0) {
13712 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13715 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13717 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13725 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13726 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13727 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13730 if (opt_case
== 0) {
13733 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13741 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13742 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13743 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13747 if (opt_case
== 0) {
13750 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13751 if (objPtr
== NULL
) {
13754 Jim_SetResult(interp
, objPtr
);
13759 case OPT_BYTERANGE
:{
13763 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13766 if (option
== OPT_RANGE
) {
13767 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13771 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13774 if (objPtr
== NULL
) {
13777 Jim_SetResult(interp
, objPtr
);
13784 if (argc
!= 5 && argc
!= 6) {
13785 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13788 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13789 if (objPtr
== NULL
) {
13792 Jim_SetResult(interp
, objPtr
);
13802 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13805 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13808 objPtr
= Jim_NewStringObj(interp
, "", 0);
13811 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13814 Jim_SetResult(interp
, objPtr
);
13824 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13828 str
= Jim_GetString(argv
[2], &len
);
13829 buf
= Jim_Alloc(len
+ 1);
13832 for (i
= 0; i
< len
; ) {
13834 int l
= utf8_tounicode(str
, &c
);
13835 memcpy(p
- l
, str
, l
);
13840 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13849 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13852 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13855 str
= Jim_String(argv
[2]);
13856 len
= Jim_Utf8Length(interp
, argv
[2]);
13857 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13858 idx
= JimRelToAbsIndex(len
, idx
);
13860 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13861 Jim_SetResultString(interp
, "", 0);
13863 else if (len
== Jim_Length(argv
[2])) {
13864 /* ASCII optimisation */
13865 Jim_SetResultString(interp
, str
+ idx
, 1);
13869 int i
= utf8_index(str
, idx
);
13870 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13877 int idx
= 0, l1
, l2
;
13878 const char *s1
, *s2
;
13880 if (argc
!= 4 && argc
!= 5) {
13881 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13884 s1
= Jim_String(argv
[2]);
13885 s2
= Jim_String(argv
[3]);
13886 l1
= Jim_Utf8Length(interp
, argv
[2]);
13887 l2
= Jim_Utf8Length(interp
, argv
[3]);
13889 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13892 idx
= JimRelToAbsIndex(l2
, idx
);
13894 else if (option
== OPT_LAST
) {
13897 if (option
== OPT_FIRST
) {
13898 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13902 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13904 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13912 case OPT_TRIMRIGHT
:{
13913 Jim_Obj
*trimchars
;
13915 if (argc
!= 3 && argc
!= 4) {
13916 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13919 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13920 if (option
== OPT_TRIM
) {
13921 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13923 else if (option
== OPT_TRIMLEFT
) {
13924 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13926 else if (option
== OPT_TRIMRIGHT
) {
13927 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13936 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13939 if (option
== OPT_TOLOWER
) {
13940 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13942 else if (option
== OPT_TOUPPER
) {
13943 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13946 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13951 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13952 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13954 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13961 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13964 jim_wide start
, elapsed
;
13966 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13969 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13973 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13979 start
= JimClock();
13983 retval
= Jim_EvalObj(interp
, argv
[1]);
13984 if (retval
!= JIM_OK
) {
13988 elapsed
= JimClock() - start
;
13989 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13990 Jim_SetResultString(interp
, buf
, -1);
13995 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14000 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
14004 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
14007 interp
->exitCode
= exitCode
;
14012 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14018 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14019 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
14020 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
14022 /* Reset the error code before catch.
14023 * Note that this is not strictly correct.
14025 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
14027 for (i
= 1; i
< argc
- 1; i
++) {
14028 const char *arg
= Jim_String(argv
[i
]);
14032 /* It's a pity we can't use Jim_GetEnum here :-( */
14033 if (strcmp(arg
, "--") == 0) {
14041 if (strncmp(arg
, "-no", 3) == 0) {
14050 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
14054 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
14061 ignore_mask
|= ((jim_wide
)1 << option
);
14064 ignore_mask
&= (~((jim_wide
)1 << option
));
14069 if (argc
< 1 || argc
> 3) {
14071 Jim_WrongNumArgs(interp
, 1, argv
,
14072 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14077 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
14081 interp
->signal_level
+= sig
;
14082 if (Jim_CheckSignal(interp
)) {
14083 /* If a signal is set, don't even try to execute the body */
14084 exitCode
= JIM_SIGNAL
;
14087 exitCode
= Jim_EvalObj(interp
, argv
[0]);
14088 /* Don't want any caught error included in a later stack trace */
14089 interp
->errorFlag
= 0;
14091 interp
->signal_level
-= sig
;
14093 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14094 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
14095 /* Not caught, pass it up */
14099 if (sig
&& exitCode
== JIM_SIGNAL
) {
14100 /* Catch the signal at this level */
14101 if (interp
->signal_set_result
) {
14102 interp
->signal_set_result(interp
, interp
->sigmask
);
14105 Jim_SetResultInt(interp
, interp
->sigmask
);
14107 interp
->sigmask
= 0;
14111 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
14115 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
14117 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
14118 Jim_ListAppendElement(interp
, optListObj
,
14119 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
14120 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
14121 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
14122 if (exitCode
== JIM_ERR
) {
14123 Jim_Obj
*errorCode
;
14124 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
14126 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
14128 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
14130 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
14131 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
14134 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
14139 Jim_SetResultInt(interp
, exitCode
);
14143 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14146 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14148 if (argc
!= 3 && argc
!= 4) {
14149 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
14153 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
14156 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
14162 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14164 Jim_Reference
*refPtr
;
14167 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14170 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14172 Jim_SetResult(interp
, refPtr
->objPtr
);
14177 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14179 Jim_Reference
*refPtr
;
14182 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14185 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14187 Jim_IncrRefCount(argv
[2]);
14188 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14189 refPtr
->objPtr
= argv
[2];
14190 Jim_SetResult(interp
, argv
[2]);
14195 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14198 Jim_WrongNumArgs(interp
, 1, argv
, "");
14201 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14203 /* Free all the freed objects. */
14204 while (interp
->freeList
) {
14205 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14206 Jim_Free(interp
->freeList
);
14207 interp
->freeList
= nextObjPtr
;
14213 /* [finalize] reference ?newValue? */
14214 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14216 if (argc
!= 2 && argc
!= 3) {
14217 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14221 Jim_Obj
*cmdNamePtr
;
14223 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14225 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14226 Jim_SetResult(interp
, cmdNamePtr
);
14229 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14231 Jim_SetResult(interp
, argv
[2]);
14236 /* [info references] */
14237 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14239 Jim_Obj
*listObjPtr
;
14240 Jim_HashTableIterator htiter
;
14243 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14245 JimInitHashTableIterator(&interp
->references
, &htiter
);
14246 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14247 char buf
[JIM_REFERENCE_SPACE
+ 1];
14248 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14249 const unsigned long *refId
= he
->key
;
14251 JimFormatReference(buf
, refPtr
, *refId
);
14252 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14254 Jim_SetResult(interp
, listObjPtr
);
14257 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14260 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14263 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14267 if (JimValidName(interp
, "new procedure", argv
[2])) {
14271 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14274 #define JIM_DICTMATCH_VALUES 0x0001
14276 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14278 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14280 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14281 if (type
& JIM_DICTMATCH_VALUES
) {
14282 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14287 * Like JimHashtablePatternMatch, but for dictionaries.
14289 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14290 JimDictMatchCallbackType
*callback
, int type
)
14293 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14295 /* Check for the non-pattern case. We can do this much more efficiently. */
14296 Jim_HashTableIterator htiter
;
14297 JimInitHashTableIterator(ht
, &htiter
);
14298 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14299 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14300 callback(interp
, listObjPtr
, he
, type
);
14308 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14310 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14313 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14317 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14319 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14322 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14326 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14328 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14331 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14335 * Must be called with at least one object.
14336 * Returns the new dictionary, or NULL on error.
14338 Jim_Obj
*Jim_DictMerge(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
14340 Jim_Obj
*objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
14343 JimPanic((objc
== 0, "Jim_DictMerge called with objc=0"));
14345 /* Note that we don't optimise the trivial case of a single argument */
14347 for (i
= 0; i
< objc
; i
++) {
14349 Jim_HashTableIterator htiter
;
14352 if (SetDictFromAny(interp
, objv
[i
]) != JIM_OK
) {
14353 Jim_FreeNewObj(interp
, objPtr
);
14356 ht
= objv
[i
]->internalRep
.ptr
;
14357 JimInitHashTableIterator(ht
, &htiter
);
14358 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14359 Jim_ReplaceHashEntry(objPtr
->internalRep
.ptr
, Jim_GetHashEntryKey(he
), Jim_GetHashEntryVal(he
));
14365 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14370 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14374 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14376 /* Note that this uses internal knowledge of the hash table */
14377 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14379 for (i
= 0; i
< ht
->size
; i
++) {
14380 Jim_HashEntry
*he
= ht
->table
[i
];
14386 printf(" %s", Jim_String(he
->key
));
14395 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14397 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14399 Jim_AppendString(interp
, prefixObj
, " ", 1);
14400 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14402 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14406 * Implements the [dict with] command
14408 static int JimDictWith(Jim_Interp
*interp
, Jim_Obj
*dictVarName
, Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*scriptObj
)
14413 Jim_Obj
**dictValues
;
14417 /* Open up the appropriate level of the dictionary */
14418 dictObj
= Jim_GetVariable(interp
, dictVarName
, JIM_ERRMSG
);
14419 if (dictObj
== NULL
|| Jim_DictKeysVector(interp
, dictObj
, keyv
, keyc
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
14422 /* Set the local variables */
14423 if (Jim_DictPairs(interp
, objPtr
, &dictValues
, &len
) == JIM_ERR
) {
14426 for (i
= 0; i
< len
; i
+= 2) {
14427 if (Jim_SetVariable(interp
, dictValues
[i
], dictValues
[i
+ 1]) == JIM_ERR
) {
14428 Jim_Free(dictValues
);
14433 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14434 if (Jim_Length(scriptObj
)) {
14435 ret
= Jim_EvalObj(interp
, scriptObj
);
14437 /* Now if the dictionary still exists, update it based on the local variables */
14438 if (ret
== JIM_OK
&& Jim_GetVariable(interp
, dictVarName
, 0) != NULL
) {
14439 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14440 Jim_Obj
**newkeyv
= Jim_Alloc(sizeof(*newkeyv
) * (keyc
+ 1));
14441 for (i
= 0; i
< keyc
; i
++) {
14442 newkeyv
[i
] = keyv
[i
];
14445 for (i
= 0; i
< len
; i
+= 2) {
14446 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14447 objPtr
= Jim_GetVariable(interp
, dictValues
[i
], 0);
14448 newkeyv
[keyc
] = dictValues
[i
];
14449 Jim_SetDictKeysVector(interp
, dictVarName
, newkeyv
, keyc
+ 1, objPtr
, 0);
14455 Jim_Free(dictValues
);
14461 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14465 static const char * const options
[] = {
14466 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14467 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14468 "replace", "update", NULL
14472 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14473 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14474 OPT_REPLACE
, OPT_UPDATE
,
14478 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14482 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14483 return Jim_CheckShowCommands(interp
, argv
[1], options
);
14489 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14492 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14493 JIM_ERRMSG
) != JIM_OK
) {
14496 Jim_SetResult(interp
, objPtr
);
14501 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14504 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14508 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14512 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14516 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14522 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14525 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14531 if (argc
!= 3 && argc
!= 4) {
14532 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14535 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14539 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14542 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14545 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14552 objPtr
= Jim_DictMerge(interp
, argc
- 2, argv
+ 2);
14553 if (objPtr
== NULL
) {
14556 Jim_SetResult(interp
, objPtr
);
14560 if (argc
< 6 || argc
% 2) {
14561 /* Better error message */
14568 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14571 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14572 Jim_SetResult(interp
, objPtr
);
14577 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14580 return Jim_DictInfo(interp
, argv
[2]);
14584 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar ?key ...? script");
14587 return JimDictWith(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1]);
14589 /* Handle command as an ensemble */
14590 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14594 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14596 static const char * const options
[] = {
14597 "-nobackslashes", "-nocommands", "-novariables", NULL
14600 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14602 int flags
= JIM_SUBST_FLAG
;
14606 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14609 for (i
= 1; i
< (argc
- 1); i
++) {
14612 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14613 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14617 case OPT_NOBACKSLASHES
:
14618 flags
|= JIM_SUBST_NOESC
;
14620 case OPT_NOCOMMANDS
:
14621 flags
|= JIM_SUBST_NOCMD
;
14623 case OPT_NOVARIABLES
:
14624 flags
|= JIM_SUBST_NOVAR
;
14628 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14631 Jim_SetResult(interp
, objPtr
);
14636 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14642 static const char * const commands
[] = {
14643 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14644 "vars", "version", "patchlevel", "complete", "args", "hostname",
14645 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14646 "references", "alias", NULL
14649 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14650 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14651 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14652 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14655 #ifdef jim_ext_namespace
14658 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14659 /* This is for internal use only */
14667 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14670 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14671 return Jim_CheckShowCommands(interp
, argv
[1], commands
);
14674 /* Test for the most common commands first, just in case it makes a difference */
14678 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14681 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14688 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14691 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14694 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14695 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14698 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14702 case INFO_CHANNELS
:
14703 mode
++; /* JIM_CMDLIST_CHANNELS */
14704 #ifndef jim_ext_aio
14705 Jim_SetResultString(interp
, "aio not enabled", -1);
14710 mode
++; /* JIM_CMDLIST_PROCS */
14712 case INFO_COMMANDS
:
14713 /* mode 0 => JIM_CMDLIST_COMMANDS */
14714 if (argc
!= 2 && argc
!= 3) {
14715 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14718 #ifdef jim_ext_namespace
14720 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14721 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14725 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14729 mode
++; /* JIM_VARLIST_VARS */
14732 mode
++; /* JIM_VARLIST_LOCALS */
14735 /* mode 0 => JIM_VARLIST_GLOBALS */
14736 if (argc
!= 2 && argc
!= 3) {
14737 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14740 #ifdef jim_ext_namespace
14742 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14743 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14747 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14752 Jim_WrongNumArgs(interp
, 2, argv
, "");
14755 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14760 Jim_Obj
*resObjPtr
;
14761 Jim_Obj
*fileNameObj
;
14763 if (argc
!= 3 && argc
!= 5) {
14764 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14768 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14771 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14772 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14775 if (argv
[2]->typePtr
== &sourceObjType
) {
14776 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14777 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14779 else if (argv
[2]->typePtr
== &scriptObjType
) {
14780 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14781 fileNameObj
= script
->fileNameObj
;
14782 line
= script
->firstline
;
14785 fileNameObj
= interp
->emptyObj
;
14788 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14789 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14790 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14792 Jim_SetResult(interp
, resObjPtr
);
14796 case INFO_STACKTRACE
:
14797 Jim_SetResult(interp
, interp
->stackTrace
);
14804 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14808 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14811 Jim_SetResult(interp
, objPtr
);
14815 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14826 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14829 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14832 if (!cmdPtr
->isproc
) {
14833 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14838 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14841 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14844 if (cmdPtr
->u
.proc
.staticVars
) {
14845 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14846 NULL
, JimVariablesMatch
, JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
));
14854 case INFO_PATCHLEVEL
:{
14855 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14857 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14858 Jim_SetResultString(interp
, buf
, -1);
14862 case INFO_COMPLETE
:
14863 if (argc
!= 3 && argc
!= 4) {
14864 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14870 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(interp
, argv
[2], &missing
));
14871 if (missing
!= ' ' && argc
== 4) {
14872 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14877 case INFO_HOSTNAME
:
14878 /* Redirect to os.gethostname if it exists */
14879 return Jim_Eval(interp
, "os.gethostname");
14881 case INFO_NAMEOFEXECUTABLE
:
14882 /* Redirect to Tcl proc */
14883 return Jim_Eval(interp
, "{info nameofexecutable}");
14885 case INFO_RETURNCODES
:
14888 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14890 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14891 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14892 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14893 jimReturnCodes
[i
], -1));
14896 Jim_SetResult(interp
, listObjPtr
);
14898 else if (argc
== 3) {
14902 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14905 name
= Jim_ReturnCode(code
);
14906 if (*name
== '?') {
14907 Jim_SetResultInt(interp
, code
);
14910 Jim_SetResultString(interp
, name
, -1);
14914 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14918 case INFO_REFERENCES
:
14919 #ifdef JIM_REFERENCES
14920 return JimInfoReferences(interp
, argc
, argv
);
14922 Jim_SetResultString(interp
, "not supported", -1);
14930 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14935 static const char * const options
[] = {
14936 "-command", "-proc", "-alias", "-var", NULL
14940 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14948 else if (argc
== 3) {
14949 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14955 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14959 if (option
== OPT_VAR
) {
14960 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14963 /* Now different kinds of commands */
14964 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14973 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14977 result
= cmd
->isproc
;
14982 Jim_SetResultBool(interp
, result
);
14987 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14989 const char *str
, *splitChars
, *noMatchStart
;
14990 int splitLen
, strLen
;
14991 Jim_Obj
*resObjPtr
;
14995 if (argc
!= 2 && argc
!= 3) {
14996 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
15000 str
= Jim_GetString(argv
[1], &len
);
15004 strLen
= Jim_Utf8Length(interp
, argv
[1]);
15008 splitChars
= " \n\t\r";
15012 splitChars
= Jim_String(argv
[2]);
15013 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
15016 noMatchStart
= str
;
15017 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15023 const char *sc
= splitChars
;
15024 int scLen
= splitLen
;
15025 int sl
= utf8_tounicode(str
, &c
);
15028 sc
+= utf8_tounicode(sc
, &pc
);
15030 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
15031 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
15032 noMatchStart
= str
+ sl
;
15038 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
15039 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
15042 /* This handles the special case of splitchars eq {}
15043 * Optimise by sharing common (ASCII) characters
15045 Jim_Obj
**commonObj
= NULL
;
15046 #define NUM_COMMON (128 - 9)
15048 int n
= utf8_tounicode(str
, &c
);
15049 #ifdef JIM_OPTIMIZATION
15050 if (c
>= 9 && c
< 128) {
15051 /* Common ASCII char. Note that 9 is the tab character */
15054 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
15055 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
15057 if (!commonObj
[c
]) {
15058 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
15060 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
15065 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
15068 Jim_Free(commonObj
);
15071 Jim_SetResult(interp
, resObjPtr
);
15076 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15078 const char *joinStr
;
15081 if (argc
!= 2 && argc
!= 3) {
15082 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
15091 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
15093 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
15098 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15103 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
15106 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
15107 if (objPtr
== NULL
)
15109 Jim_SetResult(interp
, objPtr
);
15114 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15116 Jim_Obj
*listPtr
, **outVec
;
15120 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
15123 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
15124 SetScanFmtFromAny(interp
, argv
[2]);
15125 if (FormatGetError(argv
[2]) != 0) {
15126 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
15130 int maxPos
= FormatGetMaxPos(argv
[2]);
15131 int count
= FormatGetCnvCount(argv
[2]);
15133 if (maxPos
> argc
- 3) {
15134 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
15137 else if (count
> argc
- 3) {
15138 Jim_SetResultString(interp
, "different numbers of variable names and "
15139 "field specifiers", -1);
15142 else if (count
< argc
- 3) {
15143 Jim_SetResultString(interp
, "variable is not assigned by any "
15144 "conversion specifiers", -1);
15148 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
15155 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
15156 int len
= Jim_ListLength(interp
, listPtr
);
15159 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
15160 for (i
= 0; i
< outc
; ++i
) {
15161 if (Jim_Length(outVec
[i
]) > 0) {
15163 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
15169 Jim_FreeNewObj(interp
, listPtr
);
15174 if (rc
== JIM_OK
) {
15175 Jim_SetResultInt(interp
, count
);
15180 if (listPtr
== (Jim_Obj
*)EOF
) {
15181 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
15184 Jim_SetResult(interp
, listPtr
);
15190 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15192 if (argc
!= 2 && argc
!= 3) {
15193 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
15196 Jim_SetResult(interp
, argv
[1]);
15198 JimSetStackTrace(interp
, argv
[2]);
15201 interp
->addStackTrace
++;
15206 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15211 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
15214 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
15216 Jim_SetResult(interp
, objPtr
);
15221 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15226 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
15227 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
15231 if (count
== 0 || argc
== 2) {
15238 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
15240 ListInsertElements(objPtr
, -1, argc
, argv
);
15243 Jim_SetResult(interp
, objPtr
);
15247 char **Jim_GetEnviron(void)
15249 #if defined(HAVE__NSGETENVIRON)
15250 return *_NSGetEnviron();
15252 #if !defined(NO_ENVIRON_EXTERN)
15253 extern char **environ
;
15260 void Jim_SetEnviron(char **env
)
15262 #if defined(HAVE__NSGETENVIRON)
15263 *_NSGetEnviron() = env
;
15265 #if !defined(NO_ENVIRON_EXTERN)
15266 extern char **environ
;
15274 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15280 char **e
= Jim_GetEnviron();
15283 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15285 for (i
= 0; e
[i
]; i
++) {
15286 const char *equals
= strchr(e
[i
], '=');
15289 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15291 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15295 Jim_SetResult(interp
, listObjPtr
);
15300 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15303 key
= Jim_String(argv
[1]);
15307 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15310 val
= Jim_String(argv
[2]);
15312 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15317 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15322 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15325 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15326 if (retval
== JIM_RETURN
)
15332 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15334 Jim_Obj
*revObjPtr
, **ele
;
15338 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15341 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15343 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15345 ListAppendElement(revObjPtr
, ele
[len
--]);
15346 Jim_SetResult(interp
, revObjPtr
);
15350 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15358 else if (step
> 0 && start
> end
)
15360 else if (step
< 0 && end
> start
)
15364 len
= -len
; /* abs(len) */
15366 step
= -step
; /* abs(step) */
15367 len
= 1 + ((len
- 1) / step
);
15368 /* We can truncate safely to INT_MAX, the range command
15369 * will always return an error for a such long range
15370 * because Tcl lists can't be so long. */
15373 return (int)((len
< 0) ? -1 : len
);
15377 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15379 jim_wide start
= 0, end
, step
= 1;
15383 if (argc
< 2 || argc
> 4) {
15384 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15388 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15392 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15393 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15395 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15398 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15399 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15402 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15403 for (i
= 0; i
< len
; i
++)
15404 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15405 Jim_SetResult(interp
, objPtr
);
15410 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15412 jim_wide min
= 0, max
= 0, len
, maxMul
;
15414 if (argc
< 1 || argc
> 3) {
15415 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15419 max
= JIM_WIDE_MAX
;
15420 } else if (argc
== 2) {
15421 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15423 } else if (argc
== 3) {
15424 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15425 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15430 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15433 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15437 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15438 if (r
< 0 || r
>= maxMul
) continue;
15439 r
= (len
== 0) ? 0 : r
%len
;
15440 Jim_SetResultInt(interp
, min
+r
);
15445 static const struct {
15447 Jim_CmdProc
*cmdProc
;
15448 } Jim_CoreCommandsTable
[] = {
15449 {"alias", Jim_AliasCoreCommand
},
15450 {"set", Jim_SetCoreCommand
},
15451 {"unset", Jim_UnsetCoreCommand
},
15452 {"puts", Jim_PutsCoreCommand
},
15453 {"+", Jim_AddCoreCommand
},
15454 {"*", Jim_MulCoreCommand
},
15455 {"-", Jim_SubCoreCommand
},
15456 {"/", Jim_DivCoreCommand
},
15457 {"incr", Jim_IncrCoreCommand
},
15458 {"while", Jim_WhileCoreCommand
},
15459 {"loop", Jim_LoopCoreCommand
},
15460 {"for", Jim_ForCoreCommand
},
15461 {"foreach", Jim_ForeachCoreCommand
},
15462 {"lmap", Jim_LmapCoreCommand
},
15463 {"lassign", Jim_LassignCoreCommand
},
15464 {"if", Jim_IfCoreCommand
},
15465 {"switch", Jim_SwitchCoreCommand
},
15466 {"list", Jim_ListCoreCommand
},
15467 {"lindex", Jim_LindexCoreCommand
},
15468 {"lset", Jim_LsetCoreCommand
},
15469 {"lsearch", Jim_LsearchCoreCommand
},
15470 {"llength", Jim_LlengthCoreCommand
},
15471 {"lappend", Jim_LappendCoreCommand
},
15472 {"linsert", Jim_LinsertCoreCommand
},
15473 {"lreplace", Jim_LreplaceCoreCommand
},
15474 {"lsort", Jim_LsortCoreCommand
},
15475 {"append", Jim_AppendCoreCommand
},
15476 {"debug", Jim_DebugCoreCommand
},
15477 {"eval", Jim_EvalCoreCommand
},
15478 {"uplevel", Jim_UplevelCoreCommand
},
15479 {"expr", Jim_ExprCoreCommand
},
15480 {"break", Jim_BreakCoreCommand
},
15481 {"continue", Jim_ContinueCoreCommand
},
15482 {"proc", Jim_ProcCoreCommand
},
15483 {"concat", Jim_ConcatCoreCommand
},
15484 {"return", Jim_ReturnCoreCommand
},
15485 {"upvar", Jim_UpvarCoreCommand
},
15486 {"global", Jim_GlobalCoreCommand
},
15487 {"string", Jim_StringCoreCommand
},
15488 {"time", Jim_TimeCoreCommand
},
15489 {"exit", Jim_ExitCoreCommand
},
15490 {"catch", Jim_CatchCoreCommand
},
15491 #ifdef JIM_REFERENCES
15492 {"ref", Jim_RefCoreCommand
},
15493 {"getref", Jim_GetrefCoreCommand
},
15494 {"setref", Jim_SetrefCoreCommand
},
15495 {"finalize", Jim_FinalizeCoreCommand
},
15496 {"collect", Jim_CollectCoreCommand
},
15498 {"rename", Jim_RenameCoreCommand
},
15499 {"dict", Jim_DictCoreCommand
},
15500 {"subst", Jim_SubstCoreCommand
},
15501 {"info", Jim_InfoCoreCommand
},
15502 {"exists", Jim_ExistsCoreCommand
},
15503 {"split", Jim_SplitCoreCommand
},
15504 {"join", Jim_JoinCoreCommand
},
15505 {"format", Jim_FormatCoreCommand
},
15506 {"scan", Jim_ScanCoreCommand
},
15507 {"error", Jim_ErrorCoreCommand
},
15508 {"lrange", Jim_LrangeCoreCommand
},
15509 {"lrepeat", Jim_LrepeatCoreCommand
},
15510 {"env", Jim_EnvCoreCommand
},
15511 {"source", Jim_SourceCoreCommand
},
15512 {"lreverse", Jim_LreverseCoreCommand
},
15513 {"range", Jim_RangeCoreCommand
},
15514 {"rand", Jim_RandCoreCommand
},
15515 {"tailcall", Jim_TailcallCoreCommand
},
15516 {"local", Jim_LocalCoreCommand
},
15517 {"upcall", Jim_UpcallCoreCommand
},
15518 {"apply", Jim_ApplyCoreCommand
},
15522 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15526 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15527 Jim_CreateCommand(interp
,
15528 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15533 /* -----------------------------------------------------------------------------
15534 * Interactive prompt
15535 * ---------------------------------------------------------------------------*/
15536 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15540 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15541 argv
[1] = interp
->result
;
15543 Jim_EvalObjVector(interp
, 2, argv
);
15547 * Given a null terminated array of strings, returns an allocated, sorted
15548 * copy of the array.
15550 static char **JimSortStringTable(const char *const *tablePtr
)
15553 char **tablePtrSorted
;
15555 /* Find the size of the table */
15556 for (count
= 0; tablePtr
[count
]; count
++) {
15559 /* Allocate one extra for the terminating NULL pointer */
15560 tablePtrSorted
= Jim_Alloc(sizeof(char *) * (count
+ 1));
15561 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15562 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15563 tablePtrSorted
[count
] = NULL
;
15565 return tablePtrSorted
;
15568 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15569 const char *prefix
, const char *const *tablePtr
, const char *name
)
15571 char **tablePtrSorted
;
15574 if (name
== NULL
) {
15578 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15579 tablePtrSorted
= JimSortStringTable(tablePtr
);
15580 for (i
= 0; tablePtrSorted
[i
]; i
++) {
15581 if (tablePtrSorted
[i
+ 1] == NULL
&& i
> 0) {
15582 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15584 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15585 if (tablePtrSorted
[i
+ 1]) {
15586 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15589 Jim_Free(tablePtrSorted
);
15594 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15595 * and returns JIM_OK.
15597 * Otherwise returns JIM_ERR.
15599 int Jim_CheckShowCommands(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *const *tablePtr
)
15601 if (Jim_CompareStringImmediate(interp
, objPtr
, "-commands")) {
15603 char **tablePtrSorted
= JimSortStringTable(tablePtr
);
15604 Jim_SetResult(interp
, Jim_NewListObj(interp
, NULL
, 0));
15605 for (i
= 0; tablePtrSorted
[i
]; i
++) {
15606 Jim_ListAppendElement(interp
, Jim_GetResult(interp
), Jim_NewStringObj(interp
, tablePtrSorted
[i
], -1));
15608 Jim_Free(tablePtrSorted
);
15614 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15615 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15617 const char *bad
= "bad ";
15618 const char *const *entryPtr
= NULL
;
15622 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15626 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15627 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15628 /* Found an exact match */
15632 if (flags
& JIM_ENUM_ABBREV
) {
15633 /* Accept an unambiguous abbreviation.
15634 * Note that '-' doesnt' consitute a valid abbreviation
15636 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15637 if (*arg
== '-' && arglen
== 1) {
15641 bad
= "ambiguous ";
15649 /* If we had an unambiguous partial match */
15656 if (flags
& JIM_ERRMSG
) {
15657 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15662 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15666 for (i
= 0; i
< (int)len
; i
++) {
15667 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15674 int Jim_IsDict(Jim_Obj
*objPtr
)
15676 return objPtr
->typePtr
== &dictObjType
;
15679 int Jim_IsList(Jim_Obj
*objPtr
)
15681 return objPtr
->typePtr
== &listObjType
;
15685 * Very simple printf-like formatting, designed for error messages.
15687 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15688 * The resulting string is created and set as the result.
15690 * Each '%s' should correspond to a regular string parameter.
15691 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15692 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15694 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15696 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15698 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15700 /* Initial space needed */
15701 int len
= strlen(format
);
15704 const char *params
[5];
15709 va_start(args
, format
);
15711 for (i
= 0; i
< len
&& n
< 5; i
++) {
15714 if (strncmp(format
+ i
, "%s", 2) == 0) {
15715 params
[n
] = va_arg(args
, char *);
15717 l
= strlen(params
[n
]);
15719 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15720 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15722 params
[n
] = Jim_GetString(objPtr
, &l
);
15725 if (format
[i
] == '%') {
15735 buf
= Jim_Alloc(len
+ 1);
15736 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15740 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15744 #ifndef jim_ext_package
15745 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15750 #ifndef jim_ext_aio
15751 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15753 Jim_SetResultString(interp
, "aio not enabled", -1);
15760 * Local Variables: ***
15761 * c-basic-offset: 4 ***