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) {
5797 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5798 * whereas C99 is always -6
5799 * coverity[dead_error_line]
5801 tmp
[num
++] = (i
> 0) ? (10 - i
) : -i
;
5806 tmp
[num
++] = wideValue
% 10;
5810 for (i
= 0; i
< num
; i
++) {
5811 buf
[pos
++] = '0' + tmp
[num
- i
- 1];
5816 JimSetStringBytes(objPtr
, buf
);
5819 static int SetIntFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
5824 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
5825 /* Simple switcheroo */
5826 objPtr
->typePtr
= &intObjType
;
5830 /* Get the string representation */
5831 str
= Jim_String(objPtr
);
5832 /* Try to convert into a jim_wide */
5833 if (Jim_StringToWide(str
, &wideValue
, 0) != JIM_OK
) {
5834 if (flags
& JIM_ERRMSG
) {
5835 Jim_SetResultFormatted(interp
, "expected integer but got \"%#s\"", objPtr
);
5839 if ((wideValue
== JIM_WIDE_MIN
|| wideValue
== JIM_WIDE_MAX
) && errno
== ERANGE
) {
5840 Jim_SetResultString(interp
, "Integer value too big to be represented", -1);
5843 /* Free the old internal repr and set the new one. */
5844 Jim_FreeIntRep(interp
, objPtr
);
5845 objPtr
->typePtr
= &intObjType
;
5846 objPtr
->internalRep
.wideValue
= wideValue
;
5850 #ifdef JIM_OPTIMIZATION
5851 static int JimIsWide(Jim_Obj
*objPtr
)
5853 return objPtr
->typePtr
== &intObjType
;
5857 int Jim_GetWide(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5859 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_ERRMSG
) == JIM_ERR
)
5861 *widePtr
= JimWideValue(objPtr
);
5865 /* Get a wide but does not set an error if the format is bad. */
5866 static int JimGetWideNoErr(Jim_Interp
*interp
, Jim_Obj
*objPtr
, jim_wide
* widePtr
)
5868 if (objPtr
->typePtr
!= &intObjType
&& SetIntFromAny(interp
, objPtr
, JIM_NONE
) == JIM_ERR
)
5870 *widePtr
= JimWideValue(objPtr
);
5874 int Jim_GetLong(Jim_Interp
*interp
, Jim_Obj
*objPtr
, long *longPtr
)
5879 retval
= Jim_GetWide(interp
, objPtr
, &wideValue
);
5880 if (retval
== JIM_OK
) {
5881 *longPtr
= (long)wideValue
;
5887 Jim_Obj
*Jim_NewIntObj(Jim_Interp
*interp
, jim_wide wideValue
)
5891 objPtr
= Jim_NewObj(interp
);
5892 objPtr
->typePtr
= &intObjType
;
5893 objPtr
->bytes
= NULL
;
5894 objPtr
->internalRep
.wideValue
= wideValue
;
5898 /* -----------------------------------------------------------------------------
5900 * ---------------------------------------------------------------------------*/
5901 #define JIM_DOUBLE_SPACE 30
5903 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
);
5904 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
5906 static const Jim_ObjType doubleObjType
= {
5910 UpdateStringOfDouble
,
5916 #define isnan(X) ((X) != (X))
5920 #define isinf(X) (1.0 / (X) == 0.0)
5923 static void UpdateStringOfDouble(struct Jim_Obj
*objPtr
)
5925 double value
= objPtr
->internalRep
.doubleValue
;
5928 JimSetStringBytes(objPtr
, "NaN");
5933 JimSetStringBytes(objPtr
, "-Inf");
5936 JimSetStringBytes(objPtr
, "Inf");
5941 char buf
[JIM_DOUBLE_SPACE
+ 1];
5943 int len
= sprintf(buf
, "%.12g", value
);
5945 /* Add a final ".0" if necessary */
5946 for (i
= 0; i
< len
; i
++) {
5947 if (buf
[i
] == '.' || buf
[i
] == 'e') {
5948 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5949 /* If 'buf' ends in e-0nn or e+0nn, remove
5950 * the 0 after the + or - and reduce the length by 1
5952 char *e
= strchr(buf
, 'e');
5953 if (e
&& (e
[1] == '-' || e
[1] == '+') && e
[2] == '0') {
5956 memmove(e
, e
+ 1, len
- (e
- buf
));
5962 if (buf
[i
] == '\0') {
5967 JimSetStringBytes(objPtr
, buf
);
5971 static int SetDoubleFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
5977 /* Preserve the string representation.
5978 * Needed so we can convert back to int without loss
5980 str
= Jim_String(objPtr
);
5982 #ifdef HAVE_LONG_LONG
5983 /* Assume a 53 bit mantissa */
5984 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5985 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5987 if (objPtr
->typePtr
== &intObjType
5988 && JimWideValue(objPtr
) >= MIN_INT_IN_DOUBLE
5989 && JimWideValue(objPtr
) <= MAX_INT_IN_DOUBLE
) {
5991 /* Direct conversion to coerced double */
5992 objPtr
->typePtr
= &coercedDoubleObjType
;
5997 if (Jim_StringToWide(str
, &wideValue
, 10) == JIM_OK
) {
5998 /* Managed to convert to an int, so we can use this as a cooerced double */
5999 Jim_FreeIntRep(interp
, objPtr
);
6000 objPtr
->typePtr
= &coercedDoubleObjType
;
6001 objPtr
->internalRep
.wideValue
= wideValue
;
6005 /* Try to convert into a double */
6006 if (Jim_StringToDouble(str
, &doubleValue
) != JIM_OK
) {
6007 Jim_SetResultFormatted(interp
, "expected number but got \"%#s\"", objPtr
);
6010 /* Free the old internal repr and set the new one. */
6011 Jim_FreeIntRep(interp
, objPtr
);
6013 objPtr
->typePtr
= &doubleObjType
;
6014 objPtr
->internalRep
.doubleValue
= doubleValue
;
6018 int Jim_GetDouble(Jim_Interp
*interp
, Jim_Obj
*objPtr
, double *doublePtr
)
6020 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6021 *doublePtr
= JimWideValue(objPtr
);
6024 if (objPtr
->typePtr
!= &doubleObjType
&& SetDoubleFromAny(interp
, objPtr
) == JIM_ERR
)
6027 if (objPtr
->typePtr
== &coercedDoubleObjType
) {
6028 *doublePtr
= JimWideValue(objPtr
);
6031 *doublePtr
= objPtr
->internalRep
.doubleValue
;
6036 Jim_Obj
*Jim_NewDoubleObj(Jim_Interp
*interp
, double doubleValue
)
6040 objPtr
= Jim_NewObj(interp
);
6041 objPtr
->typePtr
= &doubleObjType
;
6042 objPtr
->bytes
= NULL
;
6043 objPtr
->internalRep
.doubleValue
= doubleValue
;
6047 /* -----------------------------------------------------------------------------
6049 * ---------------------------------------------------------------------------*/
6050 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
);
6051 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
);
6052 static void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6053 static void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6054 static void UpdateStringOfList(struct Jim_Obj
*objPtr
);
6055 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6057 /* Note that while the elements of the list may contain references,
6058 * the list object itself can't. This basically means that the
6059 * list object string representation as a whole can't contain references
6060 * that are not presents in the single elements. */
6061 static const Jim_ObjType listObjType
= {
6063 FreeListInternalRep
,
6069 void FreeListInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6073 for (i
= 0; i
< objPtr
->internalRep
.listValue
.len
; i
++) {
6074 Jim_DecrRefCount(interp
, objPtr
->internalRep
.listValue
.ele
[i
]);
6076 Jim_Free(objPtr
->internalRep
.listValue
.ele
);
6079 void DupListInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6083 JIM_NOTUSED(interp
);
6085 dupPtr
->internalRep
.listValue
.len
= srcPtr
->internalRep
.listValue
.len
;
6086 dupPtr
->internalRep
.listValue
.maxLen
= srcPtr
->internalRep
.listValue
.maxLen
;
6087 dupPtr
->internalRep
.listValue
.ele
=
6088 Jim_Alloc(sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.maxLen
);
6089 memcpy(dupPtr
->internalRep
.listValue
.ele
, srcPtr
->internalRep
.listValue
.ele
,
6090 sizeof(Jim_Obj
*) * srcPtr
->internalRep
.listValue
.len
);
6091 for (i
= 0; i
< dupPtr
->internalRep
.listValue
.len
; i
++) {
6092 Jim_IncrRefCount(dupPtr
->internalRep
.listValue
.ele
[i
]);
6094 dupPtr
->typePtr
= &listObjType
;
6097 /* The following function checks if a given string can be encoded
6098 * into a list element without any kind of quoting, surrounded by braces,
6099 * or using escapes to quote. */
6100 #define JIM_ELESTR_SIMPLE 0
6101 #define JIM_ELESTR_BRACE 1
6102 #define JIM_ELESTR_QUOTE 2
6103 static unsigned char ListElementQuotingType(const char *s
, int len
)
6105 int i
, level
, blevel
, trySimple
= 1;
6107 /* Try with the SIMPLE case */
6109 return JIM_ELESTR_BRACE
;
6110 if (s
[0] == '"' || s
[0] == '{') {
6114 for (i
= 0; i
< len
; i
++) {
6134 return JIM_ELESTR_SIMPLE
;
6137 /* Test if it's possible to do with braces */
6138 if (s
[len
- 1] == '\\')
6139 return JIM_ELESTR_QUOTE
;
6142 for (i
= 0; i
< len
; i
++) {
6150 return JIM_ELESTR_QUOTE
;
6159 if (s
[i
+ 1] == '\n')
6160 return JIM_ELESTR_QUOTE
;
6161 else if (s
[i
+ 1] != '\0')
6167 return JIM_ELESTR_QUOTE
;
6172 return JIM_ELESTR_BRACE
;
6173 for (i
= 0; i
< len
; i
++) {
6187 return JIM_ELESTR_BRACE
;
6191 return JIM_ELESTR_SIMPLE
;
6193 return JIM_ELESTR_QUOTE
;
6196 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6197 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6199 * Returns the length of the result.
6201 static int BackslashQuoteString(const char *s
, int len
, char *q
)
6254 static void JimMakeListStringRep(Jim_Obj
*objPtr
, Jim_Obj
**objv
, int objc
)
6256 #define STATIC_QUOTING_LEN 32
6257 int i
, bufLen
, realLength
;
6260 unsigned char *quotingType
, staticQuoting
[STATIC_QUOTING_LEN
];
6262 /* Estimate the space needed. */
6263 if (objc
> STATIC_QUOTING_LEN
) {
6264 quotingType
= Jim_Alloc(objc
);
6267 quotingType
= staticQuoting
;
6270 for (i
= 0; i
< objc
; i
++) {
6273 strRep
= Jim_GetString(objv
[i
], &len
);
6274 quotingType
[i
] = ListElementQuotingType(strRep
, len
);
6275 switch (quotingType
[i
]) {
6276 case JIM_ELESTR_SIMPLE
:
6277 if (i
!= 0 || strRep
[0] != '#') {
6281 /* Special case '#' on first element needs braces */
6282 quotingType
[i
] = JIM_ELESTR_BRACE
;
6284 case JIM_ELESTR_BRACE
:
6287 case JIM_ELESTR_QUOTE
:
6291 bufLen
++; /* elements separator. */
6295 /* Generate the string rep. */
6296 p
= objPtr
->bytes
= Jim_Alloc(bufLen
+ 1);
6298 for (i
= 0; i
< objc
; i
++) {
6301 strRep
= Jim_GetString(objv
[i
], &len
);
6303 switch (quotingType
[i
]) {
6304 case JIM_ELESTR_SIMPLE
:
6305 memcpy(p
, strRep
, len
);
6309 case JIM_ELESTR_BRACE
:
6311 memcpy(p
, strRep
, len
);
6314 realLength
+= len
+ 2;
6316 case JIM_ELESTR_QUOTE
:
6317 if (i
== 0 && strRep
[0] == '#') {
6321 qlen
= BackslashQuoteString(strRep
, len
, p
);
6326 /* Add a separating space */
6327 if (i
+ 1 != objc
) {
6332 *p
= '\0'; /* nul term. */
6333 objPtr
->length
= realLength
;
6335 if (quotingType
!= staticQuoting
) {
6336 Jim_Free(quotingType
);
6340 static void UpdateStringOfList(struct Jim_Obj
*objPtr
)
6342 JimMakeListStringRep(objPtr
, objPtr
->internalRep
.listValue
.ele
, objPtr
->internalRep
.listValue
.len
);
6345 static int SetListFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
6347 struct JimParserCtx parser
;
6350 Jim_Obj
*fileNameObj
;
6353 if (objPtr
->typePtr
== &listObjType
) {
6357 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6358 * it also preserves any source location of the dict elements
6359 * which can be very useful
6361 if (Jim_IsDict(objPtr
) && objPtr
->bytes
== NULL
) {
6362 Jim_Obj
**listObjPtrPtr
;
6366 listObjPtrPtr
= JimDictPairs(objPtr
, &len
);
6367 for (i
= 0; i
< len
; i
++) {
6368 Jim_IncrRefCount(listObjPtrPtr
[i
]);
6371 /* Now just switch the internal rep */
6372 Jim_FreeIntRep(interp
, objPtr
);
6373 objPtr
->typePtr
= &listObjType
;
6374 objPtr
->internalRep
.listValue
.len
= len
;
6375 objPtr
->internalRep
.listValue
.maxLen
= len
;
6376 objPtr
->internalRep
.listValue
.ele
= listObjPtrPtr
;
6381 /* Try to preserve information about filename / line number */
6382 if (objPtr
->typePtr
== &sourceObjType
) {
6383 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
6384 linenr
= objPtr
->internalRep
.sourceValue
.lineNumber
;
6387 fileNameObj
= interp
->emptyObj
;
6390 Jim_IncrRefCount(fileNameObj
);
6392 /* Get the string representation */
6393 str
= Jim_GetString(objPtr
, &strLen
);
6395 /* Free the old internal repr just now and initialize the
6396 * new one just now. The string->list conversion can't fail. */
6397 Jim_FreeIntRep(interp
, objPtr
);
6398 objPtr
->typePtr
= &listObjType
;
6399 objPtr
->internalRep
.listValue
.len
= 0;
6400 objPtr
->internalRep
.listValue
.maxLen
= 0;
6401 objPtr
->internalRep
.listValue
.ele
= NULL
;
6403 /* Convert into a list */
6405 JimParserInit(&parser
, str
, strLen
, linenr
);
6406 while (!parser
.eof
) {
6407 Jim_Obj
*elementPtr
;
6409 JimParseList(&parser
);
6410 if (parser
.tt
!= JIM_TT_STR
&& parser
.tt
!= JIM_TT_ESC
)
6412 elementPtr
= JimParserGetTokenObj(interp
, &parser
);
6413 JimSetSourceInfo(interp
, elementPtr
, fileNameObj
, parser
.tline
);
6414 ListAppendElement(objPtr
, elementPtr
);
6417 Jim_DecrRefCount(interp
, fileNameObj
);
6421 Jim_Obj
*Jim_NewListObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
6425 objPtr
= Jim_NewObj(interp
);
6426 objPtr
->typePtr
= &listObjType
;
6427 objPtr
->bytes
= NULL
;
6428 objPtr
->internalRep
.listValue
.ele
= NULL
;
6429 objPtr
->internalRep
.listValue
.len
= 0;
6430 objPtr
->internalRep
.listValue
.maxLen
= 0;
6433 ListInsertElements(objPtr
, 0, len
, elements
);
6439 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6440 * length of the vector. Note that the user of this function should make
6441 * sure that the list object can't shimmer while the vector returned
6442 * is in use, this vector is the one stored inside the internal representation
6443 * of the list object. This function is not exported, extensions should
6444 * always access to the List object elements using Jim_ListIndex(). */
6445 static void JimListGetElements(Jim_Interp
*interp
, Jim_Obj
*listObj
, int *listLen
,
6448 *listLen
= Jim_ListLength(interp
, listObj
);
6449 *listVec
= listObj
->internalRep
.listValue
.ele
;
6452 /* Sorting uses ints, but commands may return wide */
6453 static int JimSign(jim_wide w
)
6464 /* ListSortElements type values */
6480 int (*subfn
)(Jim_Obj
**, Jim_Obj
**);
6483 static struct lsort_info
*sort_info
;
6485 static int ListSortIndexHelper(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6487 Jim_Obj
*lObj
, *rObj
;
6489 if (Jim_ListIndex(sort_info
->interp
, *lhsObj
, sort_info
->index
, &lObj
, JIM_ERRMSG
) != JIM_OK
||
6490 Jim_ListIndex(sort_info
->interp
, *rhsObj
, sort_info
->index
, &rObj
, JIM_ERRMSG
) != JIM_OK
) {
6491 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6493 return sort_info
->subfn(&lObj
, &rObj
);
6496 /* Sort the internal rep of a list. */
6497 static int ListSortString(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6499 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 0) * sort_info
->order
;
6502 static int ListSortStringNoCase(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6504 return Jim_StringCompareObj(sort_info
->interp
, *lhsObj
, *rhsObj
, 1) * sort_info
->order
;
6507 static int ListSortInteger(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6509 jim_wide lhs
= 0, rhs
= 0;
6511 if (Jim_GetWide(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6512 Jim_GetWide(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6513 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6516 return JimSign(lhs
- rhs
) * sort_info
->order
;
6519 static int ListSortReal(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6521 double lhs
= 0, rhs
= 0;
6523 if (Jim_GetDouble(sort_info
->interp
, *lhsObj
, &lhs
) != JIM_OK
||
6524 Jim_GetDouble(sort_info
->interp
, *rhsObj
, &rhs
) != JIM_OK
) {
6525 longjmp(sort_info
->jmpbuf
, JIM_ERR
);
6531 return sort_info
->order
;
6533 return -sort_info
->order
;
6536 static int ListSortCommand(Jim_Obj
**lhsObj
, Jim_Obj
**rhsObj
)
6538 Jim_Obj
*compare_script
;
6543 /* This must be a valid list */
6544 compare_script
= Jim_DuplicateObj(sort_info
->interp
, sort_info
->command
);
6545 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *lhsObj
);
6546 Jim_ListAppendElement(sort_info
->interp
, compare_script
, *rhsObj
);
6548 rc
= Jim_EvalObj(sort_info
->interp
, compare_script
);
6550 if (rc
!= JIM_OK
|| Jim_GetWide(sort_info
->interp
, Jim_GetResult(sort_info
->interp
), &ret
) != JIM_OK
) {
6551 longjmp(sort_info
->jmpbuf
, rc
);
6554 return JimSign(ret
) * sort_info
->order
;
6557 /* Remove duplicate elements from the (sorted) list in-place, according to the
6558 * comparison function, comp.
6560 * Note that the last unique value is kept, not the first
6562 static void ListRemoveDuplicates(Jim_Obj
*listObjPtr
, int (*comp
)(Jim_Obj
**lhs
, Jim_Obj
**rhs
))
6566 Jim_Obj
**ele
= listObjPtr
->internalRep
.listValue
.ele
;
6568 for (src
= 1; src
< listObjPtr
->internalRep
.listValue
.len
; src
++) {
6569 if (comp(&ele
[dst
], &ele
[src
]) == 0) {
6570 /* Match, so replace the dest with the current source */
6571 Jim_DecrRefCount(sort_info
->interp
, ele
[dst
]);
6574 /* No match, so keep the current source and move to the next destination */
6577 ele
[dst
] = ele
[src
];
6579 /* At end of list, keep the final element */
6580 ele
[++dst
] = ele
[src
];
6582 /* Set the new length */
6583 listObjPtr
->internalRep
.listValue
.len
= dst
;
6586 /* Sort a list *in place*. MUST be called with a non-shared list. */
6587 static int ListSortElements(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, struct lsort_info
*info
)
6589 struct lsort_info
*prev_info
;
6591 typedef int (qsort_comparator
) (const void *, const void *);
6592 int (*fn
) (Jim_Obj
**, Jim_Obj
**);
6597 JimPanic((Jim_IsShared(listObjPtr
), "ListSortElements called with shared object"));
6598 SetListFromAny(interp
, listObjPtr
);
6600 /* Allow lsort to be called reentrantly */
6601 prev_info
= sort_info
;
6604 vector
= listObjPtr
->internalRep
.listValue
.ele
;
6605 len
= listObjPtr
->internalRep
.listValue
.len
;
6606 switch (info
->type
) {
6607 case JIM_LSORT_ASCII
:
6608 fn
= ListSortString
;
6610 case JIM_LSORT_NOCASE
:
6611 fn
= ListSortStringNoCase
;
6613 case JIM_LSORT_INTEGER
:
6614 fn
= ListSortInteger
;
6616 case JIM_LSORT_REAL
:
6619 case JIM_LSORT_COMMAND
:
6620 fn
= ListSortCommand
;
6623 fn
= NULL
; /* avoid warning */
6624 JimPanic((1, "ListSort called with invalid sort type"));
6627 if (info
->indexed
) {
6628 /* Need to interpose a "list index" function */
6630 fn
= ListSortIndexHelper
;
6633 if ((rc
= setjmp(info
->jmpbuf
)) == 0) {
6634 qsort(vector
, len
, sizeof(Jim_Obj
*), (qsort_comparator
*) fn
);
6636 if (info
->unique
&& len
> 1) {
6637 ListRemoveDuplicates(listObjPtr
, fn
);
6640 Jim_InvalidateStringRep(listObjPtr
);
6642 sort_info
= prev_info
;
6647 /* This is the low-level function to insert elements into a list.
6648 * The higher-level Jim_ListInsertElements() performs shared object
6649 * check and invalidates the string repr. This version is used
6650 * in the internals of the List Object and is not exported.
6652 * NOTE: this function can be called only against objects
6653 * with internal type of List.
6655 * An insertion point (idx) of -1 means end-of-list.
6657 static void ListInsertElements(Jim_Obj
*listPtr
, int idx
, int elemc
, Jim_Obj
*const *elemVec
)
6659 int currentLen
= listPtr
->internalRep
.listValue
.len
;
6660 int requiredLen
= currentLen
+ elemc
;
6664 if (requiredLen
> listPtr
->internalRep
.listValue
.maxLen
) {
6665 if (requiredLen
< 2) {
6666 /* Don't do allocations of under 4 pointers. */
6673 listPtr
->internalRep
.listValue
.ele
= Jim_Realloc(listPtr
->internalRep
.listValue
.ele
,
6674 sizeof(Jim_Obj
*) * requiredLen
);
6676 listPtr
->internalRep
.listValue
.maxLen
= requiredLen
;
6681 point
= listPtr
->internalRep
.listValue
.ele
+ idx
;
6682 memmove(point
+ elemc
, point
, (currentLen
- idx
) * sizeof(Jim_Obj
*));
6683 for (i
= 0; i
< elemc
; ++i
) {
6684 point
[i
] = elemVec
[i
];
6685 Jim_IncrRefCount(point
[i
]);
6687 listPtr
->internalRep
.listValue
.len
+= elemc
;
6690 /* Convenience call to ListInsertElements() to append a single element.
6692 static void ListAppendElement(Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6694 ListInsertElements(listPtr
, -1, 1, &objPtr
);
6697 /* Appends every element of appendListPtr into listPtr.
6698 * Both have to be of the list type.
6699 * Convenience call to ListInsertElements()
6701 static void ListAppendList(Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6703 ListInsertElements(listPtr
, -1,
6704 appendListPtr
->internalRep
.listValue
.len
, appendListPtr
->internalRep
.listValue
.ele
);
6707 void Jim_ListAppendElement(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*objPtr
)
6709 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendElement called with shared object"));
6710 SetListFromAny(interp
, listPtr
);
6711 Jim_InvalidateStringRep(listPtr
);
6712 ListAppendElement(listPtr
, objPtr
);
6715 void Jim_ListAppendList(Jim_Interp
*interp
, Jim_Obj
*listPtr
, Jim_Obj
*appendListPtr
)
6717 JimPanic((Jim_IsShared(listPtr
), "Jim_ListAppendList called with shared object"));
6718 SetListFromAny(interp
, listPtr
);
6719 SetListFromAny(interp
, appendListPtr
);
6720 Jim_InvalidateStringRep(listPtr
);
6721 ListAppendList(listPtr
, appendListPtr
);
6724 int Jim_ListLength(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6726 SetListFromAny(interp
, objPtr
);
6727 return objPtr
->internalRep
.listValue
.len
;
6730 void Jim_ListInsertElements(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6731 int objc
, Jim_Obj
*const *objVec
)
6733 JimPanic((Jim_IsShared(listPtr
), "Jim_ListInsertElement called with shared object"));
6734 SetListFromAny(interp
, listPtr
);
6735 if (idx
>= 0 && idx
> listPtr
->internalRep
.listValue
.len
)
6736 idx
= listPtr
->internalRep
.listValue
.len
;
6739 Jim_InvalidateStringRep(listPtr
);
6740 ListInsertElements(listPtr
, idx
, objc
, objVec
);
6743 Jim_Obj
*Jim_ListGetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
)
6745 SetListFromAny(interp
, listPtr
);
6746 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6747 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6751 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6752 return listPtr
->internalRep
.listValue
.ele
[idx
];
6755 int Jim_ListIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
, Jim_Obj
**objPtrPtr
, int flags
)
6757 *objPtrPtr
= Jim_ListGetIndex(interp
, listPtr
, idx
);
6758 if (*objPtrPtr
== NULL
) {
6759 if (flags
& JIM_ERRMSG
) {
6760 Jim_SetResultString(interp
, "list index out of range", -1);
6767 static int ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*listPtr
, int idx
,
6768 Jim_Obj
*newObjPtr
, int flags
)
6770 SetListFromAny(interp
, listPtr
);
6771 if ((idx
>= 0 && idx
>= listPtr
->internalRep
.listValue
.len
) ||
6772 (idx
< 0 && (-idx
- 1) >= listPtr
->internalRep
.listValue
.len
)) {
6773 if (flags
& JIM_ERRMSG
) {
6774 Jim_SetResultString(interp
, "list index out of range", -1);
6779 idx
= listPtr
->internalRep
.listValue
.len
+ idx
;
6780 Jim_DecrRefCount(interp
, listPtr
->internalRep
.listValue
.ele
[idx
]);
6781 listPtr
->internalRep
.listValue
.ele
[idx
] = newObjPtr
;
6782 Jim_IncrRefCount(newObjPtr
);
6786 /* Modify the list stored in the variable named 'varNamePtr'
6787 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6788 * with the new element 'newObjptr'. (implements the [lset] command) */
6789 int Jim_ListSetIndex(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
6790 Jim_Obj
*const *indexv
, int indexc
, Jim_Obj
*newObjPtr
)
6792 Jim_Obj
*varObjPtr
, *objPtr
, *listObjPtr
;
6795 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
| JIM_UNSHARED
);
6798 if ((shared
= Jim_IsShared(objPtr
)))
6799 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6800 for (i
= 0; i
< indexc
- 1; i
++) {
6801 listObjPtr
= objPtr
;
6802 if (Jim_GetIndex(interp
, indexv
[i
], &idx
) != JIM_OK
)
6804 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_ERRMSG
) != JIM_OK
) {
6807 if (Jim_IsShared(objPtr
)) {
6808 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
6809 ListSetIndex(interp
, listObjPtr
, idx
, objPtr
, JIM_NONE
);
6811 Jim_InvalidateStringRep(listObjPtr
);
6813 if (Jim_GetIndex(interp
, indexv
[indexc
- 1], &idx
) != JIM_OK
)
6815 if (ListSetIndex(interp
, objPtr
, idx
, newObjPtr
, JIM_ERRMSG
) == JIM_ERR
)
6817 Jim_InvalidateStringRep(objPtr
);
6818 Jim_InvalidateStringRep(varObjPtr
);
6819 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
)
6821 Jim_SetResult(interp
, varObjPtr
);
6825 Jim_FreeNewObj(interp
, varObjPtr
);
6830 Jim_Obj
*Jim_ListJoin(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, const char *joinStr
, int joinStrLen
)
6833 int listLen
= Jim_ListLength(interp
, listObjPtr
);
6834 Jim_Obj
*resObjPtr
= Jim_NewEmptyStringObj(interp
);
6836 for (i
= 0; i
< listLen
; ) {
6837 Jim_AppendObj(interp
, resObjPtr
, Jim_ListGetIndex(interp
, listObjPtr
, i
));
6838 if (++i
!= listLen
) {
6839 Jim_AppendString(interp
, resObjPtr
, joinStr
, joinStrLen
);
6845 Jim_Obj
*Jim_ConcatObj(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
6849 /* If all the objects in objv are lists,
6850 * it's possible to return a list as result, that's the
6851 * concatenation of all the lists. */
6852 for (i
= 0; i
< objc
; i
++) {
6853 if (!Jim_IsList(objv
[i
]))
6857 Jim_Obj
*objPtr
= Jim_NewListObj(interp
, NULL
, 0);
6859 for (i
= 0; i
< objc
; i
++)
6860 ListAppendList(objPtr
, objv
[i
]);
6864 /* Else... we have to glue strings together */
6865 int len
= 0, objLen
;
6868 /* Compute the length */
6869 for (i
= 0; i
< objc
; i
++) {
6870 len
+= Jim_Length(objv
[i
]);
6874 /* Create the string rep, and a string object holding it. */
6875 p
= bytes
= Jim_Alloc(len
+ 1);
6876 for (i
= 0; i
< objc
; i
++) {
6877 const char *s
= Jim_GetString(objv
[i
], &objLen
);
6879 /* Remove leading space */
6880 while (objLen
&& isspace(UCHAR(*s
))) {
6885 /* And trailing space */
6886 while (objLen
&& isspace(UCHAR(s
[objLen
- 1]))) {
6887 /* Handle trailing backslash-space case */
6888 if (objLen
> 1 && s
[objLen
- 2] == '\\') {
6894 memcpy(p
, s
, objLen
);
6896 if (i
+ 1 != objc
) {
6900 /* Drop the space calcuated for this
6901 * element that is instead null. */
6907 return Jim_NewStringObjNoAlloc(interp
, bytes
, len
);
6911 /* Returns a list composed of the elements in the specified range.
6912 * first and start are directly accepted as Jim_Objects and
6913 * processed for the end?-index? case. */
6914 Jim_Obj
*Jim_ListRange(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*firstObjPtr
,
6915 Jim_Obj
*lastObjPtr
)
6920 if (Jim_GetIndex(interp
, firstObjPtr
, &first
) != JIM_OK
||
6921 Jim_GetIndex(interp
, lastObjPtr
, &last
) != JIM_OK
)
6923 len
= Jim_ListLength(interp
, listObjPtr
); /* will convert into list */
6924 first
= JimRelToAbsIndex(len
, first
);
6925 last
= JimRelToAbsIndex(len
, last
);
6926 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
6927 if (first
== 0 && last
== len
) {
6930 return Jim_NewListObj(interp
, listObjPtr
->internalRep
.listValue
.ele
+ first
, rangeLen
);
6933 /* -----------------------------------------------------------------------------
6935 * ---------------------------------------------------------------------------*/
6936 static void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
6937 static void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
6938 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
);
6939 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
6941 /* Dict HashTable Type.
6943 * Keys and Values are Jim objects. */
6945 static unsigned int JimObjectHTHashFunction(const void *key
)
6948 const char *str
= Jim_GetString((Jim_Obj
*)key
, &len
);
6949 return Jim_GenHashFunction((const unsigned char *)str
, len
);
6952 static int JimObjectHTKeyCompare(void *privdata
, const void *key1
, const void *key2
)
6954 return Jim_StringEqObj((Jim_Obj
*)key1
, (Jim_Obj
*)key2
);
6957 static void *JimObjectHTKeyValDup(void *privdata
, const void *val
)
6959 Jim_IncrRefCount((Jim_Obj
*)val
);
6963 static void JimObjectHTKeyValDestructor(void *interp
, void *val
)
6965 Jim_DecrRefCount(interp
, (Jim_Obj
*)val
);
6968 static const Jim_HashTableType JimDictHashTableType
= {
6969 JimObjectHTHashFunction
, /* hash function */
6970 JimObjectHTKeyValDup
, /* key dup */
6971 JimObjectHTKeyValDup
, /* val dup */
6972 JimObjectHTKeyCompare
, /* key compare */
6973 JimObjectHTKeyValDestructor
, /* key destructor */
6974 JimObjectHTKeyValDestructor
/* val destructor */
6977 /* Note that while the elements of the dict may contain references,
6978 * the list object itself can't. This basically means that the
6979 * dict object string representation as a whole can't contain references
6980 * that are not presents in the single elements. */
6981 static const Jim_ObjType dictObjType
= {
6983 FreeDictInternalRep
,
6989 void FreeDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
6991 JIM_NOTUSED(interp
);
6993 Jim_FreeHashTable(objPtr
->internalRep
.ptr
);
6994 Jim_Free(objPtr
->internalRep
.ptr
);
6997 void DupDictInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
6999 Jim_HashTable
*ht
, *dupHt
;
7000 Jim_HashTableIterator htiter
;
7003 /* Create a new hash table */
7004 ht
= srcPtr
->internalRep
.ptr
;
7005 dupHt
= Jim_Alloc(sizeof(*dupHt
));
7006 Jim_InitHashTable(dupHt
, &JimDictHashTableType
, interp
);
7008 Jim_ExpandHashTable(dupHt
, ht
->size
);
7009 /* Copy every element from the source to the dup hash table */
7010 JimInitHashTableIterator(ht
, &htiter
);
7011 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7012 Jim_AddHashEntry(dupHt
, he
->key
, he
->u
.val
);
7015 dupPtr
->internalRep
.ptr
= dupHt
;
7016 dupPtr
->typePtr
= &dictObjType
;
7019 static Jim_Obj
**JimDictPairs(Jim_Obj
*dictPtr
, int *len
)
7022 Jim_HashTableIterator htiter
;
7027 ht
= dictPtr
->internalRep
.ptr
;
7029 /* Turn the hash table into a flat vector of Jim_Objects. */
7030 objv
= Jim_Alloc((ht
->used
* 2) * sizeof(Jim_Obj
*));
7031 JimInitHashTableIterator(ht
, &htiter
);
7033 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
7034 objv
[i
++] = Jim_GetHashEntryKey(he
);
7035 objv
[i
++] = Jim_GetHashEntryVal(he
);
7041 static void UpdateStringOfDict(struct Jim_Obj
*objPtr
)
7043 /* Turn the hash table into a flat vector of Jim_Objects. */
7045 Jim_Obj
**objv
= JimDictPairs(objPtr
, &len
);
7047 /* And now generate the string rep as a list */
7048 JimMakeListStringRep(objPtr
, objv
, len
);
7053 static int SetDictFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
7057 if (objPtr
->typePtr
== &dictObjType
) {
7061 if (Jim_IsList(objPtr
) && Jim_IsShared(objPtr
)) {
7062 /* A shared list, so get the string representation now to avoid
7063 * changing the order in case of fast conversion to dict.
7068 /* For simplicity, convert a non-list object to a list and then to a dict */
7069 listlen
= Jim_ListLength(interp
, objPtr
);
7071 Jim_SetResultString(interp
, "missing value to go with key", -1);
7075 /* Converting from a list to a dict can't fail */
7079 ht
= Jim_Alloc(sizeof(*ht
));
7080 Jim_InitHashTable(ht
, &JimDictHashTableType
, interp
);
7082 for (i
= 0; i
< listlen
; i
+= 2) {
7083 Jim_Obj
*keyObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
);
7084 Jim_Obj
*valObjPtr
= Jim_ListGetIndex(interp
, objPtr
, i
+ 1);
7086 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valObjPtr
);
7089 Jim_FreeIntRep(interp
, objPtr
);
7090 objPtr
->typePtr
= &dictObjType
;
7091 objPtr
->internalRep
.ptr
= ht
;
7097 /* Dict object API */
7099 /* Add an element to a dict. objPtr must be of the "dict" type.
7100 * The higer-level exported function is Jim_DictAddElement().
7101 * If an element with the specified key already exists, the value
7102 * associated is replaced with the new one.
7104 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7105 static int DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7106 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7108 Jim_HashTable
*ht
= objPtr
->internalRep
.ptr
;
7110 if (valueObjPtr
== NULL
) { /* unset */
7111 return Jim_DeleteHashEntry(ht
, keyObjPtr
);
7113 Jim_ReplaceHashEntry(ht
, keyObjPtr
, valueObjPtr
);
7117 /* Add an element, higher-level interface for DictAddElement().
7118 * If valueObjPtr == NULL, the key is removed if it exists. */
7119 int Jim_DictAddElement(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
7120 Jim_Obj
*keyObjPtr
, Jim_Obj
*valueObjPtr
)
7122 JimPanic((Jim_IsShared(objPtr
), "Jim_DictAddElement called with shared object"));
7123 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
7126 Jim_InvalidateStringRep(objPtr
);
7127 return DictAddElement(interp
, objPtr
, keyObjPtr
, valueObjPtr
);
7130 Jim_Obj
*Jim_NewDictObj(Jim_Interp
*interp
, Jim_Obj
*const *elements
, int len
)
7135 JimPanic((len
% 2, "Jim_NewDictObj() 'len' argument must be even"));
7137 objPtr
= Jim_NewObj(interp
);
7138 objPtr
->typePtr
= &dictObjType
;
7139 objPtr
->bytes
= NULL
;
7140 objPtr
->internalRep
.ptr
= Jim_Alloc(sizeof(Jim_HashTable
));
7141 Jim_InitHashTable(objPtr
->internalRep
.ptr
, &JimDictHashTableType
, interp
);
7142 for (i
= 0; i
< len
; i
+= 2)
7143 DictAddElement(interp
, objPtr
, elements
[i
], elements
[i
+ 1]);
7147 /* Return the value associated to the specified dict key
7148 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7150 * Sets *objPtrPtr to non-NULL only upon success.
7152 int Jim_DictKey(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
*keyPtr
,
7153 Jim_Obj
**objPtrPtr
, int flags
)
7158 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7161 ht
= dictPtr
->internalRep
.ptr
;
7162 if ((he
= Jim_FindHashEntry(ht
, keyPtr
)) == NULL
) {
7163 if (flags
& JIM_ERRMSG
) {
7164 Jim_SetResultFormatted(interp
, "key \"%#s\" not known in dictionary", keyPtr
);
7168 *objPtrPtr
= he
->u
.val
;
7172 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7173 int Jim_DictPairs(Jim_Interp
*interp
, Jim_Obj
*dictPtr
, Jim_Obj
***objPtrPtr
, int *len
)
7175 if (SetDictFromAny(interp
, dictPtr
) != JIM_OK
) {
7178 *objPtrPtr
= JimDictPairs(dictPtr
, len
);
7184 /* Return the value associated to the specified dict keys */
7185 int Jim_DictKeysVector(Jim_Interp
*interp
, Jim_Obj
*dictPtr
,
7186 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
**objPtrPtr
, int flags
)
7191 *objPtrPtr
= dictPtr
;
7195 for (i
= 0; i
< keyc
; i
++) {
7198 int rc
= Jim_DictKey(interp
, dictPtr
, keyv
[i
], &objPtr
, flags
);
7204 *objPtrPtr
= dictPtr
;
7208 /* Modify the dict stored into the variable named 'varNamePtr'
7209 * setting the element specified by the 'keyc' keys objects in 'keyv',
7210 * with the new value of the element 'newObjPtr'.
7212 * If newObjPtr == NULL the operation is to remove the given key
7213 * from the dictionary.
7215 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7216 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7218 int Jim_SetDictKeysVector(Jim_Interp
*interp
, Jim_Obj
*varNamePtr
,
7219 Jim_Obj
*const *keyv
, int keyc
, Jim_Obj
*newObjPtr
, int flags
)
7221 Jim_Obj
*varObjPtr
, *objPtr
, *dictObjPtr
;
7224 varObjPtr
= objPtr
= Jim_GetVariable(interp
, varNamePtr
, flags
);
7225 if (objPtr
== NULL
) {
7226 if (newObjPtr
== NULL
&& (flags
& JIM_MUSTEXIST
)) {
7227 /* Cannot remove a key from non existing var */
7230 varObjPtr
= objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7231 if (Jim_SetVariable(interp
, varNamePtr
, objPtr
) != JIM_OK
) {
7232 Jim_FreeNewObj(interp
, varObjPtr
);
7236 if ((shared
= Jim_IsShared(objPtr
)))
7237 varObjPtr
= objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7238 for (i
= 0; i
< keyc
; i
++) {
7239 dictObjPtr
= objPtr
;
7241 /* Check if it's a valid dictionary */
7242 if (SetDictFromAny(interp
, dictObjPtr
) != JIM_OK
) {
7246 if (i
== keyc
- 1) {
7247 /* Last key: Note that error on unset with missing last key is OK */
7248 if (Jim_DictAddElement(interp
, objPtr
, keyv
[keyc
- 1], newObjPtr
) != JIM_OK
) {
7249 if (newObjPtr
|| (flags
& JIM_MUSTEXIST
)) {
7256 /* Check if the given key exists. */
7257 Jim_InvalidateStringRep(dictObjPtr
);
7258 if (Jim_DictKey(interp
, dictObjPtr
, keyv
[i
], &objPtr
,
7259 newObjPtr
? JIM_NONE
: JIM_ERRMSG
) == JIM_OK
) {
7260 /* This key exists at the current level.
7261 * Make sure it's not shared!. */
7262 if (Jim_IsShared(objPtr
)) {
7263 objPtr
= Jim_DuplicateObj(interp
, objPtr
);
7264 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7268 /* Key not found. If it's an [unset] operation
7269 * this is an error. Only the last key may not
7271 if (newObjPtr
== NULL
) {
7274 /* Otherwise set an empty dictionary
7275 * as key's value. */
7276 objPtr
= Jim_NewDictObj(interp
, NULL
, 0);
7277 DictAddElement(interp
, dictObjPtr
, keyv
[i
], objPtr
);
7280 /* XXX: Is this necessary? */
7281 Jim_InvalidateStringRep(objPtr
);
7282 Jim_InvalidateStringRep(varObjPtr
);
7283 if (Jim_SetVariable(interp
, varNamePtr
, varObjPtr
) != JIM_OK
) {
7286 Jim_SetResult(interp
, varObjPtr
);
7290 Jim_FreeNewObj(interp
, varObjPtr
);
7295 /* -----------------------------------------------------------------------------
7297 * ---------------------------------------------------------------------------*/
7298 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
);
7299 static int SetIndexFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
7301 static const Jim_ObjType indexObjType
= {
7305 UpdateStringOfIndex
,
7309 static void UpdateStringOfIndex(struct Jim_Obj
*objPtr
)
7311 if (objPtr
->internalRep
.intValue
== -1) {
7312 JimSetStringBytes(objPtr
, "end");
7315 char buf
[JIM_INTEGER_SPACE
+ 1];
7316 if (objPtr
->internalRep
.intValue
>= 0) {
7317 sprintf(buf
, "%d", objPtr
->internalRep
.intValue
);
7321 sprintf(buf
, "end%d", objPtr
->internalRep
.intValue
+ 1);
7323 JimSetStringBytes(objPtr
, buf
);
7327 static int SetIndexFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7333 /* Get the string representation */
7334 str
= Jim_String(objPtr
);
7336 /* Try to convert into an index */
7337 if (strncmp(str
, "end", 3) == 0) {
7343 idx
= jim_strtol(str
, &endptr
);
7345 if (endptr
== str
) {
7351 /* Now str may include or +<num> or -<num> */
7352 if (*str
== '+' || *str
== '-') {
7353 int sign
= (*str
== '+' ? 1 : -1);
7355 idx
+= sign
* jim_strtol(++str
, &endptr
);
7356 if (str
== endptr
|| *endptr
) {
7361 /* The only thing left should be spaces */
7362 while (isspace(UCHAR(*str
))) {
7373 /* end-1 is repesented as -2 */
7381 /* Free the old internal repr and set the new one. */
7382 Jim_FreeIntRep(interp
, objPtr
);
7383 objPtr
->typePtr
= &indexObjType
;
7384 objPtr
->internalRep
.intValue
= idx
;
7388 Jim_SetResultFormatted(interp
,
7389 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr
);
7393 int Jim_GetIndex(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *indexPtr
)
7395 /* Avoid shimmering if the object is an integer. */
7396 if (objPtr
->typePtr
== &intObjType
) {
7397 jim_wide val
= JimWideValue(objPtr
);
7400 *indexPtr
= -INT_MAX
;
7401 else if (val
> INT_MAX
)
7402 *indexPtr
= INT_MAX
;
7404 *indexPtr
= (int)val
;
7407 if (objPtr
->typePtr
!= &indexObjType
&& SetIndexFromAny(interp
, objPtr
) == JIM_ERR
)
7409 *indexPtr
= objPtr
->internalRep
.intValue
;
7413 /* -----------------------------------------------------------------------------
7414 * Return Code Object.
7415 * ---------------------------------------------------------------------------*/
7417 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7418 static const char * const jimReturnCodes
[] = {
7430 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7432 static const Jim_ObjType returnCodeObjType
= {
7440 /* Converts a (standard) return code to a string. Returns "?" for
7441 * non-standard return codes.
7443 const char *Jim_ReturnCode(int code
)
7445 if (code
< 0 || code
>= (int)jimReturnCodesSize
) {
7449 return jimReturnCodes
[code
];
7453 static int SetReturnCodeFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
7458 /* Try to convert into an integer */
7459 if (JimGetWideNoErr(interp
, objPtr
, &wideValue
) != JIM_ERR
)
7460 returnCode
= (int)wideValue
;
7461 else if (Jim_GetEnum(interp
, objPtr
, jimReturnCodes
, &returnCode
, NULL
, JIM_NONE
) != JIM_OK
) {
7462 Jim_SetResultFormatted(interp
, "expected return code but got \"%#s\"", objPtr
);
7465 /* Free the old internal repr and set the new one. */
7466 Jim_FreeIntRep(interp
, objPtr
);
7467 objPtr
->typePtr
= &returnCodeObjType
;
7468 objPtr
->internalRep
.intValue
= returnCode
;
7472 int Jim_GetReturnCode(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int *intPtr
)
7474 if (objPtr
->typePtr
!= &returnCodeObjType
&& SetReturnCodeFromAny(interp
, objPtr
) == JIM_ERR
)
7476 *intPtr
= objPtr
->internalRep
.intValue
;
7480 /* -----------------------------------------------------------------------------
7481 * Expression Parsing
7482 * ---------------------------------------------------------------------------*/
7483 static int JimParseExprOperator(struct JimParserCtx
*pc
);
7484 static int JimParseExprNumber(struct JimParserCtx
*pc
);
7485 static int JimParseExprIrrational(struct JimParserCtx
*pc
);
7487 /* Exrp's Stack machine operators opcodes. */
7489 /* Binary operators (numbers) */
7492 /* Continues on from the JIM_TT_ space */
7494 JIM_EXPROP_MUL
= JIM_TT_EXPR_OP
, /* 20 */
7509 JIM_EXPROP_BITAND
, /* 35 */
7513 /* Note must keep these together */
7514 JIM_EXPROP_LOGICAND
, /* 38 */
7515 JIM_EXPROP_LOGICAND_LEFT
,
7516 JIM_EXPROP_LOGICAND_RIGHT
,
7519 JIM_EXPROP_LOGICOR
, /* 41 */
7520 JIM_EXPROP_LOGICOR_LEFT
,
7521 JIM_EXPROP_LOGICOR_RIGHT
,
7524 /* Ternary operators */
7525 JIM_EXPROP_TERNARY
, /* 44 */
7526 JIM_EXPROP_TERNARY_LEFT
,
7527 JIM_EXPROP_TERNARY_RIGHT
,
7530 JIM_EXPROP_COLON
, /* 47 */
7531 JIM_EXPROP_COLON_LEFT
,
7532 JIM_EXPROP_COLON_RIGHT
,
7534 JIM_EXPROP_POW
, /* 50 */
7536 /* Binary operators (strings) */
7537 JIM_EXPROP_STREQ
, /* 51 */
7542 /* Unary operators (numbers) */
7543 JIM_EXPROP_NOT
, /* 55 */
7545 JIM_EXPROP_UNARYMINUS
,
7546 JIM_EXPROP_UNARYPLUS
,
7549 JIM_EXPROP_FUNC_FIRST
, /* 59 */
7550 JIM_EXPROP_FUNC_INT
= JIM_EXPROP_FUNC_FIRST
,
7551 JIM_EXPROP_FUNC_ABS
,
7552 JIM_EXPROP_FUNC_DOUBLE
,
7553 JIM_EXPROP_FUNC_ROUND
,
7554 JIM_EXPROP_FUNC_RAND
,
7555 JIM_EXPROP_FUNC_SRAND
,
7557 /* math functions from libm */
7558 JIM_EXPROP_FUNC_SIN
, /* 64 */
7559 JIM_EXPROP_FUNC_COS
,
7560 JIM_EXPROP_FUNC_TAN
,
7561 JIM_EXPROP_FUNC_ASIN
,
7562 JIM_EXPROP_FUNC_ACOS
,
7563 JIM_EXPROP_FUNC_ATAN
,
7564 JIM_EXPROP_FUNC_SINH
,
7565 JIM_EXPROP_FUNC_COSH
,
7566 JIM_EXPROP_FUNC_TANH
,
7567 JIM_EXPROP_FUNC_CEIL
,
7568 JIM_EXPROP_FUNC_FLOOR
,
7569 JIM_EXPROP_FUNC_EXP
,
7570 JIM_EXPROP_FUNC_LOG
,
7571 JIM_EXPROP_FUNC_LOG10
,
7572 JIM_EXPROP_FUNC_SQRT
,
7573 JIM_EXPROP_FUNC_POW
,
7584 /* Operators table */
7585 typedef struct Jim_ExprOperator
7588 int (*funcop
) (Jim_Interp
*interp
, struct JimExprState
* e
);
7589 unsigned char precedence
;
7590 unsigned char arity
;
7592 unsigned char namelen
;
7595 static void ExprPush(struct JimExprState
*e
, Jim_Obj
*obj
)
7597 Jim_IncrRefCount(obj
);
7598 e
->stack
[e
->stacklen
++] = obj
;
7601 static Jim_Obj
*ExprPop(struct JimExprState
*e
)
7603 return e
->stack
[--e
->stacklen
];
7606 static int JimExprOpNumUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7610 Jim_Obj
*A
= ExprPop(e
);
7612 jim_wide wA
, wC
= 0;
7614 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) && JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
) {
7615 switch (e
->opcode
) {
7616 case JIM_EXPROP_FUNC_INT
:
7617 case JIM_EXPROP_FUNC_ROUND
:
7618 case JIM_EXPROP_UNARYPLUS
:
7621 case JIM_EXPROP_FUNC_DOUBLE
:
7625 case JIM_EXPROP_FUNC_ABS
:
7626 wC
= wA
>= 0 ? wA
: -wA
;
7628 case JIM_EXPROP_UNARYMINUS
:
7631 case JIM_EXPROP_NOT
:
7638 else if ((rc
= Jim_GetDouble(interp
, A
, &dA
)) == JIM_OK
) {
7639 switch (e
->opcode
) {
7640 case JIM_EXPROP_FUNC_INT
:
7643 case JIM_EXPROP_FUNC_ROUND
:
7644 wC
= dA
< 0 ? (dA
- 0.5) : (dA
+ 0.5);
7646 case JIM_EXPROP_FUNC_DOUBLE
:
7647 case JIM_EXPROP_UNARYPLUS
:
7651 case JIM_EXPROP_FUNC_ABS
:
7652 dC
= dA
>= 0 ? dA
: -dA
;
7655 case JIM_EXPROP_UNARYMINUS
:
7659 case JIM_EXPROP_NOT
:
7669 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7672 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7676 Jim_DecrRefCount(interp
, A
);
7681 static double JimRandDouble(Jim_Interp
*interp
)
7684 JimRandomBytes(interp
, &x
, sizeof(x
));
7686 return (double)x
/ (unsigned long)~0;
7689 static int JimExprOpIntUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7691 Jim_Obj
*A
= ExprPop(e
);
7694 int rc
= Jim_GetWide(interp
, A
, &wA
);
7696 switch (e
->opcode
) {
7697 case JIM_EXPROP_BITNOT
:
7698 ExprPush(e
, Jim_NewIntObj(interp
, ~wA
));
7700 case JIM_EXPROP_FUNC_SRAND
:
7701 JimPrngSeed(interp
, (unsigned char *)&wA
, sizeof(wA
));
7702 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7709 Jim_DecrRefCount(interp
, A
);
7714 static int JimExprOpNone(Jim_Interp
*interp
, struct JimExprState
*e
)
7716 JimPanic((e
->opcode
!= JIM_EXPROP_FUNC_RAND
, "JimExprOpNone only support rand()"));
7718 ExprPush(e
, Jim_NewDoubleObj(interp
, JimRandDouble(interp
)));
7723 #ifdef JIM_MATH_FUNCTIONS
7724 static int JimExprOpDoubleUnary(Jim_Interp
*interp
, struct JimExprState
*e
)
7727 Jim_Obj
*A
= ExprPop(e
);
7730 rc
= Jim_GetDouble(interp
, A
, &dA
);
7732 switch (e
->opcode
) {
7733 case JIM_EXPROP_FUNC_SIN
:
7736 case JIM_EXPROP_FUNC_COS
:
7739 case JIM_EXPROP_FUNC_TAN
:
7742 case JIM_EXPROP_FUNC_ASIN
:
7745 case JIM_EXPROP_FUNC_ACOS
:
7748 case JIM_EXPROP_FUNC_ATAN
:
7751 case JIM_EXPROP_FUNC_SINH
:
7754 case JIM_EXPROP_FUNC_COSH
:
7757 case JIM_EXPROP_FUNC_TANH
:
7760 case JIM_EXPROP_FUNC_CEIL
:
7763 case JIM_EXPROP_FUNC_FLOOR
:
7766 case JIM_EXPROP_FUNC_EXP
:
7769 case JIM_EXPROP_FUNC_LOG
:
7772 case JIM_EXPROP_FUNC_LOG10
:
7775 case JIM_EXPROP_FUNC_SQRT
:
7781 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
7784 Jim_DecrRefCount(interp
, A
);
7790 /* A binary operation on two ints */
7791 static int JimExprOpIntBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7793 Jim_Obj
*B
= ExprPop(e
);
7794 Jim_Obj
*A
= ExprPop(e
);
7798 if (Jim_GetWide(interp
, A
, &wA
) == JIM_OK
&& Jim_GetWide(interp
, B
, &wB
) == JIM_OK
) {
7803 switch (e
->opcode
) {
7804 case JIM_EXPROP_LSHIFT
:
7807 case JIM_EXPROP_RSHIFT
:
7810 case JIM_EXPROP_BITAND
:
7813 case JIM_EXPROP_BITXOR
:
7816 case JIM_EXPROP_BITOR
:
7819 case JIM_EXPROP_MOD
:
7822 Jim_SetResultString(interp
, "Division by zero", -1);
7829 * This code is tricky: C doesn't guarantee much
7830 * about the quotient or remainder, but Tcl does.
7831 * The remainder always has the same sign as the
7832 * divisor and a smaller absolute value.
7850 case JIM_EXPROP_ROTL
:
7851 case JIM_EXPROP_ROTR
:{
7852 /* uint32_t would be better. But not everyone has inttypes.h? */
7853 unsigned long uA
= (unsigned long)wA
;
7854 unsigned long uB
= (unsigned long)wB
;
7855 const unsigned int S
= sizeof(unsigned long) * 8;
7857 /* Shift left by the word size or more is undefined. */
7860 if (e
->opcode
== JIM_EXPROP_ROTR
) {
7863 wC
= (unsigned long)(uA
<< uB
) | (uA
>> (S
- uB
));
7869 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
7873 Jim_DecrRefCount(interp
, A
);
7874 Jim_DecrRefCount(interp
, B
);
7880 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7881 static int JimExprOpBin(Jim_Interp
*interp
, struct JimExprState
*e
)
7885 double dA
, dB
, dC
= 0;
7886 jim_wide wA
, wB
, wC
= 0;
7888 Jim_Obj
*B
= ExprPop(e
);
7889 Jim_Obj
*A
= ExprPop(e
);
7891 if ((A
->typePtr
!= &doubleObjType
|| A
->bytes
) &&
7892 (B
->typePtr
!= &doubleObjType
|| B
->bytes
) &&
7893 JimGetWideNoErr(interp
, A
, &wA
) == JIM_OK
&& JimGetWideNoErr(interp
, B
, &wB
) == JIM_OK
) {
7897 switch (e
->opcode
) {
7898 case JIM_EXPROP_POW
:
7899 case JIM_EXPROP_FUNC_POW
:
7900 wC
= JimPowWide(wA
, wB
);
7902 case JIM_EXPROP_ADD
:
7905 case JIM_EXPROP_SUB
:
7908 case JIM_EXPROP_MUL
:
7911 case JIM_EXPROP_DIV
:
7913 Jim_SetResultString(interp
, "Division by zero", -1);
7920 * This code is tricky: C doesn't guarantee much
7921 * about the quotient or remainder, but Tcl does.
7922 * The remainder always has the same sign as the
7923 * divisor and a smaller absolute value.
7941 case JIM_EXPROP_LTE
:
7944 case JIM_EXPROP_GTE
:
7947 case JIM_EXPROP_NUMEQ
:
7950 case JIM_EXPROP_NUMNE
:
7957 else if (Jim_GetDouble(interp
, A
, &dA
) == JIM_OK
&& Jim_GetDouble(interp
, B
, &dB
) == JIM_OK
) {
7959 switch (e
->opcode
) {
7960 case JIM_EXPROP_POW
:
7961 case JIM_EXPROP_FUNC_POW
:
7962 #ifdef JIM_MATH_FUNCTIONS
7965 Jim_SetResultString(interp
, "unsupported", -1);
7969 case JIM_EXPROP_ADD
:
7972 case JIM_EXPROP_SUB
:
7975 case JIM_EXPROP_MUL
:
7978 case JIM_EXPROP_DIV
:
7981 dC
= dA
< 0 ? -INFINITY
: INFINITY
;
7983 dC
= (dA
< 0 ? -1.0 : 1.0) * strtod("Inf", NULL
);
7998 case JIM_EXPROP_LTE
:
8002 case JIM_EXPROP_GTE
:
8006 case JIM_EXPROP_NUMEQ
:
8010 case JIM_EXPROP_NUMNE
:
8019 /* Handle the string case */
8021 /* XXX: Could optimise the eq/ne case by checking lengths */
8022 int i
= Jim_StringCompareObj(interp
, A
, B
, 0);
8024 switch (e
->opcode
) {
8031 case JIM_EXPROP_LTE
:
8034 case JIM_EXPROP_GTE
:
8037 case JIM_EXPROP_NUMEQ
:
8040 case JIM_EXPROP_NUMNE
:
8051 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8054 ExprPush(e
, Jim_NewDoubleObj(interp
, dC
));
8058 Jim_DecrRefCount(interp
, A
);
8059 Jim_DecrRefCount(interp
, B
);
8064 static int JimSearchList(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_Obj
*valObj
)
8069 listlen
= Jim_ListLength(interp
, listObjPtr
);
8070 for (i
= 0; i
< listlen
; i
++) {
8071 if (Jim_StringEqObj(Jim_ListGetIndex(interp
, listObjPtr
, i
), valObj
)) {
8078 static int JimExprOpStrBin(Jim_Interp
*interp
, struct JimExprState
*e
)
8080 Jim_Obj
*B
= ExprPop(e
);
8081 Jim_Obj
*A
= ExprPop(e
);
8085 switch (e
->opcode
) {
8086 case JIM_EXPROP_STREQ
:
8087 case JIM_EXPROP_STRNE
:
8088 wC
= Jim_StringEqObj(A
, B
);
8089 if (e
->opcode
== JIM_EXPROP_STRNE
) {
8093 case JIM_EXPROP_STRIN
:
8094 wC
= JimSearchList(interp
, B
, A
);
8096 case JIM_EXPROP_STRNI
:
8097 wC
= !JimSearchList(interp
, B
, A
);
8102 ExprPush(e
, Jim_NewIntObj(interp
, wC
));
8104 Jim_DecrRefCount(interp
, A
);
8105 Jim_DecrRefCount(interp
, B
);
8110 static int ExprBool(Jim_Interp
*interp
, Jim_Obj
*obj
)
8115 if (Jim_GetLong(interp
, obj
, &l
) == JIM_OK
) {
8118 if (Jim_GetDouble(interp
, obj
, &d
) == JIM_OK
) {
8124 static int JimExprOpAndLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8126 Jim_Obj
*skip
= ExprPop(e
);
8127 Jim_Obj
*A
= ExprPop(e
);
8130 switch (ExprBool(interp
, A
)) {
8132 /* false, so skip RHS opcodes with a 0 result */
8133 e
->skip
= JimWideValue(skip
);
8134 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8138 /* true so continue */
8145 Jim_DecrRefCount(interp
, A
);
8146 Jim_DecrRefCount(interp
, skip
);
8151 static int JimExprOpOrLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8153 Jim_Obj
*skip
= ExprPop(e
);
8154 Jim_Obj
*A
= ExprPop(e
);
8157 switch (ExprBool(interp
, A
)) {
8159 /* false, so do nothing */
8163 /* true so skip RHS opcodes with a 1 result */
8164 e
->skip
= JimWideValue(skip
);
8165 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8173 Jim_DecrRefCount(interp
, A
);
8174 Jim_DecrRefCount(interp
, skip
);
8179 static int JimExprOpAndOrRight(Jim_Interp
*interp
, struct JimExprState
*e
)
8181 Jim_Obj
*A
= ExprPop(e
);
8184 switch (ExprBool(interp
, A
)) {
8186 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8190 ExprPush(e
, Jim_NewIntObj(interp
, 1));
8198 Jim_DecrRefCount(interp
, A
);
8203 static int JimExprOpTernaryLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8205 Jim_Obj
*skip
= ExprPop(e
);
8206 Jim_Obj
*A
= ExprPop(e
);
8212 switch (ExprBool(interp
, A
)) {
8214 /* false, skip RHS opcodes */
8215 e
->skip
= JimWideValue(skip
);
8216 /* Push a dummy value */
8217 ExprPush(e
, Jim_NewIntObj(interp
, 0));
8221 /* true so do nothing */
8229 Jim_DecrRefCount(interp
, A
);
8230 Jim_DecrRefCount(interp
, skip
);
8235 static int JimExprOpColonLeft(Jim_Interp
*interp
, struct JimExprState
*e
)
8237 Jim_Obj
*skip
= ExprPop(e
);
8238 Jim_Obj
*B
= ExprPop(e
);
8239 Jim_Obj
*A
= ExprPop(e
);
8241 /* No need to check for A as non-boolean */
8242 if (ExprBool(interp
, A
)) {
8243 /* true, so skip RHS opcodes */
8244 e
->skip
= JimWideValue(skip
);
8245 /* Repush B as the answer */
8249 Jim_DecrRefCount(interp
, skip
);
8250 Jim_DecrRefCount(interp
, A
);
8251 Jim_DecrRefCount(interp
, B
);
8255 static int JimExprOpNull(Jim_Interp
*interp
, struct JimExprState
*e
)
8268 /* name - precedence - arity - opcode
8270 * This array *must* be kept in sync with the JIM_EXPROP enum.
8272 * The following macros pre-compute the string length at compile time.
8274 #define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1}
8275 #define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8277 static const struct Jim_ExprOperator Jim_ExprOperators
[] = {
8278 OPRINIT("*", 110, 2, JimExprOpBin
),
8279 OPRINIT("/", 110, 2, JimExprOpBin
),
8280 OPRINIT("%", 110, 2, JimExprOpIntBin
),
8282 OPRINIT("-", 100, 2, JimExprOpBin
),
8283 OPRINIT("+", 100, 2, JimExprOpBin
),
8285 OPRINIT("<<", 90, 2, JimExprOpIntBin
),
8286 OPRINIT(">>", 90, 2, JimExprOpIntBin
),
8288 OPRINIT("<<<", 90, 2, JimExprOpIntBin
),
8289 OPRINIT(">>>", 90, 2, JimExprOpIntBin
),
8291 OPRINIT("<", 80, 2, JimExprOpBin
),
8292 OPRINIT(">", 80, 2, JimExprOpBin
),
8293 OPRINIT("<=", 80, 2, JimExprOpBin
),
8294 OPRINIT(">=", 80, 2, JimExprOpBin
),
8296 OPRINIT("==", 70, 2, JimExprOpBin
),
8297 OPRINIT("!=", 70, 2, JimExprOpBin
),
8299 OPRINIT("&", 50, 2, JimExprOpIntBin
),
8300 OPRINIT("^", 49, 2, JimExprOpIntBin
),
8301 OPRINIT("|", 48, 2, JimExprOpIntBin
),
8303 OPRINIT_LAZY("&&", 10, 2, NULL
, LAZY_OP
),
8304 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndLeft
, LAZY_LEFT
),
8305 OPRINIT_LAZY(NULL
, 10, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8307 OPRINIT_LAZY("||", 9, 2, NULL
, LAZY_OP
),
8308 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpOrLeft
, LAZY_LEFT
),
8309 OPRINIT_LAZY(NULL
, 9, 2, JimExprOpAndOrRight
, LAZY_RIGHT
),
8311 OPRINIT_LAZY("?", 5, 2, JimExprOpNull
, LAZY_OP
),
8312 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpTernaryLeft
, LAZY_LEFT
),
8313 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8315 OPRINIT_LAZY(":", 5, 2, JimExprOpNull
, LAZY_OP
),
8316 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpColonLeft
, LAZY_LEFT
),
8317 OPRINIT_LAZY(NULL
, 5, 2, JimExprOpNull
, LAZY_RIGHT
),
8319 OPRINIT("**", 250, 2, JimExprOpBin
),
8321 OPRINIT("eq", 60, 2, JimExprOpStrBin
),
8322 OPRINIT("ne", 60, 2, JimExprOpStrBin
),
8324 OPRINIT("in", 55, 2, JimExprOpStrBin
),
8325 OPRINIT("ni", 55, 2, JimExprOpStrBin
),
8327 OPRINIT("!", 150, 1, JimExprOpNumUnary
),
8328 OPRINIT("~", 150, 1, JimExprOpIntUnary
),
8329 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8330 OPRINIT(NULL
, 150, 1, JimExprOpNumUnary
),
8334 OPRINIT("int", 200, 1, JimExprOpNumUnary
),
8335 OPRINIT("abs", 200, 1, JimExprOpNumUnary
),
8336 OPRINIT("double", 200, 1, JimExprOpNumUnary
),
8337 OPRINIT("round", 200, 1, JimExprOpNumUnary
),
8338 OPRINIT("rand", 200, 0, JimExprOpNone
),
8339 OPRINIT("srand", 200, 1, JimExprOpIntUnary
),
8341 #ifdef JIM_MATH_FUNCTIONS
8342 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary
),
8343 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary
),
8344 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary
),
8345 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary
),
8346 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary
),
8347 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary
),
8348 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary
),
8349 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary
),
8350 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary
),
8351 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary
),
8352 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary
),
8353 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary
),
8354 OPRINIT("log", 200, 1, JimExprOpDoubleUnary
),
8355 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary
),
8356 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary
),
8357 OPRINIT("pow", 200, 2, JimExprOpBin
),
8363 #define JIM_EXPR_OPERATORS_NUM \
8364 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8366 static int JimParseExpression(struct JimParserCtx
*pc
)
8368 /* Discard spaces and quoted newline */
8369 while (isspace(UCHAR(*pc
->p
)) || (*(pc
->p
) == '\\' && *(pc
->p
+ 1) == '\n')) {
8370 if (*pc
->p
== '\n') {
8378 pc
->tline
= pc
->linenr
;
8383 pc
->tt
= JIM_TT_EOL
;
8389 pc
->tt
= JIM_TT_SUBEXPR_START
;
8392 pc
->tt
= JIM_TT_SUBEXPR_END
;
8395 pc
->tt
= JIM_TT_SUBEXPR_COMMA
;
8402 return JimParseCmd(pc
);
8404 if (JimParseVar(pc
) == JIM_ERR
)
8405 return JimParseExprOperator(pc
);
8407 /* Don't allow expr sugar in expressions */
8408 if (pc
->tt
== JIM_TT_EXPRSUGAR
) {
8425 return JimParseExprNumber(pc
);
8427 return JimParseQuote(pc
);
8429 return JimParseBrace(pc
);
8435 if (JimParseExprIrrational(pc
) == JIM_ERR
)
8436 return JimParseExprOperator(pc
);
8439 return JimParseExprOperator(pc
);
8445 static int JimParseExprNumber(struct JimParserCtx
*pc
)
8449 /* Assume an integer for now */
8450 pc
->tt
= JIM_TT_EXPR_INT
;
8452 jim_strtoull(pc
->p
, (char **)&pc
->p
);
8453 /* Tried as an integer, but perhaps it parses as a double */
8454 if (strchr("eENnIi.", *pc
->p
) || pc
->p
== pc
->tstart
) {
8455 /* Some stupid compilers insist they are cleverer that
8456 * we are. Even a (void) cast doesn't prevent this warning!
8458 if (strtod(pc
->tstart
, &end
)) { /* nothing */ }
8459 if (end
== pc
->tstart
)
8462 /* Yes, double captured more chars */
8463 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8467 pc
->tend
= pc
->p
- 1;
8468 pc
->len
-= (pc
->p
- pc
->tstart
);
8472 static int JimParseExprIrrational(struct JimParserCtx
*pc
)
8474 const char *irrationals
[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL
};
8477 for (i
= 0; irrationals
[i
]; i
++) {
8478 const char *irr
= irrationals
[i
];
8480 if (strncmp(irr
, pc
->p
, 3) == 0) {
8483 pc
->tend
= pc
->p
- 1;
8484 pc
->tt
= JIM_TT_EXPR_DOUBLE
;
8491 static int JimParseExprOperator(struct JimParserCtx
*pc
)
8494 int bestIdx
= -1, bestLen
= 0;
8496 /* Try to get the longest match. */
8497 for (i
= 0; i
< (signed)JIM_EXPR_OPERATORS_NUM
; i
++) {
8498 const char * const opname
= Jim_ExprOperators
[i
].name
;
8499 const int oplen
= Jim_ExprOperators
[i
].namelen
;
8501 if (opname
== NULL
|| opname
[0] != pc
->p
[0]) {
8505 if (oplen
> bestLen
&& strncmp(opname
, pc
->p
, oplen
) == 0) {
8506 bestIdx
= i
+ JIM_TT_EXPR_OP
;
8510 if (bestIdx
== -1) {
8514 /* Validate paretheses around function arguments */
8515 if (bestIdx
>= JIM_EXPROP_FUNC_FIRST
) {
8516 const char *p
= pc
->p
+ bestLen
;
8517 int len
= pc
->len
- bestLen
;
8519 while (len
&& isspace(UCHAR(*p
))) {
8527 pc
->tend
= pc
->p
+ bestLen
- 1;
8535 static const struct Jim_ExprOperator
*JimExprOperatorInfoByOpcode(int opcode
)
8537 static Jim_ExprOperator dummy_op
;
8538 if (opcode
< JIM_TT_EXPR_OP
) {
8541 return &Jim_ExprOperators
[opcode
- JIM_TT_EXPR_OP
];
8544 const char *jim_tt_name(int type
)
8546 static const char * const tt_names
[JIM_TT_EXPR_OP
] =
8547 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8549 if (type
< JIM_TT_EXPR_OP
) {
8550 return tt_names
[type
];
8553 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(type
);
8554 static char buf
[20];
8559 sprintf(buf
, "(%d)", type
);
8564 /* -----------------------------------------------------------------------------
8566 * ---------------------------------------------------------------------------*/
8567 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
8568 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
8569 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
);
8571 static const Jim_ObjType exprObjType
= {
8573 FreeExprInternalRep
,
8576 JIM_TYPE_REFERENCES
,
8579 /* Expr bytecode structure */
8580 typedef struct ExprByteCode
8582 ScriptToken
*token
; /* Tokens array. */
8583 int len
; /* Length as number of tokens. */
8584 int inUse
; /* Used for sharing. */
8587 static void ExprFreeByteCode(Jim_Interp
*interp
, ExprByteCode
* expr
)
8591 for (i
= 0; i
< expr
->len
; i
++) {
8592 Jim_DecrRefCount(interp
, expr
->token
[i
].objPtr
);
8594 Jim_Free(expr
->token
);
8598 static void FreeExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
8600 ExprByteCode
*expr
= (void *)objPtr
->internalRep
.ptr
;
8603 if (--expr
->inUse
!= 0) {
8607 ExprFreeByteCode(interp
, expr
);
8611 static void DupExprInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
8613 JIM_NOTUSED(interp
);
8614 JIM_NOTUSED(srcPtr
);
8616 /* Just returns an simple string. */
8617 dupPtr
->typePtr
= NULL
;
8620 /* Check if an expr program looks correct. */
8621 static int ExprCheckCorrectness(ExprByteCode
* expr
)
8627 /* Try to check if there are stack underflows,
8628 * and make sure at the end of the program there is
8629 * a single result on the stack. */
8630 for (i
= 0; i
< expr
->len
; i
++) {
8631 ScriptToken
*t
= &expr
->token
[i
];
8632 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8634 stacklen
-= op
->arity
;
8638 if (t
->type
== JIM_EXPROP_TERNARY
|| t
->type
== JIM_EXPROP_TERNARY_LEFT
) {
8641 else if (t
->type
== JIM_EXPROP_COLON
|| t
->type
== JIM_EXPROP_COLON_LEFT
) {
8645 /* All operations and operands add one to the stack */
8648 if (stacklen
!= 1 || ternary
!= 0) {
8654 /* This procedure converts every occurrence of || and && opereators
8655 * in lazy unary versions.
8657 * a b || is converted into:
8659 * a <offset> |L b |R
8661 * a b && is converted into:
8663 * a <offset> &L b &R
8665 * "|L" checks if 'a' is true:
8666 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8667 * the opcode just after |R.
8668 * 2) if it is false does nothing.
8669 * "|R" checks if 'b' is true:
8670 * 1) if it is true pushes 1, otherwise pushes 0.
8672 * "&L" checks if 'a' is true:
8673 * 1) if it is true does nothing.
8674 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8675 * the opcode just after &R
8676 * "&R" checks if 'a' is true:
8677 * if it is true pushes 1, otherwise pushes 0.
8679 static int ExprAddLazyOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8683 int leftindex
, arity
, offset
;
8685 /* Search for the end of the first operator */
8686 leftindex
= expr
->len
- 1;
8690 ScriptToken
*tt
= &expr
->token
[leftindex
];
8692 if (tt
->type
>= JIM_TT_EXPR_OP
) {
8693 arity
+= JimExprOperatorInfoByOpcode(tt
->type
)->arity
;
8696 if (--leftindex
< 0) {
8703 memmove(&expr
->token
[leftindex
+ 2], &expr
->token
[leftindex
],
8704 sizeof(*expr
->token
) * (expr
->len
- leftindex
));
8706 offset
= (expr
->len
- leftindex
) - 1;
8708 /* Now we rely on the fact the the left and right version have opcodes
8709 * 1 and 2 after the main opcode respectively
8711 expr
->token
[leftindex
+ 1].type
= t
->type
+ 1;
8712 expr
->token
[leftindex
+ 1].objPtr
= interp
->emptyObj
;
8714 expr
->token
[leftindex
].type
= JIM_TT_EXPR_INT
;
8715 expr
->token
[leftindex
].objPtr
= Jim_NewIntObj(interp
, offset
);
8717 /* Now add the 'R' operator */
8718 expr
->token
[expr
->len
].objPtr
= interp
->emptyObj
;
8719 expr
->token
[expr
->len
].type
= t
->type
+ 2;
8722 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8723 for (i
= leftindex
- 1; i
> 0; i
--) {
8724 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
8725 if (op
->lazy
== LAZY_LEFT
) {
8726 if (JimWideValue(expr
->token
[i
- 1].objPtr
) + i
- 1 >= leftindex
) {
8727 JimWideValue(expr
->token
[i
- 1].objPtr
) += 2;
8734 static int ExprAddOperator(Jim_Interp
*interp
, ExprByteCode
* expr
, ParseToken
*t
)
8736 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8737 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8739 if (op
->lazy
== LAZY_OP
) {
8740 if (ExprAddLazyOperator(interp
, expr
, t
) != JIM_OK
) {
8741 Jim_SetResultFormatted(interp
, "Expression has bad operands to %s", op
->name
);
8746 token
->objPtr
= interp
->emptyObj
;
8747 token
->type
= t
->type
;
8754 * Returns the index of the COLON_LEFT to the left of 'right_index'
8755 * taking into account nesting.
8757 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8759 static int ExprTernaryGetColonLeftIndex(ExprByteCode
*expr
, int right_index
)
8761 int ternary_count
= 1;
8765 while (right_index
> 1) {
8766 if (expr
->token
[right_index
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8769 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_RIGHT
) {
8772 else if (expr
->token
[right_index
].type
== JIM_EXPROP_COLON_LEFT
&& ternary_count
== 1) {
8783 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8785 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8786 * Otherwise returns 0.
8788 static int ExprTernaryGetMoveIndices(ExprByteCode
*expr
, int right_index
, int *prev_right_index
, int *prev_left_index
)
8790 int i
= right_index
- 1;
8791 int ternary_count
= 1;
8794 if (expr
->token
[i
].type
== JIM_EXPROP_TERNARY_LEFT
) {
8795 if (--ternary_count
== 0 && expr
->token
[i
- 2].type
== JIM_EXPROP_COLON_RIGHT
) {
8796 *prev_right_index
= i
- 2;
8797 *prev_left_index
= ExprTernaryGetColonLeftIndex(expr
, *prev_right_index
);
8801 else if (expr
->token
[i
].type
== JIM_EXPROP_COLON_RIGHT
) {
8802 if (ternary_count
== 0) {
8813 * ExprTernaryReorderExpression description
8814 * ========================================
8816 * ?: is right-to-left associative which doesn't work with the stack-based
8817 * expression engine. The fix is to reorder the bytecode.
8823 * Has initial bytecode:
8825 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8826 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8828 * The fix involves simulating this expression instead:
8832 * With the following bytecode:
8834 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8835 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8837 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8838 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8839 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8840 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8842 * ExprTernaryReorderExpression works thus as follows :
8843 * - start from the end of the stack
8844 * - while walking towards the beginning of the stack
8845 * if token=JIM_EXPROP_COLON_RIGHT then
8846 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8847 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8848 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8850 * perform the rotation
8851 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8855 * Note: care has to be taken for nested ternary constructs!!!
8857 static void ExprTernaryReorderExpression(Jim_Interp
*interp
, ExprByteCode
*expr
)
8861 for (i
= expr
->len
- 1; i
> 1; i
--) {
8862 int prev_right_index
;
8863 int prev_left_index
;
8867 if (expr
->token
[i
].type
!= JIM_EXPROP_COLON_RIGHT
) {
8871 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8872 if (ExprTernaryGetMoveIndices(expr
, i
, &prev_right_index
, &prev_left_index
) == 0) {
8877 ** rotate tokens down
8879 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8888 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8890 tmp
= expr
->token
[prev_right_index
];
8891 for (j
= prev_right_index
; j
< i
; j
++) {
8892 expr
->token
[j
] = expr
->token
[j
+ 1];
8894 expr
->token
[i
] = tmp
;
8896 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8898 * This is 'colon left increment' = i - prev_right_index
8900 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8901 * [prev_left_index-1] : skip_count
8904 JimWideValue(expr
->token
[prev_left_index
-1].objPtr
) += (i
- prev_right_index
);
8906 /* Adjust for i-- in the loop */
8911 static ExprByteCode
*ExprCreateByteCode(Jim_Interp
*interp
, const ParseTokenList
*tokenlist
, Jim_Obj
*fileNameObj
)
8917 int prevtt
= JIM_TT_NONE
;
8918 int have_ternary
= 0;
8921 int count
= tokenlist
->count
- 1;
8923 expr
= Jim_Alloc(sizeof(*expr
));
8927 Jim_InitStack(&stack
);
8929 /* Need extra bytecodes for lazy operators.
8930 * Also check for the ternary operator
8932 for (i
= 0; i
< tokenlist
->count
; i
++) {
8933 ParseToken
*t
= &tokenlist
->list
[i
];
8934 const struct Jim_ExprOperator
*op
= JimExprOperatorInfoByOpcode(t
->type
);
8936 if (op
->lazy
== LAZY_OP
) {
8938 /* Ternary is a lazy op but also needs reordering */
8939 if (t
->type
== JIM_EXPROP_TERNARY
) {
8945 expr
->token
= Jim_Alloc(sizeof(ScriptToken
) * count
);
8947 for (i
= 0; i
< tokenlist
->count
&& ok
; i
++) {
8948 ParseToken
*t
= &tokenlist
->list
[i
];
8950 /* Next token will be stored here */
8951 struct ScriptToken
*token
= &expr
->token
[expr
->len
];
8953 if (t
->type
== JIM_TT_EOL
) {
8961 case JIM_TT_DICTSUGAR
:
8962 case JIM_TT_EXPRSUGAR
:
8964 token
->type
= t
->type
;
8966 token
->objPtr
= Jim_NewStringObj(interp
, t
->token
, t
->len
);
8967 if (t
->type
== JIM_TT_CMD
) {
8968 /* Only commands need source info */
8969 JimSetSourceInfo(interp
, token
->objPtr
, fileNameObj
, t
->line
);
8974 case JIM_TT_EXPR_INT
:
8975 case JIM_TT_EXPR_DOUBLE
:
8978 if (t
->type
== JIM_TT_EXPR_INT
) {
8979 token
->objPtr
= Jim_NewIntObj(interp
, jim_strtoull(t
->token
, &endptr
));
8982 token
->objPtr
= Jim_NewDoubleObj(interp
, strtod(t
->token
, &endptr
));
8984 if (endptr
!= t
->token
+ t
->len
) {
8985 /* Conversion failed, so just store it as a string */
8986 Jim_FreeNewObj(interp
, token
->objPtr
);
8987 token
->type
= JIM_TT_STR
;
8990 token
->type
= t
->type
;
8995 case JIM_TT_SUBEXPR_START
:
8996 Jim_StackPush(&stack
, t
);
8997 prevtt
= JIM_TT_NONE
;
9000 case JIM_TT_SUBEXPR_COMMA
:
9001 /* Simple approach. Comma is simply ignored */
9004 case JIM_TT_SUBEXPR_END
:
9006 while (Jim_StackLen(&stack
)) {
9007 ParseToken
*tt
= Jim_StackPop(&stack
);
9009 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9014 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9019 Jim_SetResultString(interp
, "Unexpected close parenthesis", -1);
9026 /* Must be an operator */
9027 const struct Jim_ExprOperator
*op
;
9030 /* Convert -/+ to unary minus or unary plus if necessary */
9031 if (prevtt
== JIM_TT_NONE
|| prevtt
>= JIM_TT_EXPR_OP
) {
9032 if (t
->type
== JIM_EXPROP_SUB
) {
9033 t
->type
= JIM_EXPROP_UNARYMINUS
;
9035 else if (t
->type
== JIM_EXPROP_ADD
) {
9036 t
->type
= JIM_EXPROP_UNARYPLUS
;
9040 op
= JimExprOperatorInfoByOpcode(t
->type
);
9042 /* Now handle precedence */
9043 while ((tt
= Jim_StackPeek(&stack
)) != NULL
) {
9044 const struct Jim_ExprOperator
*tt_op
=
9045 JimExprOperatorInfoByOpcode(tt
->type
);
9047 /* Note that right-to-left associativity of ?: operator is handled later */
9049 if (op
->arity
!= 1 && tt_op
->precedence
>= op
->precedence
) {
9050 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9054 Jim_StackPop(&stack
);
9060 Jim_StackPush(&stack
, t
);
9067 /* Reduce any remaining subexpr */
9068 while (Jim_StackLen(&stack
)) {
9069 ParseToken
*tt
= Jim_StackPop(&stack
);
9071 if (tt
->type
== JIM_TT_SUBEXPR_START
) {
9073 Jim_SetResultString(interp
, "Missing close parenthesis", -1);
9076 if (ExprAddOperator(interp
, expr
, tt
) != JIM_OK
) {
9083 ExprTernaryReorderExpression(interp
, expr
);
9087 /* Free the stack used for the compilation. */
9088 Jim_FreeStack(&stack
);
9090 for (i
= 0; i
< expr
->len
; i
++) {
9091 Jim_IncrRefCount(expr
->token
[i
].objPtr
);
9095 ExprFreeByteCode(interp
, expr
);
9103 /* This method takes the string representation of an expression
9104 * and generates a program for the Expr's stack-based VM. */
9105 static int SetExprFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
)
9108 const char *exprText
;
9109 struct JimParserCtx parser
;
9110 struct ExprByteCode
*expr
;
9111 ParseTokenList tokenlist
;
9113 Jim_Obj
*fileNameObj
;
9116 /* Try to get information about filename / line number */
9117 if (objPtr
->typePtr
== &sourceObjType
) {
9118 fileNameObj
= objPtr
->internalRep
.sourceValue
.fileNameObj
;
9119 line
= objPtr
->internalRep
.sourceValue
.lineNumber
;
9122 fileNameObj
= interp
->emptyObj
;
9125 Jim_IncrRefCount(fileNameObj
);
9127 exprText
= Jim_GetString(objPtr
, &exprTextLen
);
9129 /* Initially tokenise the expression into tokenlist */
9130 ScriptTokenListInit(&tokenlist
);
9132 JimParserInit(&parser
, exprText
, exprTextLen
, line
);
9133 while (!parser
.eof
) {
9134 if (JimParseExpression(&parser
) != JIM_OK
) {
9135 ScriptTokenListFree(&tokenlist
);
9137 Jim_SetResultFormatted(interp
, "syntax error in expression: \"%#s\"", objPtr
);
9142 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
9146 #ifdef DEBUG_SHOW_EXPR_TOKENS
9149 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj
));
9150 for (i
= 0; i
< tokenlist
.count
; i
++) {
9151 printf("[%2d]@%d %s '%.*s'\n", i
, tokenlist
.list
[i
].line
, jim_tt_name(tokenlist
.list
[i
].type
),
9152 tokenlist
.list
[i
].len
, tokenlist
.list
[i
].token
);
9157 if (JimParseCheckMissing(interp
, parser
.missing
.ch
) == JIM_ERR
) {
9158 ScriptTokenListFree(&tokenlist
);
9159 Jim_DecrRefCount(interp
, fileNameObj
);
9163 /* Now create the expression bytecode from the tokenlist */
9164 expr
= ExprCreateByteCode(interp
, &tokenlist
, fileNameObj
);
9166 /* No longer need the token list */
9167 ScriptTokenListFree(&tokenlist
);
9173 #ifdef DEBUG_SHOW_EXPR
9177 printf("==== Expr ====\n");
9178 for (i
= 0; i
< expr
->len
; i
++) {
9179 ScriptToken
*t
= &expr
->token
[i
];
9181 printf("[%2d] %s '%s'\n", i
, jim_tt_name(t
->type
), Jim_String(t
->objPtr
));
9186 /* Check program correctness. */
9187 if (ExprCheckCorrectness(expr
) != JIM_OK
) {
9188 ExprFreeByteCode(interp
, expr
);
9195 /* Free the old internal rep and set the new one. */
9196 Jim_DecrRefCount(interp
, fileNameObj
);
9197 Jim_FreeIntRep(interp
, objPtr
);
9198 Jim_SetIntRepPtr(objPtr
, expr
);
9199 objPtr
->typePtr
= &exprObjType
;
9203 static ExprByteCode
*JimGetExpression(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9205 if (objPtr
->typePtr
!= &exprObjType
) {
9206 if (SetExprFromAny(interp
, objPtr
) != JIM_OK
) {
9210 return (ExprByteCode
*) Jim_GetIntRepPtr(objPtr
);
9213 #ifdef JIM_OPTIMIZATION
9214 static Jim_Obj
*JimExprIntValOrVar(Jim_Interp
*interp
, const ScriptToken
*token
)
9216 if (token
->type
== JIM_TT_EXPR_INT
)
9217 return token
->objPtr
;
9218 else if (token
->type
== JIM_TT_VAR
)
9219 return Jim_GetVariable(interp
, token
->objPtr
, JIM_NONE
);
9220 else if (token
->type
== JIM_TT_DICTSUGAR
)
9221 return JimExpandDictSugar(interp
, token
->objPtr
);
9227 /* -----------------------------------------------------------------------------
9228 * Expressions evaluation.
9229 * Jim uses a specialized stack-based virtual machine for expressions,
9230 * that takes advantage of the fact that expr's operators
9231 * can't be redefined.
9233 * Jim_EvalExpression() uses the bytecode compiled by
9234 * SetExprFromAny() method of the "expression" object.
9236 * On success a Tcl Object containing the result of the evaluation
9237 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9239 * On error the function returns a retcode != to JIM_OK and set a suitable
9240 * error on the interp.
9241 * ---------------------------------------------------------------------------*/
9242 #define JIM_EE_STATICSTACK_LEN 10
9244 int Jim_EvalExpression(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, Jim_Obj
**exprResultPtrPtr
)
9247 Jim_Obj
*staticStack
[JIM_EE_STATICSTACK_LEN
];
9249 int retcode
= JIM_OK
;
9250 struct JimExprState e
;
9252 expr
= JimGetExpression(interp
, exprObjPtr
);
9254 return JIM_ERR
; /* error in expression. */
9257 #ifdef JIM_OPTIMIZATION
9258 /* Check for one of the following common expressions used by while/for
9263 * $a < CONST, $a < $b
9264 * $a <= CONST, $a <= $b
9265 * $a > CONST, $a > $b
9266 * $a >= CONST, $a >= $b
9267 * $a != CONST, $a != $b
9268 * $a == CONST, $a == $b
9273 /* STEP 1 -- Check if there are the conditions to run the specialized
9274 * version of while */
9276 switch (expr
->len
) {
9278 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9280 Jim_IncrRefCount(objPtr
);
9281 *exprResultPtrPtr
= objPtr
;
9287 if (expr
->token
[1].type
== JIM_EXPROP_NOT
) {
9288 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9290 if (objPtr
&& JimIsWide(objPtr
)) {
9291 *exprResultPtrPtr
= JimWideValue(objPtr
) ? interp
->falseObj
: interp
->trueObj
;
9292 Jim_IncrRefCount(*exprResultPtrPtr
);
9299 objPtr
= JimExprIntValOrVar(interp
, &expr
->token
[0]);
9300 if (objPtr
&& JimIsWide(objPtr
)) {
9301 Jim_Obj
*objPtr2
= JimExprIntValOrVar(interp
, &expr
->token
[1]);
9302 if (objPtr2
&& JimIsWide(objPtr2
)) {
9303 jim_wide wideValueA
= JimWideValue(objPtr
);
9304 jim_wide wideValueB
= JimWideValue(objPtr2
);
9306 switch (expr
->token
[2].type
) {
9308 cmpRes
= wideValueA
< wideValueB
;
9310 case JIM_EXPROP_LTE
:
9311 cmpRes
= wideValueA
<= wideValueB
;
9314 cmpRes
= wideValueA
> wideValueB
;
9316 case JIM_EXPROP_GTE
:
9317 cmpRes
= wideValueA
>= wideValueB
;
9319 case JIM_EXPROP_NUMEQ
:
9320 cmpRes
= wideValueA
== wideValueB
;
9322 case JIM_EXPROP_NUMNE
:
9323 cmpRes
= wideValueA
!= wideValueB
;
9328 *exprResultPtrPtr
= cmpRes
? interp
->trueObj
: interp
->falseObj
;
9329 Jim_IncrRefCount(*exprResultPtrPtr
);
9339 /* In order to avoid that the internal repr gets freed due to
9340 * shimmering of the exprObjPtr's object, we make the internal rep
9344 /* The stack-based expr VM itself */
9346 /* Stack allocation. Expr programs have the feature that
9347 * a program of length N can't require a stack longer than
9349 if (expr
->len
> JIM_EE_STATICSTACK_LEN
)
9350 e
.stack
= Jim_Alloc(sizeof(Jim_Obj
*) * expr
->len
);
9352 e
.stack
= staticStack
;
9356 /* Execute every instruction */
9357 for (i
= 0; i
< expr
->len
&& retcode
== JIM_OK
; i
++) {
9360 switch (expr
->token
[i
].type
) {
9361 case JIM_TT_EXPR_INT
:
9362 case JIM_TT_EXPR_DOUBLE
:
9364 ExprPush(&e
, expr
->token
[i
].objPtr
);
9368 objPtr
= Jim_GetVariable(interp
, expr
->token
[i
].objPtr
, JIM_ERRMSG
);
9370 ExprPush(&e
, objPtr
);
9377 case JIM_TT_DICTSUGAR
:
9378 objPtr
= JimExpandDictSugar(interp
, expr
->token
[i
].objPtr
);
9380 ExprPush(&e
, objPtr
);
9388 retcode
= Jim_SubstObj(interp
, expr
->token
[i
].objPtr
, &objPtr
, JIM_NONE
);
9389 if (retcode
== JIM_OK
) {
9390 ExprPush(&e
, objPtr
);
9395 retcode
= Jim_EvalObj(interp
, expr
->token
[i
].objPtr
);
9396 if (retcode
== JIM_OK
) {
9397 ExprPush(&e
, Jim_GetResult(interp
));
9402 /* Find and execute the operation */
9404 e
.opcode
= expr
->token
[i
].type
;
9406 retcode
= JimExprOperatorInfoByOpcode(e
.opcode
)->funcop(interp
, &e
);
9407 /* Skip some opcodes if necessary */
9416 if (retcode
== JIM_OK
) {
9417 *exprResultPtrPtr
= ExprPop(&e
);
9420 for (i
= 0; i
< e
.stacklen
; i
++) {
9421 Jim_DecrRefCount(interp
, e
.stack
[i
]);
9424 if (e
.stack
!= staticStack
) {
9430 int Jim_GetBoolFromExpr(Jim_Interp
*interp
, Jim_Obj
*exprObjPtr
, int *boolPtr
)
9435 Jim_Obj
*exprResultPtr
;
9437 retcode
= Jim_EvalExpression(interp
, exprObjPtr
, &exprResultPtr
);
9438 if (retcode
!= JIM_OK
)
9441 if (JimGetWideNoErr(interp
, exprResultPtr
, &wideValue
) != JIM_OK
) {
9442 if (Jim_GetDouble(interp
, exprResultPtr
, &doubleValue
) != JIM_OK
) {
9443 Jim_DecrRefCount(interp
, exprResultPtr
);
9447 Jim_DecrRefCount(interp
, exprResultPtr
);
9448 *boolPtr
= doubleValue
!= 0;
9452 *boolPtr
= wideValue
!= 0;
9454 Jim_DecrRefCount(interp
, exprResultPtr
);
9458 /* -----------------------------------------------------------------------------
9459 * ScanFormat String Object
9460 * ---------------------------------------------------------------------------*/
9462 /* This Jim_Obj will held a parsed representation of a format string passed to
9463 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9464 * to be parsed in its entirely first and then, if correct, can be used for
9465 * scanning. To avoid endless re-parsing, the parsed representation will be
9466 * stored in an internal representation and re-used for performance reason. */
9468 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9469 * scanformat string. This part will later be used to extract information
9470 * out from the string to be parsed by Jim_ScanString */
9472 typedef struct ScanFmtPartDescr
9474 char *arg
; /* Specification of a CHARSET conversion */
9475 char *prefix
; /* Prefix to be scanned literally before conversion */
9476 size_t width
; /* Maximal width of input to be converted */
9477 int pos
; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9478 char type
; /* Type of conversion (e.g. c, d, f) */
9479 char modifier
; /* Modify type (e.g. l - long, h - short */
9482 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9483 * string parsed and separated in part descriptions. Furthermore it contains
9484 * the original string representation of the scanformat string to allow for
9485 * fast update of the Jim_Obj's string representation part.
9487 * As an add-on the internal object representation adds some scratch pad area
9488 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9489 * memory for purpose of string scanning.
9491 * The error member points to a static allocated string in case of a mal-
9492 * formed scanformat string or it contains '0' (NULL) in case of a valid
9493 * parse representation.
9495 * The whole memory of the internal representation is allocated as a single
9496 * area of memory that will be internally separated. So freeing and duplicating
9497 * of such an object is cheap */
9499 typedef struct ScanFmtStringObj
9501 jim_wide size
; /* Size of internal repr in bytes */
9502 char *stringRep
; /* Original string representation */
9503 size_t count
; /* Number of ScanFmtPartDescr contained */
9504 size_t convCount
; /* Number of conversions that will assign */
9505 size_t maxPos
; /* Max position index if XPG3 is used */
9506 const char *error
; /* Ptr to error text (NULL if no error */
9507 char *scratch
; /* Some scratch pad used by Jim_ScanString */
9508 ScanFmtPartDescr descr
[1]; /* The vector of partial descriptions */
9512 static void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
);
9513 static void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
);
9514 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
);
9516 static const Jim_ObjType scanFmtStringObjType
= {
9518 FreeScanFmtInternalRep
,
9519 DupScanFmtInternalRep
,
9520 UpdateStringOfScanFmt
,
9524 void FreeScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9526 JIM_NOTUSED(interp
);
9527 Jim_Free((char *)objPtr
->internalRep
.ptr
);
9528 objPtr
->internalRep
.ptr
= 0;
9531 void DupScanFmtInternalRep(Jim_Interp
*interp
, Jim_Obj
*srcPtr
, Jim_Obj
*dupPtr
)
9533 size_t size
= (size_t) ((ScanFmtStringObj
*) srcPtr
->internalRep
.ptr
)->size
;
9534 ScanFmtStringObj
*newVec
= (ScanFmtStringObj
*) Jim_Alloc(size
);
9536 JIM_NOTUSED(interp
);
9537 memcpy(newVec
, srcPtr
->internalRep
.ptr
, size
);
9538 dupPtr
->internalRep
.ptr
= newVec
;
9539 dupPtr
->typePtr
= &scanFmtStringObjType
;
9542 static void UpdateStringOfScanFmt(Jim_Obj
*objPtr
)
9544 JimSetStringBytes(objPtr
, ((ScanFmtStringObj
*) objPtr
->internalRep
.ptr
)->stringRep
);
9547 /* SetScanFmtFromAny will parse a given string and create the internal
9548 * representation of the format specification. In case of an error
9549 * the error data member of the internal representation will be set
9550 * to an descriptive error text and the function will be left with
9551 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9554 static int SetScanFmtFromAny(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
9556 ScanFmtStringObj
*fmtObj
;
9558 int maxCount
, i
, approxSize
, lastPos
= -1;
9559 const char *fmt
= objPtr
->bytes
;
9560 int maxFmtLen
= objPtr
->length
;
9561 const char *fmtEnd
= fmt
+ maxFmtLen
;
9564 Jim_FreeIntRep(interp
, objPtr
);
9565 /* Count how many conversions could take place maximally */
9566 for (i
= 0, maxCount
= 0; i
< maxFmtLen
; ++i
)
9569 /* Calculate an approximation of the memory necessary */
9570 approxSize
= sizeof(ScanFmtStringObj
) /* Size of the container */
9571 +(maxCount
+ 1) * sizeof(ScanFmtPartDescr
) /* Size of all partials */
9572 +maxFmtLen
* sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9573 + maxFmtLen
* sizeof(char) + 1 /* Original stringrep */
9574 + maxFmtLen
* sizeof(char) /* Arg for CHARSETs */
9575 +(maxCount
+ 1) * sizeof(char) /* '\0' for every partial */
9576 +1; /* safety byte */
9577 fmtObj
= (ScanFmtStringObj
*) Jim_Alloc(approxSize
);
9578 memset(fmtObj
, 0, approxSize
);
9579 fmtObj
->size
= approxSize
;
9581 fmtObj
->scratch
= (char *)&fmtObj
->descr
[maxCount
+ 1];
9582 fmtObj
->stringRep
= fmtObj
->scratch
+ maxFmtLen
+ 3 + 1;
9583 memcpy(fmtObj
->stringRep
, fmt
, maxFmtLen
);
9584 buffer
= fmtObj
->stringRep
+ maxFmtLen
+ 1;
9585 objPtr
->internalRep
.ptr
= fmtObj
;
9586 objPtr
->typePtr
= &scanFmtStringObjType
;
9587 for (i
= 0, curr
= 0; fmt
< fmtEnd
; ++fmt
) {
9588 int width
= 0, skip
;
9589 ScanFmtPartDescr
*descr
= &fmtObj
->descr
[curr
];
9592 descr
->width
= 0; /* Assume width unspecified */
9593 /* Overread and store any "literal" prefix */
9594 if (*fmt
!= '%' || fmt
[1] == '%') {
9596 descr
->prefix
= &buffer
[i
];
9597 for (; fmt
< fmtEnd
; ++fmt
) {
9607 /* Skip the conversion introducing '%' sign */
9609 /* End reached due to non-conversion literal only? */
9612 descr
->pos
= 0; /* Assume "natural" positioning */
9614 descr
->pos
= -1; /* Okay, conversion will not be assigned */
9618 fmtObj
->convCount
++; /* Otherwise count as assign-conversion */
9619 /* Check if next token is a number (could be width or pos */
9620 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9622 /* Was the number a XPG3 position specifier? */
9623 if (descr
->pos
!= -1 && *fmt
== '$') {
9629 /* Look if "natural" postioning and XPG3 one was mixed */
9630 if ((lastPos
== 0 && descr
->pos
> 0)
9631 || (lastPos
> 0 && descr
->pos
== 0)) {
9632 fmtObj
->error
= "cannot mix \"%\" and \"%n$\" conversion specifiers";
9635 /* Look if this position was already used */
9636 for (prev
= 0; prev
< curr
; ++prev
) {
9637 if (fmtObj
->descr
[prev
].pos
== -1)
9639 if (fmtObj
->descr
[prev
].pos
== descr
->pos
) {
9641 "variable is assigned by multiple \"%n$\" conversion specifiers";
9645 /* Try to find a width after the XPG3 specifier */
9646 if (sscanf(fmt
, "%d%n", &width
, &skip
) == 1) {
9647 descr
->width
= width
;
9650 if (descr
->pos
> 0 && (size_t) descr
->pos
> fmtObj
->maxPos
)
9651 fmtObj
->maxPos
= descr
->pos
;
9654 /* Number was not a XPG3, so it has to be a width */
9655 descr
->width
= width
;
9658 /* If positioning mode was undetermined yet, fix this */
9660 lastPos
= descr
->pos
;
9661 /* Handle CHARSET conversion type ... */
9663 int swapped
= 1, beg
= i
, end
, j
;
9666 descr
->arg
= &buffer
[i
];
9669 buffer
[i
++] = *fmt
++;
9671 buffer
[i
++] = *fmt
++;
9672 while (*fmt
&& *fmt
!= ']')
9673 buffer
[i
++] = *fmt
++;
9675 fmtObj
->error
= "unmatched [ in format string";
9680 /* In case a range fence was given "backwards", swap it */
9683 for (j
= beg
+ 1; j
< end
- 1; ++j
) {
9684 if (buffer
[j
] == '-' && buffer
[j
- 1] > buffer
[j
+ 1]) {
9685 char tmp
= buffer
[j
- 1];
9687 buffer
[j
- 1] = buffer
[j
+ 1];
9688 buffer
[j
+ 1] = tmp
;
9695 /* Remember any valid modifier if given */
9696 if (strchr("hlL", *fmt
) != 0)
9697 descr
->modifier
= tolower((int)*fmt
++);
9700 if (strchr("efgcsndoxui", *fmt
) == 0) {
9701 fmtObj
->error
= "bad scan conversion character";
9704 else if (*fmt
== 'c' && descr
->width
!= 0) {
9705 fmtObj
->error
= "field width may not be specified in %c " "conversion";
9708 else if (*fmt
== 'u' && descr
->modifier
== 'l') {
9709 fmtObj
->error
= "unsigned wide not supported";
9719 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9721 #define FormatGetCnvCount(_fo_) \
9722 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9723 #define FormatGetMaxPos(_fo_) \
9724 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9725 #define FormatGetError(_fo_) \
9726 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9728 /* JimScanAString is used to scan an unspecified string that ends with
9729 * next WS, or a string that is specified via a charset.
9732 static Jim_Obj
*JimScanAString(Jim_Interp
*interp
, const char *sdescr
, const char *str
)
9734 char *buffer
= Jim_StrDup(str
);
9741 if (!sdescr
&& isspace(UCHAR(*str
)))
9742 break; /* EOS via WS if unspecified */
9744 n
= utf8_tounicode(str
, &c
);
9745 if (sdescr
&& !JimCharsetMatch(sdescr
, c
, JIM_CHARSET_SCAN
))
9751 return Jim_NewStringObjNoAlloc(interp
, buffer
, p
- buffer
);
9754 /* ScanOneEntry will scan one entry out of the string passed as argument.
9755 * It use the sscanf() function for this task. After extracting and
9756 * converting of the value, the count of scanned characters will be
9757 * returned of -1 in case of no conversion tool place and string was
9758 * already scanned thru */
9760 static int ScanOneEntry(Jim_Interp
*interp
, const char *str
, int pos
, int strLen
,
9761 ScanFmtStringObj
* fmtObj
, long idx
, Jim_Obj
**valObjPtr
)
9764 const ScanFmtPartDescr
*descr
= &fmtObj
->descr
[idx
];
9766 size_t anchor
= pos
;
9768 Jim_Obj
*tmpObj
= NULL
;
9770 /* First pessimistically assume, we will not scan anything :-) */
9772 if (descr
->prefix
) {
9773 /* There was a prefix given before the conversion, skip it and adjust
9774 * the string-to-be-parsed accordingly */
9775 for (i
= 0; pos
< strLen
&& descr
->prefix
[i
]; ++i
) {
9776 /* If prefix require, skip WS */
9777 if (isspace(UCHAR(descr
->prefix
[i
])))
9778 while (pos
< strLen
&& isspace(UCHAR(str
[pos
])))
9780 else if (descr
->prefix
[i
] != str
[pos
])
9781 break; /* Prefix do not match here, leave the loop */
9783 ++pos
; /* Prefix matched so far, next round */
9785 if (pos
>= strLen
) {
9786 return -1; /* All of str consumed: EOF condition */
9788 else if (descr
->prefix
[i
] != 0)
9789 return 0; /* Not whole prefix consumed, no conversion possible */
9791 /* For all but following conversion, skip leading WS */
9792 if (descr
->type
!= 'c' && descr
->type
!= '[' && descr
->type
!= 'n')
9793 while (isspace(UCHAR(str
[pos
])))
9795 /* Determine how much skipped/scanned so far */
9796 scanned
= pos
- anchor
;
9798 /* %c is a special, simple case. no width */
9799 if (descr
->type
== 'n') {
9800 /* Return pseudo conversion means: how much scanned so far? */
9801 *valObjPtr
= Jim_NewIntObj(interp
, anchor
+ scanned
);
9803 else if (pos
>= strLen
) {
9804 /* Cannot scan anything, as str is totally consumed */
9807 else if (descr
->type
== 'c') {
9809 scanned
+= utf8_tounicode(&str
[pos
], &c
);
9810 *valObjPtr
= Jim_NewIntObj(interp
, c
);
9814 /* Processing of conversions follows ... */
9815 if (descr
->width
> 0) {
9816 /* Do not try to scan as fas as possible but only the given width.
9817 * To ensure this, we copy the part that should be scanned. */
9818 size_t sLen
= utf8_strlen(&str
[pos
], strLen
- pos
);
9819 size_t tLen
= descr
->width
> sLen
? sLen
: descr
->width
;
9821 tmpObj
= Jim_NewStringObjUtf8(interp
, str
+ pos
, tLen
);
9822 tok
= tmpObj
->bytes
;
9825 /* As no width was given, simply refer to the original string */
9828 switch (descr
->type
) {
9834 char *endp
; /* Position where the number finished */
9837 int base
= descr
->type
== 'o' ? 8
9838 : descr
->type
== 'x' ? 16 : descr
->type
== 'i' ? 0 : 10;
9840 /* Try to scan a number with the given base */
9842 w
= jim_strtoull(tok
, &endp
);
9845 w
= strtoull(tok
, &endp
, base
);
9849 /* There was some number sucessfully scanned! */
9850 *valObjPtr
= Jim_NewIntObj(interp
, w
);
9852 /* Adjust the number-of-chars scanned so far */
9853 scanned
+= endp
- tok
;
9856 /* Nothing was scanned. We have to determine if this
9857 * happened due to e.g. prefix mismatch or input str
9859 scanned
= *tok
? 0 : -1;
9865 *valObjPtr
= JimScanAString(interp
, descr
->arg
, tok
);
9866 scanned
+= Jim_Length(*valObjPtr
);
9873 double value
= strtod(tok
, &endp
);
9876 /* There was some number sucessfully scanned! */
9877 *valObjPtr
= Jim_NewDoubleObj(interp
, value
);
9878 /* Adjust the number-of-chars scanned so far */
9879 scanned
+= endp
- tok
;
9882 /* Nothing was scanned. We have to determine if this
9883 * happened due to e.g. prefix mismatch or input str
9885 scanned
= *tok
? 0 : -1;
9890 /* If a substring was allocated (due to pre-defined width) do not
9891 * forget to free it */
9893 Jim_FreeNewObj(interp
, tmpObj
);
9899 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9900 * string and returns all converted (and not ignored) values in a list back
9901 * to the caller. If an error occured, a NULL pointer will be returned */
9903 Jim_Obj
*Jim_ScanString(Jim_Interp
*interp
, Jim_Obj
*strObjPtr
, Jim_Obj
*fmtObjPtr
, int flags
)
9907 const char *str
= Jim_String(strObjPtr
);
9908 int strLen
= Jim_Utf8Length(interp
, strObjPtr
);
9909 Jim_Obj
*resultList
= 0;
9910 Jim_Obj
**resultVec
= 0;
9912 Jim_Obj
*emptyStr
= 0;
9913 ScanFmtStringObj
*fmtObj
;
9915 /* This should never happen. The format object should already be of the correct type */
9916 JimPanic((fmtObjPtr
->typePtr
!= &scanFmtStringObjType
, "Jim_ScanString() for non-scan format"));
9918 fmtObj
= (ScanFmtStringObj
*) fmtObjPtr
->internalRep
.ptr
;
9919 /* Check if format specification was valid */
9920 if (fmtObj
->error
!= 0) {
9921 if (flags
& JIM_ERRMSG
)
9922 Jim_SetResultString(interp
, fmtObj
->error
, -1);
9925 /* Allocate a new "shared" empty string for all unassigned conversions */
9926 emptyStr
= Jim_NewEmptyStringObj(interp
);
9927 Jim_IncrRefCount(emptyStr
);
9928 /* Create a list and fill it with empty strings up to max specified XPG3 */
9929 resultList
= Jim_NewListObj(interp
, NULL
, 0);
9930 if (fmtObj
->maxPos
> 0) {
9931 for (i
= 0; i
< fmtObj
->maxPos
; ++i
)
9932 Jim_ListAppendElement(interp
, resultList
, emptyStr
);
9933 JimListGetElements(interp
, resultList
, &resultc
, &resultVec
);
9935 /* Now handle every partial format description */
9936 for (i
= 0, pos
= 0; i
< fmtObj
->count
; ++i
) {
9937 ScanFmtPartDescr
*descr
= &(fmtObj
->descr
[i
]);
9940 /* Only last type may be "literal" w/o conversion - skip it! */
9941 if (descr
->type
== 0)
9943 /* As long as any conversion could be done, we will proceed */
9945 scanned
= ScanOneEntry(interp
, str
, pos
, strLen
, fmtObj
, i
, &value
);
9946 /* In case our first try results in EOF, we will leave */
9947 if (scanned
== -1 && i
== 0)
9949 /* Advance next pos-to-be-scanned for the amount scanned already */
9952 /* value == 0 means no conversion took place so take empty string */
9954 value
= Jim_NewEmptyStringObj(interp
);
9955 /* If value is a non-assignable one, skip it */
9956 if (descr
->pos
== -1) {
9957 Jim_FreeNewObj(interp
, value
);
9959 else if (descr
->pos
== 0)
9960 /* Otherwise append it to the result list if no XPG3 was given */
9961 Jim_ListAppendElement(interp
, resultList
, value
);
9962 else if (resultVec
[descr
->pos
- 1] == emptyStr
) {
9963 /* But due to given XPG3, put the value into the corr. slot */
9964 Jim_DecrRefCount(interp
, resultVec
[descr
->pos
- 1]);
9965 Jim_IncrRefCount(value
);
9966 resultVec
[descr
->pos
- 1] = value
;
9969 /* Otherwise, the slot was already used - free obj and ERROR */
9970 Jim_FreeNewObj(interp
, value
);
9974 Jim_DecrRefCount(interp
, emptyStr
);
9977 Jim_DecrRefCount(interp
, emptyStr
);
9978 Jim_FreeNewObj(interp
, resultList
);
9979 return (Jim_Obj
*)EOF
;
9981 Jim_DecrRefCount(interp
, emptyStr
);
9982 Jim_FreeNewObj(interp
, resultList
);
9986 /* -----------------------------------------------------------------------------
9987 * Pseudo Random Number Generation
9988 * ---------------------------------------------------------------------------*/
9989 /* Initialize the sbox with the numbers from 0 to 255 */
9990 static void JimPrngInit(Jim_Interp
*interp
)
9992 #define PRNG_SEED_SIZE 256
9995 time_t t
= time(NULL
);
9997 interp
->prngState
= Jim_Alloc(sizeof(Jim_PrngState
));
9999 seed
= Jim_Alloc(PRNG_SEED_SIZE
* sizeof(*seed
));
10000 for (i
= 0; i
< PRNG_SEED_SIZE
; i
++) {
10001 seed
[i
] = (rand() ^ t
^ clock());
10003 JimPrngSeed(interp
, (unsigned char *)seed
, PRNG_SEED_SIZE
* sizeof(*seed
));
10007 /* Generates N bytes of random data */
10008 static void JimRandomBytes(Jim_Interp
*interp
, void *dest
, unsigned int len
)
10010 Jim_PrngState
*prng
;
10011 unsigned char *destByte
= (unsigned char *)dest
;
10012 unsigned int si
, sj
, x
;
10014 /* initialization, only needed the first time */
10015 if (interp
->prngState
== NULL
)
10016 JimPrngInit(interp
);
10017 prng
= interp
->prngState
;
10018 /* generates 'len' bytes of pseudo-random numbers */
10019 for (x
= 0; x
< len
; x
++) {
10020 prng
->i
= (prng
->i
+ 1) & 0xff;
10021 si
= prng
->sbox
[prng
->i
];
10022 prng
->j
= (prng
->j
+ si
) & 0xff;
10023 sj
= prng
->sbox
[prng
->j
];
10024 prng
->sbox
[prng
->i
] = sj
;
10025 prng
->sbox
[prng
->j
] = si
;
10026 *destByte
++ = prng
->sbox
[(si
+ sj
) & 0xff];
10030 /* Re-seed the generator with user-provided bytes */
10031 static void JimPrngSeed(Jim_Interp
*interp
, unsigned char *seed
, int seedLen
)
10034 Jim_PrngState
*prng
;
10036 /* initialization, only needed the first time */
10037 if (interp
->prngState
== NULL
)
10038 JimPrngInit(interp
);
10039 prng
= interp
->prngState
;
10041 /* Set the sbox[i] with i */
10042 for (i
= 0; i
< 256; i
++)
10044 /* Now use the seed to perform a random permutation of the sbox */
10045 for (i
= 0; i
< seedLen
; i
++) {
10048 t
= prng
->sbox
[i
& 0xFF];
10049 prng
->sbox
[i
& 0xFF] = prng
->sbox
[seed
[i
]];
10050 prng
->sbox
[seed
[i
]] = t
;
10052 prng
->i
= prng
->j
= 0;
10054 /* discard at least the first 256 bytes of stream.
10055 * borrow the seed buffer for this
10057 for (i
= 0; i
< 256; i
+= seedLen
) {
10058 JimRandomBytes(interp
, seed
, seedLen
);
10063 static int Jim_IncrCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10065 jim_wide wideValue
, increment
= 1;
10066 Jim_Obj
*intObjPtr
;
10068 if (argc
!= 2 && argc
!= 3) {
10069 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?increment?");
10073 if (Jim_GetWide(interp
, argv
[2], &increment
) != JIM_OK
)
10076 intObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
10078 /* Set missing variable to 0 */
10081 else if (Jim_GetWide(interp
, intObjPtr
, &wideValue
) != JIM_OK
) {
10084 if (!intObjPtr
|| Jim_IsShared(intObjPtr
)) {
10085 intObjPtr
= Jim_NewIntObj(interp
, wideValue
+ increment
);
10086 if (Jim_SetVariable(interp
, argv
[1], intObjPtr
) != JIM_OK
) {
10087 Jim_FreeNewObj(interp
, intObjPtr
);
10092 /* Can do it the quick way */
10093 Jim_InvalidateStringRep(intObjPtr
);
10094 JimWideValue(intObjPtr
) = wideValue
+ increment
;
10096 /* The following step is required in order to invalidate the
10097 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10098 if (argv
[1]->typePtr
!= &variableObjType
) {
10099 /* Note that this can't fail since GetVariable already succeeded */
10100 Jim_SetVariable(interp
, argv
[1], intObjPtr
);
10103 Jim_SetResult(interp
, intObjPtr
);
10108 /* -----------------------------------------------------------------------------
10110 * ---------------------------------------------------------------------------*/
10111 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10112 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10114 /* Handle calls to the [unknown] command */
10115 static int JimUnknown(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
10119 /* If JimUnknown() is recursively called too many times...
10122 if (interp
->unknown_called
> 50) {
10126 /* The object interp->unknown just contains
10127 * the "unknown" string, it is used in order to
10128 * avoid to lookup the unknown command every time
10129 * but instead to cache the result. */
10131 /* If the [unknown] command does not exist ... */
10132 if (Jim_GetCommand(interp
, interp
->unknown
, JIM_NONE
) == NULL
)
10135 interp
->unknown_called
++;
10136 /* XXX: Are we losing fileNameObj and linenr? */
10137 retcode
= Jim_EvalObjPrefix(interp
, interp
->unknown
, argc
, argv
);
10138 interp
->unknown_called
--;
10143 static int JimInvokeCommand(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10151 for (j
= 0; j
< objc
; j
++) {
10152 printf(" '%s'", Jim_String(objv
[j
]));
10157 if (interp
->framePtr
->tailcallCmd
) {
10158 /* Special tailcall command was pre-resolved */
10159 cmdPtr
= interp
->framePtr
->tailcallCmd
;
10160 interp
->framePtr
->tailcallCmd
= NULL
;
10163 cmdPtr
= Jim_GetCommand(interp
, objv
[0], JIM_ERRMSG
);
10164 if (cmdPtr
== NULL
) {
10165 return JimUnknown(interp
, objc
, objv
);
10167 JimIncrCmdRefCount(cmdPtr
);
10170 if (interp
->evalDepth
== interp
->maxEvalDepth
) {
10171 Jim_SetResultString(interp
, "Infinite eval recursion", -1);
10175 interp
->evalDepth
++;
10177 /* Call it -- Make sure result is an empty object. */
10178 Jim_SetEmptyResult(interp
);
10179 if (cmdPtr
->isproc
) {
10180 retcode
= JimCallProcedure(interp
, cmdPtr
, objc
, objv
);
10183 interp
->cmdPrivData
= cmdPtr
->u
.native
.privData
;
10184 retcode
= cmdPtr
->u
.native
.cmdProc(interp
, objc
, objv
);
10186 interp
->evalDepth
--;
10189 JimDecrCmdRefCount(interp
, cmdPtr
);
10194 /* Eval the object vector 'objv' composed of 'objc' elements.
10195 * Every element is used as single argument.
10196 * Jim_EvalObj() will call this function every time its object
10197 * argument is of "list" type, with no string representation.
10199 * This is possible because the string representation of a
10200 * list object generated by the UpdateStringOfList is made
10201 * in a way that ensures that every list element is a different
10202 * command argument. */
10203 int Jim_EvalObjVector(Jim_Interp
*interp
, int objc
, Jim_Obj
*const *objv
)
10207 /* Incr refcount of arguments. */
10208 for (i
= 0; i
< objc
; i
++)
10209 Jim_IncrRefCount(objv
[i
]);
10211 retcode
= JimInvokeCommand(interp
, objc
, objv
);
10213 /* Decr refcount of arguments and return the retcode */
10214 for (i
= 0; i
< objc
; i
++)
10215 Jim_DecrRefCount(interp
, objv
[i
]);
10221 * Invokes 'prefix' as a command with the objv array as arguments.
10223 int Jim_EvalObjPrefix(Jim_Interp
*interp
, Jim_Obj
*prefix
, int objc
, Jim_Obj
*const *objv
)
10226 Jim_Obj
**nargv
= Jim_Alloc((objc
+ 1) * sizeof(*nargv
));
10229 memcpy(&nargv
[1], &objv
[0], sizeof(nargv
[0]) * objc
);
10230 ret
= Jim_EvalObjVector(interp
, objc
+ 1, nargv
);
10235 static void JimAddErrorToStack(Jim_Interp
*interp
, int retcode
, ScriptObj
*script
)
10239 if (rc
== JIM_ERR
&& !interp
->errorFlag
) {
10240 /* This is the first error, so save the file/line information and reset the stack */
10241 interp
->errorFlag
= 1;
10242 Jim_IncrRefCount(script
->fileNameObj
);
10243 Jim_DecrRefCount(interp
, interp
->errorFileNameObj
);
10244 interp
->errorFileNameObj
= script
->fileNameObj
;
10245 interp
->errorLine
= script
->linenr
;
10247 JimResetStackTrace(interp
);
10248 /* Always add a level where the error first occurs */
10249 interp
->addStackTrace
++;
10252 /* Now if this is an "interesting" level, add it to the stack trace */
10253 if (rc
== JIM_ERR
&& interp
->addStackTrace
> 0) {
10254 /* Add the stack info for the current level */
10256 JimAppendStackTrace(interp
, Jim_String(interp
->errorProc
), script
->fileNameObj
, script
->linenr
);
10258 /* Note: if we didn't have a filename for this level,
10259 * don't clear the addStackTrace flag
10260 * so we can pick it up at the next level
10262 if (Jim_Length(script
->fileNameObj
)) {
10263 interp
->addStackTrace
= 0;
10266 Jim_DecrRefCount(interp
, interp
->errorProc
);
10267 interp
->errorProc
= interp
->emptyObj
;
10268 Jim_IncrRefCount(interp
->errorProc
);
10270 else if (rc
== JIM_RETURN
&& interp
->returnCode
== JIM_ERR
) {
10271 /* Propagate the addStackTrace value through 'return -code error' */
10274 interp
->addStackTrace
= 0;
10278 static int JimSubstOneToken(Jim_Interp
*interp
, const ScriptToken
*token
, Jim_Obj
**objPtrPtr
)
10282 switch (token
->type
) {
10285 objPtr
= token
->objPtr
;
10288 objPtr
= Jim_GetVariable(interp
, token
->objPtr
, JIM_ERRMSG
);
10290 case JIM_TT_DICTSUGAR
:
10291 objPtr
= JimExpandDictSugar(interp
, token
->objPtr
);
10293 case JIM_TT_EXPRSUGAR
:
10294 objPtr
= JimExpandExprSugar(interp
, token
->objPtr
);
10297 switch (Jim_EvalObj(interp
, token
->objPtr
)) {
10300 objPtr
= interp
->result
;
10303 /* Stop substituting */
10306 /* just skip this one */
10307 return JIM_CONTINUE
;
10314 "default token type (%d) reached " "in Jim_SubstObj().", token
->type
));
10319 *objPtrPtr
= objPtr
;
10325 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10326 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10327 * The returned object has refcount = 0.
10329 static Jim_Obj
*JimInterpolateTokens(Jim_Interp
*interp
, const ScriptToken
* token
, int tokens
, int flags
)
10333 Jim_Obj
*sintv
[JIM_EVAL_SINTV_LEN
];
10337 if (tokens
<= JIM_EVAL_SINTV_LEN
)
10340 intv
= Jim_Alloc(sizeof(Jim_Obj
*) * tokens
);
10342 /* Compute every token forming the argument
10343 * in the intv objects vector. */
10344 for (i
= 0; i
< tokens
; i
++) {
10345 switch (JimSubstOneToken(interp
, &token
[i
], &intv
[i
])) {
10350 if (flags
& JIM_SUBST_FLAG
) {
10355 /* XXX: Should probably set an error about break outside loop */
10356 /* fall through to error */
10358 if (flags
& JIM_SUBST_FLAG
) {
10362 /* XXX: Ditto continue outside loop */
10363 /* fall through to error */
10366 Jim_DecrRefCount(interp
, intv
[i
]);
10368 if (intv
!= sintv
) {
10373 Jim_IncrRefCount(intv
[i
]);
10374 Jim_String(intv
[i
]);
10375 totlen
+= intv
[i
]->length
;
10378 /* Fast path return for a single token */
10379 if (tokens
== 1 && intv
[0] && intv
== sintv
) {
10380 Jim_DecrRefCount(interp
, intv
[0]);
10384 /* Concatenate every token in an unique
10386 objPtr
= Jim_NewStringObjNoAlloc(interp
, NULL
, 0);
10388 if (tokens
== 4 && token
[0].type
== JIM_TT_ESC
&& token
[1].type
== JIM_TT_ESC
10389 && token
[2].type
== JIM_TT_VAR
) {
10390 /* May be able to do fast interpolated object -> dictSubst */
10391 objPtr
->typePtr
= &interpolatedObjType
;
10392 objPtr
->internalRep
.dictSubstValue
.varNameObjPtr
= token
[0].objPtr
;
10393 objPtr
->internalRep
.dictSubstValue
.indexObjPtr
= intv
[2];
10394 Jim_IncrRefCount(intv
[2]);
10396 else if (tokens
&& intv
[0] && intv
[0]->typePtr
== &sourceObjType
) {
10397 /* The first interpolated token is source, so preserve the source info */
10398 JimSetSourceInfo(interp
, objPtr
, intv
[0]->internalRep
.sourceValue
.fileNameObj
, intv
[0]->internalRep
.sourceValue
.lineNumber
);
10402 s
= objPtr
->bytes
= Jim_Alloc(totlen
+ 1);
10403 objPtr
->length
= totlen
;
10404 for (i
= 0; i
< tokens
; i
++) {
10406 memcpy(s
, intv
[i
]->bytes
, intv
[i
]->length
);
10407 s
+= intv
[i
]->length
;
10408 Jim_DecrRefCount(interp
, intv
[i
]);
10411 objPtr
->bytes
[totlen
] = '\0';
10412 /* Free the intv vector if not static. */
10413 if (intv
!= sintv
) {
10421 /* listPtr *must* be a list.
10422 * The contents of the list is evaluated with the first element as the command and
10423 * the remaining elements as the arguments.
10425 static int JimEvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10427 int retcode
= JIM_OK
;
10429 if (listPtr
->internalRep
.listValue
.len
) {
10430 Jim_IncrRefCount(listPtr
);
10431 retcode
= JimInvokeCommand(interp
,
10432 listPtr
->internalRep
.listValue
.len
,
10433 listPtr
->internalRep
.listValue
.ele
);
10434 Jim_DecrRefCount(interp
, listPtr
);
10439 int Jim_EvalObjList(Jim_Interp
*interp
, Jim_Obj
*listPtr
)
10441 SetListFromAny(interp
, listPtr
);
10442 return JimEvalObjList(interp
, listPtr
);
10445 int Jim_EvalObj(Jim_Interp
*interp
, Jim_Obj
*scriptObjPtr
)
10449 ScriptToken
*token
;
10450 int retcode
= JIM_OK
;
10451 Jim_Obj
*sargv
[JIM_EVAL_SARGV_LEN
], **argv
= NULL
;
10452 Jim_Obj
*prevScriptObj
;
10454 /* If the object is of type "list", with no string rep we can call
10455 * a specialized version of Jim_EvalObj() */
10456 if (Jim_IsList(scriptObjPtr
) && scriptObjPtr
->bytes
== NULL
) {
10457 return JimEvalObjList(interp
, scriptObjPtr
);
10460 Jim_IncrRefCount(scriptObjPtr
); /* Make sure it's shared. */
10461 script
= Jim_GetScript(interp
, scriptObjPtr
);
10462 if (script
== NULL
) {
10463 Jim_DecrRefCount(interp
, scriptObjPtr
);
10467 /* Reset the interpreter result. This is useful to
10468 * return the empty result in the case of empty program. */
10469 Jim_SetEmptyResult(interp
);
10471 token
= script
->token
;
10473 #ifdef JIM_OPTIMIZATION
10474 /* Check for one of the following common scripts used by for, while
10479 if (script
->len
== 0) {
10480 Jim_DecrRefCount(interp
, scriptObjPtr
);
10483 if (script
->len
== 3
10484 && token
[1].objPtr
->typePtr
== &commandObjType
10485 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->isproc
== 0
10486 && token
[1].objPtr
->internalRep
.cmdValue
.cmdPtr
->u
.native
.cmdProc
== Jim_IncrCoreCommand
10487 && token
[2].objPtr
->typePtr
== &variableObjType
) {
10489 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, token
[2].objPtr
, JIM_NONE
);
10491 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
10492 JimWideValue(objPtr
)++;
10493 Jim_InvalidateStringRep(objPtr
);
10494 Jim_DecrRefCount(interp
, scriptObjPtr
);
10495 Jim_SetResult(interp
, objPtr
);
10501 /* Now we have to make sure the internal repr will not be
10502 * freed on shimmering.
10504 * Think for example to this:
10506 * set x {llength $x; ... some more code ...}; eval $x
10508 * In order to preserve the internal rep, we increment the
10509 * inUse field of the script internal rep structure. */
10512 /* Stash the current script */
10513 prevScriptObj
= interp
->currentScriptObj
;
10514 interp
->currentScriptObj
= scriptObjPtr
;
10516 interp
->errorFlag
= 0;
10519 /* Execute every command sequentially until the end of the script
10520 * or an error occurs.
10522 for (i
= 0; i
< script
->len
&& retcode
== JIM_OK
; ) {
10526 /* First token of the line is always JIM_TT_LINE */
10527 argc
= token
[i
].objPtr
->internalRep
.scriptLineValue
.argc
;
10528 script
->linenr
= token
[i
].objPtr
->internalRep
.scriptLineValue
.line
;
10530 /* Allocate the arguments vector if required */
10531 if (argc
> JIM_EVAL_SARGV_LEN
)
10532 argv
= Jim_Alloc(sizeof(Jim_Obj
*) * argc
);
10534 /* Skip the JIM_TT_LINE token */
10537 /* Populate the arguments objects.
10538 * If an error occurs, retcode will be set and
10539 * 'j' will be set to the number of args expanded
10541 for (j
= 0; j
< argc
; j
++) {
10542 long wordtokens
= 1;
10544 Jim_Obj
*wordObjPtr
= NULL
;
10546 if (token
[i
].type
== JIM_TT_WORD
) {
10547 wordtokens
= JimWideValue(token
[i
++].objPtr
);
10548 if (wordtokens
< 0) {
10550 wordtokens
= -wordtokens
;
10554 if (wordtokens
== 1) {
10555 /* Fast path if the token does not
10556 * need interpolation */
10558 switch (token
[i
].type
) {
10561 wordObjPtr
= token
[i
].objPtr
;
10564 wordObjPtr
= Jim_GetVariable(interp
, token
[i
].objPtr
, JIM_ERRMSG
);
10566 case JIM_TT_EXPRSUGAR
:
10567 wordObjPtr
= JimExpandExprSugar(interp
, token
[i
].objPtr
);
10569 case JIM_TT_DICTSUGAR
:
10570 wordObjPtr
= JimExpandDictSugar(interp
, token
[i
].objPtr
);
10573 retcode
= Jim_EvalObj(interp
, token
[i
].objPtr
);
10574 if (retcode
== JIM_OK
) {
10575 wordObjPtr
= Jim_GetResult(interp
);
10579 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10583 /* For interpolation we call a helper
10584 * function to do the work for us. */
10585 wordObjPtr
= JimInterpolateTokens(interp
, token
+ i
, wordtokens
, JIM_NONE
);
10589 if (retcode
== JIM_OK
) {
10595 Jim_IncrRefCount(wordObjPtr
);
10599 argv
[j
] = wordObjPtr
;
10602 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10603 int len
= Jim_ListLength(interp
, wordObjPtr
);
10604 int newargc
= argc
+ len
- 1;
10608 if (argv
== sargv
) {
10609 if (newargc
> JIM_EVAL_SARGV_LEN
) {
10610 argv
= Jim_Alloc(sizeof(*argv
) * newargc
);
10611 memcpy(argv
, sargv
, sizeof(*argv
) * j
);
10615 /* Need to realloc to make room for (len - 1) more entries */
10616 argv
= Jim_Realloc(argv
, sizeof(*argv
) * newargc
);
10620 /* Now copy in the expanded version */
10621 for (k
= 0; k
< len
; k
++) {
10622 argv
[j
++] = wordObjPtr
->internalRep
.listValue
.ele
[k
];
10623 Jim_IncrRefCount(wordObjPtr
->internalRep
.listValue
.ele
[k
]);
10626 /* The original object reference is no longer needed,
10627 * after the expansion it is no longer present on
10628 * the argument vector, but the single elements are
10630 Jim_DecrRefCount(interp
, wordObjPtr
);
10632 /* And update the indexes */
10638 if (retcode
== JIM_OK
&& argc
) {
10639 /* Invoke the command */
10640 retcode
= JimInvokeCommand(interp
, argc
, argv
);
10641 /* Check for a signal after each command */
10642 if (Jim_CheckSignal(interp
)) {
10643 retcode
= JIM_SIGNAL
;
10647 /* Finished with the command, so decrement ref counts of each argument */
10649 Jim_DecrRefCount(interp
, argv
[j
]);
10652 if (argv
!= sargv
) {
10658 /* Possibly add to the error stack trace */
10659 JimAddErrorToStack(interp
, retcode
, script
);
10661 /* Restore the current script */
10662 interp
->currentScriptObj
= prevScriptObj
;
10664 /* Note that we don't have to decrement inUse, because the
10665 * following code transfers our use of the reference again to
10666 * the script object. */
10667 Jim_FreeIntRep(interp
, scriptObjPtr
);
10668 scriptObjPtr
->typePtr
= &scriptObjType
;
10669 Jim_SetIntRepPtr(scriptObjPtr
, script
);
10670 Jim_DecrRefCount(interp
, scriptObjPtr
);
10675 static int JimSetProcArg(Jim_Interp
*interp
, Jim_Obj
*argNameObj
, Jim_Obj
*argValObj
)
10678 /* If argObjPtr begins with '&', do an automatic upvar */
10679 const char *varname
= Jim_String(argNameObj
);
10680 if (*varname
== '&') {
10681 /* First check that the target variable exists */
10683 Jim_CallFrame
*savedCallFrame
= interp
->framePtr
;
10685 interp
->framePtr
= interp
->framePtr
->parent
;
10686 objPtr
= Jim_GetVariable(interp
, argValObj
, JIM_ERRMSG
);
10687 interp
->framePtr
= savedCallFrame
;
10692 /* It exists, so perform the binding. */
10693 objPtr
= Jim_NewStringObj(interp
, varname
+ 1, -1);
10694 Jim_IncrRefCount(objPtr
);
10695 retcode
= Jim_SetVariableLink(interp
, objPtr
, argValObj
, interp
->framePtr
->parent
);
10696 Jim_DecrRefCount(interp
, objPtr
);
10699 retcode
= Jim_SetVariable(interp
, argNameObj
, argValObj
);
10705 * Sets the interp result to be an error message indicating the required proc args.
10707 static void JimSetProcWrongArgs(Jim_Interp
*interp
, Jim_Obj
*procNameObj
, Jim_Cmd
*cmd
)
10709 /* Create a nice error message, consistent with Tcl 8.5 */
10710 Jim_Obj
*argmsg
= Jim_NewStringObj(interp
, "", 0);
10713 for (i
= 0; i
< cmd
->u
.proc
.argListLen
; i
++) {
10714 Jim_AppendString(interp
, argmsg
, " ", 1);
10716 if (i
== cmd
->u
.proc
.argsPos
) {
10717 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10719 Jim_AppendString(interp
, argmsg
, "?", 1);
10720 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].defaultObjPtr
);
10721 Jim_AppendString(interp
, argmsg
, " ...?", -1);
10724 /* We have plain args */
10725 Jim_AppendString(interp
, argmsg
, "?arg...?", -1);
10729 if (cmd
->u
.proc
.arglist
[i
].defaultObjPtr
) {
10730 Jim_AppendString(interp
, argmsg
, "?", 1);
10731 Jim_AppendObj(interp
, argmsg
, cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10732 Jim_AppendString(interp
, argmsg
, "?", 1);
10735 const char *arg
= Jim_String(cmd
->u
.proc
.arglist
[i
].nameObjPtr
);
10739 Jim_AppendString(interp
, argmsg
, arg
, -1);
10743 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s%#s\"", procNameObj
, argmsg
);
10744 Jim_FreeNewObj(interp
, argmsg
);
10747 #ifdef jim_ext_namespace
10751 int Jim_EvalNamespace(Jim_Interp
*interp
, Jim_Obj
*scriptObj
, Jim_Obj
*nsObj
)
10753 Jim_CallFrame
*callFramePtr
;
10756 /* Create a new callframe */
10757 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, nsObj
);
10758 callFramePtr
->argv
= &interp
->emptyObj
;
10759 callFramePtr
->argc
= 0;
10760 callFramePtr
->procArgsObjPtr
= NULL
;
10761 callFramePtr
->procBodyObjPtr
= scriptObj
;
10762 callFramePtr
->staticVars
= NULL
;
10763 callFramePtr
->fileNameObj
= interp
->emptyObj
;
10764 callFramePtr
->line
= 0;
10765 Jim_IncrRefCount(scriptObj
);
10766 interp
->framePtr
= callFramePtr
;
10768 /* Check if there are too nested calls */
10769 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10770 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10774 /* Eval the body */
10775 retcode
= Jim_EvalObj(interp
, scriptObj
);
10778 /* Destroy the callframe */
10779 interp
->framePtr
= interp
->framePtr
->parent
;
10780 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10786 /* Call a procedure implemented in Tcl.
10787 * It's possible to speed-up a lot this function, currently
10788 * the callframes are not cached, but allocated and
10789 * destroied every time. What is expecially costly is
10790 * to create/destroy the local vars hash table every time.
10792 * This can be fixed just implementing callframes caching
10793 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10794 static int JimCallProcedure(Jim_Interp
*interp
, Jim_Cmd
*cmd
, int argc
, Jim_Obj
*const *argv
)
10796 Jim_CallFrame
*callFramePtr
;
10797 int i
, d
, retcode
, optargs
;
10801 if (argc
- 1 < cmd
->u
.proc
.reqArity
||
10802 (cmd
->u
.proc
.argsPos
< 0 && argc
- 1 > cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
)) {
10803 JimSetProcWrongArgs(interp
, argv
[0], cmd
);
10807 if (Jim_Length(cmd
->u
.proc
.bodyObjPtr
) == 0) {
10808 /* Optimise for procedure with no body - useful for optional debugging */
10812 /* Check if there are too nested calls */
10813 if (interp
->framePtr
->level
== interp
->maxCallFrameDepth
) {
10814 Jim_SetResultString(interp
, "Too many nested calls. Infinite recursion?", -1);
10818 /* Create a new callframe */
10819 callFramePtr
= JimCreateCallFrame(interp
, interp
->framePtr
, cmd
->u
.proc
.nsObj
);
10820 callFramePtr
->argv
= argv
;
10821 callFramePtr
->argc
= argc
;
10822 callFramePtr
->procArgsObjPtr
= cmd
->u
.proc
.argListObjPtr
;
10823 callFramePtr
->procBodyObjPtr
= cmd
->u
.proc
.bodyObjPtr
;
10824 callFramePtr
->staticVars
= cmd
->u
.proc
.staticVars
;
10826 /* Remember where we were called from. */
10827 script
= Jim_GetScript(interp
, interp
->currentScriptObj
);
10828 callFramePtr
->fileNameObj
= script
->fileNameObj
;
10829 callFramePtr
->line
= script
->linenr
;
10831 Jim_IncrRefCount(cmd
->u
.proc
.argListObjPtr
);
10832 Jim_IncrRefCount(cmd
->u
.proc
.bodyObjPtr
);
10833 interp
->framePtr
= callFramePtr
;
10835 /* How many optional args are available */
10836 optargs
= (argc
- 1 - cmd
->u
.proc
.reqArity
);
10838 /* Step 'i' along the actual args, and step 'd' along the formal args */
10840 for (d
= 0; d
< cmd
->u
.proc
.argListLen
; d
++) {
10841 Jim_Obj
*nameObjPtr
= cmd
->u
.proc
.arglist
[d
].nameObjPtr
;
10842 if (d
== cmd
->u
.proc
.argsPos
) {
10844 Jim_Obj
*listObjPtr
;
10846 if (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
< argc
- 1) {
10847 argsLen
= argc
- 1 - (cmd
->u
.proc
.reqArity
+ cmd
->u
.proc
.optArity
);
10849 listObjPtr
= Jim_NewListObj(interp
, &argv
[i
], argsLen
);
10851 /* It is possible to rename args. */
10852 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
) {
10853 nameObjPtr
=cmd
->u
.proc
.arglist
[d
].defaultObjPtr
;
10855 retcode
= Jim_SetVariable(interp
, nameObjPtr
, listObjPtr
);
10856 if (retcode
!= JIM_OK
) {
10864 /* Optional or required? */
10865 if (cmd
->u
.proc
.arglist
[d
].defaultObjPtr
== NULL
|| optargs
-- > 0) {
10866 retcode
= JimSetProcArg(interp
, nameObjPtr
, argv
[i
++]);
10869 /* Ran out, so use the default */
10870 retcode
= Jim_SetVariable(interp
, nameObjPtr
, cmd
->u
.proc
.arglist
[d
].defaultObjPtr
);
10872 if (retcode
!= JIM_OK
) {
10877 /* Eval the body */
10878 retcode
= Jim_EvalObj(interp
, cmd
->u
.proc
.bodyObjPtr
);
10882 /* Free the callframe */
10883 interp
->framePtr
= interp
->framePtr
->parent
;
10884 JimFreeCallFrame(interp
, callFramePtr
, JIM_FCF_REUSE
);
10886 if (interp
->framePtr
->tailcallObj
) {
10887 /* If a tailcall is already being executed, merge this tailcall with that one */
10888 if (interp
->framePtr
->tailcall
++ == 0) {
10889 /* No current tailcall in this frame, so invoke the tailcall command */
10891 Jim_Obj
*tailcallObj
= interp
->framePtr
->tailcallObj
;
10893 interp
->framePtr
->tailcallObj
= NULL
;
10895 if (retcode
== JIM_EVAL
) {
10896 retcode
= Jim_EvalObjList(interp
, tailcallObj
);
10897 if (retcode
== JIM_RETURN
) {
10898 /* If the result of the tailcall is 'return', push
10899 * it up to the caller
10901 interp
->returnLevel
++;
10904 Jim_DecrRefCount(interp
, tailcallObj
);
10905 } while (interp
->framePtr
->tailcallObj
);
10907 /* If the tailcall chain finished early, may need to manually discard the command */
10908 if (interp
->framePtr
->tailcallCmd
) {
10909 JimDecrCmdRefCount(interp
, interp
->framePtr
->tailcallCmd
);
10910 interp
->framePtr
->tailcallCmd
= NULL
;
10913 interp
->framePtr
->tailcall
--;
10916 /* Handle the JIM_RETURN return code */
10917 if (retcode
== JIM_RETURN
) {
10918 if (--interp
->returnLevel
<= 0) {
10919 retcode
= interp
->returnCode
;
10920 interp
->returnCode
= JIM_OK
;
10921 interp
->returnLevel
= 0;
10924 else if (retcode
== JIM_ERR
) {
10925 interp
->addStackTrace
++;
10926 Jim_DecrRefCount(interp
, interp
->errorProc
);
10927 interp
->errorProc
= argv
[0];
10928 Jim_IncrRefCount(interp
->errorProc
);
10934 int Jim_EvalSource(Jim_Interp
*interp
, const char *filename
, int lineno
, const char *script
)
10937 Jim_Obj
*scriptObjPtr
;
10939 scriptObjPtr
= Jim_NewStringObj(interp
, script
, -1);
10940 Jim_IncrRefCount(scriptObjPtr
);
10943 Jim_Obj
*prevScriptObj
;
10945 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), lineno
);
10947 prevScriptObj
= interp
->currentScriptObj
;
10948 interp
->currentScriptObj
= scriptObjPtr
;
10950 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10952 interp
->currentScriptObj
= prevScriptObj
;
10955 retval
= Jim_EvalObj(interp
, scriptObjPtr
);
10957 Jim_DecrRefCount(interp
, scriptObjPtr
);
10961 int Jim_Eval(Jim_Interp
*interp
, const char *script
)
10963 return Jim_EvalObj(interp
, Jim_NewStringObj(interp
, script
, -1));
10966 /* Execute script in the scope of the global level */
10967 int Jim_EvalGlobal(Jim_Interp
*interp
, const char *script
)
10970 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10972 interp
->framePtr
= interp
->topFramePtr
;
10973 retval
= Jim_Eval(interp
, script
);
10974 interp
->framePtr
= savedFramePtr
;
10979 int Jim_EvalFileGlobal(Jim_Interp
*interp
, const char *filename
)
10982 Jim_CallFrame
*savedFramePtr
= interp
->framePtr
;
10984 interp
->framePtr
= interp
->topFramePtr
;
10985 retval
= Jim_EvalFile(interp
, filename
);
10986 interp
->framePtr
= savedFramePtr
;
10991 #include <sys/stat.h>
10993 int Jim_EvalFile(Jim_Interp
*interp
, const char *filename
)
10997 Jim_Obj
*scriptObjPtr
;
10998 Jim_Obj
*prevScriptObj
;
11003 if (stat(filename
, &sb
) != 0 || (fp
= fopen(filename
, "rt")) == NULL
) {
11004 Jim_SetResultFormatted(interp
, "couldn't read file \"%s\": %s", filename
, strerror(errno
));
11007 if (sb
.st_size
== 0) {
11012 buf
= Jim_Alloc(sb
.st_size
+ 1);
11013 readlen
= fread(buf
, 1, sb
.st_size
, fp
);
11017 Jim_SetResultFormatted(interp
, "failed to load file \"%s\": %s", filename
, strerror(errno
));
11023 scriptObjPtr
= Jim_NewStringObjNoAlloc(interp
, buf
, readlen
);
11024 JimSetSourceInfo(interp
, scriptObjPtr
, Jim_NewStringObj(interp
, filename
, -1), 1);
11025 Jim_IncrRefCount(scriptObjPtr
);
11027 /* Now check the script for unmatched braces, etc. */
11028 if (Jim_GetScript(interp
, scriptObjPtr
) == NULL
) {
11029 /* EvalFile changes context, so add a stack frame here */
11030 JimAddErrorToStack(interp
, JIM_ERR
, (ScriptObj
*)Jim_GetIntRepPtr(scriptObjPtr
));
11031 Jim_DecrRefCount(interp
, scriptObjPtr
);
11035 prevScriptObj
= interp
->currentScriptObj
;
11036 interp
->currentScriptObj
= scriptObjPtr
;
11038 retcode
= Jim_EvalObj(interp
, scriptObjPtr
);
11040 /* Handle the JIM_RETURN return code */
11041 if (retcode
== JIM_RETURN
) {
11042 if (--interp
->returnLevel
<= 0) {
11043 retcode
= interp
->returnCode
;
11044 interp
->returnCode
= JIM_OK
;
11045 interp
->returnLevel
= 0;
11048 if (retcode
== JIM_ERR
) {
11049 /* EvalFile changes context, so add a stack frame here */
11050 interp
->addStackTrace
++;
11053 interp
->currentScriptObj
= prevScriptObj
;
11055 Jim_DecrRefCount(interp
, scriptObjPtr
);
11060 /* -----------------------------------------------------------------------------
11062 * ---------------------------------------------------------------------------*/
11063 static void JimParseSubst(struct JimParserCtx
*pc
, int flags
)
11065 pc
->tstart
= pc
->p
;
11066 pc
->tline
= pc
->linenr
;
11068 if (pc
->len
== 0) {
11070 pc
->tt
= JIM_TT_EOL
;
11074 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11078 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11079 if (JimParseVar(pc
) == JIM_OK
) {
11082 /* Not a var, so treat as a string */
11083 pc
->tstart
= pc
->p
;
11084 flags
|= JIM_SUBST_NOVAR
;
11087 if (*pc
->p
== '$' && !(flags
& JIM_SUBST_NOVAR
)) {
11090 if (*pc
->p
== '[' && !(flags
& JIM_SUBST_NOCMD
)) {
11093 if (*pc
->p
== '\\' && pc
->len
> 1) {
11100 pc
->tend
= pc
->p
- 1;
11101 pc
->tt
= (flags
& JIM_SUBST_NOESC
) ? JIM_TT_STR
: JIM_TT_ESC
;
11104 /* The subst object type reuses most of the data structures and functions
11105 * of the script object. Script's data structures are a bit more complex
11106 * for what is needed for [subst]itution tasks, but the reuse helps to
11107 * deal with a single data structure at the cost of some more memory
11108 * usage for substitutions. */
11110 /* This method takes the string representation of an object
11111 * as a Tcl string where to perform [subst]itution, and generates
11112 * the pre-parsed internal representation. */
11113 static int SetSubstFromAny(Jim_Interp
*interp
, struct Jim_Obj
*objPtr
, int flags
)
11116 const char *scriptText
= Jim_GetString(objPtr
, &scriptTextLen
);
11117 struct JimParserCtx parser
;
11118 struct ScriptObj
*script
= Jim_Alloc(sizeof(*script
));
11119 ParseTokenList tokenlist
;
11121 /* Initially parse the subst into tokens (in tokenlist) */
11122 ScriptTokenListInit(&tokenlist
);
11124 JimParserInit(&parser
, scriptText
, scriptTextLen
, 1);
11126 JimParseSubst(&parser
, flags
);
11128 /* Note that subst doesn't need the EOL token */
11131 ScriptAddToken(&tokenlist
, parser
.tstart
, parser
.tend
- parser
.tstart
+ 1, parser
.tt
,
11135 /* Create the "real" subst/script tokens from the initial token list */
11137 script
->substFlags
= flags
;
11138 script
->fileNameObj
= interp
->emptyObj
;
11139 Jim_IncrRefCount(script
->fileNameObj
);
11140 SubstObjAddTokens(interp
, script
, &tokenlist
);
11142 /* No longer need the token list */
11143 ScriptTokenListFree(&tokenlist
);
11145 #ifdef DEBUG_SHOW_SUBST
11149 printf("==== Subst ====\n");
11150 for (i
= 0; i
< script
->len
; i
++) {
11151 printf("[%2d] %s '%s'\n", i
, jim_tt_name(script
->token
[i
].type
),
11152 Jim_String(script
->token
[i
].objPtr
));
11157 /* Free the old internal rep and set the new one. */
11158 Jim_FreeIntRep(interp
, objPtr
);
11159 Jim_SetIntRepPtr(objPtr
, script
);
11160 objPtr
->typePtr
= &scriptObjType
;
11164 static ScriptObj
*Jim_GetSubst(Jim_Interp
*interp
, Jim_Obj
*objPtr
, int flags
)
11166 if (objPtr
->typePtr
!= &scriptObjType
|| ((ScriptObj
*)Jim_GetIntRepPtr(objPtr
))->substFlags
!= flags
)
11167 SetSubstFromAny(interp
, objPtr
, flags
);
11168 return (ScriptObj
*) Jim_GetIntRepPtr(objPtr
);
11171 /* Performs commands,variables,blackslashes substitution,
11172 * storing the result object (with refcount 0) into
11174 int Jim_SubstObj(Jim_Interp
*interp
, Jim_Obj
*substObjPtr
, Jim_Obj
**resObjPtrPtr
, int flags
)
11176 ScriptObj
*script
= Jim_GetSubst(interp
, substObjPtr
, flags
);
11178 Jim_IncrRefCount(substObjPtr
); /* Make sure it's shared. */
11179 /* In order to preserve the internal rep, we increment the
11180 * inUse field of the script internal rep structure. */
11183 *resObjPtrPtr
= JimInterpolateTokens(interp
, script
->token
, script
->len
, flags
);
11186 Jim_DecrRefCount(interp
, substObjPtr
);
11187 if (*resObjPtrPtr
== NULL
) {
11193 /* -----------------------------------------------------------------------------
11194 * Core commands utility functions
11195 * ---------------------------------------------------------------------------*/
11196 void Jim_WrongNumArgs(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, const char *msg
)
11199 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, argv
, argc
);
11202 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, msg
, -1));
11204 Jim_IncrRefCount(listObjPtr
);
11205 objPtr
= Jim_ListJoin(interp
, listObjPtr
, " ", 1);
11206 Jim_DecrRefCount(interp
, listObjPtr
);
11208 Jim_IncrRefCount(objPtr
);
11209 Jim_SetResultFormatted(interp
, "wrong # args: should be \"%#s\"", objPtr
);
11210 Jim_DecrRefCount(interp
, objPtr
);
11214 * May add the key and/or value to the list.
11216 typedef void JimHashtableIteratorCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11217 Jim_HashEntry
*he
, int type
);
11219 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11222 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11223 * invoke the callback to add entries to a list.
11224 * Returns the list.
11226 static Jim_Obj
*JimHashtablePatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
11227 JimHashtableIteratorCallbackType
*callback
, int type
)
11230 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
11232 /* Check for the non-pattern case. We can do this much more efficiently. */
11233 if (patternObjPtr
&& JimTrivialMatch(Jim_String(patternObjPtr
))) {
11234 he
= Jim_FindHashEntry(ht
, Jim_String(patternObjPtr
));
11236 callback(interp
, listObjPtr
, he
, type
);
11240 Jim_HashTableIterator htiter
;
11241 JimInitHashTableIterator(ht
, &htiter
);
11242 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
11243 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), he
->key
, 0)) {
11244 callback(interp
, listObjPtr
, he
, type
);
11251 /* Keep these in order */
11252 #define JIM_CMDLIST_COMMANDS 0
11253 #define JIM_CMDLIST_PROCS 1
11254 #define JIM_CMDLIST_CHANNELS 2
11257 * Adds matching command names (procs, channels) to the list.
11259 static void JimCommandMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11260 Jim_HashEntry
*he
, int type
)
11262 Jim_Cmd
*cmdPtr
= Jim_GetHashEntryVal(he
);
11265 if (type
== JIM_CMDLIST_PROCS
&& !cmdPtr
->isproc
) {
11270 objPtr
= Jim_NewStringObj(interp
, he
->key
, -1);
11271 Jim_IncrRefCount(objPtr
);
11273 if (type
!= JIM_CMDLIST_CHANNELS
|| Jim_AioFilehandle(interp
, objPtr
)) {
11274 Jim_ListAppendElement(interp
, listObjPtr
, objPtr
);
11276 Jim_DecrRefCount(interp
, objPtr
);
11279 /* type is JIM_CMDLIST_xxx */
11280 static Jim_Obj
*JimCommandsList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int type
)
11282 return JimHashtablePatternMatch(interp
, &interp
->commands
, patternObjPtr
, JimCommandMatch
, type
);
11285 /* Keep these in order */
11286 #define JIM_VARLIST_GLOBALS 0
11287 #define JIM_VARLIST_LOCALS 1
11288 #define JIM_VARLIST_VARS 2
11290 #define JIM_VARLIST_VALUES 0x1000
11293 * Adds matching variable names to the list.
11295 static void JimVariablesMatch(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
,
11296 Jim_HashEntry
*he
, int type
)
11298 Jim_Var
*varPtr
= Jim_GetHashEntryVal(he
);
11300 if (type
!= JIM_VARLIST_LOCALS
|| varPtr
->linkFramePtr
== NULL
) {
11301 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, he
->key
, -1));
11302 if (type
& JIM_VARLIST_VALUES
) {
11303 Jim_ListAppendElement(interp
, listObjPtr
, varPtr
->objPtr
);
11308 /* mode is JIM_VARLIST_xxx */
11309 static Jim_Obj
*JimVariablesList(Jim_Interp
*interp
, Jim_Obj
*patternObjPtr
, int mode
)
11311 if (mode
== JIM_VARLIST_LOCALS
&& interp
->framePtr
== interp
->topFramePtr
) {
11312 /* For [info locals], if we are at top level an emtpy list
11313 * is returned. I don't agree, but we aim at compatibility (SS) */
11314 return interp
->emptyObj
;
11317 Jim_CallFrame
*framePtr
= (mode
== JIM_VARLIST_GLOBALS
) ? interp
->topFramePtr
: interp
->framePtr
;
11318 return JimHashtablePatternMatch(interp
, &framePtr
->vars
, patternObjPtr
, JimVariablesMatch
, mode
);
11322 static int JimInfoLevel(Jim_Interp
*interp
, Jim_Obj
*levelObjPtr
,
11323 Jim_Obj
**objPtrPtr
, int info_level_cmd
)
11325 Jim_CallFrame
*targetCallFrame
;
11327 targetCallFrame
= JimGetCallFrameByInteger(interp
, levelObjPtr
);
11328 if (targetCallFrame
== NULL
) {
11331 /* No proc call at toplevel callframe */
11332 if (targetCallFrame
== interp
->topFramePtr
) {
11333 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", levelObjPtr
);
11336 if (info_level_cmd
) {
11337 *objPtrPtr
= Jim_NewListObj(interp
, targetCallFrame
->argv
, targetCallFrame
->argc
);
11340 Jim_Obj
*listObj
= Jim_NewListObj(interp
, NULL
, 0);
11342 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->argv
[0]);
11343 Jim_ListAppendElement(interp
, listObj
, targetCallFrame
->fileNameObj
);
11344 Jim_ListAppendElement(interp
, listObj
, Jim_NewIntObj(interp
, targetCallFrame
->line
));
11345 *objPtrPtr
= listObj
;
11350 /* -----------------------------------------------------------------------------
11352 * ---------------------------------------------------------------------------*/
11354 /* fake [puts] -- not the real puts, just for debugging. */
11355 static int Jim_PutsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11357 if (argc
!= 2 && argc
!= 3) {
11358 Jim_WrongNumArgs(interp
, 1, argv
, "?-nonewline? string");
11362 if (!Jim_CompareStringImmediate(interp
, argv
[1], "-nonewline")) {
11363 Jim_SetResultString(interp
, "The second argument must " "be -nonewline", -1);
11367 fputs(Jim_String(argv
[2]), stdout
);
11371 puts(Jim_String(argv
[1]));
11376 /* Helper for [+] and [*] */
11377 static int JimAddMulHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11379 jim_wide wideValue
, res
;
11380 double doubleValue
, doubleRes
;
11383 res
= (op
== JIM_EXPROP_ADD
) ? 0 : 1;
11385 for (i
= 1; i
< argc
; i
++) {
11386 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
)
11388 if (op
== JIM_EXPROP_ADD
)
11393 Jim_SetResultInt(interp
, res
);
11396 doubleRes
= (double)res
;
11397 for (; i
< argc
; i
++) {
11398 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11400 if (op
== JIM_EXPROP_ADD
)
11401 doubleRes
+= doubleValue
;
11403 doubleRes
*= doubleValue
;
11405 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11409 /* Helper for [-] and [/] */
11410 static int JimSubDivHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int op
)
11412 jim_wide wideValue
, res
= 0;
11413 double doubleValue
, doubleRes
= 0;
11417 Jim_WrongNumArgs(interp
, 1, argv
, "number ?number ... number?");
11420 else if (argc
== 2) {
11421 /* The arity = 2 case is different. For [- x] returns -x,
11422 * while [/ x] returns 1/x. */
11423 if (Jim_GetWide(interp
, argv
[1], &wideValue
) != JIM_OK
) {
11424 if (Jim_GetDouble(interp
, argv
[1], &doubleValue
) != JIM_OK
) {
11428 if (op
== JIM_EXPROP_SUB
)
11429 doubleRes
= -doubleValue
;
11431 doubleRes
= 1.0 / doubleValue
;
11432 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11436 if (op
== JIM_EXPROP_SUB
) {
11438 Jim_SetResultInt(interp
, res
);
11441 doubleRes
= 1.0 / wideValue
;
11442 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11447 if (Jim_GetWide(interp
, argv
[1], &res
) != JIM_OK
) {
11448 if (Jim_GetDouble(interp
, argv
[1], &doubleRes
)
11457 for (i
= 2; i
< argc
; i
++) {
11458 if (Jim_GetWide(interp
, argv
[i
], &wideValue
) != JIM_OK
) {
11459 doubleRes
= (double)res
;
11462 if (op
== JIM_EXPROP_SUB
)
11467 Jim_SetResultInt(interp
, res
);
11470 for (; i
< argc
; i
++) {
11471 if (Jim_GetDouble(interp
, argv
[i
], &doubleValue
) != JIM_OK
)
11473 if (op
== JIM_EXPROP_SUB
)
11474 doubleRes
-= doubleValue
;
11476 doubleRes
/= doubleValue
;
11478 Jim_SetResult(interp
, Jim_NewDoubleObj(interp
, doubleRes
));
11484 static int Jim_AddCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11486 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_ADD
);
11490 static int Jim_MulCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11492 return JimAddMulHelper(interp
, argc
, argv
, JIM_EXPROP_MUL
);
11496 static int Jim_SubCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11498 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_SUB
);
11502 static int Jim_DivCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11504 return JimSubDivHelper(interp
, argc
, argv
, JIM_EXPROP_DIV
);
11508 static int Jim_SetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11510 if (argc
!= 2 && argc
!= 3) {
11511 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?newValue?");
11517 objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11520 Jim_SetResult(interp
, objPtr
);
11523 /* argc == 3 case. */
11524 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
11526 Jim_SetResult(interp
, argv
[2]);
11532 * unset ?-nocomplain? ?--? ?varName ...?
11534 static int Jim_UnsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11540 if (Jim_CompareStringImmediate(interp
, argv
[i
], "--")) {
11544 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-nocomplain")) {
11553 if (Jim_UnsetVariable(interp
, argv
[i
], complain
? JIM_ERRMSG
: JIM_NONE
) != JIM_OK
11563 static int Jim_WhileCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11566 Jim_WrongNumArgs(interp
, 1, argv
, "condition body");
11570 /* The general purpose implementation of while starts here */
11572 int boolean
, retval
;
11574 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[1], &boolean
)) != JIM_OK
)
11579 if ((retval
= Jim_EvalObj(interp
, argv
[2])) != JIM_OK
) {
11593 Jim_SetEmptyResult(interp
);
11598 static int Jim_ForCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11602 Jim_Obj
*varNamePtr
= NULL
;
11603 Jim_Obj
*stopVarNamePtr
= NULL
;
11606 Jim_WrongNumArgs(interp
, 1, argv
, "start test next body");
11610 /* Do the initialisation */
11611 if ((retval
= Jim_EvalObj(interp
, argv
[1])) != JIM_OK
) {
11615 /* And do the first test now. Better for optimisation
11616 * if we can do next/test at the bottom of the loop
11618 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11620 /* Ready to do the body as follows:
11622 * body // check retcode
11623 * next // check retcode
11624 * test // check retcode/test bool
11628 #ifdef JIM_OPTIMIZATION
11629 /* Check if the for is on the form:
11630 * for ... {$i < CONST} {incr i}
11631 * for ... {$i < $j} {incr i}
11633 if (retval
== JIM_OK
&& boolean
) {
11634 ScriptObj
*incrScript
;
11635 ExprByteCode
*expr
;
11636 jim_wide stop
, currentVal
;
11640 /* Do it only if there aren't shared arguments */
11641 expr
= JimGetExpression(interp
, argv
[2]);
11642 incrScript
= Jim_GetScript(interp
, argv
[3]);
11644 /* Ensure proper lengths to start */
11645 if (incrScript
== NULL
|| incrScript
->len
!= 3 || !expr
|| expr
->len
!= 3) {
11648 /* Ensure proper token types. */
11649 if (incrScript
->token
[1].type
!= JIM_TT_ESC
||
11650 expr
->token
[0].type
!= JIM_TT_VAR
||
11651 (expr
->token
[1].type
!= JIM_TT_EXPR_INT
&& expr
->token
[1].type
!= JIM_TT_VAR
)) {
11655 if (expr
->token
[2].type
== JIM_EXPROP_LT
) {
11658 else if (expr
->token
[2].type
== JIM_EXPROP_LTE
) {
11665 /* Update command must be incr */
11666 if (!Jim_CompareStringImmediate(interp
, incrScript
->token
[1].objPtr
, "incr")) {
11670 /* incr, expression must be about the same variable */
11671 if (!Jim_StringEqObj(incrScript
->token
[2].objPtr
, expr
->token
[0].objPtr
)) {
11675 /* Get the stop condition (must be a variable or integer) */
11676 if (expr
->token
[1].type
== JIM_TT_EXPR_INT
) {
11677 if (Jim_GetWide(interp
, expr
->token
[1].objPtr
, &stop
) == JIM_ERR
) {
11682 stopVarNamePtr
= expr
->token
[1].objPtr
;
11683 Jim_IncrRefCount(stopVarNamePtr
);
11684 /* Keep the compiler happy */
11688 /* Initialization */
11689 varNamePtr
= expr
->token
[0].objPtr
;
11690 Jim_IncrRefCount(varNamePtr
);
11692 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_NONE
);
11693 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
) {
11697 /* --- OPTIMIZED FOR --- */
11698 while (retval
== JIM_OK
) {
11699 /* === Check condition === */
11700 /* Note that currentVal is already set here */
11702 /* Immediate or Variable? get the 'stop' value if the latter. */
11703 if (stopVarNamePtr
) {
11704 objPtr
= Jim_GetVariable(interp
, stopVarNamePtr
, JIM_NONE
);
11705 if (objPtr
== NULL
|| Jim_GetWide(interp
, objPtr
, &stop
) != JIM_OK
) {
11710 if (currentVal
>= stop
+ cmpOffset
) {
11715 retval
= Jim_EvalObj(interp
, argv
[4]);
11716 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11719 objPtr
= Jim_GetVariable(interp
, varNamePtr
, JIM_ERRMSG
);
11722 if (objPtr
== NULL
) {
11726 if (!Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11727 currentVal
= ++JimWideValue(objPtr
);
11728 Jim_InvalidateStringRep(objPtr
);
11731 if (Jim_GetWide(interp
, objPtr
, ¤tVal
) != JIM_OK
||
11732 Jim_SetVariable(interp
, varNamePtr
, Jim_NewIntObj(interp
,
11733 ++currentVal
)) != JIM_OK
) {
11744 while (boolean
&& (retval
== JIM_OK
|| retval
== JIM_CONTINUE
)) {
11746 retval
= Jim_EvalObj(interp
, argv
[4]);
11748 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11751 retval
= Jim_EvalObj(interp
, argv
[3]);
11752 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11755 retval
= Jim_GetBoolFromExpr(interp
, argv
[2], &boolean
);
11760 if (stopVarNamePtr
) {
11761 Jim_DecrRefCount(interp
, stopVarNamePtr
);
11764 Jim_DecrRefCount(interp
, varNamePtr
);
11767 if (retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
|| retval
== JIM_OK
) {
11768 Jim_SetEmptyResult(interp
);
11776 static int Jim_LoopCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11782 Jim_Obj
*bodyObjPtr
;
11784 if (argc
!= 5 && argc
!= 6) {
11785 Jim_WrongNumArgs(interp
, 1, argv
, "var first limit ?incr? body");
11789 if (Jim_GetWide(interp
, argv
[2], &i
) != JIM_OK
||
11790 Jim_GetWide(interp
, argv
[3], &limit
) != JIM_OK
||
11791 (argc
== 6 && Jim_GetWide(interp
, argv
[4], &incr
) != JIM_OK
)) {
11794 bodyObjPtr
= (argc
== 5) ? argv
[4] : argv
[5];
11796 retval
= Jim_SetVariable(interp
, argv
[1], argv
[2]);
11798 while (((i
< limit
&& incr
> 0) || (i
> limit
&& incr
< 0)) && retval
== JIM_OK
) {
11799 retval
= Jim_EvalObj(interp
, bodyObjPtr
);
11800 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
) {
11801 Jim_Obj
*objPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
11808 if (objPtr
&& !Jim_IsShared(objPtr
) && objPtr
->typePtr
== &intObjType
) {
11809 if (argv
[1]->typePtr
!= &variableObjType
) {
11810 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11814 JimWideValue(objPtr
) = i
;
11815 Jim_InvalidateStringRep(objPtr
);
11817 /* The following step is required in order to invalidate the
11818 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11819 if (argv
[1]->typePtr
!= &variableObjType
) {
11820 if (Jim_SetVariable(interp
, argv
[1], objPtr
) != JIM_OK
) {
11827 objPtr
= Jim_NewIntObj(interp
, i
);
11828 retval
= Jim_SetVariable(interp
, argv
[1], objPtr
);
11829 if (retval
!= JIM_OK
) {
11830 Jim_FreeNewObj(interp
, objPtr
);
11836 if (retval
== JIM_OK
|| retval
== JIM_CONTINUE
|| retval
== JIM_BREAK
) {
11837 Jim_SetEmptyResult(interp
);
11843 /* List iterators make it easy to iterate over a list.
11844 * At some point iterators will be expanded to support generators.
11852 * Initialise the iterator at the start of the list.
11854 static void JimListIterInit(Jim_ListIter
*iter
, Jim_Obj
*objPtr
)
11856 iter
->objPtr
= objPtr
;
11861 * Returns the next object from the list, or NULL on end-of-list.
11863 static Jim_Obj
*JimListIterNext(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11865 if (iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
)) {
11868 return iter
->objPtr
->internalRep
.listValue
.ele
[iter
->idx
++];
11872 * Returns 1 if end-of-list has been reached.
11874 static int JimListIterDone(Jim_Interp
*interp
, Jim_ListIter
*iter
)
11876 return iter
->idx
>= Jim_ListLength(interp
, iter
->objPtr
);
11879 /* foreach + lmap implementation. */
11880 static int JimForeachMapHelper(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
, int doMap
)
11882 int result
= JIM_OK
;
11884 Jim_ListIter twoiters
[2]; /* Avoid allocation for a single list */
11885 Jim_ListIter
*iters
;
11887 Jim_Obj
*resultObj
;
11889 if (argc
< 4 || argc
% 2 != 0) {
11890 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varList list ...? script");
11893 script
= argv
[argc
- 1]; /* Last argument is a script */
11894 numargs
= (argc
- 1 - 1); /* argc - 'foreach' - script */
11896 if (numargs
== 2) {
11900 iters
= Jim_Alloc(numargs
* sizeof(*iters
));
11902 for (i
= 0; i
< numargs
; i
++) {
11903 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11904 if (i
% 2 == 0 && JimListIterDone(interp
, &iters
[i
])) {
11908 if (result
!= JIM_OK
) {
11909 Jim_SetResultString(interp
, "foreach varlist is empty", -1);
11914 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
11917 resultObj
= interp
->emptyObj
;
11919 Jim_IncrRefCount(resultObj
);
11922 /* Have we expired all lists? */
11923 for (i
= 0; i
< numargs
; i
+= 2) {
11924 if (!JimListIterDone(interp
, &iters
[i
+ 1])) {
11928 if (i
== numargs
) {
11933 /* For each list */
11934 for (i
= 0; i
< numargs
; i
+= 2) {
11938 JimListIterInit(&iters
[i
], argv
[i
+ 1]);
11939 while ((varName
= JimListIterNext(interp
, &iters
[i
])) != NULL
) {
11940 Jim_Obj
*valObj
= JimListIterNext(interp
, &iters
[i
+ 1]);
11942 /* Ran out, so store the empty string */
11943 valObj
= interp
->emptyObj
;
11945 /* Avoid shimmering */
11946 Jim_IncrRefCount(valObj
);
11947 result
= Jim_SetVariable(interp
, varName
, valObj
);
11948 Jim_DecrRefCount(interp
, valObj
);
11949 if (result
!= JIM_OK
) {
11954 switch (result
= Jim_EvalObj(interp
, script
)) {
11957 Jim_ListAppendElement(interp
, resultObj
, interp
->result
);
11970 Jim_SetResult(interp
, resultObj
);
11972 Jim_DecrRefCount(interp
, resultObj
);
11980 static int Jim_ForeachCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11982 return JimForeachMapHelper(interp
, argc
, argv
, 0);
11986 static int Jim_LmapCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11988 return JimForeachMapHelper(interp
, argc
, argv
, 1);
11992 static int Jim_LassignCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
11994 int result
= JIM_ERR
;
11997 Jim_Obj
*resultObj
;
12000 Jim_WrongNumArgs(interp
, 1, argv
, "varList list ?varName ...?");
12004 JimListIterInit(&iter
, argv
[1]);
12006 for (i
= 2; i
< argc
; i
++) {
12007 Jim_Obj
*valObj
= JimListIterNext(interp
, &iter
);
12008 result
= Jim_SetVariable(interp
, argv
[i
], valObj
? valObj
: interp
->emptyObj
);
12009 if (result
!= JIM_OK
) {
12014 resultObj
= Jim_NewListObj(interp
, NULL
, 0);
12015 while (!JimListIterDone(interp
, &iter
)) {
12016 Jim_ListAppendElement(interp
, resultObj
, JimListIterNext(interp
, &iter
));
12019 Jim_SetResult(interp
, resultObj
);
12025 static int Jim_IfCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12027 int boolean
, retval
, current
= 1, falsebody
= 0;
12031 /* Far not enough arguments given! */
12032 if (current
>= argc
)
12034 if ((retval
= Jim_GetBoolFromExpr(interp
, argv
[current
++], &boolean
))
12037 /* There lacks something, isn't it? */
12038 if (current
>= argc
)
12040 if (Jim_CompareStringImmediate(interp
, argv
[current
], "then"))
12042 /* Tsk tsk, no then-clause? */
12043 if (current
>= argc
)
12046 return Jim_EvalObj(interp
, argv
[current
]);
12047 /* Ok: no else-clause follows */
12048 if (++current
>= argc
) {
12049 Jim_SetResult(interp
, Jim_NewEmptyStringObj(interp
));
12052 falsebody
= current
++;
12053 if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "else")) {
12054 /* IIICKS - else-clause isn't last cmd? */
12055 if (current
!= argc
- 1)
12057 return Jim_EvalObj(interp
, argv
[current
]);
12059 else if (Jim_CompareStringImmediate(interp
, argv
[falsebody
], "elseif"))
12060 /* Ok: elseif follows meaning all the stuff
12061 * again (how boring...) */
12063 /* OOPS - else-clause is not last cmd? */
12064 else if (falsebody
!= argc
- 1)
12066 return Jim_EvalObj(interp
, argv
[falsebody
]);
12071 Jim_WrongNumArgs(interp
, 1, argv
, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12076 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12077 int Jim_CommandMatchObj(Jim_Interp
*interp
, Jim_Obj
*commandObj
, Jim_Obj
*patternObj
,
12078 Jim_Obj
*stringObj
, int nocase
)
12085 parms
[argc
++] = commandObj
;
12087 parms
[argc
++] = Jim_NewStringObj(interp
, "-nocase", -1);
12089 parms
[argc
++] = patternObj
;
12090 parms
[argc
++] = stringObj
;
12092 rc
= Jim_EvalObjVector(interp
, argc
, parms
);
12094 if (rc
!= JIM_OK
|| Jim_GetLong(interp
, Jim_GetResult(interp
), &eq
) != JIM_OK
) {
12102 { SWITCH_EXACT
, SWITCH_GLOB
, SWITCH_RE
, SWITCH_CMD
};
12105 static int Jim_SwitchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12107 int matchOpt
= SWITCH_EXACT
, opt
= 1, patCount
, i
;
12108 Jim_Obj
*command
= 0, *const *caseList
= 0, *strObj
;
12109 Jim_Obj
*script
= 0;
12113 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string "
12114 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12117 for (opt
= 1; opt
< argc
; ++opt
) {
12118 const char *option
= Jim_String(argv
[opt
]);
12120 if (*option
!= '-')
12122 else if (strncmp(option
, "--", 2) == 0) {
12126 else if (strncmp(option
, "-exact", 2) == 0)
12127 matchOpt
= SWITCH_EXACT
;
12128 else if (strncmp(option
, "-glob", 2) == 0)
12129 matchOpt
= SWITCH_GLOB
;
12130 else if (strncmp(option
, "-regexp", 2) == 0)
12131 matchOpt
= SWITCH_RE
;
12132 else if (strncmp(option
, "-command", 2) == 0) {
12133 matchOpt
= SWITCH_CMD
;
12134 if ((argc
- opt
) < 2)
12136 command
= argv
[++opt
];
12139 Jim_SetResultFormatted(interp
,
12140 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12144 if ((argc
- opt
) < 2)
12147 strObj
= argv
[opt
++];
12148 patCount
= argc
- opt
;
12149 if (patCount
== 1) {
12152 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12156 caseList
= &argv
[opt
];
12157 if (patCount
== 0 || patCount
% 2 != 0)
12159 for (i
= 0; script
== 0 && i
< patCount
; i
+= 2) {
12160 Jim_Obj
*patObj
= caseList
[i
];
12162 if (!Jim_CompareStringImmediate(interp
, patObj
, "default")
12163 || i
< (patCount
- 2)) {
12164 switch (matchOpt
) {
12166 if (Jim_StringEqObj(strObj
, patObj
))
12167 script
= caseList
[i
+ 1];
12170 if (Jim_StringMatchObj(interp
, patObj
, strObj
, 0))
12171 script
= caseList
[i
+ 1];
12174 command
= Jim_NewStringObj(interp
, "regexp", -1);
12175 /* Fall thru intentionally */
12177 int rc
= Jim_CommandMatchObj(interp
, command
, patObj
, strObj
, 0);
12179 /* After the execution of a command we need to
12180 * make sure to reconvert the object into a list
12181 * again. Only for the single-list style [switch]. */
12182 if (argc
- opt
== 1) {
12185 JimListGetElements(interp
, argv
[opt
], &patCount
, &vector
);
12188 /* command is here already decref'd */
12193 script
= caseList
[i
+ 1];
12199 script
= caseList
[i
+ 1];
12202 for (; i
< patCount
&& Jim_CompareStringImmediate(interp
, script
, "-"); i
+= 2)
12203 script
= caseList
[i
+ 1];
12204 if (script
&& Jim_CompareStringImmediate(interp
, script
, "-")) {
12205 Jim_SetResultFormatted(interp
, "no body specified for pattern \"%#s\"", caseList
[i
- 2]);
12208 Jim_SetEmptyResult(interp
);
12210 return Jim_EvalObj(interp
, script
);
12216 static int Jim_ListCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12218 Jim_Obj
*listObjPtr
;
12220 listObjPtr
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
12221 Jim_SetResult(interp
, listObjPtr
);
12226 static int Jim_LindexCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12228 Jim_Obj
*objPtr
, *listObjPtr
;
12233 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?...?");
12237 Jim_IncrRefCount(objPtr
);
12238 for (i
= 2; i
< argc
; i
++) {
12239 listObjPtr
= objPtr
;
12240 if (Jim_GetIndex(interp
, argv
[i
], &idx
) != JIM_OK
) {
12241 Jim_DecrRefCount(interp
, listObjPtr
);
12244 if (Jim_ListIndex(interp
, listObjPtr
, idx
, &objPtr
, JIM_NONE
) != JIM_OK
) {
12245 /* Returns an empty object if the index
12246 * is out of range. */
12247 Jim_DecrRefCount(interp
, listObjPtr
);
12248 Jim_SetEmptyResult(interp
);
12251 Jim_IncrRefCount(objPtr
);
12252 Jim_DecrRefCount(interp
, listObjPtr
);
12254 Jim_SetResult(interp
, objPtr
);
12255 Jim_DecrRefCount(interp
, objPtr
);
12260 static int Jim_LlengthCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12263 Jim_WrongNumArgs(interp
, 1, argv
, "list");
12266 Jim_SetResultInt(interp
, Jim_ListLength(interp
, argv
[1]));
12271 static int Jim_LsearchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12273 static const char * const options
[] = {
12274 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12278 { OPT_BOOL
, OPT_NOT
, OPT_NOCASE
, OPT_EXACT
, OPT_GLOB
, OPT_REGEXP
, OPT_ALL
, OPT_INLINE
,
12283 int opt_nocase
= 0;
12285 int opt_inline
= 0;
12286 int opt_match
= OPT_EXACT
;
12289 Jim_Obj
*listObjPtr
= NULL
;
12290 Jim_Obj
*commandObj
= NULL
;
12294 Jim_WrongNumArgs(interp
, 1, argv
,
12295 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12299 for (i
= 1; i
< argc
- 2; i
++) {
12302 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ERRMSG
) != JIM_OK
) {
12324 if (i
>= argc
- 2) {
12327 commandObj
= argv
[++i
];
12332 opt_match
= option
;
12340 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12342 if (opt_match
== OPT_REGEXP
) {
12343 commandObj
= Jim_NewStringObj(interp
, "regexp", -1);
12346 Jim_IncrRefCount(commandObj
);
12349 listlen
= Jim_ListLength(interp
, argv
[0]);
12350 for (i
= 0; i
< listlen
; i
++) {
12352 Jim_Obj
*objPtr
= Jim_ListGetIndex(interp
, argv
[0], i
);
12354 switch (opt_match
) {
12356 eq
= Jim_StringCompareObj(interp
, argv
[1], objPtr
, opt_nocase
) == 0;
12360 eq
= Jim_StringMatchObj(interp
, argv
[1], objPtr
, opt_nocase
);
12365 eq
= Jim_CommandMatchObj(interp
, commandObj
, argv
[1], objPtr
, opt_nocase
);
12368 Jim_FreeNewObj(interp
, listObjPtr
);
12376 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12377 if (!eq
&& opt_bool
&& opt_not
&& !opt_all
) {
12381 if ((!opt_bool
&& eq
== !opt_not
) || (opt_bool
&& (eq
|| opt_all
))) {
12382 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12383 Jim_Obj
*resultObj
;
12386 resultObj
= Jim_NewIntObj(interp
, eq
^ opt_not
);
12388 else if (!opt_inline
) {
12389 resultObj
= Jim_NewIntObj(interp
, i
);
12392 resultObj
= objPtr
;
12396 Jim_ListAppendElement(interp
, listObjPtr
, resultObj
);
12399 Jim_SetResult(interp
, resultObj
);
12406 Jim_SetResult(interp
, listObjPtr
);
12411 Jim_SetResultBool(interp
, opt_not
);
12413 else if (!opt_inline
) {
12414 Jim_SetResultInt(interp
, -1);
12420 Jim_DecrRefCount(interp
, commandObj
);
12426 static int Jim_LappendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12428 Jim_Obj
*listObjPtr
;
12432 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12435 listObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12437 /* Create the list if it does not exists */
12438 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12439 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12440 Jim_FreeNewObj(interp
, listObjPtr
);
12444 shared
= Jim_IsShared(listObjPtr
);
12446 listObjPtr
= Jim_DuplicateObj(interp
, listObjPtr
);
12447 for (i
= 2; i
< argc
; i
++)
12448 Jim_ListAppendElement(interp
, listObjPtr
, argv
[i
]);
12449 if (Jim_SetVariable(interp
, argv
[1], listObjPtr
) != JIM_OK
) {
12451 Jim_FreeNewObj(interp
, listObjPtr
);
12454 Jim_SetResult(interp
, listObjPtr
);
12459 static int Jim_LinsertCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12465 Jim_WrongNumArgs(interp
, 1, argv
, "list index ?element ...?");
12469 if (Jim_IsShared(listPtr
))
12470 listPtr
= Jim_DuplicateObj(interp
, listPtr
);
12471 if (Jim_GetIndex(interp
, argv
[2], &idx
) != JIM_OK
)
12473 len
= Jim_ListLength(interp
, listPtr
);
12477 idx
= len
+ idx
+ 1;
12478 Jim_ListInsertElements(interp
, listPtr
, idx
, argc
- 3, &argv
[3]);
12479 Jim_SetResult(interp
, listPtr
);
12482 if (listPtr
!= argv
[1]) {
12483 Jim_FreeNewObj(interp
, listPtr
);
12489 static int Jim_LreplaceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12491 int first
, last
, len
, rangeLen
;
12493 Jim_Obj
*newListObj
;
12496 Jim_WrongNumArgs(interp
, 1, argv
, "list first last ?element ...?");
12499 if (Jim_GetIndex(interp
, argv
[2], &first
) != JIM_OK
||
12500 Jim_GetIndex(interp
, argv
[3], &last
) != JIM_OK
) {
12505 len
= Jim_ListLength(interp
, listObj
);
12507 first
= JimRelToAbsIndex(len
, first
);
12508 last
= JimRelToAbsIndex(len
, last
);
12509 JimRelToAbsRange(len
, &first
, &last
, &rangeLen
);
12511 /* Now construct a new list which consists of:
12512 * <elements before first> <supplied elements> <elements after last>
12515 /* Check to see if trying to replace past the end of the list */
12517 /* OK. Not past the end */
12519 else if (len
== 0) {
12520 /* Special for empty list, adjust first to 0 */
12524 Jim_SetResultString(interp
, "list doesn't contain element ", -1);
12525 Jim_AppendObj(interp
, Jim_GetResult(interp
), argv
[2]);
12529 /* Add the first set of elements */
12530 newListObj
= Jim_NewListObj(interp
, listObj
->internalRep
.listValue
.ele
, first
);
12532 /* Add supplied elements */
12533 ListInsertElements(newListObj
, -1, argc
- 4, argv
+ 4);
12535 /* Add the remaining elements */
12536 ListInsertElements(newListObj
, -1, len
- first
- rangeLen
, listObj
->internalRep
.listValue
.ele
+ first
+ rangeLen
);
12538 Jim_SetResult(interp
, newListObj
);
12543 static int Jim_LsetCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12546 Jim_WrongNumArgs(interp
, 1, argv
, "listVar ?index...? newVal");
12549 else if (argc
== 3) {
12550 /* With no indexes, simply implements [set] */
12551 if (Jim_SetVariable(interp
, argv
[1], argv
[2]) != JIM_OK
)
12553 Jim_SetResult(interp
, argv
[2]);
12556 return Jim_ListSetIndex(interp
, argv
[1], argv
+ 2, argc
- 3, argv
[argc
- 1]);
12560 static int Jim_LsortCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const argv
[])
12562 static const char * const options
[] = {
12563 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12566 { OPT_ASCII
, OPT_NOCASE
, OPT_INCREASING
, OPT_DECREASING
, OPT_COMMAND
, OPT_INTEGER
, OPT_REAL
, OPT_INDEX
, OPT_UNIQUE
};
12571 struct lsort_info info
;
12574 Jim_WrongNumArgs(interp
, 1, argv
, "?options? list");
12578 info
.type
= JIM_LSORT_ASCII
;
12582 info
.command
= NULL
;
12583 info
.interp
= interp
;
12585 for (i
= 1; i
< (argc
- 1); i
++) {
12588 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
, JIM_ENUM_ABBREV
| JIM_ERRMSG
)
12593 info
.type
= JIM_LSORT_ASCII
;
12596 info
.type
= JIM_LSORT_NOCASE
;
12599 info
.type
= JIM_LSORT_INTEGER
;
12602 info
.type
= JIM_LSORT_REAL
;
12604 case OPT_INCREASING
:
12607 case OPT_DECREASING
:
12614 if (i
>= (argc
- 2)) {
12615 Jim_SetResultString(interp
, "\"-command\" option must be followed by comparison command", -1);
12618 info
.type
= JIM_LSORT_COMMAND
;
12619 info
.command
= argv
[i
+ 1];
12623 if (i
>= (argc
- 2)) {
12624 Jim_SetResultString(interp
, "\"-index\" option must be followed by list index", -1);
12627 if (Jim_GetIndex(interp
, argv
[i
+ 1], &info
.index
) != JIM_OK
) {
12635 resObj
= Jim_DuplicateObj(interp
, argv
[argc
- 1]);
12636 retCode
= ListSortElements(interp
, resObj
, &info
);
12637 if (retCode
== JIM_OK
) {
12638 Jim_SetResult(interp
, resObj
);
12641 Jim_FreeNewObj(interp
, resObj
);
12647 static int Jim_AppendCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12649 Jim_Obj
*stringObjPtr
;
12653 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?value value ...?");
12657 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_ERRMSG
);
12663 stringObjPtr
= Jim_GetVariable(interp
, argv
[1], JIM_UNSHARED
);
12664 if (!stringObjPtr
) {
12665 /* Create the string if it doesn't exist */
12666 stringObjPtr
= Jim_NewEmptyStringObj(interp
);
12669 else if (Jim_IsShared(stringObjPtr
)) {
12671 stringObjPtr
= Jim_DuplicateObj(interp
, stringObjPtr
);
12673 for (i
= 2; i
< argc
; i
++) {
12674 Jim_AppendObj(interp
, stringObjPtr
, argv
[i
]);
12676 if (Jim_SetVariable(interp
, argv
[1], stringObjPtr
) != JIM_OK
) {
12678 Jim_FreeNewObj(interp
, stringObjPtr
);
12683 Jim_SetResult(interp
, stringObjPtr
);
12688 static int Jim_DebugCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12690 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12691 static const char * const options
[] = {
12692 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12698 OPT_REFCOUNT
, OPT_OBJCOUNT
, OPT_OBJECTS
, OPT_INVSTR
, OPT_SCRIPTLEN
,
12699 OPT_EXPRLEN
, OPT_EXPRBC
, OPT_SHOW
,
12704 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?...?");
12707 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
)
12709 if (option
== OPT_REFCOUNT
) {
12711 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12714 Jim_SetResultInt(interp
, argv
[2]->refCount
);
12717 else if (option
== OPT_OBJCOUNT
) {
12718 int freeobj
= 0, liveobj
= 0;
12723 Jim_WrongNumArgs(interp
, 2, argv
, "");
12726 /* Count the number of free objects. */
12727 objPtr
= interp
->freeList
;
12730 objPtr
= objPtr
->nextObjPtr
;
12732 /* Count the number of live objects. */
12733 objPtr
= interp
->liveList
;
12736 objPtr
= objPtr
->nextObjPtr
;
12738 /* Set the result string and return. */
12739 sprintf(buf
, "free %d used %d", freeobj
, liveobj
);
12740 Jim_SetResultString(interp
, buf
, -1);
12743 else if (option
== OPT_OBJECTS
) {
12744 Jim_Obj
*objPtr
, *listObjPtr
, *subListObjPtr
;
12746 /* Count the number of live objects. */
12747 objPtr
= interp
->liveList
;
12748 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12751 const char *type
= objPtr
->typePtr
? objPtr
->typePtr
->name
: "";
12753 subListObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
12754 sprintf(buf
, "%p", objPtr
);
12755 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
12756 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewStringObj(interp
, type
, -1));
12757 Jim_ListAppendElement(interp
, subListObjPtr
, Jim_NewIntObj(interp
, objPtr
->refCount
));
12758 Jim_ListAppendElement(interp
, subListObjPtr
, objPtr
);
12759 Jim_ListAppendElement(interp
, listObjPtr
, subListObjPtr
);
12760 objPtr
= objPtr
->nextObjPtr
;
12762 Jim_SetResult(interp
, listObjPtr
);
12765 else if (option
== OPT_INVSTR
) {
12769 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12773 if (objPtr
->typePtr
!= NULL
)
12774 Jim_InvalidateStringRep(objPtr
);
12775 Jim_SetEmptyResult(interp
);
12778 else if (option
== OPT_SHOW
) {
12783 Jim_WrongNumArgs(interp
, 2, argv
, "object");
12786 s
= Jim_GetString(argv
[2], &len
);
12788 charlen
= utf8_strlen(s
, len
);
12792 printf("refcount: %d, type: %s\n", argv
[2]->refCount
, JimObjTypeName(argv
[2]));
12793 printf("chars (%d): <<%s>>\n", charlen
, s
);
12794 printf("bytes (%d):", len
);
12796 printf(" %02x", (unsigned char)*s
++);
12801 else if (option
== OPT_SCRIPTLEN
) {
12805 Jim_WrongNumArgs(interp
, 2, argv
, "script");
12808 script
= Jim_GetScript(interp
, argv
[2]);
12809 if (script
== NULL
)
12811 Jim_SetResultInt(interp
, script
->len
);
12814 else if (option
== OPT_EXPRLEN
) {
12815 ExprByteCode
*expr
;
12818 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12821 expr
= JimGetExpression(interp
, argv
[2]);
12824 Jim_SetResultInt(interp
, expr
->len
);
12827 else if (option
== OPT_EXPRBC
) {
12829 ExprByteCode
*expr
;
12833 Jim_WrongNumArgs(interp
, 2, argv
, "expression");
12836 expr
= JimGetExpression(interp
, argv
[2]);
12839 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
12840 for (i
= 0; i
< expr
->len
; i
++) {
12842 const Jim_ExprOperator
*op
;
12843 Jim_Obj
*obj
= expr
->token
[i
].objPtr
;
12845 switch (expr
->token
[i
].type
) {
12846 case JIM_TT_EXPR_INT
:
12849 case JIM_TT_EXPR_DOUBLE
:
12858 case JIM_TT_DICTSUGAR
:
12859 type
= "dictsugar";
12861 case JIM_TT_EXPRSUGAR
:
12862 type
= "exprsugar";
12871 op
= JimExprOperatorInfoByOpcode(expr
->token
[i
].type
);
12878 obj
= Jim_NewStringObj(interp
, op
? op
->name
: "", -1);
12881 Jim_ListAppendElement(interp
, objPtr
, Jim_NewStringObj(interp
, type
, -1));
12882 Jim_ListAppendElement(interp
, objPtr
, obj
);
12884 Jim_SetResult(interp
, objPtr
);
12888 Jim_SetResultString(interp
,
12889 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12893 #endif /* JIM_BOOTSTRAP */
12894 #if !defined(JIM_DEBUG_COMMAND)
12895 Jim_SetResultString(interp
, "unsupported", -1);
12901 static int Jim_EvalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12906 Jim_WrongNumArgs(interp
, 1, argv
, "script ?...?");
12911 rc
= Jim_EvalObj(interp
, argv
[1]);
12914 rc
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12917 if (rc
== JIM_ERR
) {
12918 /* eval is "interesting", so add a stack frame here */
12919 interp
->addStackTrace
++;
12925 static int Jim_UplevelCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12929 Jim_CallFrame
*savedCallFrame
, *targetCallFrame
;
12933 /* Save the old callframe pointer */
12934 savedCallFrame
= interp
->framePtr
;
12936 /* Lookup the target frame pointer */
12937 str
= Jim_String(argv
[1]);
12938 if ((str
[0] >= '0' && str
[0] <= '9') || str
[0] == '#') {
12939 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
12944 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
12946 if (targetCallFrame
== NULL
) {
12950 Jim_WrongNumArgs(interp
, 1, argv
- 1, "?level? command ?arg ...?");
12953 /* Eval the code in the target callframe. */
12954 interp
->framePtr
= targetCallFrame
;
12955 /* Can't merge tailcalls across upcall */
12956 savedTailcall
= interp
->framePtr
->tailcall
;
12957 interp
->framePtr
->tailcall
= 0;
12959 retcode
= Jim_EvalObj(interp
, argv
[1]);
12962 retcode
= Jim_EvalObj(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
12964 interp
->framePtr
->tailcall
= savedTailcall
;
12965 interp
->framePtr
= savedCallFrame
;
12969 Jim_WrongNumArgs(interp
, 1, argv
, "?level? command ?arg ...?");
12975 static int Jim_ExprCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
12977 Jim_Obj
*exprResultPtr
;
12981 retcode
= Jim_EvalExpression(interp
, argv
[1], &exprResultPtr
);
12983 else if (argc
> 2) {
12986 objPtr
= Jim_ConcatObj(interp
, argc
- 1, argv
+ 1);
12987 Jim_IncrRefCount(objPtr
);
12988 retcode
= Jim_EvalExpression(interp
, objPtr
, &exprResultPtr
);
12989 Jim_DecrRefCount(interp
, objPtr
);
12992 Jim_WrongNumArgs(interp
, 1, argv
, "expression ?...?");
12995 if (retcode
!= JIM_OK
)
12997 Jim_SetResult(interp
, exprResultPtr
);
12998 Jim_DecrRefCount(interp
, exprResultPtr
);
13003 static int Jim_BreakCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13006 Jim_WrongNumArgs(interp
, 1, argv
, "");
13013 static int Jim_ContinueCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13016 Jim_WrongNumArgs(interp
, 1, argv
, "");
13019 return JIM_CONTINUE
;
13023 static int Jim_ReturnCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13026 Jim_Obj
*stackTraceObj
= NULL
;
13027 Jim_Obj
*errorCodeObj
= NULL
;
13028 int returnCode
= JIM_OK
;
13031 for (i
= 1; i
< argc
- 1; i
+= 2) {
13032 if (Jim_CompareStringImmediate(interp
, argv
[i
], "-code")) {
13033 if (Jim_GetReturnCode(interp
, argv
[i
+ 1], &returnCode
) == JIM_ERR
) {
13037 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorinfo")) {
13038 stackTraceObj
= argv
[i
+ 1];
13040 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-errorcode")) {
13041 errorCodeObj
= argv
[i
+ 1];
13043 else if (Jim_CompareStringImmediate(interp
, argv
[i
], "-level")) {
13044 if (Jim_GetLong(interp
, argv
[i
+ 1], &level
) != JIM_OK
|| level
< 0) {
13045 Jim_SetResultFormatted(interp
, "bad level \"%#s\"", argv
[i
+ 1]);
13054 if (i
!= argc
- 1 && i
!= argc
) {
13055 Jim_WrongNumArgs(interp
, 1, argv
,
13056 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13059 /* If a stack trace is supplied and code is error, set the stack trace */
13060 if (stackTraceObj
&& returnCode
== JIM_ERR
) {
13061 JimSetStackTrace(interp
, stackTraceObj
);
13063 /* If an error code list is supplied, set the global $errorCode */
13064 if (errorCodeObj
&& returnCode
== JIM_ERR
) {
13065 Jim_SetGlobalVariableStr(interp
, "errorCode", errorCodeObj
);
13067 interp
->returnCode
= returnCode
;
13068 interp
->returnLevel
= level
;
13070 if (i
== argc
- 1) {
13071 Jim_SetResult(interp
, argv
[i
]);
13077 static int Jim_TailcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13079 if (interp
->framePtr
->level
== 0) {
13080 Jim_SetResultString(interp
, "tailcall can only be called from a proc or lambda", -1);
13083 else if (argc
>= 2) {
13084 /* Need to resolve the tailcall command in the current context */
13085 Jim_CallFrame
*cf
= interp
->framePtr
->parent
;
13087 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13088 if (cmdPtr
== NULL
) {
13092 JimPanic((cf
->tailcallCmd
!= NULL
, "Already have a tailcallCmd"));
13094 /* And stash this pre-resolved command */
13095 JimIncrCmdRefCount(cmdPtr
);
13096 cf
->tailcallCmd
= cmdPtr
;
13098 /* And stash the command list */
13099 JimPanic((cf
->tailcallObj
!= NULL
, "Already have a tailcallobj"));
13101 cf
->tailcallObj
= Jim_NewListObj(interp
, argv
+ 1, argc
- 1);
13102 Jim_IncrRefCount(cf
->tailcallObj
);
13104 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13110 static int JimAliasCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13113 Jim_Obj
*prefixListObj
= Jim_CmdPrivData(interp
);
13115 /* prefixListObj is a list to which the args need to be appended */
13116 cmdList
= Jim_DuplicateObj(interp
, prefixListObj
);
13117 ListInsertElements(cmdList
, -1, argc
- 1, argv
+ 1);
13119 return JimEvalObjList(interp
, cmdList
);
13122 static void JimAliasCmdDelete(Jim_Interp
*interp
, void *privData
)
13124 Jim_Obj
*prefixListObj
= privData
;
13125 Jim_DecrRefCount(interp
, prefixListObj
);
13128 static int Jim_AliasCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13130 Jim_Obj
*prefixListObj
;
13131 const char *newname
;
13134 Jim_WrongNumArgs(interp
, 1, argv
, "newname command ?args ...?");
13138 prefixListObj
= Jim_NewListObj(interp
, argv
+ 2, argc
- 2);
13139 Jim_IncrRefCount(prefixListObj
);
13140 newname
= Jim_String(argv
[1]);
13141 if (newname
[0] == ':' && newname
[1] == ':') {
13142 while (*++newname
== ':') {
13146 Jim_SetResult(interp
, argv
[1]);
13148 return Jim_CreateCommand(interp
, newname
, JimAliasCmd
, prefixListObj
, JimAliasCmdDelete
);
13152 static int Jim_ProcCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13156 if (argc
!= 4 && argc
!= 5) {
13157 Jim_WrongNumArgs(interp
, 1, argv
, "name arglist ?statics? body");
13161 if (JimValidName(interp
, "procedure", argv
[1]) != JIM_OK
) {
13166 cmd
= JimCreateProcedureCmd(interp
, argv
[2], NULL
, argv
[3], NULL
);
13169 cmd
= JimCreateProcedureCmd(interp
, argv
[2], argv
[3], argv
[4], NULL
);
13173 /* Add the new command */
13174 Jim_Obj
*qualifiedCmdNameObj
;
13175 const char *cmdname
= JimQualifyName(interp
, Jim_String(argv
[1]), &qualifiedCmdNameObj
);
13177 JimCreateCommand(interp
, cmdname
, cmd
);
13179 /* Calculate and set the namespace for this proc */
13180 JimUpdateProcNamespace(interp
, cmd
, cmdname
);
13182 JimFreeQualifiedName(interp
, qualifiedCmdNameObj
);
13184 /* Unlike Tcl, set the name of the proc as the result */
13185 Jim_SetResult(interp
, argv
[1]);
13192 static int Jim_LocalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13197 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13201 /* Evaluate the arguments with 'local' in force */
13203 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13207 /* If OK, and the result is a proc, add it to the list of local procs */
13208 if (retcode
== 0) {
13209 Jim_Obj
*cmdNameObj
= Jim_GetResult(interp
);
13211 if (Jim_GetCommand(interp
, cmdNameObj
, JIM_ERRMSG
) == NULL
) {
13214 if (interp
->framePtr
->localCommands
== NULL
) {
13215 interp
->framePtr
->localCommands
= Jim_Alloc(sizeof(*interp
->framePtr
->localCommands
));
13216 Jim_InitStack(interp
->framePtr
->localCommands
);
13218 Jim_IncrRefCount(cmdNameObj
);
13219 Jim_StackPush(interp
->framePtr
->localCommands
, cmdNameObj
);
13226 static int Jim_UpcallCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13229 Jim_WrongNumArgs(interp
, 1, argv
, "cmd ?args ...?");
13235 Jim_Cmd
*cmdPtr
= Jim_GetCommand(interp
, argv
[1], JIM_ERRMSG
);
13236 if (cmdPtr
== NULL
|| !cmdPtr
->isproc
|| !cmdPtr
->prevCmd
) {
13237 Jim_SetResultFormatted(interp
, "no previous command: \"%#s\"", argv
[1]);
13240 /* OK. Mark this command as being in an upcall */
13241 cmdPtr
->u
.proc
.upcall
++;
13242 JimIncrCmdRefCount(cmdPtr
);
13244 /* Invoke the command as normal */
13245 retcode
= Jim_EvalObjVector(interp
, argc
- 1, argv
+ 1);
13247 /* No longer in an upcall */
13248 cmdPtr
->u
.proc
.upcall
--;
13249 JimDecrCmdRefCount(interp
, cmdPtr
);
13256 static int Jim_ApplyCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13259 Jim_WrongNumArgs(interp
, 1, argv
, "lambdaExpr ?arg ...?");
13265 Jim_Obj
*argListObjPtr
;
13266 Jim_Obj
*bodyObjPtr
;
13267 Jim_Obj
*nsObj
= NULL
;
13270 int len
= Jim_ListLength(interp
, argv
[1]);
13271 if (len
!= 2 && len
!= 3) {
13272 Jim_SetResultFormatted(interp
, "can't interpret \"%#s\" as a lambda expression", argv
[1]);
13277 #ifdef jim_ext_namespace
13278 /* Need to canonicalise the given namespace. */
13279 nsObj
= JimQualifyNameObj(interp
, Jim_ListGetIndex(interp
, argv
[1], 2));
13281 Jim_SetResultString(interp
, "namespaces not enabled", -1);
13285 argListObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 0);
13286 bodyObjPtr
= Jim_ListGetIndex(interp
, argv
[1], 1);
13288 cmd
= JimCreateProcedureCmd(interp
, argListObjPtr
, NULL
, bodyObjPtr
, nsObj
);
13291 /* Create a new argv array with a dummy argv[0], for error messages */
13292 nargv
= Jim_Alloc((argc
- 2 + 1) * sizeof(*nargv
));
13293 nargv
[0] = Jim_NewStringObj(interp
, "apply lambdaExpr", -1);
13294 Jim_IncrRefCount(nargv
[0]);
13295 memcpy(&nargv
[1], argv
+ 2, (argc
- 2) * sizeof(*nargv
));
13296 ret
= JimCallProcedure(interp
, cmd
, argc
- 2 + 1, nargv
);
13297 Jim_DecrRefCount(interp
, nargv
[0]);
13300 JimDecrCmdRefCount(interp
, cmd
);
13309 static int Jim_ConcatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13311 Jim_SetResult(interp
, Jim_ConcatObj(interp
, argc
- 1, argv
+ 1));
13316 static int Jim_UpvarCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13319 Jim_CallFrame
*targetCallFrame
;
13321 /* Lookup the target frame pointer */
13322 if (argc
> 3 && (argc
% 2 == 0)) {
13323 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, argv
[1]);
13328 targetCallFrame
= Jim_GetCallFrameByLevel(interp
, NULL
);
13330 if (targetCallFrame
== NULL
) {
13334 /* Check for arity */
13336 Jim_WrongNumArgs(interp
, 1, argv
, "?level? otherVar localVar ?otherVar localVar ...?");
13340 /* Now... for every other/local couple: */
13341 for (i
= 1; i
< argc
; i
+= 2) {
13342 if (Jim_SetVariableLink(interp
, argv
[i
+ 1], argv
[i
], targetCallFrame
) != JIM_OK
)
13349 static int Jim_GlobalCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13354 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?varName ...?");
13357 /* Link every var to the toplevel having the same name */
13358 if (interp
->framePtr
->level
== 0)
13359 return JIM_OK
; /* global at toplevel... */
13360 for (i
= 1; i
< argc
; i
++) {
13361 /* global ::blah does nothing */
13362 const char *name
= Jim_String(argv
[i
]);
13363 if (name
[0] != ':' || name
[1] != ':') {
13364 if (Jim_SetVariableLink(interp
, argv
[i
], argv
[i
], interp
->topFramePtr
) != JIM_OK
)
13371 /* does the [string map] operation. On error NULL is returned,
13372 * otherwise a new string object with the result, having refcount = 0,
13374 static Jim_Obj
*JimStringMap(Jim_Interp
*interp
, Jim_Obj
*mapListObjPtr
,
13375 Jim_Obj
*objPtr
, int nocase
)
13378 const char *str
, *noMatchStart
= NULL
;
13380 Jim_Obj
*resultObjPtr
;
13382 numMaps
= Jim_ListLength(interp
, mapListObjPtr
);
13384 Jim_SetResultString(interp
, "list must contain an even number of elements", -1);
13388 str
= Jim_String(objPtr
);
13389 strLen
= Jim_Utf8Length(interp
, objPtr
);
13392 resultObjPtr
= Jim_NewStringObj(interp
, "", 0);
13394 for (i
= 0; i
< numMaps
; i
+= 2) {
13399 objPtr
= Jim_ListGetIndex(interp
, mapListObjPtr
, i
);
13400 k
= Jim_String(objPtr
);
13401 kl
= Jim_Utf8Length(interp
, objPtr
);
13403 if (strLen
>= kl
&& kl
) {
13405 rc
= JimStringCompareLen(str
, k
, kl
, nocase
);
13407 if (noMatchStart
) {
13408 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13409 noMatchStart
= NULL
;
13411 Jim_AppendObj(interp
, resultObjPtr
, Jim_ListGetIndex(interp
, mapListObjPtr
, i
+ 1));
13412 str
+= utf8_index(str
, kl
);
13418 if (i
== numMaps
) { /* no match */
13420 if (noMatchStart
== NULL
)
13421 noMatchStart
= str
;
13422 str
+= utf8_tounicode(str
, &c
);
13426 if (noMatchStart
) {
13427 Jim_AppendString(interp
, resultObjPtr
, noMatchStart
, str
- noMatchStart
);
13429 return resultObjPtr
;
13433 static int Jim_StringCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13438 static const char * const options
[] = {
13439 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13440 "map", "repeat", "reverse", "index", "first", "last",
13441 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13445 OPT_BYTELENGTH
, OPT_LENGTH
, OPT_COMPARE
, OPT_MATCH
, OPT_EQUAL
, OPT_IS
, OPT_BYTERANGE
, OPT_RANGE
, OPT_REPLACE
,
13446 OPT_MAP
, OPT_REPEAT
, OPT_REVERSE
, OPT_INDEX
, OPT_FIRST
, OPT_LAST
,
13447 OPT_TRIM
, OPT_TRIMLEFT
, OPT_TRIMRIGHT
, OPT_TOLOWER
, OPT_TOUPPER
, OPT_TOTITLE
13449 static const char * const nocase_options
[] = {
13452 static const char * const nocase_length_options
[] = {
13453 "-nocase", "-length", NULL
13457 Jim_WrongNumArgs(interp
, 1, argv
, "option ?arguments ...?");
13460 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
,
13461 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
)
13466 case OPT_BYTELENGTH
:
13468 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13471 if (option
== OPT_LENGTH
) {
13472 len
= Jim_Utf8Length(interp
, argv
[2]);
13475 len
= Jim_Length(argv
[2]);
13477 Jim_SetResultInt(interp
, len
);
13483 /* n is the number of remaining option args */
13484 long opt_length
= -1;
13489 if (Jim_GetEnum(interp
, argv
[i
++], nocase_length_options
, &subopt
, NULL
,
13490 JIM_ENUM_ABBREV
) != JIM_OK
) {
13492 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? ?-length int? string1 string2");
13503 goto badcompareargs
;
13505 if (Jim_GetLong(interp
, argv
[i
++], &opt_length
) != JIM_OK
) {
13512 goto badcompareargs
;
13515 if (opt_length
< 0 && option
!= OPT_COMPARE
&& opt_case
) {
13516 /* Fast version - [string equal], case sensitive, no length */
13517 Jim_SetResultBool(interp
, Jim_StringEqObj(argv
[0], argv
[1]));
13520 if (opt_length
>= 0) {
13521 n
= JimStringCompareLen(Jim_String(argv
[0]), Jim_String(argv
[1]), opt_length
, !opt_case
);
13524 n
= Jim_StringCompareObj(interp
, argv
[0], argv
[1], !opt_case
);
13526 Jim_SetResultInt(interp
, option
== OPT_COMPARE
? n
: n
== 0);
13534 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13535 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13536 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? pattern string");
13539 if (opt_case
== 0) {
13542 Jim_SetResultBool(interp
, Jim_StringMatchObj(interp
, argv
[2], argv
[3], !opt_case
));
13550 Jim_GetEnum(interp
, argv
[2], nocase_options
, &opt_case
, NULL
,
13551 JIM_ENUM_ABBREV
) != JIM_OK
)) {
13552 Jim_WrongNumArgs(interp
, 2, argv
, "?-nocase? mapList string");
13556 if (opt_case
== 0) {
13559 objPtr
= JimStringMap(interp
, argv
[2], argv
[3], !opt_case
);
13560 if (objPtr
== NULL
) {
13563 Jim_SetResult(interp
, objPtr
);
13568 case OPT_BYTERANGE
:{
13572 Jim_WrongNumArgs(interp
, 2, argv
, "string first last");
13575 if (option
== OPT_RANGE
) {
13576 objPtr
= Jim_StringRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13580 objPtr
= Jim_StringByteRangeObj(interp
, argv
[2], argv
[3], argv
[4]);
13583 if (objPtr
== NULL
) {
13586 Jim_SetResult(interp
, objPtr
);
13593 if (argc
!= 5 && argc
!= 6) {
13594 Jim_WrongNumArgs(interp
, 2, argv
, "string first last ?string?");
13597 objPtr
= JimStringReplaceObj(interp
, argv
[2], argv
[3], argv
[4], argc
== 6 ? argv
[5] : NULL
);
13598 if (objPtr
== NULL
) {
13601 Jim_SetResult(interp
, objPtr
);
13611 Jim_WrongNumArgs(interp
, 2, argv
, "string count");
13614 if (Jim_GetWide(interp
, argv
[3], &count
) != JIM_OK
) {
13617 objPtr
= Jim_NewStringObj(interp
, "", 0);
13620 Jim_AppendObj(interp
, objPtr
, argv
[2]);
13623 Jim_SetResult(interp
, objPtr
);
13634 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13638 str
= Jim_GetString(argv
[2], &len
);
13639 buf
= Jim_Alloc(len
+ 1);
13642 for (i
= 0; i
< len
; ) {
13644 int l
= utf8_tounicode(str
, &c
);
13645 memcpy(p
- l
, str
, l
);
13650 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
13659 Jim_WrongNumArgs(interp
, 2, argv
, "string index");
13662 if (Jim_GetIndex(interp
, argv
[3], &idx
) != JIM_OK
) {
13665 str
= Jim_String(argv
[2]);
13666 len
= Jim_Utf8Length(interp
, argv
[2]);
13667 if (idx
!= INT_MIN
&& idx
!= INT_MAX
) {
13668 idx
= JimRelToAbsIndex(len
, idx
);
13670 if (idx
< 0 || idx
>= len
|| str
== NULL
) {
13671 Jim_SetResultString(interp
, "", 0);
13673 else if (len
== Jim_Length(argv
[2])) {
13674 /* ASCII optimisation */
13675 Jim_SetResultString(interp
, str
+ idx
, 1);
13679 int i
= utf8_index(str
, idx
);
13680 Jim_SetResultString(interp
, str
+ i
, utf8_tounicode(str
+ i
, &c
));
13687 int idx
= 0, l1
, l2
;
13688 const char *s1
, *s2
;
13690 if (argc
!= 4 && argc
!= 5) {
13691 Jim_WrongNumArgs(interp
, 2, argv
, "subString string ?index?");
13694 s1
= Jim_String(argv
[2]);
13695 s2
= Jim_String(argv
[3]);
13696 l1
= Jim_Utf8Length(interp
, argv
[2]);
13697 l2
= Jim_Utf8Length(interp
, argv
[3]);
13699 if (Jim_GetIndex(interp
, argv
[4], &idx
) != JIM_OK
) {
13702 idx
= JimRelToAbsIndex(l2
, idx
);
13704 else if (option
== OPT_LAST
) {
13707 if (option
== OPT_FIRST
) {
13708 Jim_SetResultInt(interp
, JimStringFirst(s1
, l1
, s2
, l2
, idx
));
13712 Jim_SetResultInt(interp
, JimStringLastUtf8(s1
, l1
, s2
, idx
));
13714 Jim_SetResultInt(interp
, JimStringLast(s1
, l1
, s2
, idx
));
13722 case OPT_TRIMRIGHT
:{
13723 Jim_Obj
*trimchars
;
13725 if (argc
!= 3 && argc
!= 4) {
13726 Jim_WrongNumArgs(interp
, 2, argv
, "string ?trimchars?");
13729 trimchars
= (argc
== 4 ? argv
[3] : NULL
);
13730 if (option
== OPT_TRIM
) {
13731 Jim_SetResult(interp
, JimStringTrim(interp
, argv
[2], trimchars
));
13733 else if (option
== OPT_TRIMLEFT
) {
13734 Jim_SetResult(interp
, JimStringTrimLeft(interp
, argv
[2], trimchars
));
13736 else if (option
== OPT_TRIMRIGHT
) {
13737 Jim_SetResult(interp
, JimStringTrimRight(interp
, argv
[2], trimchars
));
13746 Jim_WrongNumArgs(interp
, 2, argv
, "string");
13749 if (option
== OPT_TOLOWER
) {
13750 Jim_SetResult(interp
, JimStringToLower(interp
, argv
[2]));
13752 else if (option
== OPT_TOUPPER
) {
13753 Jim_SetResult(interp
, JimStringToUpper(interp
, argv
[2]));
13756 Jim_SetResult(interp
, JimStringToTitle(interp
, argv
[2]));
13761 if (argc
== 4 || (argc
== 5 && Jim_CompareStringImmediate(interp
, argv
[3], "-strict"))) {
13762 return JimStringIs(interp
, argv
[argc
- 1], argv
[2], argc
== 5);
13764 Jim_WrongNumArgs(interp
, 2, argv
, "class ?-strict? str");
13771 static int Jim_TimeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13774 jim_wide start
, elapsed
;
13776 const char *fmt
= "%" JIM_WIDE_MODIFIER
" microseconds per iteration";
13779 Jim_WrongNumArgs(interp
, 1, argv
, "script ?count?");
13783 if (Jim_GetLong(interp
, argv
[2], &count
) != JIM_OK
)
13789 start
= JimClock();
13793 retval
= Jim_EvalObj(interp
, argv
[1]);
13794 if (retval
!= JIM_OK
) {
13798 elapsed
= JimClock() - start
;
13799 sprintf(buf
, fmt
, count
== 0 ? 0 : elapsed
/ count
);
13800 Jim_SetResultString(interp
, buf
, -1);
13805 static int Jim_ExitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13810 Jim_WrongNumArgs(interp
, 1, argv
, "?exitCode?");
13814 if (Jim_GetLong(interp
, argv
[1], &exitCode
) != JIM_OK
)
13817 interp
->exitCode
= exitCode
;
13822 static int Jim_CatchCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13828 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13829 jim_wide ignore_mask
= (1 << JIM_EXIT
) | (1 << JIM_EVAL
) | (1 << JIM_SIGNAL
);
13830 static const int max_ignore_code
= sizeof(ignore_mask
) * 8;
13832 /* Reset the error code before catch.
13833 * Note that this is not strictly correct.
13835 Jim_SetGlobalVariableStr(interp
, "errorCode", Jim_NewStringObj(interp
, "NONE", -1));
13837 for (i
= 1; i
< argc
- 1; i
++) {
13838 const char *arg
= Jim_String(argv
[i
]);
13842 /* It's a pity we can't use Jim_GetEnum here :-( */
13843 if (strcmp(arg
, "--") == 0) {
13851 if (strncmp(arg
, "-no", 3) == 0) {
13860 if (Jim_StringToWide(arg
, &option
, 10) != JIM_OK
) {
13864 option
= Jim_FindByName(arg
, jimReturnCodes
, jimReturnCodesSize
);
13871 ignore_mask
|= (1 << option
);
13874 ignore_mask
&= ~(1 << option
);
13879 if (argc
< 1 || argc
> 3) {
13881 Jim_WrongNumArgs(interp
, 1, argv
,
13882 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13887 if ((ignore_mask
& (1 << JIM_SIGNAL
)) == 0) {
13891 interp
->signal_level
+= sig
;
13892 if (Jim_CheckSignal(interp
)) {
13893 /* If a signal is set, don't even try to execute the body */
13894 exitCode
= JIM_SIGNAL
;
13897 exitCode
= Jim_EvalObj(interp
, argv
[0]);
13898 /* Don't want any caught error included in a later stack trace */
13899 interp
->errorFlag
= 0;
13901 interp
->signal_level
-= sig
;
13903 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13904 if (exitCode
>= 0 && exitCode
< max_ignore_code
&& (((unsigned jim_wide
)1 << exitCode
) & ignore_mask
)) {
13905 /* Not caught, pass it up */
13909 if (sig
&& exitCode
== JIM_SIGNAL
) {
13910 /* Catch the signal at this level */
13911 if (interp
->signal_set_result
) {
13912 interp
->signal_set_result(interp
, interp
->sigmask
);
13915 Jim_SetResultInt(interp
, interp
->sigmask
);
13917 interp
->sigmask
= 0;
13921 if (Jim_SetVariable(interp
, argv
[1], Jim_GetResult(interp
)) != JIM_OK
) {
13925 Jim_Obj
*optListObj
= Jim_NewListObj(interp
, NULL
, 0);
13927 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-code", -1));
13928 Jim_ListAppendElement(interp
, optListObj
,
13929 Jim_NewIntObj(interp
, exitCode
== JIM_RETURN
? interp
->returnCode
: exitCode
));
13930 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-level", -1));
13931 Jim_ListAppendElement(interp
, optListObj
, Jim_NewIntObj(interp
, interp
->returnLevel
));
13932 if (exitCode
== JIM_ERR
) {
13933 Jim_Obj
*errorCode
;
13934 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorinfo",
13936 Jim_ListAppendElement(interp
, optListObj
, interp
->stackTrace
);
13938 errorCode
= Jim_GetGlobalVariableStr(interp
, "errorCode", JIM_NONE
);
13940 Jim_ListAppendElement(interp
, optListObj
, Jim_NewStringObj(interp
, "-errorcode", -1));
13941 Jim_ListAppendElement(interp
, optListObj
, errorCode
);
13944 if (Jim_SetVariable(interp
, argv
[2], optListObj
) != JIM_OK
) {
13949 Jim_SetResultInt(interp
, exitCode
);
13953 #ifdef JIM_REFERENCES
13956 static int Jim_RefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13958 if (argc
!= 3 && argc
!= 4) {
13959 Jim_WrongNumArgs(interp
, 1, argv
, "string tag ?finalizer?");
13963 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], NULL
));
13966 Jim_SetResult(interp
, Jim_NewReference(interp
, argv
[1], argv
[2], argv
[3]));
13972 static int Jim_GetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13974 Jim_Reference
*refPtr
;
13977 Jim_WrongNumArgs(interp
, 1, argv
, "reference");
13980 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
13982 Jim_SetResult(interp
, refPtr
->objPtr
);
13987 static int Jim_SetrefCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
13989 Jim_Reference
*refPtr
;
13992 Jim_WrongNumArgs(interp
, 1, argv
, "reference newValue");
13995 if ((refPtr
= Jim_GetReference(interp
, argv
[1])) == NULL
)
13997 Jim_IncrRefCount(argv
[2]);
13998 Jim_DecrRefCount(interp
, refPtr
->objPtr
);
13999 refPtr
->objPtr
= argv
[2];
14000 Jim_SetResult(interp
, argv
[2]);
14005 static int Jim_CollectCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14008 Jim_WrongNumArgs(interp
, 1, argv
, "");
14011 Jim_SetResultInt(interp
, Jim_Collect(interp
));
14013 /* Free all the freed objects. */
14014 while (interp
->freeList
) {
14015 Jim_Obj
*nextObjPtr
= interp
->freeList
->nextObjPtr
;
14016 Jim_Free(interp
->freeList
);
14017 interp
->freeList
= nextObjPtr
;
14023 /* [finalize] reference ?newValue? */
14024 static int Jim_FinalizeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14026 if (argc
!= 2 && argc
!= 3) {
14027 Jim_WrongNumArgs(interp
, 1, argv
, "reference ?finalizerProc?");
14031 Jim_Obj
*cmdNamePtr
;
14033 if (Jim_GetFinalizer(interp
, argv
[1], &cmdNamePtr
) != JIM_OK
)
14035 if (cmdNamePtr
!= NULL
) /* otherwise the null string is returned. */
14036 Jim_SetResult(interp
, cmdNamePtr
);
14039 if (Jim_SetFinalizer(interp
, argv
[1], argv
[2]) != JIM_OK
)
14041 Jim_SetResult(interp
, argv
[2]);
14046 /* [info references] */
14047 static int JimInfoReferences(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14049 Jim_Obj
*listObjPtr
;
14050 Jim_HashTableIterator htiter
;
14053 listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14055 JimInitHashTableIterator(&interp
->references
, &htiter
);
14056 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14057 char buf
[JIM_REFERENCE_SPACE
+ 1];
14058 Jim_Reference
*refPtr
= Jim_GetHashEntryVal(he
);
14059 const unsigned long *refId
= he
->key
;
14061 JimFormatReference(buf
, refPtr
, *refId
);
14062 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, buf
, -1));
14064 Jim_SetResult(interp
, listObjPtr
);
14070 static int Jim_RenameCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14073 Jim_WrongNumArgs(interp
, 1, argv
, "oldName newName");
14077 if (JimValidName(interp
, "new procedure", argv
[2])) {
14081 return Jim_RenameCommand(interp
, Jim_String(argv
[1]), Jim_String(argv
[2]));
14084 #define JIM_DICTMATCH_VALUES 0x0001
14086 typedef void JimDictMatchCallbackType(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
);
14088 static void JimDictMatchKeys(Jim_Interp
*interp
, Jim_Obj
*listObjPtr
, Jim_HashEntry
*he
, int type
)
14090 Jim_ListAppendElement(interp
, listObjPtr
, (Jim_Obj
*)he
->key
);
14091 if (type
& JIM_DICTMATCH_VALUES
) {
14092 Jim_ListAppendElement(interp
, listObjPtr
, Jim_GetHashEntryVal(he
));
14097 * Like JimHashtablePatternMatch, but for dictionaries.
14099 static Jim_Obj
*JimDictPatternMatch(Jim_Interp
*interp
, Jim_HashTable
*ht
, Jim_Obj
*patternObjPtr
,
14100 JimDictMatchCallbackType
*callback
, int type
)
14103 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14105 /* Check for the non-pattern case. We can do this much more efficiently. */
14106 Jim_HashTableIterator htiter
;
14107 JimInitHashTableIterator(ht
, &htiter
);
14108 while ((he
= Jim_NextHashEntry(&htiter
)) != NULL
) {
14109 if (patternObjPtr
== NULL
|| JimGlobMatch(Jim_String(patternObjPtr
), Jim_String((Jim_Obj
*)he
->key
), 0)) {
14110 callback(interp
, listObjPtr
, he
, type
);
14118 int Jim_DictKeys(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14120 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14123 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, 0));
14127 int Jim_DictValues(Jim_Interp
*interp
, Jim_Obj
*objPtr
, Jim_Obj
*patternObjPtr
)
14129 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14132 Jim_SetResult(interp
, JimDictPatternMatch(interp
, objPtr
->internalRep
.ptr
, patternObjPtr
, JimDictMatchKeys
, JIM_DICTMATCH_VALUES
));
14136 int Jim_DictSize(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14138 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14141 return ((Jim_HashTable
*)objPtr
->internalRep
.ptr
)->used
;
14144 int Jim_DictInfo(Jim_Interp
*interp
, Jim_Obj
*objPtr
)
14149 if (SetDictFromAny(interp
, objPtr
) != JIM_OK
) {
14153 ht
= (Jim_HashTable
*)objPtr
->internalRep
.ptr
;
14155 /* Note that this uses internal knowledge of the hash table */
14156 printf("%d entries in table, %d buckets\n", ht
->used
, ht
->size
);
14158 for (i
= 0; i
< ht
->size
; i
++) {
14159 Jim_HashEntry
*he
= ht
->table
[i
];
14165 printf(" %s", Jim_String(he
->key
));
14174 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
14176 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
14178 Jim_AppendString(interp
, prefixObj
, " ", 1);
14179 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
14181 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
14185 static int Jim_DictCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14189 static const char * const options
[] = {
14190 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14191 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14192 "replace", "update", NULL
14196 OPT_CREATE
, OPT_GET
, OPT_SET
, OPT_UNSET
, OPT_EXISTS
, OPT_KEYS
, OPT_SIZE
, OPT_INFO
,
14197 OPT_MERGE
, OPT_WITH
, OPT_APPEND
, OPT_LAPPEND
, OPT_INCR
, OPT_REMOVE
, OPT_VALUES
, OPT_FOR
,
14198 OPT_REPLACE
, OPT_UPDATE
,
14202 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arguments ...?");
14206 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
) != JIM_OK
) {
14213 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?key ...?");
14216 if (Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
,
14217 JIM_ERRMSG
) != JIM_OK
) {
14220 Jim_SetResult(interp
, objPtr
);
14225 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...? value");
14228 return Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 4, argv
[argc
- 1], JIM_ERRMSG
);
14232 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary key ?key ...?");
14236 int rc
= Jim_DictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, &objPtr
, JIM_ERRMSG
);
14240 Jim_SetResultBool(interp
, rc
== JIM_OK
);
14246 Jim_WrongNumArgs(interp
, 2, argv
, "varName key ?key ...?");
14249 if (Jim_SetDictKeysVector(interp
, argv
[2], argv
+ 3, argc
- 3, NULL
, 0) != JIM_OK
) {
14255 if (argc
!= 3 && argc
!= 4) {
14256 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary ?pattern?");
14259 return Jim_DictKeys(interp
, argv
[2], argc
== 4 ? argv
[3] : NULL
);
14263 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14266 else if (Jim_DictSize(interp
, argv
[2]) < 0) {
14269 Jim_SetResultInt(interp
, Jim_DictSize(interp
, argv
[2]));
14276 if (Jim_DictSize(interp
, argv
[2]) < 0) {
14279 /* Handle as ensemble */
14283 if (argc
< 6 || argc
% 2) {
14284 /* Better error message */
14291 Jim_WrongNumArgs(interp
, 2, argv
, "?key value ...?");
14294 objPtr
= Jim_NewDictObj(interp
, argv
+ 2, argc
- 2);
14295 Jim_SetResult(interp
, objPtr
);
14300 Jim_WrongNumArgs(interp
, 2, argv
, "dictionary");
14303 return Jim_DictInfo(interp
, argv
[2]);
14305 /* Handle command as an ensemble */
14306 return Jim_EvalEnsemble(interp
, "dict", options
[option
], argc
- 2, argv
+ 2);
14310 static int Jim_SubstCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14312 static const char * const options
[] = {
14313 "-nobackslashes", "-nocommands", "-novariables", NULL
14316 { OPT_NOBACKSLASHES
, OPT_NOCOMMANDS
, OPT_NOVARIABLES
};
14318 int flags
= JIM_SUBST_FLAG
;
14322 Jim_WrongNumArgs(interp
, 1, argv
, "?options? string");
14325 for (i
= 1; i
< (argc
- 1); i
++) {
14328 if (Jim_GetEnum(interp
, argv
[i
], options
, &option
, NULL
,
14329 JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14333 case OPT_NOBACKSLASHES
:
14334 flags
|= JIM_SUBST_NOESC
;
14336 case OPT_NOCOMMANDS
:
14337 flags
|= JIM_SUBST_NOCMD
;
14339 case OPT_NOVARIABLES
:
14340 flags
|= JIM_SUBST_NOVAR
;
14344 if (Jim_SubstObj(interp
, argv
[argc
- 1], &objPtr
, flags
) != JIM_OK
) {
14347 Jim_SetResult(interp
, objPtr
);
14352 static int Jim_InfoCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14358 static const char * const commands
[] = {
14359 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14360 "vars", "version", "patchlevel", "complete", "args", "hostname",
14361 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14362 "references", "alias", NULL
14365 { INFO_BODY
, INFO_STATICS
, INFO_COMMANDS
, INFO_PROCS
, INFO_CHANNELS
, INFO_EXISTS
, INFO_GLOBALS
, INFO_LEVEL
,
14366 INFO_FRAME
, INFO_LOCALS
, INFO_VARS
, INFO_VERSION
, INFO_PATCHLEVEL
, INFO_COMPLETE
, INFO_ARGS
,
14367 INFO_HOSTNAME
, INFO_SCRIPT
, INFO_SOURCE
, INFO_STACKTRACE
, INFO_NAMEOFEXECUTABLE
,
14368 INFO_RETURNCODES
, INFO_REFERENCES
, INFO_ALIAS
,
14371 #ifdef jim_ext_namespace
14374 if (argc
> 2 && Jim_CompareStringImmediate(interp
, argv
[1], "-nons")) {
14375 /* This is for internal use only */
14383 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?args ...?");
14386 if (Jim_GetEnum(interp
, argv
[1], commands
, &cmd
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
)
14391 /* Test for the the most common commands first, just in case it makes a difference */
14395 Jim_WrongNumArgs(interp
, 2, argv
, "varName");
14398 Jim_SetResultBool(interp
, Jim_GetVariable(interp
, argv
[2], 0) != NULL
);
14405 Jim_WrongNumArgs(interp
, 2, argv
, "command");
14408 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14411 if (cmdPtr
->isproc
|| cmdPtr
->u
.native
.cmdProc
!= JimAliasCmd
) {
14412 Jim_SetResultFormatted(interp
, "command \"%#s\" is not an alias", argv
[2]);
14415 Jim_SetResult(interp
, (Jim_Obj
*)cmdPtr
->u
.native
.privData
);
14419 case INFO_CHANNELS
:
14420 mode
++; /* JIM_CMDLIST_CHANNELS */
14421 #ifndef jim_ext_aio
14422 Jim_SetResultString(interp
, "aio not enabled", -1);
14426 mode
++; /* JIM_CMDLIST_PROCS */
14427 case INFO_COMMANDS
:
14428 /* mode 0 => JIM_CMDLIST_COMMANDS */
14429 if (argc
!= 2 && argc
!= 3) {
14430 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14433 #ifdef jim_ext_namespace
14435 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14436 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14440 Jim_SetResult(interp
, JimCommandsList(interp
, (argc
== 3) ? argv
[2] : NULL
, mode
));
14444 mode
++; /* JIM_VARLIST_VARS */
14446 mode
++; /* JIM_VARLIST_LOCALS */
14448 /* mode 0 => JIM_VARLIST_GLOBALS */
14449 if (argc
!= 2 && argc
!= 3) {
14450 Jim_WrongNumArgs(interp
, 2, argv
, "?pattern?");
14453 #ifdef jim_ext_namespace
14455 if (Jim_Length(interp
->framePtr
->nsObj
) || (argc
== 3 && JimGlobMatch("::*", Jim_String(argv
[2]), 0))) {
14456 return Jim_EvalPrefix(interp
, "namespace info", argc
- 1, argv
+ 1);
14460 Jim_SetResult(interp
, JimVariablesList(interp
, argc
== 3 ? argv
[2] : NULL
, mode
));
14465 Jim_WrongNumArgs(interp
, 2, argv
, "");
14468 Jim_SetResult(interp
, Jim_GetScript(interp
, interp
->currentScriptObj
)->fileNameObj
);
14473 Jim_Obj
*resObjPtr
;
14474 Jim_Obj
*fileNameObj
;
14477 Jim_WrongNumArgs(interp
, 2, argv
, "source");
14480 if (argv
[2]->typePtr
== &sourceObjType
) {
14481 fileNameObj
= argv
[2]->internalRep
.sourceValue
.fileNameObj
;
14482 line
= argv
[2]->internalRep
.sourceValue
.lineNumber
;
14484 else if (argv
[2]->typePtr
== &scriptObjType
) {
14485 ScriptObj
*script
= Jim_GetScript(interp
, argv
[2]);
14486 fileNameObj
= script
->fileNameObj
;
14487 line
= script
->firstline
;
14490 fileNameObj
= interp
->emptyObj
;
14493 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14494 Jim_ListAppendElement(interp
, resObjPtr
, fileNameObj
);
14495 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewIntObj(interp
, line
));
14496 Jim_SetResult(interp
, resObjPtr
);
14500 case INFO_STACKTRACE
:
14501 Jim_SetResult(interp
, interp
->stackTrace
);
14508 Jim_SetResultInt(interp
, interp
->framePtr
->level
);
14512 if (JimInfoLevel(interp
, argv
[2], &objPtr
, cmd
== INFO_LEVEL
) != JIM_OK
) {
14515 Jim_SetResult(interp
, objPtr
);
14519 Jim_WrongNumArgs(interp
, 2, argv
, "?levelNum?");
14530 Jim_WrongNumArgs(interp
, 2, argv
, "procname");
14533 if ((cmdPtr
= Jim_GetCommand(interp
, argv
[2], JIM_ERRMSG
)) == NULL
) {
14536 if (!cmdPtr
->isproc
) {
14537 Jim_SetResultFormatted(interp
, "command \"%#s\" is not a procedure", argv
[2]);
14542 Jim_SetResult(interp
, cmdPtr
->u
.proc
.bodyObjPtr
);
14545 Jim_SetResult(interp
, cmdPtr
->u
.proc
.argListObjPtr
);
14548 if (cmdPtr
->u
.proc
.staticVars
) {
14549 int mode
= JIM_VARLIST_LOCALS
| JIM_VARLIST_VALUES
;
14550 Jim_SetResult(interp
, JimHashtablePatternMatch(interp
, cmdPtr
->u
.proc
.staticVars
,
14551 NULL
, JimVariablesMatch
, mode
));
14559 case INFO_PATCHLEVEL
:{
14560 char buf
[(JIM_INTEGER_SPACE
* 2) + 1];
14562 sprintf(buf
, "%d.%d", JIM_VERSION
/ 100, JIM_VERSION
% 100);
14563 Jim_SetResultString(interp
, buf
, -1);
14567 case INFO_COMPLETE
:
14568 if (argc
!= 3 && argc
!= 4) {
14569 Jim_WrongNumArgs(interp
, 2, argv
, "script ?missing?");
14574 const char *s
= Jim_GetString(argv
[2], &len
);
14577 Jim_SetResultBool(interp
, Jim_ScriptIsComplete(s
, len
, &missing
));
14578 if (missing
!= ' ' && argc
== 4) {
14579 Jim_SetVariable(interp
, argv
[3], Jim_NewStringObj(interp
, &missing
, 1));
14584 case INFO_HOSTNAME
:
14585 /* Redirect to os.gethostname if it exists */
14586 return Jim_Eval(interp
, "os.gethostname");
14588 case INFO_NAMEOFEXECUTABLE
:
14589 /* Redirect to Tcl proc */
14590 return Jim_Eval(interp
, "{info nameofexecutable}");
14592 case INFO_RETURNCODES
:
14595 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14597 for (i
= 0; jimReturnCodes
[i
]; i
++) {
14598 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewIntObj(interp
, i
));
14599 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
,
14600 jimReturnCodes
[i
], -1));
14603 Jim_SetResult(interp
, listObjPtr
);
14605 else if (argc
== 3) {
14609 if (Jim_GetLong(interp
, argv
[2], &code
) != JIM_OK
) {
14612 name
= Jim_ReturnCode(code
);
14613 if (*name
== '?') {
14614 Jim_SetResultInt(interp
, code
);
14617 Jim_SetResultString(interp
, name
, -1);
14621 Jim_WrongNumArgs(interp
, 2, argv
, "?code?");
14625 case INFO_REFERENCES
:
14626 #ifdef JIM_REFERENCES
14627 return JimInfoReferences(interp
, argc
, argv
);
14629 Jim_SetResultString(interp
, "not supported", -1);
14637 static int Jim_ExistsCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14642 static const char * const options
[] = {
14643 "-command", "-proc", "-alias", "-var", NULL
14647 OPT_COMMAND
, OPT_PROC
, OPT_ALIAS
, OPT_VAR
14655 else if (argc
== 3) {
14656 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, NULL
, JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
14662 Jim_WrongNumArgs(interp
, 1, argv
, "?option? name");
14666 if (option
== OPT_VAR
) {
14667 result
= Jim_GetVariable(interp
, objPtr
, 0) != NULL
;
14670 /* Now different kinds of commands */
14671 Jim_Cmd
*cmd
= Jim_GetCommand(interp
, objPtr
, JIM_NONE
);
14680 result
= cmd
->isproc
== 0 && cmd
->u
.native
.cmdProc
== JimAliasCmd
;
14684 result
= cmd
->isproc
;
14689 Jim_SetResultBool(interp
, result
);
14694 static int Jim_SplitCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14696 const char *str
, *splitChars
, *noMatchStart
;
14697 int splitLen
, strLen
;
14698 Jim_Obj
*resObjPtr
;
14702 if (argc
!= 2 && argc
!= 3) {
14703 Jim_WrongNumArgs(interp
, 1, argv
, "string ?splitChars?");
14707 str
= Jim_GetString(argv
[1], &len
);
14711 strLen
= Jim_Utf8Length(interp
, argv
[1]);
14715 splitChars
= " \n\t\r";
14719 splitChars
= Jim_String(argv
[2]);
14720 splitLen
= Jim_Utf8Length(interp
, argv
[2]);
14723 noMatchStart
= str
;
14724 resObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14730 const char *sc
= splitChars
;
14731 int scLen
= splitLen
;
14732 int sl
= utf8_tounicode(str
, &c
);
14735 sc
+= utf8_tounicode(sc
, &pc
);
14737 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14738 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14739 noMatchStart
= str
+ sl
;
14745 objPtr
= Jim_NewStringObj(interp
, noMatchStart
, (str
- noMatchStart
));
14746 Jim_ListAppendElement(interp
, resObjPtr
, objPtr
);
14749 /* This handles the special case of splitchars eq {}
14750 * Optimise by sharing common (ASCII) characters
14752 Jim_Obj
**commonObj
= NULL
;
14753 #define NUM_COMMON (128 - 9)
14755 int n
= utf8_tounicode(str
, &c
);
14756 #ifdef JIM_OPTIMIZATION
14757 if (c
>= 9 && c
< 128) {
14758 /* Common ASCII char. Note that 9 is the tab character */
14761 commonObj
= Jim_Alloc(sizeof(*commonObj
) * NUM_COMMON
);
14762 memset(commonObj
, 0, sizeof(*commonObj
) * NUM_COMMON
);
14764 if (!commonObj
[c
]) {
14765 commonObj
[c
] = Jim_NewStringObj(interp
, str
, 1);
14767 Jim_ListAppendElement(interp
, resObjPtr
, commonObj
[c
]);
14772 Jim_ListAppendElement(interp
, resObjPtr
, Jim_NewStringObjUtf8(interp
, str
, 1));
14775 Jim_Free(commonObj
);
14778 Jim_SetResult(interp
, resObjPtr
);
14783 static int Jim_JoinCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14785 const char *joinStr
;
14788 if (argc
!= 2 && argc
!= 3) {
14789 Jim_WrongNumArgs(interp
, 1, argv
, "list ?joinString?");
14798 joinStr
= Jim_GetString(argv
[2], &joinStrLen
);
14800 Jim_SetResult(interp
, Jim_ListJoin(interp
, argv
[1], joinStr
, joinStrLen
));
14805 static int Jim_FormatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14810 Jim_WrongNumArgs(interp
, 1, argv
, "formatString ?arg arg ...?");
14813 objPtr
= Jim_FormatString(interp
, argv
[1], argc
- 2, argv
+ 2);
14814 if (objPtr
== NULL
)
14816 Jim_SetResult(interp
, objPtr
);
14821 static int Jim_ScanCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14823 Jim_Obj
*listPtr
, **outVec
;
14827 Jim_WrongNumArgs(interp
, 1, argv
, "string format ?varName varName ...?");
14830 if (argv
[2]->typePtr
!= &scanFmtStringObjType
)
14831 SetScanFmtFromAny(interp
, argv
[2]);
14832 if (FormatGetError(argv
[2]) != 0) {
14833 Jim_SetResultString(interp
, FormatGetError(argv
[2]), -1);
14837 int maxPos
= FormatGetMaxPos(argv
[2]);
14838 int count
= FormatGetCnvCount(argv
[2]);
14840 if (maxPos
> argc
- 3) {
14841 Jim_SetResultString(interp
, "\"%n$\" argument index out of range", -1);
14844 else if (count
> argc
- 3) {
14845 Jim_SetResultString(interp
, "different numbers of variable names and "
14846 "field specifiers", -1);
14849 else if (count
< argc
- 3) {
14850 Jim_SetResultString(interp
, "variable is not assigned by any "
14851 "conversion specifiers", -1);
14855 listPtr
= Jim_ScanString(interp
, argv
[1], argv
[2], JIM_ERRMSG
);
14862 if (listPtr
!= 0 && listPtr
!= (Jim_Obj
*)EOF
) {
14863 int len
= Jim_ListLength(interp
, listPtr
);
14866 JimListGetElements(interp
, listPtr
, &outc
, &outVec
);
14867 for (i
= 0; i
< outc
; ++i
) {
14868 if (Jim_Length(outVec
[i
]) > 0) {
14870 if (Jim_SetVariable(interp
, argv
[3 + i
], outVec
[i
]) != JIM_OK
) {
14876 Jim_FreeNewObj(interp
, listPtr
);
14881 if (rc
== JIM_OK
) {
14882 Jim_SetResultInt(interp
, count
);
14887 if (listPtr
== (Jim_Obj
*)EOF
) {
14888 Jim_SetResult(interp
, Jim_NewListObj(interp
, 0, 0));
14891 Jim_SetResult(interp
, listPtr
);
14897 static int Jim_ErrorCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14899 if (argc
!= 2 && argc
!= 3) {
14900 Jim_WrongNumArgs(interp
, 1, argv
, "message ?stacktrace?");
14903 Jim_SetResult(interp
, argv
[1]);
14905 JimSetStackTrace(interp
, argv
[2]);
14908 interp
->addStackTrace
++;
14913 static int Jim_LrangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14918 Jim_WrongNumArgs(interp
, 1, argv
, "list first last");
14921 if ((objPtr
= Jim_ListRange(interp
, argv
[1], argv
[2], argv
[3])) == NULL
)
14923 Jim_SetResult(interp
, objPtr
);
14928 static int Jim_LrepeatCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14933 if (argc
< 2 || Jim_GetLong(interp
, argv
[1], &count
) != JIM_OK
|| count
< 0) {
14934 Jim_WrongNumArgs(interp
, 1, argv
, "count ?value ...?");
14938 if (count
== 0 || argc
== 2) {
14945 objPtr
= Jim_NewListObj(interp
, argv
, argc
);
14947 ListInsertElements(objPtr
, -1, argc
, argv
);
14950 Jim_SetResult(interp
, objPtr
);
14954 char **Jim_GetEnviron(void)
14956 #if defined(HAVE__NSGETENVIRON)
14957 return *_NSGetEnviron();
14959 #if !defined(NO_ENVIRON_EXTERN)
14960 extern char **environ
;
14967 void Jim_SetEnviron(char **env
)
14969 #if defined(HAVE__NSGETENVIRON)
14970 *_NSGetEnviron() = env
;
14972 #if !defined(NO_ENVIRON_EXTERN)
14973 extern char **environ
;
14981 static int Jim_EnvCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
14987 char **e
= Jim_GetEnviron();
14990 Jim_Obj
*listObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
14992 for (i
= 0; e
[i
]; i
++) {
14993 const char *equals
= strchr(e
[i
], '=');
14996 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, e
[i
],
14998 Jim_ListAppendElement(interp
, listObjPtr
, Jim_NewStringObj(interp
, equals
+ 1, -1));
15002 Jim_SetResult(interp
, listObjPtr
);
15007 Jim_WrongNumArgs(interp
, 1, argv
, "varName ?default?");
15010 key
= Jim_String(argv
[1]);
15014 Jim_SetResultFormatted(interp
, "environment variable \"%#s\" does not exist", argv
[1]);
15017 val
= Jim_String(argv
[2]);
15019 Jim_SetResult(interp
, Jim_NewStringObj(interp
, val
, -1));
15024 static int Jim_SourceCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15029 Jim_WrongNumArgs(interp
, 1, argv
, "fileName");
15032 retval
= Jim_EvalFile(interp
, Jim_String(argv
[1]));
15033 if (retval
== JIM_RETURN
)
15039 static int Jim_LreverseCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15041 Jim_Obj
*revObjPtr
, **ele
;
15045 Jim_WrongNumArgs(interp
, 1, argv
, "list");
15048 JimListGetElements(interp
, argv
[1], &len
, &ele
);
15050 revObjPtr
= Jim_NewListObj(interp
, NULL
, 0);
15052 ListAppendElement(revObjPtr
, ele
[len
--]);
15053 Jim_SetResult(interp
, revObjPtr
);
15057 static int JimRangeLen(jim_wide start
, jim_wide end
, jim_wide step
)
15065 else if (step
> 0 && start
> end
)
15067 else if (step
< 0 && end
> start
)
15071 len
= -len
; /* abs(len) */
15073 step
= -step
; /* abs(step) */
15074 len
= 1 + ((len
- 1) / step
);
15075 /* We can truncate safely to INT_MAX, the range command
15076 * will always return an error for a such long range
15077 * because Tcl lists can't be so long. */
15080 return (int)((len
< 0) ? -1 : len
);
15084 static int Jim_RangeCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15086 jim_wide start
= 0, end
, step
= 1;
15090 if (argc
< 2 || argc
> 4) {
15091 Jim_WrongNumArgs(interp
, 1, argv
, "?start? end ?step?");
15095 if (Jim_GetWide(interp
, argv
[1], &end
) != JIM_OK
)
15099 if (Jim_GetWide(interp
, argv
[1], &start
) != JIM_OK
||
15100 Jim_GetWide(interp
, argv
[2], &end
) != JIM_OK
)
15102 if (argc
== 4 && Jim_GetWide(interp
, argv
[3], &step
) != JIM_OK
)
15105 if ((len
= JimRangeLen(start
, end
, step
)) == -1) {
15106 Jim_SetResultString(interp
, "Invalid (infinite?) range specified", -1);
15109 objPtr
= Jim_NewListObj(interp
, NULL
, 0);
15110 for (i
= 0; i
< len
; i
++)
15111 ListAppendElement(objPtr
, Jim_NewIntObj(interp
, start
+ i
* step
));
15112 Jim_SetResult(interp
, objPtr
);
15117 static int Jim_RandCoreCommand(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
15119 jim_wide min
= 0, max
= 0, len
, maxMul
;
15121 if (argc
< 1 || argc
> 3) {
15122 Jim_WrongNumArgs(interp
, 1, argv
, "?min? max");
15126 max
= JIM_WIDE_MAX
;
15127 } else if (argc
== 2) {
15128 if (Jim_GetWide(interp
, argv
[1], &max
) != JIM_OK
)
15130 } else if (argc
== 3) {
15131 if (Jim_GetWide(interp
, argv
[1], &min
) != JIM_OK
||
15132 Jim_GetWide(interp
, argv
[2], &max
) != JIM_OK
)
15137 Jim_SetResultString(interp
, "Invalid arguments (max < min)", -1);
15140 maxMul
= JIM_WIDE_MAX
- (len
? (JIM_WIDE_MAX
%len
) : 0);
15144 JimRandomBytes(interp
, &r
, sizeof(jim_wide
));
15145 if (r
< 0 || r
>= maxMul
) continue;
15146 r
= (len
== 0) ? 0 : r
%len
;
15147 Jim_SetResultInt(interp
, min
+r
);
15152 static const struct {
15154 Jim_CmdProc
*cmdProc
;
15155 } Jim_CoreCommandsTable
[] = {
15156 {"alias", Jim_AliasCoreCommand
},
15157 {"set", Jim_SetCoreCommand
},
15158 {"unset", Jim_UnsetCoreCommand
},
15159 {"puts", Jim_PutsCoreCommand
},
15160 {"+", Jim_AddCoreCommand
},
15161 {"*", Jim_MulCoreCommand
},
15162 {"-", Jim_SubCoreCommand
},
15163 {"/", Jim_DivCoreCommand
},
15164 {"incr", Jim_IncrCoreCommand
},
15165 {"while", Jim_WhileCoreCommand
},
15166 {"loop", Jim_LoopCoreCommand
},
15167 {"for", Jim_ForCoreCommand
},
15168 {"foreach", Jim_ForeachCoreCommand
},
15169 {"lmap", Jim_LmapCoreCommand
},
15170 {"lassign", Jim_LassignCoreCommand
},
15171 {"if", Jim_IfCoreCommand
},
15172 {"switch", Jim_SwitchCoreCommand
},
15173 {"list", Jim_ListCoreCommand
},
15174 {"lindex", Jim_LindexCoreCommand
},
15175 {"lset", Jim_LsetCoreCommand
},
15176 {"lsearch", Jim_LsearchCoreCommand
},
15177 {"llength", Jim_LlengthCoreCommand
},
15178 {"lappend", Jim_LappendCoreCommand
},
15179 {"linsert", Jim_LinsertCoreCommand
},
15180 {"lreplace", Jim_LreplaceCoreCommand
},
15181 {"lsort", Jim_LsortCoreCommand
},
15182 {"append", Jim_AppendCoreCommand
},
15183 {"debug", Jim_DebugCoreCommand
},
15184 {"eval", Jim_EvalCoreCommand
},
15185 {"uplevel", Jim_UplevelCoreCommand
},
15186 {"expr", Jim_ExprCoreCommand
},
15187 {"break", Jim_BreakCoreCommand
},
15188 {"continue", Jim_ContinueCoreCommand
},
15189 {"proc", Jim_ProcCoreCommand
},
15190 {"concat", Jim_ConcatCoreCommand
},
15191 {"return", Jim_ReturnCoreCommand
},
15192 {"upvar", Jim_UpvarCoreCommand
},
15193 {"global", Jim_GlobalCoreCommand
},
15194 {"string", Jim_StringCoreCommand
},
15195 {"time", Jim_TimeCoreCommand
},
15196 {"exit", Jim_ExitCoreCommand
},
15197 {"catch", Jim_CatchCoreCommand
},
15198 #ifdef JIM_REFERENCES
15199 {"ref", Jim_RefCoreCommand
},
15200 {"getref", Jim_GetrefCoreCommand
},
15201 {"setref", Jim_SetrefCoreCommand
},
15202 {"finalize", Jim_FinalizeCoreCommand
},
15203 {"collect", Jim_CollectCoreCommand
},
15205 {"rename", Jim_RenameCoreCommand
},
15206 {"dict", Jim_DictCoreCommand
},
15207 {"subst", Jim_SubstCoreCommand
},
15208 {"info", Jim_InfoCoreCommand
},
15209 {"exists", Jim_ExistsCoreCommand
},
15210 {"split", Jim_SplitCoreCommand
},
15211 {"join", Jim_JoinCoreCommand
},
15212 {"format", Jim_FormatCoreCommand
},
15213 {"scan", Jim_ScanCoreCommand
},
15214 {"error", Jim_ErrorCoreCommand
},
15215 {"lrange", Jim_LrangeCoreCommand
},
15216 {"lrepeat", Jim_LrepeatCoreCommand
},
15217 {"env", Jim_EnvCoreCommand
},
15218 {"source", Jim_SourceCoreCommand
},
15219 {"lreverse", Jim_LreverseCoreCommand
},
15220 {"range", Jim_RangeCoreCommand
},
15221 {"rand", Jim_RandCoreCommand
},
15222 {"tailcall", Jim_TailcallCoreCommand
},
15223 {"local", Jim_LocalCoreCommand
},
15224 {"upcall", Jim_UpcallCoreCommand
},
15225 {"apply", Jim_ApplyCoreCommand
},
15229 void Jim_RegisterCoreCommands(Jim_Interp
*interp
)
15233 while (Jim_CoreCommandsTable
[i
].name
!= NULL
) {
15234 Jim_CreateCommand(interp
,
15235 Jim_CoreCommandsTable
[i
].name
, Jim_CoreCommandsTable
[i
].cmdProc
, NULL
, NULL
);
15240 /* -----------------------------------------------------------------------------
15241 * Interactive prompt
15242 * ---------------------------------------------------------------------------*/
15243 void Jim_MakeErrorMessage(Jim_Interp
*interp
)
15247 argv
[0] = Jim_NewStringObj(interp
, "errorInfo", -1);
15248 argv
[1] = interp
->result
;
15250 Jim_EvalObjVector(interp
, 2, argv
);
15253 static void JimSetFailedEnumResult(Jim_Interp
*interp
, const char *arg
, const char *badtype
,
15254 const char *prefix
, const char *const *tablePtr
, const char *name
)
15257 char **tablePtrSorted
;
15260 for (count
= 0; tablePtr
[count
]; count
++) {
15263 if (name
== NULL
) {
15267 Jim_SetResultFormatted(interp
, "%s%s \"%s\": must be ", badtype
, name
, arg
);
15268 tablePtrSorted
= Jim_Alloc(sizeof(char *) * count
);
15269 memcpy(tablePtrSorted
, tablePtr
, sizeof(char *) * count
);
15270 qsort(tablePtrSorted
, count
, sizeof(char *), qsortCompareStringPointers
);
15271 for (i
= 0; i
< count
; i
++) {
15272 if (i
+ 1 == count
&& count
> 1) {
15273 Jim_AppendString(interp
, Jim_GetResult(interp
), "or ", -1);
15275 Jim_AppendStrings(interp
, Jim_GetResult(interp
), prefix
, tablePtrSorted
[i
], NULL
);
15276 if (i
+ 1 != count
) {
15277 Jim_AppendString(interp
, Jim_GetResult(interp
), ", ", -1);
15280 Jim_Free(tablePtrSorted
);
15283 int Jim_GetEnum(Jim_Interp
*interp
, Jim_Obj
*objPtr
,
15284 const char *const *tablePtr
, int *indexPtr
, const char *name
, int flags
)
15286 const char *bad
= "bad ";
15287 const char *const *entryPtr
= NULL
;
15291 const char *arg
= Jim_GetString(objPtr
, &arglen
);
15295 for (entryPtr
= tablePtr
, i
= 0; *entryPtr
!= NULL
; entryPtr
++, i
++) {
15296 if (Jim_CompareStringImmediate(interp
, objPtr
, *entryPtr
)) {
15297 /* Found an exact match */
15301 if (flags
& JIM_ENUM_ABBREV
) {
15302 /* Accept an unambiguous abbreviation.
15303 * Note that '-' doesnt' consitute a valid abbreviation
15305 if (strncmp(arg
, *entryPtr
, arglen
) == 0) {
15306 if (*arg
== '-' && arglen
== 1) {
15310 bad
= "ambiguous ";
15318 /* If we had an unambiguous partial match */
15325 if (flags
& JIM_ERRMSG
) {
15326 JimSetFailedEnumResult(interp
, arg
, bad
, "", tablePtr
, name
);
15331 int Jim_FindByName(const char *name
, const char * const array
[], size_t len
)
15335 for (i
= 0; i
< (int)len
; i
++) {
15336 if (array
[i
] && strcmp(array
[i
], name
) == 0) {
15343 int Jim_IsDict(Jim_Obj
*objPtr
)
15345 return objPtr
->typePtr
== &dictObjType
;
15348 int Jim_IsList(Jim_Obj
*objPtr
)
15350 return objPtr
->typePtr
== &listObjType
;
15354 * Very simple printf-like formatting, designed for error messages.
15356 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15357 * The resulting string is created and set as the result.
15359 * Each '%s' should correspond to a regular string parameter.
15360 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15361 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15363 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15365 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15367 void Jim_SetResultFormatted(Jim_Interp
*interp
, const char *format
, ...)
15369 /* Initial space needed */
15370 int len
= strlen(format
);
15373 const char *params
[5];
15378 va_start(args
, format
);
15380 for (i
= 0; i
< len
&& n
< 5; i
++) {
15383 if (strncmp(format
+ i
, "%s", 2) == 0) {
15384 params
[n
] = va_arg(args
, char *);
15386 l
= strlen(params
[n
]);
15388 else if (strncmp(format
+ i
, "%#s", 3) == 0) {
15389 Jim_Obj
*objPtr
= va_arg(args
, Jim_Obj
*);
15391 params
[n
] = Jim_GetString(objPtr
, &l
);
15394 if (format
[i
] == '%') {
15404 buf
= Jim_Alloc(len
+ 1);
15405 len
= snprintf(buf
, len
+ 1, format
, params
[0], params
[1], params
[2], params
[3], params
[4]);
15409 Jim_SetResult(interp
, Jim_NewStringObjNoAlloc(interp
, buf
, len
));
15413 #ifndef jim_ext_package
15414 int Jim_PackageProvide(Jim_Interp
*interp
, const char *name
, const char *ver
, int flags
)
15419 #ifndef jim_ext_aio
15420 FILE *Jim_AioFilehandle(Jim_Interp
*interp
, Jim_Obj
*fhObj
)
15422 Jim_SetResultString(interp
, "aio not enabled", -1);
15429 * Local Variables: ***
15430 * c-basic-offset: 4 ***