1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
58 #include "jimautoconf.h"
61 #ifdef HAVE_SYS_TIME_H
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
71 /* For INFINITY, even if math functions are not enabled */
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
79 #define TCL_LIBRARY "."
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type
);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition
, const char *fmt
, ...);
113 #define JimPanic(X) JimPanicDump X
118 /* -----------------------------------------------------------------------------
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep
[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
);
130 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int listindex
, Jim_Obj
*newObjPtr
,
132 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
);
133 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
134 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
135 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
);
136 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
137 const char *prefix
, const char *const *tablePtr
, const char *name
);
138 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
);
139 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
);
140 static int JimSign(jim_wide w
);
141 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
);
142 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
);
143 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
);
146 /* Fast access to the int (wide) value of an object which is known to be of int type */
147 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
149 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
151 static int utf8_tounicode_case(const char *s
, int *uc
, int upper
)
153 int l
= utf8_tounicode(s
, uc
);
155 *uc
= utf8_upper(*uc
);
160 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
161 #define JIM_CHARSET_SCAN 2
162 #define JIM_CHARSET_GLOB 0
165 * pattern points to a string like "[^a-z\ub5]"
167 * The pattern may contain trailing chars, which are ignored.
169 * The pattern is matched against unicode char 'c'.
171 * If (flags & JIM_NOCASE), case is ignored when matching.
172 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
173 * of the charset, per scan, rather than glob/string match.
175 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
176 * or the null character if the ']' is missing.
178 * Returns NULL on no match.
180 static const char *JimCharsetMatch(const char *pattern
, int c
, int flags
)
187 if (flags
& JIM_NOCASE
) {
192 if (flags
& JIM_CHARSET_SCAN
) {
193 if (*pattern
== '^') {
198 /* Special case. If the first char is ']', it is part of the set */
199 if (*pattern
== ']') {
204 while (*pattern
&& *pattern
!= ']') {
206 if (pattern
[0] == '\\') {
208 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
211 /* Is this a range? a-z */
215 pattern
+= utf8_tounicode_case(pattern
, &start
, nocase
);
216 if (pattern
[0] == '-' && pattern
[1]) {
218 pattern
+= utf8_tounicode(pattern
, &pchar
);
219 pattern
+= utf8_tounicode_case(pattern
, &end
, nocase
);
221 /* Handle reversed range too */
222 if ((c
>= start
&& c
<= end
) || (c
>= end
&& c
<= start
)) {
238 return match
? pattern
: NULL
;
241 /* Glob-style pattern matching. */
243 /* Note: string *must* be valid UTF-8 sequences
245 static int JimGlobMatch(const char *pattern
, const char *string
, int nocase
)
250 switch (pattern
[0]) {
252 while (pattern
[1] == '*') {
257 return 1; /* match */
260 /* Recursive call - Does the remaining pattern match anywhere? */
261 if (JimGlobMatch(pattern
, string
, nocase
))
262 return 1; /* match */
263 string
+= utf8_tounicode(string
, &c
);
265 return 0; /* no match */
268 string
+= utf8_tounicode(string
, &c
);
272 string
+= utf8_tounicode(string
, &c
);
273 pattern
= JimCharsetMatch(pattern
+ 1, c
, nocase
? JIM_NOCASE
: 0);
278 /* Ran out of pattern (no ']') */
289 string
+= utf8_tounicode_case(string
, &c
, nocase
);
290 utf8_tounicode_case(pattern
, &pchar
, nocase
);
296 pattern
+= utf8_tounicode_case(pattern
, &pchar
, nocase
);
298 while (*pattern
== '*') {
304 if (!*pattern
&& !*string
) {
311 * string comparison. Works on binary data.
315 * Note that the lengths are byte lengths, not char lengths.
317 static int JimStringCompare(const char *s1
, int l1
, const char *s2
, int l2
)
320 return memcmp(s1
, s2
, l1
) <= 0 ? -1 : 1;
323 return memcmp(s1
, s2
, l2
) >= 0 ? 1 : -1;
326 return JimSign(memcmp(s1
, s2
, l1
));
331 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
332 * (or end of string if 'maxchars' is -1).
334 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
336 * Note: does not support embedded nulls.
338 static int JimStringCompareLen(const char *s1
, const char *s2
, int maxchars
, int nocase
)
340 while (*s1
&& *s2
&& maxchars
) {
342 s1
+= utf8_tounicode_case(s1
, &c1
, nocase
);
343 s2
+= utf8_tounicode_case(s2
, &c2
, nocase
);
345 return JimSign(c1
- c2
);
352 /* One string or both terminated */
362 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
363 * The index of the first occurrence of s1 in s2 is returned.
364 * If s1 is not found inside s2, -1 is returned. */
365 static int JimStringFirst(const char *s1
, int l1
, const char *s2
, int l2
, int idx
)
370 if (!l1
|| !l2
|| l1
> l2
) {
375 s2
+= utf8_index(s2
, idx
);
377 l1bytelen
= utf8_index(s1
, l1
);
379 for (i
= idx
; i
<= l2
- l1
; i
++) {
381 if (memcmp(s2
, s1
, l1bytelen
) == 0) {
384 s2
+= utf8_tounicode(s2
, &c
);
390 * Note: Lengths and return value are in bytes, not chars.
392 static int JimStringLast(const char *s1
, int l1
, const char *s2
, int l2
)
396 if (!l1
|| !l2
|| l1
> l2
)
399 /* Now search for the needle */
400 for (p
= s2
+ l2
- 1; p
!= s2
- 1; p
--) {
401 if (*p
== *s1
&& memcmp(s1
, p
, l1
) == 0) {
410 * Note: Lengths and return value are in chars.
412 static int JimStringLastUtf8(const char *s1
, int l1
, const char *s2
, int l2
)
414 int n
= JimStringLast(s1
, utf8_index(s1
, l1
), s2
, utf8_index(s2
, l2
));
416 n
= utf8_strlen(s2
, n
);
423 * After an strtol()/strtod()-like conversion,
424 * check whether something was converted and that
425 * the only thing left is white space.
427 * Returns JIM_OK or JIM_ERR.
429 static int JimCheckConversion(const char *str
, const char *endptr
)
431 if (str
[0] == '\0' || str
== endptr
) {
435 if (endptr
[0] != '\0') {
437 if (!isspace(UCHAR(*endptr
))) {
446 /* Parses the front of a number to determine it's sign and base
447 * Returns the index to start parsing according to the given base
449 static int JimNumberBase(const char *str
, int *base
, int *sign
)
455 while (isspace(UCHAR(str
[i
]))) {
475 /* We have 0<x>, so see if we can convert it */
476 switch (str
[i
+ 1]) {
477 case 'x': case 'X': *base
= 16; break;
478 case 'o': case 'O': *base
= 8; break;
479 case 'b': case 'B': *base
= 2; break;
483 /* Ensure that (e.g.) 0x-5 fails to parse */
484 if (str
[i
] != '-' && str
[i
] != '+' && !isspace(UCHAR(str
[i
]))) {
485 /* Parse according to this base */
488 /* Parse as base 10 */
493 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
494 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
496 static long jim_strtol(const char *str
, char **endptr
)
500 int i
= JimNumberBase(str
, &base
, &sign
);
503 long value
= strtol(str
+ i
, endptr
, base
);
504 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
509 /* Can just do a regular base-10 conversion */
510 return strtol(str
, endptr
, 10);
514 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
515 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
517 static jim_wide
jim_strtoull(const char *str
, char **endptr
)
519 #ifdef HAVE_LONG_LONG
522 int i
= JimNumberBase(str
, &base
, &sign
);
525 jim_wide value
= strtoull(str
+ i
, endptr
, base
);
526 if (endptr
== NULL
|| *endptr
!= str
+ i
) {
531 /* Can just do a regular base-10 conversion */
532 return strtoull(str
, endptr
, 10);
534 return (unsigned long)jim_strtol(str
, endptr
);
538 int Jim_StringToWide(const char *str
, jim_wide
* widePtr
, int base
)
543 *widePtr
= strtoull(str
, &endptr
, base
);
546 *widePtr
= jim_strtoull(str
, &endptr
);
549 return JimCheckConversion(str
, endptr
);
552 int Jim_StringToDouble(const char *str
, double *doublePtr
)
556 /* Callers can check for underflow via ERANGE */
559 *doublePtr
= strtod(str
, &endptr
);
561 return JimCheckConversion(str
, endptr
);
564 static jim_wide
JimPowWide(jim_wide b
, jim_wide e
)
568 if ((b
== 0 && e
!= 0) || (e
< 0))
570 for (i
= 0; i
< e
; i
++) {
576 /* -----------------------------------------------------------------------------
578 * ---------------------------------------------------------------------------*/
579 #ifdef JIM_DEBUG_PANIC
580 static void JimPanicDump(int condition
, const char *fmt
, ...)
590 fprintf(stderr
, "\nJIM INTERPRETER PANIC: ");
591 vfprintf(stderr
, fmt
, ap
);
592 fprintf(stderr
, "\n\n");
595 #ifdef HAVE_BACKTRACE
601 size
= backtrace(array
, 40);
602 strings
= backtrace_symbols(array
, size
);
603 for (i
= 0; i
< size
; i
++)
604 fprintf(stderr
, "[backtrace] %s\n", strings
[i
]);
605 fprintf(stderr
, "[backtrace] Include the above lines and the output\n");
606 fprintf(stderr
, "[backtrace] of 'nm <executable>' in the bug report.\n");
614 /* -----------------------------------------------------------------------------
616 * ---------------------------------------------------------------------------*/
618 void *Jim_Alloc(int size
)
620 return size
? malloc(size
) : NULL
;
623 void Jim_Free(void *ptr
)
628 void *Jim_Realloc(void *ptr
, int size
)
630 return realloc(ptr
, size
);
633 char *Jim_StrDup(const char *s
)
638 char *Jim_StrDupLen(const char *s
, int l
)
640 char *copy
= Jim_Alloc(l
+ 1);
642 memcpy(copy
, s
, l
+ 1);
643 copy
[l
] = 0; /* Just to be sure, original could be substring */
647 /* -----------------------------------------------------------------------------
648 * Time related functions
649 * ---------------------------------------------------------------------------*/
651 /* Returns current time in microseconds */
652 static jim_wide
JimClock(void)
656 gettimeofday(&tv
, NULL
);
657 return (jim_wide
) tv
.tv_sec
* 1000000 + tv
.tv_usec
;
660 /* -----------------------------------------------------------------------------
662 * ---------------------------------------------------------------------------*/
664 /* -------------------------- private prototypes ---------------------------- */
665 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
);
666 static unsigned int JimHashTableNextPower(unsigned int size
);
667 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
);
669 /* -------------------------- hash functions -------------------------------- */
671 /* Thomas Wang's 32 bit Mix Function */
672 unsigned int Jim_IntHashFunction(unsigned int key
)
683 /* Generic hash function (we are using to multiply by 9 and add the byte
685 unsigned int Jim_GenHashFunction(const unsigned char *buf
, int len
)
690 h
+= (h
<< 3) + *buf
++;
694 /* ----------------------------- API implementation ------------------------- */
696 /* reset a hashtable already initialized */
697 static void JimResetHashTable(Jim_HashTable
*ht
)
704 #ifdef JIM_RANDOMISE_HASH
705 /* This is initialised to a random value to avoid a hash collision attack.
706 * See: n.runs-SA-2011.004
708 ht
->uniq
= (rand() ^ time(NULL
) ^ clock());
714 static void JimInitHashTableIterator(Jim_HashTable
*ht
, Jim_HashTableIterator
*iter
)
719 iter
->nextEntry
= NULL
;
722 /* Initialize the hash table */
723 int Jim_InitHashTable(Jim_HashTable
*ht
, const Jim_HashTableType
*type
, void *privDataPtr
)
725 JimResetHashTable(ht
);
727 ht
->privdata
= privDataPtr
;
731 /* Resize the table to the minimal size that contains all the elements,
732 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
733 void Jim_ResizeHashTable(Jim_HashTable
*ht
)
735 int minimal
= ht
->used
;
737 if (minimal
< JIM_HT_INITIAL_SIZE
)
738 minimal
= JIM_HT_INITIAL_SIZE
;
739 Jim_ExpandHashTable(ht
, minimal
);
742 /* Expand or create the hashtable */
743 void Jim_ExpandHashTable(Jim_HashTable
*ht
, unsigned int size
)
745 Jim_HashTable n
; /* the new hashtable */
746 unsigned int realsize
= JimHashTableNextPower(size
), i
;
748 /* the size is invalid if it is smaller than the number of
749 * elements already inside the hashtable */
750 if (size
<= ht
->used
)
753 Jim_InitHashTable(&n
, ht
->type
, ht
->privdata
);
755 n
.sizemask
= realsize
- 1;
756 n
.table
= Jim_Alloc(realsize
* sizeof(Jim_HashEntry
*));
757 /* Keep the same 'uniq' as the original */
760 /* Initialize all the pointers to NULL */
761 memset(n
.table
, 0, realsize
* sizeof(Jim_HashEntry
*));
763 /* Copy all the elements from the old to the new table:
764 * note that if the old hash table is empty ht->used is zero,
765 * so Jim_ExpandHashTable just creates an empty hash table. */
767 for (i
= 0; ht
->used
> 0; i
++) {
768 Jim_HashEntry
*he
, *nextHe
;
770 if (ht
->table
[i
] == NULL
)
773 /* For each hash entry on this slot... */
779 /* Get the new element index */
780 h
= Jim_HashKey(ht
, he
->key
) & n
.sizemask
;
781 he
->next
= n
.table
[h
];
784 /* Pass to the next element */
788 assert(ht
->used
== 0);
791 /* Remap the new hashtable in the old */
795 /* Add an element to the target hash table */
796 int Jim_AddHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
798 Jim_HashEntry
*entry
;
800 /* Get the index of the new element, or -1 if
801 * the element already exists. */
802 entry
= JimInsertHashEntry(ht
, key
, 0);
806 /* Set the hash entry fields. */
807 Jim_SetHashKey(ht
, entry
, key
);
808 Jim_SetHashVal(ht
, entry
, val
);
812 /* Add an element, discarding the old if the key already exists */
813 int Jim_ReplaceHashEntry(Jim_HashTable
*ht
, const void *key
, void *val
)
816 Jim_HashEntry
*entry
;
818 /* Get the index of the new element, or -1 if
819 * the element already exists. */
820 entry
= JimInsertHashEntry(ht
, key
, 1);
822 /* It already exists, so only replace the value.
823 * Note if both a destructor and a duplicate function exist,
824 * need to dup before destroy. perhaps they are the same
825 * reference counted object
827 if (ht
->type
->valDestructor
&& ht
->type
->valDup
) {
828 void *newval
= ht
->type
->valDup(ht
->privdata
, val
);
829 ht
->type
->valDestructor(ht
->privdata
, entry
->u
.val
);
830 entry
->u
.val
= newval
;
833 Jim_FreeEntryVal(ht
, entry
);
834 Jim_SetHashVal(ht
, entry
, val
);
839 /* Doesn't exist, so set the key */
840 Jim_SetHashKey(ht
, entry
, key
);
841 Jim_SetHashVal(ht
, entry
, val
);
848 /* Search and remove an element */
849 int Jim_DeleteHashEntry(Jim_HashTable
*ht
, const void *key
)
852 Jim_HashEntry
*he
, *prevHe
;
856 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
861 if (Jim_CompareHashKeys(ht
, key
, he
->key
)) {
862 /* Unlink the element from the list */
864 prevHe
->next
= he
->next
;
866 ht
->table
[h
] = he
->next
;
867 Jim_FreeEntryKey(ht
, he
);
868 Jim_FreeEntryVal(ht
, he
);
876 return JIM_ERR
; /* not found */
879 /* Destroy an entire hash table and leave it ready for reuse */
880 int Jim_FreeHashTable(Jim_HashTable
*ht
)
884 /* Free all the elements */
885 for (i
= 0; ht
->used
> 0; i
++) {
886 Jim_HashEntry
*he
, *nextHe
;
888 if ((he
= ht
->table
[i
]) == NULL
)
892 Jim_FreeEntryKey(ht
, he
);
893 Jim_FreeEntryVal(ht
, he
);
899 /* Free the table and the allocated cache structure */
901 /* Re-initialize the table */
902 JimResetHashTable(ht
);
903 return JIM_OK
; /* never fails */
906 Jim_HashEntry
*Jim_FindHashEntry(Jim_HashTable
*ht
, const void *key
)
913 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
916 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
923 Jim_HashTableIterator
*Jim_GetHashTableIterator(Jim_HashTable
*ht
)
925 Jim_HashTableIterator
*iter
= Jim_Alloc(sizeof(*iter
));
926 JimInitHashTableIterator(ht
, iter
);
930 Jim_HashEntry
*Jim_NextHashEntry(Jim_HashTableIterator
*iter
)
933 if (iter
->entry
== NULL
) {
935 if (iter
->index
>= (signed)iter
->ht
->size
)
937 iter
->entry
= iter
->ht
->table
[iter
->index
];
940 iter
->entry
= iter
->nextEntry
;
943 /* We need to save the 'next' here, the iterator user
944 * may delete the entry we are returning. */
945 iter
->nextEntry
= iter
->entry
->next
;
952 /* ------------------------- private functions ------------------------------ */
954 /* Expand the hash table if needed */
955 static void JimExpandHashTableIfNeeded(Jim_HashTable
*ht
)
957 /* If the hash table is empty expand it to the intial size,
958 * if the table is "full" dobule its size. */
960 Jim_ExpandHashTable(ht
, JIM_HT_INITIAL_SIZE
);
961 if (ht
->size
== ht
->used
)
962 Jim_ExpandHashTable(ht
, ht
->size
* 2);
965 /* Our hash table capability is a power of two */
966 static unsigned int JimHashTableNextPower(unsigned int size
)
968 unsigned int i
= JIM_HT_INITIAL_SIZE
;
970 if (size
>= 2147483648U)
979 /* Returns the index of a free slot that can be populated with
980 * a hash entry for the given 'key'.
981 * If the key already exists, -1 is returned. */
982 static Jim_HashEntry
*JimInsertHashEntry(Jim_HashTable
*ht
, const void *key
, int replace
)
987 /* Expand the hashtable if needed */
988 JimExpandHashTableIfNeeded(ht
);
990 /* Compute the key hash value */
991 h
= Jim_HashKey(ht
, key
) & ht
->sizemask
;
992 /* Search if this slot does not already contain the given key */
995 if (Jim_CompareHashKeys(ht
, key
, he
->key
))
996 return replace
? he
: NULL
;
1000 /* Allocates the memory and stores key */
1001 he
= Jim_Alloc(sizeof(*he
));
1002 he
->next
= ht
->table
[h
];
1010 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1012 static unsigned int JimStringCopyHTHashFunction(const void *key
)
1014 return Jim_GenHashFunction(key
, strlen(key
));
1017 static void *JimStringCopyHTDup(void *privdata
, const void *key
)
1019 return Jim_StrDup(key
);
1022 static int JimStringCopyHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
1024 return strcmp(key1
, key2
) == 0;
1027 static void JimStringCopyHTKeyDestructor(void *privdata
, void *key
)
1032 static const Jim_HashTableType JimPackageHashTableType
= {
1033 JimStringCopyHTHashFunction
, /* hash function */
1034 JimStringCopyHTDup
, /* key dup */
1036 JimStringCopyHTKeyCompare
, /* key compare */
1037 JimStringCopyHTKeyDestructor
, /* key destructor */
1038 NULL
/* val destructor */
1041 typedef struct AssocDataValue
1043 Jim_InterpDeleteProc
*delProc
;
1047 static void JimAssocDataHashTableValueDestructor(void *privdata
, void *data
)
1049 AssocDataValue
*assocPtr
= (AssocDataValue
*) data
;
1051 if (assocPtr
->delProc
!= NULL
)
1052 assocPtr
->delProc((Jim_Interp
*)privdata
, assocPtr
->data
);
1056 static const Jim_HashTableType JimAssocDataHashTableType
= {
1057 JimStringCopyHTHashFunction
, /* hash function */
1058 JimStringCopyHTDup
, /* key dup */
1060 JimStringCopyHTKeyCompare
, /* key compare */
1061 JimStringCopyHTKeyDestructor
, /* key destructor */
1062 JimAssocDataHashTableValueDestructor
/* val destructor */
1065 /* -----------------------------------------------------------------------------
1066 * Stack - This is a simple generic stack implementation. It is used for
1067 * example in the 'expr' expression compiler.
1068 * ---------------------------------------------------------------------------*/
1069 void Jim_InitStack(Jim_Stack
*stack
)
1073 stack
->vector
= NULL
;
1076 void Jim_FreeStack(Jim_Stack
*stack
)
1078 Jim_Free(stack
->vector
);
1081 int Jim_StackLen(Jim_Stack
*stack
)
1086 void Jim_StackPush(Jim_Stack
*stack
, void *element
)
1088 int neededLen
= stack
->len
+ 1;
1090 if (neededLen
> stack
->maxlen
) {
1091 stack
->maxlen
= neededLen
< 20 ? 20 : neededLen
* 2;
1092 stack
->vector
= Jim_Realloc(stack
->vector
, sizeof(void *) * stack
->maxlen
);
1094 stack
->vector
[stack
->len
] = element
;
1098 void *Jim_StackPop(Jim_Stack
*stack
)
1100 if (stack
->len
== 0)
1103 return stack
->vector
[stack
->len
];
1106 void *Jim_StackPeek(Jim_Stack
*stack
)
1108 if (stack
->len
== 0)
1110 return stack
->vector
[stack
->len
- 1];
1113 void Jim_FreeStackElements(Jim_Stack
*stack
, void (*freeFunc
) (void *ptr
))
1117 for (i
= 0; i
< stack
->len
; i
++)
1118 freeFunc(stack
->vector
[i
]);
1121 /* -----------------------------------------------------------------------------
1123 * ---------------------------------------------------------------------------*/
1126 #define JIM_TT_NONE 0 /* No token returned */
1127 #define JIM_TT_STR 1 /* simple string */
1128 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1129 #define JIM_TT_VAR 3 /* var substitution */
1130 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1131 #define JIM_TT_CMD 5 /* command substitution */
1132 /* Note: Keep these three together for TOKEN_IS_SEP() */
1133 #define JIM_TT_SEP 6 /* word separator (white space) */
1134 #define JIM_TT_EOL 7 /* line separator */
1135 #define JIM_TT_EOF 8 /* end of script */
1137 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1138 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1140 /* Additional token types needed for expressions */
1141 #define JIM_TT_SUBEXPR_START 11
1142 #define JIM_TT_SUBEXPR_END 12
1143 #define JIM_TT_SUBEXPR_COMMA 13
1144 #define JIM_TT_EXPR_INT 14
1145 #define JIM_TT_EXPR_DOUBLE 15
1147 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1149 /* Operator token types start here */
1150 #define JIM_TT_EXPR_OP 20
1152 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1155 #define JIM_PS_DEF 0 /* Default state */
1156 #define JIM_PS_QUOTE 1 /* Inside "" */
1157 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 * Results of missing quotes, braces, etc. from parsing.
1162 struct JimParseMissing
{
1163 int ch
; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1164 int line
; /* Line number starting the missing token */
1167 /* Parser context structure. The same context is used both to parse
1168 * Tcl scripts and lists. */
1171 const char *p
; /* Pointer to the point of the program we are parsing */
1172 int len
; /* Remaining length */
1173 int linenr
; /* Current line number */
1175 const char *tend
; /* Returned token is at tstart-tend in 'prg'. */
1176 int tline
; /* Line number of the returned token */
1177 int tt
; /* Token type */
1178 int eof
; /* Non zero if EOF condition is true. */
1179 int state
; /* Parser state */
1180 int comment
; /* Non zero if the next chars may be a comment. */
1181 struct JimParseMissing missing
; /* Details of any missing quotes, etc. */
1184 static int JimParseScript(struct JimParserCtx
*pc
);
1185 static int JimParseSep(struct JimParserCtx
*pc
);
1186 static int JimParseEol(struct JimParserCtx
*pc
);
1187 static int JimParseCmd(struct JimParserCtx
*pc
);
1188 static int JimParseQuote(struct JimParserCtx
*pc
);
1189 static int JimParseVar(struct JimParserCtx
*pc
);
1190 static int JimParseBrace(struct JimParserCtx
*pc
);
1191 static int JimParseStr(struct JimParserCtx
*pc
);
1192 static int JimParseComment(struct JimParserCtx
*pc
);
1193 static void JimParseSubCmd(struct JimParserCtx
*pc
);
1194 static int JimParseSubQuote(struct JimParserCtx
*pc
);
1195 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
);
1197 /* Initialize a parser context.
1198 * 'prg' is a pointer to the program text, linenr is the line
1199 * number of the first line contained in the program. */
1200 static void JimParserInit(struct JimParserCtx
*pc
, const char *prg
, int len
, int linenr
)
1207 pc
->tt
= JIM_TT_NONE
;
1209 pc
->state
= JIM_PS_DEF
;
1210 pc
->linenr
= linenr
;
1212 pc
->missing
.ch
= ' ';
1213 pc
->missing
.line
= linenr
;
1216 static int JimParseScript(struct JimParserCtx
*pc
)
1218 while (1) { /* the while is used to reiterate with continue if needed */
1221 pc
->tend
= pc
->p
- 1;
1222 pc
->tline
= pc
->linenr
;
1223 pc
->tt
= JIM_TT_EOL
;
1229 if (*(pc
->p
+ 1) == '\n' && pc
->state
== JIM_PS_DEF
) {
1230 return JimParseSep(pc
);
1233 return JimParseStr(pc
);
1238 if (pc
->state
== JIM_PS_DEF
)
1239 return JimParseSep(pc
);
1241 return JimParseStr(pc
);
1245 if (pc
->state
== JIM_PS_DEF
)
1246 return JimParseEol(pc
);
1247 return JimParseStr(pc
);
1250 return JimParseCmd(pc
);
1253 if (JimParseVar(pc
) == JIM_ERR
) {
1254 /* An orphan $. Create as a separate token */
1255 pc
->tstart
= pc
->tend
= pc
->p
++;
1257 pc
->tt
= JIM_TT_ESC
;
1262 JimParseComment(pc
);
1265 return JimParseStr(pc
);
1268 return JimParseStr(pc
);
1274 static int JimParseSep(struct JimParserCtx
*pc
)
1277 pc
->tline
= pc
->linenr
;
1278 while (isspace(UCHAR(*pc
->p
)) || (*pc
->p
== '\\' && *(pc
->p
+ 1) == '\n')) {
1279 if (*pc
->p
== '\n') {
1282 if (*pc
->p
== '\\') {
1290 pc
->tend
= pc
->p
- 1;
1291 pc
->tt
= JIM_TT_SEP
;
1295 static int JimParseEol(struct JimParserCtx
*pc
)
1298 pc
->tline
= pc
->linenr
;
1299 while (isspace(UCHAR(*pc
->p
)) || *pc
->p
== ';') {
1305 pc
->tend
= pc
->p
- 1;
1306 pc
->tt
= JIM_TT_EOL
;
1311 ** Here are the rules for parsing:
1312 ** {braced expression}
1313 ** - Count open and closing braces
1314 ** - Backslash escapes meaning of braces
1316 ** "quoted expression"
1317 ** - First double quote at start of word terminates the expression
1318 ** - Backslash escapes quote and bracket
1319 ** - [commands brackets] are counted/nested
1320 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1322 ** [command expression]
1323 ** - Count open and closing brackets
1324 ** - Backslash escapes quote, bracket and brace
1325 ** - [commands brackets] are counted/nested
1326 ** - "quoted expressions" are parsed according to quoting rules
1327 ** - {braced expressions} are parsed according to brace rules
1329 ** For everything, backslash escapes the next char, newline increments current line
1333 * Parses a braced expression starting at pc->p.
1335 * Positions the parser at the end of the braced expression,
1336 * sets pc->tend and possibly pc->missing.
1338 static void JimParseSubBrace(struct JimParserCtx
*pc
)
1342 /* Skip the brace */
1349 if (*++pc
->p
== '\n') {
1362 pc
->tend
= pc
->p
- 1;
1376 pc
->missing
.ch
= '{';
1377 pc
->missing
.line
= pc
->tline
;
1378 pc
->tend
= pc
->p
- 1;
1382 * Parses a quoted expression starting at pc->p.
1384 * Positions the parser at the end of the quoted expression,
1385 * sets pc->tend and possibly pc->missing.
1387 * Returns the type of the token of the string,
1388 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1391 static int JimParseSubQuote(struct JimParserCtx
*pc
)
1393 int tt
= JIM_TT_STR
;
1394 int line
= pc
->tline
;
1396 /* Skip the quote */
1403 if (*++pc
->p
== '\n') {
1412 pc
->tend
= pc
->p
- 1;
1433 pc
->missing
.ch
= '"';
1434 pc
->missing
.line
= line
;
1435 pc
->tend
= pc
->p
- 1;
1440 * Parses a [command] expression starting at pc->p.
1442 * Positions the parser at the end of the command expression,
1443 * sets pc->tend and possibly pc->missing.
1445 static void JimParseSubCmd(struct JimParserCtx
*pc
)
1448 int startofword
= 1;
1449 int line
= pc
->tline
;
1451 /* Skip the bracket */
1458 if (*++pc
->p
== '\n') {
1471 pc
->tend
= pc
->p
- 1;
1480 JimParseSubQuote(pc
);
1486 JimParseSubBrace(pc
);
1494 startofword
= isspace(UCHAR(*pc
->p
));
1498 pc
->missing
.ch
= '[';
1499 pc
->missing
.line
= line
;
1500 pc
->tend
= pc
->p
- 1;
1503 static int JimParseBrace(struct JimParserCtx
*pc
)
1505 pc
->tstart
= pc
->p
+ 1;
1506 pc
->tline
= pc
->linenr
;
1507 pc
->tt
= JIM_TT_STR
;
1508 JimParseSubBrace(pc
);
1512 static int JimParseCmd(struct JimParserCtx
*pc
)
1514 pc
->tstart
= pc
->p
+ 1;
1515 pc
->tline
= pc
->linenr
;
1516 pc
->tt
= JIM_TT_CMD
;
1521 static int JimParseQuote(struct JimParserCtx
*pc
)
1523 pc
->tstart
= pc
->p
+ 1;
1524 pc
->tline
= pc
->linenr
;
1525 pc
->tt
= JimParseSubQuote(pc
);
1529 static int JimParseVar(struct JimParserCtx
*pc
)
1535 #ifdef EXPRSUGAR_BRACKET
1536 if (*pc
->p
== '[') {
1537 /* Parse $[...] expr shorthand syntax */
1539 pc
->tt
= JIM_TT_EXPRSUGAR
;
1545 pc
->tt
= JIM_TT_VAR
;
1546 pc
->tline
= pc
->linenr
;
1548 if (*pc
->p
== '{') {
1549 pc
->tstart
= ++pc
->p
;
1552 while (pc
->len
&& *pc
->p
!= '}') {
1553 if (*pc
->p
== '\n') {
1559 pc
->tend
= pc
->p
- 1;
1567 /* Skip double colon, but not single colon! */
1568 if (pc
->p
[0] == ':' && pc
->p
[1] == ':') {
1569 while (*pc
->p
== ':') {
1575 /* Note that any char >= 0x80 must be part of a utf-8 char.
1576 * We consider all unicode points outside of ASCII as letters
1578 if (isalnum(UCHAR(*pc
->p
)) || *pc
->p
== '_' || UCHAR(*pc
->p
) >= 0x80) {
1585 /* Parse [dict get] syntax sugar. */
1586 if (*pc
->p
== '(') {
1588 const char *paren
= NULL
;
1590 pc
->tt
= JIM_TT_DICTSUGAR
;
1592 while (count
&& pc
->len
) {
1595 if (*pc
->p
== '\\' && pc
->len
>= 1) {
1599 else if (*pc
->p
== '(') {
1602 else if (*pc
->p
== ')') {
1612 /* Did not find a matching paren. Back up */
1614 pc
->len
+= (pc
->p
- paren
);
1617 #ifndef EXPRSUGAR_BRACKET
1618 if (*pc
->tstart
== '(') {
1619 pc
->tt
= JIM_TT_EXPRSUGAR
;
1623 pc
->tend
= pc
->p
- 1;
1625 /* Check if we parsed just the '$' character.
1626 * That's not a variable so an error is returned
1627 * to tell the state machine to consider this '$' just
1629 if (pc
->tstart
== pc
->p
) {
1637 static int JimParseStr(struct JimParserCtx
*pc
)
1639 if (pc
->tt
== JIM_TT_SEP
|| pc
->tt
== JIM_TT_EOL
||
1640 pc
->tt
== JIM_TT_NONE
|| pc
->tt
== JIM_TT_STR
) {
1641 /* Starting a new word */
1642 if (*pc
->p
== '{') {
1643 return JimParseBrace(pc
);
1645 if (*pc
->p
== '"') {
1646 pc
->state
= JIM_PS_QUOTE
;
1649 /* In case the end quote is missing */
1650 pc
->missing
.line
= pc
->tline
;
1654 pc
->tline
= pc
->linenr
;
1657 if (pc
->state
== JIM_PS_QUOTE
) {
1658 pc
->missing
.ch
= '"';
1660 pc
->tend
= pc
->p
- 1;
1661 pc
->tt
= JIM_TT_ESC
;
1666 if (pc
->state
== JIM_PS_DEF
&& *(pc
->p
+ 1) == '\n') {
1667 pc
->tend
= pc
->p
- 1;
1668 pc
->tt
= JIM_TT_ESC
;
1672 if (*(pc
->p
+ 1) == '\n') {
1678 else if (pc
->len
== 1) {
1679 /* End of script with trailing backslash */
1680 pc
->missing
.ch
= '\\';
1684 /* If the following token is not '$' just keep going */
1685 if (pc
->len
> 1 && pc
->p
[1] != '$') {
1689 /* Only need a separate ')' token if the previous was a var */
1690 if (*pc
->p
== '(' || pc
->tt
== JIM_TT_VAR
) {
1691 if (pc
->p
== pc
->tstart
) {
1692 /* At the start of the token, so just return this char */
1696 pc
->tend
= pc
->p
- 1;
1697 pc
->tt
= JIM_TT_ESC
;
1704 pc
->tend
= pc
->p
- 1;
1705 pc
->tt
= JIM_TT_ESC
;
1713 if (pc
->state
== JIM_PS_DEF
) {
1714 pc
->tend
= pc
->p
- 1;
1715 pc
->tt
= JIM_TT_ESC
;
1718 else if (*pc
->p
== '\n') {
1723 if (pc
->state
== JIM_PS_QUOTE
) {
1724 pc
->tend
= pc
->p
- 1;
1725 pc
->tt
= JIM_TT_ESC
;
1728 pc
->state
= JIM_PS_DEF
;
1736 return JIM_OK
; /* unreached */
1739 static int JimParseComment(struct JimParserCtx
*pc
)
1742 if (*pc
->p
== '\\') {
1746 pc
->missing
.ch
= '\\';
1749 if (*pc
->p
== '\n') {
1753 else if (*pc
->p
== '\n') {
1765 /* xdigitval and odigitval are helper functions for JimEscape() */
1766 static int xdigitval(int c
)
1768 if (c
>= '0' && c
<= '9')
1770 if (c
>= 'a' && c
<= 'f')
1771 return c
- 'a' + 10;
1772 if (c
>= 'A' && c
<= 'F')
1773 return c
- 'A' + 10;
1777 static int odigitval(int c
)
1779 if (c
>= '0' && c
<= '7')
1784 /* Perform Tcl escape substitution of 's', storing the result
1785 * string into 'dest'. The escaped string is guaranteed to
1786 * be the same length or shorted than the source string.
1787 * Slen is the length of the string at 's', if it's -1 the string
1788 * length will be calculated by the function.
1790 * The function returns the length of the resulting string. */
1791 static int JimEscape(char *dest
, const char *s
, int slen
)
1799 for (i
= 0; i
< slen
; i
++) {
1830 /* A unicode or hex sequence.
1831 * \x Expect 1-2 hex chars and convert to hex.
1832 * \u Expect 1-4 hex chars and convert to utf-8.
1833 * \U Expect 1-8 hex chars and convert to utf-8.
1834 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1835 * An invalid sequence means simply the escaped char.
1847 else if (s
[i
] == 'u') {
1848 if (s
[i
+ 1] == '{') {
1857 for (k
= 0; k
< maxchars
; k
++) {
1858 int c
= xdigitval(s
[i
+ k
+ 1]);
1862 val
= (val
<< 4) | c
;
1864 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1866 if (k
== 0 || val
> 0x1fffff || s
[i
+ k
+ 1] != '}') {
1872 /* Skip the closing brace */
1877 /* Got a valid sequence, so convert */
1882 p
+= utf8_fromunicode(p
, val
);
1887 /* Not a valid codepoint, just an escaped char */
1900 /* Replace all spaces and tabs after backslash newline with a single space*/
1904 } while (s
[i
+ 1] == ' ' || s
[i
+ 1] == '\t');
1917 int c
= odigitval(s
[i
+ 1]);
1920 c
= odigitval(s
[i
+ 2]);
1926 val
= (val
* 8) + c
;
1927 c
= odigitval(s
[i
+ 3]);
1933 val
= (val
* 8) + c
;
1954 /* Returns a dynamically allocated copy of the current token in the
1955 * parser context. The function performs conversion of escapes if
1956 * the token is of type JIM_TT_ESC.
1958 * Note that after the conversion, tokens that are grouped with
1959 * braces in the source code, are always recognizable from the
1960 * identical string obtained in a different way from the type.
1962 * For example the string:
1966 * will return as first token "*", of type JIM_TT_STR
1972 * will return as first token "*", of type JIM_TT_ESC
1974 static Jim_Obj
*JimParserGetTokenObj(Jim_Interp
*interp
, struct JimParserCtx
*pc
)
1976 const char *start
, *end
;
1984 token
= Jim_Alloc(1);
1988 len
= (end
- start
) + 1;
1989 token
= Jim_Alloc(len
+ 1);
1990 if (pc
->tt
!= JIM_TT_ESC
) {
1991 /* No escape conversion needed? Just copy it. */
1992 memcpy(token
, start
, len
);
1996 /* Else convert the escape chars. */
1997 len
= JimEscape(token
, start
, len
);
2001 return Jim_NewStringObjNoAlloc(interp
, token
, len
);
2004 /* Parses the given string to determine if it represents a complete script.
2006 * This is useful for interactive shells implementation, for [info complete].
2008 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2009 * '{' on scripts incomplete missing one or more '}' to be balanced.
2010 * '[' on scripts incomplete missing one or more ']' to be balanced.
2011 * '"' on scripts incomplete missing a '"' char.
2012 * '\\' on scripts with a trailing backslash.
2014 * If the script is complete, 1 is returned, otherwise 0.
2016 int Jim_ScriptIsComplete(const char *s
, int len
, char *stateCharPtr
)
2018 struct JimParserCtx parser
;
2020 JimParserInit(&parser
, s
, len
, 1);
2021 while (!parser
.eof
) {
2022 JimParseScript(&parser
);
2025 *stateCharPtr
= parser
.missing
.ch
;
2027 return parser
.missing
.ch
== ' ';
2030 /* -----------------------------------------------------------------------------
2032 * ---------------------------------------------------------------------------*/
2033 static int JimParseListSep(struct JimParserCtx
*pc
);
2034 static int JimParseListStr(struct JimParserCtx
*pc
);
2035 static int JimParseListQuote(struct JimParserCtx
*pc
);
2037 static int JimParseList(struct JimParserCtx
*pc
)
2039 if (isspace(UCHAR(*pc
->p
))) {
2040 return JimParseListSep(pc
);
2044 return JimParseListQuote(pc
);
2047 return JimParseBrace(pc
);
2051 return JimParseListStr(pc
);
2056 pc
->tstart
= pc
->tend
= pc
->p
;
2057 pc
->tline
= pc
->linenr
;
2058 pc
->tt
= JIM_TT_EOL
;
2063 static int JimParseListSep(struct JimParserCtx
*pc
)
2066 pc
->tline
= pc
->linenr
;
2067 while (isspace(UCHAR(*pc
->p
))) {
2068 if (*pc
->p
== '\n') {
2074 pc
->tend
= pc
->p
- 1;
2075 pc
->tt
= JIM_TT_SEP
;
2079 static int JimParseListQuote(struct JimParserCtx
*pc
)
2085 pc
->tline
= pc
->linenr
;
2086 pc
->tt
= JIM_TT_STR
;
2091 pc
->tt
= JIM_TT_ESC
;
2092 if (--pc
->len
== 0) {
2093 /* Trailing backslash */
2103 pc
->tend
= pc
->p
- 1;
2112 pc
->tend
= pc
->p
- 1;
2116 static int JimParseListStr(struct JimParserCtx
*pc
)
2119 pc
->tline
= pc
->linenr
;
2120 pc
->tt
= JIM_TT_STR
;
2123 if (isspace(UCHAR(*pc
->p
))) {
2124 pc
->tend
= pc
->p
- 1;
2127 if (*pc
->p
== '\\') {
2128 if (--pc
->len
== 0) {
2129 /* Trailing backslash */
2133 pc
->tt
= JIM_TT_ESC
;
2139 pc
->tend
= pc
->p
- 1;
2143 /* -----------------------------------------------------------------------------
2144 * Jim_Obj related functions
2145 * ---------------------------------------------------------------------------*/
2147 /* Return a new initialized object. */
2148 Jim_Obj
*Jim_NewObj(Jim_Interp
*interp
)
2152 /* -- Check if there are objects in the free list -- */
2153 if (interp
->freeList
!= NULL
) {
2154 /* -- Unlink the object from the free list -- */
2155 objPtr
= interp
->freeList
;
2156 interp
->freeList
= objPtr
->nextObjPtr
;
2159 /* -- No ready to use objects: allocate a new one -- */
2160 objPtr
= Jim_Alloc(sizeof(*objPtr
));
2163 /* Object is returned with refCount of 0. Every
2164 * kind of GC implemented should take care to don't try
2165 * to scan objects with refCount == 0. */
2166 objPtr
->refCount
= 0;
2167 /* All the other fields are left not initialized to save time.
2168 * The caller will probably want to set them to the right
2171 /* -- Put the object into the live list -- */
2172 objPtr
->prevObjPtr
= NULL
;
2173 objPtr
->nextObjPtr
= interp
->liveList
;
2174 if (interp
->liveList
)
2175 interp
->liveList
->prevObjPtr
= objPtr
;
2176 interp
->liveList
= objPtr
;
2181 /* Free an object. Actually objects are never freed, but
2182 * just moved to the free objects list, where they will be
2183 * reused by Jim_NewObj(). */
2184 void Jim_FreeObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2186 /* Check if the object was already freed, panic. */
2187 JimPanic((objPtr
->refCount
!= 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr
,
2188 objPtr
->refCount
, objPtr
->typePtr
? objPtr
->typePtr
->name
: "<none>"));
2190 /* Free the internal representation */
2191 Jim_FreeIntRep(interp
, objPtr
);
2192 /* Free the string representation */
2193 if (objPtr
->bytes
!= NULL
) {
2194 if (objPtr
->bytes
!= JimEmptyStringRep
)
2195 Jim_Free(objPtr
->bytes
);
2197 /* Unlink the object from the live objects list */
2198 if (objPtr
->prevObjPtr
)
2199 objPtr
->prevObjPtr
->nextObjPtr
= objPtr
->nextObjPtr
;
2200 if (objPtr
->nextObjPtr
)
2201 objPtr
->nextObjPtr
->prevObjPtr
= objPtr
->prevObjPtr
;
2202 if (interp
->liveList
== objPtr
)
2203 interp
->liveList
= objPtr
->nextObjPtr
;
2204 #ifdef JIM_DISABLE_OBJECT_POOL
2207 /* Link the object into the free objects list */
2208 objPtr
->prevObjPtr
= NULL
;
2209 objPtr
->nextObjPtr
= interp
->freeList
;
2210 if (interp
->freeList
)
2211 interp
->freeList
->prevObjPtr
= objPtr
;
2212 interp
->freeList
= objPtr
;
2213 objPtr
->refCount
= -1;
2217 /* Invalidate the string representation of an object. */
2218 void Jim_InvalidateStringRep(Jim_Obj
*objPtr
)
2220 if (objPtr
->bytes
!= NULL
) {
2221 if (objPtr
->bytes
!= JimEmptyStringRep
)
2222 Jim_Free(objPtr
->bytes
);
2224 objPtr
->bytes
= NULL
;
2227 /* Duplicate an object. The returned object has refcount = 0. */
2228 Jim_Obj
*Jim_DuplicateObj(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
2232 dupPtr
= Jim_NewObj(interp
);
2233 if (objPtr
->bytes
== NULL
) {
2234 /* Object does not have a valid string representation. */
2235 dupPtr
->bytes
= NULL
;
2237 else if (objPtr
->length
== 0) {
2238 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2239 dupPtr
->bytes
= JimEmptyStringRep
;
2241 dupPtr
->typePtr
= NULL
;
2245 dupPtr
->bytes
= Jim_Alloc(objPtr
->length
+ 1);
2246 dupPtr
->length
= objPtr
->length
;
2247 /* Copy the null byte too */
2248 memcpy(dupPtr
->bytes
, objPtr
->bytes
, objPtr
->length
+ 1);
2251 /* By default, the new object has the same type as the old object */
2252 dupPtr
->typePtr
= objPtr
->typePtr
;
2253 if (objPtr
->typePtr
!= NULL
) {
2254 if (objPtr
->typePtr
->dupIntRepProc
== NULL
) {
2255 dupPtr
->internalRep
= objPtr
->internalRep
;
2258 /* The dup proc may set a different type, e.g. NULL */
2259 objPtr
->typePtr
->dupIntRepProc(interp
, objPtr
, dupPtr
);
2265 /* Return the string representation for objPtr. If the object's
2266 * string representation is invalid, calls the updateStringProc method to create
2267 * a new one from the internal representation of the object.
2269 const char *Jim_GetString(Jim_Obj
*objPtr
, int *lenPtr
)
2271 if (objPtr
->bytes
== NULL
) {
2272 /* Invalid string repr. Generate it. */
2273 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2274 objPtr
->typePtr
->updateStringProc(objPtr
);
2277 *lenPtr
= objPtr
->length
;
2278 return objPtr
->bytes
;
2281 /* Just returns the length of the object's string rep */
2282 int Jim_Length(Jim_Obj
*objPtr
)
2284 if (objPtr
->bytes
== NULL
) {
2285 /* Invalid string repr. Generate it. */
2286 JimPanic((objPtr
->typePtr
->updateStringProc
== NULL
, "UpdateStringProc called against '%s' type.", objPtr
->typePtr
->name
));
2287 objPtr
->typePtr
->updateStringProc(objPtr
);
2289 return objPtr
->length
;
2292 /* Just returns the length of the object's string rep */
2293 const char *Jim_String(Jim_Obj
*objPtr
)
2295 if (objPtr
->bytes
== NULL
) {
2296 /* Invalid string repr. Generate it. */
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",
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
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_ALPHA
: isclassfunc
= isalpha
; break;
3014 case STR_IS_ALNUM
: isclassfunc
= isalnum
; break;
3015 case STR_IS_ASCII
: isclassfunc
= jim_isascii
; break;
3016 case STR_IS_DIGIT
: isclassfunc
= isdigit
; break;
3017 case STR_IS_LOWER
: isclassfunc
= islower
; break;
3018 case STR_IS_UPPER
: isclassfunc
= isupper
; break;
3019 case STR_IS_SPACE
: isclassfunc
= isspace
; break;
3020 case STR_IS_XDIGIT
: isclassfunc
= isxdigit
; break;
3021 case STR_IS_CONTROL
: isclassfunc
= iscntrl
; break;
3022 case STR_IS_PRINT
: isclassfunc
= isprint
; break;
3023 case STR_IS_GRAPH
: isclassfunc
= isgraph
; break;
3024 case STR_IS_PUNCT
: isclassfunc
= ispunct
; break;
3029 for (i
= 0; i
< len
; i
++) {
3030 if (!isclassfunc(str
[i
])) {
3031 Jim_SetResultBool(interp
, 0);
3035 Jim_SetResultBool(interp
, 1);
3039 /* -----------------------------------------------------------------------------
3040 * Compared String Object
3041 * ---------------------------------------------------------------------------*/
3043 /* This is strange object that allows comparison of a C literal string
3044 * with a Jim object in a very short time if the same comparison is done
3045 * multiple times. For example every time the [if] command is executed,
3046 * Jim has to check if a given argument is "else".
3047 * If the code has no errors, this comparison is true most of the time,
3048 * so we can cache the pointer of the string of the last matching
3049 * comparison inside the object. Because most C compilers perform literal sharing,
3050 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3051 * this works pretty well even if comparisons are at different places
3052 * inside the C code. */
3054 static const Jim_ObjType comparedStringObjType
= {
3059 JIM_TYPE_REFERENCES
,
3062 /* The only way this object is exposed to the API is via the following
3063 * function. Returns true if the string and the object string repr.
3064 * are the same, otherwise zero is returned.
3066 * Note: this isn't binary safe, but it hardly needs to be.*/
3067 int Jim_CompareStringImmediate(Jim_Interp
*interp
, Jim_Obj
*objPtr
, const char *str
)
3069 if (objPtr
->typePtr
== &comparedStringObjType
&& objPtr
->internalRep
.ptr
== str
) {
3073 const char *objStr
= Jim_String(objPtr
);
3075 if (strcmp(str
, objStr
) != 0)
3078 if (objPtr
->typePtr
!= &comparedStringObjType
) {
3079 Jim_FreeIntRep(interp
, objPtr
);
3080 objPtr
->typePtr
= &comparedStringObjType
;
3082 objPtr
->internalRep
.ptr
= (char *)str
; /*ATTENTION: const cast */
3087 static int qsortCompareStringPointers(const void *a
, const void *b
)
3089 char *const *sa
= (char *const *)a
;
3090 char *const *sb
= (char *const *)b
;
3092 return strcmp(*sa
, *sb
);
3096 /* -----------------------------------------------------------------------------
3099 * This object is just a string from the language point of view, but
3100 * the internal representation contains the filename and line number
3101 * where this token was read. This information is used by
3102 * Jim_EvalObj() if the object passed happens to be of type "source".
3104 * This allows propagation of the information about line numbers and file
3105 * names and gives error messages with absolute line numbers.
3107 * Note that this object uses the internal representation of the Jim_Object,
3108 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3110 * Also the object will be converted to something else if the given
3111 * token it represents in the source file is not something to be
3112 * evaluated (not a script), and will be specialized in some other way,
3113 * so the time overhead is also almost zero.
3114 * ---------------------------------------------------------------------------*/
3116 static void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3117 static void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3119 static const Jim_ObjType sourceObjType
= {
3121 FreeSourceInternalRep
,
3122 DupSourceInternalRep
,
3124 JIM_TYPE_REFERENCES
,
3127 void FreeSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3129 Jim_DecrRefCount(interp
, objPtr
->internalRep
.sourceValue
.fileNameObj
);
3132 void DupSourceInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3134 dupPtr
->internalRep
.sourceValue
= srcPtr
->internalRep
.sourceValue
;
3135 Jim_IncrRefCount(dupPtr
->internalRep
.sourceValue
.fileNameObj
);
3138 static void JimSetSourceInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
3139 Jim_Obj
*fileNameObj
, int lineNumber
)
3141 JimPanic((Jim_IsShared(objPtr
), "JimSetSourceInfo called with shared object"));
3142 JimPanic((objPtr
->typePtr
!= NULL
, "JimSetSourceInfo called with typed object"));
3143 Jim_IncrRefCount(fileNameObj
);
3144 objPtr
->internalRep
.sourceValue
.fileNameObj
= fileNameObj
;
3145 objPtr
->internalRep
.sourceValue
.lineNumber
= lineNumber
;
3146 objPtr
->typePtr
= &sourceObjType
;
3149 /* -----------------------------------------------------------------------------
3152 * This object is used only in the Script internal represenation.
3153 * For each line of the script, it holds the number of tokens on the line
3154 * and the source line number.
3156 static const Jim_ObjType scriptLineObjType
= {
3164 static Jim_Obj
*JimNewScriptLineObj(Jim_Interp
*interp
, int argc
, int line
)
3168 #ifdef DEBUG_SHOW_SCRIPT
3170 snprintf(buf
, sizeof(buf
), "line=%d, argc=%d", line
, argc
);
3171 objPtr
= Jim_NewStringObj(interp
, buf
, -1);
3173 objPtr
= Jim_NewEmptyStringObj(interp
);
3175 objPtr
->typePtr
= &scriptLineObjType
;
3176 objPtr
->internalRep
.scriptLineValue
.argc
= argc
;
3177 objPtr
->internalRep
.scriptLineValue
.line
= line
;
3182 /* -----------------------------------------------------------------------------
3185 * This object holds the parsed internal representation of a script.
3186 * This representation is help within an allocated ScriptObj (see below)
3188 static void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
3189 static void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
3190 static int JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
3191 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
);
3193 static const Jim_ObjType scriptObjType
= {
3195 FreeScriptInternalRep
,
3196 DupScriptInternalRep
,
3198 JIM_TYPE_REFERENCES
,
3201 /* Each token of a script is represented by a ScriptToken.
3202 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3203 * can be specialized by commands operating on it.
3205 typedef struct ScriptToken
3211 /* This is the script object internal representation. An array of
3212 * ScriptToken structures, including a pre-computed representation of the
3213 * command length and arguments.
3215 * For example the script:
3218 * set $i $x$y [foo]BAR
3220 * will produce a ScriptObj with the following ScriptToken's:
3235 * "puts hello" has two args (LIN 2), composed of single tokens.
3236 * (Note that the WRD token is omitted for the common case of a single token.)
3238 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3239 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3241 * The precomputation of the command structure makes Jim_Eval() faster,
3242 * and simpler because there aren't dynamic lengths / allocations.
3244 * -- {expand}/{*} handling --
3246 * Expand is handled in a special way.
3248 * If a "word" begins with {*}, the word token count is -ve.
3250 * For example the command:
3254 * Will produce the following cmdstruct array:
3261 * Note that the 'LIN' token also contains the source information for the
3262 * first word of the line for error reporting purposes
3264 * -- the substFlags field of the structure --
3266 * The scriptObj structure is used to represent both "script" objects
3267 * and "subst" objects. In the second case, the there are no LIN and WRD
3268 * tokens. Instead SEP and EOL tokens are added as-is.
3269 * In addition, the field 'substFlags' is used to represent the flags used to turn
3270 * the string into the internal representation.
3271 * If these flags do not match what the application requires,
3272 * the scriptObj is created again. For example the script:
3274 * subst -nocommands $string
3275 * subst -novariables $string
3277 * Will (re)create the internal representation of the $string object
3280 typedef struct ScriptObj
3282 ScriptToken
*token
; /* Tokens array. */
3283 Jim_Obj
*fileNameObj
; /* Filename */
3284 int len
; /* Length of token[] */
3285 int substFlags
; /* flags used for the compilation of "subst" objects */
3286 int inUse
; /* Used to share a ScriptObj. Currently
3287 only used by Jim_EvalObj() as protection against
3288 shimmering of the currently evaluated object. */
3289 int firstline
; /* Line number of the first line */
3290 int linenr
; /* Line number of the current line */
3293 void FreeScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3296 struct ScriptObj
*script
= (void *)objPtr
->internalRep
.ptr
;
3298 if (--script
->inUse
!= 0)
3300 for (i
= 0; i
< script
->len
; i
++) {
3301 Jim_DecrRefCount(interp
, script
->token
[i
].objPtr
);
3303 Jim_Free(script
->token
);
3304 Jim_DecrRefCount(interp
, script
->fileNameObj
);
3308 void DupScriptInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
3310 JIM_NOTUSED(interp
);
3311 JIM_NOTUSED(srcPtr
);
3313 /* Just return a simple string. We don't try to preserve the source info
3314 * since in practice scripts are never duplicated
3316 dupPtr
->typePtr
= NULL
;
3319 /* A simple parse token.
3320 * As the script is parsed, the created tokens point into the script string rep.
3324 const char *token
; /* Pointer to the start of the token */
3325 int len
; /* Length of this token */
3326 int type
; /* Token type */
3327 int line
; /* Line number */
3330 /* A list of parsed tokens representing a script.
3331 * Tokens are added to this list as the script is parsed.
3332 * It grows as needed.
3336 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3337 ParseToken
*list
; /* Array of tokens */
3338 int size
; /* Current size of the list */
3339 int count
; /* Number of entries used */
3340 ParseToken static_list
[20]; /* Small initial token space to avoid allocation */
3343 static void ScriptTokenListInit(ParseTokenList
*tokenlist
)
3345 tokenlist
->list
= tokenlist
->static_list
;
3346 tokenlist
->size
= sizeof(tokenlist
->static_list
) / sizeof(ParseToken
);
3347 tokenlist
->count
= 0;
3350 static void ScriptTokenListFree(ParseTokenList
*tokenlist
)
3352 if (tokenlist
->list
!= tokenlist
->static_list
) {
3353 Jim_Free(tokenlist
->list
);
3358 * Adds the new token to the tokenlist.
3359 * The token has the given length, type and line number.
3360 * The token list is resized as necessary.
3362 static void ScriptAddToken(ParseTokenList
*tokenlist
, const char *token
, int len
, int type
,
3367 if (tokenlist
->count
== tokenlist
->size
) {
3368 /* Resize the list */
3369 tokenlist
->size
*= 2;
3370 if (tokenlist
->list
!= tokenlist
->static_list
) {
3372 Jim_Realloc(tokenlist
->list
, tokenlist
->size
* sizeof(*tokenlist
->list
));
3375 /* The list needs to become allocated */
3376 tokenlist
->list
= Jim_Alloc(tokenlist
->size
* sizeof(*tokenlist
->list
));
3377 memcpy(tokenlist
->list
, tokenlist
->static_list
,
3378 tokenlist
->count
* sizeof(*tokenlist
->list
));
3381 t
= &tokenlist
->list
[tokenlist
->count
++];
3388 /* Counts the number of adjoining non-separator tokens.
3390 * Returns -ve if the first token is the expansion
3391 * operator (in which case the count doesn't include
3394 static int JimCountWordTokens(ParseToken
*t
)
3399 /* Is the first word {*} or {expand}? */
3400 if (t
->type
== JIM_TT_STR
&& !TOKEN_IS_SEP(t
[1].type
)) {
3401 if ((t
->len
== 1 && *t
->token
== '*') || (t
->len
== 6 && strncmp(t
->token
, "expand", 6) == 0)) {
3402 /* Create an expand token */
3408 /* Now count non-separator words */
3409 while (!TOKEN_IS_SEP(t
->type
)) {
3414 return count
* expand
;
3418 * Create a script/subst object from the given token.
3420 static Jim_Obj
*JimMakeScriptObj(Jim_Interp
*interp
, const ParseToken
*t
)
3424 if (t
->type
== JIM_TT_ESC
&& memchr(t
->token
, '\\', t
->len
) != NULL
) {
3425 /* Convert backlash escapes. The result will never be longer than the original */
3427 char *str
= Jim_Alloc(len
+ 1);
3428 len
= JimEscape(str
, t
->token
, len
);
3429 objPtr
= Jim_NewStringObjNoAlloc(interp
, str
, len
);
3432 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3433 * with a single space.
3435 objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
3441 * Takes a tokenlist and creates the allocated list of script tokens
3442 * in script->token, of length script->len.
3444 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3447 * Also sets script->line to the line number of the first token
3449 static void ScriptObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3450 ParseTokenList
*tokenlist
)
3453 struct ScriptToken
*token
;
3454 /* Number of tokens so far for the current command */
3456 /* This is the first token for the current command */
3457 ScriptToken
*linefirst
;
3461 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3462 printf("==== Tokens ====\n");
3463 for (i
= 0; i
< tokenlist
->count
; i
++) {
3464 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
->list
[i
].line
, jim_tt_name(tokenlist
->list
[i
].type
),
3465 tokenlist
->list
[i
].len
, tokenlist
->list
[i
].token
);
3469 /* May need up to one extra script token for each EOL in the worst case */
3470 count
= tokenlist
->count
;
3471 for (i
= 0; i
< tokenlist
->count
; i
++) {
3472 if (tokenlist
->list
[i
].type
== JIM_TT_EOL
) {
3476 linenr
= script
->firstline
= tokenlist
->list
[0].line
;
3478 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
3480 /* This is the first token for the current command */
3481 linefirst
= token
++;
3483 for (i
= 0; i
< tokenlist
->count
; ) {
3484 /* Look ahead to find out how many tokens make up the next word */
3487 /* Skip any leading separators */
3488 while (tokenlist
->list
[i
].type
== JIM_TT_SEP
) {
3492 wordtokens
= JimCountWordTokens(tokenlist
->list
+ i
);
3494 if (wordtokens
== 0) {
3495 /* None, so at end of line */
3497 linefirst
->type
= JIM_TT_LINE
;
3498 linefirst
->objPtr
= JimNewScriptLineObj(interp
, lineargs
, linenr
);
3499 Jim_IncrRefCount(linefirst
->objPtr
);
3501 /* Reset for new line */
3503 linefirst
= token
++;
3508 else if (wordtokens
!= 1) {
3509 /* More than 1, or {*}, so insert a WORD token */
3510 token
->type
= JIM_TT_WORD
;
3511 token
->objPtr
= Jim_NewIntObj(interp
, wordtokens
);
3512 Jim_IncrRefCount(token
->objPtr
);
3514 if (wordtokens
< 0) {
3515 /* Skip the expand token */
3517 wordtokens
= -wordtokens
- 1;
3522 if (lineargs
== 0) {
3523 /* First real token on the line, so record the line number */
3524 linenr
= tokenlist
->list
[i
].line
;
3528 /* Add each non-separator word token to the line */
3529 while (wordtokens
--) {
3530 const ParseToken
*t
= &tokenlist
->list
[i
++];
3532 token
->type
= t
->type
;
3533 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3534 Jim_IncrRefCount(token
->objPtr
);
3536 /* Every object is initially a string of type 'source', but the
3537 * internal type may be specialized during execution of the
3539 JimSetSourceInfo(interp
, token
->objPtr
, script
->fileNameObj
, t
->line
);
3544 if (lineargs
== 0) {
3548 script
->len
= token
- script
->token
;
3550 JimPanic((script
->len
>= count
, "allocated script array is too short"));
3552 #ifdef DEBUG_SHOW_SCRIPT
3553 printf("==== Script (%s) ====\n", Jim_String(script
->fileNameObj
));
3554 for (i
= 0; i
< script
->len
; i
++) {
3555 const ScriptToken
*t
= &script
->token
[i
];
3556 printf("[%2d] %s %s\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
3563 * Sets an appropriate error message for a missing script/expression terminator.
3565 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3567 * Note that a trailing backslash is not considered to be an error.
3569 static int JimParseCheckMissing(Jim_Interp
*interp
, int ch
)
3579 msg
= "unmatched \"[\"";
3582 msg
= "missing close-brace";
3586 msg
= "missing quote";
3590 Jim_SetResultString(interp
, msg
, -1);
3595 * Similar to ScriptObjAddTokens(), but for subst objects.
3597 static void SubstObjAddTokens(Jim_Interp
*interp
, struct ScriptObj
*script
,
3598 ParseTokenList
*tokenlist
)
3601 struct ScriptToken
*token
;
3603 token
= script
->token
= Jim_Alloc(sizeof(ScriptToken
) * tokenlist
->count
);
3605 for (i
= 0; i
< tokenlist
->count
; i
++) {
3606 const ParseToken
*t
= &tokenlist
->list
[i
];
3608 /* Create a token for 't' */
3609 token
->type
= t
->type
;
3610 token
->objPtr
= JimMakeScriptObj(interp
, t
);
3611 Jim_IncrRefCount(token
->objPtr
);
3618 /* This method takes the string representation of an object
3619 * as a Tcl script, and generates the pre-parsed internal representation
3622 * On parse error, sets an error message and returns JIM_ERR
3623 * (Note: the object is still converted to a script, even if an error occurs)
3625 static int JimSetScriptFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
3628 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
3629 struct JimParserCtx parser
;
3630 struct ScriptObj
*script
;
3631 ParseTokenList tokenlist
;
3633 int retcode
= JIM_OK
;
3635 /* Try to get information about filename / line number */
3636 if (objPtr
->typePtr
== &sourceObjType
) {
3637 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
3640 /* Initially parse the script into tokens (in tokenlist) */
3641 ScriptTokenListInit(&tokenlist
);
3643 JimParserInit(&parser
, scriptText
, scriptTextLen
, line
);
3644 while (!parser
.eof
) {
3645 JimParseScript(&parser
);
3646 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
3650 retcode
= JimParseCheckMissing(interp
, parser
.missing
.ch
);
3652 /* Add a final EOF token */
3653 ScriptAddToken(&tokenlist
, scriptText
+ scriptTextLen
, 0, JIM_TT_EOF
, 0);
3655 /* Create the "real" script tokens from the parsed tokens */
3656 script
= Jim_Alloc(sizeof(*script
));
3657 memset(script
, 0, sizeof(*script
));
3659 if (objPtr
->typePtr
== &sourceObjType
) {
3660 script
->fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
3663 script
->fileNameObj
= interp
->emptyObj
;
3665 script
->linenr
= parser
.missing
.line
;
3666 Jim_IncrRefCount(script
->fileNameObj
);
3668 ScriptObjAddTokens(interp
, script
, &tokenlist
);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist
);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp
, objPtr
);
3675 Jim_SetIntRepPtr(objPtr
, script
);
3676 objPtr
->typePtr
= &scriptObjType
;
3682 * Returns NULL if the script failed to parse and leaves
3683 * an error message in the interp result.
3685 * Otherwise returns a parsed script object.
3686 * (Note: the object is still converted to a script, even if an error occurs)
3688 ScriptObj
*Jim_GetScript(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
3690 if (objPtr
== interp
->emptyObj
) {
3691 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3692 objPtr
= interp
->nullScriptObj
;
3695 if (objPtr
->typePtr
!= &scriptObjType
|| ((struct ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
) {
3696 if (JimSetScriptFromAny(interp
, objPtr
) == JIM_ERR
) {
3700 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
3703 /* -----------------------------------------------------------------------------
3705 * ---------------------------------------------------------------------------*/
3706 static void JimIncrCmdRefCount(Jim_Cmd
*cmdPtr
)
3711 static void JimDecrCmdRefCount(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
)
3713 if (--cmdPtr
->inUse
== 0) {
3714 if (cmdPtr
->isproc
) {
3715 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
3716 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
3717 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3718 if (cmdPtr
->u
.proc
.staticVars
) {
3719 Jim_FreeHashTable(cmdPtr
->u
.proc
.staticVars
);
3720 Jim_Free(cmdPtr
->u
.proc
.staticVars
);
3725 if (cmdPtr
->u
.native
.delProc
) {
3726 cmdPtr
->u
.native
.delProc(interp
, cmdPtr
->u
.native
.privData
);
3729 if (cmdPtr
->prevCmd
) {
3730 /* Delete any pushed command too */
3731 JimDecrCmdRefCount(interp
, cmdPtr
->prevCmd
);
3737 /* Variables HashTable Type.
3739 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3742 /* Variables HashTable Type.
3744 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3745 static void JimVariablesHTValDestructor(void *interp
, void *val
)
3747 Jim_DecrRefCount(interp
, ((Jim_Var
*)val
)->objPtr
);
3751 static const Jim_HashTableType JimVariablesHashTableType
= {
3752 JimStringCopyHTHashFunction
, /* hash function */
3753 JimStringCopyHTDup
, /* key dup */
3755 JimStringCopyHTKeyCompare
, /* key compare */
3756 JimStringCopyHTKeyDestructor
, /* key destructor */
3757 JimVariablesHTValDestructor
/* val destructor */
3760 /* Commands HashTable Type.
3762 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3764 static void JimCommandsHT_ValDestructor(void *interp
, void *val
)
3766 JimDecrCmdRefCount(interp
, val
);
3769 static const Jim_HashTableType JimCommandsHashTableType
= {
3770 JimStringCopyHTHashFunction
, /* hash function */
3771 JimStringCopyHTDup
, /* key dup */
3773 JimStringCopyHTKeyCompare
, /* key compare */
3774 JimStringCopyHTKeyDestructor
, /* key destructor */
3775 JimCommandsHT_ValDestructor
/* val destructor */
3778 /* ------------------------- Commands related functions --------------------- */
3780 #ifdef jim_ext_namespace
3782 * Returns the "unscoped" version of the given namespace.
3783 * That is, the fully qualfied name without the leading ::
3784 * The returned value is either nsObj, or an object with a zero ref count.
3786 static Jim_Obj
*JimQualifyNameObj(Jim_Interp
*interp
, Jim_Obj
*nsObj
)
3788 const char *name
= Jim_String(nsObj
);
3789 if (name
[0] == ':' && name
[1] == ':') {
3790 /* This command is being defined in the global namespace */
3791 while (*++name
== ':') {
3793 nsObj
= Jim_NewStringObj(interp
, name
, -1);
3795 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3796 /* This command is being defined in a non-global namespace */
3797 nsObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3798 Jim_AppendStrings(interp
, nsObj
, "::", name
, NULL
);
3803 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3807 const char *name
= Jim_String(nameObjPtr
);
3808 if (name
[0] == ':' && name
[1] == ':') {
3811 Jim_IncrRefCount(nameObjPtr
);
3812 resultObj
= Jim_NewStringObj(interp
, "::", -1);
3813 Jim_AppendObj(interp
, resultObj
, nameObjPtr
);
3814 Jim_DecrRefCount(interp
, nameObjPtr
);
3820 * An efficient version of JimQualifyNameObj() where the name is
3821 * available (and needed) as a 'const char *'.
3822 * Avoids creating an object if not necessary.
3823 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3825 static const char *JimQualifyName(Jim_Interp
*interp
, const char *name
, Jim_Obj
**objPtrPtr
)
3827 Jim_Obj
*objPtr
= interp
->emptyObj
;
3829 if (name
[0] == ':' && name
[1] == ':') {
3830 /* This command is being defined in the global namespace */
3831 while (*++name
== ':') {
3834 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
3835 /* This command is being defined in a non-global namespace */
3836 objPtr
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
3837 Jim_AppendStrings(interp
, objPtr
, "::", name
, NULL
);
3838 name
= Jim_String(objPtr
);
3840 Jim_IncrRefCount(objPtr
);
3841 *objPtrPtr
= objPtr
;
3845 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3848 /* We can be more efficient in the no-namespace case */
3849 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3850 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3852 Jim_Obj
*Jim_MakeGlobalNamespaceName(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
)
3858 static int JimCreateCommand(Jim_Interp
*interp
, const char *name
, Jim_Cmd
*cmd
)
3860 /* It may already exist, so we try to delete the old one.
3861 * Note that reference count means that it won't be deleted yet if
3862 * it exists in the call stack.
3864 * BUT, if 'local' is in force, instead of deleting the existing
3865 * proc, we stash a reference to the old proc here.
3867 Jim_HashEntry
*he
= Jim_FindHashEntry(&interp
->commands
, name
);
3869 /* There was an old cmd with the same name,
3870 * so this requires a 'proc epoch' update. */
3872 /* If a procedure with the same name didn't exist there is no need
3873 * to increment the 'proc epoch' because creation of a new procedure
3874 * can never affect existing cached commands. We don't do
3875 * negative caching. */
3876 Jim_InterpIncrProcEpoch(interp
);
3879 if (he
&& interp
->local
) {
3880 /* Push this command over the top of the previous one */
3881 cmd
->prevCmd
= Jim_GetHashEntryVal(he
);
3882 Jim_SetHashVal(&interp
->commands
, he
, cmd
);
3886 /* Replace the existing command */
3887 Jim_DeleteHashEntry(&interp
->commands
, name
);
3890 Jim_AddHashEntry(&interp
->commands
, name
, cmd
);
3896 int Jim_CreateCommand(Jim_Interp
*interp
, const char *cmdNameStr
,
3897 Jim_CmdProc cmdProc
, void *privData
, Jim_DelCmdProc delProc
)
3899 Jim_Cmd
*cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
));
3901 /* Store the new details for this command */
3902 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
3904 cmdPtr
->u
.native
.delProc
= delProc
;
3905 cmdPtr
->u
.native
.cmdProc
= cmdProc
;
3906 cmdPtr
->u
.native
.privData
= privData
;
3908 JimCreateCommand(interp
, cmdNameStr
, cmdPtr
);
3913 static int JimCreateProcedureStatics(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, Jim_Obj
*staticsListObjPtr
)
3917 len
= Jim_ListLength(interp
, staticsListObjPtr
);
3922 cmdPtr
->u
.proc
.staticVars
= Jim_Alloc(sizeof(Jim_HashTable
));
3923 Jim_InitHashTable(cmdPtr
->u
.proc
.staticVars
, &JimVariablesHashTableType
, interp
);
3924 for (i
= 0; i
< len
; i
++) {
3925 Jim_Obj
*objPtr
, *initObjPtr
, *nameObjPtr
;
3929 objPtr
= Jim_ListGetIndex(interp
, staticsListObjPtr
, i
);
3930 /* Check if it's composed of two elements. */
3931 subLen
= Jim_ListLength(interp
, objPtr
);
3932 if (subLen
== 1 || subLen
== 2) {
3933 /* Try to get the variable value from the current
3935 nameObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 0);
3937 initObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, JIM_NONE
);
3938 if (initObjPtr
== NULL
) {
3939 Jim_SetResultFormatted(interp
,
3940 "variable for initialization of static \"%#s\" not found in the local context",
3946 initObjPtr
= Jim_ListGetIndex(interp
, objPtr
, 1);
3948 if (JimValidName(interp
, "static variable", nameObjPtr
) != JIM_OK
) {
3952 varPtr
= Jim_Alloc(sizeof(*varPtr
));
3953 varPtr
->objPtr
= initObjPtr
;
3954 Jim_IncrRefCount(initObjPtr
);
3955 varPtr
->linkFramePtr
= NULL
;
3956 if (Jim_AddHashEntry(cmdPtr
->u
.proc
.staticVars
,
3957 Jim_String(nameObjPtr
), varPtr
) != JIM_OK
) {
3958 Jim_SetResultFormatted(interp
,
3959 "static variable name \"%#s\" duplicated in statics list", nameObjPtr
);
3960 Jim_DecrRefCount(interp
, initObjPtr
);
3966 Jim_SetResultFormatted(interp
, "too many fields in static specifier \"%#s\"",
3974 static void JimUpdateProcNamespace(Jim_Interp
*interp
, Jim_Cmd
*cmdPtr
, const char *cmdname
)
3976 #ifdef jim_ext_namespace
3977 if (cmdPtr
->isproc
) {
3978 /* XXX: Really need JimNamespaceSplit() */
3979 const char *pt
= strrchr(cmdname
, ':');
3980 if (pt
&& pt
!= cmdname
&& pt
[-1] == ':') {
3981 Jim_DecrRefCount(interp
, cmdPtr
->u
.proc
.nsObj
);
3982 cmdPtr
->u
.proc
.nsObj
= Jim_NewStringObj(interp
, cmdname
, pt
- cmdname
- 1);
3983 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
3985 if (Jim_FindHashEntry(&interp
->commands
, pt
+ 1)) {
3986 /* This commands shadows a global command, so a proc epoch update is required */
3987 Jim_InterpIncrProcEpoch(interp
);
3994 static Jim_Cmd
*JimCreateProcedureCmd(Jim_Interp
*interp
, Jim_Obj
*argListObjPtr
,
3995 Jim_Obj
*staticsListObjPtr
, Jim_Obj
*bodyObjPtr
, Jim_Obj
*nsObj
)
4001 argListLen
= Jim_ListLength(interp
, argListObjPtr
);
4003 /* Allocate space for both the command pointer and the arg list */
4004 cmdPtr
= Jim_Alloc(sizeof(*cmdPtr
) + sizeof(struct Jim_ProcArg
) * argListLen
);
4005 memset(cmdPtr
, 0, sizeof(*cmdPtr
));
4008 cmdPtr
->u
.proc
.argListObjPtr
= argListObjPtr
;
4009 cmdPtr
->u
.proc
.argListLen
= argListLen
;
4010 cmdPtr
->u
.proc
.bodyObjPtr
= bodyObjPtr
;
4011 cmdPtr
->u
.proc
.argsPos
= -1;
4012 cmdPtr
->u
.proc
.arglist
= (struct Jim_ProcArg
*)(cmdPtr
+ 1);
4013 cmdPtr
->u
.proc
.nsObj
= nsObj
? nsObj
: interp
->emptyObj
;
4014 Jim_IncrRefCount(argListObjPtr
);
4015 Jim_IncrRefCount(bodyObjPtr
);
4016 Jim_IncrRefCount(cmdPtr
->u
.proc
.nsObj
);
4018 /* Create the statics hash table. */
4019 if (staticsListObjPtr
&& JimCreateProcedureStatics(interp
, cmdPtr
, staticsListObjPtr
) != JIM_OK
) {
4023 /* Parse the args out into arglist, validating as we go */
4024 /* Examine the argument list for default parameters and 'args' */
4025 for (i
= 0; i
< argListLen
; i
++) {
4027 Jim_Obj
*nameObjPtr
;
4028 Jim_Obj
*defaultObjPtr
;
4031 /* Examine a parameter */
4032 argPtr
= Jim_ListGetIndex(interp
, argListObjPtr
, i
);
4033 len
= Jim_ListLength(interp
, argPtr
);
4035 Jim_SetResultString(interp
, "argument with no name", -1);
4037 JimDecrCmdRefCount(interp
, cmdPtr
);
4041 Jim_SetResultFormatted(interp
, "too many fields in argument specifier \"%#s\"", argPtr
);
4046 /* Optional parameter */
4047 nameObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 0);
4048 defaultObjPtr
= Jim_ListGetIndex(interp
, argPtr
, 1);
4051 /* Required parameter */
4052 nameObjPtr
= argPtr
;
4053 defaultObjPtr
= NULL
;
4057 if (Jim_CompareStringImmediate(interp
, nameObjPtr
, "args")) {
4058 if (cmdPtr
->u
.proc
.argsPos
>= 0) {
4059 Jim_SetResultString(interp
, "'args' specified more than once", -1);
4062 cmdPtr
->u
.proc
.argsPos
= i
;
4066 cmdPtr
->u
.proc
.optArity
++;
4069 cmdPtr
->u
.proc
.reqArity
++;
4073 cmdPtr
->u
.proc
.arglist
[i
].nameObjPtr
= nameObjPtr
;
4074 cmdPtr
->u
.proc
.arglist
[i
].defaultObjPtr
= defaultObjPtr
;
4080 int Jim_DeleteCommand(Jim_Interp
*interp
, const char *name
)
4083 Jim_Obj
*qualifiedNameObj
;
4084 const char *qualname
= JimQualifyName(interp
, name
, &qualifiedNameObj
);
4086 if (Jim_DeleteHashEntry(&interp
->commands
, qualname
) == JIM_ERR
) {
4087 Jim_SetResultFormatted(interp
, "can't delete \"%s\": command doesn't exist", name
);
4091 Jim_InterpIncrProcEpoch(interp
);
4094 JimFreeQualifiedName(interp
, qualifiedNameObj
);
4099 int Jim_RenameCommand(Jim_Interp
*interp
, const char *oldName
, const char *newName
)
4104 Jim_Obj
*qualifiedOldNameObj
;
4105 Jim_Obj
*qualifiedNewNameObj
;
4109 if (newName
[0] == 0) {
4110 return Jim_DeleteCommand(interp
, oldName
);
4113 fqold
= JimQualifyName(interp
, oldName
, &qualifiedOldNameObj
);
4114 fqnew
= JimQualifyName(interp
, newName
, &qualifiedNewNameObj
);
4116 /* Does it exist? */
4117 he
= Jim_FindHashEntry(&interp
->commands
, fqold
);
4119 Jim_SetResultFormatted(interp
, "can't rename \"%s\": command doesn't exist", oldName
);
4121 else if (Jim_FindHashEntry(&interp
->commands
, fqnew
)) {
4122 Jim_SetResultFormatted(interp
, "can't rename to \"%s\": command already exists", newName
);
4125 /* Add the new name first */
4126 cmdPtr
= Jim_GetHashEntryVal(he
);
4127 JimIncrCmdRefCount(cmdPtr
);
4128 JimUpdateProcNamespace(interp
, cmdPtr
, fqnew
);
4129 Jim_AddHashEntry(&interp
->commands
, fqnew
, cmdPtr
);
4131 /* Now remove the old name */
4132 Jim_DeleteHashEntry(&interp
->commands
, fqold
);
4134 /* Increment the epoch */
4135 Jim_InterpIncrProcEpoch(interp
);
4140 JimFreeQualifiedName(interp
, qualifiedOldNameObj
);
4141 JimFreeQualifiedName(interp
, qualifiedNewNameObj
);
4146 /* -----------------------------------------------------------------------------
4148 * ---------------------------------------------------------------------------*/
4150 static void FreeCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4152 Jim_DecrRefCount(interp
, objPtr
->internalRep
.cmdValue
.nsObj
);
4155 static void DupCommandInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4157 dupPtr
->internalRep
.cmdValue
= srcPtr
->internalRep
.cmdValue
;
4158 dupPtr
->typePtr
= srcPtr
->typePtr
;
4159 Jim_IncrRefCount(dupPtr
->internalRep
.cmdValue
.nsObj
);
4162 static const Jim_ObjType commandObjType
= {
4164 FreeCommandInternalRep
,
4165 DupCommandInternalRep
,
4167 JIM_TYPE_REFERENCES
,
4170 /* This function returns the command structure for the command name
4171 * stored in objPtr. It tries to specialize the objPtr to contain
4172 * a cached info instead to perform the lookup into the hash table
4173 * every time. The information cached may not be uptodate, in such
4174 * a case the lookup is performed and the cache updated.
4176 * Respects the 'upcall' setting
4178 Jim_Cmd
*Jim_GetCommand(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4182 /* In order to be valid, the proc epoch must match and
4183 * the lookup must have occurred in the same namespace
4185 if (objPtr
->typePtr
!= &commandObjType
||
4186 objPtr
->internalRep
.cmdValue
.procEpoch
!= interp
->procEpoch
4187 #ifdef jim_ext_namespace
4188 || !Jim_StringEqObj(objPtr
->internalRep
.cmdValue
.nsObj
, interp
->framePtr
->nsObj
)
4191 /* Not cached or out of date, so lookup */
4193 /* Do we need to try the local namespace? */
4194 const char *name
= Jim_String(objPtr
);
4197 if (name
[0] == ':' && name
[1] == ':') {
4198 while (*++name
== ':') {
4201 #ifdef jim_ext_namespace
4202 else if (Jim_Length(interp
->framePtr
->nsObj
)) {
4203 /* This command is being defined in a non-global namespace */
4204 Jim_Obj
*nameObj
= Jim_DuplicateObj(interp
, interp
->framePtr
->nsObj
);
4205 Jim_AppendStrings(interp
, nameObj
, "::", name
, NULL
);
4206 he
= Jim_FindHashEntry(&interp
->commands
, Jim_String(nameObj
));
4207 Jim_FreeNewObj(interp
, nameObj
);
4214 /* Lookup in the global namespace */
4215 he
= Jim_FindHashEntry(&interp
->commands
, name
);
4217 if (flags
& JIM_ERRMSG
) {
4218 Jim_SetResultFormatted(interp
, "invalid command name \"%#s\"", objPtr
);
4222 #ifdef jim_ext_namespace
4225 cmd
= Jim_GetHashEntryVal(he
);
4227 /* Free the old internal repr and set the new one. */
4228 Jim_FreeIntRep(interp
, objPtr
);
4229 objPtr
->typePtr
= &commandObjType
;
4230 objPtr
->internalRep
.cmdValue
.procEpoch
= interp
->procEpoch
;
4231 objPtr
->internalRep
.cmdValue
.cmdPtr
= cmd
;
4232 objPtr
->internalRep
.cmdValue
.nsObj
= interp
->framePtr
->nsObj
;
4233 Jim_IncrRefCount(interp
->framePtr
->nsObj
);
4236 cmd
= objPtr
->internalRep
.cmdValue
.cmdPtr
;
4238 while (cmd
->u
.proc
.upcall
) {
4244 /* -----------------------------------------------------------------------------
4246 * ---------------------------------------------------------------------------*/
4248 /* -----------------------------------------------------------------------------
4250 * ---------------------------------------------------------------------------*/
4252 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4254 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
4256 static const Jim_ObjType variableObjType
= {
4261 JIM_TYPE_REFERENCES
,
4265 * Check that the name does not contain embedded nulls.
4267 * Variable and procedure names are maniplated as null terminated strings, so
4268 * don't allow names with embedded nulls.
4270 static int JimValidName(Jim_Interp
*interp
, const char *type
, Jim_Obj
*nameObjPtr
)
4272 /* Variable names and proc names can't contain embedded nulls */
4273 if (nameObjPtr
->typePtr
!= &variableObjType
) {
4275 const char *str
= Jim_GetString(nameObjPtr
, &len
);
4276 if (memchr(str
, '\0', len
)) {
4277 Jim_SetResultFormatted(interp
, "%s name contains embedded null", type
);
4284 /* This method should be called only by the variable API.
4285 * It returns JIM_OK on success (variable already exists),
4286 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4287 * a variable name, but syntax glue for [dict] i.e. the last
4288 * character is ')' */
4289 static int SetVariableFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
4291 const char *varName
;
4292 Jim_CallFrame
*framePtr
;
4297 /* Check if the object is already an uptodate variable */
4298 if (objPtr
->typePtr
== &variableObjType
) {
4299 framePtr
= objPtr
->internalRep
.varValue
.global
? interp
->topFramePtr
: interp
->framePtr
;
4300 if (objPtr
->internalRep
.varValue
.callFrameId
== framePtr
->id
) {
4304 /* Need to re-resolve the variable in the updated callframe */
4306 else if (objPtr
->typePtr
== &dictSubstObjType
) {
4307 return JIM_DICT_SUGAR
;
4309 else if (JimValidName(interp
, "variable", objPtr
) != JIM_OK
) {
4314 varName
= Jim_GetString(objPtr
, &len
);
4316 /* Make sure it's not syntax glue to get/set dict. */
4317 if (len
&& varName
[len
- 1] == ')' && strchr(varName
, '(') != NULL
) {
4318 return JIM_DICT_SUGAR
;
4321 if (varName
[0] == ':' && varName
[1] == ':') {
4322 while (*++varName
== ':') {
4325 framePtr
= interp
->topFramePtr
;
4329 framePtr
= interp
->framePtr
;
4332 /* Resolve this name in the variables hash table */
4333 he
= Jim_FindHashEntry(&framePtr
->vars
, varName
);
4335 if (!global
&& framePtr
->staticVars
) {
4336 /* Try with static vars. */
4337 he
= Jim_FindHashEntry(framePtr
->staticVars
, varName
);
4344 /* Free the old internal repr and set the new one. */
4345 Jim_FreeIntRep(interp
, objPtr
);
4346 objPtr
->typePtr
= &variableObjType
;
4347 objPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4348 objPtr
->internalRep
.varValue
.varPtr
= Jim_GetHashEntryVal(he
);
4349 objPtr
->internalRep
.varValue
.global
= global
;
4353 /* -------------------- Variables related functions ------------------------- */
4354 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, Jim_Obj
*valObjPtr
);
4355 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*ObjPtr
, int flags
);
4357 static Jim_Var
*JimCreateVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4360 Jim_CallFrame
*framePtr
;
4363 /* New variable to create */
4364 Jim_Var
*var
= Jim_Alloc(sizeof(*var
));
4366 var
->objPtr
= valObjPtr
;
4367 Jim_IncrRefCount(valObjPtr
);
4368 var
->linkFramePtr
= NULL
;
4370 name
= Jim_String(nameObjPtr
);
4371 if (name
[0] == ':' && name
[1] == ':') {
4372 while (*++name
== ':') {
4374 framePtr
= interp
->topFramePtr
;
4378 framePtr
= interp
->framePtr
;
4382 /* Insert the new variable */
4383 Jim_AddHashEntry(&framePtr
->vars
, name
, var
);
4385 /* Make the object int rep a variable */
4386 Jim_FreeIntRep(interp
, nameObjPtr
);
4387 nameObjPtr
->typePtr
= &variableObjType
;
4388 nameObjPtr
->internalRep
.varValue
.callFrameId
= framePtr
->id
;
4389 nameObjPtr
->internalRep
.varValue
.varPtr
= var
;
4390 nameObjPtr
->internalRep
.varValue
.global
= global
;
4395 /* For now that's dummy. Variables lookup should be optimized
4396 * in many ways, with caching of lookups, and possibly with
4397 * a table of pre-allocated vars in every CallFrame for local vars.
4398 * All the caching should also have an 'epoch' mechanism similar
4399 * to the one used by Tcl for procedures lookup caching. */
4401 int Jim_SetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, Jim_Obj
*valObjPtr
)
4406 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4407 case JIM_DICT_SUGAR
:
4408 return JimDictSugarSet(interp
, nameObjPtr
, valObjPtr
);
4411 if (JimValidName(interp
, "variable", nameObjPtr
) != JIM_OK
) {
4414 JimCreateVariable(interp
, nameObjPtr
, valObjPtr
);
4418 var
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4419 if (var
->linkFramePtr
== NULL
) {
4420 Jim_IncrRefCount(valObjPtr
);
4421 Jim_DecrRefCount(interp
, var
->objPtr
);
4422 var
->objPtr
= valObjPtr
;
4424 else { /* Else handle the link */
4425 Jim_CallFrame
*savedCallFrame
;
4427 savedCallFrame
= interp
->framePtr
;
4428 interp
->framePtr
= var
->linkFramePtr
;
4429 err
= Jim_SetVariable(interp
, var
->objPtr
, valObjPtr
);
4430 interp
->framePtr
= savedCallFrame
;
4438 int Jim_SetVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4440 Jim_Obj
*nameObjPtr
;
4443 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4444 Jim_IncrRefCount(nameObjPtr
);
4445 result
= Jim_SetVariable(interp
, nameObjPtr
, objPtr
);
4446 Jim_DecrRefCount(interp
, nameObjPtr
);
4450 int Jim_SetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, Jim_Obj
*objPtr
)
4452 Jim_CallFrame
*savedFramePtr
;
4455 savedFramePtr
= interp
->framePtr
;
4456 interp
->framePtr
= interp
->topFramePtr
;
4457 result
= Jim_SetVariableStr(interp
, name
, objPtr
);
4458 interp
->framePtr
= savedFramePtr
;
4462 int Jim_SetVariableStrWithStr(Jim_Interp
*interp
, const char *name
, const char *val
)
4464 Jim_Obj
*nameObjPtr
, *valObjPtr
;
4467 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4468 valObjPtr
= Jim_NewStringObj(interp
, val
, -1);
4469 Jim_IncrRefCount(nameObjPtr
);
4470 Jim_IncrRefCount(valObjPtr
);
4471 result
= Jim_SetVariable(interp
, nameObjPtr
, valObjPtr
);
4472 Jim_DecrRefCount(interp
, nameObjPtr
);
4473 Jim_DecrRefCount(interp
, valObjPtr
);
4477 int Jim_SetVariableLink(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
,
4478 Jim_Obj
*targetNameObjPtr
, Jim_CallFrame
*targetCallFrame
)
4480 const char *varName
;
4481 const char *targetName
;
4482 Jim_CallFrame
*framePtr
;
4485 /* Check for an existing variable or link */
4486 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4487 case JIM_DICT_SUGAR
:
4488 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4489 Jim_SetResultFormatted(interp
, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr
);
4493 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4495 if (varPtr
->linkFramePtr
== NULL
) {
4496 Jim_SetResultFormatted(interp
, "variable \"%#s\" already exists", nameObjPtr
);
4500 /* It exists, but is a link, so first delete the link */
4501 varPtr
->linkFramePtr
= NULL
;
4505 /* Resolve the call frames for both variables */
4506 /* XXX: SetVariableFromAny() already did this! */
4507 varName
= Jim_String(nameObjPtr
);
4509 if (varName
[0] == ':' && varName
[1] == ':') {
4510 while (*++varName
== ':') {
4512 /* Linking a global var does nothing */
4513 framePtr
= interp
->topFramePtr
;
4516 framePtr
= interp
->framePtr
;
4519 targetName
= Jim_String(targetNameObjPtr
);
4520 if (targetName
[0] == ':' && targetName
[1] == ':') {
4521 while (*++targetName
== ':') {
4523 targetNameObjPtr
= Jim_NewStringObj(interp
, targetName
, -1);
4524 targetCallFrame
= interp
->topFramePtr
;
4526 Jim_IncrRefCount(targetNameObjPtr
);
4528 if (framePtr
->level
< targetCallFrame
->level
) {
4529 Jim_SetResultFormatted(interp
,
4530 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4532 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4536 /* Check for cycles. */
4537 if (framePtr
== targetCallFrame
) {
4538 Jim_Obj
*objPtr
= targetNameObjPtr
;
4540 /* Cycles are only possible with 'uplevel 0' */
4542 if (strcmp(Jim_String(objPtr
), varName
) == 0) {
4543 Jim_SetResultString(interp
, "can't upvar from variable to itself", -1);
4544 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4547 if (SetVariableFromAny(interp
, objPtr
) != JIM_OK
)
4549 varPtr
= objPtr
->internalRep
.varValue
.varPtr
;
4550 if (varPtr
->linkFramePtr
!= targetCallFrame
)
4552 objPtr
= varPtr
->objPtr
;
4556 /* Perform the binding */
4557 Jim_SetVariable(interp
, nameObjPtr
, targetNameObjPtr
);
4558 /* We are now sure 'nameObjPtr' type is variableObjType */
4559 nameObjPtr
->internalRep
.varValue
.varPtr
->linkFramePtr
= targetCallFrame
;
4560 Jim_DecrRefCount(interp
, targetNameObjPtr
);
4564 /* Return the Jim_Obj pointer associated with a variable name,
4565 * or NULL if the variable was not found in the current context.
4566 * The same optimization discussed in the comment to the
4567 * 'SetVariable' function should apply here.
4569 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4570 * in a dictionary which is shared, the array variable value is duplicated first.
4571 * This allows the array element to be updated (e.g. append, lappend) without
4572 * affecting other references to the dictionary.
4574 Jim_Obj
*Jim_GetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4576 switch (SetVariableFromAny(interp
, nameObjPtr
)) {
4578 Jim_Var
*varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4580 if (varPtr
->linkFramePtr
== NULL
) {
4581 return varPtr
->objPtr
;
4586 /* The variable is a link? Resolve it. */
4587 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
4589 interp
->framePtr
= varPtr
->linkFramePtr
;
4590 objPtr
= Jim_GetVariable(interp
, varPtr
->objPtr
, flags
);
4591 interp
->framePtr
= savedCallFrame
;
4595 /* Error, so fall through to the error message */
4600 case JIM_DICT_SUGAR
:
4601 /* [dict] syntax sugar. */
4602 return JimDictSugarGet(interp
, nameObjPtr
, flags
);
4604 if (flags
& JIM_ERRMSG
) {
4605 Jim_SetResultFormatted(interp
, "can't read \"%#s\": no such variable", nameObjPtr
);
4610 Jim_Obj
*Jim_GetGlobalVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4612 Jim_CallFrame
*savedFramePtr
;
4615 savedFramePtr
= interp
->framePtr
;
4616 interp
->framePtr
= interp
->topFramePtr
;
4617 objPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4618 interp
->framePtr
= savedFramePtr
;
4623 Jim_Obj
*Jim_GetVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4625 Jim_Obj
*nameObjPtr
, *varObjPtr
;
4627 nameObjPtr
= Jim_NewStringObj(interp
, name
, -1);
4628 Jim_IncrRefCount(nameObjPtr
);
4629 varObjPtr
= Jim_GetVariable(interp
, nameObjPtr
, flags
);
4630 Jim_DecrRefCount(interp
, nameObjPtr
);
4634 Jim_Obj
*Jim_GetGlobalVariableStr(Jim_Interp
*interp
, const char *name
, int flags
)
4636 Jim_CallFrame
*savedFramePtr
;
4639 savedFramePtr
= interp
->framePtr
;
4640 interp
->framePtr
= interp
->topFramePtr
;
4641 objPtr
= Jim_GetVariableStr(interp
, name
, flags
);
4642 interp
->framePtr
= savedFramePtr
;
4647 /* Unset a variable.
4648 * Note: On success unset invalidates all the variable objects created
4649 * in the current call frame incrementing. */
4650 int Jim_UnsetVariable(Jim_Interp
*interp
, Jim_Obj
*nameObjPtr
, int flags
)
4654 Jim_CallFrame
*framePtr
;
4656 retval
= SetVariableFromAny(interp
, nameObjPtr
);
4657 if (retval
== JIM_DICT_SUGAR
) {
4658 /* [dict] syntax sugar. */
4659 return JimDictSugarSet(interp
, nameObjPtr
, NULL
);
4661 else if (retval
== JIM_OK
) {
4662 varPtr
= nameObjPtr
->internalRep
.varValue
.varPtr
;
4664 /* If it's a link call UnsetVariable recursively */
4665 if (varPtr
->linkFramePtr
) {
4666 framePtr
= interp
->framePtr
;
4667 interp
->framePtr
= varPtr
->linkFramePtr
;
4668 retval
= Jim_UnsetVariable(interp
, varPtr
->objPtr
, JIM_NONE
);
4669 interp
->framePtr
= framePtr
;
4672 const char *name
= Jim_String(nameObjPtr
);
4673 if (nameObjPtr
->internalRep
.varValue
.global
) {
4675 framePtr
= interp
->topFramePtr
;
4678 framePtr
= interp
->framePtr
;
4681 retval
= Jim_DeleteHashEntry(&framePtr
->vars
, name
);
4682 if (retval
== JIM_OK
) {
4683 /* Change the callframe id, invalidating var lookup caching */
4684 framePtr
->id
= interp
->callFrameEpoch
++;
4688 if (retval
!= JIM_OK
&& (flags
& JIM_ERRMSG
)) {
4689 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such variable", nameObjPtr
);
4694 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4696 /* Given a variable name for [dict] operation syntax sugar,
4697 * this function returns two objects, the first with the name
4698 * of the variable to set, and the second with the rispective key.
4699 * For example "foo(bar)" will return objects with string repr. of
4702 * The returned objects have refcount = 1. The function can't fail. */
4703 static void JimDictSugarParseVarKey(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
4704 Jim_Obj
**varPtrPtr
, Jim_Obj
**keyPtrPtr
)
4706 const char *str
, *p
;
4708 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4710 str
= Jim_GetString(objPtr
, &len
);
4712 p
= strchr(str
, '(');
4713 JimPanic((p
== NULL
, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str
));
4715 varObjPtr
= Jim_NewStringObj(interp
, str
, p
- str
);
4718 keyLen
= (str
+ len
) - p
;
4719 if (str
[len
- 1] == ')') {
4723 /* Create the objects with the variable name and key. */
4724 keyObjPtr
= Jim_NewStringObj(interp
, p
, keyLen
);
4726 Jim_IncrRefCount(varObjPtr
);
4727 Jim_IncrRefCount(keyObjPtr
);
4728 *varPtrPtr
= varObjPtr
;
4729 *keyPtrPtr
= keyObjPtr
;
4732 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4733 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4734 static int JimDictSugarSet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*valObjPtr
)
4738 SetDictSubstFromAny(interp
, objPtr
);
4740 err
= Jim_SetDictKeysVector(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4741 &objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, 1, valObjPtr
, JIM_MUSTEXIST
);
4743 if (err
== JIM_OK
) {
4744 /* Don't keep an extra ref to the result */
4745 Jim_SetEmptyResult(interp
);
4749 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4750 if (Jim_GetVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
, JIM_NONE
)) {
4751 Jim_SetResultFormatted(interp
, "can't unset \"%#s\": no such element in array",
4756 /* Make the error more informative and Tcl-compatible */
4757 Jim_SetResultFormatted(interp
, "can't %s \"%#s\": variable isn't array",
4758 (valObjPtr
? "set" : "unset"), objPtr
);
4764 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4766 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4767 * and stored back to the variable before expansion.
4769 static Jim_Obj
*JimDictExpandArrayVariable(Jim_Interp
*interp
, Jim_Obj
*varObjPtr
,
4770 Jim_Obj
*keyObjPtr
, int flags
)
4772 Jim_Obj
*dictObjPtr
;
4773 Jim_Obj
*resObjPtr
= NULL
;
4776 dictObjPtr
= Jim_GetVariable(interp
, varObjPtr
, JIM_ERRMSG
);
4781 ret
= Jim_DictKey(interp
, dictObjPtr
, keyObjPtr
, &resObjPtr
, JIM_NONE
);
4782 if (ret
!= JIM_OK
) {
4783 Jim_SetResultFormatted(interp
,
4784 "can't read \"%#s(%#s)\": %s array", varObjPtr
, keyObjPtr
,
4785 ret
< 0 ? "variable isn't" : "no such element in");
4787 else if ((flags
& JIM_UNSHARED
) && Jim_IsShared(dictObjPtr
)) {
4788 /* Update the variable to have an unshared copy */
4789 Jim_SetVariable(interp
, varObjPtr
, Jim_DuplicateObj(interp
, dictObjPtr
));
4795 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4796 static Jim_Obj
*JimDictSugarGet(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
4798 SetDictSubstFromAny(interp
, objPtr
);
4800 return JimDictExpandArrayVariable(interp
,
4801 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4802 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
, flags
);
4805 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4807 void FreeDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4809 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
);
4810 Jim_DecrRefCount(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
);
4813 void DupDictSubstInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
4815 JIM_NOTUSED(interp
);
4817 dupPtr
->internalRep
.dictSubstValue
.varNameObjPtr
=
4818 srcPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4819 dupPtr
->internalRep
.dictSubstValue
.indexObjPtr
= srcPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4820 dupPtr
->typePtr
= &dictSubstObjType
;
4823 /* Note: The object *must* be in dict-sugar format */
4824 static void SetDictSubstFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4826 if (objPtr
->typePtr
!= &dictSubstObjType
) {
4827 Jim_Obj
*varObjPtr
, *keyObjPtr
;
4829 if (objPtr
->typePtr
== &interpolatedObjType
) {
4830 /* An interpolated object in dict-sugar form */
4832 varObjPtr
= objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
;
4833 keyObjPtr
= objPtr
->internalRep
.dictSubstValue
.indexObjPtr
;
4835 Jim_IncrRefCount(varObjPtr
);
4836 Jim_IncrRefCount(keyObjPtr
);
4839 JimDictSugarParseVarKey(interp
, objPtr
, &varObjPtr
, &keyObjPtr
);
4842 Jim_FreeIntRep(interp
, objPtr
);
4843 objPtr
->typePtr
= &dictSubstObjType
;
4844 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= varObjPtr
;
4845 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= keyObjPtr
;
4849 /* This function is used to expand [dict get] sugar in the form
4850 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4851 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4852 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4853 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4854 * the [dict]ionary contained in variable VARNAME. */
4855 static Jim_Obj
*JimExpandDictSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4857 Jim_Obj
*resObjPtr
= NULL
;
4858 Jim_Obj
*substKeyObjPtr
= NULL
;
4860 SetDictSubstFromAny(interp
, objPtr
);
4862 if (Jim_SubstObj(interp
, objPtr
->internalRep
.dictSubstValue
.indexObjPtr
,
4863 &substKeyObjPtr
, JIM_NONE
)
4867 Jim_IncrRefCount(substKeyObjPtr
);
4869 JimDictExpandArrayVariable(interp
, objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
,
4871 Jim_DecrRefCount(interp
, substKeyObjPtr
);
4876 static Jim_Obj
*JimExpandExprSugar(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
4878 Jim_Obj
*resultObjPtr
;
4880 if (Jim_EvalExpression(interp
, objPtr
, &resultObjPtr
) == JIM_OK
) {
4881 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4882 resultObjPtr
->refCount
--;
4883 return resultObjPtr
;
4888 /* -----------------------------------------------------------------------------
4890 * ---------------------------------------------------------------------------*/
4892 static Jim_CallFrame
*JimCreateCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*parent
, Jim_Obj
*nsObj
)
4896 if (interp
->freeFramesList
) {
4897 cf
= interp
->freeFramesList
;
4898 interp
->freeFramesList
= cf
->next
;
4902 cf
->procArgsObjPtr
= NULL
;
4903 cf
->procBodyObjPtr
= NULL
;
4905 cf
->staticVars
= NULL
;
4906 cf
->localCommands
= NULL
;
4908 cf
->tailcallObj
= NULL
;
4909 cf
->tailcallCmd
= NULL
;
4912 cf
= Jim_Alloc(sizeof(*cf
));
4913 memset(cf
, 0, sizeof(*cf
));
4915 Jim_InitHashTable(&cf
->vars
, &JimVariablesHashTableType
, interp
);
4918 cf
->id
= interp
->callFrameEpoch
++;
4919 cf
->parent
= parent
;
4920 cf
->level
= parent
? parent
->level
+ 1 : 0;
4922 Jim_IncrRefCount(nsObj
);
4927 static int JimDeleteLocalProcs(Jim_Interp
*interp
, Jim_Stack
*localCommands
)
4929 /* Delete any local procs */
4930 if (localCommands
) {
4931 Jim_Obj
*cmdNameObj
;
4933 while ((cmdNameObj
= Jim_StackPop(localCommands
)) != NULL
) {
4936 Jim_HashTable
*ht
= &interp
->commands
;
4938 const char *fqname
= JimQualifyName(interp
, Jim_String(cmdNameObj
), &fqObjName
);
4940 he
= Jim_FindHashEntry(ht
, fqname
);
4943 Jim_Cmd
*cmd
= Jim_GetHashEntryVal(he
);
4945 Jim_Cmd
*prevCmd
= cmd
->prevCmd
;
4946 cmd
->prevCmd
= NULL
;
4948 /* Delete the old command */
4949 JimDecrCmdRefCount(interp
, cmd
);
4951 /* And restore the original */
4952 Jim_SetHashVal(ht
, he
, prevCmd
);
4955 Jim_DeleteHashEntry(ht
, fqname
);
4956 Jim_InterpIncrProcEpoch(interp
);
4959 Jim_DecrRefCount(interp
, cmdNameObj
);
4960 JimFreeQualifiedName(interp
, fqObjName
);
4962 Jim_FreeStack(localCommands
);
4963 Jim_Free(localCommands
);
4969 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4970 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4971 static void JimFreeCallFrame(Jim_Interp
*interp
, Jim_CallFrame
*cf
, int action
)
4973 JimDeleteLocalProcs(interp
, cf
->localCommands
);
4975 if (cf
->procArgsObjPtr
)
4976 Jim_DecrRefCount(interp
, cf
->procArgsObjPtr
);
4977 if (cf
->procBodyObjPtr
)
4978 Jim_DecrRefCount(interp
, cf
->procBodyObjPtr
);
4979 Jim_DecrRefCount(interp
, cf
->nsObj
);
4980 if (action
== JIM_FCF_FULL
|| cf
->vars
.size
!= JIM_HT_INITIAL_SIZE
)
4981 Jim_FreeHashTable(&cf
->vars
);
4984 Jim_HashEntry
**table
= cf
->vars
.table
, *he
;
4986 for (i
= 0; i
< JIM_HT_INITIAL_SIZE
; i
++) {
4988 while (he
!= NULL
) {
4989 Jim_HashEntry
*nextEntry
= he
->next
;
4990 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
4992 Jim_DecrRefCount(interp
, varPtr
->objPtr
);
4993 Jim_Free(Jim_GetHashEntryKey(he
));
5002 cf
->next
= interp
->freeFramesList
;
5003 interp
->freeFramesList
= cf
;
5007 /* -----------------------------------------------------------------------------
5009 * ---------------------------------------------------------------------------*/
5010 #ifdef JIM_REFERENCES
5012 /* References HashTable Type.
5014 * Keys are unsigned long integers, dynamically allocated for now but in the
5015 * future it's worth to cache this 4 bytes objects. Values are pointers
5016 * to Jim_References. */
5017 static void JimReferencesHTValDestructor(void *interp
, void *val
)
5019 Jim_Reference
*refPtr
= (void *)val
;
5021 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
5022 if (refPtr
->finalizerCmdNamePtr
!= NULL
) {
5023 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5028 static unsigned int JimReferencesHTHashFunction(const void *key
)
5030 /* Only the least significant bits are used. */
5031 const unsigned long *widePtr
= key
;
5032 unsigned int intValue
= (unsigned int)*widePtr
;
5034 return Jim_IntHashFunction(intValue
);
5037 static void *JimReferencesHTKeyDup(void *privdata
, const void *key
)
5039 void *copy
= Jim_Alloc(sizeof(unsigned long));
5041 JIM_NOTUSED(privdata
);
5043 memcpy(copy
, key
, sizeof(unsigned long));
5047 static int JimReferencesHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
5049 JIM_NOTUSED(privdata
);
5051 return memcmp(key1
, key2
, sizeof(unsigned long)) == 0;
5054 static void JimReferencesHTKeyDestructor(void *privdata
, void *key
)
5056 JIM_NOTUSED(privdata
);
5061 static const Jim_HashTableType JimReferencesHashTableType
= {
5062 JimReferencesHTHashFunction
, /* hash function */
5063 JimReferencesHTKeyDup
, /* key dup */
5065 JimReferencesHTKeyCompare
, /* key compare */
5066 JimReferencesHTKeyDestructor
, /* key destructor */
5067 JimReferencesHTValDestructor
/* val destructor */
5070 /* -----------------------------------------------------------------------------
5071 * Reference object type and References API
5072 * ---------------------------------------------------------------------------*/
5074 /* The string representation of references has two features in order
5075 * to make the GC faster. The first is that every reference starts
5076 * with a non common character '<', in order to make the string matching
5077 * faster. The second is that the reference string rep is 42 characters
5078 * in length, this means that it is not necessary to check any object with a string
5079 * repr < 42, and usually there aren't many of these objects. */
5081 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5083 static int JimFormatReference(char *buf
, Jim_Reference
*refPtr
, unsigned long id
)
5085 const char *fmt
= "<reference.<%s>.%020lu>";
5087 sprintf(buf
, fmt
, refPtr
->tag
, id
);
5088 return JIM_REFERENCE_SPACE
;
5091 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
);
5093 static const Jim_ObjType referenceObjType
= {
5097 UpdateStringOfReference
,
5098 JIM_TYPE_REFERENCES
,
5101 static void UpdateStringOfReference(struct Jim_Obj
*objPtr
)
5103 char buf
[JIM_REFERENCE_SPACE
+ 1];
5105 JimFormatReference(buf
, objPtr
->internalRep
.refValue
.refPtr
, objPtr
->internalRep
.refValue
.id
);
5106 JimSetStringBytes(objPtr
, buf
);
5109 /* returns true if 'c' is a valid reference tag character.
5110 * i.e. inside the range [_a-zA-Z0-9] */
5111 static int isrefchar(int c
)
5113 return (c
== '_' || isalnum(c
));
5116 static int SetReferenceFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5118 unsigned long value
;
5120 const char *str
, *start
, *end
;
5122 Jim_Reference
*refPtr
;
5126 /* Get the string representation */
5127 str
= Jim_GetString(objPtr
, &len
);
5128 /* Check if it looks like a reference */
5129 if (len
< JIM_REFERENCE_SPACE
)
5133 end
= str
+ len
- 1;
5134 while (*start
== ' ')
5136 while (*end
== ' ' && end
> start
)
5138 if (end
- start
+ 1 != JIM_REFERENCE_SPACE
)
5140 /* <reference.<1234567>.%020> */
5141 if (memcmp(start
, "<reference.<", 12) != 0)
5143 if (start
[12 + JIM_REFERENCE_TAGLEN
] != '>' || end
[0] != '>')
5145 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5146 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5147 if (!isrefchar(start
[12 + i
]))
5150 /* Extract info from the reference. */
5151 memcpy(refId
, start
+ 14 + JIM_REFERENCE_TAGLEN
, 20);
5153 /* Try to convert the ID into an unsigned long */
5154 value
= strtoul(refId
, &endptr
, 10);
5155 if (JimCheckConversion(refId
, endptr
) != JIM_OK
)
5157 /* Check if the reference really exists! */
5158 he
= Jim_FindHashEntry(&interp
->references
, &value
);
5160 Jim_SetResultFormatted(interp
, "invalid reference id \"%#s\"", objPtr
);
5163 refPtr
= Jim_GetHashEntryVal(he
);
5164 /* Free the old internal repr and set the new one. */
5165 Jim_FreeIntRep(interp
, objPtr
);
5166 objPtr
->typePtr
= &referenceObjType
;
5167 objPtr
->internalRep
.refValue
.id
= value
;
5168 objPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5172 Jim_SetResultFormatted(interp
, "expected reference but got \"%#s\"", objPtr
);
5176 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5177 * as finalizer command (or NULL if there is no finalizer).
5178 * The returned reference object has refcount = 0. */
5179 Jim_Obj
*Jim_NewReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*tagPtr
, Jim_Obj
*cmdNamePtr
)
5181 struct Jim_Reference
*refPtr
;
5187 /* Perform the Garbage Collection if needed. */
5188 Jim_CollectIfNeeded(interp
);
5190 refPtr
= Jim_Alloc(sizeof(*refPtr
));
5191 refPtr
->objPtr
= objPtr
;
5192 Jim_IncrRefCount(objPtr
);
5193 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5195 Jim_IncrRefCount(cmdNamePtr
);
5196 id
= interp
->referenceNextId
++;
5197 Jim_AddHashEntry(&interp
->references
, &id
, refPtr
);
5198 refObjPtr
= Jim_NewObj(interp
);
5199 refObjPtr
->typePtr
= &referenceObjType
;
5200 refObjPtr
->bytes
= NULL
;
5201 refObjPtr
->internalRep
.refValue
.id
= id
;
5202 refObjPtr
->internalRep
.refValue
.refPtr
= refPtr
;
5203 interp
->referenceNextId
++;
5204 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5205 * that does not pass the 'isrefchar' test is replaced with '_' */
5206 tag
= Jim_GetString(tagPtr
, &tagLen
);
5207 if (tagLen
> JIM_REFERENCE_TAGLEN
)
5208 tagLen
= JIM_REFERENCE_TAGLEN
;
5209 for (i
= 0; i
< JIM_REFERENCE_TAGLEN
; i
++) {
5210 if (i
< tagLen
&& isrefchar(tag
[i
]))
5211 refPtr
->tag
[i
] = tag
[i
];
5213 refPtr
->tag
[i
] = '_';
5215 refPtr
->tag
[JIM_REFERENCE_TAGLEN
] = '\0';
5219 Jim_Reference
*Jim_GetReference(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5221 if (objPtr
->typePtr
!= &referenceObjType
&& SetReferenceFromAny(interp
, objPtr
) == JIM_ERR
)
5223 return objPtr
->internalRep
.refValue
.refPtr
;
5226 int Jim_SetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*cmdNamePtr
)
5228 Jim_Reference
*refPtr
;
5230 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5232 Jim_IncrRefCount(cmdNamePtr
);
5233 if (refPtr
->finalizerCmdNamePtr
)
5234 Jim_DecrRefCount(interp
, refPtr
->finalizerCmdNamePtr
);
5235 refPtr
->finalizerCmdNamePtr
= cmdNamePtr
;
5239 int Jim_GetFinalizer(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
**cmdNamePtrPtr
)
5241 Jim_Reference
*refPtr
;
5243 if ((refPtr
= Jim_GetReference(interp
, objPtr
)) == NULL
)
5245 *cmdNamePtrPtr
= refPtr
->finalizerCmdNamePtr
;
5249 /* -----------------------------------------------------------------------------
5250 * References Garbage Collection
5251 * ---------------------------------------------------------------------------*/
5253 /* This the hash table type for the "MARK" phase of the GC */
5254 static const Jim_HashTableType JimRefMarkHashTableType
= {
5255 JimReferencesHTHashFunction
, /* hash function */
5256 JimReferencesHTKeyDup
, /* key dup */
5258 JimReferencesHTKeyCompare
, /* key compare */
5259 JimReferencesHTKeyDestructor
, /* key destructor */
5260 NULL
/* val destructor */
5263 /* Performs the garbage collection. */
5264 int Jim_Collect(Jim_Interp
*interp
)
5267 #ifndef JIM_BOOTSTRAP
5268 Jim_HashTable marks
;
5269 Jim_HashTableIterator htiter
;
5273 /* Avoid recursive calls */
5274 if (interp
->lastCollectId
== -1) {
5275 /* Jim_Collect() already running. Return just now. */
5278 interp
->lastCollectId
= -1;
5280 /* Mark all the references found into the 'mark' hash table.
5281 * The references are searched in every live object that
5282 * is of a type that can contain references. */
5283 Jim_InitHashTable(&marks
, &JimRefMarkHashTableType
, NULL
);
5284 objPtr
= interp
->liveList
;
5286 if (objPtr
->typePtr
== NULL
|| objPtr
->typePtr
->flags
& JIM_TYPE_REFERENCES
) {
5287 const char *str
, *p
;
5290 /* If the object is of type reference, to get the
5291 * Id is simple... */
5292 if (objPtr
->typePtr
== &referenceObjType
) {
5293 Jim_AddHashEntry(&marks
, &objPtr
->internalRep
.refValue
.id
, NULL
);
5295 printf("MARK (reference): %d refcount: %d\n",
5296 (int)objPtr
->internalRep
.refValue
.id
, objPtr
->refCount
);
5298 objPtr
= objPtr
->nextObjPtr
;
5301 /* Get the string repr of the object we want
5302 * to scan for references. */
5303 p
= str
= Jim_GetString(objPtr
, &len
);
5304 /* Skip objects too little to contain references. */
5305 if (len
< JIM_REFERENCE_SPACE
) {
5306 objPtr
= objPtr
->nextObjPtr
;
5309 /* Extract references from the object string repr. */
5314 if ((p
= strstr(p
, "<reference.<")) == NULL
)
5316 /* Check if it's a valid reference. */
5317 if (len
- (p
- str
) < JIM_REFERENCE_SPACE
)
5319 if (p
[41] != '>' || p
[19] != '>' || p
[20] != '.')
5321 for (i
= 21; i
<= 40; i
++)
5322 if (!isdigit(UCHAR(p
[i
])))
5325 id
= strtoul(p
+ 21, NULL
, 10);
5327 /* Ok, a reference for the given ID
5328 * was found. Mark it. */
5329 Jim_AddHashEntry(&marks
, &id
, NULL
);
5331 printf("MARK: %d\n", (int)id
);
5333 p
+= JIM_REFERENCE_SPACE
;
5336 objPtr
= objPtr
->nextObjPtr
;
5339 /* Run the references hash table to destroy every reference that
5340 * is not referenced outside (not present in the mark HT). */
5341 JimInitHashTableIterator(&interp
->references
, &htiter
);
5342 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
5343 const unsigned long *refId
;
5344 Jim_Reference
*refPtr
;
5347 /* Check if in the mark phase we encountered
5348 * this reference. */
5349 if (Jim_FindHashEntry(&marks
, refId
) == NULL
) {
5351 printf("COLLECTING %d\n", (int)*refId
);
5354 /* Drop the reference, but call the
5355 * finalizer first if registered. */
5356 refPtr
= Jim_GetHashEntryVal(he
);
5357 if (refPtr
->finalizerCmdNamePtr
) {
5358 char *refstr
= Jim_Alloc(JIM_REFERENCE_SPACE
+ 1);
5359 Jim_Obj
*objv
[3], *oldResult
;
5361 JimFormatReference(refstr
, refPtr
, *refId
);
5363 objv
[0] = refPtr
->finalizerCmdNamePtr
;
5364 objv
[1] = Jim_NewStringObjNoAlloc(interp
, refstr
, JIM_REFERENCE_SPACE
);
5365 objv
[2] = refPtr
->objPtr
;
5367 /* Drop the reference itself */
5368 /* Avoid the finaliser being freed here */
5369 Jim_IncrRefCount(objv
[0]);
5370 /* Don't remove the reference from the hash table just yet
5371 * since that will free refPtr, and hence refPtr->objPtr
5374 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5375 oldResult
= interp
->result
;
5376 Jim_IncrRefCount(oldResult
);
5377 Jim_EvalObjVector(interp
, 3, objv
);
5378 Jim_SetResult(interp
, oldResult
);
5379 Jim_DecrRefCount(interp
, oldResult
);
5381 Jim_DecrRefCount(interp
, objv
[0]);
5383 Jim_DeleteHashEntry(&interp
->references
, refId
);
5386 Jim_FreeHashTable(&marks
);
5387 interp
->lastCollectId
= interp
->referenceNextId
;
5388 interp
->lastCollectTime
= time(NULL
);
5389 #endif /* JIM_BOOTSTRAP */
5393 #define JIM_COLLECT_ID_PERIOD 5000
5394 #define JIM_COLLECT_TIME_PERIOD 300
5396 void Jim_CollectIfNeeded(Jim_Interp
*interp
)
5398 unsigned long elapsedId
;
5401 elapsedId
= interp
->referenceNextId
- interp
->lastCollectId
;
5402 elapsedTime
= time(NULL
) - interp
->lastCollectTime
;
5405 if (elapsedId
> JIM_COLLECT_ID_PERIOD
|| elapsedTime
> JIM_COLLECT_TIME_PERIOD
) {
5406 Jim_Collect(interp
);
5411 int Jim_IsBigEndian(void)
5418 return uval
.c
[0] == 1;
5421 /* -----------------------------------------------------------------------------
5422 * Interpreter related functions
5423 * ---------------------------------------------------------------------------*/
5425 Jim_Interp
*Jim_CreateInterp(void)
5427 Jim_Interp
*i
= Jim_Alloc(sizeof(*i
));
5429 memset(i
, 0, sizeof(*i
));
5431 i
->maxCallFrameDepth
= JIM_MAX_CALLFRAME_DEPTH
;
5432 i
->maxEvalDepth
= JIM_MAX_EVAL_DEPTH
;
5433 i
->lastCollectTime
= time(NULL
);
5435 /* Note that we can create objects only after the
5436 * interpreter liveList and freeList pointers are
5437 * initialized to NULL. */
5438 Jim_InitHashTable(&i
->commands
, &JimCommandsHashTableType
, i
);
5439 #ifdef JIM_REFERENCES
5440 Jim_InitHashTable(&i
->references
, &JimReferencesHashTableType
, i
);
5442 Jim_InitHashTable(&i
->assocData
, &JimAssocDataHashTableType
, i
);
5443 Jim_InitHashTable(&i
->packages
, &JimPackageHashTableType
, NULL
);
5444 i
->emptyObj
= Jim_NewEmptyStringObj(i
);
5445 i
->trueObj
= Jim_NewIntObj(i
, 1);
5446 i
->falseObj
= Jim_NewIntObj(i
, 0);
5447 i
->framePtr
= i
->topFramePtr
= JimCreateCallFrame(i
, NULL
, i
->emptyObj
);
5448 i
->errorFileNameObj
= i
->emptyObj
;
5449 i
->result
= i
->emptyObj
;
5450 i
->stackTrace
= Jim_NewListObj(i
, NULL
, 0);
5451 i
->unknown
= Jim_NewStringObj(i
, "unknown", -1);
5452 i
->errorProc
= i
->emptyObj
;
5453 i
->currentScriptObj
= Jim_NewEmptyStringObj(i
);
5454 i
->nullScriptObj
= Jim_NewEmptyStringObj(i
);
5455 Jim_IncrRefCount(i
->emptyObj
);
5456 Jim_IncrRefCount(i
->errorFileNameObj
);
5457 Jim_IncrRefCount(i
->result
);
5458 Jim_IncrRefCount(i
->stackTrace
);
5459 Jim_IncrRefCount(i
->unknown
);
5460 Jim_IncrRefCount(i
->currentScriptObj
);
5461 Jim_IncrRefCount(i
->nullScriptObj
);
5462 Jim_IncrRefCount(i
->errorProc
);
5463 Jim_IncrRefCount(i
->trueObj
);
5464 Jim_IncrRefCount(i
->falseObj
);
5466 /* Initialize key variables every interpreter should contain */
5467 Jim_SetVariableStrWithStr(i
, JIM_LIBPATH
, TCL_LIBRARY
);
5468 Jim_SetVariableStrWithStr(i
, JIM_INTERACTIVE
, "0");
5470 Jim_SetVariableStrWithStr(i
, "tcl_platform(os)", TCL_PLATFORM_OS
);
5471 Jim_SetVariableStrWithStr(i
, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM
);
5472 Jim_SetVariableStrWithStr(i
, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR
);
5473 Jim_SetVariableStrWithStr(i
, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5474 Jim_SetVariableStrWithStr(i
, "tcl_platform(threaded)", "0");
5475 Jim_SetVariableStr(i
, "tcl_platform(pointerSize)", Jim_NewIntObj(i
, sizeof(void *)));
5476 Jim_SetVariableStr(i
, "tcl_platform(wordSize)", Jim_NewIntObj(i
, sizeof(jim_wide
)));
5481 void Jim_FreeInterp(Jim_Interp
*i
)
5483 Jim_CallFrame
*cf
, *cfx
;
5485 Jim_Obj
*objPtr
, *nextObjPtr
;
5487 /* Free the active call frames list - must be done before i->commands is destroyed */
5488 for (cf
= i
->framePtr
; cf
; cf
= cfx
) {
5490 JimFreeCallFrame(i
, cf
, JIM_FCF_FULL
);
5493 Jim_DecrRefCount(i
, i
->emptyObj
);
5494 Jim_DecrRefCount(i
, i
->trueObj
);
5495 Jim_DecrRefCount(i
, i
->falseObj
);
5496 Jim_DecrRefCount(i
, i
->result
);
5497 Jim_DecrRefCount(i
, i
->stackTrace
);
5498 Jim_DecrRefCount(i
, i
->errorProc
);
5499 Jim_DecrRefCount(i
, i
->unknown
);
5500 Jim_DecrRefCount(i
, i
->errorFileNameObj
);
5501 Jim_DecrRefCount(i
, i
->currentScriptObj
);
5502 Jim_DecrRefCount(i
, i
->nullScriptObj
);
5503 Jim_FreeHashTable(&i
->commands
);
5504 #ifdef JIM_REFERENCES
5505 Jim_FreeHashTable(&i
->references
);
5507 Jim_FreeHashTable(&i
->packages
);
5508 Jim_Free(i
->prngState
);
5509 Jim_FreeHashTable(&i
->assocData
);
5511 /* Check that the live object list is empty, otherwise
5512 * there is a memory leak. */
5513 #ifdef JIM_MAINTAINER
5514 if (i
->liveList
!= NULL
) {
5515 objPtr
= i
->liveList
;
5517 printf("\n-------------------------------------\n");
5518 printf("Objects still in the free list:\n");
5520 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "string";
5522 if (objPtr
->bytes
&& strlen(objPtr
->bytes
) > 20) {
5523 printf("%p (%d) %-10s: '%.20s...'\n",
5524 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
);
5527 printf("%p (%d) %-10s: '%s'\n",
5528 (void *)objPtr
, objPtr
->refCount
, type
, objPtr
->bytes
? objPtr
->bytes
: "(null)");
5530 if (objPtr
->typePtr
== &sourceObjType
) {
5531 printf("FILE %s LINE %d\n",
5532 Jim_String(objPtr
->internalRep
.sourceValue
.fileNameObj
),
5533 objPtr
->internalRep
.sourceValue
.lineNumber
);
5535 objPtr
= objPtr
->nextObjPtr
;
5537 printf("-------------------------------------\n\n");
5538 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5542 /* Free all the freed objects. */
5543 objPtr
= i
->freeList
;
5545 nextObjPtr
= objPtr
->nextObjPtr
;
5547 objPtr
= nextObjPtr
;
5550 /* Free the free call frames list */
5551 for (cf
= i
->freeFramesList
; cf
; cf
= cfx
) {
5554 Jim_FreeHashTable(&cf
->vars
);
5558 /* Free the interpreter structure. */
5562 /* Returns the call frame relative to the level represented by
5563 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5565 * This function accepts the 'level' argument in the form
5566 * of the commands [uplevel] and [upvar].
5568 * Returns NULL on error.
5570 * Note: for a function accepting a relative integer as level suitable
5571 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5573 Jim_CallFrame
*Jim_GetCallFrameByLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5577 Jim_CallFrame
*framePtr
;
5580 str
= Jim_String(levelObjPtr
);
5581 if (str
[0] == '#') {
5584 level
= jim_strtol(str
+ 1, &endptr
);
5585 if (str
[1] == '\0' || endptr
[0] != '\0') {
5590 if (Jim_GetLong(interp
, levelObjPtr
, &level
) != JIM_OK
|| level
< 0) {
5594 /* Convert from a relative to an absolute level */
5595 level
= interp
->framePtr
->level
- level
;
5600 str
= "1"; /* Needed to format the error message. */
5601 level
= interp
->framePtr
->level
- 1;
5605 return interp
->topFramePtr
;
5609 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5610 if (framePtr
->level
== level
) {
5616 Jim_SetResultFormatted(interp
, "bad level \"%s\"", str
);
5620 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5621 * as a relative integer like in the [info level ?level?] command.
5623 static Jim_CallFrame
*JimGetCallFrameByInteger(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
)
5626 Jim_CallFrame
*framePtr
;
5628 if (Jim_GetLong(interp
, levelObjPtr
, &level
) == JIM_OK
) {
5630 /* Convert from a relative to an absolute level */
5631 level
= interp
->framePtr
->level
+ level
;
5635 return interp
->topFramePtr
;
5639 for (framePtr
= interp
->framePtr
; framePtr
; framePtr
= framePtr
->parent
) {
5640 if (framePtr
->level
== level
) {
5646 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
5650 static void JimResetStackTrace(Jim_Interp
*interp
)
5652 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5653 interp
->stackTrace
= Jim_NewListObj(interp
, NULL
, 0);
5654 Jim_IncrRefCount(interp
->stackTrace
);
5657 static void JimSetStackTrace(Jim_Interp
*interp
, Jim_Obj
*stackTraceObj
)
5661 /* Increment reference first in case these are the same object */
5662 Jim_IncrRefCount(stackTraceObj
);
5663 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5664 interp
->stackTrace
= stackTraceObj
;
5665 interp
->errorFlag
= 1;
5667 /* This is a bit ugly.
5668 * If the filename of the last entry of the stack trace is empty,
5669 * the next stack level should be added.
5671 len
= Jim_ListLength(interp
, interp
->stackTrace
);
5673 if (Jim_Length(Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2)) == 0) {
5674 interp
->addStackTrace
= 1;
5679 static void JimAppendStackTrace(Jim_Interp
*interp
, const char *procname
,
5680 Jim_Obj
*fileNameObj
, int linenr
)
5682 if (strcmp(procname
, "unknown") == 0) {
5685 if (!*procname
&& !Jim_Length(fileNameObj
)) {
5686 /* No useful info here */
5690 if (Jim_IsShared(interp
->stackTrace
)) {
5691 Jim_DecrRefCount(interp
, interp
->stackTrace
);
5692 interp
->stackTrace
= Jim_DuplicateObj(interp
, interp
->stackTrace
);
5693 Jim_IncrRefCount(interp
->stackTrace
);
5696 /* If we have no procname but the previous element did, merge with that frame */
5697 if (!*procname
&& Jim_Length(fileNameObj
)) {
5698 /* Just a filename. Check the previous entry */
5699 int len
= Jim_ListLength(interp
, interp
->stackTrace
);
5702 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 3);
5703 if (Jim_Length(objPtr
)) {
5704 /* Yes, the previous level had procname */
5705 objPtr
= Jim_ListGetIndex(interp
, interp
->stackTrace
, len
- 2);
5706 if (Jim_Length(objPtr
) == 0) {
5707 /* But no filename, so merge the new info with that frame */
5708 ListSetIndex(interp
, interp
->stackTrace
, len
- 2, fileNameObj
, 0);
5709 ListSetIndex(interp
, interp
->stackTrace
, len
- 1, Jim_NewIntObj(interp
, linenr
), 0);
5716 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewStringObj(interp
, procname
, -1));
5717 Jim_ListAppendElement(interp
, interp
->stackTrace
, fileNameObj
);
5718 Jim_ListAppendElement(interp
, interp
->stackTrace
, Jim_NewIntObj(interp
, linenr
));
5721 int Jim_SetAssocData(Jim_Interp
*interp
, const char *key
, Jim_InterpDeleteProc
* delProc
,
5724 AssocDataValue
*assocEntryPtr
= (AssocDataValue
*) Jim_Alloc(sizeof(AssocDataValue
));
5726 assocEntryPtr
->delProc
= delProc
;
5727 assocEntryPtr
->data
= data
;
5728 return Jim_AddHashEntry(&interp
->assocData
, key
, assocEntryPtr
);
5731 void *Jim_GetAssocData(Jim_Interp
*interp
, const char *key
)
5733 Jim_HashEntry
*entryPtr
= Jim_FindHashEntry(&interp
->assocData
, key
);
5735 if (entryPtr
!= NULL
) {
5736 AssocDataValue
*assocEntryPtr
= Jim_GetHashEntryVal(entryPtr
);
5737 return assocEntryPtr
->data
;
5742 int Jim_DeleteAssocData(Jim_Interp
*interp
, const char *key
)
5744 return Jim_DeleteHashEntry(&interp
->assocData
, key
);
5747 int Jim_GetExitCode(Jim_Interp
*interp
)
5749 return interp
->exitCode
;
5752 /* -----------------------------------------------------------------------------
5754 * ---------------------------------------------------------------------------*/
5755 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
);
5756 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
);
5758 static const Jim_ObjType intObjType
= {
5766 /* A coerced double is closer to an int than a double.
5767 * It is an int value temporarily masquerading as a double value.
5768 * i.e. it has the same string value as an int and Jim_GetWide()
5769 * succeeds, but also Jim_GetDouble() returns the value directly.
5771 static const Jim_ObjType coercedDoubleObjType
= {
5780 static void UpdateStringOfInt(struct Jim_Obj
*objPtr
)
5782 char buf
[JIM_INTEGER_SPACE
+ 1];
5783 jim_wide wideValue
= JimWideValue(objPtr
);
5786 if (wideValue
== 0) {
5790 char tmp
[JIM_INTEGER_SPACE
];
5794 if (wideValue
< 0) {
5796 /* -106 % 10 may be -6 or 4! */
5798 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5803 tmp
[num
++] = wideValue
% 10;
5807 for (i
= 0; i
< num
; i
++) {
5808 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5813 JimSetStringBytes(objPtr
, buf
);
5816 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5821 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5822 /* Simple switcheroo */
5823 objPtr
->typePtr
= &intObjType
;
5827 /* Get the string representation */
5828 str
= Jim_String(objPtr
);
5829 /* Try to convert into a jim_wide */
5830 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5831 if (flags
& JIM_ERRMSG
) {
5832 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5836 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5837 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5840 /* Free the old internal repr and set the new one. */
5841 Jim_FreeIntRep(interp
, objPtr
);
5842 objPtr
->typePtr
= &intObjType
;
5843 objPtr
->internalRep
.wideValue
= wideValue
;
5847 #ifdef JIM_OPTIMIZATION
5848 static int JimIsWide(Jim_Obj
*objPtr
)
5850 return objPtr
->typePtr
== &intObjType
;
5854 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5856 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5858 *widePtr
= JimWideValue(objPtr
);
5862 /* Get a wide but does not set an error if the format is bad. */
5863 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5865 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5867 *widePtr
= JimWideValue(objPtr
);
5871 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5876 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5877 if (retval
== JIM_OK
) {
5878 *longPtr
= (long)wideValue
;
5884 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5888 objPtr
= Jim_NewObj(interp
);
5889 objPtr
->typePtr
= &intObjType
;
5890 objPtr
->bytes
= NULL
;
5891 objPtr
->internalRep
.wideValue
= wideValue
;
5895 /* -----------------------------------------------------------------------------
5897 * ---------------------------------------------------------------------------*/
5898 #define JIM_DOUBLE_SPACE 30
5900 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5901 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5903 static const Jim_ObjType doubleObjType
= {
5907 UpdateStringOfDouble
,
5913 #define isnan(X) ((X) != (X))
5917 #define isinf(X) (1.0 / (X) == 0.0)
5920 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5922 double value
= objPtr
->internalRep
.doubleValue
;
5925 JimSetStringBytes(objPtr
, "NaN");
5930 JimSetStringBytes(objPtr
, "-Inf");
5933 JimSetStringBytes(objPtr
, "Inf");
5938 char buf
[JIM_DOUBLE_SPACE
+ 1];
5940 int len
= sprintf(buf
, "%.12g", value
);
5942 /* Add a final ".0" if necessary */
5943 for (i
= 0; i
< len
; i
++) {
5944 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5945 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5946 /* If 'buf' ends in e-0nn or e+0nn, remove
5947 * the 0 after the + or - and reduce the length by 1
5949 char *e
= strchr(buf
, 'e');
5950 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5953 memmove(e
, e
+ 1, len
- (e
- buf
));
5959 if (buf
[i
] == '\0') {
5964 JimSetStringBytes(objPtr
, buf
);
5968 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5974 /* Preserve the string representation.
5975 * Needed so we can convert back to int without loss
5977 str
= Jim_String(objPtr
);
5979 #ifdef HAVE_LONG_LONG
5980 /* Assume a 53 bit mantissa */
5981 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5982 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5984 if (objPtr
->typePtr
== &intObjType
5985 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
5986 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
5988 /* Direct conversion to coerced double */
5989 objPtr
->typePtr
= &coercedDoubleObjType
;
5994 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
5995 /* Managed to convert to an int, so we can use this as a cooerced double */
5996 Jim_FreeIntRep(interp
, objPtr
);
5997 objPtr
->typePtr
= &coercedDoubleObjType
;
5998 objPtr
->internalRep
.wideValue
= wideValue
;
6002 /* Try to convert into a double */
6003 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6004 Jim_SetResultFormatted(interp
, "expected number but got \"%#s\"", objPtr
);
6007 /* Free the old internal repr and set the new one. */
6008 Jim_FreeIntRep(interp
, objPtr
);
6010 objPtr
->typePtr
= &doubleObjType
;
6011 objPtr
->internalRep
.doubleValue
= doubleValue
;
6015 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6017 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6018 *doublePtr
= JimWideValue(objPtr
);
6021 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6024 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6025 *doublePtr
= JimWideValue(objPtr
);
6028 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6033 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6037 objPtr
= Jim_NewObj(interp
);
6038 objPtr
->typePtr
= &doubleObjType
;
6039 objPtr
->bytes
= NULL
;
6040 objPtr
->internalRep
.doubleValue
= doubleValue
;
6044 /* -----------------------------------------------------------------------------
6046 * ---------------------------------------------------------------------------*/
6047 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6048 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6049 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6050 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6051 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6052 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6054 /* Note that while the elements of the list may contain references,
6055 * the list object itself can't. This basically means that the
6056 * list object string representation as a whole can't contain references
6057 * that are not presents in the single elements. */
6058 static const Jim_ObjType listObjType
= {
6060 FreeListInternalRep
,
6066 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6070 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6071 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6073 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6076 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6080 JIM_NOTUSED(interp
);
6082 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6083 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6084 dupPtr
->internalRep
.listValue
.ele
=
6085 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6086 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6087 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6088 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6089 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6091 dupPtr
->typePtr
= &listObjType
;
6094 /* The following function checks if a given string can be encoded
6095 * into a list element without any kind of quoting, surrounded by braces,
6096 * or using escapes to quote. */
6097 #define JIM_ELESTR_SIMPLE 0
6098 #define JIM_ELESTR_BRACE 1
6099 #define JIM_ELESTR_QUOTE 2
6100 static unsigned char ListElementQuotingType(const char *s
, int len
)
6102 int i
, level
, blevel
, trySimple
= 1;
6104 /* Try with the SIMPLE case */
6106 return JIM_ELESTR_BRACE
;
6107 if (s
[0] == '"' || s
[0] == '{') {
6111 for (i
= 0; i
< len
; i
++) {
6131 return JIM_ELESTR_SIMPLE
;
6134 /* Test if it's possible to do with braces */
6135 if (s
[len
- 1] == '\\')
6136 return JIM_ELESTR_QUOTE
;
6139 for (i
= 0; i
< len
; i
++) {
6147 return JIM_ELESTR_QUOTE
;
6156 if (s
[i
+ 1] == '\n')
6157 return JIM_ELESTR_QUOTE
;
6158 else if (s
[i
+ 1] != '\0')
6164 return JIM_ELESTR_QUOTE
;
6169 return JIM_ELESTR_BRACE
;
6170 for (i
= 0; i
< len
; i
++) {
6184 return JIM_ELESTR_BRACE
;
6188 return JIM_ELESTR_SIMPLE
;
6190 return JIM_ELESTR_QUOTE
;
6193 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6194 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6196 * Returns the length of the result.
6198 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6251 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6253 #define STATIC_QUOTING_LEN 32
6254 int i
, bufLen
, realLength
;
6257 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6259 /* Estimate the space needed. */
6260 if (objc
> STATIC_QUOTING_LEN
) {
6261 quotingType
= Jim_Alloc(objc
);
6264 quotingType
= staticQuoting
;
6267 for (i
= 0; i
< objc
; i
++) {
6270 strRep
= Jim_GetString(objv
[i
], &len
);
6271 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6272 switch (quotingType
[i
]) {
6273 case JIM_ELESTR_SIMPLE
:
6274 if (i
!= 0 || strRep
[0] != '#') {
6278 /* Special case '#' on first element needs braces */
6279 quotingType
[i
] = JIM_ELESTR_BRACE
;
6281 case JIM_ELESTR_BRACE
:
6284 case JIM_ELESTR_QUOTE
:
6288 bufLen
++; /* elements separator. */
6292 /* Generate the string rep. */
6293 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6295 for (i
= 0; i
< objc
; i
++) {
6298 strRep
= Jim_GetString(objv
[i
], &len
);
6300 switch (quotingType
[i
]) {
6301 case JIM_ELESTR_SIMPLE
:
6302 memcpy(p
, strRep
, len
);
6306 case JIM_ELESTR_BRACE
:
6308 memcpy(p
, strRep
, len
);
6311 realLength
+= len
+ 2;
6313 case JIM_ELESTR_QUOTE
:
6314 if (i
== 0 && strRep
[0] == '#') {
6318 qlen
= BackslashQuoteString(strRep
, len
, p
);
6323 /* Add a separating space */
6324 if (i
+ 1 != objc
) {
6329 *p
= '\0'; /* nul term. */
6330 objPtr
->length
= realLength
;
6332 if (quotingType
!= staticQuoting
) {
6333 Jim_Free(quotingType
);
6337 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6339 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6342 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6344 struct JimParserCtx parser
;
6347 Jim_Obj
*fileNameObj
;
6350 if (objPtr
->typePtr
== &listObjType
) {
6354 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6355 * it also preserves any source location of the dict elements
6356 * which can be very useful
6358 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6359 Jim_Obj
**listObjPtrPtr
;
6363 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6364 for (i
= 0; i
< len
; i
++) {
6365 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6368 /* Now just switch the internal rep */
6369 Jim_FreeIntRep(interp
, objPtr
);
6370 objPtr
->typePtr
= &listObjType
;
6371 objPtr
->internalRep
.listValue
.len
= len
;
6372 objPtr
->internalRep
.listValue
.maxLen
= len
;
6373 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6378 /* Try to preserve information about filename / line number */
6379 if (objPtr
->typePtr
== &sourceObjType
) {
6380 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6381 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6384 fileNameObj
= interp
->emptyObj
;
6387 Jim_IncrRefCount(fileNameObj
);
6389 /* Get the string representation */
6390 str
= Jim_GetString(objPtr
, &strLen
);
6392 /* Free the old internal repr just now and initialize the
6393 * new one just now. The string->list conversion can't fail. */
6394 Jim_FreeIntRep(interp
, objPtr
);
6395 objPtr
->typePtr
= &listObjType
;
6396 objPtr
->internalRep
.listValue
.len
= 0;
6397 objPtr
->internalRep
.listValue
.maxLen
= 0;
6398 objPtr
->internalRep
.listValue
.ele
= NULL
;
6400 /* Convert into a list */
6402 JimParserInit(&parser
, str
, strLen
, linenr
);
6403 while (!parser
.eof
) {
6404 Jim_Obj
*elementPtr
;
6406 JimParseList(&parser
);
6407 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6409 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6410 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6411 ListAppendElement(objPtr
, elementPtr
);
6414 Jim_DecrRefCount(interp
, fileNameObj
);
6418 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6422 objPtr
= Jim_NewObj(interp
);
6423 objPtr
->typePtr
= &listObjType
;
6424 objPtr
->bytes
= NULL
;
6425 objPtr
->internalRep
.listValue
.ele
= NULL
;
6426 objPtr
->internalRep
.listValue
.len
= 0;
6427 objPtr
->internalRep
.listValue
.maxLen
= 0;
6430 ListInsertElements(objPtr
, 0, len
, elements
);
6436 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6437 * length of the vector. Note that the user of this function should make
6438 * sure that the list object can't shimmer while the vector returned
6439 * is in use, this vector is the one stored inside the internal representation
6440 * of the list object. This function is not exported, extensions should
6441 * always access to the List object elements using Jim_ListIndex(). */
6442 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6445 *listLen
= Jim_ListLength(interp
, listObj
);
6446 *listVec
= listObj
->internalRep
.listValue
.ele
;
6449 /* Sorting uses ints, but commands may return wide */
6450 static int JimSign(jim_wide w
)
6461 /* ListSortElements type values */
6477 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6480 static struct lsort_info
*sort_info
;
6482 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6484 Jim_Obj
*lObj
, *rObj
;
6486 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6487 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6488 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6490 return sort_info
->subfn(&lObj
, &rObj
);
6493 /* Sort the internal rep of a list. */
6494 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6496 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6499 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6501 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6504 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6506 jim_wide lhs
= 0, rhs
= 0;
6508 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6509 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6510 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6513 return JimSign(lhs
- rhs
) * sort_info
->order
;
6516 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6518 double lhs
= 0, rhs
= 0;
6520 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6521 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6522 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6528 return sort_info
->order
;
6530 return -sort_info
->order
;
6533 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6535 Jim_Obj
*compare_script
;
6540 /* This must be a valid list */
6541 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6542 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6543 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6545 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6547 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6548 longjmp(sort_info
->jmpbuf
, rc
);
6551 return JimSign(ret
) * sort_info
->order
;
6554 /* Remove duplicate elements from the (sorted) list in-place, according to the
6555 * comparison function, comp.
6557 * Note that the last unique value is kept, not the first
6559 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6563 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6565 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6566 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6567 /* Match, so replace the dest with the current source */
6568 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6571 /* No match, so keep the current source and move to the next destination */
6574 ele
[dst
] = ele
[src
];
6576 /* At end of list, keep the final element */
6577 ele
[++dst
] = ele
[src
];
6579 /* Set the new length */
6580 listObjPtr
->internalRep
.listValue
.len
= dst
;
6583 /* Sort a list *in place*. MUST be called with a non-shared list. */
6584 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6586 struct lsort_info
*prev_info
;
6588 typedef int (qsort_comparator
) (const void *, const void *);
6589 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6594 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6595 SetListFromAny(interp
, listObjPtr
);
6597 /* Allow lsort to be called reentrantly */
6598 prev_info
= sort_info
;
6601 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6602 len
= listObjPtr
->internalRep
.listValue
.len
;
6603 switch (info
->type
) {
6604 case JIM_LSORT_ASCII
:
6605 fn
= ListSortString
;
6607 case JIM_LSORT_NOCASE
:
6608 fn
= ListSortStringNoCase
;
6610 case JIM_LSORT_INTEGER
:
6611 fn
= ListSortInteger
;
6613 case JIM_LSORT_REAL
:
6616 case JIM_LSORT_COMMAND
:
6617 fn
= ListSortCommand
;
6620 fn
= NULL
; /* avoid warning */
6621 JimPanic((1, "ListSort called with invalid sort type"));
6624 if (info
->indexed
) {
6625 /* Need to interpose a "list index" function */
6627 fn
= ListSortIndexHelper
;
6630 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6631 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6633 if (info
->unique
&& len
> 1) {
6634 ListRemoveDuplicates(listObjPtr
, fn
);
6637 Jim_InvalidateStringRep(listObjPtr
);
6639 sort_info
= prev_info
;
6644 /* This is the low-level function to insert elements into a list.
6645 * The higher-level Jim_ListInsertElements() performs shared object
6646 * check and invalidates the string repr. This version is used
6647 * in the internals of the List Object and is not exported.
6649 * NOTE: this function can be called only against objects
6650 * with internal type of List.
6652 * An insertion point (idx) of -1 means end-of-list.
6654 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6656 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6657 int requiredLen
= currentLen
+ elemc
;
6661 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6662 if (requiredLen
< 2) {
6663 /* Don't do allocations of under 4 pointers. */
6670 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6671 sizeof(Jim_Obj
*) * requiredLen
);
6673 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6678 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6679 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6680 for (i
= 0; i
< elemc
; ++i
) {
6681 point
[i
] = elemVec
[i
];
6682 Jim_IncrRefCount(point
[i
]);
6684 listPtr
->internalRep
.listValue
.len
+= elemc
;
6687 /* Convenience call to ListInsertElements() to append a single element.
6689 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6691 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6694 /* Appends every element of appendListPtr into listPtr.
6695 * Both have to be of the list type.
6696 * Convenience call to ListInsertElements()
6698 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6700 ListInsertElements(listPtr
, -1,
6701 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6704 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6706 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6707 SetListFromAny(interp
, listPtr
);
6708 Jim_InvalidateStringRep(listPtr
);
6709 ListAppendElement(listPtr
, objPtr
);
6712 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6714 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6715 SetListFromAny(interp
, listPtr
);
6716 SetListFromAny(interp
, appendListPtr
);
6717 Jim_InvalidateStringRep(listPtr
);
6718 ListAppendList(listPtr
, appendListPtr
);
6721 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6723 SetListFromAny(interp
, objPtr
);
6724 return objPtr
->internalRep
.listValue
.len
;
6727 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6728 int objc
, Jim_Obj
*const *objVec
)
6730 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6731 SetListFromAny(interp
, listPtr
);
6732 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6733 idx
= listPtr
->internalRep
.listValue
.len
;
6736 Jim_InvalidateStringRep(listPtr
);
6737 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6740 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6742 SetListFromAny(interp
, listPtr
);
6743 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6744 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6748 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6749 return listPtr
->internalRep
.listValue
.ele
[idx
];
6752 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6754 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6755 if (*objPtrPtr
== NULL
) {
6756 if (flags
& JIM_ERRMSG
) {
6757 Jim_SetResultString(interp
, "list index out of range", -1);
6764 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6765 Jim_Obj
*newObjPtr
, int flags
)
6767 SetListFromAny(interp
, listPtr
);
6768 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6769 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6770 if (flags
& JIM_ERRMSG
) {
6771 Jim_SetResultString(interp
, "list index out of range", -1);
6776 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6777 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6778 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6779 Jim_IncrRefCount(newObjPtr
);
6783 /* Modify the list stored in the variable named 'varNamePtr'
6784 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6785 * with the new element 'newObjptr'. (implements the [lset] command) */
6786 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6787 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6789 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6792 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6795 if ((shared
= Jim_IsShared(objPtr
)))
6796 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6797 for (i
= 0; i
< indexc
- 1; i
++) {
6798 listObjPtr
= objPtr
;
6799 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6801 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6804 if (Jim_IsShared(objPtr
)) {
6805 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6806 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6808 Jim_InvalidateStringRep(listObjPtr
);
6810 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6812 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6814 Jim_InvalidateStringRep(objPtr
);
6815 Jim_InvalidateStringRep(varObjPtr
);
6816 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6818 Jim_SetResult(interp
, varObjPtr
);
6822 Jim_FreeNewObj(interp
, varObjPtr
);
6827 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6830 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6831 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6833 for (i
= 0; i
< listLen
; ) {
6834 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6835 if (++i
!= listLen
) {
6836 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6842 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6846 /* If all the objects in objv are lists,
6847 * it's possible to return a list as result, that's the
6848 * concatenation of all the lists. */
6849 for (i
= 0; i
< objc
; i
++) {
6850 if (!Jim_IsList(objv
[i
]))
6854 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6856 for (i
= 0; i
< objc
; i
++)
6857 ListAppendList(objPtr
, objv
[i
]);
6861 /* Else... we have to glue strings together */
6862 int len
= 0, objLen
;
6865 /* Compute the length */
6866 for (i
= 0; i
< objc
; i
++) {
6867 len
+= Jim_Length(objv
[i
]);
6871 /* Create the string rep, and a string object holding it. */
6872 p
= bytes
= Jim_Alloc(len
+ 1);
6873 for (i
= 0; i
< objc
; i
++) {
6874 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6876 /* Remove leading space */
6877 while (objLen
&& isspace(UCHAR(*s
))) {
6882 /* And trailing space */
6883 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6884 /* Handle trailing backslash-space case */
6885 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6891 memcpy(p
, s
, objLen
);
6893 if (i
+ 1 != objc
) {
6897 /* Drop the space calcuated for this
6898 * element that is instead null. */
6904 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6908 /* Returns a list composed of the elements in the specified range.
6909 * first and start are directly accepted as Jim_Objects and
6910 * processed for the end?-index? case. */
6911 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6912 Jim_Obj
*lastObjPtr
)
6917 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6918 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
6920 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
6921 first
= JimRelToAbsIndex(len
, first
);
6922 last
= JimRelToAbsIndex(len
, last
);
6923 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
6924 if (first
== 0 && last
== len
) {
6927 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
6930 /* -----------------------------------------------------------------------------
6932 * ---------------------------------------------------------------------------*/
6933 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6934 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6935 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
6936 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6938 /* Dict HashTable Type.
6940 * Keys and Values are Jim objects. */
6942 static unsigned int JimObjectHTHashFunction(const void *key
)
6945 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
6946 return Jim_GenHashFunction((const unsigned char *)str
, len
);
6949 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
6951 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
6954 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
6956 Jim_IncrRefCount((Jim_Obj
*)val
);
6960 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
6962 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
6965 static const Jim_HashTableType JimDictHashTableType
= {
6966 JimObjectHTHashFunction
, /* hash function */
6967 JimObjectHTKeyValDup
, /* key dup */
6968 JimObjectHTKeyValDup
, /* val dup */
6969 JimObjectHTKeyCompare
, /* key compare */
6970 JimObjectHTKeyValDestructor
, /* key destructor */
6971 JimObjectHTKeyValDestructor
/* val destructor */
6974 /* Note that while the elements of the dict may contain references,
6975 * the list object itself can't. This basically means that the
6976 * dict object string representation as a whole can't contain references
6977 * that are not presents in the single elements. */
6978 static const Jim_ObjType dictObjType
= {
6980 FreeDictInternalRep
,
6986 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6988 JIM_NOTUSED(interp
);
6990 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
6991 Jim_Free(objPtr
->internalRep
.ptr
);
6994 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6996 Jim_HashTable
*ht
, *dupHt
;
6997 Jim_HashTableIterator htiter
;
7000 /* Create a new hash table */
7001 ht
= srcPtr
->internalRep
.ptr
;
7002 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7003 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7005 Jim_ExpandHashTable(dupHt
, ht
->size
);
7006 /* Copy every element from the source to the dup hash table */
7007 JimInitHashTableIterator(ht
, &htiter
);
7008 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7009 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7012 dupPtr
->internalRep
.ptr
= dupHt
;
7013 dupPtr
->typePtr
= &dictObjType
;
7016 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7019 Jim_HashTableIterator htiter
;
7024 ht
= dictPtr
->internalRep
.ptr
;
7026 /* Turn the hash table into a flat vector of Jim_Objects. */
7027 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7028 JimInitHashTableIterator(ht
, &htiter
);
7030 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7031 objv
[i
++] = Jim_GetHashEntryKey(he
);
7032 objv
[i
++] = Jim_GetHashEntryVal(he
);
7038 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7040 /* Turn the hash table into a flat vector of Jim_Objects. */
7042 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7044 /* And now generate the string rep as a list */
7045 JimMakeListStringRep(objPtr
, objv
, len
);
7050 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7054 if (objPtr
->typePtr
== &dictObjType
) {
7058 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7059 /* A shared list, so get the string representation now to avoid
7060 * changing the order in case of fast conversion to dict.
7065 /* For simplicity, convert a non-list object to a list and then to a dict */
7066 listlen
= Jim_ListLength(interp
, objPtr
);
7068 Jim_SetResultString(interp
, "missing value to go with key", -1);
7072 /* Converting from a list to a dict can't fail */
7076 ht
= Jim_Alloc(sizeof(*ht
));
7077 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7079 for (i
= 0; i
< listlen
; i
+= 2) {
7080 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7081 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7083 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7086 Jim_FreeIntRep(interp
, objPtr
);
7087 objPtr
->typePtr
= &dictObjType
;
7088 objPtr
->internalRep
.ptr
= ht
;
7094 /* Dict object API */
7096 /* Add an element to a dict. objPtr must be of the "dict" type.
7097 * The higer-level exported function is Jim_DictAddElement().
7098 * If an element with the specified key already exists, the value
7099 * associated is replaced with the new one.
7101 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7102 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7103 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7105 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7107 if (valueObjPtr
== NULL
) { /* unset */
7108 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7110 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7114 /* Add an element, higher-level interface for DictAddElement().
7115 * If valueObjPtr == NULL, the key is removed if it exists. */
7116 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7117 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7119 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7120 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7123 Jim_InvalidateStringRep(objPtr
);
7124 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7127 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7132 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7134 objPtr
= Jim_NewObj(interp
);
7135 objPtr
->typePtr
= &dictObjType
;
7136 objPtr
->bytes
= NULL
;
7137 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7138 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7139 for (i
= 0; i
< len
; i
+= 2)
7140 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7144 /* Return the value associated to the specified dict key
7145 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7147 * Sets *objPtrPtr to non-NULL only upon success.
7149 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7150 Jim_Obj
**objPtrPtr
, int flags
)
7155 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7158 ht
= dictPtr
->internalRep
.ptr
;
7159 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7160 if (flags
& JIM_ERRMSG
) {
7161 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7165 *objPtrPtr
= he
->u
.val
;
7169 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7170 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7172 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7175 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7181 /* Return the value associated to the specified dict keys */
7182 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7183 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7188 *objPtrPtr
= dictPtr
;
7192 for (i
= 0; i
< keyc
; i
++) {
7195 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7201 *objPtrPtr
= dictPtr
;
7205 /* Modify the dict stored into the variable named 'varNamePtr'
7206 * setting the element specified by the 'keyc' keys objects in 'keyv',
7207 * with the new value of the element 'newObjPtr'.
7209 * If newObjPtr == NULL the operation is to remove the given key
7210 * from the dictionary.
7212 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7213 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7215 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7216 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7218 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7221 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7222 if (objPtr
== NULL
) {
7223 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7224 /* Cannot remove a key from non existing var */
7227 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7228 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7229 Jim_FreeNewObj(interp
, varObjPtr
);
7233 if ((shared
= Jim_IsShared(objPtr
)))
7234 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7235 for (i
= 0; i
< keyc
; i
++) {
7236 dictObjPtr
= objPtr
;
7238 /* Check if it's a valid dictionary */
7239 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7243 if (i
== keyc
- 1) {
7244 /* Last key: Note that error on unset with missing last key is OK */
7245 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7246 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7253 /* Check if the given key exists. */
7254 Jim_InvalidateStringRep(dictObjPtr
);
7255 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7256 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7257 /* This key exists at the current level.
7258 * Make sure it's not shared!. */
7259 if (Jim_IsShared(objPtr
)) {
7260 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7261 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7265 /* Key not found. If it's an [unset] operation
7266 * this is an error. Only the last key may not
7268 if (newObjPtr
== NULL
) {
7271 /* Otherwise set an empty dictionary
7272 * as key's value. */
7273 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7274 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7277 /* XXX: Is this necessary? */
7278 Jim_InvalidateStringRep(objPtr
);
7279 Jim_InvalidateStringRep(varObjPtr
);
7280 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7283 Jim_SetResult(interp
, varObjPtr
);
7287 Jim_FreeNewObj(interp
, varObjPtr
);
7292 /* -----------------------------------------------------------------------------
7294 * ---------------------------------------------------------------------------*/
7295 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7296 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7298 static const Jim_ObjType indexObjType
= {
7302 UpdateStringOfIndex
,
7306 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7308 if (objPtr
->internalRep
.intValue
== -1) {
7309 JimSetStringBytes(objPtr
, "end");
7312 char buf
[JIM_INTEGER_SPACE
+ 1];
7313 if (objPtr
->internalRep
.intValue
>= 0) {
7314 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7318 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7320 JimSetStringBytes(objPtr
, buf
);
7324 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7330 /* Get the string representation */
7331 str
= Jim_String(objPtr
);
7333 /* Try to convert into an index */
7334 if (strncmp(str
, "end", 3) == 0) {
7340 idx
= jim_strtol(str
, &endptr
);
7342 if (endptr
== str
) {
7348 /* Now str may include or +<num> or -<num> */
7349 if (*str
== '+' || *str
== '-') {
7350 int sign
= (*str
== '+' ? 1 : -1);
7352 idx
+= sign
* jim_strtol(++str
, &endptr
);
7353 if (str
== endptr
|| *endptr
) {
7358 /* The only thing left should be spaces */
7359 while (isspace(UCHAR(*str
))) {
7370 /* end-1 is repesented as -2 */
7378 /* Free the old internal repr and set the new one. */
7379 Jim_FreeIntRep(interp
, objPtr
);
7380 objPtr
->typePtr
= &indexObjType
;
7381 objPtr
->internalRep
.intValue
= idx
;
7385 Jim_SetResultFormatted(interp
,
7386 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7390 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7392 /* Avoid shimmering if the object is an integer. */
7393 if (objPtr
->typePtr
== &intObjType
) {
7394 jim_wide val
= JimWideValue(objPtr
);
7396 if (!(val
< LONG_MIN
) && !(val
> LONG_MAX
)) {
7397 *indexPtr
= (val
< 0) ? -INT_MAX
: (long)val
;;
7401 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7403 *indexPtr
= objPtr
->internalRep
.intValue
;
7407 /* -----------------------------------------------------------------------------
7408 * Return Code Object.
7409 * ---------------------------------------------------------------------------*/
7411 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7412 static const char * const jimReturnCodes
[] = {
7424 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7426 static const Jim_ObjType returnCodeObjType
= {
7434 /* Converts a (standard) return code to a string. Returns "?" for
7435 * non-standard return codes.
7437 const char *Jim_ReturnCode(int code
)
7439 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7443 return jimReturnCodes
[code
];
7447 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7452 /* Try to convert into an integer */
7453 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7454 returnCode
= (int)wideValue
;
7455 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7456 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7459 /* Free the old internal repr and set the new one. */
7460 Jim_FreeIntRep(interp
, objPtr
);
7461 objPtr
->typePtr
= &returnCodeObjType
;
7462 objPtr
->internalRep
.intValue
= returnCode
;
7466 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7468 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7470 *intPtr
= objPtr
->internalRep
.intValue
;
7474 /* -----------------------------------------------------------------------------
7475 * Expression Parsing
7476 * ---------------------------------------------------------------------------*/
7477 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7478 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7479 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7481 /* Exrp's Stack machine operators opcodes. */
7483 /* Binary operators (numbers) */
7486 /* Continues on from the JIM_TT_ space */
7488 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7503 JIM_EXPROP_BITAND
, /* 35 */
7507 /* Note must keep these together */
7508 JIM_EXPROP_LOGICAND
, /* 38 */
7509 JIM_EXPROP_LOGICAND_LEFT
,
7510 JIM_EXPROP_LOGICAND_RIGHT
,
7513 JIM_EXPROP_LOGICOR
, /* 41 */
7514 JIM_EXPROP_LOGICOR_LEFT
,
7515 JIM_EXPROP_LOGICOR_RIGHT
,
7518 /* Ternary operators */
7519 JIM_EXPROP_TERNARY
, /* 44 */
7520 JIM_EXPROP_TERNARY_LEFT
,
7521 JIM_EXPROP_TERNARY_RIGHT
,
7524 JIM_EXPROP_COLON
, /* 47 */
7525 JIM_EXPROP_COLON_LEFT
,
7526 JIM_EXPROP_COLON_RIGHT
,
7528 JIM_EXPROP_POW
, /* 50 */
7530 /* Binary operators (strings) */
7531 JIM_EXPROP_STREQ
, /* 51 */
7536 /* Unary operators (numbers) */
7537 JIM_EXPROP_NOT
, /* 55 */
7539 JIM_EXPROP_UNARYMINUS
,
7540 JIM_EXPROP_UNARYPLUS
,
7543 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7544 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7545 JIM_EXPROP_FUNC_ABS
,
7546 JIM_EXPROP_FUNC_DOUBLE
,
7547 JIM_EXPROP_FUNC_ROUND
,
7548 JIM_EXPROP_FUNC_RAND
,
7549 JIM_EXPROP_FUNC_SRAND
,
7551 /* math functions from libm */
7552 JIM_EXPROP_FUNC_SIN
, /* 64 */
7553 JIM_EXPROP_FUNC_COS
,
7554 JIM_EXPROP_FUNC_TAN
,
7555 JIM_EXPROP_FUNC_ASIN
,
7556 JIM_EXPROP_FUNC_ACOS
,
7557 JIM_EXPROP_FUNC_ATAN
,
7558 JIM_EXPROP_FUNC_SINH
,
7559 JIM_EXPROP_FUNC_COSH
,
7560 JIM_EXPROP_FUNC_TANH
,
7561 JIM_EXPROP_FUNC_CEIL
,
7562 JIM_EXPROP_FUNC_FLOOR
,
7563 JIM_EXPROP_FUNC_EXP
,
7564 JIM_EXPROP_FUNC_LOG
,
7565 JIM_EXPROP_FUNC_LOG10
,
7566 JIM_EXPROP_FUNC_SQRT
,
7567 JIM_EXPROP_FUNC_POW
,
7578 /* Operators table */
7579 typedef struct Jim_ExprOperator
7582 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7583 unsigned char precedence
;
7584 unsigned char arity
;
7586 unsigned char namelen
;
7589 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7591 Jim_IncrRefCount(obj
);
7592 e
->stack
[e
->stacklen
++] = obj
;
7595 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7597 return e
->stack
[--e
->stacklen
];
7600 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7604 Jim_Obj
*A
= ExprPop(e
);
7606 jim_wide wA
, wC
= 0;
7608 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7609 switch (e
->opcode
) {
7610 case JIM_EXPROP_FUNC_INT
:
7611 case JIM_EXPROP_FUNC_ROUND
:
7612 case JIM_EXPROP_UNARYPLUS
:
7615 case JIM_EXPROP_FUNC_DOUBLE
:
7619 case JIM_EXPROP_FUNC_ABS
:
7620 wC
= wA
>= 0 ? wA
: -wA
;
7622 case JIM_EXPROP_UNARYMINUS
:
7625 case JIM_EXPROP_NOT
:
7632 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7633 switch (e
->opcode
) {
7634 case JIM_EXPROP_FUNC_INT
:
7637 case JIM_EXPROP_FUNC_ROUND
:
7638 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7640 case JIM_EXPROP_FUNC_DOUBLE
:
7641 case JIM_EXPROP_UNARYPLUS
:
7645 case JIM_EXPROP_FUNC_ABS
:
7646 dC
= dA
>= 0 ? dA
: -dA
;
7649 case JIM_EXPROP_UNARYMINUS
:
7653 case JIM_EXPROP_NOT
:
7663 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7666 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7670 Jim_DecrRefCount(interp
, A
);
7675 static double JimRandDouble(Jim_Interp
*interp
)
7678 JimRandomBytes(interp
, &x
, sizeof(x
));
7680 return (double)x
/ (unsigned long)~0;
7683 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7685 Jim_Obj
*A
= ExprPop(e
);
7688 int rc
= Jim_GetWide(interp
, A
, &wA
);
7690 switch (e
->opcode
) {
7691 case JIM_EXPROP_BITNOT
:
7692 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7694 case JIM_EXPROP_FUNC_SRAND
:
7695 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7696 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7703 Jim_DecrRefCount(interp
, A
);
7708 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7710 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7712 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7717 #ifdef JIM_MATH_FUNCTIONS
7718 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7721 Jim_Obj
*A
= ExprPop(e
);
7724 rc
= Jim_GetDouble(interp
, A
, &dA
);
7726 switch (e
->opcode
) {
7727 case JIM_EXPROP_FUNC_SIN
:
7730 case JIM_EXPROP_FUNC_COS
:
7733 case JIM_EXPROP_FUNC_TAN
:
7736 case JIM_EXPROP_FUNC_ASIN
:
7739 case JIM_EXPROP_FUNC_ACOS
:
7742 case JIM_EXPROP_FUNC_ATAN
:
7745 case JIM_EXPROP_FUNC_SINH
:
7748 case JIM_EXPROP_FUNC_COSH
:
7751 case JIM_EXPROP_FUNC_TANH
:
7754 case JIM_EXPROP_FUNC_CEIL
:
7757 case JIM_EXPROP_FUNC_FLOOR
:
7760 case JIM_EXPROP_FUNC_EXP
:
7763 case JIM_EXPROP_FUNC_LOG
:
7766 case JIM_EXPROP_FUNC_LOG10
:
7769 case JIM_EXPROP_FUNC_SQRT
:
7775 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7778 Jim_DecrRefCount(interp
, A
);
7784 /* A binary operation on two ints */
7785 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7787 Jim_Obj
*B
= ExprPop(e
);
7788 Jim_Obj
*A
= ExprPop(e
);
7792 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7797 switch (e
->opcode
) {
7798 case JIM_EXPROP_LSHIFT
:
7801 case JIM_EXPROP_RSHIFT
:
7804 case JIM_EXPROP_BITAND
:
7807 case JIM_EXPROP_BITXOR
:
7810 case JIM_EXPROP_BITOR
:
7813 case JIM_EXPROP_MOD
:
7816 Jim_SetResultString(interp
, "Division by zero", -1);
7823 * This code is tricky: C doesn't guarantee much
7824 * about the quotient or remainder, but Tcl does.
7825 * The remainder always has the same sign as the
7826 * divisor and a smaller absolute value.
7844 case JIM_EXPROP_ROTL
:
7845 case JIM_EXPROP_ROTR
:{
7846 /* uint32_t would be better. But not everyone has inttypes.h? */
7847 unsigned long uA
= (unsigned long)wA
;
7848 unsigned long uB
= (unsigned long)wB
;
7849 const unsigned int S
= sizeof(unsigned long) * 8;
7851 /* Shift left by the word size or more is undefined. */
7854 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7857 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7863 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7867 Jim_DecrRefCount(interp
, A
);
7868 Jim_DecrRefCount(interp
, B
);
7874 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7875 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7879 double dA
, dB
, dC
= 0;
7880 jim_wide wA
, wB
, wC
= 0;
7882 Jim_Obj
*B
= ExprPop(e
);
7883 Jim_Obj
*A
= ExprPop(e
);
7885 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7886 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7887 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7891 switch (e
->opcode
) {
7892 case JIM_EXPROP_POW
:
7893 case JIM_EXPROP_FUNC_POW
:
7894 wC
= JimPowWide(wA
, wB
);
7896 case JIM_EXPROP_ADD
:
7899 case JIM_EXPROP_SUB
:
7902 case JIM_EXPROP_MUL
:
7905 case JIM_EXPROP_DIV
:
7907 Jim_SetResultString(interp
, "Division by zero", -1);
7914 * This code is tricky: C doesn't guarantee much
7915 * about the quotient or remainder, but Tcl does.
7916 * The remainder always has the same sign as the
7917 * divisor and a smaller absolute value.
7935 case JIM_EXPROP_LTE
:
7938 case JIM_EXPROP_GTE
:
7941 case JIM_EXPROP_NUMEQ
:
7944 case JIM_EXPROP_NUMNE
:
7951 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
7953 switch (e
->opcode
) {
7954 case JIM_EXPROP_POW
:
7955 case JIM_EXPROP_FUNC_POW
:
7956 #ifdef JIM_MATH_FUNCTIONS
7959 Jim_SetResultString(interp
, "unsupported", -1);
7963 case JIM_EXPROP_ADD
:
7966 case JIM_EXPROP_SUB
:
7969 case JIM_EXPROP_MUL
:
7972 case JIM_EXPROP_DIV
:
7975 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
7977 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
7992 case JIM_EXPROP_LTE
:
7996 case JIM_EXPROP_GTE
:
8000 case JIM_EXPROP_NUMEQ
:
8004 case JIM_EXPROP_NUMNE
:
8013 /* Handle the string case */
8015 /* XXX: Could optimise the eq/ne case by checking lengths */
8016 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8018 switch (e
->opcode
) {
8025 case JIM_EXPROP_LTE
:
8028 case JIM_EXPROP_GTE
:
8031 case JIM_EXPROP_NUMEQ
:
8034 case JIM_EXPROP_NUMNE
:
8045 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8048 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8052 Jim_DecrRefCount(interp
, A
);
8053 Jim_DecrRefCount(interp
, B
);
8058 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8063 listlen
= Jim_ListLength(interp
, listObjPtr
);
8064 for (i
= 0; i
< listlen
; i
++) {
8065 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8072 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8074 Jim_Obj
*B
= ExprPop(e
);
8075 Jim_Obj
*A
= ExprPop(e
);
8079 switch (e
->opcode
) {
8080 case JIM_EXPROP_STREQ
:
8081 case JIM_EXPROP_STRNE
:
8082 wC
= Jim_StringEqObj(A
, B
);
8083 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8087 case JIM_EXPROP_STRIN
:
8088 wC
= JimSearchList(interp
, B
, A
);
8090 case JIM_EXPROP_STRNI
:
8091 wC
= !JimSearchList(interp
, B
, A
);
8096 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8098 Jim_DecrRefCount(interp
, A
);
8099 Jim_DecrRefCount(interp
, B
);
8104 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8109 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8112 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8118 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8120 Jim_Obj
*skip
= ExprPop(e
);
8121 Jim_Obj
*A
= ExprPop(e
);
8124 switch (ExprBool(interp
, A
)) {
8126 /* false, so skip RHS opcodes with a 0 result */
8127 e
->skip
= JimWideValue(skip
);
8128 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8132 /* true so continue */
8139 Jim_DecrRefCount(interp
, A
);
8140 Jim_DecrRefCount(interp
, skip
);
8145 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8147 Jim_Obj
*skip
= ExprPop(e
);
8148 Jim_Obj
*A
= ExprPop(e
);
8151 switch (ExprBool(interp
, A
)) {
8153 /* false, so do nothing */
8157 /* true so skip RHS opcodes with a 1 result */
8158 e
->skip
= JimWideValue(skip
);
8159 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8167 Jim_DecrRefCount(interp
, A
);
8168 Jim_DecrRefCount(interp
, skip
);
8173 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8175 Jim_Obj
*A
= ExprPop(e
);
8178 switch (ExprBool(interp
, A
)) {
8180 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8184 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8192 Jim_DecrRefCount(interp
, A
);
8197 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8199 Jim_Obj
*skip
= ExprPop(e
);
8200 Jim_Obj
*A
= ExprPop(e
);
8206 switch (ExprBool(interp
, A
)) {
8208 /* false, skip RHS opcodes */
8209 e
->skip
= JimWideValue(skip
);
8210 /* Push a dummy value */
8211 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8215 /* true so do nothing */
8223 Jim_DecrRefCount(interp
, A
);
8224 Jim_DecrRefCount(interp
, skip
);
8229 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8231 Jim_Obj
*skip
= ExprPop(e
);
8232 Jim_Obj
*B
= ExprPop(e
);
8233 Jim_Obj
*A
= ExprPop(e
);
8235 /* No need to check for A as non-boolean */
8236 if (ExprBool(interp
, A
)) {
8237 /* true, so skip RHS opcodes */
8238 e
->skip
= JimWideValue(skip
);
8239 /* Repush B as the answer */
8243 Jim_DecrRefCount(interp
, skip
);
8244 Jim_DecrRefCount(interp
, A
);
8245 Jim_DecrRefCount(interp
, B
);
8249 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8262 /* name - precedence - arity - opcode
8264 * This array *must* be kept in sync with the JIM_EXPROP enum.
8266 * The following macros pre-compute the string length at compile time.
8268 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8269 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8271 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8272 OPRINIT("*", 110, 2, JimExprOpBin
),
8273 OPRINIT("/", 110, 2, JimExprOpBin
),
8274 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8276 OPRINIT("-", 100, 2, JimExprOpBin
),
8277 OPRINIT("+", 100, 2, JimExprOpBin
),
8279 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8280 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8282 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8283 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8285 OPRINIT("<", 80, 2, JimExprOpBin
),
8286 OPRINIT(">", 80, 2, JimExprOpBin
),
8287 OPRINIT("<=", 80, 2, JimExprOpBin
),
8288 OPRINIT(">=", 80, 2, JimExprOpBin
),
8290 OPRINIT("==", 70, 2, JimExprOpBin
),
8291 OPRINIT("!=", 70, 2, JimExprOpBin
),
8293 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8294 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8295 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8297 OPRINIT_LAZY("&&", 10, 2, NULL
, LAZY_OP
),
8298 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8299 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8301 OPRINIT_LAZY("||", 9, 2, NULL
, LAZY_OP
),
8302 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8303 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8305 OPRINIT_LAZY("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8306 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8307 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8309 OPRINIT_LAZY(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8310 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8311 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8313 OPRINIT("**", 250, 2, JimExprOpBin
),
8315 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8316 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8318 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8319 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8321 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8322 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8323 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8324 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8328 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8329 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8330 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8331 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8332 OPRINIT("rand", 200, 0, JimExprOpNone
),
8333 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8335 #ifdef JIM_MATH_FUNCTIONS
8336 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8337 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8338 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8339 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8340 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8341 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8342 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8343 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8344 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8345 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8346 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8347 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8348 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8349 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8350 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8351 OPRINIT("pow", 200, 2, JimExprOpBin
),
8357 #define JIM_EXPR_OPERATORS_NUM \
8358 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8360 static int JimParseExpression(struct JimParserCtx
*pc
)
8362 /* Discard spaces and quoted newline */
8363 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8364 if (*pc
->p
== '\n') {
8372 pc
->tline
= pc
->linenr
;
8377 pc
->tt
= JIM_TT_EOL
;
8383 pc
->tt
= JIM_TT_SUBEXPR_START
;
8386 pc
->tt
= JIM_TT_SUBEXPR_END
;
8389 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8396 return JimParseCmd(pc
);
8398 if (JimParseVar(pc
) == JIM_ERR
)
8399 return JimParseExprOperator(pc
);
8401 /* Don't allow expr sugar in expressions */
8402 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8419 return JimParseExprNumber(pc
);
8421 return JimParseQuote(pc
);
8423 return JimParseBrace(pc
);
8429 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8430 return JimParseExprOperator(pc
);
8433 return JimParseExprOperator(pc
);
8439 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8443 /* Assume an integer for now */
8444 pc
->tt
= JIM_TT_EXPR_INT
;
8446 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8447 /* Tried as an integer, but perhaps it parses as a double */
8448 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8449 /* Some stupid compilers insist they are cleverer that
8450 * we are. Even a (void) cast doesn't prevent this warning!
8452 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8453 if (end
== pc
->tstart
)
8456 /* Yes, double captured more chars */
8457 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8461 pc
->tend
= pc
->p
- 1;
8462 pc
->len
-= (pc
->p
- pc
->tstart
);
8466 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8468 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8471 for (i
= 0; irrationals
[i
]; i
++) {
8472 const char *irr
= irrationals
[i
];
8474 if (strncmp(irr
, pc
->p
, 3) == 0) {
8477 pc
->tend
= pc
->p
- 1;
8478 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8485 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8488 int bestIdx
= -1, bestLen
= 0;
8490 /* Try to get the longest match. */
8491 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8492 const char * const opname
= Jim_ExprOperators
[i
].name
;
8493 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8495 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8499 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8500 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8504 if (bestIdx
== -1) {
8508 /* Validate paretheses around function arguments */
8509 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8510 const char *p
= pc
->p
+ bestLen
;
8511 int len
= pc
->len
- bestLen
;
8513 while (len
&& isspace(UCHAR(*p
))) {
8521 pc
->tend
= pc
->p
+ bestLen
- 1;
8529 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8531 static Jim_ExprOperator dummy_op
;
8532 if (opcode
< JIM_TT_EXPR_OP
) {
8535 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8538 const char *jim_tt_name(int type
)
8540 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8541 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8543 if (type
< JIM_TT_EXPR_OP
) {
8544 return tt_names
[type
];
8547 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8548 static char buf
[20];
8553 sprintf(buf
, "(%d)", type
);
8558 /* -----------------------------------------------------------------------------
8560 * ---------------------------------------------------------------------------*/
8561 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8562 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8563 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8565 static const Jim_ObjType exprObjType
= {
8567 FreeExprInternalRep
,
8570 JIM_TYPE_REFERENCES
,
8573 /* Expr bytecode structure */
8574 typedef struct ExprByteCode
8576 ScriptToken
*token
; /* Tokens array. */
8577 int len
; /* Length as number of tokens. */
8578 int inUse
; /* Used for sharing. */
8581 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8585 for (i
= 0; i
< expr
->len
; i
++) {
8586 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8588 Jim_Free(expr
->token
);
8592 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8594 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8597 if (--expr
->inUse
!= 0) {
8601 ExprFreeByteCode(interp
, expr
);
8605 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8607 JIM_NOTUSED(interp
);
8608 JIM_NOTUSED(srcPtr
);
8610 /* Just returns an simple string. */
8611 dupPtr
->typePtr
= NULL
;
8614 /* Check if an expr program looks correct. */
8615 static int ExprCheckCorrectness(ExprByteCode
* expr
)
8621 /* Try to check if there are stack underflows,
8622 * and make sure at the end of the program there is
8623 * a single result on the stack. */
8624 for (i
= 0; i
< expr
->len
; i
++) {
8625 ScriptToken
*t
= &expr
->token
[i
];
8626 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8628 stacklen
-= op
->arity
;
8632 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8635 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8639 /* All operations and operands add one to the stack */
8642 if (stacklen
!= 1 || ternary
!= 0) {
8648 /* This procedure converts every occurrence of || and && opereators
8649 * in lazy unary versions.
8651 * a b || is converted into:
8653 * a <offset> |L b |R
8655 * a b && is converted into:
8657 * a <offset> &L b &R
8659 * "|L" checks if 'a' is true:
8660 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8661 * the opcode just after |R.
8662 * 2) if it is false does nothing.
8663 * "|R" checks if 'b' is true:
8664 * 1) if it is true pushes 1, otherwise pushes 0.
8666 * "&L" checks if 'a' is true:
8667 * 1) if it is true does nothing.
8668 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8669 * the opcode just after &R
8670 * "&R" checks if 'a' is true:
8671 * if it is true pushes 1, otherwise pushes 0.
8673 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8677 int leftindex
, arity
, offset
;
8679 /* Search for the end of the first operator */
8680 leftindex
= expr
->len
- 1;
8684 ScriptToken
*tt
= &expr
->token
[leftindex
];
8686 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8687 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8690 if (--leftindex
< 0) {
8697 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8698 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8700 offset
= (expr
->len
- leftindex
) - 1;
8702 /* Now we rely on the fact the the left and right version have opcodes
8703 * 1 and 2 after the main opcode respectively
8705 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8706 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8708 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8709 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8711 /* Now add the 'R' operator */
8712 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8713 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8716 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8717 for (i
= leftindex
- 1; i
> 0; i
--) {
8718 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8719 if (op
->lazy
== LAZY_LEFT
) {
8720 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8721 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8728 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8730 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8731 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8733 if (op
->lazy
== LAZY_OP
) {
8734 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8735 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8740 token
->objPtr
= interp
->emptyObj
;
8741 token
->type
= t
->type
;
8748 * Returns the index of the COLON_LEFT to the left of 'right_index'
8749 * taking into account nesting.
8751 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8753 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8755 int ternary_count
= 1;
8759 while (right_index
> 1) {
8760 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8763 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8766 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8777 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8779 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8780 * Otherwise returns 0.
8782 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8784 int i
= right_index
- 1;
8785 int ternary_count
= 1;
8788 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8789 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8790 *prev_right_index
= i
- 2;
8791 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8795 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8796 if (ternary_count
== 0) {
8807 * ExprTernaryReorderExpression description
8808 * ========================================
8810 * ?: is right-to-left associative which doesn't work with the stack-based
8811 * expression engine. The fix is to reorder the bytecode.
8817 * Has initial bytecode:
8819 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8820 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8822 * The fix involves simulating this expression instead:
8826 * With the following bytecode:
8828 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8829 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8831 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8832 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8833 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8834 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8836 * ExprTernaryReorderExpression works thus as follows :
8837 * - start from the end of the stack
8838 * - while walking towards the beginning of the stack
8839 * if token=JIM_EXPROP_COLON_RIGHT then
8840 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8841 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8842 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8844 * perform the rotation
8845 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8849 * Note: care has to be taken for nested ternary constructs!!!
8851 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
8855 for (i
= expr
->len
- 1; i
> 1; i
--) {
8856 int prev_right_index
;
8857 int prev_left_index
;
8861 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
8865 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8866 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
8871 ** rotate tokens down
8873 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8882 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8884 tmp
= expr
->token
[prev_right_index
];
8885 for (j
= prev_right_index
; j
< i
; j
++) {
8886 expr
->token
[j
] = expr
->token
[j
+ 1];
8888 expr
->token
[i
] = tmp
;
8890 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8892 * This is 'colon left increment' = i - prev_right_index
8894 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8895 * [prev_left_index-1] : skip_count
8898 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
8900 /* Adjust for i-- in the loop */
8905 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*fileNameObj
)
8911 int prevtt
= JIM_TT_NONE
;
8912 int have_ternary
= 0;
8915 int count
= tokenlist
->count
- 1;
8917 expr
= Jim_Alloc(sizeof(*expr
));
8921 Jim_InitStack(&stack
);
8923 /* Need extra bytecodes for lazy operators.
8924 * Also check for the ternary operator
8926 for (i
= 0; i
< tokenlist
->count
; i
++) {
8927 ParseToken
*t
= &tokenlist
->list
[i
];
8928 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8930 if (op
->lazy
== LAZY_OP
) {
8932 /* Ternary is a lazy op but also needs reordering */
8933 if (t
->type
== JIM_EXPROP_TERNARY
) {
8939 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
8941 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
8942 ParseToken
*t
= &tokenlist
->list
[i
];
8944 /* Next token will be stored here */
8945 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8947 if (t
->type
== JIM_TT_EOL
) {
8955 case JIM_TT_DICTSUGAR
:
8956 case JIM_TT_EXPRSUGAR
:
8958 token
->type
= t
->type
;
8960 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
8961 if (t
->type
== JIM_TT_CMD
) {
8962 /* Only commands need source info */
8963 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
8968 case JIM_TT_EXPR_INT
:
8969 case JIM_TT_EXPR_DOUBLE
:
8972 if (t
->type
== JIM_TT_EXPR_INT
) {
8973 token
->objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
8976 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
8978 if (endptr
!= t
->token
+ t
->len
) {
8979 /* Conversion failed, so just store it as a string */
8980 Jim_FreeNewObj(interp
, token
->objPtr
);
8981 token
->type
= JIM_TT_STR
;
8984 token
->type
= t
->type
;
8989 case JIM_TT_SUBEXPR_START
:
8990 Jim_StackPush(&stack
, t
);
8991 prevtt
= JIM_TT_NONE
;
8994 case JIM_TT_SUBEXPR_COMMA
:
8995 /* Simple approach. Comma is simply ignored */
8998 case JIM_TT_SUBEXPR_END
:
9000 while (Jim_StackLen(&stack
)) {
9001 ParseToken
*tt
= Jim_StackPop(&stack
);
9003 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9008 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9013 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
9020 /* Must be an operator */
9021 const struct Jim_ExprOperator
*op
;
9024 /* Convert -/+ to unary minus or unary plus if necessary */
9025 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
9026 if (t
->type
== JIM_EXPROP_SUB
) {
9027 t
->type
= JIM_EXPROP_UNARYMINUS
;
9029 else if (t
->type
== JIM_EXPROP_ADD
) {
9030 t
->type
= JIM_EXPROP_UNARYPLUS
;
9034 op
= JimExprOperatorInfoByOpcode(t
->type
);
9036 /* Now handle precedence */
9037 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9038 const struct Jim_ExprOperator
*tt_op
=
9039 JimExprOperatorInfoByOpcode(tt
->type
);
9041 /* Note that right-to-left associativity of ?: operator is handled later */
9043 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9044 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9048 Jim_StackPop(&stack
);
9054 Jim_StackPush(&stack
, t
);
9061 /* Reduce any remaining subexpr */
9062 while (Jim_StackLen(&stack
)) {
9063 ParseToken
*tt
= Jim_StackPop(&stack
);
9065 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9067 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9070 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9077 ExprTernaryReorderExpression(interp
, expr
);
9081 /* Free the stack used for the compilation. */
9082 Jim_FreeStack(&stack
);
9084 for (i
= 0; i
< expr
->len
; i
++) {
9085 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9089 ExprFreeByteCode(interp
, expr
);
9097 /* This method takes the string representation of an expression
9098 * and generates a program for the Expr's stack-based VM. */
9099 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9102 const char *exprText
;
9103 struct JimParserCtx parser
;
9104 struct ExprByteCode
*expr
;
9105 ParseTokenList tokenlist
;
9107 Jim_Obj
*fileNameObj
;
9110 /* Try to get information about filename / line number */
9111 if (objPtr
->typePtr
== &sourceObjType
) {
9112 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9113 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9116 fileNameObj
= interp
->emptyObj
;
9119 Jim_IncrRefCount(fileNameObj
);
9121 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9123 /* Initially tokenise the expression into tokenlist */
9124 ScriptTokenListInit(&tokenlist
);
9126 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9127 while (!parser
.eof
) {
9128 if (JimParseExpression(&parser
) != JIM_OK
) {
9129 ScriptTokenListFree(&tokenlist
);
9131 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9136 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9140 #ifdef DEBUG_SHOW_EXPR_TOKENS
9143 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9144 for (i
= 0; i
< tokenlist
.count
; i
++) {
9145 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9146 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9151 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9152 ScriptTokenListFree(&tokenlist
);
9153 Jim_DecrRefCount(interp
, fileNameObj
);
9157 /* Now create the expression bytecode from the tokenlist */
9158 expr
= ExprCreateByteCode(interp
, &tokenlist
, fileNameObj
);
9160 /* No longer need the token list */
9161 ScriptTokenListFree(&tokenlist
);
9167 #ifdef DEBUG_SHOW_EXPR
9171 printf("==== Expr ====\n");
9172 for (i
= 0; i
< expr
->len
; i
++) {
9173 ScriptToken
*t
= &expr
->token
[i
];
9175 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9180 /* Check program correctness. */
9181 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
9182 ExprFreeByteCode(interp
, expr
);
9189 /* Free the old internal rep and set the new one. */
9190 Jim_DecrRefCount(interp
, fileNameObj
);
9191 Jim_FreeIntRep(interp
, objPtr
);
9192 Jim_SetIntRepPtr(objPtr
, expr
);
9193 objPtr
->typePtr
= &exprObjType
;
9197 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9199 if (objPtr
->typePtr
!= &exprObjType
) {
9200 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9204 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9207 #ifdef JIM_OPTIMIZATION
9208 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9210 if (token
->type
== JIM_TT_EXPR_INT
)
9211 return token
->objPtr
;
9212 else if (token
->type
== JIM_TT_VAR
)
9213 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9214 else if (token
->type
== JIM_TT_DICTSUGAR
)
9215 return JimExpandDictSugar(interp
, token
->objPtr
);
9221 /* -----------------------------------------------------------------------------
9222 * Expressions evaluation.
9223 * Jim uses a specialized stack-based virtual machine for expressions,
9224 * that takes advantage of the fact that expr's operators
9225 * can't be redefined.
9227 * Jim_EvalExpression() uses the bytecode compiled by
9228 * SetExprFromAny() method of the "expression" object.
9230 * On success a Tcl Object containing the result of the evaluation
9231 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9233 * On error the function returns a retcode != to JIM_OK and set a suitable
9234 * error on the interp.
9235 * ---------------------------------------------------------------------------*/
9236 #define JIM_EE_STATICSTACK_LEN 10
9238 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9241 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9243 int retcode
= JIM_OK
;
9244 struct JimExprState e
;
9246 expr
= JimGetExpression(interp
, exprObjPtr
);
9248 return JIM_ERR
; /* error in expression. */
9251 #ifdef JIM_OPTIMIZATION
9252 /* Check for one of the following common expressions used by while/for
9257 * $a < CONST, $a < $b
9258 * $a <= CONST, $a <= $b
9259 * $a > CONST, $a > $b
9260 * $a >= CONST, $a >= $b
9261 * $a != CONST, $a != $b
9262 * $a == CONST, $a == $b
9267 /* STEP 1 -- Check if there are the conditions to run the specialized
9268 * version of while */
9270 switch (expr
->len
) {
9272 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9274 Jim_IncrRefCount(objPtr
);
9275 *exprResultPtrPtr
= objPtr
;
9281 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9282 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9284 if (objPtr
&& JimIsWide(objPtr
)) {
9285 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9286 Jim_IncrRefCount(*exprResultPtrPtr
);
9293 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9294 if (objPtr
&& JimIsWide(objPtr
)) {
9295 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9296 if (objPtr2
&& JimIsWide(objPtr2
)) {
9297 jim_wide wideValueA
= JimWideValue(objPtr
);
9298 jim_wide wideValueB
= JimWideValue(objPtr2
);
9300 switch (expr
->token
[2].type
) {
9302 cmpRes
= wideValueA
< wideValueB
;
9304 case JIM_EXPROP_LTE
:
9305 cmpRes
= wideValueA
<= wideValueB
;
9308 cmpRes
= wideValueA
> wideValueB
;
9310 case JIM_EXPROP_GTE
:
9311 cmpRes
= wideValueA
>= wideValueB
;
9313 case JIM_EXPROP_NUMEQ
:
9314 cmpRes
= wideValueA
== wideValueB
;
9316 case JIM_EXPROP_NUMNE
:
9317 cmpRes
= wideValueA
!= wideValueB
;
9322 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9323 Jim_IncrRefCount(*exprResultPtrPtr
);
9333 /* In order to avoid that the internal repr gets freed due to
9334 * shimmering of the exprObjPtr's object, we make the internal rep
9338 /* The stack-based expr VM itself */
9340 /* Stack allocation. Expr programs have the feature that
9341 * a program of length N can't require a stack longer than
9343 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9344 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9346 e
.stack
= staticStack
;
9350 /* Execute every instruction */
9351 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9354 switch (expr
->token
[i
].type
) {
9355 case JIM_TT_EXPR_INT
:
9356 case JIM_TT_EXPR_DOUBLE
:
9358 ExprPush(&e
, expr
->token
[i
].objPtr
);
9362 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9364 ExprPush(&e
, objPtr
);
9371 case JIM_TT_DICTSUGAR
:
9372 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9374 ExprPush(&e
, objPtr
);
9382 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9383 if (retcode
== JIM_OK
) {
9384 ExprPush(&e
, objPtr
);
9389 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9390 if (retcode
== JIM_OK
) {
9391 ExprPush(&e
, Jim_GetResult(interp
));
9396 /* Find and execute the operation */
9398 e
.opcode
= expr
->token
[i
].type
;
9400 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9401 /* Skip some opcodes if necessary */
9410 if (retcode
== JIM_OK
) {
9411 *exprResultPtrPtr
= ExprPop(&e
);
9414 for (i
= 0; i
< e
.stacklen
; i
++) {
9415 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9418 if (e
.stack
!= staticStack
) {
9424 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9429 Jim_Obj
*exprResultPtr
;
9431 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9432 if (retcode
!= JIM_OK
)
9435 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9436 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9437 Jim_DecrRefCount(interp
, exprResultPtr
);
9441 Jim_DecrRefCount(interp
, exprResultPtr
);
9442 *boolPtr
= doubleValue
!= 0;
9446 *boolPtr
= wideValue
!= 0;
9448 Jim_DecrRefCount(interp
, exprResultPtr
);
9452 /* -----------------------------------------------------------------------------
9453 * ScanFormat String Object
9454 * ---------------------------------------------------------------------------*/
9456 /* This Jim_Obj will held a parsed representation of a format string passed to
9457 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9458 * to be parsed in its entirely first and then, if correct, can be used for
9459 * scanning. To avoid endless re-parsing, the parsed representation will be
9460 * stored in an internal representation and re-used for performance reason. */
9462 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9463 * scanformat string. This part will later be used to extract information
9464 * out from the string to be parsed by Jim_ScanString */
9466 typedef struct ScanFmtPartDescr
9468 char *arg
; /* Specification of a CHARSET conversion */
9469 char *prefix
; /* Prefix to be scanned literally before conversion */
9470 size_t width
; /* Maximal width of input to be converted */
9471 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9472 char type
; /* Type of conversion (e.g. c, d, f) */
9473 char modifier
; /* Modify type (e.g. l - long, h - short */
9476 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9477 * string parsed and separated in part descriptions. Furthermore it contains
9478 * the original string representation of the scanformat string to allow for
9479 * fast update of the Jim_Obj's string representation part.
9481 * As an add-on the internal object representation adds some scratch pad area
9482 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9483 * memory for purpose of string scanning.
9485 * The error member points to a static allocated string in case of a mal-
9486 * formed scanformat string or it contains '0' (NULL) in case of a valid
9487 * parse representation.
9489 * The whole memory of the internal representation is allocated as a single
9490 * area of memory that will be internally separated. So freeing and duplicating
9491 * of such an object is cheap */
9493 typedef struct ScanFmtStringObj
9495 jim_wide size
; /* Size of internal repr in bytes */
9496 char *stringRep
; /* Original string representation */
9497 size_t count
; /* Number of ScanFmtPartDescr contained */
9498 size_t convCount
; /* Number of conversions that will assign */
9499 size_t maxPos
; /* Max position index if XPG3 is used */
9500 const char *error
; /* Ptr to error text (NULL if no error */
9501 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9502 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9506 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9507 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9508 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9510 static const Jim_ObjType scanFmtStringObjType
= {
9512 FreeScanFmtInternalRep
,
9513 DupScanFmtInternalRep
,
9514 UpdateStringOfScanFmt
,
9518 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9520 JIM_NOTUSED(interp
);
9521 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9522 objPtr
->internalRep
.ptr
= 0;
9525 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9527 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9528 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9530 JIM_NOTUSED(interp
);
9531 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9532 dupPtr
->internalRep
.ptr
= newVec
;
9533 dupPtr
->typePtr
= &scanFmtStringObjType
;
9536 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9538 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9541 /* SetScanFmtFromAny will parse a given string and create the internal
9542 * representation of the format specification. In case of an error
9543 * the error data member of the internal representation will be set
9544 * to an descriptive error text and the function will be left with
9545 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9548 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9550 ScanFmtStringObj
*fmtObj
;
9552 int maxCount
, i
, approxSize
, lastPos
= -1;
9553 const char *fmt
= objPtr
->bytes
;
9554 int maxFmtLen
= objPtr
->length
;
9555 const char *fmtEnd
= fmt
+ maxFmtLen
;
9558 Jim_FreeIntRep(interp
, objPtr
);
9559 /* Count how many conversions could take place maximally */
9560 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9563 /* Calculate an approximation of the memory necessary */
9564 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9565 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9566 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9567 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9568 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9569 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9570 +1; /* safety byte */
9571 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9572 memset(fmtObj
, 0, approxSize
);
9573 fmtObj
->size
= approxSize
;
9575 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9576 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9577 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9578 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9579 objPtr
->internalRep
.ptr
= fmtObj
;
9580 objPtr
->typePtr
= &scanFmtStringObjType
;
9581 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9582 int width
= 0, skip
;
9583 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9586 descr
->width
= 0; /* Assume width unspecified */
9587 /* Overread and store any "literal" prefix */
9588 if (*fmt
!= '%' || fmt
[1] == '%') {
9590 descr
->prefix
= &buffer
[i
];
9591 for (; fmt
< fmtEnd
; ++fmt
) {
9601 /* Skip the conversion introducing '%' sign */
9603 /* End reached due to non-conversion literal only? */
9606 descr
->pos
= 0; /* Assume "natural" positioning */
9608 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9612 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9613 /* Check if next token is a number (could be width or pos */
9614 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9616 /* Was the number a XPG3 position specifier? */
9617 if (descr
->pos
!= -1 && *fmt
== '$') {
9623 /* Look if "natural" postioning and XPG3 one was mixed */
9624 if ((lastPos
== 0 && descr
->pos
> 0)
9625 || (lastPos
> 0 && descr
->pos
== 0)) {
9626 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9629 /* Look if this position was already used */
9630 for (prev
= 0; prev
< curr
; ++prev
) {
9631 if (fmtObj
->descr
[prev
].pos
== -1)
9633 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9635 "variable is assigned by multiple \"%n$\" conversion specifiers";
9639 /* Try to find a width after the XPG3 specifier */
9640 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9641 descr
->width
= width
;
9644 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9645 fmtObj
->maxPos
= descr
->pos
;
9648 /* Number was not a XPG3, so it has to be a width */
9649 descr
->width
= width
;
9652 /* If positioning mode was undetermined yet, fix this */
9654 lastPos
= descr
->pos
;
9655 /* Handle CHARSET conversion type ... */
9657 int swapped
= 1, beg
= i
, end
, j
;
9660 descr
->arg
= &buffer
[i
];
9663 buffer
[i
++] = *fmt
++;
9665 buffer
[i
++] = *fmt
++;
9666 while (*fmt
&& *fmt
!= ']')
9667 buffer
[i
++] = *fmt
++;
9669 fmtObj
->error
= "unmatched [ in format string";
9674 /* In case a range fence was given "backwards", swap it */
9677 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9678 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9679 char tmp
= buffer
[j
- 1];
9681 buffer
[j
- 1] = buffer
[j
+ 1];
9682 buffer
[j
+ 1] = tmp
;
9689 /* Remember any valid modifier if given */
9690 if (strchr("hlL", *fmt
) != 0)
9691 descr
->modifier
= tolower((int)*fmt
++);
9694 if (strchr("efgcsndoxui", *fmt
) == 0) {
9695 fmtObj
->error
= "bad scan conversion character";
9698 else if (*fmt
== 'c' && descr
->width
!= 0) {
9699 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9702 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9703 fmtObj
->error
= "unsigned wide not supported";
9713 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9715 #define FormatGetCnvCount(_fo_) \
9716 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9717 #define FormatGetMaxPos(_fo_) \
9718 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9719 #define FormatGetError(_fo_) \
9720 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9722 /* JimScanAString is used to scan an unspecified string that ends with
9723 * next WS, or a string that is specified via a charset.
9726 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9728 char *buffer
= Jim_StrDup(str
);
9735 if (!sdescr
&& isspace(UCHAR(*str
)))
9736 break; /* EOS via WS if unspecified */
9738 n
= utf8_tounicode(str
, &c
);
9739 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9745 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9748 /* ScanOneEntry will scan one entry out of the string passed as argument.
9749 * It use the sscanf() function for this task. After extracting and
9750 * converting of the value, the count of scanned characters will be
9751 * returned of -1 in case of no conversion tool place and string was
9752 * already scanned thru */
9754 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9755 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9758 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9760 size_t anchor
= pos
;
9762 Jim_Obj
*tmpObj
= NULL
;
9764 /* First pessimistically assume, we will not scan anything :-) */
9766 if (descr
->prefix
) {
9767 /* There was a prefix given before the conversion, skip it and adjust
9768 * the string-to-be-parsed accordingly */
9769 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9770 /* If prefix require, skip WS */
9771 if (isspace(UCHAR(descr
->prefix
[i
])))
9772 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9774 else if (descr
->prefix
[i
] != str
[pos
])
9775 break; /* Prefix do not match here, leave the loop */
9777 ++pos
; /* Prefix matched so far, next round */
9779 if (pos
>= strLen
) {
9780 return -1; /* All of str consumed: EOF condition */
9782 else if (descr
->prefix
[i
] != 0)
9783 return 0; /* Not whole prefix consumed, no conversion possible */
9785 /* For all but following conversion, skip leading WS */
9786 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9787 while (isspace(UCHAR(str
[pos
])))
9789 /* Determine how much skipped/scanned so far */
9790 scanned
= pos
- anchor
;
9792 /* %c is a special, simple case. no width */
9793 if (descr
->type
== 'n') {
9794 /* Return pseudo conversion means: how much scanned so far? */
9795 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9797 else if (pos
>= strLen
) {
9798 /* Cannot scan anything, as str is totally consumed */
9801 else if (descr
->type
== 'c') {
9803 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9804 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9808 /* Processing of conversions follows ... */
9809 if (descr
->width
> 0) {
9810 /* Do not try to scan as fas as possible but only the given width.
9811 * To ensure this, we copy the part that should be scanned. */
9812 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9813 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9815 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9816 tok
= tmpObj
->bytes
;
9819 /* As no width was given, simply refer to the original string */
9822 switch (descr
->type
) {
9828 char *endp
; /* Position where the number finished */
9831 int base
= descr
->type
== 'o' ? 8
9832 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
9834 /* Try to scan a number with the given base */
9836 w
= jim_strtoull(tok
, &endp
);
9839 w
= strtoull(tok
, &endp
, base
);
9843 /* There was some number sucessfully scanned! */
9844 *valObjPtr
= Jim_NewIntObj(interp
, w
);
9846 /* Adjust the number-of-chars scanned so far */
9847 scanned
+= endp
- tok
;
9850 /* Nothing was scanned. We have to determine if this
9851 * happened due to e.g. prefix mismatch or input str
9853 scanned
= *tok
? 0 : -1;
9859 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
9860 scanned
+= Jim_Length(*valObjPtr
);
9867 double value
= strtod(tok
, &endp
);
9870 /* There was some number sucessfully scanned! */
9871 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
9872 /* Adjust the number-of-chars scanned so far */
9873 scanned
+= endp
- tok
;
9876 /* Nothing was scanned. We have to determine if this
9877 * happened due to e.g. prefix mismatch or input str
9879 scanned
= *tok
? 0 : -1;
9884 /* If a substring was allocated (due to pre-defined width) do not
9885 * forget to free it */
9887 Jim_FreeNewObj(interp
, tmpObj
);
9893 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9894 * string and returns all converted (and not ignored) values in a list back
9895 * to the caller. If an error occured, a NULL pointer will be returned */
9897 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
9901 const char *str
= Jim_String(strObjPtr
);
9902 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
9903 Jim_Obj
*resultList
= 0;
9904 Jim_Obj
**resultVec
= 0;
9906 Jim_Obj
*emptyStr
= 0;
9907 ScanFmtStringObj
*fmtObj
;
9909 /* This should never happen. The format object should already be of the correct type */
9910 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
9912 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
9913 /* Check if format specification was valid */
9914 if (fmtObj
->error
!= 0) {
9915 if (flags
& JIM_ERRMSG
)
9916 Jim_SetResultString(interp
, fmtObj
->error
, -1);
9919 /* Allocate a new "shared" empty string for all unassigned conversions */
9920 emptyStr
= Jim_NewEmptyStringObj(interp
);
9921 Jim_IncrRefCount(emptyStr
);
9922 /* Create a list and fill it with empty strings up to max specified XPG3 */
9923 resultList
= Jim_NewListObj(interp
, NULL
, 0);
9924 if (fmtObj
->maxPos
> 0) {
9925 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
9926 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
9927 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
9929 /* Now handle every partial format description */
9930 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
9931 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
9934 /* Only last type may be "literal" w/o conversion - skip it! */
9935 if (descr
->type
== 0)
9937 /* As long as any conversion could be done, we will proceed */
9939 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
9940 /* In case our first try results in EOF, we will leave */
9941 if (scanned
== -1 && i
== 0)
9943 /* Advance next pos-to-be-scanned for the amount scanned already */
9946 /* value == 0 means no conversion took place so take empty string */
9948 value
= Jim_NewEmptyStringObj(interp
);
9949 /* If value is a non-assignable one, skip it */
9950 if (descr
->pos
== -1) {
9951 Jim_FreeNewObj(interp
, value
);
9953 else if (descr
->pos
== 0)
9954 /* Otherwise append it to the result list if no XPG3 was given */
9955 Jim_ListAppendElement(interp
, resultList
, value
);
9956 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
9957 /* But due to given XPG3, put the value into the corr. slot */
9958 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
9959 Jim_IncrRefCount(value
);
9960 resultVec
[descr
->pos
- 1] = value
;
9963 /* Otherwise, the slot was already used - free obj and ERROR */
9964 Jim_FreeNewObj(interp
, value
);
9968 Jim_DecrRefCount(interp
, emptyStr
);
9971 Jim_DecrRefCount(interp
, emptyStr
);
9972 Jim_FreeNewObj(interp
, resultList
);
9973 return (Jim_Obj
*)EOF
;
9975 Jim_DecrRefCount(interp
, emptyStr
);
9976 Jim_FreeNewObj(interp
, resultList
);
9980 /* -----------------------------------------------------------------------------
9981 * Pseudo Random Number Generation
9982 * ---------------------------------------------------------------------------*/
9983 /* Initialize the sbox with the numbers from 0 to 255 */
9984 static void JimPrngInit(Jim_Interp
*interp
)
9986 #define PRNG_SEED_SIZE 256
9989 time_t t
= time(NULL
);
9991 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
9993 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
9994 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
9995 seed
[i
] = (rand() ^ t
^ clock());
9997 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10001 /* Generates N bytes of random data */
10002 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10004 Jim_PrngState
*prng
;
10005 unsigned char *destByte
= (unsigned char *)dest
;
10006 unsigned int si
, sj
, x
;
10008 /* initialization, only needed the first time */
10009 if (interp
->prngState
== NULL
)
10010 JimPrngInit(interp
);
10011 prng
= interp
->prngState
;
10012 /* generates 'len' bytes of pseudo-random numbers */
10013 for (x
= 0; x
< len
; x
++) {
10014 prng
->i
= (prng
->i
+ 1) & 0xff;
10015 si
= prng
->sbox
[prng
->i
];
10016 prng
->j
= (prng
->j
+ si
) & 0xff;
10017 sj
= prng
->sbox
[prng
->j
];
10018 prng
->sbox
[prng
->i
] = sj
;
10019 prng
->sbox
[prng
->j
] = si
;
10020 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10024 /* Re-seed the generator with user-provided bytes */
10025 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10028 Jim_PrngState
*prng
;
10030 /* initialization, only needed the first time */
10031 if (interp
->prngState
== NULL
)
10032 JimPrngInit(interp
);
10033 prng
= interp
->prngState
;
10035 /* Set the sbox[i] with i */
10036 for (i
= 0; i
< 256; i
++)
10038 /* Now use the seed to perform a random permutation of the sbox */
10039 for (i
= 0; i
< seedLen
; i
++) {
10042 t
= prng
->sbox
[i
& 0xFF];
10043 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10044 prng
->sbox
[seed
[i
]] = t
;
10046 prng
->i
= prng
->j
= 0;
10048 /* discard at least the first 256 bytes of stream.
10049 * borrow the seed buffer for this
10051 for (i
= 0; i
< 256; i
+= seedLen
) {
10052 JimRandomBytes(interp
, seed
, seedLen
);
10057 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10059 jim_wide wideValue
, increment
= 1;
10060 Jim_Obj
*intObjPtr
;
10062 if (argc
!= 2 && argc
!= 3) {
10063 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10067 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10070 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10072 /* Set missing variable to 0 */
10075 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10078 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10079 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10080 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10081 Jim_FreeNewObj(interp
, intObjPtr
);
10086 /* Can do it the quick way */
10087 Jim_InvalidateStringRep(intObjPtr
);
10088 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10090 /* The following step is required in order to invalidate the
10091 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10092 if (argv
[1]->typePtr
!= &variableObjType
) {
10093 /* Note that this can't fail since GetVariable already succeeded */
10094 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10097 Jim_SetResult(interp
, intObjPtr
);
10102 /* -----------------------------------------------------------------------------
10104 * ---------------------------------------------------------------------------*/
10105 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10106 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10108 /* Handle calls to the [unknown] command */
10109 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10113 /* If JimUnknown() is recursively called too many times...
10116 if (interp
->unknown_called
> 50) {
10120 /* The object interp->unknown just contains
10121 * the "unknown" string, it is used in order to
10122 * avoid to lookup the unknown command every time
10123 * but instead to cache the result. */
10125 /* If the [unknown] command does not exist ... */
10126 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10129 interp
->unknown_called
++;
10130 /* XXX: Are we losing fileNameObj and linenr? */
10131 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10132 interp
->unknown_called
--;
10137 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10145 for (j
= 0; j
< objc
; j
++) {
10146 printf(" '%s'", Jim_String(objv
[j
]));
10151 if (interp
->framePtr
->tailcallCmd
) {
10152 /* Special tailcall command was pre-resolved */
10153 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10154 interp
->framePtr
->tailcallCmd
= NULL
;
10157 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10158 if (cmdPtr
== NULL
) {
10159 return JimUnknown(interp
, objc
, objv
);
10161 JimIncrCmdRefCount(cmdPtr
);
10164 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10165 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10169 interp
->evalDepth
++;
10171 /* Call it -- Make sure result is an empty object. */
10172 Jim_SetEmptyResult(interp
);
10173 if (cmdPtr
->isproc
) {
10174 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10177 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10178 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10180 interp
->evalDepth
--;
10183 JimDecrCmdRefCount(interp
, cmdPtr
);
10188 /* Eval the object vector 'objv' composed of 'objc' elements.
10189 * Every element is used as single argument.
10190 * Jim_EvalObj() will call this function every time its object
10191 * argument is of "list" type, with no string representation.
10193 * This is possible because the string representation of a
10194 * list object generated by the UpdateStringOfList is made
10195 * in a way that ensures that every list element is a different
10196 * command argument. */
10197 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10201 /* Incr refcount of arguments. */
10202 for (i
= 0; i
< objc
; i
++)
10203 Jim_IncrRefCount(objv
[i
]);
10205 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10207 /* Decr refcount of arguments and return the retcode */
10208 for (i
= 0; i
< objc
; i
++)
10209 Jim_DecrRefCount(interp
, objv
[i
]);
10215 * Invokes 'prefix' as a command with the objv array as arguments.
10217 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10220 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10223 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10224 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10229 static void JimAddErrorToStack(Jim_Interp
*interp
, int retcode
, ScriptObj
*script
)
10233 if (rc
== JIM_ERR
&& !interp
->errorFlag
) {
10234 /* This is the first error, so save the file/line information and reset the stack */
10235 interp
->errorFlag
= 1;
10236 Jim_IncrRefCount(script
->fileNameObj
);
10237 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10238 interp
->errorFileNameObj
= script
->fileNameObj
;
10239 interp
->errorLine
= script
->linenr
;
10241 JimResetStackTrace(interp
);
10242 /* Always add a level where the error first occurs */
10243 interp
->addStackTrace
++;
10246 /* Now if this is an "interesting" level, add it to the stack trace */
10247 if (rc
== JIM_ERR
&& interp
->addStackTrace
> 0) {
10248 /* Add the stack info for the current level */
10250 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10252 /* Note: if we didn't have a filename for this level,
10253 * don't clear the addStackTrace flag
10254 * so we can pick it up at the next level
10256 if (Jim_Length(script
->fileNameObj
)) {
10257 interp
->addStackTrace
= 0;
10260 Jim_DecrRefCount(interp
, interp
->errorProc
);
10261 interp
->errorProc
= interp
->emptyObj
;
10262 Jim_IncrRefCount(interp
->errorProc
);
10264 else if (rc
== JIM_RETURN
&& interp
->returnCode
== JIM_ERR
) {
10265 /* Propagate the addStackTrace value through 'return -code error' */
10268 interp
->addStackTrace
= 0;
10272 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10276 switch (token
->type
) {
10279 objPtr
= token
->objPtr
;
10282 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10284 case JIM_TT_DICTSUGAR
:
10285 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10287 case JIM_TT_EXPRSUGAR
:
10288 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10291 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10294 objPtr
= interp
->result
;
10297 /* Stop substituting */
10300 /* just skip this one */
10301 return JIM_CONTINUE
;
10308 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10313 *objPtrPtr
= objPtr
;
10319 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10320 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10321 * The returned object has refcount = 0.
10323 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10327 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10331 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10334 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10336 /* Compute every token forming the argument
10337 * in the intv objects vector. */
10338 for (i
= 0; i
< tokens
; i
++) {
10339 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10344 if (flags
& JIM_SUBST_FLAG
) {
10349 /* XXX: Should probably set an error about break outside loop */
10350 /* fall through to error */
10352 if (flags
& JIM_SUBST_FLAG
) {
10356 /* XXX: Ditto continue outside loop */
10357 /* fall through to error */
10360 Jim_DecrRefCount(interp
, intv
[i
]);
10362 if (intv
!= sintv
) {
10367 Jim_IncrRefCount(intv
[i
]);
10368 Jim_String(intv
[i
]);
10369 totlen
+= intv
[i
]->length
;
10372 /* Fast path return for a single token */
10373 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10374 Jim_DecrRefCount(interp
, intv
[0]);
10378 /* Concatenate every token in an unique
10380 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10382 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10383 && token
[2].type
== JIM_TT_VAR
) {
10384 /* May be able to do fast interpolated object -> dictSubst */
10385 objPtr
->typePtr
= &interpolatedObjType
;
10386 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10387 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10388 Jim_IncrRefCount(intv
[2]);
10390 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10391 /* The first interpolated token is source, so preserve the source info */
10392 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10396 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10397 objPtr
->length
= totlen
;
10398 for (i
= 0; i
< tokens
; i
++) {
10400 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10401 s
+= intv
[i
]->length
;
10402 Jim_DecrRefCount(interp
, intv
[i
]);
10405 objPtr
->bytes
[totlen
] = '\0';
10406 /* Free the intv vector if not static. */
10407 if (intv
!= sintv
) {
10415 /* listPtr *must* be a list.
10416 * The contents of the list is evaluated with the first element as the command and
10417 * the remaining elements as the arguments.
10419 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10421 int retcode
= JIM_OK
;
10423 if (listPtr
->internalRep
.listValue
.len
) {
10424 Jim_IncrRefCount(listPtr
);
10425 retcode
= JimInvokeCommand(interp
,
10426 listPtr
->internalRep
.listValue
.len
,
10427 listPtr
->internalRep
.listValue
.ele
);
10428 Jim_DecrRefCount(interp
, listPtr
);
10433 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10435 SetListFromAny(interp
, listPtr
);
10436 return JimEvalObjList(interp
, listPtr
);
10439 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10443 ScriptToken
*token
;
10444 int retcode
= JIM_OK
;
10445 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10446 Jim_Obj
*prevScriptObj
;
10448 /* If the object is of type "list", with no string rep we can call
10449 * a specialized version of Jim_EvalObj() */
10450 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10451 return JimEvalObjList(interp
, scriptObjPtr
);
10454 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10455 script
= Jim_GetScript(interp
, scriptObjPtr
);
10456 if (script
== NULL
) {
10457 Jim_DecrRefCount(interp
, scriptObjPtr
);
10461 /* Reset the interpreter result. This is useful to
10462 * return the empty result in the case of empty program. */
10463 Jim_SetEmptyResult(interp
);
10465 token
= script
->token
;
10467 #ifdef JIM_OPTIMIZATION
10468 /* Check for one of the following common scripts used by for, while
10473 if (script
->len
== 0) {
10474 Jim_DecrRefCount(interp
, scriptObjPtr
);
10477 if (script
->len
== 3
10478 && token
[1].objPtr
->typePtr
== &commandObjType
10479 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10480 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10481 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10483 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10485 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10486 JimWideValue(objPtr
)++;
10487 Jim_InvalidateStringRep(objPtr
);
10488 Jim_DecrRefCount(interp
, scriptObjPtr
);
10489 Jim_SetResult(interp
, objPtr
);
10495 /* Now we have to make sure the internal repr will not be
10496 * freed on shimmering.
10498 * Think for example to this:
10500 * set x {llength $x; ... some more code ...}; eval $x
10502 * In order to preserve the internal rep, we increment the
10503 * inUse field of the script internal rep structure. */
10506 /* Stash the current script */
10507 prevScriptObj
= interp
->currentScriptObj
;
10508 interp
->currentScriptObj
= scriptObjPtr
;
10510 interp
->errorFlag
= 0;
10513 /* Execute every command sequentially until the end of the script
10514 * or an error occurs.
10516 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10520 /* First token of the line is always JIM_TT_LINE */
10521 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10522 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10524 /* Allocate the arguments vector if required */
10525 if (argc
> JIM_EVAL_SARGV_LEN
)
10526 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10528 /* Skip the JIM_TT_LINE token */
10531 /* Populate the arguments objects.
10532 * If an error occurs, retcode will be set and
10533 * 'j' will be set to the number of args expanded
10535 for (j
= 0; j
< argc
; j
++) {
10536 long wordtokens
= 1;
10538 Jim_Obj
*wordObjPtr
= NULL
;
10540 if (token
[i
].type
== JIM_TT_WORD
) {
10541 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10542 if (wordtokens
< 0) {
10544 wordtokens
= -wordtokens
;
10548 if (wordtokens
== 1) {
10549 /* Fast path if the token does not
10550 * need interpolation */
10552 switch (token
[i
].type
) {
10555 wordObjPtr
= token
[i
].objPtr
;
10558 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10560 case JIM_TT_EXPRSUGAR
:
10561 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10563 case JIM_TT_DICTSUGAR
:
10564 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10567 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10568 if (retcode
== JIM_OK
) {
10569 wordObjPtr
= Jim_GetResult(interp
);
10573 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10577 /* For interpolation we call a helper
10578 * function to do the work for us. */
10579 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10583 if (retcode
== JIM_OK
) {
10589 Jim_IncrRefCount(wordObjPtr
);
10593 argv
[j
] = wordObjPtr
;
10596 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10597 int len
= Jim_ListLength(interp
, wordObjPtr
);
10598 int newargc
= argc
+ len
- 1;
10602 if (argv
== sargv
) {
10603 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10604 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10605 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10609 /* Need to realloc to make room for (len - 1) more entries */
10610 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10614 /* Now copy in the expanded version */
10615 for (k
= 0; k
< len
; k
++) {
10616 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10617 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10620 /* The original object reference is no longer needed,
10621 * after the expansion it is no longer present on
10622 * the argument vector, but the single elements are
10624 Jim_DecrRefCount(interp
, wordObjPtr
);
10626 /* And update the indexes */
10632 if (retcode
== JIM_OK
&& argc
) {
10633 /* Invoke the command */
10634 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10635 /* Check for a signal after each command */
10636 if (Jim_CheckSignal(interp
)) {
10637 retcode
= JIM_SIGNAL
;
10641 /* Finished with the command, so decrement ref counts of each argument */
10643 Jim_DecrRefCount(interp
, argv
[j
]);
10646 if (argv
!= sargv
) {
10652 /* Possibly add to the error stack trace */
10653 JimAddErrorToStack(interp
, retcode
, script
);
10655 /* Restore the current script */
10656 interp
->currentScriptObj
= prevScriptObj
;
10658 /* Note that we don't have to decrement inUse, because the
10659 * following code transfers our use of the reference again to
10660 * the script object. */
10661 Jim_FreeIntRep(interp
, scriptObjPtr
);
10662 scriptObjPtr
->typePtr
= &scriptObjType
;
10663 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10664 Jim_DecrRefCount(interp
, scriptObjPtr
);
10669 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10672 /* If argObjPtr begins with '&', do an automatic upvar */
10673 const char *varname
= Jim_String(argNameObj
);
10674 if (*varname
== '&') {
10675 /* First check that the target variable exists */
10677 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10679 interp
->framePtr
= interp
->framePtr
->parent
;
10680 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10681 interp
->framePtr
= savedCallFrame
;
10686 /* It exists, so perform the binding. */
10687 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10688 Jim_IncrRefCount(objPtr
);
10689 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10690 Jim_DecrRefCount(interp
, objPtr
);
10693 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10699 * Sets the interp result to be an error message indicating the required proc args.
10701 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10703 /* Create a nice error message, consistent with Tcl 8.5 */
10704 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10707 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10708 Jim_AppendString(interp
, argmsg
, " ", 1);
10710 if (i
== cmd
->u
.proc
.argsPos
) {
10711 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10713 Jim_AppendString(interp
, argmsg
, "?", 1);
10714 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10715 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10718 /* We have plain args */
10719 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10723 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10724 Jim_AppendString(interp
, argmsg
, "?", 1);
10725 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10726 Jim_AppendString(interp
, argmsg
, "?", 1);
10729 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10733 Jim_AppendString(interp
, argmsg
, arg
, -1);
10737 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10738 Jim_FreeNewObj(interp
, argmsg
);
10741 #ifdef jim_ext_namespace
10745 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10747 Jim_CallFrame
*callFramePtr
;
10750 /* Create a new callframe */
10751 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10752 callFramePtr
->argv
= &interp
->emptyObj
;
10753 callFramePtr
->argc
= 0;
10754 callFramePtr
->procArgsObjPtr
= NULL
;
10755 callFramePtr
->procBodyObjPtr
= scriptObj
;
10756 callFramePtr
->staticVars
= NULL
;
10757 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10758 callFramePtr
->line
= 0;
10759 Jim_IncrRefCount(scriptObj
);
10760 interp
->framePtr
= callFramePtr
;
10762 /* Check if there are too nested calls */
10763 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10764 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10768 /* Eval the body */
10769 retcode
= Jim_EvalObj(interp
, scriptObj
);
10772 /* Destroy the callframe */
10773 interp
->framePtr
= interp
->framePtr
->parent
;
10774 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10780 /* Call a procedure implemented in Tcl.
10781 * It's possible to speed-up a lot this function, currently
10782 * the callframes are not cached, but allocated and
10783 * destroied every time. What is expecially costly is
10784 * to create/destroy the local vars hash table every time.
10786 * This can be fixed just implementing callframes caching
10787 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10788 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10790 Jim_CallFrame
*callFramePtr
;
10791 int i
, d
, retcode
, optargs
;
10795 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10796 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10797 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10801 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10802 /* Optimise for procedure with no body - useful for optional debugging */
10806 /* Check if there are too nested calls */
10807 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10808 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10812 /* Create a new callframe */
10813 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10814 callFramePtr
->argv
= argv
;
10815 callFramePtr
->argc
= argc
;
10816 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10817 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10818 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10820 /* Remember where we were called from. */
10821 script
= Jim_GetScript(interp
, interp
->currentScriptObj
);
10822 callFramePtr
->fileNameObj
= script
->fileNameObj
;
10823 callFramePtr
->line
= script
->linenr
;
10825 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
10826 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
10827 interp
->framePtr
= callFramePtr
;
10829 /* How many optional args are available */
10830 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
10832 /* Step 'i' along the actual args, and step 'd' along the formal args */
10834 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
10835 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
10836 if (d
== cmd
->u
.proc
.argsPos
) {
10838 Jim_Obj
*listObjPtr
;
10840 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
10841 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
10843 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
10845 /* It is possible to rename args. */
10846 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
10847 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
10849 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
10850 if (retcode
!= JIM_OK
) {
10858 /* Optional or required? */
10859 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
10860 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
10863 /* Ran out, so use the default */
10864 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
10866 if (retcode
!= JIM_OK
) {
10871 /* Eval the body */
10872 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
10876 /* Free the callframe */
10877 interp
->framePtr
= interp
->framePtr
->parent
;
10878 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10880 if (interp
->framePtr
->tailcallObj
) {
10881 /* If a tailcall is already being executed, merge this tailcall with that one */
10882 if (interp
->framePtr
->tailcall
++ == 0) {
10883 /* No current tailcall in this frame, so invoke the tailcall command */
10885 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
10887 interp
->framePtr
->tailcallObj
= NULL
;
10889 if (retcode
== JIM_EVAL
) {
10890 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
10891 if (retcode
== JIM_RETURN
) {
10892 /* If the result of the tailcall is 'return', push
10893 * it up to the caller
10895 interp
->returnLevel
++;
10898 Jim_DecrRefCount(interp
, tailcallObj
);
10899 } while (interp
->framePtr
->tailcallObj
);
10901 /* If the tailcall chain finished early, may need to manually discard the command */
10902 if (interp
->framePtr
->tailcallCmd
) {
10903 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
10904 interp
->framePtr
->tailcallCmd
= NULL
;
10907 interp
->framePtr
->tailcall
--;
10910 /* Handle the JIM_RETURN return code */
10911 if (retcode
== JIM_RETURN
) {
10912 if (--interp
->returnLevel
<= 0) {
10913 retcode
= interp
->returnCode
;
10914 interp
->returnCode
= JIM_OK
;
10915 interp
->returnLevel
= 0;
10918 else if (retcode
== JIM_ERR
) {
10919 interp
->addStackTrace
++;
10920 Jim_DecrRefCount(interp
, interp
->errorProc
);
10921 interp
->errorProc
= argv
[0];
10922 Jim_IncrRefCount(interp
->errorProc
);
10928 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
10931 Jim_Obj
*scriptObjPtr
;
10933 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
10934 Jim_IncrRefCount(scriptObjPtr
);
10937 Jim_Obj
*prevScriptObj
;
10939 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
10941 prevScriptObj
= interp
->currentScriptObj
;
10942 interp
->currentScriptObj
= scriptObjPtr
;
10944 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10946 interp
->currentScriptObj
= prevScriptObj
;
10949 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10951 Jim_DecrRefCount(interp
, scriptObjPtr
);
10955 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
10957 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
10960 /* Execute script in the scope of the global level */
10961 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
10964 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10966 interp
->framePtr
= interp
->topFramePtr
;
10967 retval
= Jim_Eval(interp
, script
);
10968 interp
->framePtr
= savedFramePtr
;
10973 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
10976 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10978 interp
->framePtr
= interp
->topFramePtr
;
10979 retval
= Jim_EvalFile(interp
, filename
);
10980 interp
->framePtr
= savedFramePtr
;
10985 #include <sys/stat.h>
10987 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
10991 Jim_Obj
*scriptObjPtr
;
10992 Jim_Obj
*prevScriptObj
;
10997 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
10998 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11001 if (sb
.st_size
== 0) {
11006 buf
= Jim_Alloc(sb
.st_size
+ 1);
11007 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11011 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11017 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11018 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11019 Jim_IncrRefCount(scriptObjPtr
);
11021 /* Now check the script for unmatched braces, etc. */
11022 if (Jim_GetScript(interp
, scriptObjPtr
) == NULL
) {
11023 /* EvalFile changes context, so add a stack frame here */
11024 JimAddErrorToStack(interp
, JIM_ERR
, (ScriptObj
*)Jim_GetIntRepPtr(scriptObjPtr
));
11025 Jim_DecrRefCount(interp
, scriptObjPtr
);
11029 prevScriptObj
= interp
->currentScriptObj
;
11030 interp
->currentScriptObj
= scriptObjPtr
;
11032 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11034 /* Handle the JIM_RETURN return code */
11035 if (retcode
== JIM_RETURN
) {
11036 if (--interp
->returnLevel
<= 0) {
11037 retcode
= interp
->returnCode
;
11038 interp
->returnCode
= JIM_OK
;
11039 interp
->returnLevel
= 0;
11042 if (retcode
== JIM_ERR
) {
11043 /* EvalFile changes context, so add a stack frame here */
11044 interp
->addStackTrace
++;
11047 interp
->currentScriptObj
= prevScriptObj
;
11049 Jim_DecrRefCount(interp
, scriptObjPtr
);
11054 /* -----------------------------------------------------------------------------
11056 * ---------------------------------------------------------------------------*/
11057 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11059 pc
->tstart
= pc
->p
;
11060 pc
->tline
= pc
->linenr
;
11062 if (pc
->len
== 0) {
11064 pc
->tt
= JIM_TT_EOL
;
11068 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11072 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11073 if (JimParseVar(pc
) == JIM_OK
) {
11076 /* Not a var, so treat as a string */
11077 pc
->tstart
= pc
->p
;
11078 flags
|= JIM_SUBST_NOVAR
;
11081 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11084 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11087 if (*pc
->p
== '\\' && pc
->len
> 1) {
11094 pc
->tend
= pc
->p
- 1;
11095 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11098 /* The subst object type reuses most of the data structures and functions
11099 * of the script object. Script's data structures are a bit more complex
11100 * for what is needed for [subst]itution tasks, but the reuse helps to
11101 * deal with a single data structure at the cost of some more memory
11102 * usage for substitutions. */
11104 /* This method takes the string representation of an object
11105 * as a Tcl string where to perform [subst]itution, and generates
11106 * the pre-parsed internal representation. */
11107 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11110 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11111 struct JimParserCtx parser
;
11112 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11113 ParseTokenList tokenlist
;
11115 /* Initially parse the subst into tokens (in tokenlist) */
11116 ScriptTokenListInit(&tokenlist
);
11118 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11120 JimParseSubst(&parser
, flags
);
11122 /* Note that subst doesn't need the EOL token */
11125 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11129 /* Create the "real" subst/script tokens from the initial token list */
11131 script
->substFlags
= flags
;
11132 script
->fileNameObj
= interp
->emptyObj
;
11133 Jim_IncrRefCount(script
->fileNameObj
);
11134 SubstObjAddTokens(interp
, script
, &tokenlist
);
11136 /* No longer need the token list */
11137 ScriptTokenListFree(&tokenlist
);
11139 #ifdef DEBUG_SHOW_SUBST
11143 printf("==== Subst ====\n");
11144 for (i
= 0; i
< script
->len
; i
++) {
11145 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11146 Jim_String(script
->token
[i
].objPtr
));
11151 /* Free the old internal rep and set the new one. */
11152 Jim_FreeIntRep(interp
, objPtr
);
11153 Jim_SetIntRepPtr(objPtr
, script
);
11154 objPtr
->typePtr
= &scriptObjType
;
11158 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11160 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11161 SetSubstFromAny(interp
, objPtr
, flags
);
11162 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11165 /* Performs commands,variables,blackslashes substitution,
11166 * storing the result object (with refcount 0) into
11168 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11170 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11172 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11173 /* In order to preserve the internal rep, we increment the
11174 * inUse field of the script internal rep structure. */
11177 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11180 Jim_DecrRefCount(interp
, substObjPtr
);
11181 if (*resObjPtrPtr
== NULL
) {
11187 /* -----------------------------------------------------------------------------
11188 * Core commands utility functions
11189 * ---------------------------------------------------------------------------*/
11190 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11193 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11196 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11198 Jim_IncrRefCount(listObjPtr
);
11199 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11200 Jim_DecrRefCount(interp
, listObjPtr
);
11202 Jim_IncrRefCount(objPtr
);
11203 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11204 Jim_DecrRefCount(interp
, objPtr
);
11208 * May add the key and/or value to the list.
11210 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11211 Jim_HashEntry
*he
, int type
);
11213 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11216 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11217 * invoke the callback to add entries to a list.
11218 * Returns the list.
11220 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11221 JimHashtableIteratorCallbackType
*callback
, int type
)
11224 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11226 /* Check for the non-pattern case. We can do this much more efficiently. */
11227 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11228 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11230 callback(interp
, listObjPtr
, he
, type
);
11234 Jim_HashTableIterator htiter
;
11235 JimInitHashTableIterator(ht
, &htiter
);
11236 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11237 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11238 callback(interp
, listObjPtr
, he
, type
);
11245 /* Keep these in order */
11246 #define JIM_CMDLIST_COMMANDS 0
11247 #define JIM_CMDLIST_PROCS 1
11248 #define JIM_CMDLIST_CHANNELS 2
11251 * Adds matching command names (procs, channels) to the list.
11253 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11254 Jim_HashEntry
*he
, int type
)
11256 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11259 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11264 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11265 Jim_IncrRefCount(objPtr
);
11267 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11268 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11270 Jim_DecrRefCount(interp
, objPtr
);
11273 /* type is JIM_CMDLIST_xxx */
11274 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11276 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11279 /* Keep these in order */
11280 #define JIM_VARLIST_GLOBALS 0
11281 #define JIM_VARLIST_LOCALS 1
11282 #define JIM_VARLIST_VARS 2
11284 #define JIM_VARLIST_VALUES 0x1000
11287 * Adds matching variable names to the list.
11289 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11290 Jim_HashEntry
*he
, int type
)
11292 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11294 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11295 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11296 if (type
& JIM_VARLIST_VALUES
) {
11297 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11302 /* mode is JIM_VARLIST_xxx */
11303 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11305 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11306 /* For [info locals], if we are at top level an emtpy list
11307 * is returned. I don't agree, but we aim at compatibility (SS) */
11308 return interp
->emptyObj
;
11311 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11312 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11316 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11317 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11319 Jim_CallFrame
*targetCallFrame
;
11321 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11322 if (targetCallFrame
== NULL
) {
11325 /* No proc call at toplevel callframe */
11326 if (targetCallFrame
== interp
->topFramePtr
) {
11327 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11330 if (info_level_cmd
) {
11331 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11334 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11336 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11337 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11338 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11339 *objPtrPtr
= listObj
;
11344 /* -----------------------------------------------------------------------------
11346 * ---------------------------------------------------------------------------*/
11348 /* fake [puts] -- not the real puts, just for debugging. */
11349 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11351 if (argc
!= 2 && argc
!= 3) {
11352 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11356 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11357 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11361 fputs(Jim_String(argv
[2]), stdout
);
11365 puts(Jim_String(argv
[1]));
11370 /* Helper for [+] and [*] */
11371 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11373 jim_wide wideValue
, res
;
11374 double doubleValue
, doubleRes
;
11377 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11379 for (i
= 1; i
< argc
; i
++) {
11380 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11382 if (op
== JIM_EXPROP_ADD
)
11387 Jim_SetResultInt(interp
, res
);
11390 doubleRes
= (double)res
;
11391 for (; i
< argc
; i
++) {
11392 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11394 if (op
== JIM_EXPROP_ADD
)
11395 doubleRes
+= doubleValue
;
11397 doubleRes
*= doubleValue
;
11399 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11403 /* Helper for [-] and [/] */
11404 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11406 jim_wide wideValue
, res
= 0;
11407 double doubleValue
, doubleRes
= 0;
11411 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11414 else if (argc
== 2) {
11415 /* The arity = 2 case is different. For [- x] returns -x,
11416 * while [/ x] returns 1/x. */
11417 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11418 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11422 if (op
== JIM_EXPROP_SUB
)
11423 doubleRes
= -doubleValue
;
11425 doubleRes
= 1.0 / doubleValue
;
11426 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11430 if (op
== JIM_EXPROP_SUB
) {
11432 Jim_SetResultInt(interp
, res
);
11435 doubleRes
= 1.0 / wideValue
;
11436 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11441 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11442 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11451 for (i
= 2; i
< argc
; i
++) {
11452 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11453 doubleRes
= (double)res
;
11456 if (op
== JIM_EXPROP_SUB
)
11461 Jim_SetResultInt(interp
, res
);
11464 for (; i
< argc
; i
++) {
11465 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11467 if (op
== JIM_EXPROP_SUB
)
11468 doubleRes
-= doubleValue
;
11470 doubleRes
/= doubleValue
;
11472 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11478 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11480 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11484 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11486 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11490 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11492 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11496 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11498 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11502 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11504 if (argc
!= 2 && argc
!= 3) {
11505 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11511 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11514 Jim_SetResult(interp
, objPtr
);
11517 /* argc == 3 case. */
11518 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11520 Jim_SetResult(interp
, argv
[2]);
11526 * unset ?-nocomplain? ?--? ?varName ...?
11528 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11534 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11538 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11547 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11557 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11560 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11564 /* The general purpose implementation of while starts here */
11566 int boolean
, retval
;
11568 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11573 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11587 Jim_SetEmptyResult(interp
);
11592 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11596 Jim_Obj
*varNamePtr
= NULL
;
11597 Jim_Obj
*stopVarNamePtr
= NULL
;
11600 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11604 /* Do the initialisation */
11605 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11609 /* And do the first test now. Better for optimisation
11610 * if we can do next/test at the bottom of the loop
11612 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11614 /* Ready to do the body as follows:
11616 * body // check retcode
11617 * next // check retcode
11618 * test // check retcode/test bool
11622 #ifdef JIM_OPTIMIZATION
11623 /* Check if the for is on the form:
11624 * for ... {$i < CONST} {incr i}
11625 * for ... {$i < $j} {incr i}
11627 if (retval
== JIM_OK
&& boolean
) {
11628 ScriptObj
*incrScript
;
11629 ExprByteCode
*expr
;
11630 jim_wide stop
, currentVal
;
11634 /* Do it only if there aren't shared arguments */
11635 expr
= JimGetExpression(interp
, argv
[2]);
11636 incrScript
= Jim_GetScript(interp
, argv
[3]);
11638 /* Ensure proper lengths to start */
11639 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11642 /* Ensure proper token types. */
11643 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11644 expr
->token
[0].type
!= JIM_TT_VAR
||
11645 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11649 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11652 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11659 /* Update command must be incr */
11660 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11664 /* incr, expression must be about the same variable */
11665 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11669 /* Get the stop condition (must be a variable or integer) */
11670 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11671 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11676 stopVarNamePtr
= expr
->token
[1].objPtr
;
11677 Jim_IncrRefCount(stopVarNamePtr
);
11678 /* Keep the compiler happy */
11682 /* Initialization */
11683 varNamePtr
= expr
->token
[0].objPtr
;
11684 Jim_IncrRefCount(varNamePtr
);
11686 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11687 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11691 /* --- OPTIMIZED FOR --- */
11692 while (retval
== JIM_OK
) {
11693 /* === Check condition === */
11694 /* Note that currentVal is already set here */
11696 /* Immediate or Variable? get the 'stop' value if the latter. */
11697 if (stopVarNamePtr
) {
11698 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11699 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11704 if (currentVal
>= stop
+ cmpOffset
) {
11709 retval
= Jim_EvalObj(interp
, argv
[4]);
11710 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11713 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11716 if (objPtr
== NULL
) {
11720 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11721 currentVal
= ++JimWideValue(objPtr
);
11722 Jim_InvalidateStringRep(objPtr
);
11725 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11726 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11727 ++currentVal
)) != JIM_OK
) {
11738 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11740 retval
= Jim_EvalObj(interp
, argv
[4]);
11742 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11745 retval
= Jim_EvalObj(interp
, argv
[3]);
11746 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11749 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11754 if (stopVarNamePtr
) {
11755 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11758 Jim_DecrRefCount(interp
, varNamePtr
);
11761 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11762 Jim_SetEmptyResult(interp
);
11770 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11776 Jim_Obj
*bodyObjPtr
;
11778 if (argc
!= 5 && argc
!= 6) {
11779 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11783 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11784 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11785 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11788 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11790 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11792 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11793 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11794 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11795 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11802 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11803 if (argv
[1]->typePtr
!= &variableObjType
) {
11804 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11808 JimWideValue(objPtr
) = i
;
11809 Jim_InvalidateStringRep(objPtr
);
11811 /* The following step is required in order to invalidate the
11812 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11813 if (argv
[1]->typePtr
!= &variableObjType
) {
11814 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11821 objPtr
= Jim_NewIntObj(interp
, i
);
11822 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11823 if (retval
!= JIM_OK
) {
11824 Jim_FreeNewObj(interp
, objPtr
);
11830 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11831 Jim_SetEmptyResult(interp
);
11837 /* List iterators make it easy to iterate over a list.
11838 * At some point iterators will be expanded to support generators.
11846 * Initialise the iterator at the start of the list.
11848 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
11850 iter
->objPtr
= objPtr
;
11855 * Returns the next object from the list, or NULL on end-of-list.
11857 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11859 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
11862 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
11866 * Returns 1 if end-of-list has been reached.
11868 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11870 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
11873 /* foreach + lmap implementation. */
11874 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
11876 int result
= JIM_OK
;
11878 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
11879 Jim_ListIter
*iters
;
11881 Jim_Obj
*resultObj
;
11883 if (argc
< 4 || argc
% 2 != 0) {
11884 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
11887 script
= argv
[argc
- 1]; /* Last argument is a script */
11888 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
11890 if (numargs
== 2) {
11894 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
11896 for (i
= 0; i
< numargs
; i
++) {
11897 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11898 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
11902 if (result
!= JIM_OK
) {
11903 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
11908 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
11911 resultObj
= interp
->emptyObj
;
11913 Jim_IncrRefCount(resultObj
);
11916 /* Have we expired all lists? */
11917 for (i
= 0; i
< numargs
; i
+= 2) {
11918 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
11922 if (i
== numargs
) {
11927 /* For each list */
11928 for (i
= 0; i
< numargs
; i
+= 2) {
11932 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11933 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
11934 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
11936 /* Ran out, so store the empty string */
11937 valObj
= interp
->emptyObj
;
11939 /* Avoid shimmering */
11940 Jim_IncrRefCount(valObj
);
11941 result
= Jim_SetVariable(interp
, varName
, valObj
);
11942 Jim_DecrRefCount(interp
, valObj
);
11943 if (result
!= JIM_OK
) {
11948 switch (result
= Jim_EvalObj(interp
, script
)) {
11951 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
11964 Jim_SetResult(interp
, resultObj
);
11966 Jim_DecrRefCount(interp
, resultObj
);
11974 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11976 return JimForeachMapHelper(interp
, argc
, argv
, 0);
11980 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11982 return JimForeachMapHelper(interp
, argc
, argv
, 1);
11986 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11988 int result
= JIM_ERR
;
11991 Jim_Obj
*resultObj
;
11994 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
11998 JimListIterInit(&iter
, argv
[1]);
12000 for (i
= 2; i
< argc
; i
++) {
12001 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12002 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12003 if (result
!= JIM_OK
) {
12008 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12009 while (!JimListIterDone(interp
, &iter
)) {
12010 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12013 Jim_SetResult(interp
, resultObj
);
12019 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12021 int boolean
, retval
, current
= 1, falsebody
= 0;
12025 /* Far not enough arguments given! */
12026 if (current
>= argc
)
12028 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12031 /* There lacks something, isn't it? */
12032 if (current
>= argc
)
12034 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12036 /* Tsk tsk, no then-clause? */
12037 if (current
>= argc
)
12040 return Jim_EvalObj(interp
, argv
[current
]);
12041 /* Ok: no else-clause follows */
12042 if (++current
>= argc
) {
12043 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12046 falsebody
= current
++;
12047 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12048 /* IIICKS - else-clause isn't last cmd? */
12049 if (current
!= argc
- 1)
12051 return Jim_EvalObj(interp
, argv
[current
]);
12053 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12054 /* Ok: elseif follows meaning all the stuff
12055 * again (how boring...) */
12057 /* OOPS - else-clause is not last cmd? */
12058 else if (falsebody
!= argc
- 1)
12060 return Jim_EvalObj(interp
, argv
[falsebody
]);
12065 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12070 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12071 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12072 Jim_Obj
*stringObj
, int nocase
)
12079 parms
[argc
++] = commandObj
;
12081 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12083 parms
[argc
++] = patternObj
;
12084 parms
[argc
++] = stringObj
;
12086 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12088 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12096 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12099 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12101 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12102 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12103 Jim_Obj
*script
= 0;
12107 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12108 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12111 for (opt
= 1; opt
< argc
; ++opt
) {
12112 const char *option
= Jim_String(argv
[opt
]);
12114 if (*option
!= '-')
12116 else if (strncmp(option
, "--", 2) == 0) {
12120 else if (strncmp(option
, "-exact", 2) == 0)
12121 matchOpt
= SWITCH_EXACT
;
12122 else if (strncmp(option
, "-glob", 2) == 0)
12123 matchOpt
= SWITCH_GLOB
;
12124 else if (strncmp(option
, "-regexp", 2) == 0)
12125 matchOpt
= SWITCH_RE
;
12126 else if (strncmp(option
, "-command", 2) == 0) {
12127 matchOpt
= SWITCH_CMD
;
12128 if ((argc
- opt
) < 2)
12130 command
= argv
[++opt
];
12133 Jim_SetResultFormatted(interp
,
12134 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12138 if ((argc
- opt
) < 2)
12141 strObj
= argv
[opt
++];
12142 patCount
= argc
- opt
;
12143 if (patCount
== 1) {
12146 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12150 caseList
= &argv
[opt
];
12151 if (patCount
== 0 || patCount
% 2 != 0)
12153 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12154 Jim_Obj
*patObj
= caseList
[i
];
12156 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12157 || i
< (patCount
- 2)) {
12158 switch (matchOpt
) {
12160 if (Jim_StringEqObj(strObj
, patObj
))
12161 script
= caseList
[i
+ 1];
12164 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12165 script
= caseList
[i
+ 1];
12168 command
= Jim_NewStringObj(interp
, "regexp", -1);
12169 /* Fall thru intentionally */
12171 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12173 /* After the execution of a command we need to
12174 * make sure to reconvert the object into a list
12175 * again. Only for the single-list style [switch]. */
12176 if (argc
- opt
== 1) {
12179 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12182 /* command is here already decref'd */
12187 script
= caseList
[i
+ 1];
12193 script
= caseList
[i
+ 1];
12196 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12197 script
= caseList
[i
+ 1];
12198 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12199 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12202 Jim_SetEmptyResult(interp
);
12204 return Jim_EvalObj(interp
, script
);
12210 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12212 Jim_Obj
*listObjPtr
;
12214 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12215 Jim_SetResult(interp
, listObjPtr
);
12220 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12222 Jim_Obj
*objPtr
, *listObjPtr
;
12227 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?...?");
12231 Jim_IncrRefCount(objPtr
);
12232 for (i
= 2; i
< argc
; i
++) {
12233 listObjPtr
= objPtr
;
12234 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12235 Jim_DecrRefCount(interp
, listObjPtr
);
12238 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12239 /* Returns an empty object if the index
12240 * is out of range. */
12241 Jim_DecrRefCount(interp
, listObjPtr
);
12242 Jim_SetEmptyResult(interp
);
12245 Jim_IncrRefCount(objPtr
);
12246 Jim_DecrRefCount(interp
, listObjPtr
);
12248 Jim_SetResult(interp
, objPtr
);
12249 Jim_DecrRefCount(interp
, objPtr
);
12254 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12257 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12260 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12265 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12267 static const char * const options
[] = {
12268 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12272 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12277 int opt_nocase
= 0;
12279 int opt_inline
= 0;
12280 int opt_match
= OPT_EXACT
;
12283 Jim_Obj
*listObjPtr
= NULL
;
12284 Jim_Obj
*commandObj
= NULL
;
12288 Jim_WrongNumArgs(interp
, 1, argv
,
12289 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12293 for (i
= 1; i
< argc
- 2; i
++) {
12296 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12318 if (i
>= argc
- 2) {
12321 commandObj
= argv
[++i
];
12326 opt_match
= option
;
12334 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12336 if (opt_match
== OPT_REGEXP
) {
12337 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12340 Jim_IncrRefCount(commandObj
);
12343 listlen
= Jim_ListLength(interp
, argv
[0]);
12344 for (i
= 0; i
< listlen
; i
++) {
12346 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12348 switch (opt_match
) {
12350 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12354 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12359 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12362 Jim_FreeNewObj(interp
, listObjPtr
);
12370 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12371 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12375 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12376 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12377 Jim_Obj
*resultObj
;
12380 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12382 else if (!opt_inline
) {
12383 resultObj
= Jim_NewIntObj(interp
, i
);
12386 resultObj
= objPtr
;
12390 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12393 Jim_SetResult(interp
, resultObj
);
12400 Jim_SetResult(interp
, listObjPtr
);
12405 Jim_SetResultBool(interp
, opt_not
);
12407 else if (!opt_inline
) {
12408 Jim_SetResultInt(interp
, -1);
12414 Jim_DecrRefCount(interp
, commandObj
);
12420 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12422 Jim_Obj
*listObjPtr
;
12426 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12429 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12431 /* Create the list if it does not exists */
12432 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12433 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12434 Jim_FreeNewObj(interp
, listObjPtr
);
12438 shared
= Jim_IsShared(listObjPtr
);
12440 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12441 for (i
= 2; i
< argc
; i
++)
12442 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12443 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12445 Jim_FreeNewObj(interp
, listObjPtr
);
12448 Jim_SetResult(interp
, listObjPtr
);
12453 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12459 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12463 if (Jim_IsShared(listPtr
))
12464 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12465 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12467 len
= Jim_ListLength(interp
, listPtr
);
12471 idx
= len
+ idx
+ 1;
12472 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12473 Jim_SetResult(interp
, listPtr
);
12476 if (listPtr
!= argv
[1]) {
12477 Jim_FreeNewObj(interp
, listPtr
);
12483 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12485 int first
, last
, len
, rangeLen
;
12487 Jim_Obj
*newListObj
;
12490 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12493 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12494 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12499 len
= Jim_ListLength(interp
, listObj
);
12501 first
= JimRelToAbsIndex(len
, first
);
12502 last
= JimRelToAbsIndex(len
, last
);
12503 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12505 /* Now construct a new list which consists of:
12506 * <elements before first> <supplied elements> <elements after last>
12509 /* Check to see if trying to replace past the end of the list */
12511 /* OK. Not past the end */
12513 else if (len
== 0) {
12514 /* Special for empty list, adjust first to 0 */
12518 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12519 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12523 /* Add the first set of elements */
12524 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12526 /* Add supplied elements */
12527 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12529 /* Add the remaining elements */
12530 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12532 Jim_SetResult(interp
, newListObj
);
12537 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12540 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12543 else if (argc
== 3) {
12544 /* With no indexes, simply implements [set] */
12545 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12547 Jim_SetResult(interp
, argv
[2]);
12550 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12554 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12556 static const char * const options
[] = {
12557 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12560 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12565 struct lsort_info info
;
12568 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12572 info
.type
= JIM_LSORT_ASCII
;
12576 info
.command
= NULL
;
12577 info
.interp
= interp
;
12579 for (i
= 1; i
< (argc
- 1); i
++) {
12582 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12587 info
.type
= JIM_LSORT_ASCII
;
12590 info
.type
= JIM_LSORT_NOCASE
;
12593 info
.type
= JIM_LSORT_INTEGER
;
12596 info
.type
= JIM_LSORT_REAL
;
12598 case OPT_INCREASING
:
12601 case OPT_DECREASING
:
12608 if (i
>= (argc
- 2)) {
12609 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12612 info
.type
= JIM_LSORT_COMMAND
;
12613 info
.command
= argv
[i
+ 1];
12617 if (i
>= (argc
- 2)) {
12618 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12621 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12629 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12630 retCode
= ListSortElements(interp
, resObj
, &info
);
12631 if (retCode
== JIM_OK
) {
12632 Jim_SetResult(interp
, resObj
);
12635 Jim_FreeNewObj(interp
, resObj
);
12641 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12643 Jim_Obj
*stringObjPtr
;
12647 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12651 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12657 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12658 if (!stringObjPtr
) {
12659 /* Create the string if it doesn't exist */
12660 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12663 else if (Jim_IsShared(stringObjPtr
)) {
12665 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12667 for (i
= 2; i
< argc
; i
++) {
12668 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12670 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12672 Jim_FreeNewObj(interp
, stringObjPtr
);
12677 Jim_SetResult(interp
, stringObjPtr
);
12682 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12684 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12685 static const char * const options
[] = {
12686 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12692 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12693 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12698 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12701 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12703 if (option
== OPT_REFCOUNT
) {
12705 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12708 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12711 else if (option
== OPT_OBJCOUNT
) {
12712 int freeobj
= 0, liveobj
= 0;
12717 Jim_WrongNumArgs(interp
, 2, argv
, "");
12720 /* Count the number of free objects. */
12721 objPtr
= interp
->freeList
;
12724 objPtr
= objPtr
->nextObjPtr
;
12726 /* Count the number of live objects. */
12727 objPtr
= interp
->liveList
;
12730 objPtr
= objPtr
->nextObjPtr
;
12732 /* Set the result string and return. */
12733 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12734 Jim_SetResultString(interp
, buf
, -1);
12737 else if (option
== OPT_OBJECTS
) {
12738 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12740 /* Count the number of live objects. */
12741 objPtr
= interp
->liveList
;
12742 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12745 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12747 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12748 sprintf(buf
, "%p", objPtr
);
12749 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12750 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12751 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12752 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12753 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12754 objPtr
= objPtr
->nextObjPtr
;
12756 Jim_SetResult(interp
, listObjPtr
);
12759 else if (option
== OPT_INVSTR
) {
12763 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12767 if (objPtr
->typePtr
!= NULL
)
12768 Jim_InvalidateStringRep(objPtr
);
12769 Jim_SetEmptyResult(interp
);
12772 else if (option
== OPT_SHOW
) {
12777 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12780 s
= Jim_GetString(argv
[2], &len
);
12782 charlen
= utf8_strlen(s
, len
);
12786 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12787 printf("chars (%d): <<%s>>\n", charlen
, s
);
12788 printf("bytes (%d):", len
);
12790 printf(" %02x", (unsigned char)*s
++);
12795 else if (option
== OPT_SCRIPTLEN
) {
12799 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12802 script
= Jim_GetScript(interp
, argv
[2]);
12803 if (script
== NULL
)
12805 Jim_SetResultInt(interp
, script
->len
);
12808 else if (option
== OPT_EXPRLEN
) {
12809 ExprByteCode
*expr
;
12812 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12815 expr
= JimGetExpression(interp
, argv
[2]);
12818 Jim_SetResultInt(interp
, expr
->len
);
12821 else if (option
== OPT_EXPRBC
) {
12823 ExprByteCode
*expr
;
12827 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12830 expr
= JimGetExpression(interp
, argv
[2]);
12833 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12834 for (i
= 0; i
< expr
->len
; i
++) {
12836 const Jim_ExprOperator
*op
;
12837 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
12839 switch (expr
->token
[i
].type
) {
12840 case JIM_TT_EXPR_INT
:
12843 case JIM_TT_EXPR_DOUBLE
:
12852 case JIM_TT_DICTSUGAR
:
12853 type
= "dictsugar";
12855 case JIM_TT_EXPRSUGAR
:
12856 type
= "exprsugar";
12865 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
12872 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
12875 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
12876 Jim_ListAppendElement(interp
, objPtr
, obj
);
12878 Jim_SetResult(interp
, objPtr
);
12882 Jim_SetResultString(interp
,
12883 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12887 #endif /* JIM_BOOTSTRAP */
12888 #if !defined(JIM_DEBUG_COMMAND)
12889 Jim_SetResultString(interp
, "unsupported", -1);
12895 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12900 Jim_WrongNumArgs(interp
, 1, argv
, "script ?...?");
12905 rc
= Jim_EvalObj(interp
, argv
[1]);
12908 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12911 if (rc
== JIM_ERR
) {
12912 /* eval is "interesting", so add a stack frame here */
12913 interp
->addStackTrace
++;
12919 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12923 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
12927 /* Save the old callframe pointer */
12928 savedCallFrame
= interp
->framePtr
;
12930 /* Lookup the target frame pointer */
12931 str
= Jim_String(argv
[1]);
12932 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
12933 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
12938 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
12940 if (targetCallFrame
== NULL
) {
12944 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
12947 /* Eval the code in the target callframe. */
12948 interp
->framePtr
= targetCallFrame
;
12949 /* Can't merge tailcalls across upcall */
12950 savedTailcall
= interp
->framePtr
->tailcall
;
12951 interp
->framePtr
->tailcall
= 0;
12953 retcode
= Jim_EvalObj(interp
, argv
[1]);
12956 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12958 interp
->framePtr
->tailcall
= savedTailcall
;
12959 interp
->framePtr
= savedCallFrame
;
12963 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
12969 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12971 Jim_Obj
*exprResultPtr
;
12975 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
12977 else if (argc
> 2) {
12980 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
12981 Jim_IncrRefCount(objPtr
);
12982 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
12983 Jim_DecrRefCount(interp
, objPtr
);
12986 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
12989 if (retcode
!= JIM_OK
)
12991 Jim_SetResult(interp
, exprResultPtr
);
12992 Jim_DecrRefCount(interp
, exprResultPtr
);
12997 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13000 Jim_WrongNumArgs(interp
, 1, argv
, "");
13007 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13010 Jim_WrongNumArgs(interp
, 1, argv
, "");
13013 return JIM_CONTINUE
;
13017 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13020 Jim_Obj
*stackTraceObj
= NULL
;
13021 Jim_Obj
*errorCodeObj
= NULL
;
13022 int returnCode
= JIM_OK
;
13025 for (i
= 1; i
< argc
- 1; i
+= 2) {
13026 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13027 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13031 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13032 stackTraceObj
= argv
[i
+ 1];
13034 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13035 errorCodeObj
= argv
[i
+ 1];
13037 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13038 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13039 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13048 if (i
!= argc
- 1 && i
!= argc
) {
13049 Jim_WrongNumArgs(interp
, 1, argv
,
13050 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13053 /* If a stack trace is supplied and code is error, set the stack trace */
13054 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13055 JimSetStackTrace(interp
, stackTraceObj
);
13057 /* If an error code list is supplied, set the global $errorCode */
13058 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13059 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13061 interp
->returnCode
= returnCode
;
13062 interp
->returnLevel
= level
;
13064 if (i
== argc
- 1) {
13065 Jim_SetResult(interp
, argv
[i
]);
13071 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13073 if (interp
->framePtr
->level
== 0) {
13074 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13077 else if (argc
>= 2) {
13078 /* Need to resolve the tailcall command in the current context */
13079 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13081 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13082 if (cmdPtr
== NULL
) {
13086 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13088 /* And stash this pre-resolved command */
13089 JimIncrCmdRefCount(cmdPtr
);
13090 cf
->tailcallCmd
= cmdPtr
;
13092 /* And stash the command list */
13093 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13095 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13096 Jim_IncrRefCount(cf
->tailcallObj
);
13098 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13104 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13107 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13109 /* prefixListObj is a list to which the args need to be appended */
13110 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13111 ListInsertElements(cmdList
, -1, argc
- 1, argv
+ 1);
13113 return JimEvalObjList(interp
, cmdList
);
13116 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13118 Jim_Obj
*prefixListObj
= privData
;
13119 Jim_DecrRefCount(interp
, prefixListObj
);
13122 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13124 Jim_Obj
*prefixListObj
;
13125 const char *newname
;
13128 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13132 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13133 Jim_IncrRefCount(prefixListObj
);
13134 newname
= Jim_String(argv
[1]);
13135 if (newname
[0] == ':' && newname
[1] == ':') {
13136 while (*++newname
== ':') {
13140 Jim_SetResult(interp
, argv
[1]);
13142 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13146 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13150 if (argc
!= 4 && argc
!= 5) {
13151 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13155 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13160 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13163 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13167 /* Add the new command */
13168 Jim_Obj
*qualifiedCmdNameObj
;
13169 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13171 JimCreateCommand(interp
, cmdname
, cmd
);
13173 /* Calculate and set the namespace for this proc */
13174 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13176 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13178 /* Unlike Tcl, set the name of the proc as the result */
13179 Jim_SetResult(interp
, argv
[1]);
13186 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13191 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13195 /* Evaluate the arguments with 'local' in force */
13197 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13201 /* If OK, and the result is a proc, add it to the list of local procs */
13202 if (retcode
== 0) {
13203 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13205 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13208 if (interp
->framePtr
->localCommands
== NULL
) {
13209 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13210 Jim_InitStack(interp
->framePtr
->localCommands
);
13212 Jim_IncrRefCount(cmdNameObj
);
13213 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13220 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13223 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13229 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13230 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13231 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13234 /* OK. Mark this command as being in an upcall */
13235 cmdPtr
->u
.proc
.upcall
++;
13236 JimIncrCmdRefCount(cmdPtr
);
13238 /* Invoke the command as normal */
13239 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13241 /* No longer in an upcall */
13242 cmdPtr
->u
.proc
.upcall
--;
13243 JimDecrCmdRefCount(interp
, cmdPtr
);
13250 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13253 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13259 Jim_Obj
*argListObjPtr
;
13260 Jim_Obj
*bodyObjPtr
;
13261 Jim_Obj
*nsObj
= NULL
;
13264 int len
= Jim_ListLength(interp
, argv
[1]);
13265 if (len
!= 2 && len
!= 3) {
13266 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13271 #ifdef jim_ext_namespace
13272 /* Need to canonicalise the given namespace. */
13273 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13275 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13279 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13280 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13282 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13285 /* Create a new argv array with a dummy argv[0], for error messages */
13286 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13287 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13288 Jim_IncrRefCount(nargv
[0]);
13289 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13290 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13291 Jim_DecrRefCount(interp
, nargv
[0]);
13294 JimDecrCmdRefCount(interp
, cmd
);
13303 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13305 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13310 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13313 Jim_CallFrame
*targetCallFrame
;
13315 /* Lookup the target frame pointer */
13316 if (argc
> 3 && (argc
% 2 == 0)) {
13317 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13322 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13324 if (targetCallFrame
== NULL
) {
13328 /* Check for arity */
13330 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13334 /* Now... for every other/local couple: */
13335 for (i
= 1; i
< argc
; i
+= 2) {
13336 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13343 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13348 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13351 /* Link every var to the toplevel having the same name */
13352 if (interp
->framePtr
->level
== 0)
13353 return JIM_OK
; /* global at toplevel... */
13354 for (i
= 1; i
< argc
; i
++) {
13355 /* global ::blah does nothing */
13356 const char *name
= Jim_String(argv
[i
]);
13357 if (name
[0] != ':' || name
[1] != ':') {
13358 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13365 /* does the [string map] operation. On error NULL is returned,
13366 * otherwise a new string object with the result, having refcount = 0,
13368 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13369 Jim_Obj
*objPtr
, int nocase
)
13372 const char *str
, *noMatchStart
= NULL
;
13374 Jim_Obj
*resultObjPtr
;
13376 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13378 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13382 str
= Jim_String(objPtr
);
13383 strLen
= Jim_Utf8Length(interp
, objPtr
);
13386 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13388 for (i
= 0; i
< numMaps
; i
+= 2) {
13393 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13394 k
= Jim_String(objPtr
);
13395 kl
= Jim_Utf8Length(interp
, objPtr
);
13397 if (strLen
>= kl
&& kl
) {
13399 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13401 if (noMatchStart
) {
13402 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13403 noMatchStart
= NULL
;
13405 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13406 str
+= utf8_index(str
, kl
);
13412 if (i
== numMaps
) { /* no match */
13414 if (noMatchStart
== NULL
)
13415 noMatchStart
= str
;
13416 str
+= utf8_tounicode(str
, &c
);
13420 if (noMatchStart
) {
13421 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13423 return resultObjPtr
;
13427 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13432 static const char * const options
[] = {
13433 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13434 "map", "repeat", "reverse", "index", "first", "last",
13435 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13439 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13440 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
,
13441 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13443 static const char * const nocase_options
[] = {
13446 static const char * const nocase_length_options
[] = {
13447 "-nocase", "-length", NULL
13451 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13454 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13455 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13460 case OPT_BYTELENGTH
:
13462 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13465 if (option
== OPT_LENGTH
) {
13466 len
= Jim_Utf8Length(interp
, argv
[2]);
13469 len
= Jim_Length(argv
[2]);
13471 Jim_SetResultInt(interp
, len
);
13477 /* n is the number of remaining option args */
13478 long opt_length
= -1;
13483 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13484 JIM_ENUM_ABBREV
) != JIM_OK
) {
13486 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13497 goto badcompareargs
;
13499 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13506 goto badcompareargs
;
13509 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13510 /* Fast version - [string equal], case sensitive, no length */
13511 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13514 if (opt_length
>= 0) {
13515 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13518 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13520 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13528 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13529 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13530 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13533 if (opt_case
== 0) {
13536 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13544 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13545 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13546 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13550 if (opt_case
== 0) {
13553 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13554 if (objPtr
== NULL
) {
13557 Jim_SetResult(interp
, objPtr
);
13562 case OPT_BYTERANGE
:{
13566 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13569 if (option
== OPT_RANGE
) {
13570 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13574 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13577 if (objPtr
== NULL
) {
13580 Jim_SetResult(interp
, objPtr
);
13587 if (argc
!= 5 && argc
!= 6) {
13588 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13591 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13592 if (objPtr
== NULL
) {
13595 Jim_SetResult(interp
, objPtr
);
13605 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13608 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13611 objPtr
= Jim_NewStringObj(interp
, "", 0);
13614 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13617 Jim_SetResult(interp
, objPtr
);
13628 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13632 str
= Jim_GetString(argv
[2], &len
);
13633 buf
= Jim_Alloc(len
+ 1);
13636 for (i
= 0; i
< len
; ) {
13638 int l
= utf8_tounicode(str
, &c
);
13639 memcpy(p
- l
, str
, l
);
13644 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13653 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13656 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13659 str
= Jim_String(argv
[2]);
13660 len
= Jim_Utf8Length(interp
, argv
[2]);
13661 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13662 idx
= JimRelToAbsIndex(len
, idx
);
13664 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13665 Jim_SetResultString(interp
, "", 0);
13667 else if (len
== Jim_Length(argv
[2])) {
13668 /* ASCII optimisation */
13669 Jim_SetResultString(interp
, str
+ idx
, 1);
13673 int i
= utf8_index(str
, idx
);
13674 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13681 int idx
= 0, l1
, l2
;
13682 const char *s1
, *s2
;
13684 if (argc
!= 4 && argc
!= 5) {
13685 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13688 s1
= Jim_String(argv
[2]);
13689 s2
= Jim_String(argv
[3]);
13690 l1
= Jim_Utf8Length(interp
, argv
[2]);
13691 l2
= Jim_Utf8Length(interp
, argv
[3]);
13693 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13696 idx
= JimRelToAbsIndex(l2
, idx
);
13698 else if (option
== OPT_LAST
) {
13701 if (option
== OPT_FIRST
) {
13702 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13706 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13708 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13716 case OPT_TRIMRIGHT
:{
13717 Jim_Obj
*trimchars
;
13719 if (argc
!= 3 && argc
!= 4) {
13720 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13723 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13724 if (option
== OPT_TRIM
) {
13725 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13727 else if (option
== OPT_TRIMLEFT
) {
13728 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13730 else if (option
== OPT_TRIMRIGHT
) {
13731 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13740 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13743 if (option
== OPT_TOLOWER
) {
13744 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13746 else if (option
== OPT_TOUPPER
) {
13747 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13750 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13755 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13756 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13758 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13765 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13768 jim_wide start
, elapsed
;
13770 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13773 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13777 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13783 start
= JimClock();
13787 retval
= Jim_EvalObj(interp
, argv
[1]);
13788 if (retval
!= JIM_OK
) {
13792 elapsed
= JimClock() - start
;
13793 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13794 Jim_SetResultString(interp
, buf
, -1);
13799 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13804 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13808 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13811 interp
->exitCode
= exitCode
;
13816 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13822 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13823 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
13824 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
13826 /* Reset the error code before catch.
13827 * Note that this is not strictly correct.
13829 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
13831 for (i
= 1; i
< argc
- 1; i
++) {
13832 const char *arg
= Jim_String(argv
[i
]);
13836 /* It's a pity we can't use Jim_GetEnum here :-( */
13837 if (strcmp(arg
, "--") == 0) {
13845 if (strncmp(arg
, "-no", 3) == 0) {
13854 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
13858 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
13865 ignore_mask
|= (1 << option
);
13868 ignore_mask
&= ~(1 << option
);
13873 if (argc
< 1 || argc
> 3) {
13875 Jim_WrongNumArgs(interp
, 1, argv
,
13876 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13881 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
13885 interp
->signal_level
+= sig
;
13886 if (Jim_CheckSignal(interp
)) {
13887 /* If a signal is set, don't even try to execute the body */
13888 exitCode
= JIM_SIGNAL
;
13891 exitCode
= Jim_EvalObj(interp
, argv
[0]);
13892 /* Don't want any caught error included in a later stack trace */
13893 interp
->errorFlag
= 0;
13895 interp
->signal_level
-= sig
;
13897 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13898 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
13899 /* Not caught, pass it up */
13903 if (sig
&& exitCode
== JIM_SIGNAL
) {
13904 /* Catch the signal at this level */
13905 if (interp
->signal_set_result
) {
13906 interp
->signal_set_result(interp
, interp
->sigmask
);
13909 Jim_SetResultInt(interp
, interp
->sigmask
);
13911 interp
->sigmask
= 0;
13915 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
13919 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
13921 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
13922 Jim_ListAppendElement(interp
, optListObj
,
13923 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
13924 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
13925 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
13926 if (exitCode
== JIM_ERR
) {
13927 Jim_Obj
*errorCode
;
13928 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
13930 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
13932 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
13934 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
13935 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
13938 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
13943 Jim_SetResultInt(interp
, exitCode
);
13947 #ifdef JIM_REFERENCES
13950 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13952 if (argc
!= 3 && argc
!= 4) {
13953 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
13957 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
13960 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
13966 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13968 Jim_Reference
*refPtr
;
13971 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
13974 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
13976 Jim_SetResult(interp
, refPtr
->objPtr
);
13981 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13983 Jim_Reference
*refPtr
;
13986 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
13989 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
13991 Jim_IncrRefCount(argv
[2]);
13992 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
13993 refPtr
->objPtr
= argv
[2];
13994 Jim_SetResult(interp
, argv
[2]);
13999 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14002 Jim_WrongNumArgs(interp
, 1, argv
, "");
14005 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14007 /* Free all the freed objects. */
14008 while (interp
->freeList
) {
14009 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14010 Jim_Free(interp
->freeList
);
14011 interp
->freeList
= nextObjPtr
;
14017 /* [finalize] reference ?newValue? */
14018 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14020 if (argc
!= 2 && argc
!= 3) {
14021 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14025 Jim_Obj
*cmdNamePtr
;
14027 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14029 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14030 Jim_SetResult(interp
, cmdNamePtr
);
14033 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14035 Jim_SetResult(interp
, argv
[2]);
14040 /* [info references] */
14041 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14043 Jim_Obj
*listObjPtr
;
14044 Jim_HashTableIterator htiter
;
14047 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14049 JimInitHashTableIterator(&interp
->references
, &htiter
);
14050 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14051 char buf
[JIM_REFERENCE_SPACE
+ 1];
14052 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14053 const unsigned long *refId
= he
->key
;
14055 JimFormatReference(buf
, refPtr
, *refId
);
14056 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14058 Jim_SetResult(interp
, listObjPtr
);
14064 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14067 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14071 if (JimValidName(interp
, "new procedure", argv
[2])) {
14075 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14078 #define JIM_DICTMATCH_VALUES 0x0001
14080 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14082 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14084 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14085 if (type
& JIM_DICTMATCH_VALUES
) {
14086 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14091 * Like JimHashtablePatternMatch, but for dictionaries.
14093 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14094 JimDictMatchCallbackType
*callback
, int type
)
14097 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14099 /* Check for the non-pattern case. We can do this much more efficiently. */
14100 Jim_HashTableIterator htiter
;
14101 JimInitHashTableIterator(ht
, &htiter
);
14102 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14103 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14104 callback(interp
, listObjPtr
, he
, type
);
14112 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14114 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14117 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14121 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14123 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14126 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14130 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14132 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14135 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14138 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14143 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14147 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14149 /* Note that this uses internal knowledge of the hash table */
14150 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14152 for (i
= 0; i
< ht
->size
; i
++) {
14153 Jim_HashEntry
*he
= ht
->table
[i
];
14159 printf(" %s", Jim_String(he
->key
));
14168 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14170 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14172 Jim_AppendString(interp
, prefixObj
, " ", 1);
14173 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14175 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14179 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14183 static const char * const options
[] = {
14184 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14185 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14186 "replace", "update", NULL
14190 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14191 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14192 OPT_REPLACE
, OPT_UPDATE
,
14196 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14200 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14207 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14210 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14211 JIM_ERRMSG
) != JIM_OK
) {
14214 Jim_SetResult(interp
, objPtr
);
14219 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14222 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14226 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14230 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14234 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14240 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14243 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14249 if (argc
!= 3 && argc
!= 4) {
14250 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14253 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14257 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14260 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14263 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14270 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14273 /* Handle as ensemble */
14277 if (argc
< 6 || argc
% 2) {
14278 /* Better error message */
14285 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14288 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14289 Jim_SetResult(interp
, objPtr
);
14294 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14297 return Jim_DictInfo(interp
, argv
[2]);
14299 /* Handle command as an ensemble */
14300 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14304 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14306 static const char * const options
[] = {
14307 "-nobackslashes", "-nocommands", "-novariables", NULL
14310 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14312 int flags
= JIM_SUBST_FLAG
;
14316 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14319 for (i
= 1; i
< (argc
- 1); i
++) {
14322 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14323 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14327 case OPT_NOBACKSLASHES
:
14328 flags
|= JIM_SUBST_NOESC
;
14330 case OPT_NOCOMMANDS
:
14331 flags
|= JIM_SUBST_NOCMD
;
14333 case OPT_NOVARIABLES
:
14334 flags
|= JIM_SUBST_NOVAR
;
14338 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14341 Jim_SetResult(interp
, objPtr
);
14346 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14352 static const char * const commands
[] = {
14353 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14354 "vars", "version", "patchlevel", "complete", "args", "hostname",
14355 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14356 "references", "alias", NULL
14359 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14360 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14361 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14362 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14365 #ifdef jim_ext_namespace
14368 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14369 /* This is for internal use only */
14377 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14380 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14385 /* Test for the the most common commands first, just in case it makes a difference */
14389 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14392 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14399 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14402 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14405 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14406 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14409 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14413 case INFO_CHANNELS
:
14414 mode
++; /* JIM_CMDLIST_CHANNELS */
14415 #ifndef jim_ext_aio
14416 Jim_SetResultString(interp
, "aio not enabled", -1);
14420 mode
++; /* JIM_CMDLIST_PROCS */
14421 case INFO_COMMANDS
:
14422 /* mode 0 => JIM_CMDLIST_COMMANDS */
14423 if (argc
!= 2 && argc
!= 3) {
14424 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14427 #ifdef jim_ext_namespace
14429 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14430 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14434 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14438 mode
++; /* JIM_VARLIST_VARS */
14440 mode
++; /* JIM_VARLIST_LOCALS */
14442 /* mode 0 => JIM_VARLIST_GLOBALS */
14443 if (argc
!= 2 && argc
!= 3) {
14444 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14447 #ifdef jim_ext_namespace
14449 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14450 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14454 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14459 Jim_WrongNumArgs(interp
, 2, argv
, "");
14462 Jim_SetResult(interp
, Jim_GetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14467 Jim_Obj
*resObjPtr
;
14468 Jim_Obj
*fileNameObj
;
14471 Jim_WrongNumArgs(interp
, 2, argv
, "source");
14474 if (argv
[2]->typePtr
== &sourceObjType
) {
14475 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14476 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14478 else if (argv
[2]->typePtr
== &scriptObjType
) {
14479 ScriptObj
*script
= Jim_GetScript(interp
, argv
[2]);
14480 fileNameObj
= script
->fileNameObj
;
14481 line
= script
->firstline
;
14484 fileNameObj
= interp
->emptyObj
;
14487 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14488 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14489 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14490 Jim_SetResult(interp
, resObjPtr
);
14494 case INFO_STACKTRACE
:
14495 Jim_SetResult(interp
, interp
->stackTrace
);
14502 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14506 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14509 Jim_SetResult(interp
, objPtr
);
14513 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14524 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14527 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14530 if (!cmdPtr
->isproc
) {
14531 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14536 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14539 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14542 if (cmdPtr
->u
.proc
.staticVars
) {
14543 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14544 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14545 NULL
, JimVariablesMatch
, mode
));
14553 case INFO_PATCHLEVEL
:{
14554 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14556 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14557 Jim_SetResultString(interp
, buf
, -1);
14561 case INFO_COMPLETE
:
14562 if (argc
!= 3 && argc
!= 4) {
14563 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14568 const char *s
= Jim_GetString(argv
[2], &len
);
14571 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
14572 if (missing
!= ' ' && argc
== 4) {
14573 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14578 case INFO_HOSTNAME
:
14579 /* Redirect to os.gethostname if it exists */
14580 return Jim_Eval(interp
, "os.gethostname");
14582 case INFO_NAMEOFEXECUTABLE
:
14583 /* Redirect to Tcl proc */
14584 return Jim_Eval(interp
, "{info nameofexecutable}");
14586 case INFO_RETURNCODES
:
14589 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14591 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14592 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14593 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14594 jimReturnCodes
[i
], -1));
14597 Jim_SetResult(interp
, listObjPtr
);
14599 else if (argc
== 3) {
14603 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14606 name
= Jim_ReturnCode(code
);
14607 if (*name
== '?') {
14608 Jim_SetResultInt(interp
, code
);
14611 Jim_SetResultString(interp
, name
, -1);
14615 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14619 case INFO_REFERENCES
:
14620 #ifdef JIM_REFERENCES
14621 return JimInfoReferences(interp
, argc
, argv
);
14623 Jim_SetResultString(interp
, "not supported", -1);
14631 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14636 static const char * const options
[] = {
14637 "-command", "-proc", "-alias", "-var", NULL
14641 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14649 else if (argc
== 3) {
14650 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14656 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14660 if (option
== OPT_VAR
) {
14661 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14664 /* Now different kinds of commands */
14665 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14674 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14678 result
= cmd
->isproc
;
14683 Jim_SetResultBool(interp
, result
);
14688 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14690 const char *str
, *splitChars
, *noMatchStart
;
14691 int splitLen
, strLen
;
14692 Jim_Obj
*resObjPtr
;
14696 if (argc
!= 2 && argc
!= 3) {
14697 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14701 str
= Jim_GetString(argv
[1], &len
);
14705 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14709 splitChars
= " \n\t\r";
14713 splitChars
= Jim_String(argv
[2]);
14714 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14717 noMatchStart
= str
;
14718 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14724 const char *sc
= splitChars
;
14725 int scLen
= splitLen
;
14726 int sl
= utf8_tounicode(str
, &c
);
14729 sc
+= utf8_tounicode(sc
, &pc
);
14731 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14732 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14733 noMatchStart
= str
+ sl
;
14739 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14740 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14743 /* This handles the special case of splitchars eq {}
14744 * Optimise by sharing common (ASCII) characters
14746 Jim_Obj
**commonObj
= NULL
;
14747 #define NUM_COMMON (128 - 9)
14749 int n
= utf8_tounicode(str
, &c
);
14750 #ifdef JIM_OPTIMIZATION
14751 if (c
>= 9 && c
< 128) {
14752 /* Common ASCII char. Note that 9 is the tab character */
14755 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14756 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14758 if (!commonObj
[c
]) {
14759 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14761 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14766 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14769 Jim_Free(commonObj
);
14772 Jim_SetResult(interp
, resObjPtr
);
14777 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14779 const char *joinStr
;
14782 if (argc
!= 2 && argc
!= 3) {
14783 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14792 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14794 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14799 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14804 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
14807 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
14808 if (objPtr
== NULL
)
14810 Jim_SetResult(interp
, objPtr
);
14815 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14817 Jim_Obj
*listPtr
, **outVec
;
14821 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
14824 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
14825 SetScanFmtFromAny(interp
, argv
[2]);
14826 if (FormatGetError(argv
[2]) != 0) {
14827 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
14831 int maxPos
= FormatGetMaxPos(argv
[2]);
14832 int count
= FormatGetCnvCount(argv
[2]);
14834 if (maxPos
> argc
- 3) {
14835 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
14838 else if (count
> argc
- 3) {
14839 Jim_SetResultString(interp
, "different numbers of variable names and "
14840 "field specifiers", -1);
14843 else if (count
< argc
- 3) {
14844 Jim_SetResultString(interp
, "variable is not assigned by any "
14845 "conversion specifiers", -1);
14849 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
14856 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
14857 int len
= Jim_ListLength(interp
, listPtr
);
14860 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
14861 for (i
= 0; i
< outc
; ++i
) {
14862 if (Jim_Length(outVec
[i
]) > 0) {
14864 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
14870 Jim_FreeNewObj(interp
, listPtr
);
14875 if (rc
== JIM_OK
) {
14876 Jim_SetResultInt(interp
, count
);
14881 if (listPtr
== (Jim_Obj
*)EOF
) {
14882 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
14885 Jim_SetResult(interp
, listPtr
);
14891 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14893 if (argc
!= 2 && argc
!= 3) {
14894 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
14897 Jim_SetResult(interp
, argv
[1]);
14899 JimSetStackTrace(interp
, argv
[2]);
14902 interp
->addStackTrace
++;
14907 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14912 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
14915 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
14917 Jim_SetResult(interp
, objPtr
);
14922 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14927 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
14928 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
14932 if (count
== 0 || argc
== 2) {
14939 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
14941 ListInsertElements(objPtr
, -1, argc
, argv
);
14944 Jim_SetResult(interp
, objPtr
);
14948 char **Jim_GetEnviron(void)
14950 #if defined(HAVE__NSGETENVIRON)
14951 return *_NSGetEnviron();
14953 #if !defined(NO_ENVIRON_EXTERN)
14954 extern char **environ
;
14961 void Jim_SetEnviron(char **env
)
14963 #if defined(HAVE__NSGETENVIRON)
14964 *_NSGetEnviron() = env
;
14966 #if !defined(NO_ENVIRON_EXTERN)
14967 extern char **environ
;
14975 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14981 char **e
= Jim_GetEnviron();
14984 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14986 for (i
= 0; e
[i
]; i
++) {
14987 const char *equals
= strchr(e
[i
], '=');
14990 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
14992 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
14996 Jim_SetResult(interp
, listObjPtr
);
15001 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15004 key
= Jim_String(argv
[1]);
15008 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15011 val
= Jim_String(argv
[2]);
15013 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15018 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15023 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15026 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15027 if (retval
== JIM_RETURN
)
15033 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15035 Jim_Obj
*revObjPtr
, **ele
;
15039 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15042 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15044 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15046 ListAppendElement(revObjPtr
, ele
[len
--]);
15047 Jim_SetResult(interp
, revObjPtr
);
15051 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15059 else if (step
> 0 && start
> end
)
15061 else if (step
< 0 && end
> start
)
15065 len
= -len
; /* abs(len) */
15067 step
= -step
; /* abs(step) */
15068 len
= 1 + ((len
- 1) / step
);
15069 /* We can truncate safely to INT_MAX, the range command
15070 * will always return an error for a such long range
15071 * because Tcl lists can't be so long. */
15074 return (int)((len
< 0) ? -1 : len
);
15078 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15080 jim_wide start
= 0, end
, step
= 1;
15084 if (argc
< 2 || argc
> 4) {
15085 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15089 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15093 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15094 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15096 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15099 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15100 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15103 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15104 for (i
= 0; i
< len
; i
++)
15105 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15106 Jim_SetResult(interp
, objPtr
);
15111 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15113 jim_wide min
= 0, max
= 0, len
, maxMul
;
15115 if (argc
< 1 || argc
> 3) {
15116 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15120 max
= JIM_WIDE_MAX
;
15121 } else if (argc
== 2) {
15122 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15124 } else if (argc
== 3) {
15125 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15126 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15131 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15134 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15138 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15139 if (r
< 0 || r
>= maxMul
) continue;
15140 r
= (len
== 0) ? 0 : r
%len
;
15141 Jim_SetResultInt(interp
, min
+r
);
15146 static const struct {
15148 Jim_CmdProc
*cmdProc
;
15149 } Jim_CoreCommandsTable
[] = {
15150 {"alias", Jim_AliasCoreCommand
},
15151 {"set", Jim_SetCoreCommand
},
15152 {"unset", Jim_UnsetCoreCommand
},
15153 {"puts", Jim_PutsCoreCommand
},
15154 {"+", Jim_AddCoreCommand
},
15155 {"*", Jim_MulCoreCommand
},
15156 {"-", Jim_SubCoreCommand
},
15157 {"/", Jim_DivCoreCommand
},
15158 {"incr", Jim_IncrCoreCommand
},
15159 {"while", Jim_WhileCoreCommand
},
15160 {"loop", Jim_LoopCoreCommand
},
15161 {"for", Jim_ForCoreCommand
},
15162 {"foreach", Jim_ForeachCoreCommand
},
15163 {"lmap", Jim_LmapCoreCommand
},
15164 {"lassign", Jim_LassignCoreCommand
},
15165 {"if", Jim_IfCoreCommand
},
15166 {"switch", Jim_SwitchCoreCommand
},
15167 {"list", Jim_ListCoreCommand
},
15168 {"lindex", Jim_LindexCoreCommand
},
15169 {"lset", Jim_LsetCoreCommand
},
15170 {"lsearch", Jim_LsearchCoreCommand
},
15171 {"llength", Jim_LlengthCoreCommand
},
15172 {"lappend", Jim_LappendCoreCommand
},
15173 {"linsert", Jim_LinsertCoreCommand
},
15174 {"lreplace", Jim_LreplaceCoreCommand
},
15175 {"lsort", Jim_LsortCoreCommand
},
15176 {"append", Jim_AppendCoreCommand
},
15177 {"debug", Jim_DebugCoreCommand
},
15178 {"eval", Jim_EvalCoreCommand
},
15179 {"uplevel", Jim_UplevelCoreCommand
},
15180 {"expr", Jim_ExprCoreCommand
},
15181 {"break", Jim_BreakCoreCommand
},
15182 {"continue", Jim_ContinueCoreCommand
},
15183 {"proc", Jim_ProcCoreCommand
},
15184 {"concat", Jim_ConcatCoreCommand
},
15185 {"return", Jim_ReturnCoreCommand
},
15186 {"upvar", Jim_UpvarCoreCommand
},
15187 {"global", Jim_GlobalCoreCommand
},
15188 {"string", Jim_StringCoreCommand
},
15189 {"time", Jim_TimeCoreCommand
},
15190 {"exit", Jim_ExitCoreCommand
},
15191 {"catch", Jim_CatchCoreCommand
},
15192 #ifdef JIM_REFERENCES
15193 {"ref", Jim_RefCoreCommand
},
15194 {"getref", Jim_GetrefCoreCommand
},
15195 {"setref", Jim_SetrefCoreCommand
},
15196 {"finalize", Jim_FinalizeCoreCommand
},
15197 {"collect", Jim_CollectCoreCommand
},
15199 {"rename", Jim_RenameCoreCommand
},
15200 {"dict", Jim_DictCoreCommand
},
15201 {"subst", Jim_SubstCoreCommand
},
15202 {"info", Jim_InfoCoreCommand
},
15203 {"exists", Jim_ExistsCoreCommand
},
15204 {"split", Jim_SplitCoreCommand
},
15205 {"join", Jim_JoinCoreCommand
},
15206 {"format", Jim_FormatCoreCommand
},
15207 {"scan", Jim_ScanCoreCommand
},
15208 {"error", Jim_ErrorCoreCommand
},
15209 {"lrange", Jim_LrangeCoreCommand
},
15210 {"lrepeat", Jim_LrepeatCoreCommand
},
15211 {"env", Jim_EnvCoreCommand
},
15212 {"source", Jim_SourceCoreCommand
},
15213 {"lreverse", Jim_LreverseCoreCommand
},
15214 {"range", Jim_RangeCoreCommand
},
15215 {"rand", Jim_RandCoreCommand
},
15216 {"tailcall", Jim_TailcallCoreCommand
},
15217 {"local", Jim_LocalCoreCommand
},
15218 {"upcall", Jim_UpcallCoreCommand
},
15219 {"apply", Jim_ApplyCoreCommand
},
15223 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15227 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15228 Jim_CreateCommand(interp
,
15229 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15234 /* -----------------------------------------------------------------------------
15235 * Interactive prompt
15236 * ---------------------------------------------------------------------------*/
15237 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15241 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15242 argv
[1] = interp
->result
;
15244 Jim_EvalObjVector(interp
, 2, argv
);
15247 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15248 const char *prefix
, const char *const *tablePtr
, const char *name
)
15251 char **tablePtrSorted
;
15254 for (count
= 0; tablePtr
[count
]; count
++) {
15257 if (name
== NULL
) {
15261 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15262 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15263 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15264 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15265 for (i
= 0; i
< count
; i
++) {
15266 if (i
+ 1 == count
&& count
> 1) {
15267 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15269 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15270 if (i
+ 1 != count
) {
15271 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15274 Jim_Free(tablePtrSorted
);
15277 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15278 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15280 const char *bad
= "bad ";
15281 const char *const *entryPtr
= NULL
;
15285 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15289 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15290 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15291 /* Found an exact match */
15295 if (flags
& JIM_ENUM_ABBREV
) {
15296 /* Accept an unambiguous abbreviation.
15297 * Note that '-' doesnt' consitute a valid abbreviation
15299 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15300 if (*arg
== '-' && arglen
== 1) {
15304 bad
= "ambiguous ";
15312 /* If we had an unambiguous partial match */
15319 if (flags
& JIM_ERRMSG
) {
15320 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15325 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15329 for (i
= 0; i
< (int)len
; i
++) {
15330 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15337 int Jim_IsDict(Jim_Obj
*objPtr
)
15339 return objPtr
->typePtr
== &dictObjType
;
15342 int Jim_IsList(Jim_Obj
*objPtr
)
15344 return objPtr
->typePtr
== &listObjType
;
15348 * Very simple printf-like formatting, designed for error messages.
15350 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15351 * The resulting string is created and set as the result.
15353 * Each '%s' should correspond to a regular string parameter.
15354 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15355 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15357 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15359 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15361 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15363 /* Initial space needed */
15364 int len
= strlen(format
);
15367 const char *params
[5];
15372 va_start(args
, format
);
15374 for (i
= 0; i
< len
&& n
< 5; i
++) {
15377 if (strncmp(format
+ i
, "%s", 2) == 0) {
15378 params
[n
] = va_arg(args
, char *);
15380 l
= strlen(params
[n
]);
15382 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15383 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15385 params
[n
] = Jim_GetString(objPtr
, &l
);
15388 if (format
[i
] == '%') {
15398 buf
= Jim_Alloc(len
+ 1);
15399 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15403 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15407 #ifndef jim_ext_package
15408 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15413 #ifndef jim_ext_aio
15414 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15416 Jim_SetResultString(interp
, "aio not enabled", -1);
15423 * Local Variables: ***
15424 * c-basic-offset: 4 ***