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 */
45 #define _GNU_SOURCE /* Mostly just for environ */
61 #include "jimautoconf.h"
64 #ifdef HAVE_SYS_TIME_H
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
74 /* For INFINITY, even if math functions are not enabled */
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
82 #define TCL_LIBRARY "."
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type
);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition
, const char *fmt
, ...);
116 #define JimPanic(X) JimPanicDump X
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
124 #define JIM_IF_OPTIM(X)
127 /* -----------------------------------------------------------------------------
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep
[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
);
139 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int listindex
, Jim_Obj
*newObjPtr
,
141 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
);
142 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
143 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
144 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
);
145 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
146 const char *prefix
, const char *const *tablePtr
, const char *name
);
147 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
);
148 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
149 static int JimSign(jim_wide w
);
150 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
);
151 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
);
152 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s
, int *uc
, int upper
)
162 int l
= utf8_tounicode(s
, uc
);
164 *uc
= utf8_upper(*uc
);
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern
, int c
, int flags
)
196 if (flags
& JIM_NOCASE
) {
201 if (flags
& JIM_CHARSET_SCAN
) {
202 if (*pattern
== '^') {
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern
== ']') {
213 while (*pattern
&& *pattern
!= ']') {
215 if (pattern
[0] == '\\') {
217 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
220 /* Is this a range? a-z */
224 pattern
+= utf8_tounicode_case(pattern
, &start
, nocase
);
225 if (pattern
[0] == '-' && pattern
[1]) {
227 pattern
+= utf8_tounicode(pattern
, &pchar
);
228 pattern
+= utf8_tounicode_case(pattern
, &end
, nocase
);
230 /* Handle reversed range too */
231 if ((c
>= start
&& c
<= end
) || (c
>= end
&& c
<= start
)) {
247 return match
? pattern
: NULL
;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern
, const char *string
, int nocase
)
259 switch (pattern
[0]) {
261 while (pattern
[1] == '*') {
266 return 1; /* match */
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern
, string
, nocase
))
271 return 1; /* match */
272 string
+= utf8_tounicode(string
, &c
);
274 return 0; /* no match */
277 string
+= utf8_tounicode(string
, &c
);
281 string
+= utf8_tounicode(string
, &c
);
282 pattern
= JimCharsetMatch(pattern
+ 1, c
, nocase
? JIM_NOCASE
: 0);
287 /* Ran out of pattern (no ']') */
298 string
+= utf8_tounicode_case(string
, &c
, nocase
);
299 utf8_tounicode_case(pattern
, &pchar
, nocase
);
305 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
307 while (*pattern
== '*') {
313 if (!*pattern
&& !*string
) {
320 * string comparison. Works on binary data.
324 * Note that the lengths are byte lengths, not char lengths.
326 static int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
)
329 return memcmp(s1
, s2
, l1
) <= 0 ? -1 : 1;
332 return memcmp(s1
, s2
, l2
) >= 0 ? 1 : -1;
335 return JimSign(memcmp(s1
, s2
, l1
));
340 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
341 * (or end of string if 'maxchars' is -1).
343 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
345 * Note: does not support embedded nulls.
347 static int JimStringCompareLen(const char *s1
, const char *s2
, int maxchars
, int nocase
)
349 while (*s1
&& *s2
&& maxchars
) {
351 s1
+= utf8_tounicode_case(s1
, &c1
, nocase
);
352 s2
+= utf8_tounicode_case(s2
, &c2
, nocase
);
354 return JimSign(c1
- c2
);
361 /* One string or both terminated */
371 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
372 * The index of the first occurrence of s1 in s2 is returned.
373 * If s1 is not found inside s2, -1 is returned. */
374 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int idx
)
379 if (!l1
|| !l2
|| l1
> l2
) {
384 s2
+= utf8_index(s2
, idx
);
386 l1bytelen
= utf8_index(s1
, l1
);
388 for (i
= idx
; i
<= l2
- l1
; i
++) {
390 if (memcmp(s2
, s1
, l1bytelen
) == 0) {
393 s2
+= utf8_tounicode(s2
, &c
);
399 * Note: Lengths and return value are in bytes, not chars.
401 static int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
405 if (!l1
|| !l2
|| l1
> l2
)
408 /* Now search for the needle */
409 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
410 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
419 * Note: Lengths and return value are in chars.
421 static int JimStringLastUtf8(const char *s1
, int l1
, const char *s2
, int l2
)
423 int n
= JimStringLast(s1
, utf8_index(s1
, l1
), s2
, utf8_index(s2
, l2
));
425 n
= utf8_strlen(s2
, n
);
432 * After an strtol()/strtod()-like conversion,
433 * check whether something was converted and that
434 * the only thing left is white space.
436 * Returns JIM_OK or JIM_ERR.
438 static int JimCheckConversion(const char *str
, const char *endptr
)
440 if (str
[0] == '\0' || str
== endptr
) {
444 if (endptr
[0] != '\0') {
446 if (!isspace(UCHAR(*endptr
))) {
455 /* Parses the front of a number to determine it's sign and base
456 * Returns the index to start parsing according to the given base
458 static int JimNumberBase(const char *str
, int *base
, int *sign
)
464 while (isspace(UCHAR(str
[i
]))) {
484 /* We have 0<x>, so see if we can convert it */
485 switch (str
[i
+ 1]) {
486 case 'x': case 'X': *base
= 16; break;
487 case 'o': case 'O': *base
= 8; break;
488 case 'b': case 'B': *base
= 2; break;
492 /* Ensure that (e.g.) 0x-5 fails to parse */
493 if (str
[i
] != '-' && str
[i
] != '+' && !isspace(UCHAR(str
[i
]))) {
494 /* Parse according to this base */
497 /* Parse as base 10 */
502 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
503 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
505 static long jim_strtol(const char *str
, char **endptr
)
509 int i
= JimNumberBase(str
, &base
, &sign
);
512 long value
= strtol(str
+ i
, endptr
, base
);
513 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
518 /* Can just do a regular base-10 conversion */
519 return strtol(str
, endptr
, 10);
523 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
524 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
526 static jim_wide
jim_strtoull(const char *str
, char **endptr
)
528 #ifdef HAVE_LONG_LONG
531 int i
= JimNumberBase(str
, &base
, &sign
);
534 jim_wide value
= strtoull(str
+ i
, endptr
, base
);
535 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
540 /* Can just do a regular base-10 conversion */
541 return strtoull(str
, endptr
, 10);
543 return (unsigned long)jim_strtol(str
, endptr
);
547 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
552 *widePtr
= strtoull(str
, &endptr
, base
);
555 *widePtr
= jim_strtoull(str
, &endptr
);
558 return JimCheckConversion(str
, endptr
);
561 int Jim_StringToDouble(const char *str
, double *doublePtr
)
565 /* Callers can check for underflow via ERANGE */
568 *doublePtr
= strtod(str
, &endptr
);
570 return JimCheckConversion(str
, endptr
);
573 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
586 /* Only special case is -1 ^ -n
604 /* -----------------------------------------------------------------------------
606 * ---------------------------------------------------------------------------*/
607 #ifdef JIM_DEBUG_PANIC
608 static void JimPanicDump(int condition
, const char *fmt
, ...)
618 fprintf(stderr
, "\nJIM INTERPRETER PANIC: ");
619 vfprintf(stderr
, fmt
, ap
);
620 fprintf(stderr
, "\n\n");
623 #ifdef HAVE_BACKTRACE
629 size
= backtrace(array
, 40);
630 strings
= backtrace_symbols(array
, size
);
631 for (i
= 0; i
< size
; i
++)
632 fprintf(stderr
, "[backtrace] %s\n", strings
[i
]);
633 fprintf(stderr
, "[backtrace] Include the above lines and the output\n");
634 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report.\n");
642 /* -----------------------------------------------------------------------------
644 * ---------------------------------------------------------------------------*/
646 void *Jim_Alloc(int size
)
648 return size
? malloc(size
) : NULL
;
651 void Jim_Free(void *ptr
)
656 void *Jim_Realloc(void *ptr
, int size
)
658 return realloc(ptr
, size
);
661 char *Jim_StrDup(const char *s
)
666 char *Jim_StrDupLen(const char *s
, int l
)
668 char *copy
= Jim_Alloc(l
+ 1);
670 memcpy(copy
, s
, l
+ 1);
671 copy
[l
] = 0; /* Just to be sure, original could be substring */
675 /* -----------------------------------------------------------------------------
676 * Time related functions
677 * ---------------------------------------------------------------------------*/
679 /* Returns current time in microseconds */
680 static jim_wide
JimClock(void)
684 gettimeofday(&tv
, NULL
);
685 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
688 /* -----------------------------------------------------------------------------
690 * ---------------------------------------------------------------------------*/
692 /* -------------------------- private prototypes ---------------------------- */
693 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
694 static unsigned int JimHashTableNextPower(unsigned int size
);
695 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
);
697 /* -------------------------- hash functions -------------------------------- */
699 /* Thomas Wang's 32 bit Mix Function */
700 unsigned int Jim_IntHashFunction(unsigned int key
)
711 /* Generic hash function (we are using to multiply by 9 and add the byte
713 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
718 h
+= (h
<< 3) + *buf
++;
722 /* ----------------------------- API implementation ------------------------- */
724 /* reset a hashtable already initialized */
725 static void JimResetHashTable(Jim_HashTable
*ht
)
732 #ifdef JIM_RANDOMISE_HASH
733 /* This is initialised to a random value to avoid a hash collision attack.
734 * See: n.runs-SA-2011.004
736 ht
->uniq
= (rand() ^ time(NULL
) ^ clock());
742 static void JimInitHashTableIterator(Jim_HashTable
*ht
, Jim_HashTableIterator
*iter
)
747 iter
->nextEntry
= NULL
;
750 /* Initialize the hash table */
751 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
753 JimResetHashTable(ht
);
755 ht
->privdata
= privDataPtr
;
759 /* Resize the table to the minimal size that contains all the elements,
760 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
761 void Jim_ResizeHashTable(Jim_HashTable
*ht
)
763 int minimal
= ht
->used
;
765 if (minimal
< JIM_HT_INITIAL_SIZE
)
766 minimal
= JIM_HT_INITIAL_SIZE
;
767 Jim_ExpandHashTable(ht
, minimal
);
770 /* Expand or create the hashtable */
771 void Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
773 Jim_HashTable n
; /* the new hashtable */
774 unsigned int realsize
= JimHashTableNextPower(size
), i
;
776 /* the size is invalid if it is smaller than the number of
777 * elements already inside the hashtable */
778 if (size
<= ht
->used
)
781 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
783 n
.sizemask
= realsize
- 1;
784 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
785 /* Keep the same 'uniq' as the original */
788 /* Initialize all the pointers to NULL */
789 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
791 /* Copy all the elements from the old to the new table:
792 * note that if the old hash table is empty ht->used is zero,
793 * so Jim_ExpandHashTable just creates an empty hash table. */
795 for (i
= 0; ht
->used
> 0; i
++) {
796 Jim_HashEntry
*he
, *nextHe
;
798 if (ht
->table
[i
] == NULL
)
801 /* For each hash entry on this slot... */
807 /* Get the new element index */
808 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
809 he
->next
= n
.table
[h
];
812 /* Pass to the next element */
816 assert(ht
->used
== 0);
819 /* Remap the new hashtable in the old */
823 /* Add an element to the target hash table */
824 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
826 Jim_HashEntry
*entry
;
828 /* Get the index of the new element, or -1 if
829 * the element already exists. */
830 entry
= JimInsertHashEntry(ht
, key
, 0);
834 /* Set the hash entry fields. */
835 Jim_SetHashKey(ht
, entry
, key
);
836 Jim_SetHashVal(ht
, entry
, val
);
840 /* Add an element, discarding the old if the key already exists */
841 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
844 Jim_HashEntry
*entry
;
846 /* Get the index of the new element, or -1 if
847 * the element already exists. */
848 entry
= JimInsertHashEntry(ht
, key
, 1);
850 /* It already exists, so only replace the value.
851 * Note if both a destructor and a duplicate function exist,
852 * need to dup before destroy. perhaps they are the same
853 * reference counted object
855 if (ht
->type
->valDestructor
&& ht
->type
->valDup
) {
856 void *newval
= ht
->type
->valDup(ht
->privdata
, val
);
857 ht
->type
->valDestructor(ht
->privdata
, entry
->u
.val
);
858 entry
->u
.val
= newval
;
861 Jim_FreeEntryVal(ht
, entry
);
862 Jim_SetHashVal(ht
, entry
, val
);
867 /* Doesn't exist, so set the key */
868 Jim_SetHashKey(ht
, entry
, key
);
869 Jim_SetHashVal(ht
, entry
, val
);
876 /* Search and remove an element */
877 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
880 Jim_HashEntry
*he
, *prevHe
;
884 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
889 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
890 /* Unlink the element from the list */
892 prevHe
->next
= he
->next
;
894 ht
->table
[h
] = he
->next
;
895 Jim_FreeEntryKey(ht
, he
);
896 Jim_FreeEntryVal(ht
, he
);
904 return JIM_ERR
; /* not found */
907 /* Destroy an entire hash table and leave it ready for reuse */
908 int Jim_FreeHashTable(Jim_HashTable
*ht
)
912 /* Free all the elements */
913 for (i
= 0; ht
->used
> 0; i
++) {
914 Jim_HashEntry
*he
, *nextHe
;
916 if ((he
= ht
->table
[i
]) == NULL
)
920 Jim_FreeEntryKey(ht
, he
);
921 Jim_FreeEntryVal(ht
, he
);
927 /* Free the table and the allocated cache structure */
929 /* Re-initialize the table */
930 JimResetHashTable(ht
);
931 return JIM_OK
; /* never fails */
934 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
941 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
944 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
951 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
953 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
954 JimInitHashTableIterator(ht
, iter
);
958 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
961 if (iter
->entry
== NULL
) {
963 if (iter
->index
>= (signed)iter
->ht
->size
)
965 iter
->entry
= iter
->ht
->table
[iter
->index
];
968 iter
->entry
= iter
->nextEntry
;
971 /* We need to save the 'next' here, the iterator user
972 * may delete the entry we are returning. */
973 iter
->nextEntry
= iter
->entry
->next
;
980 /* ------------------------- private functions ------------------------------ */
982 /* Expand the hash table if needed */
983 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
985 /* If the hash table is empty expand it to the intial size,
986 * if the table is "full" dobule its size. */
988 Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
989 if (ht
->size
== ht
->used
)
990 Jim_ExpandHashTable(ht
, ht
->size
* 2);
993 /* Our hash table capability is a power of two */
994 static unsigned int JimHashTableNextPower(unsigned int size
)
996 unsigned int i
= JIM_HT_INITIAL_SIZE
;
998 if (size
>= 2147483648U)
1007 /* Returns the index of a free slot that can be populated with
1008 * a hash entry for the given 'key'.
1009 * If the key already exists, -1 is returned. */
1010 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
)
1015 /* Expand the hashtable if needed */
1016 JimExpandHashTableIfNeeded(ht
);
1018 /* Compute the key hash value */
1019 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
1020 /* Search if this slot does not already contain the given key */
1023 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
1024 return replace
? he
: NULL
;
1028 /* Allocates the memory and stores key */
1029 he
= Jim_Alloc(sizeof(*he
));
1030 he
->next
= ht
->table
[h
];
1038 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1040 static unsigned int JimStringCopyHTHashFunction(const void *key
)
1042 return Jim_GenHashFunction(key
, strlen(key
));
1045 static void *JimStringCopyHTDup(void *privdata
, const void *key
)
1047 return Jim_StrDup(key
);
1050 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
1052 return strcmp(key1
, key2
) == 0;
1055 static void JimStringCopyHTKeyDestructor(void *privdata
, void *key
)
1060 static const Jim_HashTableType JimPackageHashTableType
= {
1061 JimStringCopyHTHashFunction
, /* hash function */
1062 JimStringCopyHTDup
, /* key dup */
1064 JimStringCopyHTKeyCompare
, /* key compare */
1065 JimStringCopyHTKeyDestructor
, /* key destructor */
1066 NULL
/* val destructor */
1069 typedef struct AssocDataValue
1071 Jim_InterpDeleteProc
*delProc
;
1075 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1077 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
1079 if (assocPtr
->delProc
!= NULL
)
1080 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1084 static const Jim_HashTableType JimAssocDataHashTableType
= {
1085 JimStringCopyHTHashFunction
, /* hash function */
1086 JimStringCopyHTDup
, /* key dup */
1088 JimStringCopyHTKeyCompare
, /* key compare */
1089 JimStringCopyHTKeyDestructor
, /* key destructor */
1090 JimAssocDataHashTableValueDestructor
/* val destructor */
1093 /* -----------------------------------------------------------------------------
1094 * Stack - This is a simple generic stack implementation. It is used for
1095 * example in the 'expr' expression compiler.
1096 * ---------------------------------------------------------------------------*/
1097 void Jim_InitStack(Jim_Stack
*stack
)
1101 stack
->vector
= NULL
;
1104 void Jim_FreeStack(Jim_Stack
*stack
)
1106 Jim_Free(stack
->vector
);
1109 int Jim_StackLen(Jim_Stack
*stack
)
1114 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
1116 int neededLen
= stack
->len
+ 1;
1118 if (neededLen
> stack
->maxlen
) {
1119 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
1120 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
1122 stack
->vector
[stack
->len
] = element
;
1126 void *Jim_StackPop(Jim_Stack
*stack
)
1128 if (stack
->len
== 0)
1131 return stack
->vector
[stack
->len
];
1134 void *Jim_StackPeek(Jim_Stack
*stack
)
1136 if (stack
->len
== 0)
1138 return stack
->vector
[stack
->len
- 1];
1141 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
1145 for (i
= 0; i
< stack
->len
; i
++)
1146 freeFunc(stack
->vector
[i
]);
1149 /* -----------------------------------------------------------------------------
1151 * ---------------------------------------------------------------------------*/
1154 #define JIM_TT_NONE 0 /* No token returned */
1155 #define JIM_TT_STR 1 /* simple string */
1156 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1157 #define JIM_TT_VAR 3 /* var substitution */
1158 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1159 #define JIM_TT_CMD 5 /* command substitution */
1160 /* Note: Keep these three together for TOKEN_IS_SEP() */
1161 #define JIM_TT_SEP 6 /* word separator (white space) */
1162 #define JIM_TT_EOL 7 /* line separator */
1163 #define JIM_TT_EOF 8 /* end of script */
1165 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1166 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1168 /* Additional token types needed for expressions */
1169 #define JIM_TT_SUBEXPR_START 11
1170 #define JIM_TT_SUBEXPR_END 12
1171 #define JIM_TT_SUBEXPR_COMMA 13
1172 #define JIM_TT_EXPR_INT 14
1173 #define JIM_TT_EXPR_DOUBLE 15
1174 #define JIM_TT_EXPR_BOOLEAN 16
1176 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1178 /* Operator token types start here */
1179 #define JIM_TT_EXPR_OP 20
1181 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1182 /* Can this token start an expression? */
1183 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1184 /* Is this token an expression operator? */
1185 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1188 * Results of missing quotes, braces, etc. from parsing.
1190 struct JimParseMissing
{
1191 int ch
; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1192 int line
; /* Line number starting the missing token */
1195 /* Parser context structure. The same context is used both to parse
1196 * Tcl scripts and lists. */
1199 const char *p
; /* Pointer to the point of the program we are parsing */
1200 int len
; /* Remaining length */
1201 int linenr
; /* Current line number */
1203 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1204 int tline
; /* Line number of the returned token */
1205 int tt
; /* Token type */
1206 int eof
; /* Non zero if EOF condition is true. */
1207 int inquote
; /* Parsing a quoted string */
1208 int comment
; /* Non zero if the next chars may be a comment. */
1209 struct JimParseMissing missing
; /* Details of any missing quotes, etc. */
1212 static int JimParseScript(struct JimParserCtx
*pc
);
1213 static int JimParseSep(struct JimParserCtx
*pc
);
1214 static int JimParseEol(struct JimParserCtx
*pc
);
1215 static int JimParseCmd(struct JimParserCtx
*pc
);
1216 static int JimParseQuote(struct JimParserCtx
*pc
);
1217 static int JimParseVar(struct JimParserCtx
*pc
);
1218 static int JimParseBrace(struct JimParserCtx
*pc
);
1219 static int JimParseStr(struct JimParserCtx
*pc
);
1220 static int JimParseComment(struct JimParserCtx
*pc
);
1221 static void JimParseSubCmd(struct JimParserCtx
*pc
);
1222 static int JimParseSubQuote(struct JimParserCtx
*pc
);
1223 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
1225 /* Initialize a parser context.
1226 * 'prg' is a pointer to the program text, linenr is the line
1227 * number of the first line contained in the program. */
1228 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1235 pc
->tt
= JIM_TT_NONE
;
1238 pc
->linenr
= linenr
;
1240 pc
->missing
.ch
= ' ';
1241 pc
->missing
.line
= linenr
;
1244 static int JimParseScript(struct JimParserCtx
*pc
)
1246 while (1) { /* the while is used to reiterate with continue if needed */
1249 pc
->tend
= pc
->p
- 1;
1250 pc
->tline
= pc
->linenr
;
1251 pc
->tt
= JIM_TT_EOL
;
1257 if (*(pc
->p
+ 1) == '\n' && !pc
->inquote
) {
1258 return JimParseSep(pc
);
1261 return JimParseStr(pc
);
1267 return JimParseSep(pc
);
1269 return JimParseStr(pc
);
1274 return JimParseEol(pc
);
1275 return JimParseStr(pc
);
1278 return JimParseCmd(pc
);
1281 if (JimParseVar(pc
) == JIM_ERR
) {
1282 /* An orphan $. Create as a separate token */
1283 pc
->tstart
= pc
->tend
= pc
->p
++;
1285 pc
->tt
= JIM_TT_ESC
;
1290 JimParseComment(pc
);
1293 return JimParseStr(pc
);
1296 return JimParseStr(pc
);
1302 static int JimParseSep(struct JimParserCtx
*pc
)
1305 pc
->tline
= pc
->linenr
;
1306 while (isspace(UCHAR(*pc
->p
)) || (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1307 if (*pc
->p
== '\n') {
1310 if (*pc
->p
== '\\') {
1318 pc
->tend
= pc
->p
- 1;
1319 pc
->tt
= JIM_TT_SEP
;
1323 static int JimParseEol(struct JimParserCtx
*pc
)
1326 pc
->tline
= pc
->linenr
;
1327 while (isspace(UCHAR(*pc
->p
)) || *pc
->p
== ';') {
1333 pc
->tend
= pc
->p
- 1;
1334 pc
->tt
= JIM_TT_EOL
;
1339 ** Here are the rules for parsing:
1340 ** {braced expression}
1341 ** - Count open and closing braces
1342 ** - Backslash escapes meaning of braces
1344 ** "quoted expression"
1345 ** - First double quote at start of word terminates the expression
1346 ** - Backslash escapes quote and bracket
1347 ** - [commands brackets] are counted/nested
1348 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1350 ** [command expression]
1351 ** - Count open and closing brackets
1352 ** - Backslash escapes quote, bracket and brace
1353 ** - [commands brackets] are counted/nested
1354 ** - "quoted expressions" are parsed according to quoting rules
1355 ** - {braced expressions} are parsed according to brace rules
1357 ** For everything, backslash escapes the next char, newline increments current line
1361 * Parses a braced expression starting at pc->p.
1363 * Positions the parser at the end of the braced expression,
1364 * sets pc->tend and possibly pc->missing.
1366 static void JimParseSubBrace(struct JimParserCtx
*pc
)
1370 /* Skip the brace */
1377 if (*++pc
->p
== '\n') {
1390 pc
->tend
= pc
->p
- 1;
1404 pc
->missing
.ch
= '{';
1405 pc
->missing
.line
= pc
->tline
;
1406 pc
->tend
= pc
->p
- 1;
1410 * Parses a quoted expression starting at pc->p.
1412 * Positions the parser at the end of the quoted expression,
1413 * sets pc->tend and possibly pc->missing.
1415 * Returns the type of the token of the string,
1416 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1419 static int JimParseSubQuote(struct JimParserCtx
*pc
)
1421 int tt
= JIM_TT_STR
;
1422 int line
= pc
->tline
;
1424 /* Skip the quote */
1431 if (*++pc
->p
== '\n') {
1440 pc
->tend
= pc
->p
- 1;
1461 pc
->missing
.ch
= '"';
1462 pc
->missing
.line
= line
;
1463 pc
->tend
= pc
->p
- 1;
1468 * Parses a [command] expression starting at pc->p.
1470 * Positions the parser at the end of the command expression,
1471 * sets pc->tend and possibly pc->missing.
1473 static void JimParseSubCmd(struct JimParserCtx
*pc
)
1476 int startofword
= 1;
1477 int line
= pc
->tline
;
1479 /* Skip the bracket */
1486 if (*++pc
->p
== '\n') {
1499 pc
->tend
= pc
->p
- 1;
1508 JimParseSubQuote(pc
);
1514 JimParseSubBrace(pc
);
1522 startofword
= isspace(UCHAR(*pc
->p
));
1526 pc
->missing
.ch
= '[';
1527 pc
->missing
.line
= line
;
1528 pc
->tend
= pc
->p
- 1;
1531 static int JimParseBrace(struct JimParserCtx
*pc
)
1533 pc
->tstart
= pc
->p
+ 1;
1534 pc
->tline
= pc
->linenr
;
1535 pc
->tt
= JIM_TT_STR
;
1536 JimParseSubBrace(pc
);
1540 static int JimParseCmd(struct JimParserCtx
*pc
)
1542 pc
->tstart
= pc
->p
+ 1;
1543 pc
->tline
= pc
->linenr
;
1544 pc
->tt
= JIM_TT_CMD
;
1549 static int JimParseQuote(struct JimParserCtx
*pc
)
1551 pc
->tstart
= pc
->p
+ 1;
1552 pc
->tline
= pc
->linenr
;
1553 pc
->tt
= JimParseSubQuote(pc
);
1557 static int JimParseVar(struct JimParserCtx
*pc
)
1563 #ifdef EXPRSUGAR_BRACKET
1564 if (*pc
->p
== '[') {
1565 /* Parse $[...] expr shorthand syntax */
1567 pc
->tt
= JIM_TT_EXPRSUGAR
;
1573 pc
->tt
= JIM_TT_VAR
;
1574 pc
->tline
= pc
->linenr
;
1576 if (*pc
->p
== '{') {
1577 pc
->tstart
= ++pc
->p
;
1580 while (pc
->len
&& *pc
->p
!= '}') {
1581 if (*pc
->p
== '\n') {
1587 pc
->tend
= pc
->p
- 1;
1595 /* Skip double colon, but not single colon! */
1596 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
1597 while (*pc
->p
== ':') {
1603 /* Note that any char >= 0x80 must be part of a utf-8 char.
1604 * We consider all unicode points outside of ASCII as letters
1606 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_' || UCHAR(*pc
->p
) >= 0x80) {
1613 /* Parse [dict get] syntax sugar. */
1614 if (*pc
->p
== '(') {
1616 const char *paren
= NULL
;
1618 pc
->tt
= JIM_TT_DICTSUGAR
;
1620 while (count
&& pc
->len
) {
1623 if (*pc
->p
== '\\' && pc
->len
>= 1) {
1627 else if (*pc
->p
== '(') {
1630 else if (*pc
->p
== ')') {
1640 /* Did not find a matching paren. Back up */
1642 pc
->len
+= (pc
->p
- paren
);
1645 #ifndef EXPRSUGAR_BRACKET
1646 if (*pc
->tstart
== '(') {
1647 pc
->tt
= JIM_TT_EXPRSUGAR
;
1651 pc
->tend
= pc
->p
- 1;
1653 /* Check if we parsed just the '$' character.
1654 * That's not a variable so an error is returned
1655 * to tell the state machine to consider this '$' just
1657 if (pc
->tstart
== pc
->p
) {
1665 static int JimParseStr(struct JimParserCtx
*pc
)
1667 if (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1668 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
) {
1669 /* Starting a new word */
1670 if (*pc
->p
== '{') {
1671 return JimParseBrace(pc
);
1673 if (*pc
->p
== '"') {
1677 /* In case the end quote is missing */
1678 pc
->missing
.line
= pc
->tline
;
1682 pc
->tline
= pc
->linenr
;
1686 pc
->missing
.ch
= '"';
1688 pc
->tend
= pc
->p
- 1;
1689 pc
->tt
= JIM_TT_ESC
;
1694 if (!pc
->inquote
&& *(pc
->p
+ 1) == '\n') {
1695 pc
->tend
= pc
->p
- 1;
1696 pc
->tt
= JIM_TT_ESC
;
1700 if (*(pc
->p
+ 1) == '\n') {
1706 else if (pc
->len
== 1) {
1707 /* End of script with trailing backslash */
1708 pc
->missing
.ch
= '\\';
1712 /* If the following token is not '$' just keep going */
1713 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1718 /* Only need a separate ')' token if the previous was a var */
1719 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1720 if (pc
->p
== pc
->tstart
) {
1721 /* At the start of the token, so just return this char */
1725 pc
->tend
= pc
->p
- 1;
1726 pc
->tt
= JIM_TT_ESC
;
1733 pc
->tend
= pc
->p
- 1;
1734 pc
->tt
= JIM_TT_ESC
;
1743 pc
->tend
= pc
->p
- 1;
1744 pc
->tt
= JIM_TT_ESC
;
1747 else if (*pc
->p
== '\n') {
1753 pc
->tend
= pc
->p
- 1;
1754 pc
->tt
= JIM_TT_ESC
;
1765 return JIM_OK
; /* unreached */
1768 static int JimParseComment(struct JimParserCtx
*pc
)
1771 if (*pc
->p
== '\\') {
1775 pc
->missing
.ch
= '\\';
1778 if (*pc
->p
== '\n') {
1782 else if (*pc
->p
== '\n') {
1794 /* xdigitval and odigitval are helper functions for JimEscape() */
1795 static int xdigitval(int c
)
1797 if (c
>= '0' && c
<= '9')
1799 if (c
>= 'a' && c
<= 'f')
1800 return c
- 'a' + 10;
1801 if (c
>= 'A' && c
<= 'F')
1802 return c
- 'A' + 10;
1806 static int odigitval(int c
)
1808 if (c
>= '0' && c
<= '7')
1813 /* Perform Tcl escape substitution of 's', storing the result
1814 * string into 'dest'. The escaped string is guaranteed to
1815 * be the same length or shorted than the source string.
1816 * Slen is the length of the string at 's'.
1818 * The function returns the length of the resulting string. */
1819 static int JimEscape(char *dest
, const char *s
, int slen
)
1824 for (i
= 0; i
< slen
; i
++) {
1855 /* A unicode or hex sequence.
1856 * \x Expect 1-2 hex chars and convert to hex.
1857 * \u Expect 1-4 hex chars and convert to utf-8.
1858 * \U Expect 1-8 hex chars and convert to utf-8.
1859 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1860 * An invalid sequence means simply the escaped char.
1872 else if (s
[i
] == 'u') {
1873 if (s
[i
+ 1] == '{') {
1882 for (k
= 0; k
< maxchars
; k
++) {
1883 int c
= xdigitval(s
[i
+ k
+ 1]);
1887 val
= (val
<< 4) | c
;
1889 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1891 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1897 /* Skip the closing brace */
1902 /* Got a valid sequence, so convert */
1907 p
+= utf8_fromunicode(p
, val
);
1912 /* Not a valid codepoint, just an escaped char */
1925 /* Replace all spaces and tabs after backslash newline with a single space*/
1929 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1942 int c
= odigitval(s
[i
+ 1]);
1945 c
= odigitval(s
[i
+ 2]);
1951 val
= (val
* 8) + c
;
1952 c
= odigitval(s
[i
+ 3]);
1958 val
= (val
* 8) + c
;
1979 /* Returns a dynamically allocated copy of the current token in the
1980 * parser context. The function performs conversion of escapes if
1981 * the token is of type JIM_TT_ESC.
1983 * Note that after the conversion, tokens that are grouped with
1984 * braces in the source code, are always recognizable from the
1985 * identical string obtained in a different way from the type.
1987 * For example the string:
1991 * will return as first token "*", of type JIM_TT_STR
1997 * will return as first token "*", of type JIM_TT_ESC
1999 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
2001 const char *start
, *end
;
2009 token
= Jim_Alloc(1);
2013 len
= (end
- start
) + 1;
2014 token
= Jim_Alloc(len
+ 1);
2015 if (pc
->tt
!= JIM_TT_ESC
) {
2016 /* No escape conversion needed? Just copy it. */
2017 memcpy(token
, start
, len
);
2021 /* Else convert the escape chars. */
2022 len
= JimEscape(token
, start
, len
);
2026 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
2029 /* -----------------------------------------------------------------------------
2031 * ---------------------------------------------------------------------------*/
2032 static int JimParseListSep(struct JimParserCtx
*pc
);
2033 static int JimParseListStr(struct JimParserCtx
*pc
);
2034 static int JimParseListQuote(struct JimParserCtx
*pc
);
2036 static int JimParseList(struct JimParserCtx
*pc
)
2038 if (isspace(UCHAR(*pc
->p
))) {
2039 return JimParseListSep(pc
);
2043 return JimParseListQuote(pc
);
2046 return JimParseBrace(pc
);
2050 return JimParseListStr(pc
);
2055 pc
->tstart
= pc
->tend
= pc
->p
;
2056 pc
->tline
= pc
->linenr
;
2057 pc
->tt
= JIM_TT_EOL
;
2062 static int JimParseListSep(struct JimParserCtx
*pc
)
2065 pc
->tline
= pc
->linenr
;
2066 while (isspace(UCHAR(*pc
->p
))) {
2067 if (*pc
->p
== '\n') {
2073 pc
->tend
= pc
->p
- 1;
2074 pc
->tt
= JIM_TT_SEP
;
2078 static int JimParseListQuote(struct JimParserCtx
*pc
)
2084 pc
->tline
= pc
->linenr
;
2085 pc
->tt
= JIM_TT_STR
;
2090 pc
->tt
= JIM_TT_ESC
;
2091 if (--pc
->len
== 0) {
2092 /* Trailing backslash */
2102 pc
->tend
= pc
->p
- 1;
2111 pc
->tend
= pc
->p
- 1;
2115 static int JimParseListStr(struct JimParserCtx
*pc
)
2118 pc
->tline
= pc
->linenr
;
2119 pc
->tt
= JIM_TT_STR
;
2122 if (isspace(UCHAR(*pc
->p
))) {
2123 pc
->tend
= pc
->p
- 1;
2126 if (*pc
->p
== '\\') {
2127 if (--pc
->len
== 0) {
2128 /* Trailing backslash */
2132 pc
->tt
= JIM_TT_ESC
;
2138 pc
->tend
= pc
->p
- 1;
2142 /* -----------------------------------------------------------------------------
2143 * Jim_Obj related functions
2144 * ---------------------------------------------------------------------------*/
2146 /* Return a new initialized object. */
2147 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2151 /* -- Check if there are objects in the free list -- */
2152 if (interp
->freeList
!= NULL
) {
2153 /* -- Unlink the object from the free list -- */
2154 objPtr
= interp
->freeList
;
2155 interp
->freeList
= objPtr
->nextObjPtr
;
2158 /* -- No ready to use objects: allocate a new one -- */
2159 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2162 /* Object is returned with refCount of 0. Every
2163 * kind of GC implemented should take care to don't try
2164 * to scan objects with refCount == 0. */
2165 objPtr
->refCount
= 0;
2166 /* All the other fields are left not initialized to save time.
2167 * The caller will probably want to set them to the right
2170 /* -- Put the object into the live list -- */
2171 objPtr
->prevObjPtr
= NULL
;
2172 objPtr
->nextObjPtr
= interp
->liveList
;
2173 if (interp
->liveList
)
2174 interp
->liveList
->prevObjPtr
= objPtr
;
2175 interp
->liveList
= objPtr
;
2180 /* Free an object. Actually objects are never freed, but
2181 * just moved to the free objects list, where they will be
2182 * reused by Jim_NewObj(). */
2183 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2185 /* Check if the object was already freed, panic. */
2186 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2187 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2189 /* Free the internal representation */
2190 Jim_FreeIntRep(interp
, objPtr
);
2191 /* Free the string representation */
2192 if (objPtr
->bytes
!= NULL
) {
2193 if (objPtr
->bytes
!= JimEmptyStringRep
)
2194 Jim_Free(objPtr
->bytes
);
2196 /* Unlink the object from the live objects list */
2197 if (objPtr
->prevObjPtr
)
2198 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2199 if (objPtr
->nextObjPtr
)
2200 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2201 if (interp
->liveList
== objPtr
)
2202 interp
->liveList
= objPtr
->nextObjPtr
;
2203 #ifdef JIM_DISABLE_OBJECT_POOL
2206 /* Link the object into the free objects list */
2207 objPtr
->prevObjPtr
= NULL
;
2208 objPtr
->nextObjPtr
= interp
->freeList
;
2209 if (interp
->freeList
)
2210 interp
->freeList
->prevObjPtr
= objPtr
;
2211 interp
->freeList
= objPtr
;
2212 objPtr
->refCount
= -1;
2216 /* Invalidate the string representation of an object. */
2217 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2219 if (objPtr
->bytes
!= NULL
) {
2220 if (objPtr
->bytes
!= JimEmptyStringRep
)
2221 Jim_Free(objPtr
->bytes
);
2223 objPtr
->bytes
= NULL
;
2226 /* Duplicate an object. The returned object has refcount = 0. */
2227 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2231 dupPtr
= Jim_NewObj(interp
);
2232 if (objPtr
->bytes
== NULL
) {
2233 /* Object does not have a valid string representation. */
2234 dupPtr
->bytes
= NULL
;
2236 else if (objPtr
->length
== 0) {
2237 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2238 dupPtr
->bytes
= JimEmptyStringRep
;
2240 dupPtr
->typePtr
= NULL
;
2244 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2245 dupPtr
->length
= objPtr
->length
;
2246 /* Copy the null byte too */
2247 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2250 /* By default, the new object has the same type as the old object */
2251 dupPtr
->typePtr
= objPtr
->typePtr
;
2252 if (objPtr
->typePtr
!= NULL
) {
2253 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2254 dupPtr
->internalRep
= objPtr
->internalRep
;
2257 /* The dup proc may set a different type, e.g. NULL */
2258 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2264 /* Return the string representation for objPtr. If the object's
2265 * string representation is invalid, calls the updateStringProc method to create
2266 * a new one from the internal representation of the object.
2268 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2270 if (objPtr
->bytes
== NULL
) {
2271 /* Invalid string repr. Generate it. */
2272 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2273 objPtr
->typePtr
->updateStringProc(objPtr
);
2276 *lenPtr
= objPtr
->length
;
2277 return objPtr
->bytes
;
2280 /* Just returns the length of the object's string rep */
2281 int Jim_Length(Jim_Obj
*objPtr
)
2283 if (objPtr
->bytes
== NULL
) {
2284 /* Invalid string repr. Generate it. */
2285 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2286 objPtr
->typePtr
->updateStringProc(objPtr
);
2288 return objPtr
->length
;
2291 /* Just returns object's string rep */
2292 const char *Jim_String(Jim_Obj
*objPtr
)
2294 if (objPtr
->bytes
== NULL
) {
2295 /* Invalid string repr. Generate it. */
2296 JimPanic((objPtr
->typePtr
== NULL
, "UpdateStringProc called against typeless value."));
2297 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2298 objPtr
->typePtr
->updateStringProc(objPtr
);
2300 return objPtr
->bytes
;
2303 static void JimSetStringBytes(Jim_Obj
*objPtr
, const char *str
)
2305 objPtr
->bytes
= Jim_StrDup(str
);
2306 objPtr
->length
= strlen(str
);
2309 static void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
2310 static void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2312 static const Jim_ObjType dictSubstObjType
= {
2313 "dict-substitution",
2314 FreeDictSubstInternalRep
,
2315 DupDictSubstInternalRep
,
2320 static void FreeInterpolatedInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2322 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
2325 static const Jim_ObjType interpolatedObjType
= {
2327 FreeInterpolatedInternalRep
,
2333 /* -----------------------------------------------------------------------------
2335 * ---------------------------------------------------------------------------*/
2336 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
2337 static int SetStringFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
2339 static const Jim_ObjType stringObjType
= {
2342 DupStringInternalRep
,
2344 JIM_TYPE_REFERENCES
,
2347 static void DupStringInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
2349 JIM_NOTUSED(interp
);
2351 /* This is a bit subtle: the only caller of this function
2352 * should be Jim_DuplicateObj(), that will copy the
2353 * string representaion. After the copy, the duplicated
2354 * object will not have more room in the buffer than
2355 * srcPtr->length bytes. So we just set it to length. */
2356 dupPtr
->internalRep
.strValue
.maxLength
= srcPtr
->length
;
2357 dupPtr
->internalRep
.strValue
.charLength
= srcPtr
->internalRep
.strValue
.charLength
;
2360 static int SetStringFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2362 if (objPtr
->typePtr
!= &stringObjType
) {
2363 /* Get a fresh string representation. */
2364 if (objPtr
->bytes
== NULL
) {
2365 /* Invalid string repr. Generate it. */
2366 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2367 objPtr
->typePtr
->updateStringProc(objPtr
);
2369 /* Free any other internal representation. */
2370 Jim_FreeIntRep(interp
, objPtr
);
2371 /* Set it as string, i.e. just set the maxLength field. */
2372 objPtr
->typePtr
= &stringObjType
;
2373 objPtr
->internalRep
.strValue
.maxLength
= objPtr
->length
;
2374 /* Don't know the utf-8 length yet */
2375 objPtr
->internalRep
.strValue
.charLength
= -1;
2381 * Returns the length of the object string in chars, not bytes.
2383 * These may be different for a utf-8 string.
2385 int Jim_Utf8Length(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2388 SetStringFromAny(interp
, objPtr
);
2390 if (objPtr
->internalRep
.strValue
.charLength
< 0) {
2391 objPtr
->internalRep
.strValue
.charLength
= utf8_strlen(objPtr
->bytes
, objPtr
->length
);
2393 return objPtr
->internalRep
.strValue
.charLength
;
2395 return Jim_Length(objPtr
);
2399 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2400 Jim_Obj
*Jim_NewStringObj(Jim_Interp
*interp
, const char *s
, int len
)
2402 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2404 /* Need to find out how many bytes the string requires */
2407 /* Alloc/Set the string rep. */
2409 objPtr
->bytes
= JimEmptyStringRep
;
2412 objPtr
->bytes
= Jim_Alloc(len
+ 1);
2413 memcpy(objPtr
->bytes
, s
, len
);
2414 objPtr
->bytes
[len
] = '\0';
2416 objPtr
->length
= len
;
2418 /* No typePtr field for the vanilla string object. */
2419 objPtr
->typePtr
= NULL
;
2423 /* charlen is in characters -- see also Jim_NewStringObj() */
2424 Jim_Obj
*Jim_NewStringObjUtf8(Jim_Interp
*interp
, const char *s
, int charlen
)
2427 /* Need to find out how many bytes the string requires */
2428 int bytelen
= utf8_index(s
, charlen
);
2430 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, s
, bytelen
);
2432 /* Remember the utf8 length, so set the type */
2433 objPtr
->typePtr
= &stringObjType
;
2434 objPtr
->internalRep
.strValue
.maxLength
= bytelen
;
2435 objPtr
->internalRep
.strValue
.charLength
= charlen
;
2439 return Jim_NewStringObj(interp
, s
, charlen
);
2443 /* This version does not try to duplicate the 's' pointer, but
2444 * use it directly. */
2445 Jim_Obj
*Jim_NewStringObjNoAlloc(Jim_Interp
*interp
, char *s
, int len
)
2447 Jim_Obj
*objPtr
= Jim_NewObj(interp
);
2450 objPtr
->length
= (len
== -1) ? strlen(s
) : len
;
2451 objPtr
->typePtr
= NULL
;
2455 /* Low-level string append. Use it only against unshared objects
2456 * of type "string". */
2457 static void StringAppendString(Jim_Obj
*objPtr
, const char *str
, int len
)
2463 needlen
= objPtr
->length
+ len
;
2464 if (objPtr
->internalRep
.strValue
.maxLength
< needlen
||
2465 objPtr
->internalRep
.strValue
.maxLength
== 0) {
2467 /* Inefficient to malloc() for less than 8 bytes */
2471 if (objPtr
->bytes
== JimEmptyStringRep
) {
2472 objPtr
->bytes
= Jim_Alloc(needlen
+ 1);
2475 objPtr
->bytes
= Jim_Realloc(objPtr
->bytes
, needlen
+ 1);
2477 objPtr
->internalRep
.strValue
.maxLength
= needlen
;
2479 memcpy(objPtr
->bytes
+ objPtr
->length
, str
, len
);
2480 objPtr
->bytes
[objPtr
->length
+ len
] = '\0';
2482 if (objPtr
->internalRep
.strValue
.charLength
>= 0) {
2483 /* Update the utf-8 char length */
2484 objPtr
->internalRep
.strValue
.charLength
+= utf8_strlen(objPtr
->bytes
+ objPtr
->length
, len
);
2486 objPtr
->length
+= len
;
2489 /* Higher level API to append strings to objects.
2490 * Object must not be unshared for each of these.
2492 void Jim_AppendString(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
, int len
)
2494 JimPanic((Jim_IsShared(objPtr
), "Jim_AppendString called with shared object"));
2495 SetStringFromAny(interp
, objPtr
);
2496 StringAppendString(objPtr
, str
, len
);
2499 void Jim_AppendObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*appendObjPtr
)
2502 const char *str
= Jim_GetString(appendObjPtr
, &len
);
2503 Jim_AppendString(interp
, objPtr
, str
, len
);
2506 void Jim_AppendStrings(Jim_Interp
*interp
, Jim_Obj
*objPtr
, ...)
2510 SetStringFromAny(interp
, objPtr
);
2511 va_start(ap
, objPtr
);
2513 const char *s
= va_arg(ap
, const char *);
2517 Jim_AppendString(interp
, objPtr
, s
, -1);
2522 int Jim_StringEqObj(Jim_Obj
*aObjPtr
, Jim_Obj
*bObjPtr
)
2524 if (aObjPtr
== bObjPtr
) {
2529 const char *sA
= Jim_GetString(aObjPtr
, &Alen
);
2530 const char *sB
= Jim_GetString(bObjPtr
, &Blen
);
2532 return Alen
== Blen
&& memcmp(sA
, sB
, Alen
) == 0;
2537 * Note. Does not support embedded nulls in either the pattern or the object.
2539 int Jim_StringMatchObj(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, Jim_Obj
*objPtr
, int nocase
)
2541 return JimGlobMatch(Jim_String(patternObjPtr
), Jim_String(objPtr
), nocase
);
2545 * Note: does not support embedded nulls for the nocase option.
2547 int Jim_StringCompareObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2550 const char *s1
= Jim_GetString(firstObjPtr
, &l1
);
2551 const char *s2
= Jim_GetString(secondObjPtr
, &l2
);
2554 /* Do a character compare for nocase */
2555 return JimStringCompareLen(s1
, s2
, -1, nocase
);
2557 return JimStringCompare(s1
, l1
, s2
, l2
);
2561 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2563 * Note: does not support embedded nulls
2565 int Jim_StringCompareLenObj(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*secondObjPtr
, int nocase
)
2567 const char *s1
= Jim_String(firstObjPtr
);
2568 const char *s2
= Jim_String(secondObjPtr
);
2570 return JimStringCompareLen(s1
, s2
, Jim_Utf8Length(interp
, firstObjPtr
), nocase
);
2573 /* Convert a range, as returned by Jim_GetRange(), into
2574 * an absolute index into an object of the specified length.
2575 * This function may return negative values, or values
2576 * greater than or equal to the length of the list if the index
2577 * is out of range. */
2578 static int JimRelToAbsIndex(int len
, int idx
)
2585 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2586 * into a form suitable for implementation of commands like [string range] and [lrange].
2588 * The resulting range is guaranteed to address valid elements of
2591 static void JimRelToAbsRange(int len
, int *firstPtr
, int *lastPtr
, int *rangeLenPtr
)
2595 if (*firstPtr
> *lastPtr
) {
2599 rangeLen
= *lastPtr
- *firstPtr
+ 1;
2601 if (*firstPtr
< 0) {
2602 rangeLen
+= *firstPtr
;
2605 if (*lastPtr
>= len
) {
2606 rangeLen
-= (*lastPtr
- (len
- 1));
2614 *rangeLenPtr
= rangeLen
;
2617 static int JimStringGetRange(Jim_Interp
*interp
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
,
2618 int len
, int *first
, int *last
, int *range
)
2620 if (Jim_GetIndex(interp
, firstObjPtr
, first
) != JIM_OK
) {
2623 if (Jim_GetIndex(interp
, lastObjPtr
, last
) != JIM_OK
) {
2626 *first
= JimRelToAbsIndex(len
, *first
);
2627 *last
= JimRelToAbsIndex(len
, *last
);
2628 JimRelToAbsRange(len
, first
, last
, range
);
2632 Jim_Obj
*Jim_StringByteRangeObj(Jim_Interp
*interp
,
2633 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2640 str
= Jim_GetString(strObjPtr
, &bytelen
);
2642 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, bytelen
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2646 if (first
== 0 && rangeLen
== bytelen
) {
2649 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2652 Jim_Obj
*Jim_StringRangeObj(Jim_Interp
*interp
,
2653 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
)
2661 str
= Jim_GetString(strObjPtr
, &bytelen
);
2662 len
= Jim_Utf8Length(interp
, strObjPtr
);
2664 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2668 if (first
== 0 && rangeLen
== len
) {
2671 if (len
== bytelen
) {
2672 /* ASCII optimisation */
2673 return Jim_NewStringObj(interp
, str
+ first
, rangeLen
);
2675 return Jim_NewStringObjUtf8(interp
, str
+ utf8_index(str
, first
), rangeLen
);
2677 return Jim_StringByteRangeObj(interp
, strObjPtr
, firstObjPtr
, lastObjPtr
);
2681 Jim_Obj
*JimStringReplaceObj(Jim_Interp
*interp
,
2682 Jim_Obj
*strObjPtr
, Jim_Obj
*firstObjPtr
, Jim_Obj
*lastObjPtr
, Jim_Obj
*newStrObj
)
2689 len
= Jim_Utf8Length(interp
, strObjPtr
);
2691 if (JimStringGetRange(interp
, firstObjPtr
, lastObjPtr
, len
, &first
, &last
, &rangeLen
) != JIM_OK
) {
2699 str
= Jim_String(strObjPtr
);
2702 objPtr
= Jim_NewStringObjUtf8(interp
, str
, first
);
2706 Jim_AppendObj(interp
, objPtr
, newStrObj
);
2710 Jim_AppendString(interp
, objPtr
, str
+ utf8_index(str
, last
+ 1), len
- last
- 1);
2716 * Note: does not support embedded nulls.
2718 static void JimStrCopyUpperLower(char *dest
, const char *str
, int uc
)
2722 str
+= utf8_tounicode(str
, &c
);
2723 dest
+= utf8_getchars(dest
, uc
? utf8_upper(c
) : utf8_lower(c
));
2729 * Note: does not support embedded nulls.
2731 static Jim_Obj
*JimStringToLower(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2737 SetStringFromAny(interp
, strObjPtr
);
2739 str
= Jim_GetString(strObjPtr
, &len
);
2742 /* Case mapping can change the utf-8 length of the string.
2743 * But at worst it will be by one extra byte per char
2747 buf
= Jim_Alloc(len
+ 1);
2748 JimStrCopyUpperLower(buf
, str
, 0);
2749 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2753 * Note: does not support embedded nulls.
2755 static Jim_Obj
*JimStringToUpper(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2761 if (strObjPtr
->typePtr
!= &stringObjType
) {
2762 SetStringFromAny(interp
, strObjPtr
);
2765 str
= Jim_GetString(strObjPtr
, &len
);
2768 /* Case mapping can change the utf-8 length of the string.
2769 * But at worst it will be by one extra byte per char
2773 buf
= Jim_Alloc(len
+ 1);
2774 JimStrCopyUpperLower(buf
, str
, 1);
2775 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2779 * Note: does not support embedded nulls.
2781 static Jim_Obj
*JimStringToTitle(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
)
2788 str
= Jim_GetString(strObjPtr
, &len
);
2793 /* Case mapping can change the utf-8 length of the string.
2794 * But at worst it will be by one extra byte per char
2798 buf
= p
= Jim_Alloc(len
+ 1);
2800 str
+= utf8_tounicode(str
, &c
);
2801 p
+= utf8_getchars(p
, utf8_title(c
));
2803 JimStrCopyUpperLower(p
, str
, 0);
2805 return Jim_NewStringObjNoAlloc(interp
, buf
, -1);
2808 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2809 * for unicode character 'c'.
2810 * Returns the position if found or NULL if not
2812 static const char *utf8_memchr(const char *str
, int len
, int c
)
2817 int n
= utf8_tounicode(str
, &sc
);
2826 return memchr(str
, c
, len
);
2831 * Searches for the first non-trim char in string (str, len)
2833 * If none is found, returns just past the last char.
2835 * Lengths are in bytes.
2837 static const char *JimFindTrimLeft(const char *str
, int len
, const char *trimchars
, int trimlen
)
2841 int n
= utf8_tounicode(str
, &c
);
2843 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2844 /* Not a trim char, so stop */
2854 * Searches backwards for a non-trim char in string (str, len).
2856 * Returns a pointer to just after the non-trim char, or NULL if not found.
2858 * Lengths are in bytes.
2860 static const char *JimFindTrimRight(const char *str
, int len
, const char *trimchars
, int trimlen
)
2866 int n
= utf8_prev_len(str
, len
);
2871 n
= utf8_tounicode(str
, &c
);
2873 if (utf8_memchr(trimchars
, trimlen
, c
) == NULL
) {
2881 static const char default_trim_chars
[] = " \t\n\r";
2882 /* sizeof() here includes the null byte */
2883 static int default_trim_chars_len
= sizeof(default_trim_chars
);
2885 static Jim_Obj
*JimStringTrimLeft(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2888 const char *str
= Jim_GetString(strObjPtr
, &len
);
2889 const char *trimchars
= default_trim_chars
;
2890 int trimcharslen
= default_trim_chars_len
;
2893 if (trimcharsObjPtr
) {
2894 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2897 newstr
= JimFindTrimLeft(str
, len
, trimchars
, trimcharslen
);
2898 if (newstr
== str
) {
2902 return Jim_NewStringObj(interp
, newstr
, len
- (newstr
- str
));
2905 static Jim_Obj
*JimStringTrimRight(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2908 const char *trimchars
= default_trim_chars
;
2909 int trimcharslen
= default_trim_chars_len
;
2910 const char *nontrim
;
2912 if (trimcharsObjPtr
) {
2913 trimchars
= Jim_GetString(trimcharsObjPtr
, &trimcharslen
);
2916 SetStringFromAny(interp
, strObjPtr
);
2918 len
= Jim_Length(strObjPtr
);
2919 nontrim
= JimFindTrimRight(strObjPtr
->bytes
, len
, trimchars
, trimcharslen
);
2921 if (nontrim
== NULL
) {
2922 /* All trim, so return a zero-length string */
2923 return Jim_NewEmptyStringObj(interp
);
2925 if (nontrim
== strObjPtr
->bytes
+ len
) {
2926 /* All non-trim, so return the original object */
2930 if (Jim_IsShared(strObjPtr
)) {
2931 strObjPtr
= Jim_NewStringObj(interp
, strObjPtr
->bytes
, (nontrim
- strObjPtr
->bytes
));
2934 /* Can modify this string in place */
2935 strObjPtr
->bytes
[nontrim
- strObjPtr
->bytes
] = 0;
2936 strObjPtr
->length
= (nontrim
- strObjPtr
->bytes
);
2942 static Jim_Obj
*JimStringTrim(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*trimcharsObjPtr
)
2944 /* First trim left. */
2945 Jim_Obj
*objPtr
= JimStringTrimLeft(interp
, strObjPtr
, trimcharsObjPtr
);
2947 /* Now trim right */
2948 strObjPtr
= JimStringTrimRight(interp
, objPtr
, trimcharsObjPtr
);
2950 /* Note: refCount check is needed since objPtr may be emptyObj */
2951 if (objPtr
!= strObjPtr
&& objPtr
->refCount
== 0) {
2952 /* We don't want this object to be leaked */
2953 Jim_FreeNewObj(interp
, objPtr
);
2959 /* Some platforms don't have isascii - need a non-macro version */
2961 #define jim_isascii isascii
2963 static int jim_isascii(int c
)
2965 return !(c
& ~0x7f);
2969 static int JimStringIs(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*strClass
, int strict
)
2971 static const char * const strclassnames
[] = {
2972 "integer", "alpha", "alnum", "ascii", "digit",
2973 "double", "lower", "upper", "space", "xdigit",
2974 "control", "print", "graph", "punct", "boolean",
2978 STR_IS_INTEGER
, STR_IS_ALPHA
, STR_IS_ALNUM
, STR_IS_ASCII
, STR_IS_DIGIT
,
2979 STR_IS_DOUBLE
, STR_IS_LOWER
, STR_IS_UPPER
, STR_IS_SPACE
, STR_IS_XDIGIT
,
2980 STR_IS_CONTROL
, STR_IS_PRINT
, STR_IS_GRAPH
, STR_IS_PUNCT
, STR_IS_BOOLEAN
,
2986 int (*isclassfunc
)(int c
) = NULL
;
2988 if (Jim_GetEnum(interp
, strClass
, strclassnames
, &strclass
, "class", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
2992 str
= Jim_GetString(strObjPtr
, &len
);
2994 Jim_SetResultBool(interp
, !strict
);
2999 case STR_IS_INTEGER
:
3002 Jim_SetResultBool(interp
, JimGetWideNoErr(interp
, strObjPtr
, &w
) == JIM_OK
);
3009 Jim_SetResultBool(interp
, Jim_GetDouble(interp
, strObjPtr
, &d
) == JIM_OK
&& errno
!= ERANGE
);
3013 case STR_IS_BOOLEAN
:
3016 Jim_SetResultBool(interp
, Jim_GetBoolean(interp
, strObjPtr
, &b
) == JIM_OK
);
3020 case STR_IS_ALPHA
: isclassfunc
= isalpha
; break;
3021 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
3022 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
3023 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
3024 case STR_IS_LOWER
: isclassfunc
= islower
; break;
3025 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
3026 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
3027 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
3028 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
3029 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
3030 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
3031 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3036 for (i
= 0; i
< len
; i
++) {
3037 if (!isclassfunc(UCHAR(str
[i
]))) {
3038 Jim_SetResultBool(interp
, 0);
3042 Jim_SetResultBool(interp
, 1);
3046 /* -----------------------------------------------------------------------------
3047 * Compared String Object
3048 * ---------------------------------------------------------------------------*/
3050 /* This is strange object that allows comparison of a C literal string
3051 * with a Jim object in a very short time if the same comparison is done
3052 * multiple times. For example every time the [if] command is executed,
3053 * Jim has to check if a given argument is "else".
3054 * If the code has no errors, this comparison is true most of the time,
3055 * so we can cache the pointer of the string of the last matching
3056 * comparison inside the object. Because most C compilers perform literal sharing,
3057 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3058 * this works pretty well even if comparisons are at different places
3059 * inside the C code. */
3061 static const Jim_ObjType comparedStringObjType
= {
3066 JIM_TYPE_REFERENCES
,
3069 /* The only way this object is exposed to the API is via the following
3070 * function. Returns true if the string and the object string repr.
3071 * are the same, otherwise zero is returned.
3073 * Note: this isn't binary safe, but it hardly needs to be.*/
3074 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3076 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3080 const char *objStr
= Jim_String(objPtr
);
3082 if (strcmp(str
, objStr
) != 0)
3085 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3086 Jim_FreeIntRep(interp
, objPtr
);
3087 objPtr
->typePtr
= &comparedStringObjType
;
3089 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3094 static int qsortCompareStringPointers(const void *a
, const void *b
)
3096 char *const *sa
= (char *const *)a
;
3097 char *const *sb
= (char *const *)b
;
3099 return strcmp(*sa
, *sb
);
3103 /* -----------------------------------------------------------------------------
3106 * This object is just a string from the language point of view, but
3107 * the internal representation contains the filename and line number
3108 * where this token was read. This information is used by
3109 * Jim_EvalObj() if the object passed happens to be of type "source".
3111 * This allows propagation of the information about line numbers and file
3112 * names and gives error messages with absolute line numbers.
3114 * Note that this object uses the internal representation of the Jim_Object,
3115 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3117 * Also the object will be converted to something else if the given
3118 * token it represents in the source file is not something to be
3119 * evaluated (not a script), and will be specialized in some other way,
3120 * so the time overhead is also almost zero.
3121 * ---------------------------------------------------------------------------*/
3123 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3124 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3126 static const Jim_ObjType sourceObjType
= {
3128 FreeSourceInternalRep
,
3129 DupSourceInternalRep
,
3131 JIM_TYPE_REFERENCES
,
3134 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3136 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3139 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3141 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3142 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3145 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3146 Jim_Obj
*fileNameObj
, int lineNumber
)
3148 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3149 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3150 Jim_IncrRefCount(fileNameObj
);
3151 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3152 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3153 objPtr
->typePtr
= &sourceObjType
;
3156 /* -----------------------------------------------------------------------------
3159 * This object is used only in the Script internal represenation.
3160 * For each line of the script, it holds the number of tokens on the line
3161 * and the source line number.
3163 static const Jim_ObjType scriptLineObjType
= {
3171 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3175 #ifdef DEBUG_SHOW_SCRIPT
3177 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3178 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3180 objPtr
= Jim_NewEmptyStringObj(interp
);
3182 objPtr
->typePtr
= &scriptLineObjType
;
3183 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3184 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3189 /* -----------------------------------------------------------------------------
3192 * This object holds the parsed internal representation of a script.
3193 * This representation is help within an allocated ScriptObj (see below)
3195 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3196 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3198 static const Jim_ObjType scriptObjType
= {
3200 FreeScriptInternalRep
,
3201 DupScriptInternalRep
,
3203 JIM_TYPE_REFERENCES
,
3206 /* Each token of a script is represented by a ScriptToken.
3207 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3208 * can be specialized by commands operating on it.
3210 typedef struct ScriptToken
3216 /* This is the script object internal representation. An array of
3217 * ScriptToken structures, including a pre-computed representation of the
3218 * command length and arguments.
3220 * For example the script:
3223 * set $i $x$y [foo]BAR
3225 * will produce a ScriptObj with the following ScriptToken's:
3240 * "puts hello" has two args (LIN 2), composed of single tokens.
3241 * (Note that the WRD token is omitted for the common case of a single token.)
3243 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3244 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3246 * The precomputation of the command structure makes Jim_Eval() faster,
3247 * and simpler because there aren't dynamic lengths / allocations.
3249 * -- {expand}/{*} handling --
3251 * Expand is handled in a special way.
3253 * If a "word" begins with {*}, the word token count is -ve.
3255 * For example the command:
3259 * Will produce the following cmdstruct array:
3266 * Note that the 'LIN' token also contains the source information for the
3267 * first word of the line for error reporting purposes
3269 * -- the substFlags field of the structure --
3271 * The scriptObj structure is used to represent both "script" objects
3272 * and "subst" objects. In the second case, there are no LIN and WRD
3273 * tokens. Instead SEP and EOL tokens are added as-is.
3274 * In addition, the field 'substFlags' is used to represent the flags used to turn
3275 * the string into the internal representation.
3276 * If these flags do not match what the application requires,
3277 * the scriptObj is created again. For example the script:
3279 * subst -nocommands $string
3280 * subst -novariables $string
3282 * Will (re)create the internal representation of the $string object
3285 typedef struct ScriptObj
3287 ScriptToken
*token
; /* Tokens array. */
3288 Jim_Obj
*fileNameObj
; /* Filename */
3289 int len
; /* Length of token[] */
3290 int substFlags
; /* flags used for the compilation of "subst" objects */
3291 int inUse
; /* Used to share a ScriptObj. Currently
3292 only used by Jim_EvalObj() as protection against
3293 shimmering of the currently evaluated object. */
3294 int firstline
; /* Line number of the first line */
3295 int linenr
; /* Error line number, if any */
3296 int missing
; /* Missing char if script failed to parse, (or space or backslash if OK) */
3299 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3300 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3301 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3303 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3306 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3308 if (--script
->inUse
!= 0)
3310 for (i
= 0; i
< script
->len
; i
++) {
3311 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3313 Jim_Free(script
->token
);
3314 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3318 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3320 JIM_NOTUSED(interp
);
3321 JIM_NOTUSED(srcPtr
);
3323 /* Just return a simple string. We don't try to preserve the source info
3324 * since in practice scripts are never duplicated
3326 dupPtr
->typePtr
= NULL
;
3329 /* A simple parse token.
3330 * As the script is parsed, the created tokens point into the script string rep.
3334 const char *token
; /* Pointer to the start of the token */
3335 int len
; /* Length of this token */
3336 int type
; /* Token type */
3337 int line
; /* Line number */
3340 /* A list of parsed tokens representing a script.
3341 * Tokens are added to this list as the script is parsed.
3342 * It grows as needed.
3346 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3347 ParseToken
*list
; /* Array of tokens */
3348 int size
; /* Current size of the list */
3349 int count
; /* Number of entries used */
3350 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3353 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3355 tokenlist
->list
= tokenlist
->static_list
;
3356 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3357 tokenlist
->count
= 0;
3360 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3362 if (tokenlist
->list
!= tokenlist
->static_list
) {
3363 Jim_Free(tokenlist
->list
);
3368 * Adds the new token to the tokenlist.
3369 * The token has the given length, type and line number.
3370 * The token list is resized as necessary.
3372 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3377 if (tokenlist
->count
== tokenlist
->size
) {
3378 /* Resize the list */
3379 tokenlist
->size
*= 2;
3380 if (tokenlist
->list
!= tokenlist
->static_list
) {
3382 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3385 /* The list needs to become allocated */
3386 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3387 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3388 tokenlist
->count
* sizeof(*tokenlist
->list
));
3391 t
= &tokenlist
->list
[tokenlist
->count
++];
3398 /* Counts the number of adjoining non-separator tokens.
3400 * Returns -ve if the first token is the expansion
3401 * operator (in which case the count doesn't include
3404 static int JimCountWordTokens(ParseToken
*t
)
3409 /* Is the first word {*} or {expand}? */
3410 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3411 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3412 /* Create an expand token */
3418 /* Now count non-separator words */
3419 while (!TOKEN_IS_SEP(t
->type
)) {
3424 return count
* expand
;
3428 * Create a script/subst object from the given token.
3430 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3434 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3435 /* Convert backlash escapes. The result will never be longer than the original */
3437 char *str
= Jim_Alloc(len
+ 1);
3438 len
= JimEscape(str
, t
->token
, len
);
3439 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3442 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3443 * with a single space.
3445 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3451 * Takes a tokenlist and creates the allocated list of script tokens
3452 * in script->token, of length script->len.
3454 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3457 * Also sets script->line to the line number of the first token
3459 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3460 ParseTokenList
*tokenlist
)
3463 struct ScriptToken
*token
;
3464 /* Number of tokens so far for the current command */
3466 /* This is the first token for the current command */
3467 ScriptToken
*linefirst
;
3471 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3472 printf("==== Tokens ====\n");
3473 for (i
= 0; i
< tokenlist
->count
; i
++) {
3474 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3475 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3479 /* May need up to one extra script token for each EOL in the worst case */
3480 count
= tokenlist
->count
;
3481 for (i
= 0; i
< tokenlist
->count
; i
++) {
3482 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3486 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3488 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3490 /* This is the first token for the current command */
3491 linefirst
= token
++;
3493 for (i
= 0; i
< tokenlist
->count
; ) {
3494 /* Look ahead to find out how many tokens make up the next word */
3497 /* Skip any leading separators */
3498 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3502 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3504 if (wordtokens
== 0) {
3505 /* None, so at end of line */
3507 linefirst
->type
= JIM_TT_LINE
;
3508 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3509 Jim_IncrRefCount(linefirst
->objPtr
);
3511 /* Reset for new line */
3513 linefirst
= token
++;
3518 else if (wordtokens
!= 1) {
3519 /* More than 1, or {*}, so insert a WORD token */
3520 token
->type
= JIM_TT_WORD
;
3521 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3522 Jim_IncrRefCount(token
->objPtr
);
3524 if (wordtokens
< 0) {
3525 /* Skip the expand token */
3527 wordtokens
= -wordtokens
- 1;
3532 if (lineargs
== 0) {
3533 /* First real token on the line, so record the line number */
3534 linenr
= tokenlist
->list
[i
].line
;
3538 /* Add each non-separator word token to the line */
3539 while (wordtokens
--) {
3540 const ParseToken
*t
= &tokenlist
->list
[i
++];
3542 token
->type
= t
->type
;
3543 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3544 Jim_IncrRefCount(token
->objPtr
);
3546 /* Every object is initially a string of type 'source', but the
3547 * internal type may be specialized during execution of the
3549 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3554 if (lineargs
== 0) {
3558 script
->len
= token
- script
->token
;
3560 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3562 #ifdef DEBUG_SHOW_SCRIPT
3563 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3564 for (i
= 0; i
< script
->len
; i
++) {
3565 const ScriptToken
*t
= &script
->token
[i
];
3566 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3572 /* Parses the given string object to determine if it represents a complete script.
3574 * This is useful for interactive shells implementation, for [info complete].
3576 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3577 * '{' on scripts incomplete missing one or more '}' to be balanced.
3578 * '[' on scripts incomplete missing one or more ']' to be balanced.
3579 * '"' on scripts incomplete missing a '"' char.
3580 * '\\' on scripts with a trailing backslash.
3582 * If the script is complete, 1 is returned, otherwise 0.
3584 int Jim_ScriptIsComplete(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, char *stateCharPtr
)
3586 ScriptObj
*script
= JimGetScript(interp
, scriptObj
);
3588 *stateCharPtr
= script
->missing
;
3590 return (script
->missing
== ' ');
3594 * Sets an appropriate error message for a missing script/expression terminator.
3596 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3598 * Note that a trailing backslash is not considered to be an error.
3600 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3610 msg
= "unmatched \"[\"";
3613 msg
= "missing close-brace";
3617 msg
= "missing quote";
3621 Jim_SetResultString(interp
, msg
, -1);
3626 * Similar to ScriptObjAddTokens(), but for subst objects.
3628 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3629 ParseTokenList
*tokenlist
)
3632 struct ScriptToken
*token
;
3634 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3636 for (i
= 0; i
< tokenlist
->count
; i
++) {
3637 const ParseToken
*t
= &tokenlist
->list
[i
];
3639 /* Create a token for 't' */
3640 token
->type
= t
->type
;
3641 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3642 Jim_IncrRefCount(token
->objPtr
);
3649 /* This method takes the string representation of an object
3650 * as a Tcl script, and generates the pre-parsed internal representation
3653 * On parse error, sets an error message and returns JIM_ERR
3654 * (Note: the object is still converted to a script, even if an error occurs)
3656 static void JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3659 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3660 struct JimParserCtx parser
;
3661 struct ScriptObj
*script
;
3662 ParseTokenList tokenlist
;
3665 /* Try to get information about filename / line number */
3666 if (objPtr
->typePtr
== &sourceObjType
) {
3667 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3670 /* Initially parse the script into tokens (in tokenlist) */
3671 ScriptTokenListInit(&tokenlist
);
3673 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3674 while (!parser
.eof
) {
3675 JimParseScript(&parser
);
3676 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3680 /* Add a final EOF token */
3681 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3683 /* Create the "real" script tokens from the parsed tokens */
3684 script
= Jim_Alloc(sizeof(*script
));
3685 memset(script
, 0, sizeof(*script
));
3687 if (objPtr
->typePtr
== &sourceObjType
) {
3688 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3691 script
->fileNameObj
= interp
->emptyObj
;
3693 Jim_IncrRefCount(script
->fileNameObj
);
3694 script
->missing
= parser
.missing
.ch
;
3695 script
->linenr
= parser
.missing
.line
;
3697 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3699 /* No longer need the token list */
3700 ScriptTokenListFree(&tokenlist
);
3702 /* Free the old internal rep and set the new one. */
3703 Jim_FreeIntRep(interp
, objPtr
);
3704 Jim_SetIntRepPtr(objPtr
, script
);
3705 objPtr
->typePtr
= &scriptObjType
;
3708 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
);
3711 * Returns the parsed script.
3712 * Note that if there is any possibility that the script is not valid,
3713 * call JimScriptValid() to check
3715 static ScriptObj
*JimGetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3717 if (objPtr
== interp
->emptyObj
) {
3718 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3719 objPtr
= interp
->nullScriptObj
;
3722 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3723 JimSetScriptFromAny(interp
, objPtr
);
3726 return (ScriptObj
*)Jim_GetIntRepPtr(objPtr
);
3730 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3731 * and leaves an error message in the interp result.
3734 static int JimScriptValid(Jim_Interp
*interp
, ScriptObj
*script
)
3736 if (JimParseCheckMissing(interp
, script
->missing
) == JIM_ERR
) {
3737 JimAddErrorToStack(interp
, script
);
3744 /* -----------------------------------------------------------------------------
3746 * ---------------------------------------------------------------------------*/
3747 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3752 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3754 if (--cmdPtr
->inUse
== 0) {
3755 if (cmdPtr
->isproc
) {
3756 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3757 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3758 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3759 if (cmdPtr
->u
.proc
.staticVars
) {
3760 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3761 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3766 if (cmdPtr
->u
.native
.delProc
) {
3767 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3770 if (cmdPtr
->prevCmd
) {
3771 /* Delete any pushed command too */
3772 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3778 /* Variables HashTable Type.
3780 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3783 /* Variables HashTable Type.
3785 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3786 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3788 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3792 static const Jim_HashTableType JimVariablesHashTableType
= {
3793 JimStringCopyHTHashFunction
, /* hash function */
3794 JimStringCopyHTDup
, /* key dup */
3796 JimStringCopyHTKeyCompare
, /* key compare */
3797 JimStringCopyHTKeyDestructor
, /* key destructor */
3798 JimVariablesHTValDestructor
/* val destructor */
3801 /* Commands HashTable Type.
3803 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3805 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3807 JimDecrCmdRefCount(interp
, val
);
3810 static const Jim_HashTableType JimCommandsHashTableType
= {
3811 JimStringCopyHTHashFunction
, /* hash function */
3812 JimStringCopyHTDup
, /* key dup */
3814 JimStringCopyHTKeyCompare
, /* key compare */
3815 JimStringCopyHTKeyDestructor
, /* key destructor */
3816 JimCommandsHT_ValDestructor
/* val destructor */
3819 /* ------------------------- Commands related functions --------------------- */
3821 #ifdef jim_ext_namespace
3823 * Returns the "unscoped" version of the given namespace.
3824 * That is, the fully qualified name without the leading ::
3825 * The returned value is either nsObj, or an object with a zero ref count.
3827 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3829 const char *name
= Jim_String(nsObj
);
3830 if (name
[0] == ':' && name
[1] == ':') {
3831 /* This command is being defined in the global namespace */
3832 while (*++name
== ':') {
3834 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3836 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3837 /* This command is being defined in a non-global namespace */
3838 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3839 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3844 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3848 const char *name
= Jim_String(nameObjPtr
);
3849 if (name
[0] == ':' && name
[1] == ':') {
3852 Jim_IncrRefCount(nameObjPtr
);
3853 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3854 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3855 Jim_DecrRefCount(interp
, nameObjPtr
);
3861 * An efficient version of JimQualifyNameObj() where the name is
3862 * available (and needed) as a 'const char *'.
3863 * Avoids creating an object if not necessary.
3864 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3866 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3868 Jim_Obj
*objPtr
= interp
->emptyObj
;
3870 if (name
[0] == ':' && name
[1] == ':') {
3871 /* This command is being defined in the global namespace */
3872 while (*++name
== ':') {
3875 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3876 /* This command is being defined in a non-global namespace */
3877 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3878 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3879 name
= Jim_String(objPtr
);
3881 Jim_IncrRefCount(objPtr
);
3882 *objPtrPtr
= objPtr
;
3886 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3889 /* We can be more efficient in the no-namespace case */
3890 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3891 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3893 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3899 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3901 /* It may already exist, so we try to delete the old one.
3902 * Note that reference count means that it won't be deleted yet if
3903 * it exists in the call stack.
3905 * BUT, if 'local' is in force, instead of deleting the existing
3906 * proc, we stash a reference to the old proc here.
3908 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3910 /* There was an old cmd with the same name,
3911 * so this requires a 'proc epoch' update. */
3913 /* If a procedure with the same name didn't exist there is no need
3914 * to increment the 'proc epoch' because creation of a new procedure
3915 * can never affect existing cached commands. We don't do
3916 * negative caching. */
3917 Jim_InterpIncrProcEpoch(interp
);
3920 if (he
&& interp
->local
) {
3921 /* Push this command over the top of the previous one */
3922 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3923 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3927 /* Replace the existing command */
3928 Jim_DeleteHashEntry(&interp
->commands
, name
);
3931 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3937 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3938 Jim_CmdProc
*cmdProc
, void *privData
, Jim_DelCmdProc
*delProc
)
3940 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3942 /* Store the new details for this command */
3943 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3945 cmdPtr
->u
.native
.delProc
= delProc
;
3946 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3947 cmdPtr
->u
.native
.privData
= privData
;
3949 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3954 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3958 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3963 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3964 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3965 for (i
= 0; i
< len
; i
++) {
3966 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3970 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3971 /* Check if it's composed of two elements. */
3972 subLen
= Jim_ListLength(interp
, objPtr
);
3973 if (subLen
== 1 || subLen
== 2) {
3974 /* Try to get the variable value from the current
3976 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3978 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3979 if (initObjPtr
== NULL
) {
3980 Jim_SetResultFormatted(interp
,
3981 "variable for initialization of static \"%#s\" not found in the local context",
3987 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3989 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3993 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3994 varPtr
->objPtr
= initObjPtr
;
3995 Jim_IncrRefCount(initObjPtr
);
3996 varPtr
->linkFramePtr
= NULL
;
3997 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3998 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3999 Jim_SetResultFormatted(interp
,
4000 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
4001 Jim_DecrRefCount(interp
, initObjPtr
);
4007 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
4015 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
4017 #ifdef jim_ext_namespace
4018 if (cmdPtr
->isproc
) {
4019 /* XXX: Really need JimNamespaceSplit() */
4020 const char *pt
= strrchr(cmdname
, ':');
4021 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
4022 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
4023 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
4024 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4026 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
4027 /* This commands shadows a global command, so a proc epoch update is required */
4028 Jim_InterpIncrProcEpoch(interp
);
4035 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
4036 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4042 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4044 /* Allocate space for both the command pointer and the arg list */
4045 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4046 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4049 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4050 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4051 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4052 cmdPtr
->u
.proc
.argsPos
= -1;
4053 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4054 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4055 Jim_IncrRefCount(argListObjPtr
);
4056 Jim_IncrRefCount(bodyObjPtr
);
4057 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4059 /* Create the statics hash table. */
4060 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4064 /* Parse the args out into arglist, validating as we go */
4065 /* Examine the argument list for default parameters and 'args' */
4066 for (i
= 0; i
< argListLen
; i
++) {
4068 Jim_Obj
*nameObjPtr
;
4069 Jim_Obj
*defaultObjPtr
;
4072 /* Examine a parameter */
4073 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4074 len
= Jim_ListLength(interp
, argPtr
);
4076 Jim_SetResultString(interp
, "argument with no name", -1);
4078 JimDecrCmdRefCount(interp
, cmdPtr
);
4082 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4087 /* Optional parameter */
4088 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4089 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4092 /* Required parameter */
4093 nameObjPtr
= argPtr
;
4094 defaultObjPtr
= NULL
;
4098 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4099 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4100 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4103 cmdPtr
->u
.proc
.argsPos
= i
;
4107 cmdPtr
->u
.proc
.optArity
++;
4110 cmdPtr
->u
.proc
.reqArity
++;
4114 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4115 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4121 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4124 Jim_Obj
*qualifiedNameObj
;
4125 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4127 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4128 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4132 Jim_InterpIncrProcEpoch(interp
);
4135 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4140 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4145 Jim_Obj
*qualifiedOldNameObj
;
4146 Jim_Obj
*qualifiedNewNameObj
;
4150 if (newName
[0] == 0) {
4151 return Jim_DeleteCommand(interp
, oldName
);
4154 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4155 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4157 /* Does it exist? */
4158 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4160 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4162 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4163 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4166 /* Add the new name first */
4167 cmdPtr
= Jim_GetHashEntryVal(he
);
4168 JimIncrCmdRefCount(cmdPtr
);
4169 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4170 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4172 /* Now remove the old name */
4173 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4175 /* Increment the epoch */
4176 Jim_InterpIncrProcEpoch(interp
);
4181 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4182 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4187 /* -----------------------------------------------------------------------------
4189 * ---------------------------------------------------------------------------*/
4191 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4193 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4196 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4198 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4199 dupPtr
->typePtr
= srcPtr
->typePtr
;
4200 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4203 static const Jim_ObjType commandObjType
= {
4205 FreeCommandInternalRep
,
4206 DupCommandInternalRep
,
4208 JIM_TYPE_REFERENCES
,
4211 /* This function returns the command structure for the command name
4212 * stored in objPtr. It tries to specialize the objPtr to contain
4213 * a cached info instead to perform the lookup into the hash table
4214 * every time. The information cached may not be uptodate, in such
4215 * a case the lookup is performed and the cache updated.
4217 * Respects the 'upcall' setting
4219 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4223 /* In order to be valid, the proc epoch must match and
4224 * the lookup must have occurred in the same namespace
4226 if (objPtr
->typePtr
!= &commandObjType
||
4227 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4228 #ifdef jim_ext_namespace
4229 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4232 /* Not cached or out of date, so lookup */
4234 /* Do we need to try the local namespace? */
4235 const char *name
= Jim_String(objPtr
);
4238 if (name
[0] == ':' && name
[1] == ':') {
4239 while (*++name
== ':') {
4242 #ifdef jim_ext_namespace
4243 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4244 /* This command is being defined in a non-global namespace */
4245 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4246 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4247 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4248 Jim_FreeNewObj(interp
, nameObj
);
4255 /* Lookup in the global namespace */
4256 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4258 if (flags
& JIM_ERRMSG
) {
4259 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4263 #ifdef jim_ext_namespace
4266 cmd
= Jim_GetHashEntryVal(he
);
4268 /* Free the old internal repr and set the new one. */
4269 Jim_FreeIntRep(interp
, objPtr
);
4270 objPtr
->typePtr
= &commandObjType
;
4271 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4272 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4273 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4274 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4277 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4279 while (cmd
->u
.proc
.upcall
) {
4285 /* -----------------------------------------------------------------------------
4287 * ---------------------------------------------------------------------------*/
4289 /* -----------------------------------------------------------------------------
4291 * ---------------------------------------------------------------------------*/
4293 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4295 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4297 static const Jim_ObjType variableObjType
= {
4302 JIM_TYPE_REFERENCES
,
4306 * Check that the name does not contain embedded nulls.
4308 * Variable and procedure names are manipulated as null terminated strings, so
4309 * don't allow names with embedded nulls.
4311 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4313 /* Variable names and proc names can't contain embedded nulls */
4314 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4316 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4317 if (memchr(str
, '\0', len
)) {
4318 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4325 /* This method should be called only by the variable API.
4326 * It returns JIM_OK on success (variable already exists),
4327 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4328 * a variable name, but syntax glue for [dict] i.e. the last
4329 * character is ')' */
4330 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4332 const char *varName
;
4333 Jim_CallFrame
*framePtr
;
4338 /* Check if the object is already an uptodate variable */
4339 if (objPtr
->typePtr
== &variableObjType
) {
4340 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4341 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4345 /* Need to re-resolve the variable in the updated callframe */
4347 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4348 return JIM_DICT_SUGAR
;
4350 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4355 varName
= Jim_GetString(objPtr
, &len
);
4357 /* Make sure it's not syntax glue to get/set dict. */
4358 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4359 return JIM_DICT_SUGAR
;
4362 if (varName
[0] == ':' && varName
[1] == ':') {
4363 while (*++varName
== ':') {
4366 framePtr
= interp
->topFramePtr
;
4370 framePtr
= interp
->framePtr
;
4373 /* Resolve this name in the variables hash table */
4374 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4376 if (!global
&& framePtr
->staticVars
) {
4377 /* Try with static vars. */
4378 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4385 /* Free the old internal repr and set the new one. */
4386 Jim_FreeIntRep(interp
, objPtr
);
4387 objPtr
->typePtr
= &variableObjType
;
4388 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4389 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4390 objPtr
->internalRep
.varValue
.global
= global
;
4394 /* -------------------- Variables related functions ------------------------- */
4395 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4396 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4398 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4401 Jim_CallFrame
*framePtr
;
4404 /* New variable to create */
4405 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4407 var
->objPtr
= valObjPtr
;
4408 Jim_IncrRefCount(valObjPtr
);
4409 var
->linkFramePtr
= NULL
;
4411 name
= Jim_String(nameObjPtr
);
4412 if (name
[0] == ':' && name
[1] == ':') {
4413 while (*++name
== ':') {
4415 framePtr
= interp
->topFramePtr
;
4419 framePtr
= interp
->framePtr
;
4423 /* Insert the new variable */
4424 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4426 /* Make the object int rep a variable */
4427 Jim_FreeIntRep(interp
, nameObjPtr
);
4428 nameObjPtr
->typePtr
= &variableObjType
;
4429 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4430 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4431 nameObjPtr
->internalRep
.varValue
.global
= global
;
4436 /* For now that's dummy. Variables lookup should be optimized
4437 * in many ways, with caching of lookups, and possibly with
4438 * a table of pre-allocated vars in every CallFrame for local vars.
4439 * All the caching should also have an 'epoch' mechanism similar
4440 * to the one used by Tcl for procedures lookup caching. */
4442 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4447 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4448 case JIM_DICT_SUGAR
:
4449 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4452 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4455 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4459 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4460 if (var
->linkFramePtr
== NULL
) {
4461 Jim_IncrRefCount(valObjPtr
);
4462 Jim_DecrRefCount(interp
, var
->objPtr
);
4463 var
->objPtr
= valObjPtr
;
4465 else { /* Else handle the link */
4466 Jim_CallFrame
*savedCallFrame
;
4468 savedCallFrame
= interp
->framePtr
;
4469 interp
->framePtr
= var
->linkFramePtr
;
4470 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4471 interp
->framePtr
= savedCallFrame
;
4479 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4481 Jim_Obj
*nameObjPtr
;
4484 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4485 Jim_IncrRefCount(nameObjPtr
);
4486 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4487 Jim_DecrRefCount(interp
, nameObjPtr
);
4491 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4493 Jim_CallFrame
*savedFramePtr
;
4496 savedFramePtr
= interp
->framePtr
;
4497 interp
->framePtr
= interp
->topFramePtr
;
4498 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4499 interp
->framePtr
= savedFramePtr
;
4503 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4505 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4508 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4509 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4510 Jim_IncrRefCount(nameObjPtr
);
4511 Jim_IncrRefCount(valObjPtr
);
4512 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4513 Jim_DecrRefCount(interp
, nameObjPtr
);
4514 Jim_DecrRefCount(interp
, valObjPtr
);
4518 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4519 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4521 const char *varName
;
4522 const char *targetName
;
4523 Jim_CallFrame
*framePtr
;
4526 /* Check for an existing variable or link */
4527 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4528 case JIM_DICT_SUGAR
:
4529 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4530 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4534 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4536 if (varPtr
->linkFramePtr
== NULL
) {
4537 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4541 /* It exists, but is a link, so first delete the link */
4542 varPtr
->linkFramePtr
= NULL
;
4546 /* Resolve the call frames for both variables */
4547 /* XXX: SetVariableFromAny() already did this! */
4548 varName
= Jim_String(nameObjPtr
);
4550 if (varName
[0] == ':' && varName
[1] == ':') {
4551 while (*++varName
== ':') {
4553 /* Linking a global var does nothing */
4554 framePtr
= interp
->topFramePtr
;
4557 framePtr
= interp
->framePtr
;
4560 targetName
= Jim_String(targetNameObjPtr
);
4561 if (targetName
[0] == ':' && targetName
[1] == ':') {
4562 while (*++targetName
== ':') {
4564 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4565 targetCallFrame
= interp
->topFramePtr
;
4567 Jim_IncrRefCount(targetNameObjPtr
);
4569 if (framePtr
->level
< targetCallFrame
->level
) {
4570 Jim_SetResultFormatted(interp
,
4571 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4573 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4577 /* Check for cycles. */
4578 if (framePtr
== targetCallFrame
) {
4579 Jim_Obj
*objPtr
= targetNameObjPtr
;
4581 /* Cycles are only possible with 'uplevel 0' */
4583 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4584 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4585 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4588 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4590 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4591 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4593 objPtr
= varPtr
->objPtr
;
4597 /* Perform the binding */
4598 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4599 /* We are now sure 'nameObjPtr' type is variableObjType */
4600 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4601 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4605 /* Return the Jim_Obj pointer associated with a variable name,
4606 * or NULL if the variable was not found in the current context.
4607 * The same optimization discussed in the comment to the
4608 * 'SetVariable' function should apply here.
4610 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4611 * in a dictionary which is shared, the array variable value is duplicated first.
4612 * This allows the array element to be updated (e.g. append, lappend) without
4613 * affecting other references to the dictionary.
4615 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4617 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4619 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4621 if (varPtr
->linkFramePtr
== NULL
) {
4622 return varPtr
->objPtr
;
4627 /* The variable is a link? Resolve it. */
4628 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4630 interp
->framePtr
= varPtr
->linkFramePtr
;
4631 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4632 interp
->framePtr
= savedCallFrame
;
4636 /* Error, so fall through to the error message */
4641 case JIM_DICT_SUGAR
:
4642 /* [dict] syntax sugar. */
4643 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4645 if (flags
& JIM_ERRMSG
) {
4646 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4651 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4653 Jim_CallFrame
*savedFramePtr
;
4656 savedFramePtr
= interp
->framePtr
;
4657 interp
->framePtr
= interp
->topFramePtr
;
4658 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4659 interp
->framePtr
= savedFramePtr
;
4664 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4666 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4668 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4669 Jim_IncrRefCount(nameObjPtr
);
4670 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4671 Jim_DecrRefCount(interp
, nameObjPtr
);
4675 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4677 Jim_CallFrame
*savedFramePtr
;
4680 savedFramePtr
= interp
->framePtr
;
4681 interp
->framePtr
= interp
->topFramePtr
;
4682 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4683 interp
->framePtr
= savedFramePtr
;
4688 /* Unset a variable.
4689 * Note: On success unset invalidates all the variable objects created
4690 * in the current call frame incrementing. */
4691 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4695 Jim_CallFrame
*framePtr
;
4697 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4698 if (retval
== JIM_DICT_SUGAR
) {
4699 /* [dict] syntax sugar. */
4700 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4702 else if (retval
== JIM_OK
) {
4703 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4705 /* If it's a link call UnsetVariable recursively */
4706 if (varPtr
->linkFramePtr
) {
4707 framePtr
= interp
->framePtr
;
4708 interp
->framePtr
= varPtr
->linkFramePtr
;
4709 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4710 interp
->framePtr
= framePtr
;
4713 const char *name
= Jim_String(nameObjPtr
);
4714 if (nameObjPtr
->internalRep
.varValue
.global
) {
4716 framePtr
= interp
->topFramePtr
;
4719 framePtr
= interp
->framePtr
;
4722 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4723 if (retval
== JIM_OK
) {
4724 /* Change the callframe id, invalidating var lookup caching */
4725 framePtr
->id
= interp
->callFrameEpoch
++;
4729 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4730 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4735 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4737 /* Given a variable name for [dict] operation syntax sugar,
4738 * this function returns two objects, the first with the name
4739 * of the variable to set, and the second with the respective key.
4740 * For example "foo(bar)" will return objects with string repr. of
4743 * The returned objects have refcount = 1. The function can't fail. */
4744 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4745 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4747 const char *str
, *p
;
4749 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4751 str
= Jim_GetString(objPtr
, &len
);
4753 p
= strchr(str
, '(');
4754 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4756 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4759 keyLen
= (str
+ len
) - p
;
4760 if (str
[len
- 1] == ')') {
4764 /* Create the objects with the variable name and key. */
4765 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4767 Jim_IncrRefCount(varObjPtr
);
4768 Jim_IncrRefCount(keyObjPtr
);
4769 *varPtrPtr
= varObjPtr
;
4770 *keyPtrPtr
= keyObjPtr
;
4773 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4774 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4775 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4779 SetDictSubstFromAny(interp
, objPtr
);
4781 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4782 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4784 if (err
== JIM_OK
) {
4785 /* Don't keep an extra ref to the result */
4786 Jim_SetEmptyResult(interp
);
4790 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4791 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4792 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4797 /* Make the error more informative and Tcl-compatible */
4798 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4799 (valObjPtr
? "set" : "unset"), objPtr
);
4805 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4807 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4808 * and stored back to the variable before expansion.
4810 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4811 Jim_Obj
*keyObjPtr
, int flags
)
4813 Jim_Obj
*dictObjPtr
;
4814 Jim_Obj
*resObjPtr
= NULL
;
4817 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4822 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4823 if (ret
!= JIM_OK
) {
4824 Jim_SetResultFormatted(interp
,
4825 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4826 ret
< 0 ? "variable isn't" : "no such element in");
4828 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4829 /* Update the variable to have an unshared copy */
4830 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4836 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4837 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4839 SetDictSubstFromAny(interp
, objPtr
);
4841 return JimDictExpandArrayVariable(interp
,
4842 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4843 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4846 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4848 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4850 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4851 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4854 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4856 JIM_NOTUSED(interp
);
4858 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4859 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4860 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4861 dupPtr
->typePtr
= &dictSubstObjType
;
4864 /* Note: The object *must* be in dict-sugar format */
4865 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4867 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4868 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4870 if (objPtr
->typePtr
== &interpolatedObjType
) {
4871 /* An interpolated object in dict-sugar form */
4873 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4874 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4876 Jim_IncrRefCount(varObjPtr
);
4877 Jim_IncrRefCount(keyObjPtr
);
4880 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4883 Jim_FreeIntRep(interp
, objPtr
);
4884 objPtr
->typePtr
= &dictSubstObjType
;
4885 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4886 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4890 /* This function is used to expand [dict get] sugar in the form
4891 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4892 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4893 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4894 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4895 * the [dict]ionary contained in variable VARNAME. */
4896 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4898 Jim_Obj
*resObjPtr
= NULL
;
4899 Jim_Obj
*substKeyObjPtr
= NULL
;
4901 SetDictSubstFromAny(interp
, objPtr
);
4903 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4904 &substKeyObjPtr
, JIM_NONE
)
4908 Jim_IncrRefCount(substKeyObjPtr
);
4910 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4912 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4917 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4919 Jim_Obj
*resultObjPtr
;
4921 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4922 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4923 resultObjPtr
->refCount
--;
4924 return resultObjPtr
;
4929 /* -----------------------------------------------------------------------------
4931 * ---------------------------------------------------------------------------*/
4933 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4937 if (interp
->freeFramesList
) {
4938 cf
= interp
->freeFramesList
;
4939 interp
->freeFramesList
= cf
->next
;
4943 cf
->procArgsObjPtr
= NULL
;
4944 cf
->procBodyObjPtr
= NULL
;
4946 cf
->staticVars
= NULL
;
4947 cf
->localCommands
= NULL
;
4948 cf
->tailcallObj
= NULL
;
4949 cf
->tailcallCmd
= NULL
;
4952 cf
= Jim_Alloc(sizeof(*cf
));
4953 memset(cf
, 0, sizeof(*cf
));
4955 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4958 cf
->id
= interp
->callFrameEpoch
++;
4959 cf
->parent
= parent
;
4960 cf
->level
= parent
? parent
->level
+ 1 : 0;
4962 Jim_IncrRefCount(nsObj
);
4967 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
)
4969 /* Delete any local procs */
4970 if (localCommands
) {
4971 Jim_Obj
*cmdNameObj
;
4973 while ((cmdNameObj
= Jim_StackPop(localCommands
)) != NULL
) {
4976 Jim_HashTable
*ht
= &interp
->commands
;
4978 const char *fqname
= JimQualifyName(interp
, Jim_String(cmdNameObj
), &fqObjName
);
4980 he
= Jim_FindHashEntry(ht
, fqname
);
4983 Jim_Cmd
*cmd
= Jim_GetHashEntryVal(he
);
4985 Jim_Cmd
*prevCmd
= cmd
->prevCmd
;
4986 cmd
->prevCmd
= NULL
;
4988 /* Delete the old command */
4989 JimDecrCmdRefCount(interp
, cmd
);
4991 /* And restore the original */
4992 Jim_SetHashVal(ht
, he
, prevCmd
);
4995 Jim_DeleteHashEntry(ht
, fqname
);
4997 Jim_InterpIncrProcEpoch(interp
);
4999 Jim_DecrRefCount(interp
, cmdNameObj
);
5000 JimFreeQualifiedName(interp
, fqObjName
);
5002 Jim_FreeStack(localCommands
);
5003 Jim_Free(localCommands
);
5009 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5010 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5011 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
)
5013 JimDeleteLocalProcs(interp
, cf
->localCommands
);
5015 if (cf
->procArgsObjPtr
)
5016 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
5017 if (cf
->procBodyObjPtr
)
5018 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
5019 Jim_DecrRefCount(interp
, cf
->nsObj
);
5020 if (action
== JIM_FCF_FULL
|| cf
->vars
.size
!= JIM_HT_INITIAL_SIZE
)
5021 Jim_FreeHashTable(&cf
->vars
);
5024 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
5026 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
5028 while (he
!= NULL
) {
5029 Jim_HashEntry
*nextEntry
= he
->next
;
5030 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
5032 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
5033 Jim_Free(Jim_GetHashEntryKey(he
));
5042 cf
->next
= interp
->freeFramesList
;
5043 interp
->freeFramesList
= cf
;
5047 /* -----------------------------------------------------------------------------
5049 * ---------------------------------------------------------------------------*/
5050 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5052 /* References HashTable Type.
5054 * Keys are unsigned long integers, dynamically allocated for now but in the
5055 * future it's worth to cache this 4 bytes objects. Values are pointers
5056 * to Jim_References. */
5057 static void JimReferencesHTValDestructor(void *interp
, void *val
)
5059 Jim_Reference
*refPtr
= (void *)val
;
5061 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
5062 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
5063 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5068 static unsigned int JimReferencesHTHashFunction(const void *key
)
5070 /* Only the least significant bits are used. */
5071 const unsigned long *widePtr
= key
;
5072 unsigned int intValue
= (unsigned int)*widePtr
;
5074 return Jim_IntHashFunction(intValue
);
5077 static void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
5079 void *copy
= Jim_Alloc(sizeof(unsigned long));
5081 JIM_NOTUSED(privdata
);
5083 memcpy(copy
, key
, sizeof(unsigned long));
5087 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5089 JIM_NOTUSED(privdata
);
5091 return memcmp(key1
, key2
, sizeof(unsigned long)) == 0;
5094 static void JimReferencesHTKeyDestructor(void *privdata
, void *key
)
5096 JIM_NOTUSED(privdata
);
5101 static const Jim_HashTableType JimReferencesHashTableType
= {
5102 JimReferencesHTHashFunction
, /* hash function */
5103 JimReferencesHTKeyDup
, /* key dup */
5105 JimReferencesHTKeyCompare
, /* key compare */
5106 JimReferencesHTKeyDestructor
, /* key destructor */
5107 JimReferencesHTValDestructor
/* val destructor */
5110 /* -----------------------------------------------------------------------------
5111 * Reference object type and References API
5112 * ---------------------------------------------------------------------------*/
5114 /* The string representation of references has two features in order
5115 * to make the GC faster. The first is that every reference starts
5116 * with a non common character '<', in order to make the string matching
5117 * faster. The second is that the reference string rep is 42 characters
5118 * in length, this means that it is not necessary to check any object with a string
5119 * repr < 42, and usually there aren't many of these objects. */
5121 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5123 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, unsigned long id
)
5125 const char *fmt
= "<reference.<%s>.%020lu>";
5127 sprintf(buf
, fmt
, refPtr
->tag
, id
);
5128 return JIM_REFERENCE_SPACE
;
5131 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
5133 static const Jim_ObjType referenceObjType
= {
5137 UpdateStringOfReference
,
5138 JIM_TYPE_REFERENCES
,
5141 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
5143 char buf
[JIM_REFERENCE_SPACE
+ 1];
5145 JimFormatReference(buf
, objPtr
->internalRep
.refValue
.refPtr
, objPtr
->internalRep
.refValue
.id
);
5146 JimSetStringBytes(objPtr
, buf
);
5149 /* returns true if 'c' is a valid reference tag character.
5150 * i.e. inside the range [_a-zA-Z0-9] */
5151 static int isrefchar(int c
)
5153 return (c
== '_' || isalnum(c
));
5156 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5158 unsigned long value
;
5160 const char *str
, *start
, *end
;
5162 Jim_Reference
*refPtr
;
5166 /* Get the string representation */
5167 str
= Jim_GetString(objPtr
, &len
);
5168 /* Check if it looks like a reference */
5169 if (len
< JIM_REFERENCE_SPACE
)
5173 end
= str
+ len
- 1;
5174 while (*start
== ' ')
5176 while (*end
== ' ' && end
> start
)
5178 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
5180 /* <reference.<1234567>.%020> */
5181 if (memcmp(start
, "<reference.<", 12) != 0)
5183 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
5185 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5186 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5187 if (!isrefchar(start
[12 + i
]))
5190 /* Extract info from the reference. */
5191 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
5193 /* Try to convert the ID into an unsigned long */
5194 value
= strtoul(refId
, &endptr
, 10);
5195 if (JimCheckConversion(refId
, endptr
) != JIM_OK
)
5197 /* Check if the reference really exists! */
5198 he
= Jim_FindHashEntry(&interp
->references
, &value
);
5200 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
5203 refPtr
= Jim_GetHashEntryVal(he
);
5204 /* Free the old internal repr and set the new one. */
5205 Jim_FreeIntRep(interp
, objPtr
);
5206 objPtr
->typePtr
= &referenceObjType
;
5207 objPtr
->internalRep
.refValue
.id
= value
;
5208 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5212 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
5216 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5217 * as finalizer command (or NULL if there is no finalizer).
5218 * The returned reference object has refcount = 0. */
5219 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
5221 struct Jim_Reference
*refPtr
;
5227 /* Perform the Garbage Collection if needed. */
5228 Jim_CollectIfNeeded(interp
);
5230 refPtr
= Jim_Alloc(sizeof(*refPtr
));
5231 refPtr
->objPtr
= objPtr
;
5232 Jim_IncrRefCount(objPtr
);
5233 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5235 Jim_IncrRefCount(cmdNamePtr
);
5236 id
= interp
->referenceNextId
++;
5237 Jim_AddHashEntry(&interp
->references
, &id
, refPtr
);
5238 refObjPtr
= Jim_NewObj(interp
);
5239 refObjPtr
->typePtr
= &referenceObjType
;
5240 refObjPtr
->bytes
= NULL
;
5241 refObjPtr
->internalRep
.refValue
.id
= id
;
5242 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5243 interp
->referenceNextId
++;
5244 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5245 * that does not pass the 'isrefchar' test is replaced with '_' */
5246 tag
= Jim_GetString(tagPtr
, &tagLen
);
5247 if (tagLen
> JIM_REFERENCE_TAGLEN
)
5248 tagLen
= JIM_REFERENCE_TAGLEN
;
5249 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5250 if (i
< tagLen
&& isrefchar(tag
[i
]))
5251 refPtr
->tag
[i
] = tag
[i
];
5253 refPtr
->tag
[i
] = '_';
5255 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
5259 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5261 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
5263 return objPtr
->internalRep
.refValue
.refPtr
;
5266 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
5268 Jim_Reference
*refPtr
;
5270 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5272 Jim_IncrRefCount(cmdNamePtr
);
5273 if (refPtr
->finalizerCmdNamePtr
)
5274 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5275 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5279 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
5281 Jim_Reference
*refPtr
;
5283 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5285 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
5289 /* -----------------------------------------------------------------------------
5290 * References Garbage Collection
5291 * ---------------------------------------------------------------------------*/
5293 /* This the hash table type for the "MARK" phase of the GC */
5294 static const Jim_HashTableType JimRefMarkHashTableType
= {
5295 JimReferencesHTHashFunction
, /* hash function */
5296 JimReferencesHTKeyDup
, /* key dup */
5298 JimReferencesHTKeyCompare
, /* key compare */
5299 JimReferencesHTKeyDestructor
, /* key destructor */
5300 NULL
/* val destructor */
5303 /* Performs the garbage collection. */
5304 int Jim_Collect(Jim_Interp
*interp
)
5307 Jim_HashTable marks
;
5308 Jim_HashTableIterator htiter
;
5312 /* Avoid recursive calls */
5313 if (interp
->lastCollectId
== -1) {
5314 /* Jim_Collect() already running. Return just now. */
5317 interp
->lastCollectId
= -1;
5319 /* Mark all the references found into the 'mark' hash table.
5320 * The references are searched in every live object that
5321 * is of a type that can contain references. */
5322 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
5323 objPtr
= interp
->liveList
;
5325 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
5326 const char *str
, *p
;
5329 /* If the object is of type reference, to get the
5330 * Id is simple... */
5331 if (objPtr
->typePtr
== &referenceObjType
) {
5332 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
5334 printf("MARK (reference): %d refcount: %d\n",
5335 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
5337 objPtr
= objPtr
->nextObjPtr
;
5340 /* Get the string repr of the object we want
5341 * to scan for references. */
5342 p
= str
= Jim_GetString(objPtr
, &len
);
5343 /* Skip objects too little to contain references. */
5344 if (len
< JIM_REFERENCE_SPACE
) {
5345 objPtr
= objPtr
->nextObjPtr
;
5348 /* Extract references from the object string repr. */
5353 if ((p
= strstr(p
, "<reference.<")) == NULL
)
5355 /* Check if it's a valid reference. */
5356 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
5358 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
5360 for (i
= 21; i
<= 40; i
++)
5361 if (!isdigit(UCHAR(p
[i
])))
5364 id
= strtoul(p
+ 21, NULL
, 10);
5366 /* Ok, a reference for the given ID
5367 * was found. Mark it. */
5368 Jim_AddHashEntry(&marks
, &id
, NULL
);
5370 printf("MARK: %d\n", (int)id
);
5372 p
+= JIM_REFERENCE_SPACE
;
5375 objPtr
= objPtr
->nextObjPtr
;
5378 /* Run the references hash table to destroy every reference that
5379 * is not referenced outside (not present in the mark HT). */
5380 JimInitHashTableIterator(&interp
->references
, &htiter
);
5381 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
5382 const unsigned long *refId
;
5383 Jim_Reference
*refPtr
;
5386 /* Check if in the mark phase we encountered
5387 * this reference. */
5388 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
5390 printf("COLLECTING %d\n", (int)*refId
);
5393 /* Drop the reference, but call the
5394 * finalizer first if registered. */
5395 refPtr
= Jim_GetHashEntryVal(he
);
5396 if (refPtr
->finalizerCmdNamePtr
) {
5397 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
5398 Jim_Obj
*objv
[3], *oldResult
;
5400 JimFormatReference(refstr
, refPtr
, *refId
);
5402 objv
[0] = refPtr
->finalizerCmdNamePtr
;
5403 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, JIM_REFERENCE_SPACE
);
5404 objv
[2] = refPtr
->objPtr
;
5406 /* Drop the reference itself */
5407 /* Avoid the finaliser being freed here */
5408 Jim_IncrRefCount(objv
[0]);
5409 /* Don't remove the reference from the hash table just yet
5410 * since that will free refPtr, and hence refPtr->objPtr
5413 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5414 oldResult
= interp
->result
;
5415 Jim_IncrRefCount(oldResult
);
5416 Jim_EvalObjVector(interp
, 3, objv
);
5417 Jim_SetResult(interp
, oldResult
);
5418 Jim_DecrRefCount(interp
, oldResult
);
5420 Jim_DecrRefCount(interp
, objv
[0]);
5422 Jim_DeleteHashEntry(&interp
->references
, refId
);
5425 Jim_FreeHashTable(&marks
);
5426 interp
->lastCollectId
= interp
->referenceNextId
;
5427 interp
->lastCollectTime
= time(NULL
);
5431 #define JIM_COLLECT_ID_PERIOD 5000
5432 #define JIM_COLLECT_TIME_PERIOD 300
5434 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
5436 unsigned long elapsedId
;
5439 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
5440 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
5443 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
5444 Jim_Collect(interp
);
5447 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5449 int Jim_IsBigEndian(void)
5456 return uval
.c
[0] == 1;
5459 /* -----------------------------------------------------------------------------
5460 * Interpreter related functions
5461 * ---------------------------------------------------------------------------*/
5463 Jim_Interp
*Jim_CreateInterp(void)
5465 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
5467 memset(i
, 0, sizeof(*i
));
5469 i
->maxCallFrameDepth
= JIM_MAX_CALLFRAME_DEPTH
;
5470 i
->maxEvalDepth
= JIM_MAX_EVAL_DEPTH
;
5471 i
->lastCollectTime
= time(NULL
);
5473 /* Note that we can create objects only after the
5474 * interpreter liveList and freeList pointers are
5475 * initialized to NULL. */
5476 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
5477 #ifdef JIM_REFERENCES
5478 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
5480 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
5481 Jim_InitHashTable(&i
->packages
, &JimPackageHashTableType
, NULL
);
5482 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
5483 i
->trueObj
= Jim_NewIntObj(i
, 1);
5484 i
->falseObj
= Jim_NewIntObj(i
, 0);
5485 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
, i
->emptyObj
);
5486 i
->errorFileNameObj
= i
->emptyObj
;
5487 i
->result
= i
->emptyObj
;
5488 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
5489 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
5490 i
->errorProc
= i
->emptyObj
;
5491 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
5492 i
->nullScriptObj
= Jim_NewEmptyStringObj(i
);
5493 Jim_IncrRefCount(i
->emptyObj
);
5494 Jim_IncrRefCount(i
->errorFileNameObj
);
5495 Jim_IncrRefCount(i
->result
);
5496 Jim_IncrRefCount(i
->stackTrace
);
5497 Jim_IncrRefCount(i
->unknown
);
5498 Jim_IncrRefCount(i
->currentScriptObj
);
5499 Jim_IncrRefCount(i
->nullScriptObj
);
5500 Jim_IncrRefCount(i
->errorProc
);
5501 Jim_IncrRefCount(i
->trueObj
);
5502 Jim_IncrRefCount(i
->falseObj
);
5504 /* Initialize key variables every interpreter should contain */
5505 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
5506 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
5508 Jim_SetVariableStrWithStr(i
, "tcl_platform(engine)", "Jim");
5509 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5510 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5511 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5512 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5513 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5514 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5515 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5520 void Jim_FreeInterp(Jim_Interp
*i
)
5522 Jim_CallFrame
*cf
, *cfx
;
5524 Jim_Obj
*objPtr
, *nextObjPtr
;
5526 /* Free the active call frames list - must be done before i->commands is destroyed */
5527 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5529 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5532 Jim_DecrRefCount(i
, i
->emptyObj
);
5533 Jim_DecrRefCount(i
, i
->trueObj
);
5534 Jim_DecrRefCount(i
, i
->falseObj
);
5535 Jim_DecrRefCount(i
, i
->result
);
5536 Jim_DecrRefCount(i
, i
->stackTrace
);
5537 Jim_DecrRefCount(i
, i
->errorProc
);
5538 Jim_DecrRefCount(i
, i
->unknown
);
5539 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5540 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5541 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5542 Jim_FreeHashTable(&i
->commands
);
5543 #ifdef JIM_REFERENCES
5544 Jim_FreeHashTable(&i
->references
);
5546 Jim_FreeHashTable(&i
->packages
);
5547 Jim_Free(i
->prngState
);
5548 Jim_FreeHashTable(&i
->assocData
);
5550 /* Check that the live object list is empty, otherwise
5551 * there is a memory leak. */
5552 #ifdef JIM_MAINTAINER
5553 if (i
->liveList
!= NULL
) {
5554 objPtr
= i
->liveList
;
5556 printf("\n-------------------------------------\n");
5557 printf("Objects still in the free list:\n");
5559 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5561 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5562 printf("%p (%d) %-10s: '%.20s...'\n",
5563 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5566 printf("%p (%d) %-10s: '%s'\n",
5567 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5569 if (objPtr
->typePtr
== &sourceObjType
) {
5570 printf("FILE %s LINE %d\n",
5571 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5572 objPtr
->internalRep
.sourceValue
.lineNumber
);
5574 objPtr
= objPtr
->nextObjPtr
;
5576 printf("-------------------------------------\n\n");
5577 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5581 /* Free all the freed objects. */
5582 objPtr
= i
->freeList
;
5584 nextObjPtr
= objPtr
->nextObjPtr
;
5586 objPtr
= nextObjPtr
;
5589 /* Free the free call frames list */
5590 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5593 Jim_FreeHashTable(&cf
->vars
);
5597 /* Free the interpreter structure. */
5601 /* Returns the call frame relative to the level represented by
5602 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5604 * This function accepts the 'level' argument in the form
5605 * of the commands [uplevel] and [upvar].
5607 * Returns NULL on error.
5609 * Note: for a function accepting a relative integer as level suitable
5610 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5612 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5616 Jim_CallFrame
*framePtr
;
5619 str
= Jim_String(levelObjPtr
);
5620 if (str
[0] == '#') {
5623 level
= jim_strtol(str
+ 1, &endptr
);
5624 if (str
[1] == '\0' || endptr
[0] != '\0') {
5629 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5633 /* Convert from a relative to an absolute level */
5634 level
= interp
->framePtr
->level
- level
;
5639 str
= "1"; /* Needed to format the error message. */
5640 level
= interp
->framePtr
->level
- 1;
5644 return interp
->topFramePtr
;
5648 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5649 if (framePtr
->level
== level
) {
5655 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5659 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5660 * as a relative integer like in the [info level ?level?] command.
5662 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5665 Jim_CallFrame
*framePtr
;
5667 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5669 /* Convert from a relative to an absolute level */
5670 level
= interp
->framePtr
->level
+ level
;
5674 return interp
->topFramePtr
;
5678 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5679 if (framePtr
->level
== level
) {
5685 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5689 static void JimResetStackTrace(Jim_Interp
*interp
)
5691 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5692 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5693 Jim_IncrRefCount(interp
->stackTrace
);
5696 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5700 /* Increment reference first in case these are the same object */
5701 Jim_IncrRefCount(stackTraceObj
);
5702 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5703 interp
->stackTrace
= stackTraceObj
;
5704 interp
->errorFlag
= 1;
5706 /* This is a bit ugly.
5707 * If the filename of the last entry of the stack trace is empty,
5708 * the next stack level should be added.
5710 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5712 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5713 interp
->addStackTrace
= 1;
5718 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5719 Jim_Obj
*fileNameObj
, int linenr
)
5721 if (strcmp(procname
, "unknown") == 0) {
5724 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5725 /* No useful info here */
5729 if (Jim_IsShared(interp
->stackTrace
)) {
5730 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5731 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5732 Jim_IncrRefCount(interp
->stackTrace
);
5735 /* If we have no procname but the previous element did, merge with that frame */
5736 if (!*procname
&& Jim_Length(fileNameObj
)) {
5737 /* Just a filename. Check the previous entry */
5738 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5741 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5742 if (Jim_Length(objPtr
)) {
5743 /* Yes, the previous level had procname */
5744 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5745 if (Jim_Length(objPtr
) == 0) {
5746 /* But no filename, so merge the new info with that frame */
5747 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5748 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5755 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5756 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5757 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5760 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5763 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5765 assocEntryPtr
->delProc
= delProc
;
5766 assocEntryPtr
->data
= data
;
5767 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5770 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5772 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5774 if (entryPtr
!= NULL
) {
5775 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5776 return assocEntryPtr
->data
;
5781 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5783 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5786 int Jim_GetExitCode(Jim_Interp
*interp
)
5788 return interp
->exitCode
;
5791 /* -----------------------------------------------------------------------------
5793 * ---------------------------------------------------------------------------*/
5794 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5795 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5797 static const Jim_ObjType intObjType
= {
5805 /* A coerced double is closer to an int than a double.
5806 * It is an int value temporarily masquerading as a double value.
5807 * i.e. it has the same string value as an int and Jim_GetWide()
5808 * succeeds, but also Jim_GetDouble() returns the value directly.
5810 static const Jim_ObjType coercedDoubleObjType
= {
5819 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5821 char buf
[JIM_INTEGER_SPACE
+ 1];
5822 jim_wide wideValue
= JimWideValue(objPtr
);
5825 if (wideValue
== 0) {
5829 char tmp
[JIM_INTEGER_SPACE
];
5833 if (wideValue
< 0) {
5836 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5837 * whereas C99 is always -6
5838 * coverity[dead_error_line]
5840 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5845 tmp
[num
++] = wideValue
% 10;
5849 for (i
= 0; i
< num
; i
++) {
5850 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5855 JimSetStringBytes(objPtr
, buf
);
5858 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5863 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5865 objPtr
->typePtr
= &intObjType
;
5869 /* Get the string representation */
5870 str
= Jim_String(objPtr
);
5871 /* Try to convert into a jim_wide */
5872 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5873 if (flags
& JIM_ERRMSG
) {
5874 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5878 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5879 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5882 /* Free the old internal repr and set the new one. */
5883 Jim_FreeIntRep(interp
, objPtr
);
5884 objPtr
->typePtr
= &intObjType
;
5885 objPtr
->internalRep
.wideValue
= wideValue
;
5889 #ifdef JIM_OPTIMIZATION
5890 static int JimIsWide(Jim_Obj
*objPtr
)
5892 return objPtr
->typePtr
== &intObjType
;
5896 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5898 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5900 *widePtr
= JimWideValue(objPtr
);
5904 /* Get a wide but does not set an error if the format is bad. */
5905 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5907 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5909 *widePtr
= JimWideValue(objPtr
);
5913 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5918 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5919 if (retval
== JIM_OK
) {
5920 *longPtr
= (long)wideValue
;
5926 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5930 objPtr
= Jim_NewObj(interp
);
5931 objPtr
->typePtr
= &intObjType
;
5932 objPtr
->bytes
= NULL
;
5933 objPtr
->internalRep
.wideValue
= wideValue
;
5937 /* -----------------------------------------------------------------------------
5939 * ---------------------------------------------------------------------------*/
5940 #define JIM_DOUBLE_SPACE 30
5942 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5943 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5945 static const Jim_ObjType doubleObjType
= {
5949 UpdateStringOfDouble
,
5955 #define isnan(X) ((X) != (X))
5959 #define isinf(X) (1.0 / (X) == 0.0)
5962 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5964 double value
= objPtr
->internalRep
.doubleValue
;
5967 JimSetStringBytes(objPtr
, "NaN");
5972 JimSetStringBytes(objPtr
, "-Inf");
5975 JimSetStringBytes(objPtr
, "Inf");
5980 char buf
[JIM_DOUBLE_SPACE
+ 1];
5982 int len
= sprintf(buf
, "%.12g", value
);
5984 /* Add a final ".0" if necessary */
5985 for (i
= 0; i
< len
; i
++) {
5986 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5987 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5988 /* If 'buf' ends in e-0nn or e+0nn, remove
5989 * the 0 after the + or - and reduce the length by 1
5991 char *e
= strchr(buf
, 'e');
5992 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5995 memmove(e
, e
+ 1, len
- (e
- buf
));
6001 if (buf
[i
] == '\0') {
6006 JimSetStringBytes(objPtr
, buf
);
6010 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6016 /* Preserve the string representation.
6017 * Needed so we can convert back to int without loss
6019 str
= Jim_String(objPtr
);
6021 #ifdef HAVE_LONG_LONG
6022 /* Assume a 53 bit mantissa */
6023 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6024 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6026 if (objPtr
->typePtr
== &intObjType
6027 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
6028 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
6030 /* Direct conversion to coerced double */
6031 objPtr
->typePtr
= &coercedDoubleObjType
;
6036 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
6037 /* Managed to convert to an int, so we can use this as a cooerced double */
6038 Jim_FreeIntRep(interp
, objPtr
);
6039 objPtr
->typePtr
= &coercedDoubleObjType
;
6040 objPtr
->internalRep
.wideValue
= wideValue
;
6044 /* Try to convert into a double */
6045 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6046 Jim_SetResultFormatted(interp
, "expected floating-point number but got \"%#s\"", objPtr
);
6049 /* Free the old internal repr and set the new one. */
6050 Jim_FreeIntRep(interp
, objPtr
);
6052 objPtr
->typePtr
= &doubleObjType
;
6053 objPtr
->internalRep
.doubleValue
= doubleValue
;
6057 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6059 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6060 *doublePtr
= JimWideValue(objPtr
);
6063 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6066 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6067 *doublePtr
= JimWideValue(objPtr
);
6070 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6075 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6079 objPtr
= Jim_NewObj(interp
);
6080 objPtr
->typePtr
= &doubleObjType
;
6081 objPtr
->bytes
= NULL
;
6082 objPtr
->internalRep
.doubleValue
= doubleValue
;
6086 /* -----------------------------------------------------------------------------
6087 * Boolean conversion
6088 * ---------------------------------------------------------------------------*/
6089 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
6091 int Jim_GetBoolean(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int * booleanPtr
)
6093 if (objPtr
->typePtr
!= &intObjType
&& SetBooleanFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
6095 *booleanPtr
= (int) JimWideValue(objPtr
);
6099 static int SetBooleanFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
6101 static const char * const falses
[] = {
6102 "0", "false", "no", "off", NULL
6104 static const char * const trues
[] = {
6105 "1", "true", "yes", "on", NULL
6111 if (Jim_GetEnum(interp
, objPtr
, falses
, &index
, NULL
, 0) == JIM_OK
) {
6113 } else if (Jim_GetEnum(interp
, objPtr
, trues
, &index
, NULL
, 0) == JIM_OK
) {
6116 if (flags
& JIM_ERRMSG
) {
6117 Jim_SetResultFormatted(interp
, "expected boolean but got \"%#s\"", objPtr
);
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp
, objPtr
);
6124 objPtr
->typePtr
= &intObjType
;
6125 objPtr
->internalRep
.wideValue
= boolean
;
6129 /* -----------------------------------------------------------------------------
6131 * ---------------------------------------------------------------------------*/
6132 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6133 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6134 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6135 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6136 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6137 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6139 /* Note that while the elements of the list may contain references,
6140 * the list object itself can't. This basically means that the
6141 * list object string representation as a whole can't contain references
6142 * that are not presents in the single elements. */
6143 static const Jim_ObjType listObjType
= {
6145 FreeListInternalRep
,
6151 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6155 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6156 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6158 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6161 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6165 JIM_NOTUSED(interp
);
6167 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6168 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6169 dupPtr
->internalRep
.listValue
.ele
=
6170 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6171 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6172 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6173 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6174 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6176 dupPtr
->typePtr
= &listObjType
;
6179 /* The following function checks if a given string can be encoded
6180 * into a list element without any kind of quoting, surrounded by braces,
6181 * or using escapes to quote. */
6182 #define JIM_ELESTR_SIMPLE 0
6183 #define JIM_ELESTR_BRACE 1
6184 #define JIM_ELESTR_QUOTE 2
6185 static unsigned char ListElementQuotingType(const char *s
, int len
)
6187 int i
, level
, blevel
, trySimple
= 1;
6189 /* Try with the SIMPLE case */
6191 return JIM_ELESTR_BRACE
;
6192 if (s
[0] == '"' || s
[0] == '{') {
6196 for (i
= 0; i
< len
; i
++) {
6217 return JIM_ELESTR_SIMPLE
;
6220 /* Test if it's possible to do with braces */
6221 if (s
[len
- 1] == '\\')
6222 return JIM_ELESTR_QUOTE
;
6225 for (i
= 0; i
< len
; i
++) {
6233 return JIM_ELESTR_QUOTE
;
6242 if (s
[i
+ 1] == '\n')
6243 return JIM_ELESTR_QUOTE
;
6244 else if (s
[i
+ 1] != '\0')
6250 return JIM_ELESTR_QUOTE
;
6255 return JIM_ELESTR_BRACE
;
6256 for (i
= 0; i
< len
; i
++) {
6270 return JIM_ELESTR_BRACE
;
6274 return JIM_ELESTR_SIMPLE
;
6276 return JIM_ELESTR_QUOTE
;
6279 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6280 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6282 * Returns the length of the result.
6284 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6337 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6339 #define STATIC_QUOTING_LEN 32
6340 int i
, bufLen
, realLength
;
6343 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6345 /* Estimate the space needed. */
6346 if (objc
> STATIC_QUOTING_LEN
) {
6347 quotingType
= Jim_Alloc(objc
);
6350 quotingType
= staticQuoting
;
6353 for (i
= 0; i
< objc
; i
++) {
6356 strRep
= Jim_GetString(objv
[i
], &len
);
6357 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6358 switch (quotingType
[i
]) {
6359 case JIM_ELESTR_SIMPLE
:
6360 if (i
!= 0 || strRep
[0] != '#') {
6364 /* Special case '#' on first element needs braces */
6365 quotingType
[i
] = JIM_ELESTR_BRACE
;
6367 case JIM_ELESTR_BRACE
:
6370 case JIM_ELESTR_QUOTE
:
6374 bufLen
++; /* elements separator. */
6378 /* Generate the string rep. */
6379 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6381 for (i
= 0; i
< objc
; i
++) {
6384 strRep
= Jim_GetString(objv
[i
], &len
);
6386 switch (quotingType
[i
]) {
6387 case JIM_ELESTR_SIMPLE
:
6388 memcpy(p
, strRep
, len
);
6392 case JIM_ELESTR_BRACE
:
6394 memcpy(p
, strRep
, len
);
6397 realLength
+= len
+ 2;
6399 case JIM_ELESTR_QUOTE
:
6400 if (i
== 0 && strRep
[0] == '#') {
6404 qlen
= BackslashQuoteString(strRep
, len
, p
);
6409 /* Add a separating space */
6410 if (i
+ 1 != objc
) {
6415 *p
= '\0'; /* nul term. */
6416 objPtr
->length
= realLength
;
6418 if (quotingType
!= staticQuoting
) {
6419 Jim_Free(quotingType
);
6423 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6425 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6428 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6430 struct JimParserCtx parser
;
6433 Jim_Obj
*fileNameObj
;
6436 if (objPtr
->typePtr
== &listObjType
) {
6440 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6441 * it also preserves any source location of the dict elements
6442 * which can be very useful
6444 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6445 Jim_Obj
**listObjPtrPtr
;
6449 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6450 for (i
= 0; i
< len
; i
++) {
6451 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6454 /* Now just switch the internal rep */
6455 Jim_FreeIntRep(interp
, objPtr
);
6456 objPtr
->typePtr
= &listObjType
;
6457 objPtr
->internalRep
.listValue
.len
= len
;
6458 objPtr
->internalRep
.listValue
.maxLen
= len
;
6459 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6464 /* Try to preserve information about filename / line number */
6465 if (objPtr
->typePtr
== &sourceObjType
) {
6466 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6467 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6470 fileNameObj
= interp
->emptyObj
;
6473 Jim_IncrRefCount(fileNameObj
);
6475 /* Get the string representation */
6476 str
= Jim_GetString(objPtr
, &strLen
);
6478 /* Free the old internal repr just now and initialize the
6479 * new one just now. The string->list conversion can't fail. */
6480 Jim_FreeIntRep(interp
, objPtr
);
6481 objPtr
->typePtr
= &listObjType
;
6482 objPtr
->internalRep
.listValue
.len
= 0;
6483 objPtr
->internalRep
.listValue
.maxLen
= 0;
6484 objPtr
->internalRep
.listValue
.ele
= NULL
;
6486 /* Convert into a list */
6488 JimParserInit(&parser
, str
, strLen
, linenr
);
6489 while (!parser
.eof
) {
6490 Jim_Obj
*elementPtr
;
6492 JimParseList(&parser
);
6493 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6495 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6496 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6497 ListAppendElement(objPtr
, elementPtr
);
6500 Jim_DecrRefCount(interp
, fileNameObj
);
6504 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6508 objPtr
= Jim_NewObj(interp
);
6509 objPtr
->typePtr
= &listObjType
;
6510 objPtr
->bytes
= NULL
;
6511 objPtr
->internalRep
.listValue
.ele
= NULL
;
6512 objPtr
->internalRep
.listValue
.len
= 0;
6513 objPtr
->internalRep
.listValue
.maxLen
= 0;
6516 ListInsertElements(objPtr
, 0, len
, elements
);
6522 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6523 * length of the vector. Note that the user of this function should make
6524 * sure that the list object can't shimmer while the vector returned
6525 * is in use, this vector is the one stored inside the internal representation
6526 * of the list object. This function is not exported, extensions should
6527 * always access to the List object elements using Jim_ListIndex(). */
6528 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6531 *listLen
= Jim_ListLength(interp
, listObj
);
6532 *listVec
= listObj
->internalRep
.listValue
.ele
;
6535 /* Sorting uses ints, but commands may return wide */
6536 static int JimSign(jim_wide w
)
6547 /* ListSortElements type values */
6563 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6566 static struct lsort_info
*sort_info
;
6568 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6570 Jim_Obj
*lObj
, *rObj
;
6572 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6573 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6574 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6576 return sort_info
->subfn(&lObj
, &rObj
);
6579 /* Sort the internal rep of a list. */
6580 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6582 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6585 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6587 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6590 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6592 jim_wide lhs
= 0, rhs
= 0;
6594 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6595 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6596 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6599 return JimSign(lhs
- rhs
) * sort_info
->order
;
6602 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6604 double lhs
= 0, rhs
= 0;
6606 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6607 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6608 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6614 return sort_info
->order
;
6616 return -sort_info
->order
;
6619 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6621 Jim_Obj
*compare_script
;
6626 /* This must be a valid list */
6627 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6628 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6629 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6631 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6633 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6634 longjmp(sort_info
->jmpbuf
, rc
);
6637 return JimSign(ret
) * sort_info
->order
;
6640 /* Remove duplicate elements from the (sorted) list in-place, according to the
6641 * comparison function, comp.
6643 * Note that the last unique value is kept, not the first
6645 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6649 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6651 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6652 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6653 /* Match, so replace the dest with the current source */
6654 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6657 /* No match, so keep the current source and move to the next destination */
6660 ele
[dst
] = ele
[src
];
6662 /* At end of list, keep the final element */
6663 ele
[++dst
] = ele
[src
];
6665 /* Set the new length */
6666 listObjPtr
->internalRep
.listValue
.len
= dst
;
6669 /* Sort a list *in place*. MUST be called with a non-shared list. */
6670 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6672 struct lsort_info
*prev_info
;
6674 typedef int (qsort_comparator
) (const void *, const void *);
6675 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6680 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6681 SetListFromAny(interp
, listObjPtr
);
6683 /* Allow lsort to be called reentrantly */
6684 prev_info
= sort_info
;
6687 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6688 len
= listObjPtr
->internalRep
.listValue
.len
;
6689 switch (info
->type
) {
6690 case JIM_LSORT_ASCII
:
6691 fn
= ListSortString
;
6693 case JIM_LSORT_NOCASE
:
6694 fn
= ListSortStringNoCase
;
6696 case JIM_LSORT_INTEGER
:
6697 fn
= ListSortInteger
;
6699 case JIM_LSORT_REAL
:
6702 case JIM_LSORT_COMMAND
:
6703 fn
= ListSortCommand
;
6706 fn
= NULL
; /* avoid warning */
6707 JimPanic((1, "ListSort called with invalid sort type"));
6708 return -1; /* Should not be run but keeps static analysers happy */
6711 if (info
->indexed
) {
6712 /* Need to interpose a "list index" function */
6714 fn
= ListSortIndexHelper
;
6717 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6718 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6720 if (info
->unique
&& len
> 1) {
6721 ListRemoveDuplicates(listObjPtr
, fn
);
6724 Jim_InvalidateStringRep(listObjPtr
);
6726 sort_info
= prev_info
;
6731 /* This is the low-level function to insert elements into a list.
6732 * The higher-level Jim_ListInsertElements() performs shared object
6733 * check and invalidates the string repr. This version is used
6734 * in the internals of the List Object and is not exported.
6736 * NOTE: this function can be called only against objects
6737 * with internal type of List.
6739 * An insertion point (idx) of -1 means end-of-list.
6741 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6743 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6744 int requiredLen
= currentLen
+ elemc
;
6748 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6749 if (requiredLen
< 2) {
6750 /* Don't do allocations of under 4 pointers. */
6757 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6758 sizeof(Jim_Obj
*) * requiredLen
);
6760 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6765 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6766 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6767 for (i
= 0; i
< elemc
; ++i
) {
6768 point
[i
] = elemVec
[i
];
6769 Jim_IncrRefCount(point
[i
]);
6771 listPtr
->internalRep
.listValue
.len
+= elemc
;
6774 /* Convenience call to ListInsertElements() to append a single element.
6776 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6778 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6781 /* Appends every element of appendListPtr into listPtr.
6782 * Both have to be of the list type.
6783 * Convenience call to ListInsertElements()
6785 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6787 ListInsertElements(listPtr
, -1,
6788 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6791 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6793 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6794 SetListFromAny(interp
, listPtr
);
6795 Jim_InvalidateStringRep(listPtr
);
6796 ListAppendElement(listPtr
, objPtr
);
6799 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6801 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6802 SetListFromAny(interp
, listPtr
);
6803 SetListFromAny(interp
, appendListPtr
);
6804 Jim_InvalidateStringRep(listPtr
);
6805 ListAppendList(listPtr
, appendListPtr
);
6808 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6810 SetListFromAny(interp
, objPtr
);
6811 return objPtr
->internalRep
.listValue
.len
;
6814 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6815 int objc
, Jim_Obj
*const *objVec
)
6817 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6818 SetListFromAny(interp
, listPtr
);
6819 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6820 idx
= listPtr
->internalRep
.listValue
.len
;
6823 Jim_InvalidateStringRep(listPtr
);
6824 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6827 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6829 SetListFromAny(interp
, listPtr
);
6830 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6831 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6835 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6836 return listPtr
->internalRep
.listValue
.ele
[idx
];
6839 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6841 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6842 if (*objPtrPtr
== NULL
) {
6843 if (flags
& JIM_ERRMSG
) {
6844 Jim_SetResultString(interp
, "list index out of range", -1);
6851 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6852 Jim_Obj
*newObjPtr
, int flags
)
6854 SetListFromAny(interp
, listPtr
);
6855 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6856 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6857 if (flags
& JIM_ERRMSG
) {
6858 Jim_SetResultString(interp
, "list index out of range", -1);
6863 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6864 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6865 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6866 Jim_IncrRefCount(newObjPtr
);
6870 /* Modify the list stored in the variable named 'varNamePtr'
6871 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6872 * with the new element 'newObjptr'. (implements the [lset] command) */
6873 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6874 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6876 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6879 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6882 if ((shared
= Jim_IsShared(objPtr
)))
6883 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6884 for (i
= 0; i
< indexc
- 1; i
++) {
6885 listObjPtr
= objPtr
;
6886 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6888 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6891 if (Jim_IsShared(objPtr
)) {
6892 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6893 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6895 Jim_InvalidateStringRep(listObjPtr
);
6897 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6899 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6901 Jim_InvalidateStringRep(objPtr
);
6902 Jim_InvalidateStringRep(varObjPtr
);
6903 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6905 Jim_SetResult(interp
, varObjPtr
);
6909 Jim_FreeNewObj(interp
, varObjPtr
);
6914 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6917 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6918 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6920 for (i
= 0; i
< listLen
; ) {
6921 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6922 if (++i
!= listLen
) {
6923 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6929 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6933 /* If all the objects in objv are lists,
6934 * it's possible to return a list as result, that's the
6935 * concatenation of all the lists. */
6936 for (i
= 0; i
< objc
; i
++) {
6937 if (!Jim_IsList(objv
[i
]))
6941 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6943 for (i
= 0; i
< objc
; i
++)
6944 ListAppendList(objPtr
, objv
[i
]);
6948 /* Else... we have to glue strings together */
6949 int len
= 0, objLen
;
6952 /* Compute the length */
6953 for (i
= 0; i
< objc
; i
++) {
6954 len
+= Jim_Length(objv
[i
]);
6958 /* Create the string rep, and a string object holding it. */
6959 p
= bytes
= Jim_Alloc(len
+ 1);
6960 for (i
= 0; i
< objc
; i
++) {
6961 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6963 /* Remove leading space */
6964 while (objLen
&& isspace(UCHAR(*s
))) {
6969 /* And trailing space */
6970 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6971 /* Handle trailing backslash-space case */
6972 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6978 memcpy(p
, s
, objLen
);
6980 if (i
+ 1 != objc
) {
6984 /* Drop the space calculated for this
6985 * element that is instead null. */
6991 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6995 /* Returns a list composed of the elements in the specified range.
6996 * first and start are directly accepted as Jim_Objects and
6997 * processed for the end?-index? case. */
6998 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6999 Jim_Obj
*lastObjPtr
)
7004 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
7005 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
7007 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
7008 first
= JimRelToAbsIndex(len
, first
);
7009 last
= JimRelToAbsIndex(len
, last
);
7010 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
7011 if (first
== 0 && last
== len
) {
7014 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
7017 /* -----------------------------------------------------------------------------
7019 * ---------------------------------------------------------------------------*/
7020 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
7021 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
7022 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
7023 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7025 /* Dict HashTable Type.
7027 * Keys and Values are Jim objects. */
7029 static unsigned int JimObjectHTHashFunction(const void *key
)
7032 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
7033 return Jim_GenHashFunction((const unsigned char *)str
, len
);
7036 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
7038 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
7041 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
7043 Jim_IncrRefCount((Jim_Obj
*)val
);
7047 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
7049 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
7052 static const Jim_HashTableType JimDictHashTableType
= {
7053 JimObjectHTHashFunction
, /* hash function */
7054 JimObjectHTKeyValDup
, /* key dup */
7055 JimObjectHTKeyValDup
, /* val dup */
7056 JimObjectHTKeyCompare
, /* key compare */
7057 JimObjectHTKeyValDestructor
, /* key destructor */
7058 JimObjectHTKeyValDestructor
/* val destructor */
7061 /* Note that while the elements of the dict may contain references,
7062 * the list object itself can't. This basically means that the
7063 * dict object string representation as a whole can't contain references
7064 * that are not presents in the single elements. */
7065 static const Jim_ObjType dictObjType
= {
7067 FreeDictInternalRep
,
7073 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7075 JIM_NOTUSED(interp
);
7077 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
7078 Jim_Free(objPtr
->internalRep
.ptr
);
7081 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
7083 Jim_HashTable
*ht
, *dupHt
;
7084 Jim_HashTableIterator htiter
;
7087 /* Create a new hash table */
7088 ht
= srcPtr
->internalRep
.ptr
;
7089 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7090 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7092 Jim_ExpandHashTable(dupHt
, ht
->size
);
7093 /* Copy every element from the source to the dup hash table */
7094 JimInitHashTableIterator(ht
, &htiter
);
7095 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7096 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7099 dupPtr
->internalRep
.ptr
= dupHt
;
7100 dupPtr
->typePtr
= &dictObjType
;
7103 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7106 Jim_HashTableIterator htiter
;
7111 ht
= dictPtr
->internalRep
.ptr
;
7113 /* Turn the hash table into a flat vector of Jim_Objects. */
7114 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7115 JimInitHashTableIterator(ht
, &htiter
);
7117 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7118 objv
[i
++] = Jim_GetHashEntryKey(he
);
7119 objv
[i
++] = Jim_GetHashEntryVal(he
);
7125 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7127 /* Turn the hash table into a flat vector of Jim_Objects. */
7129 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7131 /* And now generate the string rep as a list */
7132 JimMakeListStringRep(objPtr
, objv
, len
);
7137 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7141 if (objPtr
->typePtr
== &dictObjType
) {
7145 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7146 /* A shared list, so get the string representation now to avoid
7147 * changing the order in case of fast conversion to dict.
7152 /* For simplicity, convert a non-list object to a list and then to a dict */
7153 listlen
= Jim_ListLength(interp
, objPtr
);
7155 Jim_SetResultString(interp
, "missing value to go with key", -1);
7159 /* Converting from a list to a dict can't fail */
7163 ht
= Jim_Alloc(sizeof(*ht
));
7164 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7166 for (i
= 0; i
< listlen
; i
+= 2) {
7167 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7168 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7170 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7173 Jim_FreeIntRep(interp
, objPtr
);
7174 objPtr
->typePtr
= &dictObjType
;
7175 objPtr
->internalRep
.ptr
= ht
;
7181 /* Dict object API */
7183 /* Add an element to a dict. objPtr must be of the "dict" type.
7184 * The higher-level exported function is Jim_DictAddElement().
7185 * If an element with the specified key already exists, the value
7186 * associated is replaced with the new one.
7188 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7189 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7190 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7192 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7194 if (valueObjPtr
== NULL
) { /* unset */
7195 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7197 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7201 /* Add an element, higher-level interface for DictAddElement().
7202 * If valueObjPtr == NULL, the key is removed if it exists. */
7203 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7204 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7206 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7207 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7210 Jim_InvalidateStringRep(objPtr
);
7211 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7214 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7219 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7221 objPtr
= Jim_NewObj(interp
);
7222 objPtr
->typePtr
= &dictObjType
;
7223 objPtr
->bytes
= NULL
;
7224 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7225 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7226 for (i
= 0; i
< len
; i
+= 2)
7227 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7231 /* Return the value associated to the specified dict key
7232 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7234 * Sets *objPtrPtr to non-NULL only upon success.
7236 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7237 Jim_Obj
**objPtrPtr
, int flags
)
7242 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7245 ht
= dictPtr
->internalRep
.ptr
;
7246 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7247 if (flags
& JIM_ERRMSG
) {
7248 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7253 *objPtrPtr
= Jim_GetHashEntryVal(he
);
7258 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7259 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7261 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7264 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7270 /* Return the value associated to the specified dict keys */
7271 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7272 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7277 *objPtrPtr
= dictPtr
;
7281 for (i
= 0; i
< keyc
; i
++) {
7284 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7290 *objPtrPtr
= dictPtr
;
7294 /* Modify the dict stored into the variable named 'varNamePtr'
7295 * setting the element specified by the 'keyc' keys objects in 'keyv',
7296 * with the new value of the element 'newObjPtr'.
7298 * If newObjPtr == NULL the operation is to remove the given key
7299 * from the dictionary.
7301 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7302 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7304 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7305 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7307 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7310 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7311 if (objPtr
== NULL
) {
7312 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7313 /* Cannot remove a key from non existing var */
7316 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7317 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7318 Jim_FreeNewObj(interp
, varObjPtr
);
7322 if ((shared
= Jim_IsShared(objPtr
)))
7323 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7324 for (i
= 0; i
< keyc
; i
++) {
7325 dictObjPtr
= objPtr
;
7327 /* Check if it's a valid dictionary */
7328 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7332 if (i
== keyc
- 1) {
7333 /* Last key: Note that error on unset with missing last key is OK */
7334 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7335 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7342 /* Check if the given key exists. */
7343 Jim_InvalidateStringRep(dictObjPtr
);
7344 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7345 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7346 /* This key exists at the current level.
7347 * Make sure it's not shared!. */
7348 if (Jim_IsShared(objPtr
)) {
7349 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7350 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7354 /* Key not found. If it's an [unset] operation
7355 * this is an error. Only the last key may not
7357 if (newObjPtr
== NULL
) {
7360 /* Otherwise set an empty dictionary
7361 * as key's value. */
7362 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7363 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7366 /* XXX: Is this necessary? */
7367 Jim_InvalidateStringRep(objPtr
);
7368 Jim_InvalidateStringRep(varObjPtr
);
7369 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7372 Jim_SetResult(interp
, varObjPtr
);
7376 Jim_FreeNewObj(interp
, varObjPtr
);
7381 /* -----------------------------------------------------------------------------
7383 * ---------------------------------------------------------------------------*/
7384 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7385 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7387 static const Jim_ObjType indexObjType
= {
7391 UpdateStringOfIndex
,
7395 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7397 if (objPtr
->internalRep
.intValue
== -1) {
7398 JimSetStringBytes(objPtr
, "end");
7401 char buf
[JIM_INTEGER_SPACE
+ 1];
7402 if (objPtr
->internalRep
.intValue
>= 0) {
7403 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7407 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7409 JimSetStringBytes(objPtr
, buf
);
7413 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7419 /* Get the string representation */
7420 str
= Jim_String(objPtr
);
7422 /* Try to convert into an index */
7423 if (strncmp(str
, "end", 3) == 0) {
7429 idx
= jim_strtol(str
, &endptr
);
7431 if (endptr
== str
) {
7437 /* Now str may include or +<num> or -<num> */
7438 if (*str
== '+' || *str
== '-') {
7439 int sign
= (*str
== '+' ? 1 : -1);
7441 idx
+= sign
* jim_strtol(++str
, &endptr
);
7442 if (str
== endptr
|| *endptr
) {
7447 /* The only thing left should be spaces */
7448 while (isspace(UCHAR(*str
))) {
7459 /* end-1 is repesented as -2 */
7467 /* Free the old internal repr and set the new one. */
7468 Jim_FreeIntRep(interp
, objPtr
);
7469 objPtr
->typePtr
= &indexObjType
;
7470 objPtr
->internalRep
.intValue
= idx
;
7474 Jim_SetResultFormatted(interp
,
7475 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7479 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7481 /* Avoid shimmering if the object is an integer. */
7482 if (objPtr
->typePtr
== &intObjType
) {
7483 jim_wide val
= JimWideValue(objPtr
);
7486 *indexPtr
= -INT_MAX
;
7487 else if (val
> INT_MAX
)
7488 *indexPtr
= INT_MAX
;
7490 *indexPtr
= (int)val
;
7493 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7495 *indexPtr
= objPtr
->internalRep
.intValue
;
7499 /* -----------------------------------------------------------------------------
7500 * Return Code Object.
7501 * ---------------------------------------------------------------------------*/
7503 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7504 static const char * const jimReturnCodes
[] = {
7516 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7518 static const Jim_ObjType returnCodeObjType
= {
7526 /* Converts a (standard) return code to a string. Returns "?" for
7527 * non-standard return codes.
7529 const char *Jim_ReturnCode(int code
)
7531 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7535 return jimReturnCodes
[code
];
7539 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7544 /* Try to convert into an integer */
7545 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7546 returnCode
= (int)wideValue
;
7547 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7548 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7551 /* Free the old internal repr and set the new one. */
7552 Jim_FreeIntRep(interp
, objPtr
);
7553 objPtr
->typePtr
= &returnCodeObjType
;
7554 objPtr
->internalRep
.intValue
= returnCode
;
7558 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7560 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7562 *intPtr
= objPtr
->internalRep
.intValue
;
7566 /* -----------------------------------------------------------------------------
7567 * Expression Parsing
7568 * ---------------------------------------------------------------------------*/
7569 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7570 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7571 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7572 static int JimParseExprBoolean(struct JimParserCtx
*pc
);
7574 /* Exrp's Stack machine operators opcodes. */
7576 /* Binary operators (numbers) */
7579 /* Continues on from the JIM_TT_ space */
7581 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7596 JIM_EXPROP_BITAND
, /* 35 */
7600 /* Note must keep these together */
7601 JIM_EXPROP_LOGICAND
, /* 38 */
7602 JIM_EXPROP_LOGICAND_LEFT
,
7603 JIM_EXPROP_LOGICAND_RIGHT
,
7606 JIM_EXPROP_LOGICOR
, /* 41 */
7607 JIM_EXPROP_LOGICOR_LEFT
,
7608 JIM_EXPROP_LOGICOR_RIGHT
,
7611 /* Ternary operators */
7612 JIM_EXPROP_TERNARY
, /* 44 */
7613 JIM_EXPROP_TERNARY_LEFT
,
7614 JIM_EXPROP_TERNARY_RIGHT
,
7617 JIM_EXPROP_COLON
, /* 47 */
7618 JIM_EXPROP_COLON_LEFT
,
7619 JIM_EXPROP_COLON_RIGHT
,
7621 JIM_EXPROP_POW
, /* 50 */
7623 /* Binary operators (strings) */
7624 JIM_EXPROP_STREQ
, /* 51 */
7629 /* Unary operators (numbers) */
7630 JIM_EXPROP_NOT
, /* 55 */
7632 JIM_EXPROP_UNARYMINUS
,
7633 JIM_EXPROP_UNARYPLUS
,
7636 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7637 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7638 JIM_EXPROP_FUNC_WIDE
,
7639 JIM_EXPROP_FUNC_ABS
,
7640 JIM_EXPROP_FUNC_DOUBLE
,
7641 JIM_EXPROP_FUNC_ROUND
,
7642 JIM_EXPROP_FUNC_RAND
,
7643 JIM_EXPROP_FUNC_SRAND
,
7645 /* math functions from libm */
7646 JIM_EXPROP_FUNC_SIN
, /* 65 */
7647 JIM_EXPROP_FUNC_COS
,
7648 JIM_EXPROP_FUNC_TAN
,
7649 JIM_EXPROP_FUNC_ASIN
,
7650 JIM_EXPROP_FUNC_ACOS
,
7651 JIM_EXPROP_FUNC_ATAN
,
7652 JIM_EXPROP_FUNC_ATAN2
,
7653 JIM_EXPROP_FUNC_SINH
,
7654 JIM_EXPROP_FUNC_COSH
,
7655 JIM_EXPROP_FUNC_TANH
,
7656 JIM_EXPROP_FUNC_CEIL
,
7657 JIM_EXPROP_FUNC_FLOOR
,
7658 JIM_EXPROP_FUNC_EXP
,
7659 JIM_EXPROP_FUNC_LOG
,
7660 JIM_EXPROP_FUNC_LOG10
,
7661 JIM_EXPROP_FUNC_SQRT
,
7662 JIM_EXPROP_FUNC_POW
,
7663 JIM_EXPROP_FUNC_HYPOT
,
7664 JIM_EXPROP_FUNC_FMOD
,
7675 /* Operators table */
7676 typedef struct Jim_ExprOperator
7679 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7680 unsigned char precedence
;
7681 unsigned char arity
;
7683 unsigned char namelen
;
7686 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7688 Jim_IncrRefCount(obj
);
7689 e
->stack
[e
->stacklen
++] = obj
;
7692 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7694 return e
->stack
[--e
->stacklen
];
7697 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7701 Jim_Obj
*A
= ExprPop(e
);
7703 jim_wide wA
, wC
= 0;
7705 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7706 switch (e
->opcode
) {
7707 case JIM_EXPROP_FUNC_INT
:
7708 case JIM_EXPROP_FUNC_WIDE
:
7709 case JIM_EXPROP_FUNC_ROUND
:
7710 case JIM_EXPROP_UNARYPLUS
:
7713 case JIM_EXPROP_FUNC_DOUBLE
:
7717 case JIM_EXPROP_FUNC_ABS
:
7718 wC
= wA
>= 0 ? wA
: -wA
;
7720 case JIM_EXPROP_UNARYMINUS
:
7723 case JIM_EXPROP_NOT
:
7730 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7731 switch (e
->opcode
) {
7732 case JIM_EXPROP_FUNC_INT
:
7733 case JIM_EXPROP_FUNC_WIDE
:
7736 case JIM_EXPROP_FUNC_ROUND
:
7737 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7739 case JIM_EXPROP_FUNC_DOUBLE
:
7740 case JIM_EXPROP_UNARYPLUS
:
7744 case JIM_EXPROP_FUNC_ABS
:
7745 #ifdef JIM_MATH_FUNCTIONS
7748 dC
= dA
>= 0 ? dA
: -dA
;
7752 case JIM_EXPROP_UNARYMINUS
:
7756 case JIM_EXPROP_NOT
:
7766 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7769 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7773 Jim_DecrRefCount(interp
, A
);
7778 static double JimRandDouble(Jim_Interp
*interp
)
7781 JimRandomBytes(interp
, &x
, sizeof(x
));
7783 return (double)x
/ (unsigned long)~0;
7786 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7788 Jim_Obj
*A
= ExprPop(e
);
7791 int rc
= Jim_GetWide(interp
, A
, &wA
);
7793 switch (e
->opcode
) {
7794 case JIM_EXPROP_BITNOT
:
7795 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7797 case JIM_EXPROP_FUNC_SRAND
:
7798 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7799 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7806 Jim_DecrRefCount(interp
, A
);
7811 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7813 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7815 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7820 #ifdef JIM_MATH_FUNCTIONS
7821 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7824 Jim_Obj
*A
= ExprPop(e
);
7827 rc
= Jim_GetDouble(interp
, A
, &dA
);
7829 switch (e
->opcode
) {
7830 case JIM_EXPROP_FUNC_SIN
:
7833 case JIM_EXPROP_FUNC_COS
:
7836 case JIM_EXPROP_FUNC_TAN
:
7839 case JIM_EXPROP_FUNC_ASIN
:
7842 case JIM_EXPROP_FUNC_ACOS
:
7845 case JIM_EXPROP_FUNC_ATAN
:
7848 case JIM_EXPROP_FUNC_SINH
:
7851 case JIM_EXPROP_FUNC_COSH
:
7854 case JIM_EXPROP_FUNC_TANH
:
7857 case JIM_EXPROP_FUNC_CEIL
:
7860 case JIM_EXPROP_FUNC_FLOOR
:
7863 case JIM_EXPROP_FUNC_EXP
:
7866 case JIM_EXPROP_FUNC_LOG
:
7869 case JIM_EXPROP_FUNC_LOG10
:
7872 case JIM_EXPROP_FUNC_SQRT
:
7878 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7881 Jim_DecrRefCount(interp
, A
);
7887 /* A binary operation on two ints */
7888 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7890 Jim_Obj
*B
= ExprPop(e
);
7891 Jim_Obj
*A
= ExprPop(e
);
7895 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7900 switch (e
->opcode
) {
7901 case JIM_EXPROP_LSHIFT
:
7904 case JIM_EXPROP_RSHIFT
:
7907 case JIM_EXPROP_BITAND
:
7910 case JIM_EXPROP_BITXOR
:
7913 case JIM_EXPROP_BITOR
:
7916 case JIM_EXPROP_MOD
:
7919 Jim_SetResultString(interp
, "Division by zero", -1);
7926 * This code is tricky: C doesn't guarantee much
7927 * about the quotient or remainder, but Tcl does.
7928 * The remainder always has the same sign as the
7929 * divisor and a smaller absolute value.
7947 case JIM_EXPROP_ROTL
:
7948 case JIM_EXPROP_ROTR
:{
7949 /* uint32_t would be better. But not everyone has inttypes.h? */
7950 unsigned long uA
= (unsigned long)wA
;
7951 unsigned long uB
= (unsigned long)wB
;
7952 const unsigned int S
= sizeof(unsigned long) * 8;
7954 /* Shift left by the word size or more is undefined. */
7957 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7960 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7966 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7970 Jim_DecrRefCount(interp
, A
);
7971 Jim_DecrRefCount(interp
, B
);
7977 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7978 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7981 double dA
, dB
, dC
= 0;
7982 jim_wide wA
, wB
, wC
= 0;
7984 Jim_Obj
*B
= ExprPop(e
);
7985 Jim_Obj
*A
= ExprPop(e
);
7987 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7988 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7989 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7993 switch (e
->opcode
) {
7994 case JIM_EXPROP_POW
:
7995 case JIM_EXPROP_FUNC_POW
:
7996 if (wA
== 0 && wB
< 0) {
7997 Jim_SetResultString(interp
, "exponentiation of zero by negative power", -1);
8001 wC
= JimPowWide(wA
, wB
);
8003 case JIM_EXPROP_ADD
:
8006 case JIM_EXPROP_SUB
:
8009 case JIM_EXPROP_MUL
:
8012 case JIM_EXPROP_DIV
:
8014 Jim_SetResultString(interp
, "Division by zero", -1);
8022 * This code is tricky: C doesn't guarantee much
8023 * about the quotient or remainder, but Tcl does.
8024 * The remainder always has the same sign as the
8025 * divisor and a smaller absolute value.
8043 case JIM_EXPROP_LTE
:
8046 case JIM_EXPROP_GTE
:
8049 case JIM_EXPROP_NUMEQ
:
8052 case JIM_EXPROP_NUMNE
:
8057 if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
8058 switch (e
->opcode
) {
8059 #ifndef JIM_MATH_FUNCTIONS
8060 case JIM_EXPROP_POW
:
8061 case JIM_EXPROP_FUNC_POW
:
8062 case JIM_EXPROP_FUNC_ATAN2
:
8063 case JIM_EXPROP_FUNC_HYPOT
:
8064 case JIM_EXPROP_FUNC_FMOD
:
8065 Jim_SetResultString(interp
, "unsupported", -1);
8069 case JIM_EXPROP_POW
:
8070 case JIM_EXPROP_FUNC_POW
:
8073 case JIM_EXPROP_FUNC_ATAN2
:
8076 case JIM_EXPROP_FUNC_HYPOT
:
8079 case JIM_EXPROP_FUNC_FMOD
:
8083 case JIM_EXPROP_ADD
:
8086 case JIM_EXPROP_SUB
:
8089 case JIM_EXPROP_MUL
:
8092 case JIM_EXPROP_DIV
:
8095 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
8097 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
8110 case JIM_EXPROP_LTE
:
8113 case JIM_EXPROP_GTE
:
8116 case JIM_EXPROP_NUMEQ
:
8119 case JIM_EXPROP_NUMNE
:
8125 /* Handle the string case */
8127 /* XXX: Could optimise the eq/ne case by checking lengths */
8128 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8130 switch (e
->opcode
) {
8137 case JIM_EXPROP_LTE
:
8140 case JIM_EXPROP_GTE
:
8143 case JIM_EXPROP_NUMEQ
:
8146 case JIM_EXPROP_NUMNE
:
8151 /* If we get here, it is an error */
8154 Jim_DecrRefCount(interp
, A
);
8155 Jim_DecrRefCount(interp
, B
);
8158 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8161 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8165 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8170 listlen
= Jim_ListLength(interp
, listObjPtr
);
8171 for (i
= 0; i
< listlen
; i
++) {
8172 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8179 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8181 Jim_Obj
*B
= ExprPop(e
);
8182 Jim_Obj
*A
= ExprPop(e
);
8186 switch (e
->opcode
) {
8187 case JIM_EXPROP_STREQ
:
8188 case JIM_EXPROP_STRNE
:
8189 wC
= Jim_StringEqObj(A
, B
);
8190 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8194 case JIM_EXPROP_STRIN
:
8195 wC
= JimSearchList(interp
, B
, A
);
8197 case JIM_EXPROP_STRNI
:
8198 wC
= !JimSearchList(interp
, B
, A
);
8203 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8205 Jim_DecrRefCount(interp
, A
);
8206 Jim_DecrRefCount(interp
, B
);
8211 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8217 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8220 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8223 if (Jim_GetBoolean(interp
, obj
, &b
) == JIM_OK
) {
8229 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8231 Jim_Obj
*skip
= ExprPop(e
);
8232 Jim_Obj
*A
= ExprPop(e
);
8235 switch (ExprBool(interp
, A
)) {
8237 /* false, so skip RHS opcodes with a 0 result */
8238 e
->skip
= JimWideValue(skip
);
8239 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8243 /* true so continue */
8250 Jim_DecrRefCount(interp
, A
);
8251 Jim_DecrRefCount(interp
, skip
);
8256 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8258 Jim_Obj
*skip
= ExprPop(e
);
8259 Jim_Obj
*A
= ExprPop(e
);
8262 switch (ExprBool(interp
, A
)) {
8264 /* false, so do nothing */
8268 /* true so skip RHS opcodes with a 1 result */
8269 e
->skip
= JimWideValue(skip
);
8270 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8278 Jim_DecrRefCount(interp
, A
);
8279 Jim_DecrRefCount(interp
, skip
);
8284 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8286 Jim_Obj
*A
= ExprPop(e
);
8289 switch (ExprBool(interp
, A
)) {
8291 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8295 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8303 Jim_DecrRefCount(interp
, A
);
8308 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8310 Jim_Obj
*skip
= ExprPop(e
);
8311 Jim_Obj
*A
= ExprPop(e
);
8317 switch (ExprBool(interp
, A
)) {
8319 /* false, skip RHS opcodes */
8320 e
->skip
= JimWideValue(skip
);
8321 /* Push a dummy value */
8322 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8326 /* true so do nothing */
8334 Jim_DecrRefCount(interp
, A
);
8335 Jim_DecrRefCount(interp
, skip
);
8340 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8342 Jim_Obj
*skip
= ExprPop(e
);
8343 Jim_Obj
*B
= ExprPop(e
);
8344 Jim_Obj
*A
= ExprPop(e
);
8346 /* No need to check for A as non-boolean */
8347 if (ExprBool(interp
, A
)) {
8348 /* true, so skip RHS opcodes */
8349 e
->skip
= JimWideValue(skip
);
8350 /* Repush B as the answer */
8354 Jim_DecrRefCount(interp
, skip
);
8355 Jim_DecrRefCount(interp
, A
);
8356 Jim_DecrRefCount(interp
, B
);
8360 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8371 RIGHT_ASSOC
, /* reuse this field for right associativity too */
8374 /* name - precedence - arity - opcode
8376 * This array *must* be kept in sync with the JIM_EXPROP enum.
8378 * The following macros pre-compute the string length at compile time.
8380 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8381 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8383 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8384 OPRINIT("*", 110, 2, JimExprOpBin
),
8385 OPRINIT("/", 110, 2, JimExprOpBin
),
8386 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8388 OPRINIT("-", 100, 2, JimExprOpBin
),
8389 OPRINIT("+", 100, 2, JimExprOpBin
),
8391 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8392 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8394 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8395 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8397 OPRINIT("<", 80, 2, JimExprOpBin
),
8398 OPRINIT(">", 80, 2, JimExprOpBin
),
8399 OPRINIT("<=", 80, 2, JimExprOpBin
),
8400 OPRINIT(">=", 80, 2, JimExprOpBin
),
8402 OPRINIT("==", 70, 2, JimExprOpBin
),
8403 OPRINIT("!=", 70, 2, JimExprOpBin
),
8405 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8406 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8407 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8409 OPRINIT_ATTR("&&", 10, 2, NULL
, LAZY_OP
),
8410 OPRINIT_ATTR(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8411 OPRINIT_ATTR(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8413 OPRINIT_ATTR("||", 9, 2, NULL
, LAZY_OP
),
8414 OPRINIT_ATTR(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8415 OPRINIT_ATTR(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8417 OPRINIT_ATTR("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8418 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8419 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8421 OPRINIT_ATTR(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8422 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8423 OPRINIT_ATTR(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8425 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8426 OPRINIT_ATTR("**", 120, 2, JimExprOpBin
, RIGHT_ASSOC
),
8428 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8429 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8431 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8432 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8434 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8435 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8436 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8437 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8441 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8442 OPRINIT("wide", 200, 1, JimExprOpNumUnary
),
8443 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8444 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8445 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8446 OPRINIT("rand", 200, 0, JimExprOpNone
),
8447 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8449 #ifdef JIM_MATH_FUNCTIONS
8450 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8451 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8452 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8453 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8454 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8455 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8456 OPRINIT("atan2", 200, 2, JimExprOpBin
),
8457 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8458 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8459 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8460 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8461 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8462 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8463 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8464 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8465 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8466 OPRINIT("pow", 200, 2, JimExprOpBin
),
8467 OPRINIT("hypot", 200, 2, JimExprOpBin
),
8468 OPRINIT("fmod", 200, 2, JimExprOpBin
),
8474 #define JIM_EXPR_OPERATORS_NUM \
8475 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8477 static int JimParseExpression(struct JimParserCtx
*pc
)
8479 /* Discard spaces and quoted newline */
8480 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8481 if (*pc
->p
== '\n') {
8489 pc
->tline
= pc
->linenr
;
8494 pc
->tt
= JIM_TT_EOL
;
8500 pc
->tt
= JIM_TT_SUBEXPR_START
;
8503 pc
->tt
= JIM_TT_SUBEXPR_END
;
8506 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8513 return JimParseCmd(pc
);
8515 if (JimParseVar(pc
) == JIM_ERR
)
8516 return JimParseExprOperator(pc
);
8518 /* Don't allow expr sugar in expressions */
8519 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8536 return JimParseExprNumber(pc
);
8538 return JimParseQuote(pc
);
8540 return JimParseBrace(pc
);
8546 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8547 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8548 return JimParseExprOperator(pc
);
8554 if (JimParseExprBoolean(pc
) == JIM_ERR
)
8555 return JimParseExprOperator(pc
);
8558 return JimParseExprOperator(pc
);
8564 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8568 /* Assume an integer for now */
8569 pc
->tt
= JIM_TT_EXPR_INT
;
8571 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8572 /* Tried as an integer, but perhaps it parses as a double */
8573 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8574 /* Some stupid compilers insist they are cleverer that
8575 * we are. Even a (void) cast doesn't prevent this warning!
8577 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8578 if (end
== pc
->tstart
)
8581 /* Yes, double captured more chars */
8582 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8586 pc
->tend
= pc
->p
- 1;
8587 pc
->len
-= (pc
->p
- pc
->tstart
);
8591 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8593 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8596 for (i
= 0; irrationals
[i
]; i
++) {
8597 const char *irr
= irrationals
[i
];
8599 if (strncmp(irr
, pc
->p
, 3) == 0) {
8602 pc
->tend
= pc
->p
- 1;
8603 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8610 static int JimParseExprBoolean(struct JimParserCtx
*pc
)
8612 const char *booleans
[] = { "false", "no", "off", "true", "yes", "on", NULL
};
8613 const int lengths
[] = { 5, 2, 3, 4, 3, 2, 0 };
8616 for (i
= 0; booleans
[i
]; i
++) {
8617 const char *boolean
= booleans
[i
];
8618 int length
= lengths
[i
];
8620 if (strncmp(boolean
, pc
->p
, length
) == 0) {
8623 pc
->tend
= pc
->p
- 1;
8624 pc
->tt
= JIM_TT_EXPR_BOOLEAN
;
8631 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8634 int bestIdx
= -1, bestLen
= 0;
8636 /* Try to get the longest match. */
8637 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8638 const char * const opname
= Jim_ExprOperators
[i
].name
;
8639 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8641 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8645 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8646 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8650 if (bestIdx
== -1) {
8654 /* Validate paretheses around function arguments */
8655 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8656 const char *p
= pc
->p
+ bestLen
;
8657 int len
= pc
->len
- bestLen
;
8659 while (len
&& isspace(UCHAR(*p
))) {
8667 pc
->tend
= pc
->p
+ bestLen
- 1;
8675 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8677 static Jim_ExprOperator dummy_op
;
8678 if (opcode
< JIM_TT_EXPR_OP
) {
8681 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8684 const char *jim_tt_name(int type
)
8686 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8687 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8688 "DBL", "BOO", "$()" };
8689 if (type
< JIM_TT_EXPR_OP
) {
8690 return tt_names
[type
];
8692 else if (type
== JIM_EXPROP_UNARYMINUS
) {
8695 else if (type
== JIM_EXPROP_UNARYPLUS
) {
8699 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8700 static char buf
[20];
8705 sprintf(buf
, "(%d)", type
);
8710 /* -----------------------------------------------------------------------------
8712 * ---------------------------------------------------------------------------*/
8713 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8714 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8715 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8717 static const Jim_ObjType exprObjType
= {
8719 FreeExprInternalRep
,
8722 JIM_TYPE_REFERENCES
,
8725 /* Expr bytecode structure */
8726 typedef struct ExprByteCode
8728 ScriptToken
*token
; /* Tokens array. */
8729 int len
; /* Length as number of tokens. */
8730 int inUse
; /* Used for sharing. */
8733 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8737 for (i
= 0; i
< expr
->len
; i
++) {
8738 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8740 Jim_Free(expr
->token
);
8744 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8746 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8749 if (--expr
->inUse
!= 0) {
8753 ExprFreeByteCode(interp
, expr
);
8757 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8759 JIM_NOTUSED(interp
);
8760 JIM_NOTUSED(srcPtr
);
8762 /* Just returns an simple string. */
8763 dupPtr
->typePtr
= NULL
;
8766 /* Check if an expr program looks correct
8767 * Sets an error result on invalid
8769 static int ExprCheckCorrectness(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, ExprByteCode
* expr
)
8774 int lasttt
= JIM_TT_NONE
;
8777 /* Try to check if there are stack underflows,
8778 * and make sure at the end of the program there is
8779 * a single result on the stack. */
8780 for (i
= 0; i
< expr
->len
; i
++) {
8781 ScriptToken
*t
= &expr
->token
[i
];
8782 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8785 stacklen
-= op
->arity
;
8790 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8793 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8797 /* All operations and operands add one to the stack */
8800 if (stacklen
== 1 && ternary
== 0) {
8804 if (stacklen
<= 0) {
8806 if (lasttt
>= JIM_EXPROP_FUNC_FIRST
) {
8807 errmsg
= "too few arguments for math function";
8808 Jim_SetResultString(interp
, "too few arguments for math function", -1);
8810 errmsg
= "premature end of expression";
8813 else if (stacklen
> 1) {
8814 if (lasttt
>= JIM_EXPROP_FUNC_FIRST
) {
8815 errmsg
= "too many arguments for math function";
8817 errmsg
= "extra tokens at end of expression";
8821 errmsg
= "invalid ternary expression";
8823 Jim_SetResultFormatted(interp
, "syntax error in expression \"%#s\": %s", exprObjPtr
, errmsg
);
8827 /* This procedure converts every occurrence of || and && opereators
8828 * in lazy unary versions.
8830 * a b || is converted into:
8832 * a <offset> |L b |R
8834 * a b && is converted into:
8836 * a <offset> &L b &R
8838 * "|L" checks if 'a' is true:
8839 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8840 * the opcode just after |R.
8841 * 2) if it is false does nothing.
8842 * "|R" checks if 'b' is true:
8843 * 1) if it is true pushes 1, otherwise pushes 0.
8845 * "&L" checks if 'a' is true:
8846 * 1) if it is true does nothing.
8847 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8848 * the opcode just after &R
8849 * "&R" checks if 'a' is true:
8850 * if it is true pushes 1, otherwise pushes 0.
8852 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8856 int leftindex
, arity
, offset
;
8858 /* Search for the end of the first operator */
8859 leftindex
= expr
->len
- 1;
8863 ScriptToken
*tt
= &expr
->token
[leftindex
];
8865 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8866 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8869 if (--leftindex
< 0) {
8876 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8877 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8879 offset
= (expr
->len
- leftindex
) - 1;
8881 /* Now we rely on the fact that the left and right version have opcodes
8882 * 1 and 2 after the main opcode respectively
8884 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8885 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8887 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8888 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8890 /* Now add the 'R' operator */
8891 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8892 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8895 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8896 for (i
= leftindex
- 1; i
> 0; i
--) {
8897 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8898 if (op
->lazy
== LAZY_LEFT
) {
8899 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8900 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8907 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8909 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8910 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8912 if (op
->lazy
== LAZY_OP
) {
8913 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8914 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8919 token
->objPtr
= interp
->emptyObj
;
8920 token
->type
= t
->type
;
8927 * Returns the index of the COLON_LEFT to the left of 'right_index'
8928 * taking into account nesting.
8930 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8932 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8934 int ternary_count
= 1;
8938 while (right_index
> 1) {
8939 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8942 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8945 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8956 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8958 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8959 * Otherwise returns 0.
8961 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8963 int i
= right_index
- 1;
8964 int ternary_count
= 1;
8967 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8968 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8969 *prev_right_index
= i
- 2;
8970 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8974 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8975 if (ternary_count
== 0) {
8986 * ExprTernaryReorderExpression description
8987 * ========================================
8989 * ?: is right-to-left associative which doesn't work with the stack-based
8990 * expression engine. The fix is to reorder the bytecode.
8996 * Has initial bytecode:
8998 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8999 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
9001 * The fix involves simulating this expression instead:
9005 * With the following bytecode:
9007 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9008 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9010 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9011 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9012 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9013 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9015 * ExprTernaryReorderExpression works thus as follows :
9016 * - start from the end of the stack
9017 * - while walking towards the beginning of the stack
9018 * if token=JIM_EXPROP_COLON_RIGHT then
9019 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9020 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9021 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9023 * perform the rotation
9024 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9028 * Note: care has to be taken for nested ternary constructs!!!
9030 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
9034 for (i
= expr
->len
- 1; i
> 1; i
--) {
9035 int prev_right_index
;
9036 int prev_left_index
;
9040 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
9044 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9045 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
9050 ** rotate tokens down
9052 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9061 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9063 tmp
= expr
->token
[prev_right_index
];
9064 for (j
= prev_right_index
; j
< i
; j
++) {
9065 expr
->token
[j
] = expr
->token
[j
+ 1];
9067 expr
->token
[i
] = tmp
;
9069 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9071 * This is 'colon left increment' = i - prev_right_index
9073 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9074 * [prev_left_index-1] : skip_count
9077 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
9079 /* Adjust for i-- in the loop */
9084 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*exprObjPtr
, Jim_Obj
*fileNameObj
)
9090 int prevtt
= JIM_TT_NONE
;
9091 int have_ternary
= 0;
9094 int count
= tokenlist
->count
- 1;
9096 expr
= Jim_Alloc(sizeof(*expr
));
9100 Jim_InitStack(&stack
);
9102 /* Need extra bytecodes for lazy operators.
9103 * Also check for the ternary operator
9105 for (i
= 0; i
< tokenlist
->count
; i
++) {
9106 ParseToken
*t
= &tokenlist
->list
[i
];
9107 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
9109 if (op
->lazy
== LAZY_OP
) {
9111 /* Ternary is a lazy op but also needs reordering */
9112 if (t
->type
== JIM_EXPROP_TERNARY
) {
9118 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
9120 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
9121 ParseToken
*t
= &tokenlist
->list
[i
];
9123 /* Next token will be stored here */
9124 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
9126 if (t
->type
== JIM_TT_EOL
) {
9130 if (TOKEN_IS_EXPR_OP(t
->type
)) {
9131 const struct Jim_ExprOperator
*op
;
9134 /* Convert -/+ to unary minus or unary plus if necessary */
9135 if (prevtt
== JIM_TT_NONE
|| prevtt
== JIM_TT_SUBEXPR_START
|| prevtt
== JIM_TT_SUBEXPR_COMMA
|| prevtt
>= JIM_TT_EXPR_OP
) {
9136 if (t
->type
== JIM_EXPROP_SUB
) {
9137 t
->type
= JIM_EXPROP_UNARYMINUS
;
9139 else if (t
->type
== JIM_EXPROP_ADD
) {
9140 t
->type
= JIM_EXPROP_UNARYPLUS
;
9144 op
= JimExprOperatorInfoByOpcode(t
->type
);
9146 /* Handle precedence */
9147 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9148 const struct Jim_ExprOperator
*tt_op
=
9149 JimExprOperatorInfoByOpcode(tt
->type
);
9151 /* Note that right-to-left associativity of ?: operator is handled later.
9154 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9155 /* Don't reduce if right associative with equal precedence? */
9156 if (tt_op
->precedence
== op
->precedence
&& tt_op
->lazy
== RIGHT_ASSOC
) {
9159 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9163 Jim_StackPop(&stack
);
9169 Jim_StackPush(&stack
, t
);
9171 else if (t
->type
== JIM_TT_SUBEXPR_START
) {
9172 Jim_StackPush(&stack
, t
);
9174 else if (t
->type
== JIM_TT_SUBEXPR_END
|| t
->type
== JIM_TT_SUBEXPR_COMMA
) {
9175 /* Reduce the expression back to the previous ( or , */
9177 while (Jim_StackLen(&stack
)) {
9178 ParseToken
*tt
= Jim_StackPop(&stack
);
9180 if (tt
->type
== JIM_TT_SUBEXPR_START
|| tt
->type
== JIM_TT_SUBEXPR_COMMA
) {
9181 if (t
->type
== JIM_TT_SUBEXPR_COMMA
) {
9182 /* Need to push back the previous START or COMMA in the case of comma */
9183 Jim_StackPush(&stack
, tt
);
9188 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9193 Jim_SetResultFormatted(interp
, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr
);
9198 Jim_Obj
*objPtr
= NULL
;
9200 /* This is a simple non-operator term, so create and push the appropriate object */
9201 token
->type
= t
->type
;
9203 /* Two consecutive terms without an operator is invalid */
9204 if (!TOKEN_IS_EXPR_START(prevtt
) && !TOKEN_IS_EXPR_OP(prevtt
)) {
9205 Jim_SetResultFormatted(interp
, "missing operator in expression: \"%#s\"", exprObjPtr
);
9210 /* Immediately create a double or int object? */
9211 if (t
->type
== JIM_TT_EXPR_INT
|| t
->type
== JIM_TT_EXPR_DOUBLE
) {
9213 if (t
->type
== JIM_TT_EXPR_INT
) {
9214 objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
9217 objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
9219 if (endptr
!= t
->token
+ t
->len
) {
9220 /* Conversion failed, so just store it as a string */
9221 Jim_FreeNewObj(interp
, objPtr
);
9227 token
->objPtr
= objPtr
;
9230 /* Everything else is stored a simple string term */
9231 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
9232 if (t
->type
== JIM_TT_CMD
) {
9233 /* Only commands need source info */
9234 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
9242 /* Reduce any remaining subexpr */
9243 while (Jim_StackLen(&stack
)) {
9244 ParseToken
*tt
= Jim_StackPop(&stack
);
9246 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9248 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9251 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9258 ExprTernaryReorderExpression(interp
, expr
);
9262 /* Free the stack used for the compilation. */
9263 Jim_FreeStack(&stack
);
9265 for (i
= 0; i
< expr
->len
; i
++) {
9266 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9270 ExprFreeByteCode(interp
, expr
);
9278 /* This method takes the string representation of an expression
9279 * and generates a program for the Expr's stack-based VM. */
9280 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9283 const char *exprText
;
9284 struct JimParserCtx parser
;
9285 struct ExprByteCode
*expr
;
9286 ParseTokenList tokenlist
;
9288 Jim_Obj
*fileNameObj
;
9291 /* Try to get information about filename / line number */
9292 if (objPtr
->typePtr
== &sourceObjType
) {
9293 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9294 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9297 fileNameObj
= interp
->emptyObj
;
9300 Jim_IncrRefCount(fileNameObj
);
9302 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9304 /* Initially tokenise the expression into tokenlist */
9305 ScriptTokenListInit(&tokenlist
);
9307 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9308 while (!parser
.eof
) {
9309 if (JimParseExpression(&parser
) != JIM_OK
) {
9310 ScriptTokenListFree(&tokenlist
);
9311 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9316 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9320 #ifdef DEBUG_SHOW_EXPR_TOKENS
9323 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9324 for (i
= 0; i
< tokenlist
.count
; i
++) {
9325 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9326 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9331 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9332 ScriptTokenListFree(&tokenlist
);
9333 Jim_DecrRefCount(interp
, fileNameObj
);
9337 /* Now create the expression bytecode from the tokenlist */
9338 expr
= ExprCreateByteCode(interp
, &tokenlist
, objPtr
, fileNameObj
);
9340 /* No longer need the token list */
9341 ScriptTokenListFree(&tokenlist
);
9347 #ifdef DEBUG_SHOW_EXPR
9351 printf("==== Expr ====\n");
9352 for (i
= 0; i
< expr
->len
; i
++) {
9353 ScriptToken
*t
= &expr
->token
[i
];
9355 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9360 /* Check program correctness. */
9361 if (ExprCheckCorrectness(interp
, objPtr
, expr
) != JIM_OK
) {
9362 /* ExprCheckCorrectness set an error in this case */
9363 ExprFreeByteCode(interp
, expr
);
9371 /* Free the old internal rep and set the new one. */
9372 Jim_DecrRefCount(interp
, fileNameObj
);
9373 Jim_FreeIntRep(interp
, objPtr
);
9374 Jim_SetIntRepPtr(objPtr
, expr
);
9375 objPtr
->typePtr
= &exprObjType
;
9379 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9381 if (objPtr
->typePtr
!= &exprObjType
) {
9382 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9386 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9389 #ifdef JIM_OPTIMIZATION
9390 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9392 if (token
->type
== JIM_TT_EXPR_INT
)
9393 return token
->objPtr
;
9394 else if (token
->type
== JIM_TT_VAR
)
9395 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9396 else if (token
->type
== JIM_TT_DICTSUGAR
)
9397 return JimExpandDictSugar(interp
, token
->objPtr
);
9403 /* -----------------------------------------------------------------------------
9404 * Expressions evaluation.
9405 * Jim uses a specialized stack-based virtual machine for expressions,
9406 * that takes advantage of the fact that expr's operators
9407 * can't be redefined.
9409 * Jim_EvalExpression() uses the bytecode compiled by
9410 * SetExprFromAny() method of the "expression" object.
9412 * On success a Tcl Object containing the result of the evaluation
9413 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9415 * On error the function returns a retcode != to JIM_OK and set a suitable
9416 * error on the interp.
9417 * ---------------------------------------------------------------------------*/
9418 #define JIM_EE_STATICSTACK_LEN 10
9420 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9423 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9425 int retcode
= JIM_OK
;
9426 struct JimExprState e
;
9428 expr
= JimGetExpression(interp
, exprObjPtr
);
9430 return JIM_ERR
; /* error in expression. */
9433 #ifdef JIM_OPTIMIZATION
9434 /* Check for one of the following common expressions used by while/for
9439 * $a < CONST, $a < $b
9440 * $a <= CONST, $a <= $b
9441 * $a > CONST, $a > $b
9442 * $a >= CONST, $a >= $b
9443 * $a != CONST, $a != $b
9444 * $a == CONST, $a == $b
9449 /* STEP 1 -- Check if there are the conditions to run the specialized
9450 * version of while */
9452 switch (expr
->len
) {
9454 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9456 Jim_IncrRefCount(objPtr
);
9457 *exprResultPtrPtr
= objPtr
;
9463 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9464 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9466 if (objPtr
&& JimIsWide(objPtr
)) {
9467 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9468 Jim_IncrRefCount(*exprResultPtrPtr
);
9475 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9476 if (objPtr
&& JimIsWide(objPtr
)) {
9477 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9478 if (objPtr2
&& JimIsWide(objPtr2
)) {
9479 jim_wide wideValueA
= JimWideValue(objPtr
);
9480 jim_wide wideValueB
= JimWideValue(objPtr2
);
9482 switch (expr
->token
[2].type
) {
9484 cmpRes
= wideValueA
< wideValueB
;
9486 case JIM_EXPROP_LTE
:
9487 cmpRes
= wideValueA
<= wideValueB
;
9490 cmpRes
= wideValueA
> wideValueB
;
9492 case JIM_EXPROP_GTE
:
9493 cmpRes
= wideValueA
>= wideValueB
;
9495 case JIM_EXPROP_NUMEQ
:
9496 cmpRes
= wideValueA
== wideValueB
;
9498 case JIM_EXPROP_NUMNE
:
9499 cmpRes
= wideValueA
!= wideValueB
;
9504 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9505 Jim_IncrRefCount(*exprResultPtrPtr
);
9515 /* In order to avoid that the internal repr gets freed due to
9516 * shimmering of the exprObjPtr's object, we make the internal rep
9520 /* The stack-based expr VM itself */
9522 /* Stack allocation. Expr programs have the feature that
9523 * a program of length N can't require a stack longer than
9525 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9526 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9528 e
.stack
= staticStack
;
9532 /* Execute every instruction */
9533 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9536 switch (expr
->token
[i
].type
) {
9537 case JIM_TT_EXPR_INT
:
9538 case JIM_TT_EXPR_DOUBLE
:
9539 case JIM_TT_EXPR_BOOLEAN
:
9541 ExprPush(&e
, expr
->token
[i
].objPtr
);
9545 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9547 ExprPush(&e
, objPtr
);
9554 case JIM_TT_DICTSUGAR
:
9555 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9557 ExprPush(&e
, objPtr
);
9565 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9566 if (retcode
== JIM_OK
) {
9567 ExprPush(&e
, objPtr
);
9572 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9573 if (retcode
== JIM_OK
) {
9574 ExprPush(&e
, Jim_GetResult(interp
));
9579 /* Find and execute the operation */
9581 e
.opcode
= expr
->token
[i
].type
;
9583 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9584 /* Skip some opcodes if necessary */
9593 if (retcode
== JIM_OK
) {
9594 *exprResultPtrPtr
= ExprPop(&e
);
9597 for (i
= 0; i
< e
.stacklen
; i
++) {
9598 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9601 if (e
.stack
!= staticStack
) {
9607 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9613 Jim_Obj
*exprResultPtr
;
9615 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9616 if (retcode
!= JIM_OK
)
9619 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9620 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9621 if (Jim_GetBoolean(interp
, exprResultPtr
, &booleanValue
) != JIM_OK
) {
9622 Jim_DecrRefCount(interp
, exprResultPtr
);
9625 Jim_DecrRefCount(interp
, exprResultPtr
);
9626 *boolPtr
= booleanValue
;
9631 Jim_DecrRefCount(interp
, exprResultPtr
);
9632 *boolPtr
= doubleValue
!= 0;
9636 *boolPtr
= wideValue
!= 0;
9638 Jim_DecrRefCount(interp
, exprResultPtr
);
9642 /* -----------------------------------------------------------------------------
9643 * ScanFormat String Object
9644 * ---------------------------------------------------------------------------*/
9646 /* This Jim_Obj will held a parsed representation of a format string passed to
9647 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9648 * to be parsed in its entirely first and then, if correct, can be used for
9649 * scanning. To avoid endless re-parsing, the parsed representation will be
9650 * stored in an internal representation and re-used for performance reason. */
9652 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9653 * scanformat string. This part will later be used to extract information
9654 * out from the string to be parsed by Jim_ScanString */
9656 typedef struct ScanFmtPartDescr
9658 char *arg
; /* Specification of a CHARSET conversion */
9659 char *prefix
; /* Prefix to be scanned literally before conversion */
9660 size_t width
; /* Maximal width of input to be converted */
9661 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9662 char type
; /* Type of conversion (e.g. c, d, f) */
9663 char modifier
; /* Modify type (e.g. l - long, h - short */
9666 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9667 * string parsed and separated in part descriptions. Furthermore it contains
9668 * the original string representation of the scanformat string to allow for
9669 * fast update of the Jim_Obj's string representation part.
9671 * As an add-on the internal object representation adds some scratch pad area
9672 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9673 * memory for purpose of string scanning.
9675 * The error member points to a static allocated string in case of a mal-
9676 * formed scanformat string or it contains '0' (NULL) in case of a valid
9677 * parse representation.
9679 * The whole memory of the internal representation is allocated as a single
9680 * area of memory that will be internally separated. So freeing and duplicating
9681 * of such an object is cheap */
9683 typedef struct ScanFmtStringObj
9685 jim_wide size
; /* Size of internal repr in bytes */
9686 char *stringRep
; /* Original string representation */
9687 size_t count
; /* Number of ScanFmtPartDescr contained */
9688 size_t convCount
; /* Number of conversions that will assign */
9689 size_t maxPos
; /* Max position index if XPG3 is used */
9690 const char *error
; /* Ptr to error text (NULL if no error */
9691 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9692 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9696 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9697 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9698 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9700 static const Jim_ObjType scanFmtStringObjType
= {
9702 FreeScanFmtInternalRep
,
9703 DupScanFmtInternalRep
,
9704 UpdateStringOfScanFmt
,
9708 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9710 JIM_NOTUSED(interp
);
9711 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9712 objPtr
->internalRep
.ptr
= 0;
9715 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9717 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9718 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9720 JIM_NOTUSED(interp
);
9721 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9722 dupPtr
->internalRep
.ptr
= newVec
;
9723 dupPtr
->typePtr
= &scanFmtStringObjType
;
9726 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9728 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9731 /* SetScanFmtFromAny will parse a given string and create the internal
9732 * representation of the format specification. In case of an error
9733 * the error data member of the internal representation will be set
9734 * to an descriptive error text and the function will be left with
9735 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9738 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9740 ScanFmtStringObj
*fmtObj
;
9742 int maxCount
, i
, approxSize
, lastPos
= -1;
9743 const char *fmt
= objPtr
->bytes
;
9744 int maxFmtLen
= objPtr
->length
;
9745 const char *fmtEnd
= fmt
+ maxFmtLen
;
9748 Jim_FreeIntRep(interp
, objPtr
);
9749 /* Count how many conversions could take place maximally */
9750 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9753 /* Calculate an approximation of the memory necessary */
9754 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9755 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9756 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9757 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9758 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9759 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9760 +1; /* safety byte */
9761 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9762 memset(fmtObj
, 0, approxSize
);
9763 fmtObj
->size
= approxSize
;
9765 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9766 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9767 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9768 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9769 objPtr
->internalRep
.ptr
= fmtObj
;
9770 objPtr
->typePtr
= &scanFmtStringObjType
;
9771 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9772 int width
= 0, skip
;
9773 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9776 descr
->width
= 0; /* Assume width unspecified */
9777 /* Overread and store any "literal" prefix */
9778 if (*fmt
!= '%' || fmt
[1] == '%') {
9780 descr
->prefix
= &buffer
[i
];
9781 for (; fmt
< fmtEnd
; ++fmt
) {
9791 /* Skip the conversion introducing '%' sign */
9793 /* End reached due to non-conversion literal only? */
9796 descr
->pos
= 0; /* Assume "natural" positioning */
9798 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9802 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9803 /* Check if next token is a number (could be width or pos */
9804 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9806 /* Was the number a XPG3 position specifier? */
9807 if (descr
->pos
!= -1 && *fmt
== '$') {
9813 /* Look if "natural" postioning and XPG3 one was mixed */
9814 if ((lastPos
== 0 && descr
->pos
> 0)
9815 || (lastPos
> 0 && descr
->pos
== 0)) {
9816 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9819 /* Look if this position was already used */
9820 for (prev
= 0; prev
< curr
; ++prev
) {
9821 if (fmtObj
->descr
[prev
].pos
== -1)
9823 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9825 "variable is assigned by multiple \"%n$\" conversion specifiers";
9829 /* Try to find a width after the XPG3 specifier */
9830 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9831 descr
->width
= width
;
9834 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9835 fmtObj
->maxPos
= descr
->pos
;
9838 /* Number was not a XPG3, so it has to be a width */
9839 descr
->width
= width
;
9842 /* If positioning mode was undetermined yet, fix this */
9844 lastPos
= descr
->pos
;
9845 /* Handle CHARSET conversion type ... */
9847 int swapped
= 1, beg
= i
, end
, j
;
9850 descr
->arg
= &buffer
[i
];
9853 buffer
[i
++] = *fmt
++;
9855 buffer
[i
++] = *fmt
++;
9856 while (*fmt
&& *fmt
!= ']')
9857 buffer
[i
++] = *fmt
++;
9859 fmtObj
->error
= "unmatched [ in format string";
9864 /* In case a range fence was given "backwards", swap it */
9867 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9868 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9869 char tmp
= buffer
[j
- 1];
9871 buffer
[j
- 1] = buffer
[j
+ 1];
9872 buffer
[j
+ 1] = tmp
;
9879 /* Remember any valid modifier if given */
9880 if (strchr("hlL", *fmt
) != 0)
9881 descr
->modifier
= tolower((int)*fmt
++);
9884 if (strchr("efgcsndoxui", *fmt
) == 0) {
9885 fmtObj
->error
= "bad scan conversion character";
9888 else if (*fmt
== 'c' && descr
->width
!= 0) {
9889 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9892 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9893 fmtObj
->error
= "unsigned wide not supported";
9903 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9905 #define FormatGetCnvCount(_fo_) \
9906 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9907 #define FormatGetMaxPos(_fo_) \
9908 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9909 #define FormatGetError(_fo_) \
9910 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9912 /* JimScanAString is used to scan an unspecified string that ends with
9913 * next WS, or a string that is specified via a charset.
9916 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9918 char *buffer
= Jim_StrDup(str
);
9925 if (!sdescr
&& isspace(UCHAR(*str
)))
9926 break; /* EOS via WS if unspecified */
9928 n
= utf8_tounicode(str
, &c
);
9929 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9935 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9938 /* ScanOneEntry will scan one entry out of the string passed as argument.
9939 * It use the sscanf() function for this task. After extracting and
9940 * converting of the value, the count of scanned characters will be
9941 * returned of -1 in case of no conversion tool place and string was
9942 * already scanned thru */
9944 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9945 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9948 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9950 size_t anchor
= pos
;
9952 Jim_Obj
*tmpObj
= NULL
;
9954 /* First pessimistically assume, we will not scan anything :-) */
9956 if (descr
->prefix
) {
9957 /* There was a prefix given before the conversion, skip it and adjust
9958 * the string-to-be-parsed accordingly */
9959 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9960 /* If prefix require, skip WS */
9961 if (isspace(UCHAR(descr
->prefix
[i
])))
9962 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9964 else if (descr
->prefix
[i
] != str
[pos
])
9965 break; /* Prefix do not match here, leave the loop */
9967 ++pos
; /* Prefix matched so far, next round */
9969 if (pos
>= strLen
) {
9970 return -1; /* All of str consumed: EOF condition */
9972 else if (descr
->prefix
[i
] != 0)
9973 return 0; /* Not whole prefix consumed, no conversion possible */
9975 /* For all but following conversion, skip leading WS */
9976 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9977 while (isspace(UCHAR(str
[pos
])))
9979 /* Determine how much skipped/scanned so far */
9980 scanned
= pos
- anchor
;
9982 /* %c is a special, simple case. no width */
9983 if (descr
->type
== 'n') {
9984 /* Return pseudo conversion means: how much scanned so far? */
9985 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9987 else if (pos
>= strLen
) {
9988 /* Cannot scan anything, as str is totally consumed */
9991 else if (descr
->type
== 'c') {
9993 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9994 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9998 /* Processing of conversions follows ... */
9999 if (descr
->width
> 0) {
10000 /* Do not try to scan as fas as possible but only the given width.
10001 * To ensure this, we copy the part that should be scanned. */
10002 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
10003 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
10005 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
10006 tok
= tmpObj
->bytes
;
10009 /* As no width was given, simply refer to the original string */
10012 switch (descr
->type
) {
10018 char *endp
; /* Position where the number finished */
10021 int base
= descr
->type
== 'o' ? 8
10022 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
10024 /* Try to scan a number with the given base */
10026 w
= jim_strtoull(tok
, &endp
);
10029 w
= strtoull(tok
, &endp
, base
);
10033 /* There was some number sucessfully scanned! */
10034 *valObjPtr
= Jim_NewIntObj(interp
, w
);
10036 /* Adjust the number-of-chars scanned so far */
10037 scanned
+= endp
- tok
;
10040 /* Nothing was scanned. We have to determine if this
10041 * happened due to e.g. prefix mismatch or input str
10043 scanned
= *tok
? 0 : -1;
10049 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
10050 scanned
+= Jim_Length(*valObjPtr
);
10057 double value
= strtod(tok
, &endp
);
10060 /* There was some number sucessfully scanned! */
10061 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
10062 /* Adjust the number-of-chars scanned so far */
10063 scanned
+= endp
- tok
;
10066 /* Nothing was scanned. We have to determine if this
10067 * happened due to e.g. prefix mismatch or input str
10069 scanned
= *tok
? 0 : -1;
10074 /* If a substring was allocated (due to pre-defined width) do not
10075 * forget to free it */
10077 Jim_FreeNewObj(interp
, tmpObj
);
10083 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10084 * string and returns all converted (and not ignored) values in a list back
10085 * to the caller. If an error occured, a NULL pointer will be returned */
10087 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
10091 const char *str
= Jim_String(strObjPtr
);
10092 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
10093 Jim_Obj
*resultList
= 0;
10094 Jim_Obj
**resultVec
= 0;
10096 Jim_Obj
*emptyStr
= 0;
10097 ScanFmtStringObj
*fmtObj
;
10099 /* This should never happen. The format object should already be of the correct type */
10100 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
10102 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
10103 /* Check if format specification was valid */
10104 if (fmtObj
->error
!= 0) {
10105 if (flags
& JIM_ERRMSG
)
10106 Jim_SetResultString(interp
, fmtObj
->error
, -1);
10109 /* Allocate a new "shared" empty string for all unassigned conversions */
10110 emptyStr
= Jim_NewEmptyStringObj(interp
);
10111 Jim_IncrRefCount(emptyStr
);
10112 /* Create a list and fill it with empty strings up to max specified XPG3 */
10113 resultList
= Jim_NewListObj(interp
, NULL
, 0);
10114 if (fmtObj
->maxPos
> 0) {
10115 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
10116 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
10117 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
10119 /* Now handle every partial format description */
10120 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
10121 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
10122 Jim_Obj
*value
= 0;
10124 /* Only last type may be "literal" w/o conversion - skip it! */
10125 if (descr
->type
== 0)
10127 /* As long as any conversion could be done, we will proceed */
10129 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
10130 /* In case our first try results in EOF, we will leave */
10131 if (scanned
== -1 && i
== 0)
10133 /* Advance next pos-to-be-scanned for the amount scanned already */
10136 /* value == 0 means no conversion took place so take empty string */
10138 value
= Jim_NewEmptyStringObj(interp
);
10139 /* If value is a non-assignable one, skip it */
10140 if (descr
->pos
== -1) {
10141 Jim_FreeNewObj(interp
, value
);
10143 else if (descr
->pos
== 0)
10144 /* Otherwise append it to the result list if no XPG3 was given */
10145 Jim_ListAppendElement(interp
, resultList
, value
);
10146 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
10147 /* But due to given XPG3, put the value into the corr. slot */
10148 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
10149 Jim_IncrRefCount(value
);
10150 resultVec
[descr
->pos
- 1] = value
;
10153 /* Otherwise, the slot was already used - free obj and ERROR */
10154 Jim_FreeNewObj(interp
, value
);
10158 Jim_DecrRefCount(interp
, emptyStr
);
10161 Jim_DecrRefCount(interp
, emptyStr
);
10162 Jim_FreeNewObj(interp
, resultList
);
10163 return (Jim_Obj
*)EOF
;
10165 Jim_DecrRefCount(interp
, emptyStr
);
10166 Jim_FreeNewObj(interp
, resultList
);
10170 /* -----------------------------------------------------------------------------
10171 * Pseudo Random Number Generation
10172 * ---------------------------------------------------------------------------*/
10173 /* Initialize the sbox with the numbers from 0 to 255 */
10174 static void JimPrngInit(Jim_Interp
*interp
)
10176 #define PRNG_SEED_SIZE 256
10178 unsigned int *seed
;
10179 time_t t
= time(NULL
);
10181 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
10183 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10184 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10185 seed
[i
] = (rand() ^ t
^ clock());
10187 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10191 /* Generates N bytes of random data */
10192 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10194 Jim_PrngState
*prng
;
10195 unsigned char *destByte
= (unsigned char *)dest
;
10196 unsigned int si
, sj
, x
;
10198 /* initialization, only needed the first time */
10199 if (interp
->prngState
== NULL
)
10200 JimPrngInit(interp
);
10201 prng
= interp
->prngState
;
10202 /* generates 'len' bytes of pseudo-random numbers */
10203 for (x
= 0; x
< len
; x
++) {
10204 prng
->i
= (prng
->i
+ 1) & 0xff;
10205 si
= prng
->sbox
[prng
->i
];
10206 prng
->j
= (prng
->j
+ si
) & 0xff;
10207 sj
= prng
->sbox
[prng
->j
];
10208 prng
->sbox
[prng
->i
] = sj
;
10209 prng
->sbox
[prng
->j
] = si
;
10210 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10214 /* Re-seed the generator with user-provided bytes */
10215 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10218 Jim_PrngState
*prng
;
10220 /* initialization, only needed the first time */
10221 if (interp
->prngState
== NULL
)
10222 JimPrngInit(interp
);
10223 prng
= interp
->prngState
;
10225 /* Set the sbox[i] with i */
10226 for (i
= 0; i
< 256; i
++)
10228 /* Now use the seed to perform a random permutation of the sbox */
10229 for (i
= 0; i
< seedLen
; i
++) {
10232 t
= prng
->sbox
[i
& 0xFF];
10233 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10234 prng
->sbox
[seed
[i
]] = t
;
10236 prng
->i
= prng
->j
= 0;
10238 /* discard at least the first 256 bytes of stream.
10239 * borrow the seed buffer for this
10241 for (i
= 0; i
< 256; i
+= seedLen
) {
10242 JimRandomBytes(interp
, seed
, seedLen
);
10247 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10249 jim_wide wideValue
, increment
= 1;
10250 Jim_Obj
*intObjPtr
;
10252 if (argc
!= 2 && argc
!= 3) {
10253 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10257 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10260 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10262 /* Set missing variable to 0 */
10265 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10268 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10269 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10270 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10271 Jim_FreeNewObj(interp
, intObjPtr
);
10276 /* Can do it the quick way */
10277 Jim_InvalidateStringRep(intObjPtr
);
10278 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10280 /* The following step is required in order to invalidate the
10281 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10282 if (argv
[1]->typePtr
!= &variableObjType
) {
10283 /* Note that this can't fail since GetVariable already succeeded */
10284 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10287 Jim_SetResult(interp
, intObjPtr
);
10292 /* -----------------------------------------------------------------------------
10294 * ---------------------------------------------------------------------------*/
10295 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10296 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10298 /* Handle calls to the [unknown] command */
10299 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10303 /* If JimUnknown() is recursively called too many times...
10306 if (interp
->unknown_called
> 50) {
10310 /* The object interp->unknown just contains
10311 * the "unknown" string, it is used in order to
10312 * avoid to lookup the unknown command every time
10313 * but instead to cache the result. */
10315 /* If the [unknown] command does not exist ... */
10316 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10319 interp
->unknown_called
++;
10320 /* XXX: Are we losing fileNameObj and linenr? */
10321 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10322 interp
->unknown_called
--;
10327 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10335 for (j
= 0; j
< objc
; j
++) {
10336 printf(" '%s'", Jim_String(objv
[j
]));
10341 if (interp
->framePtr
->tailcallCmd
) {
10342 /* Special tailcall command was pre-resolved */
10343 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10344 interp
->framePtr
->tailcallCmd
= NULL
;
10347 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10348 if (cmdPtr
== NULL
) {
10349 return JimUnknown(interp
, objc
, objv
);
10351 JimIncrCmdRefCount(cmdPtr
);
10354 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10355 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10359 interp
->evalDepth
++;
10361 /* Call it -- Make sure result is an empty object. */
10362 Jim_SetEmptyResult(interp
);
10363 if (cmdPtr
->isproc
) {
10364 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10367 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10368 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10370 interp
->evalDepth
--;
10373 JimDecrCmdRefCount(interp
, cmdPtr
);
10378 /* Eval the object vector 'objv' composed of 'objc' elements.
10379 * Every element is used as single argument.
10380 * Jim_EvalObj() will call this function every time its object
10381 * argument is of "list" type, with no string representation.
10383 * This is possible because the string representation of a
10384 * list object generated by the UpdateStringOfList is made
10385 * in a way that ensures that every list element is a different
10386 * command argument. */
10387 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10391 /* Incr refcount of arguments. */
10392 for (i
= 0; i
< objc
; i
++)
10393 Jim_IncrRefCount(objv
[i
]);
10395 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10397 /* Decr refcount of arguments and return the retcode */
10398 for (i
= 0; i
< objc
; i
++)
10399 Jim_DecrRefCount(interp
, objv
[i
]);
10405 * Invokes 'prefix' as a command with the objv array as arguments.
10407 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10410 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10413 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10414 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10419 static void JimAddErrorToStack(Jim_Interp
*interp
, ScriptObj
*script
)
10421 if (!interp
->errorFlag
) {
10422 /* This is the first error, so save the file/line information and reset the stack */
10423 interp
->errorFlag
= 1;
10424 Jim_IncrRefCount(script
->fileNameObj
);
10425 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10426 interp
->errorFileNameObj
= script
->fileNameObj
;
10427 interp
->errorLine
= script
->linenr
;
10429 JimResetStackTrace(interp
);
10430 /* Always add a level where the error first occurs */
10431 interp
->addStackTrace
++;
10434 /* Now if this is an "interesting" level, add it to the stack trace */
10435 if (interp
->addStackTrace
> 0) {
10436 /* Add the stack info for the current level */
10438 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10440 /* Note: if we didn't have a filename for this level,
10441 * don't clear the addStackTrace flag
10442 * so we can pick it up at the next level
10444 if (Jim_Length(script
->fileNameObj
)) {
10445 interp
->addStackTrace
= 0;
10448 Jim_DecrRefCount(interp
, interp
->errorProc
);
10449 interp
->errorProc
= interp
->emptyObj
;
10450 Jim_IncrRefCount(interp
->errorProc
);
10454 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10458 switch (token
->type
) {
10461 objPtr
= token
->objPtr
;
10464 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10466 case JIM_TT_DICTSUGAR
:
10467 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10469 case JIM_TT_EXPRSUGAR
:
10470 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10473 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10476 objPtr
= interp
->result
;
10479 /* Stop substituting */
10482 /* just skip this one */
10483 return JIM_CONTINUE
;
10490 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10495 *objPtrPtr
= objPtr
;
10501 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10502 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10503 * The returned object has refcount = 0.
10505 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10509 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10513 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10516 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10518 /* Compute every token forming the argument
10519 * in the intv objects vector. */
10520 for (i
= 0; i
< tokens
; i
++) {
10521 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10526 if (flags
& JIM_SUBST_FLAG
) {
10531 /* XXX: Should probably set an error about break outside loop */
10532 /* fall through to error */
10534 if (flags
& JIM_SUBST_FLAG
) {
10538 /* XXX: Ditto continue outside loop */
10539 /* fall through to error */
10542 Jim_DecrRefCount(interp
, intv
[i
]);
10544 if (intv
!= sintv
) {
10549 Jim_IncrRefCount(intv
[i
]);
10550 Jim_String(intv
[i
]);
10551 totlen
+= intv
[i
]->length
;
10554 /* Fast path return for a single token */
10555 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10556 Jim_DecrRefCount(interp
, intv
[0]);
10560 /* Concatenate every token in an unique
10562 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10564 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10565 && token
[2].type
== JIM_TT_VAR
) {
10566 /* May be able to do fast interpolated object -> dictSubst */
10567 objPtr
->typePtr
= &interpolatedObjType
;
10568 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10569 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10570 Jim_IncrRefCount(intv
[2]);
10572 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10573 /* The first interpolated token is source, so preserve the source info */
10574 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10578 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10579 objPtr
->length
= totlen
;
10580 for (i
= 0; i
< tokens
; i
++) {
10582 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10583 s
+= intv
[i
]->length
;
10584 Jim_DecrRefCount(interp
, intv
[i
]);
10587 objPtr
->bytes
[totlen
] = '\0';
10588 /* Free the intv vector if not static. */
10589 if (intv
!= sintv
) {
10597 /* listPtr *must* be a list.
10598 * The contents of the list is evaluated with the first element as the command and
10599 * the remaining elements as the arguments.
10601 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10603 int retcode
= JIM_OK
;
10605 JimPanic((Jim_IsList(listPtr
) == 0, "JimEvalObjList() invoked on non-list."));
10607 if (listPtr
->internalRep
.listValue
.len
) {
10608 Jim_IncrRefCount(listPtr
);
10609 retcode
= JimInvokeCommand(interp
,
10610 listPtr
->internalRep
.listValue
.len
,
10611 listPtr
->internalRep
.listValue
.ele
);
10612 Jim_DecrRefCount(interp
, listPtr
);
10617 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10619 SetListFromAny(interp
, listPtr
);
10620 return JimEvalObjList(interp
, listPtr
);
10623 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10627 ScriptToken
*token
;
10628 int retcode
= JIM_OK
;
10629 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10630 Jim_Obj
*prevScriptObj
;
10632 /* If the object is of type "list", with no string rep we can call
10633 * a specialized version of Jim_EvalObj() */
10634 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10635 return JimEvalObjList(interp
, scriptObjPtr
);
10638 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10639 script
= JimGetScript(interp
, scriptObjPtr
);
10640 if (!JimScriptValid(interp
, script
)) {
10641 Jim_DecrRefCount(interp
, scriptObjPtr
);
10645 /* Reset the interpreter result. This is useful to
10646 * return the empty result in the case of empty program. */
10647 Jim_SetEmptyResult(interp
);
10649 token
= script
->token
;
10651 #ifdef JIM_OPTIMIZATION
10652 /* Check for one of the following common scripts used by for, while
10657 if (script
->len
== 0) {
10658 Jim_DecrRefCount(interp
, scriptObjPtr
);
10661 if (script
->len
== 3
10662 && token
[1].objPtr
->typePtr
== &commandObjType
10663 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10664 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10665 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10667 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10669 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10670 JimWideValue(objPtr
)++;
10671 Jim_InvalidateStringRep(objPtr
);
10672 Jim_DecrRefCount(interp
, scriptObjPtr
);
10673 Jim_SetResult(interp
, objPtr
);
10679 /* Now we have to make sure the internal repr will not be
10680 * freed on shimmering.
10682 * Think for example to this:
10684 * set x {llength $x; ... some more code ...}; eval $x
10686 * In order to preserve the internal rep, we increment the
10687 * inUse field of the script internal rep structure. */
10690 /* Stash the current script */
10691 prevScriptObj
= interp
->currentScriptObj
;
10692 interp
->currentScriptObj
= scriptObjPtr
;
10694 interp
->errorFlag
= 0;
10697 /* Execute every command sequentially until the end of the script
10698 * or an error occurs.
10700 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10704 /* First token of the line is always JIM_TT_LINE */
10705 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10706 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10708 /* Allocate the arguments vector if required */
10709 if (argc
> JIM_EVAL_SARGV_LEN
)
10710 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10712 /* Skip the JIM_TT_LINE token */
10715 /* Populate the arguments objects.
10716 * If an error occurs, retcode will be set and
10717 * 'j' will be set to the number of args expanded
10719 for (j
= 0; j
< argc
; j
++) {
10720 long wordtokens
= 1;
10722 Jim_Obj
*wordObjPtr
= NULL
;
10724 if (token
[i
].type
== JIM_TT_WORD
) {
10725 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10726 if (wordtokens
< 0) {
10728 wordtokens
= -wordtokens
;
10732 if (wordtokens
== 1) {
10733 /* Fast path if the token does not
10734 * need interpolation */
10736 switch (token
[i
].type
) {
10739 wordObjPtr
= token
[i
].objPtr
;
10742 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10744 case JIM_TT_EXPRSUGAR
:
10745 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10747 case JIM_TT_DICTSUGAR
:
10748 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10751 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10752 if (retcode
== JIM_OK
) {
10753 wordObjPtr
= Jim_GetResult(interp
);
10757 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10761 /* For interpolation we call a helper
10762 * function to do the work for us. */
10763 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10767 if (retcode
== JIM_OK
) {
10773 Jim_IncrRefCount(wordObjPtr
);
10777 argv
[j
] = wordObjPtr
;
10780 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10781 int len
= Jim_ListLength(interp
, wordObjPtr
);
10782 int newargc
= argc
+ len
- 1;
10786 if (argv
== sargv
) {
10787 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10788 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10789 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10793 /* Need to realloc to make room for (len - 1) more entries */
10794 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10798 /* Now copy in the expanded version */
10799 for (k
= 0; k
< len
; k
++) {
10800 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10801 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10804 /* The original object reference is no longer needed,
10805 * after the expansion it is no longer present on
10806 * the argument vector, but the single elements are
10808 Jim_DecrRefCount(interp
, wordObjPtr
);
10810 /* And update the indexes */
10816 if (retcode
== JIM_OK
&& argc
) {
10817 /* Invoke the command */
10818 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10819 /* Check for a signal after each command */
10820 if (Jim_CheckSignal(interp
)) {
10821 retcode
= JIM_SIGNAL
;
10825 /* Finished with the command, so decrement ref counts of each argument */
10827 Jim_DecrRefCount(interp
, argv
[j
]);
10830 if (argv
!= sargv
) {
10836 /* Possibly add to the error stack trace */
10837 if (retcode
== JIM_ERR
) {
10838 JimAddErrorToStack(interp
, script
);
10840 /* Propagate the addStackTrace value through 'return -code error' */
10841 else if (retcode
!= JIM_RETURN
|| interp
->returnCode
!= JIM_ERR
) {
10842 /* No need to add stack trace */
10843 interp
->addStackTrace
= 0;
10846 /* Restore the current script */
10847 interp
->currentScriptObj
= prevScriptObj
;
10849 /* Note that we don't have to decrement inUse, because the
10850 * following code transfers our use of the reference again to
10851 * the script object. */
10852 Jim_FreeIntRep(interp
, scriptObjPtr
);
10853 scriptObjPtr
->typePtr
= &scriptObjType
;
10854 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10855 Jim_DecrRefCount(interp
, scriptObjPtr
);
10860 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10863 /* If argObjPtr begins with '&', do an automatic upvar */
10864 const char *varname
= Jim_String(argNameObj
);
10865 if (*varname
== '&') {
10866 /* First check that the target variable exists */
10868 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10870 interp
->framePtr
= interp
->framePtr
->parent
;
10871 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10872 interp
->framePtr
= savedCallFrame
;
10877 /* It exists, so perform the binding. */
10878 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10879 Jim_IncrRefCount(objPtr
);
10880 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10881 Jim_DecrRefCount(interp
, objPtr
);
10884 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10890 * Sets the interp result to be an error message indicating the required proc args.
10892 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10894 /* Create a nice error message, consistent with Tcl 8.5 */
10895 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10898 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10899 Jim_AppendString(interp
, argmsg
, " ", 1);
10901 if (i
== cmd
->u
.proc
.argsPos
) {
10902 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10904 Jim_AppendString(interp
, argmsg
, "?", 1);
10905 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10906 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10909 /* We have plain args */
10910 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10914 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10915 Jim_AppendString(interp
, argmsg
, "?", 1);
10916 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10917 Jim_AppendString(interp
, argmsg
, "?", 1);
10920 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10924 Jim_AppendString(interp
, argmsg
, arg
, -1);
10928 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10931 #ifdef jim_ext_namespace
10935 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10937 Jim_CallFrame
*callFramePtr
;
10940 /* Create a new callframe */
10941 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10942 callFramePtr
->argv
= &interp
->emptyObj
;
10943 callFramePtr
->argc
= 0;
10944 callFramePtr
->procArgsObjPtr
= NULL
;
10945 callFramePtr
->procBodyObjPtr
= scriptObj
;
10946 callFramePtr
->staticVars
= NULL
;
10947 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10948 callFramePtr
->line
= 0;
10949 Jim_IncrRefCount(scriptObj
);
10950 interp
->framePtr
= callFramePtr
;
10952 /* Check if there are too nested calls */
10953 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10954 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10958 /* Eval the body */
10959 retcode
= Jim_EvalObj(interp
, scriptObj
);
10962 /* Destroy the callframe */
10963 interp
->framePtr
= interp
->framePtr
->parent
;
10964 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10970 /* Call a procedure implemented in Tcl.
10971 * It's possible to speed-up a lot this function, currently
10972 * the callframes are not cached, but allocated and
10973 * destroied every time. What is expecially costly is
10974 * to create/destroy the local vars hash table every time.
10976 * This can be fixed just implementing callframes caching
10977 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10978 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10980 Jim_CallFrame
*callFramePtr
;
10981 int i
, d
, retcode
, optargs
;
10985 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10986 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10987 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10991 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10992 /* Optimise for procedure with no body - useful for optional debugging */
10996 /* Check if there are too nested calls */
10997 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10998 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
11002 /* Create a new callframe */
11003 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
11004 callFramePtr
->argv
= argv
;
11005 callFramePtr
->argc
= argc
;
11006 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
11007 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
11008 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
11010 /* Remember where we were called from. */
11011 script
= JimGetScript(interp
, interp
->currentScriptObj
);
11012 callFramePtr
->fileNameObj
= script
->fileNameObj
;
11013 callFramePtr
->line
= script
->linenr
;
11015 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
11016 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
11017 interp
->framePtr
= callFramePtr
;
11019 /* How many optional args are available */
11020 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
11022 /* Step 'i' along the actual args, and step 'd' along the formal args */
11024 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
11025 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
11026 if (d
== cmd
->u
.proc
.argsPos
) {
11028 Jim_Obj
*listObjPtr
;
11030 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
11031 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
11033 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
11035 /* It is possible to rename args. */
11036 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
11037 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
11039 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
11040 if (retcode
!= JIM_OK
) {
11048 /* Optional or required? */
11049 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
11050 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
11053 /* Ran out, so use the default */
11054 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
11056 if (retcode
!= JIM_OK
) {
11061 /* Eval the body */
11062 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
11066 /* Free the callframe */
11067 interp
->framePtr
= interp
->framePtr
->parent
;
11068 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
11070 /* Now chain any tailcalls in the parent frame */
11071 if (interp
->framePtr
->tailcallObj
) {
11073 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
11075 interp
->framePtr
->tailcallObj
= NULL
;
11077 if (retcode
== JIM_EVAL
) {
11078 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
11079 if (retcode
== JIM_RETURN
) {
11080 /* If the result of the tailcall is 'return', push
11081 * it up to the caller
11083 interp
->returnLevel
++;
11086 Jim_DecrRefCount(interp
, tailcallObj
);
11087 } while (interp
->framePtr
->tailcallObj
);
11089 /* If the tailcall chain finished early, may need to manually discard the command */
11090 if (interp
->framePtr
->tailcallCmd
) {
11091 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
11092 interp
->framePtr
->tailcallCmd
= NULL
;
11096 /* Handle the JIM_RETURN return code */
11097 if (retcode
== JIM_RETURN
) {
11098 if (--interp
->returnLevel
<= 0) {
11099 retcode
= interp
->returnCode
;
11100 interp
->returnCode
= JIM_OK
;
11101 interp
->returnLevel
= 0;
11104 else if (retcode
== JIM_ERR
) {
11105 interp
->addStackTrace
++;
11106 Jim_DecrRefCount(interp
, interp
->errorProc
);
11107 interp
->errorProc
= argv
[0];
11108 Jim_IncrRefCount(interp
->errorProc
);
11114 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
11117 Jim_Obj
*scriptObjPtr
;
11119 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
11120 Jim_IncrRefCount(scriptObjPtr
);
11123 Jim_Obj
*prevScriptObj
;
11125 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
11127 prevScriptObj
= interp
->currentScriptObj
;
11128 interp
->currentScriptObj
= scriptObjPtr
;
11130 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11132 interp
->currentScriptObj
= prevScriptObj
;
11135 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
11137 Jim_DecrRefCount(interp
, scriptObjPtr
);
11141 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
11143 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
11146 /* Execute script in the scope of the global level */
11147 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
11150 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11152 interp
->framePtr
= interp
->topFramePtr
;
11153 retval
= Jim_Eval(interp
, script
);
11154 interp
->framePtr
= savedFramePtr
;
11159 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
11162 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
11164 interp
->framePtr
= interp
->topFramePtr
;
11165 retval
= Jim_EvalFile(interp
, filename
);
11166 interp
->framePtr
= savedFramePtr
;
11171 #include <sys/stat.h>
11173 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
11177 Jim_Obj
*scriptObjPtr
;
11178 Jim_Obj
*prevScriptObj
;
11183 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11184 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11187 if (sb
.st_size
== 0) {
11192 buf
= Jim_Alloc(sb
.st_size
+ 1);
11193 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11197 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11203 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11204 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11205 Jim_IncrRefCount(scriptObjPtr
);
11207 prevScriptObj
= interp
->currentScriptObj
;
11208 interp
->currentScriptObj
= scriptObjPtr
;
11210 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11212 /* Handle the JIM_RETURN return code */
11213 if (retcode
== JIM_RETURN
) {
11214 if (--interp
->returnLevel
<= 0) {
11215 retcode
= interp
->returnCode
;
11216 interp
->returnCode
= JIM_OK
;
11217 interp
->returnLevel
= 0;
11220 if (retcode
== JIM_ERR
) {
11221 /* EvalFile changes context, so add a stack frame here */
11222 interp
->addStackTrace
++;
11225 interp
->currentScriptObj
= prevScriptObj
;
11227 Jim_DecrRefCount(interp
, scriptObjPtr
);
11232 /* -----------------------------------------------------------------------------
11234 * ---------------------------------------------------------------------------*/
11235 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11237 pc
->tstart
= pc
->p
;
11238 pc
->tline
= pc
->linenr
;
11240 if (pc
->len
== 0) {
11242 pc
->tt
= JIM_TT_EOL
;
11246 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11250 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11251 if (JimParseVar(pc
) == JIM_OK
) {
11254 /* Not a var, so treat as a string */
11255 pc
->tstart
= pc
->p
;
11256 flags
|= JIM_SUBST_NOVAR
;
11259 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11262 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11265 if (*pc
->p
== '\\' && pc
->len
> 1) {
11272 pc
->tend
= pc
->p
- 1;
11273 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11276 /* The subst object type reuses most of the data structures and functions
11277 * of the script object. Script's data structures are a bit more complex
11278 * for what is needed for [subst]itution tasks, but the reuse helps to
11279 * deal with a single data structure at the cost of some more memory
11280 * usage for substitutions. */
11282 /* This method takes the string representation of an object
11283 * as a Tcl string where to perform [subst]itution, and generates
11284 * the pre-parsed internal representation. */
11285 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11288 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11289 struct JimParserCtx parser
;
11290 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11291 ParseTokenList tokenlist
;
11293 /* Initially parse the subst into tokens (in tokenlist) */
11294 ScriptTokenListInit(&tokenlist
);
11296 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11298 JimParseSubst(&parser
, flags
);
11300 /* Note that subst doesn't need the EOL token */
11303 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11307 /* Create the "real" subst/script tokens from the initial token list */
11309 script
->substFlags
= flags
;
11310 script
->fileNameObj
= interp
->emptyObj
;
11311 Jim_IncrRefCount(script
->fileNameObj
);
11312 SubstObjAddTokens(interp
, script
, &tokenlist
);
11314 /* No longer need the token list */
11315 ScriptTokenListFree(&tokenlist
);
11317 #ifdef DEBUG_SHOW_SUBST
11321 printf("==== Subst ====\n");
11322 for (i
= 0; i
< script
->len
; i
++) {
11323 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11324 Jim_String(script
->token
[i
].objPtr
));
11329 /* Free the old internal rep and set the new one. */
11330 Jim_FreeIntRep(interp
, objPtr
);
11331 Jim_SetIntRepPtr(objPtr
, script
);
11332 objPtr
->typePtr
= &scriptObjType
;
11336 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11338 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11339 SetSubstFromAny(interp
, objPtr
, flags
);
11340 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11343 /* Performs commands,variables,blackslashes substitution,
11344 * storing the result object (with refcount 0) into
11346 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11348 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11350 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11351 /* In order to preserve the internal rep, we increment the
11352 * inUse field of the script internal rep structure. */
11355 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11358 Jim_DecrRefCount(interp
, substObjPtr
);
11359 if (*resObjPtrPtr
== NULL
) {
11365 /* -----------------------------------------------------------------------------
11366 * Core commands utility functions
11367 * ---------------------------------------------------------------------------*/
11368 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11371 Jim_Obj
*listObjPtr
;
11373 JimPanic((argc
== 0, "Jim_WrongNumArgs() called with argc=0"));
11375 listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11378 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11380 Jim_IncrRefCount(listObjPtr
);
11381 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11382 Jim_DecrRefCount(interp
, listObjPtr
);
11384 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11388 * May add the key and/or value to the list.
11390 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11391 Jim_HashEntry
*he
, int type
);
11393 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11396 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11397 * invoke the callback to add entries to a list.
11398 * Returns the list.
11400 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11401 JimHashtableIteratorCallbackType
*callback
, int type
)
11404 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11406 /* Check for the non-pattern case. We can do this much more efficiently. */
11407 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11408 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11410 callback(interp
, listObjPtr
, he
, type
);
11414 Jim_HashTableIterator htiter
;
11415 JimInitHashTableIterator(ht
, &htiter
);
11416 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11417 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11418 callback(interp
, listObjPtr
, he
, type
);
11425 /* Keep these in order */
11426 #define JIM_CMDLIST_COMMANDS 0
11427 #define JIM_CMDLIST_PROCS 1
11428 #define JIM_CMDLIST_CHANNELS 2
11431 * Adds matching command names (procs, channels) to the list.
11433 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11434 Jim_HashEntry
*he
, int type
)
11436 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11439 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11444 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11445 Jim_IncrRefCount(objPtr
);
11447 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11448 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11450 Jim_DecrRefCount(interp
, objPtr
);
11453 /* type is JIM_CMDLIST_xxx */
11454 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11456 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11459 /* Keep these in order */
11460 #define JIM_VARLIST_GLOBALS 0
11461 #define JIM_VARLIST_LOCALS 1
11462 #define JIM_VARLIST_VARS 2
11464 #define JIM_VARLIST_VALUES 0x1000
11467 * Adds matching variable names to the list.
11469 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11470 Jim_HashEntry
*he
, int type
)
11472 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11474 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11475 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11476 if (type
& JIM_VARLIST_VALUES
) {
11477 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11482 /* mode is JIM_VARLIST_xxx */
11483 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11485 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11486 /* For [info locals], if we are at top level an emtpy list
11487 * is returned. I don't agree, but we aim at compatibility (SS) */
11488 return interp
->emptyObj
;
11491 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11492 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11496 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11497 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11499 Jim_CallFrame
*targetCallFrame
;
11501 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11502 if (targetCallFrame
== NULL
) {
11505 /* No proc call at toplevel callframe */
11506 if (targetCallFrame
== interp
->topFramePtr
) {
11507 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11510 if (info_level_cmd
) {
11511 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11514 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11516 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11517 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11518 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11519 *objPtrPtr
= listObj
;
11524 /* -----------------------------------------------------------------------------
11526 * ---------------------------------------------------------------------------*/
11528 /* fake [puts] -- not the real puts, just for debugging. */
11529 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11531 if (argc
!= 2 && argc
!= 3) {
11532 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11536 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11537 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11541 fputs(Jim_String(argv
[2]), stdout
);
11545 puts(Jim_String(argv
[1]));
11550 /* Helper for [+] and [*] */
11551 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11553 jim_wide wideValue
, res
;
11554 double doubleValue
, doubleRes
;
11557 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11559 for (i
= 1; i
< argc
; i
++) {
11560 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11562 if (op
== JIM_EXPROP_ADD
)
11567 Jim_SetResultInt(interp
, res
);
11570 doubleRes
= (double)res
;
11571 for (; i
< argc
; i
++) {
11572 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11574 if (op
== JIM_EXPROP_ADD
)
11575 doubleRes
+= doubleValue
;
11577 doubleRes
*= doubleValue
;
11579 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11583 /* Helper for [-] and [/] */
11584 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11586 jim_wide wideValue
, res
= 0;
11587 double doubleValue
, doubleRes
= 0;
11591 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11594 else if (argc
== 2) {
11595 /* The arity = 2 case is different. For [- x] returns -x,
11596 * while [/ x] returns 1/x. */
11597 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11598 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11602 if (op
== JIM_EXPROP_SUB
)
11603 doubleRes
= -doubleValue
;
11605 doubleRes
= 1.0 / doubleValue
;
11606 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11610 if (op
== JIM_EXPROP_SUB
) {
11612 Jim_SetResultInt(interp
, res
);
11615 doubleRes
= 1.0 / wideValue
;
11616 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11621 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11622 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11631 for (i
= 2; i
< argc
; i
++) {
11632 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11633 doubleRes
= (double)res
;
11636 if (op
== JIM_EXPROP_SUB
)
11641 Jim_SetResultInt(interp
, res
);
11644 for (; i
< argc
; i
++) {
11645 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11647 if (op
== JIM_EXPROP_SUB
)
11648 doubleRes
-= doubleValue
;
11650 doubleRes
/= doubleValue
;
11652 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11658 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11660 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11664 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11666 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11670 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11672 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11676 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11678 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11682 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11684 if (argc
!= 2 && argc
!= 3) {
11685 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11691 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11694 Jim_SetResult(interp
, objPtr
);
11697 /* argc == 3 case. */
11698 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11700 Jim_SetResult(interp
, argv
[2]);
11706 * unset ?-nocomplain? ?--? ?varName ...?
11708 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11714 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11718 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11727 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11737 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11740 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11744 /* The general purpose implementation of while starts here */
11746 int boolean
, retval
;
11748 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11753 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11767 Jim_SetEmptyResult(interp
);
11772 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11776 Jim_Obj
*varNamePtr
= NULL
;
11777 Jim_Obj
*stopVarNamePtr
= NULL
;
11780 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11784 /* Do the initialisation */
11785 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11789 /* And do the first test now. Better for optimisation
11790 * if we can do next/test at the bottom of the loop
11792 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11794 /* Ready to do the body as follows:
11796 * body // check retcode
11797 * next // check retcode
11798 * test // check retcode/test bool
11802 #ifdef JIM_OPTIMIZATION
11803 /* Check if the for is on the form:
11804 * for ... {$i < CONST} {incr i}
11805 * for ... {$i < $j} {incr i}
11807 if (retval
== JIM_OK
&& boolean
) {
11808 ScriptObj
*incrScript
;
11809 ExprByteCode
*expr
;
11810 jim_wide stop
, currentVal
;
11814 /* Do it only if there aren't shared arguments */
11815 expr
= JimGetExpression(interp
, argv
[2]);
11816 incrScript
= JimGetScript(interp
, argv
[3]);
11818 /* Ensure proper lengths to start */
11819 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11822 /* Ensure proper token types. */
11823 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11824 expr
->token
[0].type
!= JIM_TT_VAR
||
11825 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11829 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11832 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11839 /* Update command must be incr */
11840 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11844 /* incr, expression must be about the same variable */
11845 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11849 /* Get the stop condition (must be a variable or integer) */
11850 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11851 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11856 stopVarNamePtr
= expr
->token
[1].objPtr
;
11857 Jim_IncrRefCount(stopVarNamePtr
);
11858 /* Keep the compiler happy */
11862 /* Initialization */
11863 varNamePtr
= expr
->token
[0].objPtr
;
11864 Jim_IncrRefCount(varNamePtr
);
11866 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11867 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11871 /* --- OPTIMIZED FOR --- */
11872 while (retval
== JIM_OK
) {
11873 /* === Check condition === */
11874 /* Note that currentVal is already set here */
11876 /* Immediate or Variable? get the 'stop' value if the latter. */
11877 if (stopVarNamePtr
) {
11878 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11879 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11884 if (currentVal
>= stop
+ cmpOffset
) {
11889 retval
= Jim_EvalObj(interp
, argv
[4]);
11890 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11893 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11896 if (objPtr
== NULL
) {
11900 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11901 currentVal
= ++JimWideValue(objPtr
);
11902 Jim_InvalidateStringRep(objPtr
);
11905 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11906 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11907 ++currentVal
)) != JIM_OK
) {
11918 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11920 retval
= Jim_EvalObj(interp
, argv
[4]);
11922 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11924 JIM_IF_OPTIM(evalnext
:)
11925 retval
= Jim_EvalObj(interp
, argv
[3]);
11926 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11928 JIM_IF_OPTIM(testcond
:)
11929 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11934 if (stopVarNamePtr
) {
11935 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11938 Jim_DecrRefCount(interp
, varNamePtr
);
11941 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11942 Jim_SetEmptyResult(interp
);
11950 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11956 Jim_Obj
*bodyObjPtr
;
11958 if (argc
!= 5 && argc
!= 6) {
11959 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11963 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11964 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11965 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11968 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11970 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11972 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11973 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11974 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11975 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11982 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11983 if (argv
[1]->typePtr
!= &variableObjType
) {
11984 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11988 JimWideValue(objPtr
) = i
;
11989 Jim_InvalidateStringRep(objPtr
);
11991 /* The following step is required in order to invalidate the
11992 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11993 if (argv
[1]->typePtr
!= &variableObjType
) {
11994 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
12001 objPtr
= Jim_NewIntObj(interp
, i
);
12002 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
12003 if (retval
!= JIM_OK
) {
12004 Jim_FreeNewObj(interp
, objPtr
);
12010 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
12011 Jim_SetEmptyResult(interp
);
12017 /* List iterators make it easy to iterate over a list.
12018 * At some point iterators will be expanded to support generators.
12026 * Initialise the iterator at the start of the list.
12028 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
12030 iter
->objPtr
= objPtr
;
12035 * Returns the next object from the list, or NULL on end-of-list.
12037 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
12039 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
12042 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
12046 * Returns 1 if end-of-list has been reached.
12048 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
12050 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
12053 /* foreach + lmap implementation. */
12054 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
12056 int result
= JIM_OK
;
12058 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
12059 Jim_ListIter
*iters
;
12061 Jim_Obj
*resultObj
;
12063 if (argc
< 4 || argc
% 2 != 0) {
12064 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
12067 script
= argv
[argc
- 1]; /* Last argument is a script */
12068 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
12070 if (numargs
== 2) {
12074 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
12076 for (i
= 0; i
< numargs
; i
++) {
12077 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12078 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
12082 if (result
!= JIM_OK
) {
12083 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
12088 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12091 resultObj
= interp
->emptyObj
;
12093 Jim_IncrRefCount(resultObj
);
12096 /* Have we expired all lists? */
12097 for (i
= 0; i
< numargs
; i
+= 2) {
12098 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
12102 if (i
== numargs
) {
12107 /* For each list */
12108 for (i
= 0; i
< numargs
; i
+= 2) {
12112 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
12113 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
12114 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
12116 /* Ran out, so store the empty string */
12117 valObj
= interp
->emptyObj
;
12119 /* Avoid shimmering */
12120 Jim_IncrRefCount(valObj
);
12121 result
= Jim_SetVariable(interp
, varName
, valObj
);
12122 Jim_DecrRefCount(interp
, valObj
);
12123 if (result
!= JIM_OK
) {
12128 switch (result
= Jim_EvalObj(interp
, script
)) {
12131 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
12144 Jim_SetResult(interp
, resultObj
);
12146 Jim_DecrRefCount(interp
, resultObj
);
12154 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12156 return JimForeachMapHelper(interp
, argc
, argv
, 0);
12160 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12162 return JimForeachMapHelper(interp
, argc
, argv
, 1);
12166 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12168 int result
= JIM_ERR
;
12171 Jim_Obj
*resultObj
;
12174 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12178 JimListIterInit(&iter
, argv
[1]);
12180 for (i
= 2; i
< argc
; i
++) {
12181 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12182 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12183 if (result
!= JIM_OK
) {
12188 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12189 while (!JimListIterDone(interp
, &iter
)) {
12190 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12193 Jim_SetResult(interp
, resultObj
);
12199 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12201 int boolean
, retval
, current
= 1, falsebody
= 0;
12205 /* Far not enough arguments given! */
12206 if (current
>= argc
)
12208 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12211 /* There lacks something, isn't it? */
12212 if (current
>= argc
)
12214 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12216 /* Tsk tsk, no then-clause? */
12217 if (current
>= argc
)
12220 return Jim_EvalObj(interp
, argv
[current
]);
12221 /* Ok: no else-clause follows */
12222 if (++current
>= argc
) {
12223 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12226 falsebody
= current
++;
12227 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12228 /* IIICKS - else-clause isn't last cmd? */
12229 if (current
!= argc
- 1)
12231 return Jim_EvalObj(interp
, argv
[current
]);
12233 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12234 /* Ok: elseif follows meaning all the stuff
12235 * again (how boring...) */
12237 /* OOPS - else-clause is not last cmd? */
12238 else if (falsebody
!= argc
- 1)
12240 return Jim_EvalObj(interp
, argv
[falsebody
]);
12245 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12250 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12251 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12252 Jim_Obj
*stringObj
, int nocase
)
12259 parms
[argc
++] = commandObj
;
12261 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12263 parms
[argc
++] = patternObj
;
12264 parms
[argc
++] = stringObj
;
12266 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12268 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12276 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12279 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12281 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12282 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12283 Jim_Obj
*script
= 0;
12287 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12288 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12291 for (opt
= 1; opt
< argc
; ++opt
) {
12292 const char *option
= Jim_String(argv
[opt
]);
12294 if (*option
!= '-')
12296 else if (strncmp(option
, "--", 2) == 0) {
12300 else if (strncmp(option
, "-exact", 2) == 0)
12301 matchOpt
= SWITCH_EXACT
;
12302 else if (strncmp(option
, "-glob", 2) == 0)
12303 matchOpt
= SWITCH_GLOB
;
12304 else if (strncmp(option
, "-regexp", 2) == 0)
12305 matchOpt
= SWITCH_RE
;
12306 else if (strncmp(option
, "-command", 2) == 0) {
12307 matchOpt
= SWITCH_CMD
;
12308 if ((argc
- opt
) < 2)
12310 command
= argv
[++opt
];
12313 Jim_SetResultFormatted(interp
,
12314 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12318 if ((argc
- opt
) < 2)
12321 strObj
= argv
[opt
++];
12322 patCount
= argc
- opt
;
12323 if (patCount
== 1) {
12326 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12330 caseList
= &argv
[opt
];
12331 if (patCount
== 0 || patCount
% 2 != 0)
12333 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12334 Jim_Obj
*patObj
= caseList
[i
];
12336 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12337 || i
< (patCount
- 2)) {
12338 switch (matchOpt
) {
12340 if (Jim_StringEqObj(strObj
, patObj
))
12341 script
= caseList
[i
+ 1];
12344 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12345 script
= caseList
[i
+ 1];
12348 command
= Jim_NewStringObj(interp
, "regexp", -1);
12349 /* Fall thru intentionally */
12351 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12353 /* After the execution of a command we need to
12354 * make sure to reconvert the object into a list
12355 * again. Only for the single-list style [switch]. */
12356 if (argc
- opt
== 1) {
12359 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12362 /* command is here already decref'd */
12367 script
= caseList
[i
+ 1];
12373 script
= caseList
[i
+ 1];
12376 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12377 script
= caseList
[i
+ 1];
12378 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12379 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12382 Jim_SetEmptyResult(interp
);
12384 return Jim_EvalObj(interp
, script
);
12390 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12392 Jim_Obj
*listObjPtr
;
12394 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12395 Jim_SetResult(interp
, listObjPtr
);
12400 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12402 Jim_Obj
*objPtr
, *listObjPtr
;
12407 Jim_WrongNumArgs(interp
, 1, argv
, "list ?index ...?");
12411 Jim_IncrRefCount(objPtr
);
12412 for (i
= 2; i
< argc
; i
++) {
12413 listObjPtr
= objPtr
;
12414 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12415 Jim_DecrRefCount(interp
, listObjPtr
);
12418 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12419 /* Returns an empty object if the index
12420 * is out of range. */
12421 Jim_DecrRefCount(interp
, listObjPtr
);
12422 Jim_SetEmptyResult(interp
);
12425 Jim_IncrRefCount(objPtr
);
12426 Jim_DecrRefCount(interp
, listObjPtr
);
12428 Jim_SetResult(interp
, objPtr
);
12429 Jim_DecrRefCount(interp
, objPtr
);
12434 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12437 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12440 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12445 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12447 static const char * const options
[] = {
12448 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12452 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12457 int opt_nocase
= 0;
12459 int opt_inline
= 0;
12460 int opt_match
= OPT_EXACT
;
12463 Jim_Obj
*listObjPtr
= NULL
;
12464 Jim_Obj
*commandObj
= NULL
;
12468 Jim_WrongNumArgs(interp
, 1, argv
,
12469 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12473 for (i
= 1; i
< argc
- 2; i
++) {
12476 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12498 if (i
>= argc
- 2) {
12501 commandObj
= argv
[++i
];
12506 opt_match
= option
;
12514 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12516 if (opt_match
== OPT_REGEXP
) {
12517 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12520 Jim_IncrRefCount(commandObj
);
12523 listlen
= Jim_ListLength(interp
, argv
[0]);
12524 for (i
= 0; i
< listlen
; i
++) {
12526 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12528 switch (opt_match
) {
12530 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12534 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12539 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12542 Jim_FreeNewObj(interp
, listObjPtr
);
12550 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12551 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12555 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12556 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12557 Jim_Obj
*resultObj
;
12560 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12562 else if (!opt_inline
) {
12563 resultObj
= Jim_NewIntObj(interp
, i
);
12566 resultObj
= objPtr
;
12570 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12573 Jim_SetResult(interp
, resultObj
);
12580 Jim_SetResult(interp
, listObjPtr
);
12585 Jim_SetResultBool(interp
, opt_not
);
12587 else if (!opt_inline
) {
12588 Jim_SetResultInt(interp
, -1);
12594 Jim_DecrRefCount(interp
, commandObj
);
12600 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12602 Jim_Obj
*listObjPtr
;
12607 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12610 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12612 /* Create the list if it does not exist */
12613 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12616 else if (Jim_IsShared(listObjPtr
)) {
12617 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12620 for (i
= 2; i
< argc
; i
++)
12621 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12622 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12624 Jim_FreeNewObj(interp
, listObjPtr
);
12627 Jim_SetResult(interp
, listObjPtr
);
12632 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12638 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12642 if (Jim_IsShared(listPtr
))
12643 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12644 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12646 len
= Jim_ListLength(interp
, listPtr
);
12650 idx
= len
+ idx
+ 1;
12651 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12652 Jim_SetResult(interp
, listPtr
);
12655 if (listPtr
!= argv
[1]) {
12656 Jim_FreeNewObj(interp
, listPtr
);
12662 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12664 int first
, last
, len
, rangeLen
;
12666 Jim_Obj
*newListObj
;
12669 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12672 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12673 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12678 len
= Jim_ListLength(interp
, listObj
);
12680 first
= JimRelToAbsIndex(len
, first
);
12681 last
= JimRelToAbsIndex(len
, last
);
12682 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12684 /* Now construct a new list which consists of:
12685 * <elements before first> <supplied elements> <elements after last>
12688 /* Check to see if trying to replace past the end of the list */
12690 /* OK. Not past the end */
12692 else if (len
== 0) {
12693 /* Special for empty list, adjust first to 0 */
12697 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12698 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12702 /* Add the first set of elements */
12703 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12705 /* Add supplied elements */
12706 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12708 /* Add the remaining elements */
12709 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12711 Jim_SetResult(interp
, newListObj
);
12716 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12719 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12722 else if (argc
== 3) {
12723 /* With no indexes, simply implements [set] */
12724 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12726 Jim_SetResult(interp
, argv
[2]);
12729 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12733 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12735 static const char * const options
[] = {
12736 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12739 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12744 struct lsort_info info
;
12747 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12751 info
.type
= JIM_LSORT_ASCII
;
12755 info
.command
= NULL
;
12756 info
.interp
= interp
;
12758 for (i
= 1; i
< (argc
- 1); i
++) {
12761 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12766 info
.type
= JIM_LSORT_ASCII
;
12769 info
.type
= JIM_LSORT_NOCASE
;
12772 info
.type
= JIM_LSORT_INTEGER
;
12775 info
.type
= JIM_LSORT_REAL
;
12777 case OPT_INCREASING
:
12780 case OPT_DECREASING
:
12787 if (i
>= (argc
- 2)) {
12788 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12791 info
.type
= JIM_LSORT_COMMAND
;
12792 info
.command
= argv
[i
+ 1];
12796 if (i
>= (argc
- 2)) {
12797 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12800 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12808 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12809 retCode
= ListSortElements(interp
, resObj
, &info
);
12810 if (retCode
== JIM_OK
) {
12811 Jim_SetResult(interp
, resObj
);
12814 Jim_FreeNewObj(interp
, resObj
);
12820 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12822 Jim_Obj
*stringObjPtr
;
12826 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value ...?");
12830 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12836 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12837 if (!stringObjPtr
) {
12838 /* Create the string if it doesn't exist */
12839 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12842 else if (Jim_IsShared(stringObjPtr
)) {
12844 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12846 for (i
= 2; i
< argc
; i
++) {
12847 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12849 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12851 Jim_FreeNewObj(interp
, stringObjPtr
);
12856 Jim_SetResult(interp
, stringObjPtr
);
12861 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12863 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12864 static const char * const options
[] = {
12865 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12871 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12872 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12877 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12880 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12881 return Jim_CheckShowCommands(interp
, argv
[1], options
);
12882 if (option
== OPT_REFCOUNT
) {
12884 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12887 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12890 else if (option
== OPT_OBJCOUNT
) {
12891 int freeobj
= 0, liveobj
= 0;
12896 Jim_WrongNumArgs(interp
, 2, argv
, "");
12899 /* Count the number of free objects. */
12900 objPtr
= interp
->freeList
;
12903 objPtr
= objPtr
->nextObjPtr
;
12905 /* Count the number of live objects. */
12906 objPtr
= interp
->liveList
;
12909 objPtr
= objPtr
->nextObjPtr
;
12911 /* Set the result string and return. */
12912 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12913 Jim_SetResultString(interp
, buf
, -1);
12916 else if (option
== OPT_OBJECTS
) {
12917 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12919 /* Count the number of live objects. */
12920 objPtr
= interp
->liveList
;
12921 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12924 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12926 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12927 sprintf(buf
, "%p", objPtr
);
12928 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12929 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12930 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12931 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12932 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12933 objPtr
= objPtr
->nextObjPtr
;
12935 Jim_SetResult(interp
, listObjPtr
);
12938 else if (option
== OPT_INVSTR
) {
12942 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12946 if (objPtr
->typePtr
!= NULL
)
12947 Jim_InvalidateStringRep(objPtr
);
12948 Jim_SetEmptyResult(interp
);
12951 else if (option
== OPT_SHOW
) {
12956 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12959 s
= Jim_GetString(argv
[2], &len
);
12961 charlen
= utf8_strlen(s
, len
);
12965 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12966 printf("chars (%d): <<%s>>\n", charlen
, s
);
12967 printf("bytes (%d):", len
);
12969 printf(" %02x", (unsigned char)*s
++);
12974 else if (option
== OPT_SCRIPTLEN
) {
12978 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12981 script
= JimGetScript(interp
, argv
[2]);
12982 if (script
== NULL
)
12984 Jim_SetResultInt(interp
, script
->len
);
12987 else if (option
== OPT_EXPRLEN
) {
12988 ExprByteCode
*expr
;
12991 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12994 expr
= JimGetExpression(interp
, argv
[2]);
12997 Jim_SetResultInt(interp
, expr
->len
);
13000 else if (option
== OPT_EXPRBC
) {
13002 ExprByteCode
*expr
;
13006 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
13009 expr
= JimGetExpression(interp
, argv
[2]);
13012 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
13013 for (i
= 0; i
< expr
->len
; i
++) {
13015 const Jim_ExprOperator
*op
;
13016 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
13018 switch (expr
->token
[i
].type
) {
13019 case JIM_TT_EXPR_INT
:
13022 case JIM_TT_EXPR_DOUBLE
:
13025 case JIM_TT_EXPR_BOOLEAN
:
13034 case JIM_TT_DICTSUGAR
:
13035 type
= "dictsugar";
13037 case JIM_TT_EXPRSUGAR
:
13038 type
= "exprsugar";
13047 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
13054 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
13057 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
13058 Jim_ListAppendElement(interp
, objPtr
, obj
);
13060 Jim_SetResult(interp
, objPtr
);
13064 Jim_SetResultString(interp
,
13065 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13069 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
13070 #if !defined(JIM_DEBUG_COMMAND)
13071 Jim_SetResultString(interp
, "unsupported", -1);
13077 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13082 Jim_WrongNumArgs(interp
, 1, argv
, "arg ?arg ...?");
13087 rc
= Jim_EvalObj(interp
, argv
[1]);
13090 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13093 if (rc
== JIM_ERR
) {
13094 /* eval is "interesting", so add a stack frame here */
13095 interp
->addStackTrace
++;
13101 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13105 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
13108 /* Save the old callframe pointer */
13109 savedCallFrame
= interp
->framePtr
;
13111 /* Lookup the target frame pointer */
13112 str
= Jim_String(argv
[1]);
13113 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
13114 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13119 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13121 if (targetCallFrame
== NULL
) {
13125 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
13128 /* Eval the code in the target callframe. */
13129 interp
->framePtr
= targetCallFrame
;
13131 retcode
= Jim_EvalObj(interp
, argv
[1]);
13134 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13136 interp
->framePtr
= savedCallFrame
;
13140 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
13146 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13148 Jim_Obj
*exprResultPtr
;
13152 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
13154 else if (argc
> 2) {
13157 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
13158 Jim_IncrRefCount(objPtr
);
13159 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
13160 Jim_DecrRefCount(interp
, objPtr
);
13163 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
13166 if (retcode
!= JIM_OK
)
13168 Jim_SetResult(interp
, exprResultPtr
);
13169 Jim_DecrRefCount(interp
, exprResultPtr
);
13174 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13177 Jim_WrongNumArgs(interp
, 1, argv
, "");
13184 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13187 Jim_WrongNumArgs(interp
, 1, argv
, "");
13190 return JIM_CONTINUE
;
13194 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13197 Jim_Obj
*stackTraceObj
= NULL
;
13198 Jim_Obj
*errorCodeObj
= NULL
;
13199 int returnCode
= JIM_OK
;
13202 for (i
= 1; i
< argc
- 1; i
+= 2) {
13203 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13204 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13208 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13209 stackTraceObj
= argv
[i
+ 1];
13211 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13212 errorCodeObj
= argv
[i
+ 1];
13214 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13215 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13216 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13225 if (i
!= argc
- 1 && i
!= argc
) {
13226 Jim_WrongNumArgs(interp
, 1, argv
,
13227 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13230 /* If a stack trace is supplied and code is error, set the stack trace */
13231 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13232 JimSetStackTrace(interp
, stackTraceObj
);
13234 /* If an error code list is supplied, set the global $errorCode */
13235 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13236 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13238 interp
->returnCode
= returnCode
;
13239 interp
->returnLevel
= level
;
13241 if (i
== argc
- 1) {
13242 Jim_SetResult(interp
, argv
[i
]);
13248 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13250 if (interp
->framePtr
->level
== 0) {
13251 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13254 else if (argc
>= 2) {
13255 /* Need to resolve the tailcall command in the current context */
13256 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13258 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13259 if (cmdPtr
== NULL
) {
13263 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13265 /* And stash this pre-resolved command */
13266 JimIncrCmdRefCount(cmdPtr
);
13267 cf
->tailcallCmd
= cmdPtr
;
13269 /* And stash the command list */
13270 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13272 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13273 Jim_IncrRefCount(cf
->tailcallObj
);
13275 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13281 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13284 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13286 /* prefixListObj is a list to which the args need to be appended */
13287 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13288 Jim_ListInsertElements(interp
, cmdList
, Jim_ListLength(interp
, cmdList
), argc
- 1, argv
+ 1);
13290 return JimEvalObjList(interp
, cmdList
);
13293 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13295 Jim_Obj
*prefixListObj
= privData
;
13296 Jim_DecrRefCount(interp
, prefixListObj
);
13299 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13301 Jim_Obj
*prefixListObj
;
13302 const char *newname
;
13305 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13309 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13310 Jim_IncrRefCount(prefixListObj
);
13311 newname
= Jim_String(argv
[1]);
13312 if (newname
[0] == ':' && newname
[1] == ':') {
13313 while (*++newname
== ':') {
13317 Jim_SetResult(interp
, argv
[1]);
13319 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13323 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13327 if (argc
!= 4 && argc
!= 5) {
13328 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13332 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13337 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13340 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13344 /* Add the new command */
13345 Jim_Obj
*qualifiedCmdNameObj
;
13346 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13348 JimCreateCommand(interp
, cmdname
, cmd
);
13350 /* Calculate and set the namespace for this proc */
13351 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13353 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13355 /* Unlike Tcl, set the name of the proc as the result */
13356 Jim_SetResult(interp
, argv
[1]);
13363 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13368 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13372 /* Evaluate the arguments with 'local' in force */
13374 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13378 /* If OK, and the result is a proc, add it to the list of local procs */
13379 if (retcode
== 0) {
13380 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13382 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13385 if (interp
->framePtr
->localCommands
== NULL
) {
13386 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13387 Jim_InitStack(interp
->framePtr
->localCommands
);
13389 Jim_IncrRefCount(cmdNameObj
);
13390 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13397 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13400 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13406 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13407 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13408 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13411 /* OK. Mark this command as being in an upcall */
13412 cmdPtr
->u
.proc
.upcall
++;
13413 JimIncrCmdRefCount(cmdPtr
);
13415 /* Invoke the command as normal */
13416 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13418 /* No longer in an upcall */
13419 cmdPtr
->u
.proc
.upcall
--;
13420 JimDecrCmdRefCount(interp
, cmdPtr
);
13427 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13430 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13436 Jim_Obj
*argListObjPtr
;
13437 Jim_Obj
*bodyObjPtr
;
13438 Jim_Obj
*nsObj
= NULL
;
13441 int len
= Jim_ListLength(interp
, argv
[1]);
13442 if (len
!= 2 && len
!= 3) {
13443 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13448 #ifdef jim_ext_namespace
13449 /* Need to canonicalise the given namespace. */
13450 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13452 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13456 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13457 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13459 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13462 /* Create a new argv array with a dummy argv[0], for error messages */
13463 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13464 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13465 Jim_IncrRefCount(nargv
[0]);
13466 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13467 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13468 Jim_DecrRefCount(interp
, nargv
[0]);
13471 JimDecrCmdRefCount(interp
, cmd
);
13480 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13482 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13487 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13490 Jim_CallFrame
*targetCallFrame
;
13492 /* Lookup the target frame pointer */
13493 if (argc
> 3 && (argc
% 2 == 0)) {
13494 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13499 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13501 if (targetCallFrame
== NULL
) {
13505 /* Check for arity */
13507 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13511 /* Now... for every other/local couple: */
13512 for (i
= 1; i
< argc
; i
+= 2) {
13513 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13520 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13525 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13528 /* Link every var to the toplevel having the same name */
13529 if (interp
->framePtr
->level
== 0)
13530 return JIM_OK
; /* global at toplevel... */
13531 for (i
= 1; i
< argc
; i
++) {
13532 /* global ::blah does nothing */
13533 const char *name
= Jim_String(argv
[i
]);
13534 if (name
[0] != ':' || name
[1] != ':') {
13535 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13542 /* does the [string map] operation. On error NULL is returned,
13543 * otherwise a new string object with the result, having refcount = 0,
13545 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13546 Jim_Obj
*objPtr
, int nocase
)
13549 const char *str
, *noMatchStart
= NULL
;
13551 Jim_Obj
*resultObjPtr
;
13553 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13555 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13559 str
= Jim_String(objPtr
);
13560 strLen
= Jim_Utf8Length(interp
, objPtr
);
13563 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13565 for (i
= 0; i
< numMaps
; i
+= 2) {
13566 Jim_Obj
*eachObjPtr
;
13570 eachObjPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13571 k
= Jim_String(eachObjPtr
);
13572 kl
= Jim_Utf8Length(interp
, eachObjPtr
);
13574 if (strLen
>= kl
&& kl
) {
13576 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13578 if (noMatchStart
) {
13579 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13580 noMatchStart
= NULL
;
13582 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13583 str
+= utf8_index(str
, kl
);
13589 if (i
== numMaps
) { /* no match */
13591 if (noMatchStart
== NULL
)
13592 noMatchStart
= str
;
13593 str
+= utf8_tounicode(str
, &c
);
13597 if (noMatchStart
) {
13598 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13600 return resultObjPtr
;
13604 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13609 static const char * const options
[] = {
13610 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13611 "map", "repeat", "reverse", "index", "first", "last", "cat",
13612 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13616 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13617 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
, OPT_CAT
,
13618 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13620 static const char * const nocase_options
[] = {
13623 static const char * const nocase_length_options
[] = {
13624 "-nocase", "-length", NULL
13628 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13631 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13632 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13633 return Jim_CheckShowCommands(interp
, argv
[1], options
);
13637 case OPT_BYTELENGTH
:
13639 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13642 if (option
== OPT_LENGTH
) {
13643 len
= Jim_Utf8Length(interp
, argv
[2]);
13646 len
= Jim_Length(argv
[2]);
13648 Jim_SetResultInt(interp
, len
);
13654 /* optimise the one-arg case */
13660 objPtr
= Jim_NewStringObj(interp
, "", 0);
13662 for (i
= 2; i
< argc
; i
++) {
13663 Jim_AppendObj(interp
, objPtr
, argv
[i
]);
13666 Jim_SetResult(interp
, objPtr
);
13673 /* n is the number of remaining option args */
13674 long opt_length
= -1;
13679 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13680 JIM_ENUM_ABBREV
) != JIM_OK
) {
13682 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13693 goto badcompareargs
;
13695 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13702 goto badcompareargs
;
13705 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13706 /* Fast version - [string equal], case sensitive, no length */
13707 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13710 if (opt_length
>= 0) {
13711 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13714 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13716 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13724 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13725 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13726 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13729 if (opt_case
== 0) {
13732 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13740 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13741 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13742 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13746 if (opt_case
== 0) {
13749 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13750 if (objPtr
== NULL
) {
13753 Jim_SetResult(interp
, objPtr
);
13758 case OPT_BYTERANGE
:{
13762 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13765 if (option
== OPT_RANGE
) {
13766 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13770 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13773 if (objPtr
== NULL
) {
13776 Jim_SetResult(interp
, objPtr
);
13783 if (argc
!= 5 && argc
!= 6) {
13784 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13787 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13788 if (objPtr
== NULL
) {
13791 Jim_SetResult(interp
, objPtr
);
13801 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13804 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13807 objPtr
= Jim_NewStringObj(interp
, "", 0);
13810 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13813 Jim_SetResult(interp
, objPtr
);
13823 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13827 str
= Jim_GetString(argv
[2], &len
);
13828 buf
= Jim_Alloc(len
+ 1);
13831 for (i
= 0; i
< len
; ) {
13833 int l
= utf8_tounicode(str
, &c
);
13834 memcpy(p
- l
, str
, l
);
13839 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13848 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13851 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13854 str
= Jim_String(argv
[2]);
13855 len
= Jim_Utf8Length(interp
, argv
[2]);
13856 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13857 idx
= JimRelToAbsIndex(len
, idx
);
13859 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13860 Jim_SetResultString(interp
, "", 0);
13862 else if (len
== Jim_Length(argv
[2])) {
13863 /* ASCII optimisation */
13864 Jim_SetResultString(interp
, str
+ idx
, 1);
13868 int i
= utf8_index(str
, idx
);
13869 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13876 int idx
= 0, l1
, l2
;
13877 const char *s1
, *s2
;
13879 if (argc
!= 4 && argc
!= 5) {
13880 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13883 s1
= Jim_String(argv
[2]);
13884 s2
= Jim_String(argv
[3]);
13885 l1
= Jim_Utf8Length(interp
, argv
[2]);
13886 l2
= Jim_Utf8Length(interp
, argv
[3]);
13888 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13891 idx
= JimRelToAbsIndex(l2
, idx
);
13893 else if (option
== OPT_LAST
) {
13896 if (option
== OPT_FIRST
) {
13897 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13901 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13903 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13911 case OPT_TRIMRIGHT
:{
13912 Jim_Obj
*trimchars
;
13914 if (argc
!= 3 && argc
!= 4) {
13915 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13918 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13919 if (option
== OPT_TRIM
) {
13920 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13922 else if (option
== OPT_TRIMLEFT
) {
13923 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13925 else if (option
== OPT_TRIMRIGHT
) {
13926 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13935 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13938 if (option
== OPT_TOLOWER
) {
13939 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13941 else if (option
== OPT_TOUPPER
) {
13942 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13945 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13950 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13951 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13953 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13960 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13963 jim_wide start
, elapsed
;
13965 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13968 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13972 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13978 start
= JimClock();
13982 retval
= Jim_EvalObj(interp
, argv
[1]);
13983 if (retval
!= JIM_OK
) {
13987 elapsed
= JimClock() - start
;
13988 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13989 Jim_SetResultString(interp
, buf
, -1);
13994 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13999 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
14003 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
14006 interp
->exitCode
= exitCode
;
14011 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14017 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14018 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
14019 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
14021 /* Reset the error code before catch.
14022 * Note that this is not strictly correct.
14024 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
14026 for (i
= 1; i
< argc
- 1; i
++) {
14027 const char *arg
= Jim_String(argv
[i
]);
14031 /* It's a pity we can't use Jim_GetEnum here :-( */
14032 if (strcmp(arg
, "--") == 0) {
14040 if (strncmp(arg
, "-no", 3) == 0) {
14049 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
14053 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
14060 ignore_mask
|= ((jim_wide
)1 << option
);
14063 ignore_mask
&= (~((jim_wide
)1 << option
));
14068 if (argc
< 1 || argc
> 3) {
14070 Jim_WrongNumArgs(interp
, 1, argv
,
14071 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14076 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
14080 interp
->signal_level
+= sig
;
14081 if (Jim_CheckSignal(interp
)) {
14082 /* If a signal is set, don't even try to execute the body */
14083 exitCode
= JIM_SIGNAL
;
14086 exitCode
= Jim_EvalObj(interp
, argv
[0]);
14087 /* Don't want any caught error included in a later stack trace */
14088 interp
->errorFlag
= 0;
14090 interp
->signal_level
-= sig
;
14092 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14093 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
14094 /* Not caught, pass it up */
14098 if (sig
&& exitCode
== JIM_SIGNAL
) {
14099 /* Catch the signal at this level */
14100 if (interp
->signal_set_result
) {
14101 interp
->signal_set_result(interp
, interp
->sigmask
);
14104 Jim_SetResultInt(interp
, interp
->sigmask
);
14106 interp
->sigmask
= 0;
14110 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
14114 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
14116 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
14117 Jim_ListAppendElement(interp
, optListObj
,
14118 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
14119 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
14120 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
14121 if (exitCode
== JIM_ERR
) {
14122 Jim_Obj
*errorCode
;
14123 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
14125 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
14127 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
14129 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
14130 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
14133 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
14138 Jim_SetResultInt(interp
, exitCode
);
14142 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14145 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14147 if (argc
!= 3 && argc
!= 4) {
14148 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
14152 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
14155 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
14161 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14163 Jim_Reference
*refPtr
;
14166 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
14169 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14171 Jim_SetResult(interp
, refPtr
->objPtr
);
14176 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14178 Jim_Reference
*refPtr
;
14181 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
14184 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
14186 Jim_IncrRefCount(argv
[2]);
14187 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
14188 refPtr
->objPtr
= argv
[2];
14189 Jim_SetResult(interp
, argv
[2]);
14194 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14197 Jim_WrongNumArgs(interp
, 1, argv
, "");
14200 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14202 /* Free all the freed objects. */
14203 while (interp
->freeList
) {
14204 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14205 Jim_Free(interp
->freeList
);
14206 interp
->freeList
= nextObjPtr
;
14212 /* [finalize] reference ?newValue? */
14213 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14215 if (argc
!= 2 && argc
!= 3) {
14216 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14220 Jim_Obj
*cmdNamePtr
;
14222 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14224 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14225 Jim_SetResult(interp
, cmdNamePtr
);
14228 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14230 Jim_SetResult(interp
, argv
[2]);
14235 /* [info references] */
14236 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14238 Jim_Obj
*listObjPtr
;
14239 Jim_HashTableIterator htiter
;
14242 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14244 JimInitHashTableIterator(&interp
->references
, &htiter
);
14245 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14246 char buf
[JIM_REFERENCE_SPACE
+ 1];
14247 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14248 const unsigned long *refId
= he
->key
;
14250 JimFormatReference(buf
, refPtr
, *refId
);
14251 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14253 Jim_SetResult(interp
, listObjPtr
);
14256 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14259 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14262 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14266 if (JimValidName(interp
, "new procedure", argv
[2])) {
14270 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14273 #define JIM_DICTMATCH_VALUES 0x0001
14275 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14277 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14279 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14280 if (type
& JIM_DICTMATCH_VALUES
) {
14281 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14286 * Like JimHashtablePatternMatch, but for dictionaries.
14288 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14289 JimDictMatchCallbackType
*callback
, int type
)
14292 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14294 /* Check for the non-pattern case. We can do this much more efficiently. */
14295 Jim_HashTableIterator htiter
;
14296 JimInitHashTableIterator(ht
, &htiter
);
14297 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14298 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14299 callback(interp
, listObjPtr
, he
, type
);
14307 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14309 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14312 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14316 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14318 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14321 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14325 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14327 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14330 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14334 * Must be called with at least one object.
14335 * Returns the new dictionary, or NULL on error.
14337 Jim_Obj
*Jim_DictMerge(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
14339 Jim_Obj
*objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
14342 JimPanic((objc
== 0, "Jim_DictMerge called with objc=0"));
14344 /* Note that we don't optimise the trivial case of a single argument */
14346 for (i
= 0; i
< objc
; i
++) {
14348 Jim_HashTableIterator htiter
;
14351 if (SetDictFromAny(interp
, objv
[i
]) != JIM_OK
) {
14352 Jim_FreeNewObj(interp
, objPtr
);
14355 ht
= objv
[i
]->internalRep
.ptr
;
14356 JimInitHashTableIterator(ht
, &htiter
);
14357 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14358 Jim_ReplaceHashEntry(objPtr
->internalRep
.ptr
, Jim_GetHashEntryKey(he
), Jim_GetHashEntryVal(he
));
14364 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14370 int nonzero_count
= 0;
14372 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14376 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14378 /* Note that this uses internal knowledge of the hash table */
14379 snprintf(buffer
, sizeof(buffer
), "%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14380 Jim_Obj
*output
= Jim_NewStringObj(interp
, buffer
, -1);
14382 int bucket_counts
[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14383 for (i
= 0; i
< ht
->size
; i
++) {
14384 Jim_HashEntry
*he
= ht
->table
[i
];
14391 bucket_counts
[10]++;
14394 bucket_counts
[entries
]++;
14401 for (i
= 0; i
< 10; i
++) {
14402 snprintf(buffer
, sizeof(buffer
), "number of buckets with %d entries: %d\n", i
, bucket_counts
[i
]);
14403 Jim_AppendString(interp
, output
, buffer
, -1);
14405 snprintf(buffer
, sizeof(buffer
), "number of buckets with 10 or more entries: %d\n", bucket_counts
[10]);
14406 Jim_AppendString(interp
, output
, buffer
, -1);
14407 snprintf(buffer
, sizeof(buffer
), "average search distance for entry: %.1f", nonzero_count
? (double)sum
/ nonzero_count
: 0.0);
14408 Jim_AppendString(interp
, output
, buffer
, -1);
14409 Jim_SetResult(interp
, output
);
14413 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14415 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14417 Jim_AppendString(interp
, prefixObj
, " ", 1);
14418 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14420 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14424 * Implements the [dict with] command
14426 static int JimDictWith(Jim_Interp
*interp
, Jim_Obj
*dictVarName
, Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*scriptObj
)
14431 Jim_Obj
**dictValues
;
14435 /* Open up the appropriate level of the dictionary */
14436 dictObj
= Jim_GetVariable(interp
, dictVarName
, JIM_ERRMSG
);
14437 if (dictObj
== NULL
|| Jim_DictKeysVector(interp
, dictObj
, keyv
, keyc
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
14440 /* Set the local variables */
14441 if (Jim_DictPairs(interp
, objPtr
, &dictValues
, &len
) == JIM_ERR
) {
14444 for (i
= 0; i
< len
; i
+= 2) {
14445 if (Jim_SetVariable(interp
, dictValues
[i
], dictValues
[i
+ 1]) == JIM_ERR
) {
14446 Jim_Free(dictValues
);
14451 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14452 if (Jim_Length(scriptObj
)) {
14453 ret
= Jim_EvalObj(interp
, scriptObj
);
14455 /* Now if the dictionary still exists, update it based on the local variables */
14456 if (ret
== JIM_OK
&& Jim_GetVariable(interp
, dictVarName
, 0) != NULL
) {
14457 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14458 Jim_Obj
**newkeyv
= Jim_Alloc(sizeof(*newkeyv
) * (keyc
+ 1));
14459 for (i
= 0; i
< keyc
; i
++) {
14460 newkeyv
[i
] = keyv
[i
];
14463 for (i
= 0; i
< len
; i
+= 2) {
14464 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14465 objPtr
= Jim_GetVariable(interp
, dictValues
[i
], 0);
14466 newkeyv
[keyc
] = dictValues
[i
];
14467 Jim_SetDictKeysVector(interp
, dictVarName
, newkeyv
, keyc
+ 1, objPtr
, 0);
14473 Jim_Free(dictValues
);
14479 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14483 static const char * const options
[] = {
14484 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14485 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14486 "replace", "update", NULL
14490 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14491 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14492 OPT_REPLACE
, OPT_UPDATE
,
14496 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14500 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14501 return Jim_CheckShowCommands(interp
, argv
[1], options
);
14507 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14510 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14511 JIM_ERRMSG
) != JIM_OK
) {
14514 Jim_SetResult(interp
, objPtr
);
14519 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14522 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14526 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14530 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14534 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14540 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14543 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14549 if (argc
!= 3 && argc
!= 4) {
14550 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14553 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14557 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14560 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14563 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14570 objPtr
= Jim_DictMerge(interp
, argc
- 2, argv
+ 2);
14571 if (objPtr
== NULL
) {
14574 Jim_SetResult(interp
, objPtr
);
14578 if (argc
< 6 || argc
% 2) {
14579 /* Better error message */
14586 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14589 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14590 Jim_SetResult(interp
, objPtr
);
14595 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14598 return Jim_DictInfo(interp
, argv
[2]);
14602 Jim_WrongNumArgs(interp
, 2, argv
, "dictVar ?key ...? script");
14605 return JimDictWith(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1]);
14607 /* Handle command as an ensemble */
14608 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14612 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14614 static const char * const options
[] = {
14615 "-nobackslashes", "-nocommands", "-novariables", NULL
14618 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14620 int flags
= JIM_SUBST_FLAG
;
14624 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14627 for (i
= 1; i
< (argc
- 1); i
++) {
14630 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14631 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14635 case OPT_NOBACKSLASHES
:
14636 flags
|= JIM_SUBST_NOESC
;
14638 case OPT_NOCOMMANDS
:
14639 flags
|= JIM_SUBST_NOCMD
;
14641 case OPT_NOVARIABLES
:
14642 flags
|= JIM_SUBST_NOVAR
;
14646 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14649 Jim_SetResult(interp
, objPtr
);
14654 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14660 static const char * const commands
[] = {
14661 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14662 "vars", "version", "patchlevel", "complete", "args", "hostname",
14663 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14664 "references", "alias", NULL
14667 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14668 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14669 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14670 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14673 #ifdef jim_ext_namespace
14676 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14677 /* This is for internal use only */
14685 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14688 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14689 return Jim_CheckShowCommands(interp
, argv
[1], commands
);
14692 /* Test for the most common commands first, just in case it makes a difference */
14696 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14699 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14706 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14709 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14712 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14713 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14716 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14720 case INFO_CHANNELS
:
14721 mode
++; /* JIM_CMDLIST_CHANNELS */
14722 #ifndef jim_ext_aio
14723 Jim_SetResultString(interp
, "aio not enabled", -1);
14728 mode
++; /* JIM_CMDLIST_PROCS */
14730 case INFO_COMMANDS
:
14731 /* mode 0 => JIM_CMDLIST_COMMANDS */
14732 if (argc
!= 2 && argc
!= 3) {
14733 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14736 #ifdef jim_ext_namespace
14738 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14739 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14743 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14747 mode
++; /* JIM_VARLIST_VARS */
14750 mode
++; /* JIM_VARLIST_LOCALS */
14753 /* mode 0 => JIM_VARLIST_GLOBALS */
14754 if (argc
!= 2 && argc
!= 3) {
14755 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14758 #ifdef jim_ext_namespace
14760 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14761 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14765 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14770 Jim_WrongNumArgs(interp
, 2, argv
, "");
14773 Jim_SetResult(interp
, JimGetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14778 Jim_Obj
*resObjPtr
;
14779 Jim_Obj
*fileNameObj
;
14781 if (argc
!= 3 && argc
!= 5) {
14782 Jim_WrongNumArgs(interp
, 2, argv
, "source ?filename line?");
14786 if (Jim_GetWide(interp
, argv
[4], &line
) != JIM_OK
) {
14789 resObjPtr
= Jim_NewStringObj(interp
, Jim_String(argv
[2]), Jim_Length(argv
[2]));
14790 JimSetSourceInfo(interp
, resObjPtr
, argv
[3], line
);
14793 if (argv
[2]->typePtr
== &sourceObjType
) {
14794 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14795 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14797 else if (argv
[2]->typePtr
== &scriptObjType
) {
14798 ScriptObj
*script
= JimGetScript(interp
, argv
[2]);
14799 fileNameObj
= script
->fileNameObj
;
14800 line
= script
->firstline
;
14803 fileNameObj
= interp
->emptyObj
;
14806 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14807 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14808 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14810 Jim_SetResult(interp
, resObjPtr
);
14814 case INFO_STACKTRACE
:
14815 Jim_SetResult(interp
, interp
->stackTrace
);
14822 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14826 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14829 Jim_SetResult(interp
, objPtr
);
14833 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14844 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14847 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14850 if (!cmdPtr
->isproc
) {
14851 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14856 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14859 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14862 if (cmdPtr
->u
.proc
.staticVars
) {
14863 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14864 NULL
, JimVariablesMatch
, JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
));
14872 case INFO_PATCHLEVEL
:{
14873 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14875 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14876 Jim_SetResultString(interp
, buf
, -1);
14880 case INFO_COMPLETE
:
14881 if (argc
!= 3 && argc
!= 4) {
14882 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14888 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(interp
, argv
[2], &missing
));
14889 if (missing
!= ' ' && argc
== 4) {
14890 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14895 case INFO_HOSTNAME
:
14896 /* Redirect to os.gethostname if it exists */
14897 return Jim_Eval(interp
, "os.gethostname");
14899 case INFO_NAMEOFEXECUTABLE
:
14900 /* Redirect to Tcl proc */
14901 return Jim_Eval(interp
, "{info nameofexecutable}");
14903 case INFO_RETURNCODES
:
14906 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14908 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14909 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14910 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14911 jimReturnCodes
[i
], -1));
14914 Jim_SetResult(interp
, listObjPtr
);
14916 else if (argc
== 3) {
14920 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14923 name
= Jim_ReturnCode(code
);
14924 if (*name
== '?') {
14925 Jim_SetResultInt(interp
, code
);
14928 Jim_SetResultString(interp
, name
, -1);
14932 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14936 case INFO_REFERENCES
:
14937 #ifdef JIM_REFERENCES
14938 return JimInfoReferences(interp
, argc
, argv
);
14940 Jim_SetResultString(interp
, "not supported", -1);
14948 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14953 static const char * const options
[] = {
14954 "-command", "-proc", "-alias", "-var", NULL
14958 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14966 else if (argc
== 3) {
14967 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14973 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14977 if (option
== OPT_VAR
) {
14978 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14981 /* Now different kinds of commands */
14982 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14991 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14995 result
= cmd
->isproc
;
15000 Jim_SetResultBool(interp
, result
);
15005 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15007 const char *str
, *splitChars
, *noMatchStart
;
15008 int splitLen
, strLen
;
15009 Jim_Obj
*resObjPtr
;
15013 if (argc
!= 2 && argc
!= 3) {
15014 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
15018 str
= Jim_GetString(argv
[1], &len
);
15022 strLen
= Jim_Utf8Length(interp
, argv
[1]);
15026 splitChars
= " \n\t\r";
15030 splitChars
= Jim_String(argv
[2]);
15031 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
15034 noMatchStart
= str
;
15035 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15041 const char *sc
= splitChars
;
15042 int scLen
= splitLen
;
15043 int sl
= utf8_tounicode(str
, &c
);
15046 sc
+= utf8_tounicode(sc
, &pc
);
15048 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
15049 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
15050 noMatchStart
= str
+ sl
;
15056 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
15057 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
15060 /* This handles the special case of splitchars eq {}
15061 * Optimise by sharing common (ASCII) characters
15063 Jim_Obj
**commonObj
= NULL
;
15064 #define NUM_COMMON (128 - 9)
15066 int n
= utf8_tounicode(str
, &c
);
15067 #ifdef JIM_OPTIMIZATION
15068 if (c
>= 9 && c
< 128) {
15069 /* Common ASCII char. Note that 9 is the tab character */
15072 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
15073 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
15075 if (!commonObj
[c
]) {
15076 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
15078 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
15083 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
15086 Jim_Free(commonObj
);
15089 Jim_SetResult(interp
, resObjPtr
);
15094 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15096 const char *joinStr
;
15099 if (argc
!= 2 && argc
!= 3) {
15100 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
15109 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
15111 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
15116 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15121 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
15124 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
15125 if (objPtr
== NULL
)
15127 Jim_SetResult(interp
, objPtr
);
15132 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15134 Jim_Obj
*listPtr
, **outVec
;
15138 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
15141 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
15142 SetScanFmtFromAny(interp
, argv
[2]);
15143 if (FormatGetError(argv
[2]) != 0) {
15144 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
15148 int maxPos
= FormatGetMaxPos(argv
[2]);
15149 int count
= FormatGetCnvCount(argv
[2]);
15151 if (maxPos
> argc
- 3) {
15152 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
15155 else if (count
> argc
- 3) {
15156 Jim_SetResultString(interp
, "different numbers of variable names and "
15157 "field specifiers", -1);
15160 else if (count
< argc
- 3) {
15161 Jim_SetResultString(interp
, "variable is not assigned by any "
15162 "conversion specifiers", -1);
15166 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
15173 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
15174 int len
= Jim_ListLength(interp
, listPtr
);
15177 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
15178 for (i
= 0; i
< outc
; ++i
) {
15179 if (Jim_Length(outVec
[i
]) > 0) {
15181 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
15187 Jim_FreeNewObj(interp
, listPtr
);
15192 if (rc
== JIM_OK
) {
15193 Jim_SetResultInt(interp
, count
);
15198 if (listPtr
== (Jim_Obj
*)EOF
) {
15199 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
15202 Jim_SetResult(interp
, listPtr
);
15208 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15210 if (argc
!= 2 && argc
!= 3) {
15211 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
15214 Jim_SetResult(interp
, argv
[1]);
15216 JimSetStackTrace(interp
, argv
[2]);
15219 interp
->addStackTrace
++;
15224 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15229 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
15232 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
15234 Jim_SetResult(interp
, objPtr
);
15239 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15244 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
15245 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
15249 if (count
== 0 || argc
== 2) {
15256 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
15258 ListInsertElements(objPtr
, -1, argc
, argv
);
15261 Jim_SetResult(interp
, objPtr
);
15265 char **Jim_GetEnviron(void)
15267 #if defined(HAVE__NSGETENVIRON)
15268 return *_NSGetEnviron();
15270 #if !defined(NO_ENVIRON_EXTERN)
15271 extern char **environ
;
15278 void Jim_SetEnviron(char **env
)
15280 #if defined(HAVE__NSGETENVIRON)
15281 *_NSGetEnviron() = env
;
15283 #if !defined(NO_ENVIRON_EXTERN)
15284 extern char **environ
;
15292 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15298 char **e
= Jim_GetEnviron();
15301 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15303 for (i
= 0; e
[i
]; i
++) {
15304 const char *equals
= strchr(e
[i
], '=');
15307 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
15309 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15313 Jim_SetResult(interp
, listObjPtr
);
15318 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15321 key
= Jim_String(argv
[1]);
15325 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15328 val
= Jim_String(argv
[2]);
15330 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15335 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15340 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15343 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15344 if (retval
== JIM_RETURN
)
15350 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15352 Jim_Obj
*revObjPtr
, **ele
;
15356 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15359 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15361 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15363 ListAppendElement(revObjPtr
, ele
[len
--]);
15364 Jim_SetResult(interp
, revObjPtr
);
15368 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15376 else if (step
> 0 && start
> end
)
15378 else if (step
< 0 && end
> start
)
15382 len
= -len
; /* abs(len) */
15384 step
= -step
; /* abs(step) */
15385 len
= 1 + ((len
- 1) / step
);
15386 /* We can truncate safely to INT_MAX, the range command
15387 * will always return an error for a such long range
15388 * because Tcl lists can't be so long. */
15391 return (int)((len
< 0) ? -1 : len
);
15395 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15397 jim_wide start
= 0, end
, step
= 1;
15401 if (argc
< 2 || argc
> 4) {
15402 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15406 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15410 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15411 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15413 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15416 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15417 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15420 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15421 for (i
= 0; i
< len
; i
++)
15422 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15423 Jim_SetResult(interp
, objPtr
);
15428 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15430 jim_wide min
= 0, max
= 0, len
, maxMul
;
15432 if (argc
< 1 || argc
> 3) {
15433 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15437 max
= JIM_WIDE_MAX
;
15438 } else if (argc
== 2) {
15439 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15441 } else if (argc
== 3) {
15442 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15443 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15448 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15451 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15455 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15456 if (r
< 0 || r
>= maxMul
) continue;
15457 r
= (len
== 0) ? 0 : r
%len
;
15458 Jim_SetResultInt(interp
, min
+r
);
15463 static const struct {
15465 Jim_CmdProc
*cmdProc
;
15466 } Jim_CoreCommandsTable
[] = {
15467 {"alias", Jim_AliasCoreCommand
},
15468 {"set", Jim_SetCoreCommand
},
15469 {"unset", Jim_UnsetCoreCommand
},
15470 {"puts", Jim_PutsCoreCommand
},
15471 {"+", Jim_AddCoreCommand
},
15472 {"*", Jim_MulCoreCommand
},
15473 {"-", Jim_SubCoreCommand
},
15474 {"/", Jim_DivCoreCommand
},
15475 {"incr", Jim_IncrCoreCommand
},
15476 {"while", Jim_WhileCoreCommand
},
15477 {"loop", Jim_LoopCoreCommand
},
15478 {"for", Jim_ForCoreCommand
},
15479 {"foreach", Jim_ForeachCoreCommand
},
15480 {"lmap", Jim_LmapCoreCommand
},
15481 {"lassign", Jim_LassignCoreCommand
},
15482 {"if", Jim_IfCoreCommand
},
15483 {"switch", Jim_SwitchCoreCommand
},
15484 {"list", Jim_ListCoreCommand
},
15485 {"lindex", Jim_LindexCoreCommand
},
15486 {"lset", Jim_LsetCoreCommand
},
15487 {"lsearch", Jim_LsearchCoreCommand
},
15488 {"llength", Jim_LlengthCoreCommand
},
15489 {"lappend", Jim_LappendCoreCommand
},
15490 {"linsert", Jim_LinsertCoreCommand
},
15491 {"lreplace", Jim_LreplaceCoreCommand
},
15492 {"lsort", Jim_LsortCoreCommand
},
15493 {"append", Jim_AppendCoreCommand
},
15494 {"debug", Jim_DebugCoreCommand
},
15495 {"eval", Jim_EvalCoreCommand
},
15496 {"uplevel", Jim_UplevelCoreCommand
},
15497 {"expr", Jim_ExprCoreCommand
},
15498 {"break", Jim_BreakCoreCommand
},
15499 {"continue", Jim_ContinueCoreCommand
},
15500 {"proc", Jim_ProcCoreCommand
},
15501 {"concat", Jim_ConcatCoreCommand
},
15502 {"return", Jim_ReturnCoreCommand
},
15503 {"upvar", Jim_UpvarCoreCommand
},
15504 {"global", Jim_GlobalCoreCommand
},
15505 {"string", Jim_StringCoreCommand
},
15506 {"time", Jim_TimeCoreCommand
},
15507 {"exit", Jim_ExitCoreCommand
},
15508 {"catch", Jim_CatchCoreCommand
},
15509 #ifdef JIM_REFERENCES
15510 {"ref", Jim_RefCoreCommand
},
15511 {"getref", Jim_GetrefCoreCommand
},
15512 {"setref", Jim_SetrefCoreCommand
},
15513 {"finalize", Jim_FinalizeCoreCommand
},
15514 {"collect", Jim_CollectCoreCommand
},
15516 {"rename", Jim_RenameCoreCommand
},
15517 {"dict", Jim_DictCoreCommand
},
15518 {"subst", Jim_SubstCoreCommand
},
15519 {"info", Jim_InfoCoreCommand
},
15520 {"exists", Jim_ExistsCoreCommand
},
15521 {"split", Jim_SplitCoreCommand
},
15522 {"join", Jim_JoinCoreCommand
},
15523 {"format", Jim_FormatCoreCommand
},
15524 {"scan", Jim_ScanCoreCommand
},
15525 {"error", Jim_ErrorCoreCommand
},
15526 {"lrange", Jim_LrangeCoreCommand
},
15527 {"lrepeat", Jim_LrepeatCoreCommand
},
15528 {"env", Jim_EnvCoreCommand
},
15529 {"source", Jim_SourceCoreCommand
},
15530 {"lreverse", Jim_LreverseCoreCommand
},
15531 {"range", Jim_RangeCoreCommand
},
15532 {"rand", Jim_RandCoreCommand
},
15533 {"tailcall", Jim_TailcallCoreCommand
},
15534 {"local", Jim_LocalCoreCommand
},
15535 {"upcall", Jim_UpcallCoreCommand
},
15536 {"apply", Jim_ApplyCoreCommand
},
15540 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15544 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15545 Jim_CreateCommand(interp
,
15546 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15551 /* -----------------------------------------------------------------------------
15552 * Interactive prompt
15553 * ---------------------------------------------------------------------------*/
15554 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15558 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15559 argv
[1] = interp
->result
;
15561 Jim_EvalObjVector(interp
, 2, argv
);
15565 * Given a null terminated array of strings, returns an allocated, sorted
15566 * copy of the array.
15568 static char **JimSortStringTable(const char *const *tablePtr
)
15571 char **tablePtrSorted
;
15573 /* Find the size of the table */
15574 for (count
= 0; tablePtr
[count
]; count
++) {
15577 /* Allocate one extra for the terminating NULL pointer */
15578 tablePtrSorted
= Jim_Alloc(sizeof(char *) * (count
+ 1));
15579 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15580 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15581 tablePtrSorted
[count
] = NULL
;
15583 return tablePtrSorted
;
15586 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15587 const char *prefix
, const char *const *tablePtr
, const char *name
)
15589 char **tablePtrSorted
;
15592 if (name
== NULL
) {
15596 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15597 tablePtrSorted
= JimSortStringTable(tablePtr
);
15598 for (i
= 0; tablePtrSorted
[i
]; i
++) {
15599 if (tablePtrSorted
[i
+ 1] == NULL
&& i
> 0) {
15600 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15602 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15603 if (tablePtrSorted
[i
+ 1]) {
15604 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15607 Jim_Free(tablePtrSorted
);
15612 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15613 * and returns JIM_OK.
15615 * Otherwise returns JIM_ERR.
15617 int Jim_CheckShowCommands(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *const *tablePtr
)
15619 if (Jim_CompareStringImmediate(interp
, objPtr
, "-commands")) {
15621 char **tablePtrSorted
= JimSortStringTable(tablePtr
);
15622 Jim_SetResult(interp
, Jim_NewListObj(interp
, NULL
, 0));
15623 for (i
= 0; tablePtrSorted
[i
]; i
++) {
15624 Jim_ListAppendElement(interp
, Jim_GetResult(interp
), Jim_NewStringObj(interp
, tablePtrSorted
[i
], -1));
15626 Jim_Free(tablePtrSorted
);
15632 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15633 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15635 const char *bad
= "bad ";
15636 const char *const *entryPtr
= NULL
;
15640 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15644 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15645 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15646 /* Found an exact match */
15650 if (flags
& JIM_ENUM_ABBREV
) {
15651 /* Accept an unambiguous abbreviation.
15652 * Note that '-' doesnt' consitute a valid abbreviation
15654 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15655 if (*arg
== '-' && arglen
== 1) {
15659 bad
= "ambiguous ";
15667 /* If we had an unambiguous partial match */
15674 if (flags
& JIM_ERRMSG
) {
15675 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15680 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15684 for (i
= 0; i
< (int)len
; i
++) {
15685 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15692 int Jim_IsDict(Jim_Obj
*objPtr
)
15694 return objPtr
->typePtr
== &dictObjType
;
15697 int Jim_IsList(Jim_Obj
*objPtr
)
15699 return objPtr
->typePtr
== &listObjType
;
15703 * Very simple printf-like formatting, designed for error messages.
15705 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15706 * The resulting string is created and set as the result.
15708 * Each '%s' should correspond to a regular string parameter.
15709 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15710 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15712 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15714 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15716 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15718 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15720 /* Initial space needed */
15721 int len
= strlen(format
);
15724 const char *params
[5];
15726 Jim_Obj
*objparam
[5];
15731 va_start(args
, format
);
15733 for (i
= 0; i
< len
&& n
< 5; i
++) {
15736 if (strncmp(format
+ i
, "%s", 2) == 0) {
15737 params
[n
] = va_arg(args
, char *);
15739 l
= strlen(params
[n
]);
15741 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15742 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15744 params
[n
] = Jim_GetString(objPtr
, &l
);
15745 objparam
[nobjparam
++] = objPtr
;
15746 Jim_IncrRefCount(objPtr
);
15749 if (format
[i
] == '%') {
15759 buf
= Jim_Alloc(len
+ 1);
15760 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15764 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15766 for (i
= 0; i
< nobjparam
; i
++) {
15767 Jim_DecrRefCount(interp
, objparam
[i
]);
15772 #ifndef jim_ext_package
15773 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15778 #ifndef jim_ext_aio
15779 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15781 Jim_SetResultString(interp
, "aio not enabled", -1);
15788 * Local Variables: ***
15789 * c-basic-offset: 4 ***