It was possible to create a bad ref
[jimtcl.git] / jim.c
blob17f41f028d14afe2ee9bccd348af3c4d2ccb9be3
2 /* Jim - A small embeddable Tcl interpreter
4 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
5 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
6 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
7 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
8 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
9 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
10 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
11 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
12 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
13 * Copyright 2009 Zachary T Welch zw@superlucidity.net
14 * Copyright 2009 David Brownell
16 * The FreeBSD license
18 * Redistribution and use in source and binary forms, with or without
19 * modification, are permitted provided that the following conditions
20 * are met:
22 * 1. Redistributions of source code must retain the above copyright
23 * notice, this list of conditions and the following disclaimer.
24 * 2. Redistributions in binary form must reproduce the above
25 * copyright notice, this list of conditions and the following
26 * disclaimer in the documentation and/or other materials
27 * provided with the distribution.
29 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
30 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
31 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
32 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
33 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
34 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
35 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
36 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
37 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
38 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
39 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
40 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
42 * The views and conclusions contained in the software and documentation
43 * are those of the authors and should not be interpreted as representing
44 * official policies, either expressed or implied, of the Jim Tcl Project.
45 **/
46 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include <unistd.h>
61 #include <sys/time.h>
63 #include "jim.h"
65 #ifdef HAVE_BACKTRACE
66 #include <execinfo.h>
67 #endif
69 /* For INFINITY, even if math functions are not enabled */
70 #include <math.h>
72 /* -----------------------------------------------------------------------------
73 * Global variables
74 * ---------------------------------------------------------------------------*/
76 /* A shared empty string for the objects string representation.
77 * Jim_InvalidateStringRep knows about it and don't try to free. */
78 static char *JimEmptyStringRep = (char *)"";
80 /* -----------------------------------------------------------------------------
81 * Required prototypes of not exported functions
82 * ---------------------------------------------------------------------------*/
83 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
84 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
85 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index, Jim_Obj *newObjPtr,
86 int flags);
87 static Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
88 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
89 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
90 const char *prefix, const char *const *tablePtr, const char *name);
91 static void JimDeleteLocalProcs(Jim_Interp *interp);
92 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr,
93 int argc, Jim_Obj *const *argv);
94 static int JimEvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv,
95 const char *filename, int linenr);
96 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
98 static const Jim_HashTableType JimVariablesHashTableType;
100 const char *tt_name(int type);
102 /* -----------------------------------------------------------------------------
103 * Utility functions
104 * ---------------------------------------------------------------------------*/
106 /* Glob-style pattern matching. */
107 static int JimStringMatch(const char *pattern, int patternLen,
108 const char *string, int stringLen, int nocase)
110 while (patternLen) {
111 switch (pattern[0]) {
112 case '*':
113 while (pattern[1] == '*') {
114 pattern++;
115 patternLen--;
117 if (patternLen == 1)
118 return 1; /* match */
119 while (stringLen) {
120 if (JimStringMatch(pattern + 1, patternLen - 1, string, stringLen, nocase))
121 return 1; /* match */
122 string++;
123 stringLen--;
125 return 0; /* no match */
126 break;
127 case '?':
128 if (stringLen == 0)
129 return 0; /* no match */
130 string++;
131 stringLen--;
132 break;
133 case '[':
135 int not, match;
137 pattern++;
138 patternLen--;
139 not = pattern[0] == '^';
140 if (not) {
141 pattern++;
142 patternLen--;
144 match = 0;
145 while (1) {
146 if (pattern[0] == '\\') {
147 pattern++;
148 patternLen--;
149 if (pattern[0] == string[0])
150 match = 1;
152 else if (pattern[0] == ']') {
153 break;
155 else if (patternLen == 0) {
156 pattern--;
157 patternLen++;
158 break;
160 else if (pattern[1] == '-' && patternLen >= 3) {
161 int start = pattern[0];
162 int end = pattern[2];
163 int c = string[0];
165 if (start > end) {
166 int t = start;
168 start = end;
169 end = t;
171 if (nocase) {
172 start = tolower(start);
173 end = tolower(end);
174 c = tolower(c);
176 pattern += 2;
177 patternLen -= 2;
178 if (c >= start && c <= end)
179 match = 1;
181 else {
182 if (!nocase) {
183 if (pattern[0] == string[0])
184 match = 1;
186 else {
187 if (tolower((int)pattern[0]) == tolower((int)string[0]))
188 match = 1;
191 pattern++;
192 patternLen--;
194 if (not)
195 match = !match;
196 if (!match)
197 return 0; /* no match */
198 string++;
199 stringLen--;
200 break;
202 case '\\':
203 if (patternLen >= 2) {
204 pattern++;
205 patternLen--;
207 /* fall through */
208 default:
209 if (!nocase) {
210 if (pattern[0] != string[0])
211 return 0; /* no match */
213 else {
214 if (tolower((int)pattern[0]) != tolower((int)string[0]))
215 return 0; /* no match */
217 string++;
218 stringLen--;
219 break;
221 pattern++;
222 patternLen--;
223 if (stringLen == 0) {
224 while (*pattern == '*') {
225 pattern++;
226 patternLen--;
228 break;
231 if (patternLen == 0 && stringLen == 0)
232 return 1;
233 return 0;
236 int JimStringCompare(const char *s1, int l1, const char *s2, int l2, int nocase)
238 unsigned char *u1 = (unsigned char *)s1, *u2 = (unsigned char *)s2;
239 int diff;
241 if (nocase == 0) {
242 while (l1 && l2) {
243 diff = (int)*u1 - *u2;
244 if (diff) {
245 goto done;
247 u1++;
248 u2++;
249 l1--;
250 l2--;
252 diff = l1 - l2;
254 else {
255 while (l1 && l2) {
256 diff = tolower((int)*u1) - tolower((int)*u2);
257 if (diff) {
258 goto done;
260 u1++;
261 u2++;
262 l1--;
263 l2--;
265 diff = l1 - l2;
267 if (diff == 0) {
268 return 0;
270 done:
271 return diff < 0 ? -1 : 1;
274 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
275 * The index of the first occurrence of s1 in s2 is returned.
276 * If s1 is not found inside s2, -1 is returned. */
277 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
279 int i;
281 if (!l1 || !l2 || l1 > l2)
282 return -1;
283 if (index < 0)
284 index = 0;
285 s2 += index;
286 for (i = index; i <= l2 - l1; i++) {
287 if (memcmp(s2, s1, l1) == 0)
288 return i;
289 s2++;
291 return -1;
294 int JimStringLast(const char *s1, int l1, const char *s2, int l2)
296 const char *p;
298 if (!l1 || !l2 || l1 > l2)
299 return -1;
301 /* Now search for the needle */
302 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
303 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
304 return p - s2;
307 return -1;
310 int Jim_WideToString(char *buf, jim_wide wideValue)
312 const char *fmt = "%" JIM_WIDE_MODIFIER;
314 return sprintf(buf, fmt, wideValue);
318 * After an strtol()/strtod()-like conversion,
319 * check whether something was converted and that
320 * the only thing left is white space.
322 * Returns JIM_OK or JIM_ERR.
324 static int JimCheckConversion(const char *str, const char *endptr)
326 if (str[0] == '\0' || str == endptr) {
327 return JIM_ERR;
330 if (endptr[0] != '\0') {
331 while (*endptr) {
332 if (!isspace(*endptr)) {
333 return JIM_ERR;
335 endptr++;
338 return JIM_OK;
341 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
343 char *endptr;
345 *widePtr = strtoull(str, &endptr, base);
347 return JimCheckConversion(str, endptr);
350 int Jim_DoubleToString(char *buf, double doubleValue)
352 int len;
354 len = sprintf(buf, "%.12g", doubleValue);
356 /* Add a final ".0" if it's a number. But not
357 * for NaN or InF */
358 while (*buf) {
359 if (*buf == '.' || isalpha(*buf)) {
360 /* inf -> Inf, nan -> Nan */
361 if (*buf == 'i' || *buf == 'n') {
362 *buf = toupper(*buf);
364 return len;
366 buf++;
369 *buf++ = '.';
370 *buf++ = '0';
371 *buf = '\0';
373 return len + 2;
376 int Jim_StringToDouble(const char *str, double *doublePtr)
378 char *endptr;
380 /* Callers can check for underflow via ERANGE */
381 errno = 0;
383 *doublePtr = strtod(str, &endptr);
385 return JimCheckConversion(str, endptr);
388 static jim_wide JimPowWide(jim_wide b, jim_wide e)
390 jim_wide i, res = 1;
392 if ((b == 0 && e != 0) || (e < 0))
393 return 0;
394 for (i = 0; i < e; i++) {
395 res *= b;
397 return res;
400 /* -----------------------------------------------------------------------------
401 * Special functions
402 * ---------------------------------------------------------------------------*/
404 /* Note that 'interp' may be NULL if not available in the
405 * context of the panic. It's only useful to get the error
406 * file descriptor, it will default to stderr otherwise. */
407 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
409 va_list ap;
411 va_start(ap, fmt);
413 * Send it here first.. Assuming STDIO still works
415 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
416 vfprintf(stderr, fmt, ap);
417 fprintf(stderr, JIM_NL JIM_NL);
418 va_end(ap);
420 #ifdef HAVE_BACKTRACE
422 void *array[40];
423 int size, i;
424 char **strings;
426 size = backtrace(array, 40);
427 strings = backtrace_symbols(array, size);
428 for (i = 0; i < size; i++)
429 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
430 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
431 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
433 #endif
435 abort();
438 /* -----------------------------------------------------------------------------
439 * Memory allocation
440 * ---------------------------------------------------------------------------*/
442 void *Jim_Alloc(int size)
444 return malloc(size);
447 void Jim_Free(void *ptr)
449 free(ptr);
452 void *Jim_Realloc(void *ptr, int size)
454 return realloc(ptr, size);
457 char *Jim_StrDup(const char *s)
459 return strdup(s);
462 char *Jim_StrDupLen(const char *s, int l)
464 char *copy = Jim_Alloc(l + 1);
466 memcpy(copy, s, l + 1);
467 copy[l] = 0; /* Just to be sure, original could be substring */
468 return copy;
471 /* -----------------------------------------------------------------------------
472 * Time related functions
473 * ---------------------------------------------------------------------------*/
475 /* Returns microseconds of CPU used since start. */
476 static jim_wide JimClock(void)
478 struct timeval tv;
480 gettimeofday(&tv, NULL);
481 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
484 /* -----------------------------------------------------------------------------
485 * Hash Tables
486 * ---------------------------------------------------------------------------*/
488 /* -------------------------- private prototypes ---------------------------- */
489 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
490 static unsigned int JimHashTableNextPower(unsigned int size);
491 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
493 /* -------------------------- hash functions -------------------------------- */
495 /* Thomas Wang's 32 bit Mix Function */
496 unsigned int Jim_IntHashFunction(unsigned int key)
498 key += ~(key << 15);
499 key ^= (key >> 10);
500 key += (key << 3);
501 key ^= (key >> 6);
502 key += ~(key << 11);
503 key ^= (key >> 16);
504 return key;
507 /* Generic hash function (we are using to multiply by 9 and add the byte
508 * as Tcl) */
509 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
511 unsigned int h = 0;
513 while (len--)
514 h += (h << 3) + *buf++;
515 return h;
518 /* ----------------------------- API implementation ------------------------- */
520 /* reset a hashtable already initialized with ht_init().
521 * NOTE: This function should only called by ht_destroy(). */
522 static void JimResetHashTable(Jim_HashTable *ht)
524 ht->table = NULL;
525 ht->size = 0;
526 ht->sizemask = 0;
527 ht->used = 0;
528 ht->collisions = 0;
531 /* Initialize the hash table */
532 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
534 JimResetHashTable(ht);
535 ht->type = type;
536 ht->privdata = privDataPtr;
537 return JIM_OK;
540 /* Resize the table to the minimal size that contains all the elements,
541 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
542 int Jim_ResizeHashTable(Jim_HashTable *ht)
544 int minimal = ht->used;
546 if (minimal < JIM_HT_INITIAL_SIZE)
547 minimal = JIM_HT_INITIAL_SIZE;
548 return Jim_ExpandHashTable(ht, minimal);
551 /* Expand or create the hashtable */
552 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
554 Jim_HashTable n; /* the new hashtable */
555 unsigned int realsize = JimHashTableNextPower(size), i;
557 /* the size is invalid if it is smaller than the number of
558 * elements already inside the hashtable */
559 if (ht->used >= size)
560 return JIM_ERR;
562 Jim_InitHashTable(&n, ht->type, ht->privdata);
563 n.size = realsize;
564 n.sizemask = realsize - 1;
565 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
567 /* Initialize all the pointers to NULL */
568 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
570 /* Copy all the elements from the old to the new table:
571 * note that if the old hash table is empty ht->size is zero,
572 * so Jim_ExpandHashTable just creates an hash table. */
573 n.used = ht->used;
574 for (i = 0; i < ht->size && ht->used > 0; i++) {
575 Jim_HashEntry *he, *nextHe;
577 if (ht->table[i] == NULL)
578 continue;
580 /* For each hash entry on this slot... */
581 he = ht->table[i];
582 while (he) {
583 unsigned int h;
585 nextHe = he->next;
586 /* Get the new element index */
587 h = Jim_HashKey(ht, he->key) & n.sizemask;
588 he->next = n.table[h];
589 n.table[h] = he;
590 ht->used--;
591 /* Pass to the next element */
592 he = nextHe;
595 assert(ht->used == 0);
596 Jim_Free(ht->table);
598 /* Remap the new hashtable in the old */
599 *ht = n;
600 return JIM_OK;
603 /* Add an element to the target hash table */
604 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
606 int index;
607 Jim_HashEntry *entry;
609 /* Get the index of the new element, or -1 if
610 * the element already exists. */
611 if ((index = JimInsertHashEntry(ht, key)) == -1)
612 return JIM_ERR;
614 /* Allocates the memory and stores key */
615 entry = Jim_Alloc(sizeof(*entry));
616 entry->next = ht->table[index];
617 ht->table[index] = entry;
619 /* Set the hash entry fields. */
620 Jim_SetHashKey(ht, entry, key);
621 Jim_SetHashVal(ht, entry, val);
622 ht->used++;
623 return JIM_OK;
626 /* Add an element, discarding the old if the key already exists */
627 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
629 Jim_HashEntry *entry;
631 /* Try to add the element. If the key
632 * does not exists Jim_AddHashEntry will suceed. */
633 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
634 return JIM_OK;
635 /* It already exists, get the entry */
636 entry = Jim_FindHashEntry(ht, key);
637 /* Free the old value and set the new one */
638 Jim_FreeEntryVal(ht, entry);
639 Jim_SetHashVal(ht, entry, val);
640 return JIM_OK;
643 /* Search and remove an element */
644 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
646 unsigned int h;
647 Jim_HashEntry *he, *prevHe;
649 if (ht->size == 0)
650 return JIM_ERR;
651 h = Jim_HashKey(ht, key) & ht->sizemask;
652 he = ht->table[h];
654 prevHe = NULL;
655 while (he) {
656 if (Jim_CompareHashKeys(ht, key, he->key)) {
657 /* Unlink the element from the list */
658 if (prevHe)
659 prevHe->next = he->next;
660 else
661 ht->table[h] = he->next;
662 Jim_FreeEntryKey(ht, he);
663 Jim_FreeEntryVal(ht, he);
664 Jim_Free(he);
665 ht->used--;
666 return JIM_OK;
668 prevHe = he;
669 he = he->next;
671 return JIM_ERR; /* not found */
674 /* Destroy an entire hash table */
675 int Jim_FreeHashTable(Jim_HashTable *ht)
677 unsigned int i;
679 /* Free all the elements */
680 for (i = 0; i < ht->size && ht->used > 0; i++) {
681 Jim_HashEntry *he, *nextHe;
683 if ((he = ht->table[i]) == NULL)
684 continue;
685 while (he) {
686 nextHe = he->next;
687 Jim_FreeEntryKey(ht, he);
688 Jim_FreeEntryVal(ht, he);
689 Jim_Free(he);
690 ht->used--;
691 he = nextHe;
694 /* Free the table and the allocated cache structure */
695 Jim_Free(ht->table);
696 /* Re-initialize the table */
697 JimResetHashTable(ht);
698 return JIM_OK; /* never fails */
701 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
703 Jim_HashEntry *he;
704 unsigned int h;
706 if (ht->size == 0)
707 return NULL;
708 h = Jim_HashKey(ht, key) & ht->sizemask;
709 he = ht->table[h];
710 while (he) {
711 if (Jim_CompareHashKeys(ht, key, he->key))
712 return he;
713 he = he->next;
715 return NULL;
718 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
720 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
722 iter->ht = ht;
723 iter->index = -1;
724 iter->entry = NULL;
725 iter->nextEntry = NULL;
726 return iter;
729 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
731 while (1) {
732 if (iter->entry == NULL) {
733 iter->index++;
734 if (iter->index >= (signed)iter->ht->size)
735 break;
736 iter->entry = iter->ht->table[iter->index];
738 else {
739 iter->entry = iter->nextEntry;
741 if (iter->entry) {
742 /* We need to save the 'next' here, the iterator user
743 * may delete the entry we are returning. */
744 iter->nextEntry = iter->entry->next;
745 return iter->entry;
748 return NULL;
751 /* ------------------------- private functions ------------------------------ */
753 /* Expand the hash table if needed */
754 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
756 /* If the hash table is empty expand it to the intial size,
757 * if the table is "full" dobule its size. */
758 if (ht->size == 0)
759 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
760 if (ht->size == ht->used)
761 return Jim_ExpandHashTable(ht, ht->size * 2);
762 return JIM_OK;
765 /* Our hash table capability is a power of two */
766 static unsigned int JimHashTableNextPower(unsigned int size)
768 unsigned int i = JIM_HT_INITIAL_SIZE;
770 if (size >= 2147483648U)
771 return 2147483648U;
772 while (1) {
773 if (i >= size)
774 return i;
775 i *= 2;
779 /* Returns the index of a free slot that can be populated with
780 * an hash entry for the given 'key'.
781 * If the key already exists, -1 is returned. */
782 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
784 unsigned int h;
785 Jim_HashEntry *he;
787 /* Expand the hashtable if needed */
788 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
789 return -1;
790 /* Compute the key hash value */
791 h = Jim_HashKey(ht, key) & ht->sizemask;
792 /* Search if this slot does not already contain the given key */
793 he = ht->table[h];
794 while (he) {
795 if (Jim_CompareHashKeys(ht, key, he->key))
796 return -1;
797 he = he->next;
799 return h;
802 /* ----------------------- StringCopy Hash Table Type ------------------------*/
804 static unsigned int JimStringCopyHTHashFunction(const void *key)
806 return Jim_GenHashFunction(key, strlen(key));
809 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
811 int len = strlen(key);
812 char *copy = Jim_Alloc(len + 1);
814 JIM_NOTUSED(privdata);
816 memcpy(copy, key, len);
817 copy[len] = '\0';
818 return copy;
821 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
823 int len = strlen(val);
824 char *copy = Jim_Alloc(len + 1);
826 JIM_NOTUSED(privdata);
828 memcpy(copy, val, len);
829 copy[len] = '\0';
830 return copy;
833 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
835 JIM_NOTUSED(privdata);
837 return strcmp(key1, key2) == 0;
840 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
842 JIM_NOTUSED(privdata);
844 Jim_Free((void *)key); /* ATTENTION: const cast */
847 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
849 JIM_NOTUSED(privdata);
851 Jim_Free((void *)val); /* ATTENTION: const cast */
854 #if 0
855 static Jim_HashTableType JimStringCopyHashTableType = {
856 JimStringCopyHTHashFunction, /* hash function */
857 JimStringCopyHTKeyDup, /* key dup */
858 NULL, /* val dup */
859 JimStringCopyHTKeyCompare, /* key compare */
860 JimStringCopyHTKeyDestructor, /* key destructor */
861 NULL /* val destructor */
863 #endif
865 /* This is like StringCopy but does not auto-duplicate the key.
866 * It's used for intepreter's shared strings. */
867 static const Jim_HashTableType JimSharedStringsHashTableType = {
868 JimStringCopyHTHashFunction, /* hash function */
869 NULL, /* key dup */
870 NULL, /* val dup */
871 JimStringCopyHTKeyCompare, /* key compare */
872 JimStringCopyHTKeyDestructor, /* key destructor */
873 NULL /* val destructor */
876 /* This is like StringCopy but also automatically handle dynamic
877 * allocated C strings as values. */
878 static const Jim_HashTableType JimStringKeyValCopyHashTableType = {
879 JimStringCopyHTHashFunction, /* hash function */
880 JimStringCopyHTKeyDup, /* key dup */
881 JimStringKeyValCopyHTValDup, /* val dup */
882 JimStringCopyHTKeyCompare, /* key compare */
883 JimStringCopyHTKeyDestructor, /* key destructor */
884 JimStringKeyValCopyHTValDestructor, /* val destructor */
887 typedef struct AssocDataValue
889 Jim_InterpDeleteProc *delProc;
890 void *data;
891 } AssocDataValue;
893 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
895 AssocDataValue *assocPtr = (AssocDataValue *) data;
897 if (assocPtr->delProc != NULL)
898 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
899 Jim_Free(data);
902 static const Jim_HashTableType JimAssocDataHashTableType = {
903 JimStringCopyHTHashFunction, /* hash function */
904 JimStringCopyHTKeyDup, /* key dup */
905 NULL, /* val dup */
906 JimStringCopyHTKeyCompare, /* key compare */
907 JimStringCopyHTKeyDestructor, /* key destructor */
908 JimAssocDataHashTableValueDestructor /* val destructor */
911 /* -----------------------------------------------------------------------------
912 * Stack - This is a simple generic stack implementation. It is used for
913 * example in the 'expr' expression compiler.
914 * ---------------------------------------------------------------------------*/
915 void Jim_InitStack(Jim_Stack *stack)
917 stack->len = 0;
918 stack->maxlen = 0;
919 stack->vector = NULL;
922 void Jim_FreeStack(Jim_Stack *stack)
924 Jim_Free(stack->vector);
927 int Jim_StackLen(Jim_Stack *stack)
929 return stack->len;
932 void Jim_StackPush(Jim_Stack *stack, void *element)
934 int neededLen = stack->len + 1;
936 if (neededLen > stack->maxlen) {
937 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
938 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
940 stack->vector[stack->len] = element;
941 stack->len++;
944 void *Jim_StackPop(Jim_Stack *stack)
946 if (stack->len == 0)
947 return NULL;
948 stack->len--;
949 return stack->vector[stack->len];
952 void *Jim_StackPeek(Jim_Stack *stack)
954 if (stack->len == 0)
955 return NULL;
956 return stack->vector[stack->len - 1];
959 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
961 int i;
963 for (i = 0; i < stack->len; i++)
964 freeFunc(stack->vector[i]);
967 /* -----------------------------------------------------------------------------
968 * Parser
969 * ---------------------------------------------------------------------------*/
971 /* Token types */
972 #define JIM_TT_NONE 0 /* No token returned */
973 #define JIM_TT_STR 1 /* simple string */
974 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
975 #define JIM_TT_VAR 3 /* var substitution */
976 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
977 #define JIM_TT_CMD 5 /* command substitution */
978 #define JIM_TT_SEP 6 /* word separator */
979 #define JIM_TT_EOL 7 /* line separator */
980 #define JIM_TT_EOF 8 /* end of script */
982 /* Additional token types needed for expressions */
983 #define JIM_TT_SUBEXPR_START 10
984 #define JIM_TT_SUBEXPR_END 11
985 #define JIM_TT_EXPR_INT 12
986 #define JIM_TT_EXPR_DOUBLE 13
988 /* Operator token types start here */
989 #define JIM_TT_EXPR_OP 15
991 /* Parser states */
992 #define JIM_PS_DEF 0 /* Default state */
993 #define JIM_PS_QUOTE 1 /* Inside "" */
994 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
996 /* Parser context structure. The same context is used both to parse
997 * Tcl scripts and lists. */
998 struct JimParserCtx
1000 const char *prg; /* Program text */
1001 const char *p; /* Pointer to the point of the program we are parsing */
1002 int len; /* Left length of 'prg' */
1003 int linenr; /* Current line number */
1004 const char *tstart;
1005 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1006 int tline; /* Line number of the returned token */
1007 int tt; /* Token type */
1008 int eof; /* Non zero if EOF condition is true. */
1009 int state; /* Parser state */
1010 int comment; /* Non zero if the next chars may be a comment. */
1011 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1014 #define JimParserEof(c) ((c)->eof)
1015 #define JimParserTstart(c) ((c)->tstart)
1016 #define JimParserTend(c) ((c)->tend)
1017 #define JimParserTtype(c) ((c)->tt)
1018 #define JimParserTline(c) ((c)->tline)
1020 static int JimParseScript(struct JimParserCtx *pc);
1021 static int JimParseSep(struct JimParserCtx *pc);
1022 static int JimParseEol(struct JimParserCtx *pc);
1023 static int JimParseCmd(struct JimParserCtx *pc);
1024 static int JimParseVar(struct JimParserCtx *pc);
1025 static int JimParseBrace(struct JimParserCtx *pc);
1026 static int JimParseStr(struct JimParserCtx *pc);
1027 static int JimParseComment(struct JimParserCtx *pc);
1028 static char *JimParserGetToken(struct JimParserCtx *pc, int *lenPtr, int *typePtr, int *linePtr);
1030 /* Initialize a parser context.
1031 * 'prg' is a pointer to the program text, linenr is the line
1032 * number of the first line contained in the program. */
1033 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1035 pc->prg = prg;
1036 pc->p = prg;
1037 pc->len = len;
1038 pc->tstart = NULL;
1039 pc->tend = NULL;
1040 pc->tline = 0;
1041 pc->tt = JIM_TT_NONE;
1042 pc->eof = 0;
1043 pc->state = JIM_PS_DEF;
1044 pc->linenr = linenr;
1045 pc->comment = 1;
1046 pc->missing = ' ';
1049 static int JimParseScript(struct JimParserCtx *pc)
1051 while (1) { /* the while is used to reiterate with continue if needed */
1052 if (!pc->len) {
1053 pc->tstart = pc->p;
1054 pc->tend = pc->p - 1;
1055 pc->tline = pc->linenr;
1056 pc->tt = JIM_TT_EOL;
1057 pc->eof = 1;
1058 return JIM_OK;
1060 switch (*(pc->p)) {
1061 case '\\':
1062 if (*(pc->p + 1) == '\n')
1063 return JimParseSep(pc);
1064 else {
1065 pc->comment = 0;
1066 return JimParseStr(pc);
1068 break;
1069 case ' ':
1070 case '\t':
1071 case '\r':
1072 if (pc->state == JIM_PS_DEF)
1073 return JimParseSep(pc);
1074 else {
1075 pc->comment = 0;
1076 return JimParseStr(pc);
1078 break;
1079 case '\n':
1080 case ';':
1081 pc->comment = 1;
1082 if (pc->state == JIM_PS_DEF)
1083 return JimParseEol(pc);
1084 else
1085 return JimParseStr(pc);
1086 break;
1087 case '[':
1088 pc->comment = 0;
1089 return JimParseCmd(pc);
1090 break;
1091 case '$':
1092 pc->comment = 0;
1093 if (JimParseVar(pc) == JIM_ERR) {
1094 pc->tstart = pc->tend = pc->p++;
1095 pc->len--;
1096 pc->tline = pc->linenr;
1097 pc->tt = JIM_TT_STR;
1098 return JIM_OK;
1100 else
1101 return JIM_OK;
1102 break;
1103 case '#':
1104 if (pc->comment) {
1105 JimParseComment(pc);
1106 continue;
1108 else {
1109 return JimParseStr(pc);
1111 default:
1112 pc->comment = 0;
1113 return JimParseStr(pc);
1114 break;
1116 return JIM_OK;
1120 static int JimParseSep(struct JimParserCtx *pc)
1122 pc->tstart = pc->p;
1123 pc->tline = pc->linenr;
1124 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1125 (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1126 if (*pc->p == '\\') {
1127 pc->p++;
1128 pc->len--;
1129 pc->linenr++;
1131 pc->p++;
1132 pc->len--;
1134 pc->tend = pc->p - 1;
1135 pc->tt = JIM_TT_SEP;
1136 return JIM_OK;
1139 static int JimParseEol(struct JimParserCtx *pc)
1141 pc->tstart = pc->p;
1142 pc->tline = pc->linenr;
1143 while (*pc->p == ' ' || *pc->p == '\n' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1144 if (*pc->p == '\n')
1145 pc->linenr++;
1146 pc->p++;
1147 pc->len--;
1149 pc->tend = pc->p - 1;
1150 pc->tt = JIM_TT_EOL;
1151 return JIM_OK;
1154 /* Todo. Don't stop if ']' appears inside {} or quoted.
1155 * Also should handle the case of puts [string length "]"] */
1156 static int JimParseCmd(struct JimParserCtx *pc)
1158 int level = 1;
1159 int blevel = 0;
1161 pc->tstart = ++pc->p;
1162 pc->len--;
1163 pc->tline = pc->linenr;
1164 while (1) {
1165 if (pc->len == 0) {
1166 break;
1168 else if (*pc->p == '[' && blevel == 0) {
1169 level++;
1171 else if (*pc->p == ']' && blevel == 0) {
1172 level--;
1173 if (!level)
1174 break;
1176 else if (*pc->p == '\\') {
1177 pc->p++;
1178 pc->len--;
1179 if (*pc->p == '\n')
1180 pc->linenr++;
1182 else if (*pc->p == '{') {
1183 blevel++;
1185 else if (*pc->p == '}') {
1186 if (blevel != 0)
1187 blevel--;
1189 else if (*pc->p == '\n')
1190 pc->linenr++;
1191 pc->p++;
1192 pc->len--;
1194 pc->tend = pc->p - 1;
1195 pc->tt = JIM_TT_CMD;
1196 if (*pc->p == ']') {
1197 pc->p++;
1198 pc->len--;
1200 return JIM_OK;
1203 static int JimParseVar(struct JimParserCtx *pc)
1205 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1207 pc->tstart = ++pc->p;
1208 pc->len--; /* skip the $ */
1209 pc->tline = pc->linenr;
1210 if (*pc->p == '{') {
1211 pc->tstart = ++pc->p;
1212 pc->len--;
1213 brace = 1;
1215 if (brace) {
1216 while (!stop) {
1217 if (*pc->p == '}' || pc->len == 0) {
1218 pc->tend = pc->p - 1;
1219 stop = 1;
1220 if (pc->len == 0)
1221 break;
1223 else if (*pc->p == '\n')
1224 pc->linenr++;
1225 pc->p++;
1226 pc->len--;
1229 else {
1230 /* Include leading colons */
1231 while (*pc->p == ':') {
1232 pc->p++;
1233 pc->len--;
1235 while (!stop) {
1236 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1237 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1238 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1239 stop = 1;
1240 else {
1241 pc->p++;
1242 pc->len--;
1245 /* Parse [dict get] syntax sugar. */
1246 if (*pc->p == '(') {
1247 int count = 1;
1249 while (count && pc->len) {
1250 pc->p++;
1251 pc->len--;
1252 if (*pc->p == '\\' && pc->len >= 2) {
1253 pc->p += 2;
1254 pc->len -= 2;
1256 else if (*pc->p == '(') {
1257 count++;
1259 else if (*pc->p == ')') {
1260 count--;
1263 if (*pc->p != '\0') {
1264 pc->p++;
1265 pc->len--;
1267 ttype = JIM_TT_DICTSUGAR;
1269 pc->tend = pc->p - 1;
1271 /* Check if we parsed just the '$' character.
1272 * That's not a variable so an error is returned
1273 * to tell the state machine to consider this '$' just
1274 * a string. */
1275 if (pc->tstart == pc->p) {
1276 pc->p--;
1277 pc->len++;
1278 return JIM_ERR;
1280 pc->tt = ttype;
1281 return JIM_OK;
1284 static int JimParseBrace(struct JimParserCtx *pc)
1286 int level = 1;
1288 pc->tstart = ++pc->p;
1289 pc->len--;
1290 pc->tline = pc->linenr;
1291 while (1) {
1292 if (*pc->p == '\\' && pc->len >= 2) {
1293 pc->p++;
1294 pc->len--;
1295 if (*pc->p == '\n')
1296 pc->linenr++;
1298 else if (*pc->p == '{') {
1299 level++;
1301 else if (pc->len == 0 || *pc->p == '}') {
1302 if (pc->len == 0) {
1303 pc->missing = '{';
1305 level--;
1306 if (pc->len == 0 || level == 0) {
1307 pc->tend = pc->p - 1;
1308 if (pc->len != 0) {
1309 pc->p++;
1310 pc->len--;
1312 pc->tt = JIM_TT_STR;
1313 return JIM_OK;
1316 else if (*pc->p == '\n') {
1317 pc->linenr++;
1319 pc->p++;
1320 pc->len--;
1322 return JIM_OK; /* unreached */
1325 static int JimParseStr(struct JimParserCtx *pc)
1327 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1328 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1329 if (newword && *pc->p == '{') {
1330 return JimParseBrace(pc);
1332 else if (newword && *pc->p == '"') {
1333 pc->state = JIM_PS_QUOTE;
1334 pc->p++;
1335 pc->len--;
1337 pc->tstart = pc->p;
1338 pc->tline = pc->linenr;
1339 while (1) {
1340 if (pc->len == 0) {
1341 if (pc->state == JIM_PS_QUOTE) {
1342 pc->missing = '"';
1344 pc->tend = pc->p - 1;
1345 pc->tt = JIM_TT_ESC;
1346 return JIM_OK;
1348 switch (*pc->p) {
1349 case '\\':
1350 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1351 pc->tend = pc->p - 1;
1352 pc->tt = JIM_TT_ESC;
1353 return JIM_OK;
1355 if (pc->len >= 2) {
1356 if (*(pc->p + 1) == '\n') {
1357 pc->linenr++;
1359 pc->p++;
1360 pc->len--;
1362 break;
1363 case '(':
1364 /* If the following token is not '$' just keep going */
1365 if (pc->len > 1 && pc->p[1] != '$') {
1366 break;
1368 case ')':
1369 /* Only need a separate ')' token if the previous was a var */
1370 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1371 if (pc->p == pc->tstart) {
1372 /* At the start of the token, so just return this char */
1373 pc->p++;
1374 pc->len--;
1376 pc->tend = pc->p - 1;
1377 pc->tt = JIM_TT_ESC;
1378 return JIM_OK;
1380 break;
1382 case '$':
1383 case '[':
1384 pc->tend = pc->p - 1;
1385 pc->tt = JIM_TT_ESC;
1386 return JIM_OK;
1387 case ' ':
1388 case '\t':
1389 case '\n':
1390 case '\r':
1391 case ';':
1392 if (pc->state == JIM_PS_DEF) {
1393 pc->tend = pc->p - 1;
1394 pc->tt = JIM_TT_ESC;
1395 return JIM_OK;
1397 else if (*pc->p == '\n') {
1398 pc->linenr++;
1400 break;
1401 case '"':
1402 if (pc->state == JIM_PS_QUOTE) {
1403 pc->tend = pc->p - 1;
1404 pc->tt = JIM_TT_ESC;
1405 pc->p++;
1406 pc->len--;
1407 pc->state = JIM_PS_DEF;
1408 return JIM_OK;
1410 break;
1412 pc->p++;
1413 pc->len--;
1415 return JIM_OK; /* unreached */
1418 int JimParseComment(struct JimParserCtx *pc)
1420 while (*pc->p) {
1421 if (*pc->p == '\n') {
1422 pc->linenr++;
1423 if (*(pc->p - 1) != '\\') {
1424 pc->p++;
1425 pc->len--;
1426 return JIM_OK;
1429 pc->p++;
1430 pc->len--;
1432 return JIM_OK;
1435 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1436 static int xdigitval(int c)
1438 if (c >= '0' && c <= '9')
1439 return c - '0';
1440 if (c >= 'a' && c <= 'f')
1441 return c - 'a' + 10;
1442 if (c >= 'A' && c <= 'F')
1443 return c - 'A' + 10;
1444 return -1;
1447 static int odigitval(int c)
1449 if (c >= '0' && c <= '7')
1450 return c - '0';
1451 return -1;
1454 /* Perform Tcl escape substitution of 's', storing the result
1455 * string into 'dest'. The escaped string is guaranteed to
1456 * be the same length or shorted than the source string.
1457 * Slen is the length of the string at 's', if it's -1 the string
1458 * length will be calculated by the function.
1460 * The function returns the length of the resulting string. */
1461 static int JimEscape(char *dest, const char *s, int slen)
1463 char *p = dest;
1464 int i, len;
1466 if (slen == -1)
1467 slen = strlen(s);
1469 for (i = 0; i < slen; i++) {
1470 switch (s[i]) {
1471 case '\\':
1472 switch (s[i + 1]) {
1473 case 'a':
1474 *p++ = 0x7;
1475 i++;
1476 break;
1477 case 'b':
1478 *p++ = 0x8;
1479 i++;
1480 break;
1481 case 'f':
1482 *p++ = 0xc;
1483 i++;
1484 break;
1485 case 'n':
1486 *p++ = 0xa;
1487 i++;
1488 break;
1489 case 'r':
1490 *p++ = 0xd;
1491 i++;
1492 break;
1493 case 't':
1494 *p++ = 0x9;
1495 i++;
1496 break;
1497 case 'v':
1498 *p++ = 0xb;
1499 i++;
1500 break;
1501 case '\0':
1502 *p++ = '\\';
1503 i++;
1504 break;
1505 case '\n':
1506 *p++ = ' ';
1507 i++;
1508 break;
1509 default:
1510 if (s[i + 1] == 'x') {
1511 int val = 0;
1512 int c = xdigitval(s[i + 2]);
1514 if (c == -1) {
1515 *p++ = 'x';
1516 i++;
1517 break;
1519 val = c;
1520 c = xdigitval(s[i + 3]);
1521 if (c == -1) {
1522 *p++ = val;
1523 i += 2;
1524 break;
1526 val = (val * 16) + c;
1527 *p++ = val;
1528 i += 3;
1529 break;
1531 else if (s[i + 1] >= '0' && s[i + 1] <= '7') {
1532 int val = 0;
1533 int c = odigitval(s[i + 1]);
1535 val = c;
1536 c = odigitval(s[i + 2]);
1537 if (c == -1) {
1538 *p++ = val;
1539 i++;
1540 break;
1542 val = (val * 8) + c;
1543 c = odigitval(s[i + 3]);
1544 if (c == -1) {
1545 *p++ = val;
1546 i += 2;
1547 break;
1549 val = (val * 8) + c;
1550 *p++ = val;
1551 i += 3;
1553 else {
1554 *p++ = s[i + 1];
1555 i++;
1557 break;
1559 break;
1560 default:
1561 *p++ = s[i];
1562 break;
1565 len = p - dest;
1566 *p = '\0';
1567 return len;
1570 /* Returns a dynamically allocated copy of the current token in the
1571 * parser context. The function performs conversion of escapes if
1572 * the token is of type JIM_TT_ESC.
1574 * Note that after the conversion, tokens that are grouped with
1575 * braces in the source code, are always recognizable from the
1576 * identical string obtained in a different way from the type.
1578 * For example the string:
1580 * {*}$a
1582 * will return as first token "*", of type JIM_TT_STR
1584 * While the string:
1586 * *$a
1588 * will return as first token "*", of type JIM_TT_ESC
1590 char *JimParserGetToken(struct JimParserCtx *pc, int *lenPtr, int *typePtr, int *linePtr)
1592 const char *start, *end;
1593 char *token;
1594 int len;
1596 start = JimParserTstart(pc);
1597 end = JimParserTend(pc);
1598 if (start > end) {
1599 len = 0;
1600 token = Jim_Alloc(1);
1601 token[0] = '\0';
1603 else {
1604 len = (end - start) + 1;
1605 token = Jim_Alloc(len + 1);
1606 if (JimParserTtype(pc) != JIM_TT_ESC) {
1607 /* No escape conversion needed? Just copy it. */
1608 memcpy(token, start, len);
1609 token[len] = '\0';
1611 else {
1612 /* Else convert the escape chars. */
1613 len = JimEscape(token, start, len);
1616 if (lenPtr)
1617 *lenPtr = len;
1618 if (typePtr)
1619 *typePtr = JimParserTtype(pc);
1620 if (linePtr)
1621 *linePtr = JimParserTline(pc);
1622 return token;
1625 /* Parses the given string to determine if it represents a complete script.
1627 * This is useful for interactive shells implementation, for [info complete]
1628 * and is used by source/Jim_EvalFile().
1630 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1631 * '{' on scripts incomplete missing one or more '}' to be balanced.
1632 * '"' on scripts incomplete missing a '"' char.
1634 * If the script is complete, 1 is returned, otherwise 0.
1636 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1638 struct JimParserCtx parser;
1640 JimParserInit(&parser, s, len, 1);
1641 while (!JimParserEof(&parser)) {
1642 JimParseScript(&parser);
1644 if (stateCharPtr) {
1645 *stateCharPtr = parser.missing;
1647 return parser.missing == ' ';
1650 /* -----------------------------------------------------------------------------
1651 * Tcl Lists parsing
1652 * ---------------------------------------------------------------------------*/
1653 static int JimParseListSep(struct JimParserCtx *pc);
1654 static int JimParseListStr(struct JimParserCtx *pc);
1656 int JimParseList(struct JimParserCtx *pc)
1658 if (pc->len == 0) {
1659 pc->tstart = pc->tend = pc->p;
1660 pc->tline = pc->linenr;
1661 pc->tt = JIM_TT_EOL;
1662 pc->eof = 1;
1663 return JIM_OK;
1665 switch (*pc->p) {
1666 case ' ':
1667 case '\n':
1668 case '\t':
1669 case '\r':
1670 if (pc->state == JIM_PS_DEF)
1671 return JimParseListSep(pc);
1672 else
1673 return JimParseListStr(pc);
1674 break;
1675 default:
1676 return JimParseListStr(pc);
1677 break;
1679 return JIM_OK;
1682 int JimParseListSep(struct JimParserCtx *pc)
1684 pc->tstart = pc->p;
1685 pc->tline = pc->linenr;
1686 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n') {
1687 pc->p++;
1688 pc->len--;
1690 pc->tend = pc->p - 1;
1691 pc->tt = JIM_TT_SEP;
1692 return JIM_OK;
1695 int JimParseListStr(struct JimParserCtx *pc)
1697 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL || pc->tt == JIM_TT_NONE);
1699 if (newword && *pc->p == '{') {
1700 return JimParseBrace(pc);
1702 else if (newword && *pc->p == '"') {
1703 pc->state = JIM_PS_QUOTE;
1704 pc->p++;
1705 pc->len--;
1707 pc->tstart = pc->p;
1708 pc->tline = pc->linenr;
1709 while (1) {
1710 if (pc->len == 0) {
1711 pc->tend = pc->p - 1;
1712 pc->tt = JIM_TT_ESC;
1713 return JIM_OK;
1715 switch (*pc->p) {
1716 case '\\':
1717 pc->p++;
1718 pc->len--;
1719 break;
1720 case ' ':
1721 case '\t':
1722 case '\n':
1723 case '\r':
1724 if (pc->state == JIM_PS_DEF) {
1725 pc->tend = pc->p - 1;
1726 pc->tt = JIM_TT_ESC;
1727 return JIM_OK;
1729 else if (*pc->p == '\n') {
1730 pc->linenr++;
1732 break;
1733 case '"':
1734 if (pc->state == JIM_PS_QUOTE) {
1735 pc->tend = pc->p - 1;
1736 pc->tt = JIM_TT_ESC;
1737 pc->p++;
1738 pc->len--;
1739 pc->state = JIM_PS_DEF;
1740 return JIM_OK;
1742 break;
1744 pc->p++;
1745 pc->len--;
1747 return JIM_OK; /* unreached */
1750 /* -----------------------------------------------------------------------------
1751 * Jim_Obj related functions
1752 * ---------------------------------------------------------------------------*/
1754 /* Return a new initialized object. */
1755 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1757 Jim_Obj *objPtr;
1759 /* -- Check if there are objects in the free list -- */
1760 if (interp->freeList != NULL) {
1761 /* -- Unlink the object from the free list -- */
1762 objPtr = interp->freeList;
1763 interp->freeList = objPtr->nextObjPtr;
1765 else {
1766 /* -- No ready to use objects: allocate a new one -- */
1767 objPtr = Jim_Alloc(sizeof(*objPtr));
1770 /* Object is returned with refCount of 0. Every
1771 * kind of GC implemented should take care to don't try
1772 * to scan objects with refCount == 0. */
1773 objPtr->refCount = 0;
1774 /* All the other fields are left not initialized to save time.
1775 * The caller will probably want to set them to the right
1776 * value anyway. */
1778 /* -- Put the object into the live list -- */
1779 objPtr->prevObjPtr = NULL;
1780 objPtr->nextObjPtr = interp->liveList;
1781 if (interp->liveList)
1782 interp->liveList->prevObjPtr = objPtr;
1783 interp->liveList = objPtr;
1785 return objPtr;
1788 /* Free an object. Actually objects are never freed, but
1789 * just moved to the free objects list, where they will be
1790 * reused by Jim_NewObj(). */
1791 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1793 /* Check if the object was already freed, panic. */
1794 if (objPtr->refCount != 0) {
1795 Jim_Panic(interp, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
1796 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>");
1799 /* Free the internal representation */
1800 Jim_FreeIntRep(interp, objPtr);
1801 /* Free the string representation */
1802 if (objPtr->bytes != NULL) {
1803 if (objPtr->bytes != JimEmptyStringRep)
1804 Jim_Free(objPtr->bytes);
1806 /* Unlink the object from the live objects list */
1807 if (objPtr->prevObjPtr)
1808 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1809 if (objPtr->nextObjPtr)
1810 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1811 if (interp->liveList == objPtr)
1812 interp->liveList = objPtr->nextObjPtr;
1813 /* Link the object into the free objects list */
1814 objPtr->prevObjPtr = NULL;
1815 objPtr->nextObjPtr = interp->freeList;
1816 if (interp->freeList)
1817 interp->freeList->prevObjPtr = objPtr;
1818 interp->freeList = objPtr;
1819 objPtr->refCount = -1;
1822 /* Invalidate the string representation of an object. */
1823 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1825 if (objPtr->bytes != NULL) {
1826 if (objPtr->bytes != JimEmptyStringRep)
1827 Jim_Free(objPtr->bytes);
1829 objPtr->bytes = NULL;
1832 #define Jim_SetStringRep(o, b, l) \
1833 do { (o)->bytes = b; (o)->length = l; } while (0)
1835 /* Set the initial string representation for an object.
1836 * Does not try to free an old one. */
1837 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1839 if (length == 0) {
1840 objPtr->bytes = JimEmptyStringRep;
1841 objPtr->length = 0;
1843 else {
1844 objPtr->bytes = Jim_Alloc(length + 1);
1845 objPtr->length = length;
1846 memcpy(objPtr->bytes, bytes, length);
1847 objPtr->bytes[length] = '\0';
1851 /* Duplicate an object. The returned object has refcount = 0. */
1852 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1854 Jim_Obj *dupPtr;
1856 dupPtr = Jim_NewObj(interp);
1857 if (objPtr->bytes == NULL) {
1858 /* Object does not have a valid string representation. */
1859 dupPtr->bytes = NULL;
1861 else {
1862 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1864 if (objPtr->typePtr != NULL) {
1865 if (objPtr->typePtr->dupIntRepProc == NULL) {
1866 dupPtr->internalRep = objPtr->internalRep;
1868 else {
1869 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1871 dupPtr->typePtr = objPtr->typePtr;
1873 else {
1874 dupPtr->typePtr = NULL;
1876 return dupPtr;
1879 /* Return the string representation for objPtr. If the object
1880 * string representation is invalid, calls the method to create
1881 * a new one starting from the internal representation of the object. */
1882 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1884 if (objPtr->bytes == NULL) {
1885 /* Invalid string repr. Generate it. */
1886 if (objPtr->typePtr->updateStringProc == NULL) {
1887 Jim_Panic(NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name);
1889 objPtr->typePtr->updateStringProc(objPtr);
1891 if (lenPtr)
1892 *lenPtr = objPtr->length;
1893 return objPtr->bytes;
1896 /* Just returns the length of the object's string rep */
1897 int Jim_Length(Jim_Obj *objPtr)
1899 int len;
1901 Jim_GetString(objPtr, &len);
1902 return len;
1905 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
1906 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1908 static const Jim_ObjType dictSubstObjType = {
1909 "dict-substitution",
1910 FreeDictSubstInternalRep,
1911 DupDictSubstInternalRep,
1912 NULL,
1913 JIM_TYPE_NONE,
1916 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
1918 Jim_DecrRefCount(interp, (Jim_Obj *)objPtr->internalRep.twoPtrValue.ptr2);
1921 static const Jim_ObjType interpolatedObjType = {
1922 "interpolated",
1923 FreeInterpolatedInternalRep,
1924 NULL,
1925 NULL,
1926 JIM_TYPE_NONE,
1929 /* -----------------------------------------------------------------------------
1930 * String Object
1931 * ---------------------------------------------------------------------------*/
1932 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1933 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1935 static const Jim_ObjType stringObjType = {
1936 "string",
1937 NULL,
1938 DupStringInternalRep,
1939 NULL,
1940 JIM_TYPE_REFERENCES,
1943 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1945 JIM_NOTUSED(interp);
1947 /* This is a bit subtle: the only caller of this function
1948 * should be Jim_DuplicateObj(), that will copy the
1949 * string representaion. After the copy, the duplicated
1950 * object will not have more room in teh buffer than
1951 * srcPtr->length bytes. So we just set it to length. */
1952 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1955 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1957 /* Get a fresh string representation. */
1958 (void)Jim_GetString(objPtr, NULL);
1959 /* Free any other internal representation. */
1960 Jim_FreeIntRep(interp, objPtr);
1961 /* Set it as string, i.e. just set the maxLength field. */
1962 objPtr->typePtr = &stringObjType;
1963 objPtr->internalRep.strValue.maxLength = objPtr->length;
1964 return JIM_OK;
1967 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1969 Jim_Obj *objPtr = Jim_NewObj(interp);
1971 if (len == -1)
1972 len = strlen(s);
1973 /* Alloc/Set the string rep. */
1974 if (len == 0) {
1975 objPtr->bytes = JimEmptyStringRep;
1976 objPtr->length = 0;
1978 else {
1979 objPtr->bytes = Jim_Alloc(len + 1);
1980 objPtr->length = len;
1981 memcpy(objPtr->bytes, s, len);
1982 objPtr->bytes[len] = '\0';
1985 /* No typePtr field for the vanilla string object. */
1986 objPtr->typePtr = NULL;
1987 return objPtr;
1990 /* This version does not try to duplicate the 's' pointer, but
1991 * use it directly. */
1992 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
1994 Jim_Obj *objPtr = Jim_NewObj(interp);
1996 if (len == -1)
1997 len = strlen(s);
1998 Jim_SetStringRep(objPtr, s, len);
1999 objPtr->typePtr = NULL;
2000 return objPtr;
2003 /* Low-level string append. Use it only against objects
2004 * of type "string". */
2005 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2007 int needlen;
2009 if (len == -1)
2010 len = strlen(str);
2011 needlen = objPtr->length + len;
2012 if (objPtr->internalRep.strValue.maxLength < needlen ||
2013 objPtr->internalRep.strValue.maxLength == 0) {
2014 if (objPtr->bytes == JimEmptyStringRep) {
2015 objPtr->bytes = Jim_Alloc((needlen * 2) + 1);
2017 else {
2018 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen * 2) + 1);
2020 objPtr->internalRep.strValue.maxLength = needlen * 2;
2022 memcpy(objPtr->bytes + objPtr->length, str, len);
2023 objPtr->bytes[objPtr->length + len] = '\0';
2024 objPtr->length += len;
2027 /* Higher level API to append strings to objects. */
2028 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2030 if (Jim_IsShared(objPtr))
2031 Jim_Panic(interp, "Jim_AppendString called with shared object");
2032 if (objPtr->typePtr != &stringObjType)
2033 SetStringFromAny(interp, objPtr);
2034 StringAppendString(objPtr, str, len);
2037 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2039 int len;
2040 const char *str;
2042 str = Jim_GetString(appendObjPtr, &len);
2043 Jim_AppendString(interp, objPtr, str, len);
2046 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2048 va_list ap;
2050 if (objPtr->typePtr != &stringObjType)
2051 SetStringFromAny(interp, objPtr);
2052 va_start(ap, objPtr);
2053 while (1) {
2054 char *s = va_arg(ap, char *);
2056 if (s == NULL)
2057 break;
2058 Jim_AppendString(interp, objPtr, s, -1);
2060 va_end(ap);
2063 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2065 const char *aStr, *bStr;
2066 int aLen, bLen, i;
2068 if (aObjPtr == bObjPtr)
2069 return 1;
2070 aStr = Jim_GetString(aObjPtr, &aLen);
2071 bStr = Jim_GetString(bObjPtr, &bLen);
2072 if (aLen != bLen)
2073 return 0;
2074 if (nocase == 0)
2075 return memcmp(aStr, bStr, aLen) == 0;
2076 for (i = 0; i < aLen; i++) {
2077 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2078 return 0;
2080 return 1;
2083 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2085 const char *pattern, *string;
2086 int patternLen, stringLen;
2088 pattern = Jim_GetString(patternObjPtr, &patternLen);
2089 string = Jim_GetString(objPtr, &stringLen);
2090 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2093 int Jim_StringCompareObj(Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2095 const char *s1, *s2;
2096 int l1, l2;
2098 s1 = Jim_GetString(firstObjPtr, &l1);
2099 s2 = Jim_GetString(secondObjPtr, &l2);
2100 return JimStringCompare(s1, l1, s2, l2, nocase);
2103 /* Convert a range, as returned by Jim_GetRange(), into
2104 * an absolute index into an object of the specified length.
2105 * This function may return negative values, or values
2106 * bigger or equal to the length of the list if the index
2107 * is out of range. */
2108 static int JimRelToAbsIndex(int len, int index)
2110 if (index < 0)
2111 return len + index;
2112 return index;
2115 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2116 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2117 * for implementation of commands like [string range] and [lrange].
2119 * The resulting range is guaranteed to address valid elements of
2120 * the structure. */
2121 static void JimRelToAbsRange(int len, int first, int last,
2122 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2124 int rangeLen;
2126 if (first > last) {
2127 rangeLen = 0;
2129 else {
2130 rangeLen = last - first + 1;
2131 if (rangeLen) {
2132 if (first < 0) {
2133 rangeLen += first;
2134 first = 0;
2136 if (last >= len) {
2137 rangeLen -= (last - (len - 1));
2138 last = len - 1;
2142 if (rangeLen < 0)
2143 rangeLen = 0;
2145 *firstPtr = first;
2146 *lastPtr = last;
2147 *rangeLenPtr = rangeLen;
2150 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2151 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2153 int first, last;
2154 const char *str;
2155 int len, rangeLen;
2157 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2158 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2159 return NULL;
2160 str = Jim_GetString(strObjPtr, &len);
2161 first = JimRelToAbsIndex(len, first);
2162 last = JimRelToAbsIndex(len, last);
2163 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2164 return Jim_NewStringObj(interp, str + first, rangeLen);
2167 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2169 char *buf;
2170 int i;
2172 if (strObjPtr->typePtr != &stringObjType) {
2173 SetStringFromAny(interp, strObjPtr);
2176 buf = Jim_Alloc(strObjPtr->length + 1);
2178 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2179 for (i = 0; i < strObjPtr->length; i++)
2180 buf[i] = tolower(buf[i]);
2181 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2184 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2186 char *buf;
2187 int i;
2189 if (strObjPtr->typePtr != &stringObjType) {
2190 SetStringFromAny(interp, strObjPtr);
2193 buf = Jim_Alloc(strObjPtr->length + 1);
2195 memcpy(buf, strObjPtr->bytes, strObjPtr->length + 1);
2196 for (i = 0; i < strObjPtr->length; i++)
2197 buf[i] = toupper(buf[i]);
2198 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2201 static const char *trim_left(const char *str, const char *trimchars)
2203 return str + strspn(str, trimchars);
2206 static void trim_right(char *str, const char *trimchars)
2208 char *p = str + strlen(str) - 1;
2209 char *end = str - 1;
2210 int c;
2212 while (p != end) {
2213 c = *p;
2214 if (strchr(trimchars, c) == 0) {
2215 break;
2217 p--;
2219 p[1] = 0;
2222 static const char default_trim_chars[] = " \t\n\r";
2224 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2226 char *buf;
2227 const char *trimchars = default_trim_chars;
2229 if (strObjPtr->typePtr != &stringObjType) {
2230 SetStringFromAny(interp, strObjPtr);
2232 if (trimcharsObjPtr) {
2233 trimchars = Jim_GetString(trimcharsObjPtr, NULL);
2236 buf = Jim_Alloc(strObjPtr->length + 1);
2237 strcpy(buf, trim_left(strObjPtr->bytes, trimchars));
2238 trim_right(buf, trimchars);
2240 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2243 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2245 const char *str = Jim_GetString(strObjPtr, NULL);
2246 const char *trimchars = default_trim_chars;
2248 if (trimcharsObjPtr) {
2249 trimchars = Jim_GetString(trimcharsObjPtr, NULL);
2252 return Jim_NewStringObj(interp, trim_left(str, trimchars), -1);
2255 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2257 char *buf;
2258 const char *trimchars = default_trim_chars;
2260 if (trimcharsObjPtr) {
2261 trimchars = Jim_GetString(trimcharsObjPtr, NULL);
2265 if (strObjPtr->typePtr != &stringObjType) {
2266 SetStringFromAny(interp, strObjPtr);
2269 buf = Jim_StrDup(strObjPtr->bytes);
2270 trim_right(buf, trimchars);
2272 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2276 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2278 static const char *strclassnames[] = {
2279 "integer", "alpha", "alnum", "ascii", "digit",
2280 "double", "lower", "upper", "space", "xdigit",
2281 "control", "print", "graph", "punct",
2282 NULL
2284 enum {
2285 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2286 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2287 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2289 int strclass;
2290 int len;
2291 int i;
2292 const char *str;
2293 int (*isclassfunc)(int c) = NULL;
2295 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2296 return JIM_ERR;
2299 str = Jim_GetString(strObjPtr, &len);
2300 if (len == 0) {
2301 Jim_SetResultInt(interp, !strict);
2302 return JIM_OK;
2305 switch (strclass) {
2306 case STR_IS_INTEGER:
2308 jim_wide w;
2309 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2310 return JIM_OK;
2313 case STR_IS_DOUBLE:
2315 double d;
2316 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2317 return JIM_OK;
2320 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2321 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2322 case STR_IS_ASCII: isclassfunc = isascii; break;
2323 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2324 case STR_IS_LOWER: isclassfunc = islower; break;
2325 case STR_IS_UPPER: isclassfunc = isupper; break;
2326 case STR_IS_SPACE: isclassfunc = isspace; break;
2327 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2328 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2329 case STR_IS_PRINT: isclassfunc = isprint; break;
2330 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2331 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2332 default:
2333 return JIM_ERR;
2336 for (i = 0; i < len; i++) {
2337 if (!isclassfunc(str[i])) {
2338 Jim_SetResultInt(interp, 0);
2339 return JIM_OK;
2342 Jim_SetResultInt(interp, 1);
2343 return JIM_OK;
2346 /* This is the core of the [format] command.
2347 * TODO: Lots of things work - via a hack
2348 * However, no format item can be >= JIM_MAX_FMT
2350 #define JIM_MAX_FMT 2048
2351 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2352 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2354 const char *fmt;
2355 int fmtLen;
2356 Jim_Obj *resObjPtr;
2359 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2360 resObjPtr = Jim_NewStringObj(interp, "", 0);
2361 while (fmtLen) {
2362 const char *p = fmt;
2363 char spec[2], c;
2364 jim_wide wideValue;
2365 double doubleValue;
2367 /* we cheat and use Sprintf()! */
2368 char fmt_str[100];
2369 char *cp;
2370 int width;
2371 int ljust;
2372 int zpad;
2373 int spad;
2374 int altfm;
2375 int forceplus;
2376 int prec;
2377 int inprec;
2378 int haveprec;
2379 int accum;
2380 int buflen = 0;
2382 while (*fmt != '%' && fmtLen) {
2383 fmt++;
2384 fmtLen--;
2386 Jim_AppendString(interp, resObjPtr, p, fmt - p);
2387 if (fmtLen == 0)
2388 break;
2389 fmt++;
2390 fmtLen--; /* skip '%' */
2391 if (*fmt == '%') {
2392 /* %% -> % */
2393 Jim_AppendString(interp, resObjPtr, "%", 1);
2394 fmt++;
2395 fmtLen--;
2396 continue;
2398 zpad = 0;
2399 spad = 0;
2400 width = -1;
2401 ljust = 0;
2402 altfm = 0;
2403 forceplus = 0;
2404 inprec = 0;
2405 haveprec = 0;
2406 prec = -1; /* not found yet */
2407 next_fmt:
2408 if (fmtLen <= 0) {
2409 break;
2411 switch (*fmt) {
2412 /* terminals */
2413 case 'b': /* binary - not all printfs() do this */
2414 case 's': /* string */
2415 case 'i': /* integer */
2416 case 'd': /* decimal */
2417 case 'x': /* hex */
2418 case 'X': /* CAP hex */
2419 case 'c': /* char */
2420 case 'o': /* octal */
2421 case 'u': /* unsigned */
2422 case 'f': /* float */
2423 break;
2425 /* non-terminals */
2426 case '+':
2427 forceplus = 1;
2428 fmt++;
2429 fmtLen--;
2430 goto next_fmt;
2431 break;
2432 case ' ': /* sign space */
2433 spad = 1;
2434 fmt++;
2435 fmtLen--;
2436 goto next_fmt;
2437 break;
2438 case '-':
2439 ljust = 1;
2440 fmt++;
2441 fmtLen--;
2442 goto next_fmt;
2443 break;
2444 case '#':
2445 altfm = 1;
2446 fmt++;
2447 fmtLen--;
2448 goto next_fmt;
2450 case '.':
2451 inprec = 1;
2452 fmt++;
2453 fmtLen--;
2454 goto next_fmt;
2455 break;
2456 case '0':
2457 if (!inprec) {
2458 /* zero pad */
2459 zpad = 1;
2460 fmt++;
2461 fmtLen--;
2462 goto next_fmt;
2463 break;
2465 /* fall through */
2466 case '1':
2467 case '2':
2468 case '3':
2469 case '4':
2470 case '5':
2471 case '6':
2472 case '7':
2473 case '8':
2474 case '9':
2475 accum = 0;
2476 while (isdigit(*fmt) && (fmtLen > 0)) {
2477 accum = (accum * 10) + (*fmt - '0');
2478 fmt++;
2479 fmtLen--;
2481 if (inprec) {
2482 haveprec = 1;
2483 prec = accum;
2485 else {
2486 width = accum;
2488 goto next_fmt;
2489 case '*':
2490 /* suck up the next item as an integer */
2491 fmt++;
2492 fmtLen--;
2493 objc--;
2494 if (objc <= 0) {
2495 goto not_enough_args;
2497 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2498 Jim_FreeNewObj(interp, resObjPtr);
2499 return NULL;
2501 if (inprec) {
2502 haveprec = 1;
2503 prec = wideValue;
2504 if (prec < 0) {
2505 /* man 3 printf says */
2506 /* if prec is negative, it is zero */
2507 prec = 0;
2510 else {
2511 width = wideValue;
2512 if (width < 0) {
2513 ljust = 1;
2514 width = -width;
2517 objv++;
2518 goto next_fmt;
2519 break;
2523 if (*fmt != '%') {
2524 if (objc == 0) {
2525 not_enough_args:
2526 Jim_FreeNewObj(interp, resObjPtr);
2527 Jim_SetResultString(interp, "not enough arguments for all format specifiers", -1);
2528 return NULL;
2530 else {
2531 objc--;
2536 * Create the formatter
2537 * cause we cheat and use sprintf()
2539 cp = fmt_str;
2540 *cp++ = '%';
2541 if (altfm) {
2542 *cp++ = '#';
2544 if (forceplus) {
2545 *cp++ = '+';
2547 else if (spad) {
2548 /* PLUS overrides */
2549 *cp++ = ' ';
2551 if (ljust) {
2552 *cp++ = '-';
2554 if (zpad) {
2555 *cp++ = '0';
2557 if (width > 0) {
2558 sprintf(cp, "%d", width);
2559 /* skip ahead */
2560 cp = strchr(cp, 0);
2562 /* did we find a period? */
2563 if (inprec) {
2564 /* then add it */
2565 *cp++ = '.';
2566 /* did something occur after the period? */
2567 if (haveprec) {
2568 sprintf(cp, "%d", prec);
2570 cp = strchr(cp, 0);
2572 *cp = 0;
2574 /* here we do the work */
2575 /* actually - we make sprintf() do it for us */
2576 switch (*fmt) {
2577 case 's':
2578 *cp++ = 's';
2579 *cp = 0;
2580 /* BUG: we do not handled embeded NULLs */
2581 buflen = snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString(objv[0], NULL));
2582 break;
2583 case 'c':
2584 *cp++ = 'c';
2585 *cp = 0;
2586 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2587 Jim_FreeNewObj(interp, resObjPtr);
2588 return NULL;
2590 c = (char)wideValue;
2591 buflen = snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, c);
2592 break;
2593 case 'f':
2594 case 'F':
2595 case 'g':
2596 case 'G':
2597 case 'e':
2598 case 'E':
2599 *cp++ = *fmt;
2600 *cp = 0;
2601 if (Jim_GetDouble(interp, objv[0], &doubleValue) == JIM_ERR) {
2602 Jim_FreeNewObj(interp, resObjPtr);
2603 return NULL;
2605 buflen = snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue);
2606 break;
2607 case 'b':
2608 case 'd':
2609 case 'o':
2610 case 'i':
2611 case 'u':
2612 case 'x':
2613 case 'X':
2614 *cp++ = 'l';
2615 #ifdef HAVE_LONG_LONG
2616 /* jim widevaluse are 64bit */
2617 if (sizeof(jim_wide) == sizeof(long long)) {
2618 *cp++ = 'l';
2620 #endif
2621 *cp++ = *fmt;
2622 *cp = 0;
2623 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2624 Jim_FreeNewObj(interp, resObjPtr);
2625 return NULL;
2627 buflen = snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue);
2628 break;
2629 case '%':
2630 sprintf_buf[0] = '%';
2631 sprintf_buf[1] = 0;
2632 objv--; /* undo the objv++ below */
2633 break;
2634 default:
2635 spec[0] = *fmt;
2636 spec[1] = '\0';
2637 Jim_SetResultFormatted(interp, "bad field specifier \"%s\"", spec);
2638 Jim_FreeNewObj(interp, resObjPtr);
2639 return NULL;
2641 /* force terminate */
2642 #if 0
2643 printf("FMT was: %s\n", fmt_str);
2644 printf("RES was: |%s|\n", sprintf_buf);
2645 #endif
2647 Jim_AppendString(interp, resObjPtr, sprintf_buf,
2648 buflen <= JIM_MAX_FMT ? buflen : JIM_MAX_FMT);
2649 /* next obj */
2650 objv++;
2651 fmt++;
2652 fmtLen--;
2654 return resObjPtr;
2657 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr, int objc, Jim_Obj *const *objv)
2659 char *sprintf_buf = malloc(JIM_MAX_FMT);
2660 Jim_Obj *t = Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2662 free(sprintf_buf);
2663 return t;
2666 /* -----------------------------------------------------------------------------
2667 * Compared String Object
2668 * ---------------------------------------------------------------------------*/
2670 /* This is strange object that allows to compare a C literal string
2671 * with a Jim object in very short time if the same comparison is done
2672 * multiple times. For example every time the [if] command is executed,
2673 * Jim has to check if a given argument is "else". This comparions if
2674 * the code has no errors are true most of the times, so we can cache
2675 * inside the object the pointer of the string of the last matching
2676 * comparison. Because most C compilers perform literal sharing,
2677 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2678 * this works pretty well even if comparisons are at different places
2679 * inside the C code. */
2681 static const Jim_ObjType comparedStringObjType = {
2682 "compared-string",
2683 NULL,
2684 NULL,
2685 NULL,
2686 JIM_TYPE_REFERENCES,
2689 /* The only way this object is exposed to the API is via the following
2690 * function. Returns true if the string and the object string repr.
2691 * are the same, otherwise zero is returned.
2693 * Note: this isn't binary safe, but it hardly needs to be.*/
2694 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
2696 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
2697 return 1;
2698 else {
2699 const char *objStr = Jim_GetString(objPtr, NULL);
2701 if (strcmp(str, objStr) != 0)
2702 return 0;
2703 if (objPtr->typePtr != &comparedStringObjType) {
2704 Jim_FreeIntRep(interp, objPtr);
2705 objPtr->typePtr = &comparedStringObjType;
2707 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
2708 return 1;
2712 int qsortCompareStringPointers(const void *a, const void *b)
2714 char *const *sa = (char *const *)a;
2715 char *const *sb = (char *const *)b;
2717 return strcmp(*sa, *sb);
2721 /* -----------------------------------------------------------------------------
2722 * Source Object
2724 * This object is just a string from the language point of view, but
2725 * in the internal representation it contains the filename and line number
2726 * where this given token was read. This information is used by
2727 * Jim_EvalObj() if the object passed happens to be of type "source".
2729 * This allows to propagate the information about line numbers and file
2730 * names and give error messages with absolute line numbers.
2732 * Note that this object uses shared strings for filenames, and the
2733 * pointer to the filename together with the line number is taken into
2734 * the space for the "inline" internal representation of the Jim_Object,
2735 * so there is almost memory zero-overhead.
2737 * Also the object will be converted to something else if the given
2738 * token it represents in the source file is not something to be
2739 * evaluated (not a script), and will be specialized in some other way,
2740 * so the time overhead is also null.
2741 * ---------------------------------------------------------------------------*/
2743 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2744 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2746 static const Jim_ObjType sourceObjType = {
2747 "source",
2748 FreeSourceInternalRep,
2749 DupSourceInternalRep,
2750 NULL,
2751 JIM_TYPE_REFERENCES,
2754 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2756 Jim_ReleaseSharedString(interp, objPtr->internalRep.sourceValue.fileName);
2759 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2761 dupPtr->internalRep.sourceValue.fileName =
2762 Jim_GetSharedString(interp, srcPtr->internalRep.sourceValue.fileName);
2763 dupPtr->internalRep.sourceValue.lineNumber = dupPtr->internalRep.sourceValue.lineNumber;
2764 dupPtr->typePtr = &sourceObjType;
2767 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2768 const char *fileName, int lineNumber)
2770 if (Jim_IsShared(objPtr))
2771 Jim_Panic(interp, "JimSetSourceInfo called with shared object");
2772 if (objPtr->typePtr != NULL)
2773 Jim_Panic(interp, "JimSetSourceInfo called with typePtr != NULL");
2774 objPtr->internalRep.sourceValue.fileName = Jim_GetSharedString(interp, fileName);
2775 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2776 objPtr->typePtr = &sourceObjType;
2779 /* -----------------------------------------------------------------------------
2780 * Script Object
2781 * ---------------------------------------------------------------------------*/
2783 #define JIM_CMDSTRUCT_EXPAND -1
2785 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2786 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2787 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2789 static const Jim_ObjType scriptObjType = {
2790 "script",
2791 FreeScriptInternalRep,
2792 DupScriptInternalRep,
2793 NULL,
2794 JIM_TYPE_REFERENCES,
2797 /* The ScriptToken structure represents every token into a scriptObj.
2798 * Every token contains an associated Jim_Obj that can be specialized
2799 * by commands operating on it. */
2800 typedef struct ScriptToken
2802 int type;
2803 Jim_Obj *objPtr;
2804 int linenr;
2805 } ScriptToken;
2807 /* This is the script object internal representation. An array of
2808 * ScriptToken structures, with an associated command structure array.
2809 * The command structure is a pre-computed representation of the
2810 * command length and arguments structure as a simple liner array
2811 * of integers.
2813 * For example the script:
2815 * puts hello
2816 * set $i $x$y [foo]BAR
2818 * will produce a ScriptObj with the following Tokens:
2820 * ESC puts
2821 * SEP
2822 * ESC hello
2823 * EOL
2824 * ESC set
2825 * EOL
2826 * VAR i
2827 * SEP
2828 * VAR x
2829 * VAR y
2830 * SEP
2831 * CMD foo
2832 * ESC BAR
2833 * EOL
2835 * This is a description of the tokens, separators, and of lines.
2836 * The command structure instead represents the number of arguments
2837 * of every command, followed by the tokens of which every argument
2838 * is composed. So for the example script, the cmdstruct array will
2839 * contain:
2841 * 2 1 1 4 1 1 2 2
2843 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2844 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2845 * composed of single tokens (1 1) and the last two of double tokens
2846 * (2 2).
2848 * The precomputation of the command structure makes Jim_Eval() faster,
2849 * and simpler because there aren't dynamic lengths / allocations.
2851 * -- {expand}/{*} handling --
2853 * Expand is handled in a special way. When a command
2854 * contains at least an argument with the {expand} or {*} prefix,
2855 * the command structure presents a -1 before the integer
2856 * describing the number of arguments. This is used in order
2857 * to send the command exection to a different path in case
2858 * of {expand} and guarantee a fast path for the more common
2859 * case. Also, the integers describing the number of tokens
2860 * are expressed with negative sign, to allow for fast check
2861 * of what's an {expand}-prefixed argument and what not.
2863 * For example the command:
2865 * list {expand}{1 2}
2867 * Will produce the following cmdstruct array:
2869 * -1 2 1 -2
2871 * -- the substFlags field of the structure --
2873 * The scriptObj structure is used to represent both "script" objects
2874 * and "subst" objects. In the second case, the cmdStruct related
2875 * fields are not used at all, but there is an additional field used
2876 * that is 'substFlags': this represents the flags used to turn
2877 * the string into the internal representation used to perform the
2878 * substitution. If this flags are not what the application requires
2879 * the scriptObj is created again. For example the script:
2881 * subst -nocommands $string
2882 * subst -novariables $string
2884 * Will recreate the internal representation of the $string object
2885 * two times.
2887 typedef struct ScriptObj
2889 int len; /* Length as number of tokens. */
2890 ScriptToken *token; /* Tokens array. */
2891 int *cmdStruct; /* commands structure */
2892 int csLen; /* length of the cmdStruct array. */
2893 int substFlags; /* flags used for the compilation of "subst" objects */
2894 int inUse; /* Used to share a ScriptObj. Currently
2895 only used by Jim_EvalObj() as protection against
2896 shimmering of the currently evaluated object. */
2897 char *fileName;
2898 } ScriptObj;
2900 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2902 int i;
2903 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
2905 script->inUse--;
2906 if (script->inUse != 0)
2907 return;
2908 for (i = 0; i < script->len; i++) {
2909 if (script->token[i].objPtr != NULL) {
2910 Jim_DecrRefCount(interp, script->token[i].objPtr);
2913 Jim_Free(script->token);
2914 Jim_Free(script->cmdStruct);
2915 Jim_Free(script->fileName);
2916 Jim_Free(script);
2919 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2921 JIM_NOTUSED(interp);
2922 JIM_NOTUSED(srcPtr);
2924 /* Just returns an simple string. */
2925 dupPtr->typePtr = NULL;
2928 /* A simple parser token.
2929 * All the simple tokens for the script point into the same script string rep.
2931 typedef struct
2933 const char *token; /* Pointer to the start of the token */
2934 int len; /* Length of this token */
2935 int type; /* Token type */
2936 int line; /* Line number */
2937 } ParseToken;
2939 /* A list of parsed tokens representing a script.
2940 * Tokens are added to this list as the script is parsed.
2941 * It grows as needed.
2943 typedef struct
2945 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
2946 ParseToken *list; /* Array of tokens */
2947 int size; /* Current size of the list */
2948 int count; /* Number of entries used */
2949 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
2950 } ParseTokenList;
2952 static void ScriptTokenListInit(ParseTokenList *tokenlist)
2954 tokenlist->list = tokenlist->static_list;
2955 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
2956 tokenlist->count = 0;
2959 static void ScriptTokenListFree(ParseTokenList *tokenlist)
2961 if (tokenlist->list != tokenlist->static_list) {
2962 Jim_Free(tokenlist->list);
2967 * Adds the new token to the tokenlist.
2968 * The token has the given length, type and line number.
2969 * The token list is resized as necessary.
2971 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
2972 int line)
2974 ParseToken *t;
2976 if (tokenlist->count == tokenlist->size) {
2977 /* Resize the list */
2978 tokenlist->size *= 2;
2979 if (tokenlist->list != tokenlist->static_list) {
2980 tokenlist->list =
2981 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
2983 else {
2984 /* The list needs to become allocated */
2985 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
2986 memcpy(tokenlist->list, tokenlist->static_list,
2987 tokenlist->count * sizeof(*tokenlist->list));
2990 t = &tokenlist->list[tokenlist->count++];
2991 t->token = token;
2992 t->len = len;
2993 t->type = type;
2994 t->line = line;
2998 * Takes a tokenlist and creates the allocated list of script tokens
2999 * in script->token, of length script->len.
3001 * Unnecessary tokens are discarded, and some tokens may be consolidated into
3002 * a single token.
3004 * Also counts the required cmdStruct length in script->csLen.
3006 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3007 ParseTokenList *tokenlist)
3009 int i;
3010 struct ScriptToken *token;
3011 int prevtype = JIM_TT_EOL;
3013 /* Be pessimistic. This will definitely be big enough since at least the EOF token
3014 * will be discarded
3016 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3017 script->csLen = 0;
3019 for (i = 0; i < tokenlist->count; i++) {
3020 const ParseToken *t = &tokenlist->list[i];
3022 if (t->type == JIM_TT_EOF) {
3023 break;
3026 switch (t->type) {
3027 case JIM_TT_EOL:
3028 /* Combine multiple EOLs to one */
3029 if (prevtype == JIM_TT_EOL) {
3030 continue;
3032 token->objPtr = interp->emptyObj;
3033 script->csLen += 2;
3034 break;
3036 case JIM_TT_SEP:
3037 /* Skip SEP before or after EOL */
3038 if (prevtype == JIM_TT_EOL || t[1].type == JIM_TT_EOL) {
3039 continue;
3041 token->objPtr = interp->emptyObj;
3042 script->csLen++;
3043 break;
3045 default:{
3046 char *str;
3047 int len = t->len;
3049 if (t->type == JIM_TT_ESC) {
3050 /* Convert the escape chars. */
3051 str = Jim_Alloc(len + 1);
3052 len = JimEscape(str, t->token, len);
3054 else {
3055 /* No escape conversion needed, so just copy it. */
3056 str = Jim_StrDupLen(t->token, len);
3059 /* Every object is initially a string, but the
3060 * internal type may be specialized during execution of the
3061 * script. */
3062 token->objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3064 if (script->fileName) {
3065 JimSetSourceInfo(interp, token->objPtr, script->fileName, t->line);
3067 break;
3071 token->type = t->type;
3072 token->linenr = t->line;
3074 Jim_IncrRefCount(token->objPtr);
3075 token++;
3077 prevtype = t->type;
3080 script->len = token - script->token;
3083 #ifdef JIM_OPTIMIZATION
3086 * An optimised version of ScriptObjAddTokens() for subst objects.
3088 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3089 ParseTokenList *tokenlist)
3091 int i;
3092 struct ScriptToken *token;
3094 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3096 for (i = 0; i < tokenlist->count; i++) {
3097 ParseToken *t = &tokenlist->list[i];
3098 int len;
3099 char *str;
3101 /* Create a token for 't' */
3102 token->type = t->type;
3103 token->linenr = t->line;
3105 len = t->len;
3107 if (t->type != JIM_TT_ESC) {
3108 /* No escape conversion needed, so just copy it. */
3109 str = Jim_StrDupLen(t->token, len);
3111 else {
3112 /* Else convert the escape chars. */
3113 str = Jim_Alloc(len + 1);
3114 len = JimEscape(str, t->token, len);
3117 /* Every object is initially a string, but the
3118 * internal type may be specialized during execution of the
3119 * script. */
3120 token->objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3122 /* To add source info to SEP and EOL tokens is useless because
3123 * they will never by called as arguments of Jim_EvalObj(). */
3124 Jim_IncrRefCount(token->objPtr);
3125 token++;
3128 script->len = i;
3130 #endif
3132 /* This method takes the string representation of an object
3133 * as a Tcl script, and generates the pre-parsed internal representation
3134 * of the script. */
3135 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3137 int scriptTextLen;
3138 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3139 struct JimParserCtx parser;
3140 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3141 ScriptToken *token;
3142 int *cs;
3143 int i;
3144 int initialLineNumber;
3145 ParseTokenList tokenlist;
3146 int line_expand;
3147 int arg_expand;
3148 int *csp;
3149 int args;
3150 int tokens;
3152 /* Try to get information about filename / line number */
3153 if (objPtr->typePtr == &sourceObjType) {
3154 script->fileName = Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3155 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3157 else {
3158 script->fileName = NULL;
3159 initialLineNumber = 1;
3162 /* Initially parse the script into tokens (in tokenlist) */
3163 ScriptTokenListInit(&tokenlist);
3165 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3166 while (!JimParserEof(&parser)) {
3167 JimParseScript(&parser);
3168 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3169 parser.tline);
3171 /* Add a final EOF token */
3172 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3174 /* Create the "real" script tokens from the initial token list */
3175 script->substFlags = 0;
3176 script->inUse = 1;
3177 ScriptObjAddTokens(interp, script, &tokenlist);
3179 /* No longer need the token list */
3180 ScriptTokenListFree(&tokenlist);
3182 if (!script->fileName) {
3183 script->fileName = Jim_StrDup("");
3186 #if 0
3187 printf("==== Script ====\n");
3188 for (i = 0; i < script->len; i++) {
3189 printf("[%2d] %s (%d)'%s'\n", i, tt_name(script->token[i].type),
3190 script->token[i].objPtr->length, script->token[i].objPtr->bytes);
3192 #endif
3194 /* Compute the command structure array
3195 * (see the ScriptObj struct definition for more info).
3196 * Note that the required size has already been calculated in script->csLen.
3199 cs = script->cmdStruct = Jim_Alloc(sizeof(int) * (script->csLen));
3201 token = script->token;
3203 line_expand = 0; /* expand is used on this line */
3204 arg_expand = 0; /* expand is used on this argument */
3205 csp = cs++; /* points to argument count */
3206 args = 1; /* Number of args on this line */
3207 tokens = 0; /* Number of tokens in current argument. */
3209 for (i = 0; i < script->len; i++) {
3210 ScriptToken *t = &token[i];
3212 if (tokens == 0 && t[0].type == JIM_TT_STR &&
3213 t[1].type != JIM_TT_SEP && t[1].type != JIM_TT_EOL &&
3214 (!strcmp(t->objPtr->bytes, "expand") || !strcmp(t->objPtr->bytes, "*"))) {
3216 arg_expand = line_expand = 1;
3219 if (t->type == JIM_TT_SEP || t->type == JIM_TT_EOL) {
3220 /* Now add info about the number of tokens. -ve is list expansion is involved */
3221 *cs++ = arg_expand ? -tokens : tokens;
3222 arg_expand = 0;
3223 tokens = 0;
3225 if (t->type == JIM_TT_EOL) {
3226 /* End of line. Back patch the arg count */
3227 /* Negative value if there is list expansion involved. */
3228 if (line_expand) {
3229 line_expand = 0;
3230 *csp = -args;
3232 else {
3233 *csp = args;
3235 /* And reset */
3236 csp = cs++;
3237 args = 0;
3239 args++;
3241 else {
3242 tokens++;
3245 #if 0
3246 for (i = 0; i < script->csLen; i++) {
3247 printf("cs[%d]=%d\n", i, script->cmdStruct[i]);
3249 #endif
3251 /* Free the old internal rep and set the new one. */
3252 Jim_FreeIntRep(interp, objPtr);
3253 Jim_SetIntRepPtr(objPtr, script);
3254 objPtr->typePtr = &scriptObjType;
3256 return JIM_OK;
3259 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3261 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
3263 if (objPtr->typePtr != &scriptObjType || script->substFlags) {
3264 SetScriptFromAny(interp, objPtr);
3266 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3269 /* -----------------------------------------------------------------------------
3270 * Commands
3271 * ---------------------------------------------------------------------------*/
3272 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3274 cmdPtr->inUse++;
3277 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3279 if (--cmdPtr->inUse == 0) {
3280 if (cmdPtr->cmdProc == NULL) {
3281 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3282 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3283 if (cmdPtr->staticVars) {
3284 Jim_FreeHashTable(cmdPtr->staticVars);
3285 Jim_Free(cmdPtr->staticVars);
3288 else if (cmdPtr->delProc != NULL) {
3289 /* If it was a C coded command, call the delProc if any */
3290 cmdPtr->delProc(interp, cmdPtr->privData);
3292 Jim_Free(cmdPtr);
3296 /* Commands HashTable Type.
3298 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3299 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3301 JimDecrCmdRefCount(interp, val);
3304 static const Jim_HashTableType JimCommandsHashTableType = {
3305 JimStringCopyHTHashFunction, /* hash function */
3306 JimStringCopyHTKeyDup, /* key dup */
3307 NULL, /* val dup */
3308 JimStringCopyHTKeyCompare, /* key compare */
3309 JimStringCopyHTKeyDestructor, /* key destructor */
3310 Jim_CommandsHT_ValDestructor /* val destructor */
3313 /* ------------------------- Commands related functions --------------------- */
3315 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3316 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3318 Jim_Cmd *cmdPtr;
3320 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3321 /* Command existed so incr proc epoch */
3322 Jim_InterpIncrProcEpoch(interp);
3325 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3327 /* Store the new details for this proc */
3328 cmdPtr->delProc = delProc;
3329 cmdPtr->cmdProc = cmdProc;
3330 cmdPtr->privData = privData;
3331 cmdPtr->inUse = 1;
3333 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3335 /* There is no need to increment the 'proc epoch' because
3336 * creation of a new procedure can never affect existing
3337 * cached commands. We don't do negative caching. */
3338 return JIM_OK;
3341 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3342 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3343 int leftArity, int optionalArgs, int args, int rightArity)
3345 Jim_Cmd *cmdPtr;
3347 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3348 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3349 cmdPtr->argListObjPtr = argListObjPtr;
3350 cmdPtr->bodyObjPtr = bodyObjPtr;
3351 Jim_IncrRefCount(argListObjPtr);
3352 Jim_IncrRefCount(bodyObjPtr);
3353 cmdPtr->leftArity = leftArity;
3354 cmdPtr->optionalArgs = optionalArgs;
3355 cmdPtr->args = args;
3356 cmdPtr->rightArity = rightArity;
3357 cmdPtr->staticVars = NULL;
3358 cmdPtr->inUse = 1;
3360 /* Create the statics hash table. */
3361 if (staticsListObjPtr) {
3362 int len, i;
3364 len = Jim_ListLength(interp, staticsListObjPtr);
3365 if (len != 0) {
3366 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3367 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType, interp);
3368 for (i = 0; i < len; i++) {
3369 Jim_Obj *objPtr = 0, *initObjPtr = 0, *nameObjPtr = 0;
3370 Jim_Var *varPtr;
3371 int subLen;
3373 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3374 /* Check if it's composed of two elements. */
3375 subLen = Jim_ListLength(interp, objPtr);
3376 if (subLen == 1 || subLen == 2) {
3377 /* Try to get the variable value from the current
3378 * environment. */
3379 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3380 if (subLen == 1) {
3381 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3382 if (initObjPtr == NULL) {
3383 Jim_SetResultFormatted(interp,
3384 "variable for initialization of static \"%#s\" not found in the local context",
3385 nameObjPtr);
3386 goto err;
3389 else {
3390 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3392 varPtr = Jim_Alloc(sizeof(*varPtr));
3393 varPtr->objPtr = initObjPtr;
3394 Jim_IncrRefCount(initObjPtr);
3395 varPtr->linkFramePtr = NULL;
3396 if (Jim_AddHashEntry(cmdPtr->staticVars,
3397 Jim_GetString(nameObjPtr, NULL), varPtr) != JIM_OK) {
3398 Jim_SetResultFormatted(interp,
3399 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3400 Jim_DecrRefCount(interp, initObjPtr);
3401 Jim_Free(varPtr);
3402 goto err;
3405 else {
3406 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3407 objPtr);
3408 goto err;
3414 /* Add the new command */
3416 /* It may already exist, so we try to delete the old one.
3417 * Note that reference count means that it won't be deleted yet if
3418 * it exists in the call stack
3420 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3421 /* There was an old procedure with the same name, this requires
3422 * a 'proc epoch' update. */
3423 Jim_InterpIncrProcEpoch(interp);
3425 /* If a procedure with the same name didn't existed there is no need
3426 * to increment the 'proc epoch' because creation of a new procedure
3427 * can never affect existing cached commands. We don't do
3428 * negative caching. */
3429 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3431 /* Unlike Tcl, set the name of the proc as the result */
3432 Jim_SetResultString(interp, cmdName, -1);
3433 return JIM_OK;
3435 err:
3436 Jim_FreeHashTable(cmdPtr->staticVars);
3437 Jim_Free(cmdPtr->staticVars);
3438 Jim_DecrRefCount(interp, argListObjPtr);
3439 Jim_DecrRefCount(interp, bodyObjPtr);
3440 Jim_Free(cmdPtr);
3441 return JIM_ERR;
3444 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3446 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3447 return JIM_ERR;
3448 Jim_InterpIncrProcEpoch(interp);
3449 return JIM_OK;
3452 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
3454 Jim_Cmd *cmdPtr;
3455 Jim_HashEntry *he;
3456 Jim_Cmd *copyCmdPtr;
3458 if (newName[0] == '\0') /* Delete! */
3459 return Jim_DeleteCommand(interp, oldName);
3460 /* Rename */
3461 he = Jim_FindHashEntry(&interp->commands, oldName);
3462 if (he == NULL)
3463 return JIM_ERR; /* Invalid command name */
3464 cmdPtr = he->val;
3465 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3466 *copyCmdPtr = *cmdPtr;
3467 /* In order to avoid that a procedure will get arglist/body/statics
3468 * freed by the hash table methods, fake a C-coded command
3469 * setting cmdPtr->cmdProc as not NULL */
3470 cmdPtr->cmdProc = (void *)1;
3471 /* Also make sure delProc is NULL. */
3472 cmdPtr->delProc = NULL;
3473 /* Destroy the old command, and make sure the new is freed
3474 * as well. */
3475 Jim_DeleteHashEntry(&interp->commands, oldName);
3476 Jim_DeleteHashEntry(&interp->commands, newName);
3477 /* Now the new command. We are sure it can't fail because
3478 * the target name was already freed. */
3479 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3480 /* Increment the epoch */
3481 Jim_InterpIncrProcEpoch(interp);
3482 return JIM_OK;
3485 /* -----------------------------------------------------------------------------
3486 * Command object
3487 * ---------------------------------------------------------------------------*/
3489 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3491 static const Jim_ObjType commandObjType = {
3492 "command",
3493 NULL,
3494 NULL,
3495 NULL,
3496 JIM_TYPE_REFERENCES,
3499 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3501 Jim_HashEntry *he;
3502 const char *cmdName;
3504 /* Get the string representation */
3505 cmdName = Jim_GetString(objPtr, NULL);
3506 /* Lookup this name into the commands hash table */
3507 he = Jim_FindHashEntry(&interp->commands, cmdName);
3508 if (he == NULL)
3509 return JIM_ERR;
3511 /* Free the old internal repr and set the new one. */
3512 Jim_FreeIntRep(interp, objPtr);
3513 objPtr->typePtr = &commandObjType;
3514 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3515 objPtr->internalRep.cmdValue.cmdPtr = (void *)he->val;
3516 return JIM_OK;
3519 /* This function returns the command structure for the command name
3520 * stored in objPtr. It tries to specialize the objPtr to contain
3521 * a cached info instead to perform the lookup into the hash table
3522 * every time. The information cached may not be uptodate, in such
3523 * a case the lookup is performed and the cache updated. */
3524 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3526 if ((objPtr->typePtr != &commandObjType ||
3527 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3528 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3529 if (flags & JIM_ERRMSG) {
3530 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
3532 return NULL;
3534 return objPtr->internalRep.cmdValue.cmdPtr;
3537 /* -----------------------------------------------------------------------------
3538 * Variables
3539 * ---------------------------------------------------------------------------*/
3541 /* Variables HashTable Type.
3543 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3544 static void JimVariablesHTValDestructor(void *interp, void *val)
3546 Jim_Var *varPtr = (void *)val;
3548 Jim_DecrRefCount(interp, varPtr->objPtr);
3549 Jim_Free(val);
3552 static const Jim_HashTableType JimVariablesHashTableType = {
3553 JimStringCopyHTHashFunction, /* hash function */
3554 JimStringCopyHTKeyDup, /* key dup */
3555 NULL, /* val dup */
3556 JimStringCopyHTKeyCompare, /* key compare */
3557 JimStringCopyHTKeyDestructor, /* key destructor */
3558 JimVariablesHTValDestructor /* val destructor */
3561 /* -----------------------------------------------------------------------------
3562 * Variable object
3563 * ---------------------------------------------------------------------------*/
3565 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3567 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3569 static const Jim_ObjType variableObjType = {
3570 "variable",
3571 NULL,
3572 NULL,
3573 NULL,
3574 JIM_TYPE_REFERENCES,
3577 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3578 * is in the form "varname(key)". */
3579 static int Jim_NameIsDictSugar(const char *str, int len)
3581 if (len && str[len - 1] == ')' && strchr(str, '(') != NULL)
3582 return 1;
3583 return 0;
3586 /* This method should be called only by the variable API.
3587 * It returns JIM_OK on success (variable already exists),
3588 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
3589 * a variable name, but syntax glue for [dict] i.e. the last
3590 * character is ')' */
3591 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3593 Jim_HashEntry *he;
3594 const char *varName;
3595 int len;
3596 Jim_CallFrame *framePtr = interp->framePtr;
3598 /* Check if the object is already an uptodate variable */
3599 if (objPtr->typePtr == &variableObjType &&
3600 objPtr->internalRep.varValue.callFrameId == framePtr->id) {
3601 return JIM_OK; /* nothing to do */
3604 if (objPtr->typePtr == &dictSubstObjType) {
3605 return JIM_DICT_SUGAR;
3608 /* Get the string representation */
3609 varName = Jim_GetString(objPtr, &len);
3611 /* Make sure it's not syntax glue to get/set dict. */
3612 if (Jim_NameIsDictSugar(varName, len)) {
3613 return JIM_DICT_SUGAR;
3616 if (varName[0] == ':' && varName[1] == ':') {
3617 framePtr = interp->topFramePtr;
3618 he = Jim_FindHashEntry(&framePtr->vars, varName + 2);
3619 if (he == NULL) {
3620 return JIM_ERR;
3623 else {
3624 /* Lookup this name into the variables hash table */
3625 he = Jim_FindHashEntry(&framePtr->vars, varName);
3626 if (he == NULL) {
3627 /* Try with static vars. */
3628 if (framePtr->staticVars == NULL)
3629 return JIM_ERR;
3630 if (!(he = Jim_FindHashEntry(framePtr->staticVars, varName)))
3631 return JIM_ERR;
3634 /* Free the old internal repr and set the new one. */
3635 Jim_FreeIntRep(interp, objPtr);
3636 objPtr->typePtr = &variableObjType;
3637 objPtr->internalRep.varValue.callFrameId = framePtr->id;
3638 objPtr->internalRep.varValue.varPtr = (void *)he->val;
3639 return JIM_OK;
3642 /* -------------------- Variables related functions ------------------------- */
3643 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
3644 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3646 /* For now that's dummy. Variables lookup should be optimized
3647 * in many ways, with caching of lookups, and possibly with
3648 * a table of pre-allocated vars in every CallFrame for local vars.
3649 * All the caching should also have an 'epoch' mechanism similar
3650 * to the one used by Tcl for procedures lookup caching. */
3652 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3654 const char *name;
3655 Jim_Var *var;
3656 int err;
3658 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3659 Jim_CallFrame *framePtr = interp->framePtr;
3661 /* Check for [dict] syntax sugar. */
3662 if (err == JIM_DICT_SUGAR)
3663 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3664 /* New variable to create */
3665 name = Jim_GetString(nameObjPtr, NULL);
3667 var = Jim_Alloc(sizeof(*var));
3668 var->objPtr = valObjPtr;
3669 Jim_IncrRefCount(valObjPtr);
3670 var->linkFramePtr = NULL;
3671 /* Insert the new variable */
3672 if (name[0] == ':' && name[1] == ':') {
3673 /* Into to the top evel frame */
3674 framePtr = interp->topFramePtr;
3675 Jim_AddHashEntry(&framePtr->vars, name + 2, var);
3677 else {
3678 Jim_AddHashEntry(&framePtr->vars, name, var);
3680 /* Make the object int rep a variable */
3681 Jim_FreeIntRep(interp, nameObjPtr);
3682 nameObjPtr->typePtr = &variableObjType;
3683 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
3684 nameObjPtr->internalRep.varValue.varPtr = var;
3686 else {
3687 var = nameObjPtr->internalRep.varValue.varPtr;
3688 if (var->linkFramePtr == NULL) {
3689 Jim_IncrRefCount(valObjPtr);
3690 Jim_DecrRefCount(interp, var->objPtr);
3691 var->objPtr = valObjPtr;
3693 else { /* Else handle the link */
3694 Jim_CallFrame *savedCallFrame;
3696 savedCallFrame = interp->framePtr;
3697 interp->framePtr = var->linkFramePtr;
3698 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3699 interp->framePtr = savedCallFrame;
3700 if (err != JIM_OK)
3701 return err;
3704 return JIM_OK;
3707 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3709 Jim_Obj *nameObjPtr;
3710 int result;
3712 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3713 Jim_IncrRefCount(nameObjPtr);
3714 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3715 Jim_DecrRefCount(interp, nameObjPtr);
3716 return result;
3719 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3721 Jim_CallFrame *savedFramePtr;
3722 int result;
3724 savedFramePtr = interp->framePtr;
3725 interp->framePtr = interp->topFramePtr;
3726 result = Jim_SetVariableStr(interp, name, objPtr);
3727 interp->framePtr = savedFramePtr;
3728 return result;
3731 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3733 Jim_Obj *nameObjPtr, *valObjPtr;
3734 int result;
3736 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3737 valObjPtr = Jim_NewStringObj(interp, val, -1);
3738 Jim_IncrRefCount(nameObjPtr);
3739 Jim_IncrRefCount(valObjPtr);
3740 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3741 Jim_DecrRefCount(interp, nameObjPtr);
3742 Jim_DecrRefCount(interp, valObjPtr);
3743 return result;
3746 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3747 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3749 const char *varName;
3750 int len;
3752 varName = Jim_GetString(nameObjPtr, &len);
3754 if (Jim_FindHashEntry(&interp->framePtr->vars, varName)) {
3755 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
3756 return JIM_ERR;
3759 /* Check for cycles. */
3760 if (interp->framePtr == targetCallFrame) {
3761 Jim_Obj *objPtr = targetNameObjPtr;
3762 Jim_Var *varPtr;
3764 /* Cycles are only possible with 'uplevel 0' */
3765 while (1) {
3766 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3767 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
3768 return JIM_ERR;
3770 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3771 break;
3772 varPtr = objPtr->internalRep.varValue.varPtr;
3773 if (varPtr->linkFramePtr != targetCallFrame)
3774 break;
3775 objPtr = varPtr->objPtr;
3778 if (Jim_NameIsDictSugar(varName, len)) {
3779 Jim_SetResultString(interp, "Dict key syntax invalid as link source", -1);
3780 return JIM_ERR;
3782 /* Perform the binding */
3783 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3784 /* We are now sure 'nameObjPtr' type is variableObjType */
3785 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3786 return JIM_OK;
3789 /* Return the Jim_Obj pointer associated with a variable name,
3790 * or NULL if the variable was not found in the current context.
3791 * The same optimization discussed in the comment to the
3792 * 'SetVariable' function should apply here. */
3793 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3795 switch (SetVariableFromAny(interp, nameObjPtr)) {
3796 case JIM_OK:{
3797 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
3799 if (varPtr->linkFramePtr == NULL) {
3800 return varPtr->objPtr;
3802 else {
3803 Jim_Obj *objPtr;
3805 /* The variable is a link? Resolve it. */
3806 Jim_CallFrame *savedCallFrame = interp->framePtr;
3808 interp->framePtr = varPtr->linkFramePtr;
3809 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
3810 interp->framePtr = savedCallFrame;
3811 return objPtr;
3815 case JIM_DICT_SUGAR:
3816 /* [dict] syntax sugar. */
3817 return JimDictSugarGet(interp, nameObjPtr);
3819 default:
3820 if (flags & JIM_ERRMSG) {
3821 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
3823 return NULL;
3827 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3829 Jim_CallFrame *savedFramePtr;
3830 Jim_Obj *objPtr;
3832 savedFramePtr = interp->framePtr;
3833 interp->framePtr = interp->topFramePtr;
3834 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3835 interp->framePtr = savedFramePtr;
3837 return objPtr;
3840 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3842 Jim_Obj *nameObjPtr, *varObjPtr;
3844 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3845 Jim_IncrRefCount(nameObjPtr);
3846 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3847 Jim_DecrRefCount(interp, nameObjPtr);
3848 return varObjPtr;
3851 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
3853 Jim_CallFrame *savedFramePtr;
3854 Jim_Obj *objPtr;
3856 savedFramePtr = interp->framePtr;
3857 interp->framePtr = interp->topFramePtr;
3858 objPtr = Jim_GetVariableStr(interp, name, flags);
3859 interp->framePtr = savedFramePtr;
3861 return objPtr;
3864 /* Unset a variable.
3865 * Note: On success unset invalidates all the variable objects created
3866 * in the current call frame incrementing. */
3867 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3869 const char *name;
3870 Jim_Var *varPtr;
3871 int retval;
3873 retval = SetVariableFromAny(interp, nameObjPtr);
3874 if (retval == JIM_DICT_SUGAR) {
3875 /* [dict] syntax sugar. */
3876 return JimDictSugarSet(interp, nameObjPtr, NULL);
3878 else if (retval == JIM_OK) {
3879 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3881 /* If it's a link call UnsetVariable recursively */
3882 if (varPtr->linkFramePtr) {
3883 Jim_CallFrame *savedCallFrame;
3885 savedCallFrame = interp->framePtr;
3886 interp->framePtr = varPtr->linkFramePtr;
3887 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3888 interp->framePtr = savedCallFrame;
3890 else {
3891 Jim_CallFrame *framePtr = interp->framePtr;
3893 name = Jim_GetString(nameObjPtr, NULL);
3894 if (name[0] == ':' && name[1] == ':') {
3895 framePtr = interp->topFramePtr;
3896 name += 2;
3898 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
3899 if (retval == JIM_OK) {
3900 /* Change the callframe id, invalidating var lookup caching */
3901 JimChangeCallFrameId(interp, framePtr);
3905 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
3906 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
3908 return retval;
3911 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3913 /* Given a variable name for [dict] operation syntax sugar,
3914 * this function returns two objects, the first with the name
3915 * of the variable to set, and the second with the rispective key.
3916 * For example "foo(bar)" will return objects with string repr. of
3917 * "foo" and "bar".
3919 * The returned objects have refcount = 1. The function can't fail. */
3920 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3921 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3923 const char *str, *p;
3924 char *t;
3925 int len, keyLen, nameLen;
3926 Jim_Obj *varObjPtr, *keyObjPtr;
3928 str = Jim_GetString(objPtr, &len);
3930 p = strchr(str, '(');
3931 if (p == NULL) {
3932 Jim_Panic(interp, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str);
3934 p++;
3935 keyLen = len - ((p - str) + 1);
3936 nameLen = (p - str) - 1;
3937 /* Create the objects with the variable name and key. */
3938 t = Jim_Alloc(nameLen + 1);
3939 memcpy(t, str, nameLen);
3940 t[nameLen] = '\0';
3941 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3943 t = Jim_Alloc(keyLen + 1);
3944 memcpy(t, p, keyLen);
3945 t[keyLen] = '\0';
3946 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3948 Jim_IncrRefCount(varObjPtr);
3949 Jim_IncrRefCount(keyObjPtr);
3950 *varPtrPtr = varObjPtr;
3951 *keyPtrPtr = keyObjPtr;
3954 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3955 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3956 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
3958 int err;
3960 SetDictSubstFromAny(interp, objPtr);
3962 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
3963 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr);
3965 if (err == JIM_OK) {
3966 /* Don't keep an extra ref to the result */
3967 Jim_SetEmptyResult(interp);
3969 else {
3970 if (!valObjPtr) {
3971 /* Better error message for unset a(2) where a exists but a(2) doesn't */
3972 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
3973 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
3974 objPtr);
3975 return err;
3978 /* Make the error more informative and Tcl-compatible */
3979 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
3980 (valObjPtr ? "set" : "unset"), objPtr);
3982 return err;
3985 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
3986 Jim_Obj *keyObjPtr)
3988 Jim_Obj *dictObjPtr;
3989 Jim_Obj *resObjPtr = NULL;
3990 int ret;
3992 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3993 if (!dictObjPtr) {
3994 return NULL;
3997 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
3998 if (ret != JIM_OK) {
3999 resObjPtr = NULL;
4000 if (ret < 0) {
4001 Jim_SetResultFormatted(interp,
4002 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4004 else {
4005 Jim_SetResultFormatted(interp,
4006 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4010 return resObjPtr;
4013 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4014 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
4016 Jim_Obj *varObjPtr, *keyObjPtr, *resObjPtr;
4019 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4021 resObjPtr = JimDictExpandArrayVariable(interp, varObjPtr, keyObjPtr);
4023 Jim_DecrRefCount(interp, varObjPtr);
4024 Jim_DecrRefCount(interp, keyObjPtr);
4026 return resObjPtr;
4029 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4031 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4033 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4034 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4037 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4039 JIM_NOTUSED(interp);
4041 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4042 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4043 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4044 dupPtr->typePtr = &dictSubstObjType;
4047 /* Note: The object *must* be in dict-sugar format */
4048 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4050 if (objPtr->typePtr != &dictSubstObjType) {
4051 Jim_Obj *varObjPtr, *keyObjPtr;
4053 if (objPtr->typePtr == &interpolatedObjType) {
4054 /* An interpolated object in dict-sugar form */
4056 const ScriptToken *token = objPtr->internalRep.twoPtrValue.ptr1;
4058 varObjPtr = token[0].objPtr;
4059 keyObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
4061 Jim_IncrRefCount(varObjPtr);
4062 Jim_IncrRefCount(keyObjPtr);
4064 else {
4065 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4068 Jim_FreeIntRep(interp, objPtr);
4069 objPtr->typePtr = &dictSubstObjType;
4070 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4071 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4075 /* This function is used to expand [dict get] sugar in the form
4076 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4077 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4078 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4079 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4080 * the [dict]ionary contained in variable VARNAME. */
4081 static Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4083 Jim_Obj *resObjPtr = NULL;
4084 Jim_Obj *substKeyObjPtr = NULL;
4086 SetDictSubstFromAny(interp, objPtr);
4088 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4089 &substKeyObjPtr, JIM_NONE)
4090 != JIM_OK) {
4091 return NULL;
4093 Jim_IncrRefCount(substKeyObjPtr);
4094 resObjPtr =
4095 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4096 substKeyObjPtr);
4097 Jim_DecrRefCount(interp, substKeyObjPtr);
4099 return resObjPtr;
4102 /* -----------------------------------------------------------------------------
4103 * CallFrame
4104 * ---------------------------------------------------------------------------*/
4106 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
4108 Jim_CallFrame *cf;
4110 if (interp->freeFramesList) {
4111 cf = interp->freeFramesList;
4112 interp->freeFramesList = cf->nextFramePtr;
4114 else {
4115 cf = Jim_Alloc(sizeof(*cf));
4116 cf->vars.table = NULL;
4119 cf->id = interp->callFrameEpoch++;
4120 cf->parentCallFrame = NULL;
4121 cf->argv = NULL;
4122 cf->argc = 0;
4123 cf->procArgsObjPtr = NULL;
4124 cf->procBodyObjPtr = NULL;
4125 cf->nextFramePtr = NULL;
4126 cf->staticVars = NULL;
4127 if (cf->vars.table == NULL)
4128 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4129 return cf;
4132 /* Used to invalidate every caching related to callframe stability. */
4133 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4135 cf->id = interp->callFrameEpoch++;
4138 #define JIM_FCF_NONE 0 /* no flags */
4139 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4140 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4142 if (cf->procArgsObjPtr)
4143 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4144 if (cf->procBodyObjPtr)
4145 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4146 if (!(flags & JIM_FCF_NOHT))
4147 Jim_FreeHashTable(&cf->vars);
4148 else {
4149 int i;
4150 Jim_HashEntry **table = cf->vars.table, *he;
4152 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4153 he = table[i];
4154 while (he != NULL) {
4155 Jim_HashEntry *nextEntry = he->next;
4156 Jim_Var *varPtr = (void *)he->val;
4158 Jim_DecrRefCount(interp, varPtr->objPtr);
4159 Jim_Free(he->val);
4160 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4161 Jim_Free(he);
4162 table[i] = NULL;
4163 he = nextEntry;
4166 cf->vars.used = 0;
4168 cf->nextFramePtr = interp->freeFramesList;
4169 interp->freeFramesList = cf;
4172 /* -----------------------------------------------------------------------------
4173 * References
4174 * ---------------------------------------------------------------------------*/
4175 #ifdef JIM_REFERENCES
4177 /* References HashTable Type.
4179 * Keys are jim_wide integers, dynamically allocated for now but in the
4180 * future it's worth to cache this 8 bytes objects. Values are poitners
4181 * to Jim_References. */
4182 static void JimReferencesHTValDestructor(void *interp, void *val)
4184 Jim_Reference *refPtr = (void *)val;
4186 Jim_DecrRefCount(interp, refPtr->objPtr);
4187 if (refPtr->finalizerCmdNamePtr != NULL) {
4188 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4190 Jim_Free(val);
4193 unsigned int JimReferencesHTHashFunction(const void *key)
4195 /* Only the least significant bits are used. */
4196 const jim_wide *widePtr = key;
4197 unsigned int intValue = (unsigned int)*widePtr;
4199 return Jim_IntHashFunction(intValue);
4202 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4204 void *copy = Jim_Alloc(sizeof(jim_wide));
4206 JIM_NOTUSED(privdata);
4208 memcpy(copy, key, sizeof(jim_wide));
4209 return copy;
4212 int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4214 JIM_NOTUSED(privdata);
4216 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4219 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4221 JIM_NOTUSED(privdata);
4223 Jim_Free((void *)key);
4226 static const Jim_HashTableType JimReferencesHashTableType = {
4227 JimReferencesHTHashFunction, /* hash function */
4228 JimReferencesHTKeyDup, /* key dup */
4229 NULL, /* val dup */
4230 JimReferencesHTKeyCompare, /* key compare */
4231 JimReferencesHTKeyDestructor, /* key destructor */
4232 JimReferencesHTValDestructor /* val destructor */
4235 /* -----------------------------------------------------------------------------
4236 * Reference object type and References API
4237 * ---------------------------------------------------------------------------*/
4239 /* The string representation of references has two features in order
4240 * to make the GC faster. The first is that every reference starts
4241 * with a non common character '<', in order to make the string matching
4242 * faster. The second is that the reference string rep is 42 characters
4243 * in length, this allows to avoid to check every object with a string
4244 * repr < 42, and usually there aren't many of these objects. */
4246 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
4248 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
4250 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
4252 sprintf(buf, fmt, refPtr->tag, id);
4253 return JIM_REFERENCE_SPACE;
4256 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4258 static const Jim_ObjType referenceObjType = {
4259 "reference",
4260 NULL,
4261 NULL,
4262 UpdateStringOfReference,
4263 JIM_TYPE_REFERENCES,
4266 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4268 int len;
4269 char buf[JIM_REFERENCE_SPACE + 1];
4270 Jim_Reference *refPtr;
4272 refPtr = objPtr->internalRep.refValue.refPtr;
4273 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4274 objPtr->bytes = Jim_Alloc(len + 1);
4275 memcpy(objPtr->bytes, buf, len + 1);
4276 objPtr->length = len;
4279 /* returns true if 'c' is a valid reference tag character.
4280 * i.e. inside the range [_a-zA-Z0-9] */
4281 static int isrefchar(int c)
4283 return (c == '_' || isalnum(c));
4286 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4288 jim_wide wideValue;
4289 int i, len;
4290 const char *str, *start, *end;
4291 char refId[21];
4292 Jim_Reference *refPtr;
4293 Jim_HashEntry *he;
4295 /* Get the string representation */
4296 str = Jim_GetString(objPtr, &len);
4297 /* Check if it looks like a reference */
4298 if (len < JIM_REFERENCE_SPACE)
4299 goto badformat;
4300 /* Trim spaces */
4301 start = str;
4302 end = str + len - 1;
4303 while (*start == ' ')
4304 start++;
4305 while (*end == ' ' && end > start)
4306 end--;
4307 if (end - start + 1 != JIM_REFERENCE_SPACE)
4308 goto badformat;
4309 /* <reference.<1234567>.%020> */
4310 if (memcmp(start, "<reference.<", 12) != 0)
4311 goto badformat;
4312 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
4313 goto badformat;
4314 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4315 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4316 if (!isrefchar(start[12 + i]))
4317 goto badformat;
4319 /* Extract info from the refernece. */
4320 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
4321 refId[20] = '\0';
4322 /* Try to convert the ID into a jim_wide */
4323 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK)
4324 goto badformat;
4325 /* Check if the reference really exists! */
4326 he = Jim_FindHashEntry(&interp->references, &wideValue);
4327 if (he == NULL) {
4328 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
4329 return JIM_ERR;
4331 refPtr = he->val;
4332 /* Free the old internal repr and set the new one. */
4333 Jim_FreeIntRep(interp, objPtr);
4334 objPtr->typePtr = &referenceObjType;
4335 objPtr->internalRep.refValue.id = wideValue;
4336 objPtr->internalRep.refValue.refPtr = refPtr;
4337 return JIM_OK;
4339 badformat:
4340 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
4341 return JIM_ERR;
4344 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4345 * as finalizer command (or NULL if there is no finalizer).
4346 * The returned reference object has refcount = 0. */
4347 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
4349 struct Jim_Reference *refPtr;
4350 jim_wide wideValue = interp->referenceNextId;
4351 Jim_Obj *refObjPtr;
4352 const char *tag;
4353 int tagLen, i;
4355 /* Perform the Garbage Collection if needed. */
4356 Jim_CollectIfNeeded(interp);
4358 refPtr = Jim_Alloc(sizeof(*refPtr));
4359 refPtr->objPtr = objPtr;
4360 Jim_IncrRefCount(objPtr);
4361 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4362 if (cmdNamePtr)
4363 Jim_IncrRefCount(cmdNamePtr);
4364 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4365 refObjPtr = Jim_NewObj(interp);
4366 refObjPtr->typePtr = &referenceObjType;
4367 refObjPtr->bytes = NULL;
4368 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4369 refObjPtr->internalRep.refValue.refPtr = refPtr;
4370 interp->referenceNextId++;
4371 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
4372 * that does not pass the 'isrefchar' test is replaced with '_' */
4373 tag = Jim_GetString(tagPtr, &tagLen);
4374 if (tagLen > JIM_REFERENCE_TAGLEN)
4375 tagLen = JIM_REFERENCE_TAGLEN;
4376 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4377 if (i < tagLen && isrefchar(tag[i]))
4378 refPtr->tag[i] = tag[i];
4379 else
4380 refPtr->tag[i] = '_';
4382 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4383 return refObjPtr;
4386 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4388 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4389 return NULL;
4390 return objPtr->internalRep.refValue.refPtr;
4393 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4395 Jim_Reference *refPtr;
4397 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4398 return JIM_ERR;
4399 Jim_IncrRefCount(cmdNamePtr);
4400 if (refPtr->finalizerCmdNamePtr)
4401 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4402 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4403 return JIM_OK;
4406 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4408 Jim_Reference *refPtr;
4410 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4411 return JIM_ERR;
4412 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4413 return JIM_OK;
4416 /* -----------------------------------------------------------------------------
4417 * References Garbage Collection
4418 * ---------------------------------------------------------------------------*/
4420 /* This the hash table type for the "MARK" phase of the GC */
4421 static const Jim_HashTableType JimRefMarkHashTableType = {
4422 JimReferencesHTHashFunction, /* hash function */
4423 JimReferencesHTKeyDup, /* key dup */
4424 NULL, /* val dup */
4425 JimReferencesHTKeyCompare, /* key compare */
4426 JimReferencesHTKeyDestructor, /* key destructor */
4427 NULL /* val destructor */
4430 /* #define JIM_DEBUG_GC 1 */
4432 /* Performs the garbage collection. */
4433 int Jim_Collect(Jim_Interp *interp)
4435 Jim_HashTable marks;
4436 Jim_HashTableIterator *htiter;
4437 Jim_HashEntry *he;
4438 Jim_Obj *objPtr;
4439 int collected = 0;
4441 /* Avoid recursive calls */
4442 if (interp->lastCollectId == -1) {
4443 /* Jim_Collect() already running. Return just now. */
4444 return 0;
4446 interp->lastCollectId = -1;
4448 /* Mark all the references found into the 'mark' hash table.
4449 * The references are searched in every live object that
4450 * is of a type that can contain references. */
4451 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4452 objPtr = interp->liveList;
4453 while (objPtr) {
4454 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4455 const char *str, *p;
4456 int len;
4458 /* If the object is of type reference, to get the
4459 * Id is simple... */
4460 if (objPtr->typePtr == &referenceObjType) {
4461 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
4462 #ifdef JIM_DEBUG_GC
4463 printf("MARK (reference): %d refcount: %d" JIM_NL,
4464 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
4465 #endif
4466 objPtr = objPtr->nextObjPtr;
4467 continue;
4469 /* Get the string repr of the object we want
4470 * to scan for references. */
4471 p = str = Jim_GetString(objPtr, &len);
4472 /* Skip objects too little to contain references. */
4473 if (len < JIM_REFERENCE_SPACE) {
4474 objPtr = objPtr->nextObjPtr;
4475 continue;
4477 /* Extract references from the object string repr. */
4478 while (1) {
4479 int i;
4480 jim_wide id;
4481 char buf[21];
4483 if ((p = strstr(p, "<reference.<")) == NULL)
4484 break;
4485 /* Check if it's a valid reference. */
4486 if (len - (p - str) < JIM_REFERENCE_SPACE)
4487 break;
4488 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
4489 break;
4490 for (i = 21; i <= 40; i++)
4491 if (!isdigit(p[i]))
4492 break;
4493 /* Get the ID */
4494 memcpy(buf, p + 21, 20);
4495 buf[20] = '\0';
4496 Jim_StringToWide(buf, &id, 10);
4498 /* Ok, a reference for the given ID
4499 * was found. Mark it. */
4500 Jim_AddHashEntry(&marks, &id, NULL);
4501 #ifdef JIM_DEBUG_GC
4502 printf("MARK: %d" JIM_NL, (int)id);
4503 #endif
4504 p += JIM_REFERENCE_SPACE;
4507 objPtr = objPtr->nextObjPtr;
4510 /* Run the references hash table to destroy every reference that
4511 * is not referenced outside (not present in the mark HT). */
4512 htiter = Jim_GetHashTableIterator(&interp->references);
4513 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4514 const jim_wide *refId;
4515 Jim_Reference *refPtr;
4517 refId = he->key;
4518 /* Check if in the mark phase we encountered
4519 * this reference. */
4520 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4521 #ifdef JIM_DEBUG_GC
4522 printf("COLLECTING %d" JIM_NL, (int)*refId);
4523 #endif
4524 collected++;
4525 /* Drop the reference, but call the
4526 * finalizer first if registered. */
4527 refPtr = he->val;
4528 if (refPtr->finalizerCmdNamePtr) {
4529 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
4530 Jim_Obj *objv[3], *oldResult;
4532 JimFormatReference(refstr, refPtr, *refId);
4534 objv[0] = refPtr->finalizerCmdNamePtr;
4535 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, 32);
4536 objv[2] = refPtr->objPtr;
4537 Jim_IncrRefCount(objv[0]);
4538 Jim_IncrRefCount(objv[1]);
4539 Jim_IncrRefCount(objv[2]);
4541 /* Drop the reference itself */
4542 Jim_DeleteHashEntry(&interp->references, refId);
4544 /* Call the finalizer. Errors ignored. */
4545 oldResult = interp->result;
4546 Jim_IncrRefCount(oldResult);
4547 Jim_EvalObjVector(interp, 3, objv);
4548 Jim_SetResult(interp, oldResult);
4549 Jim_DecrRefCount(interp, oldResult);
4551 Jim_DecrRefCount(interp, objv[0]);
4552 Jim_DecrRefCount(interp, objv[1]);
4553 Jim_DecrRefCount(interp, objv[2]);
4555 else {
4556 Jim_DeleteHashEntry(&interp->references, refId);
4560 Jim_FreeHashTableIterator(htiter);
4561 Jim_FreeHashTable(&marks);
4562 interp->lastCollectId = interp->referenceNextId;
4563 interp->lastCollectTime = time(NULL);
4564 return collected;
4567 #define JIM_COLLECT_ID_PERIOD 5000
4568 #define JIM_COLLECT_TIME_PERIOD 300
4570 void Jim_CollectIfNeeded(Jim_Interp *interp)
4572 jim_wide elapsedId;
4573 int elapsedTime;
4575 elapsedId = interp->referenceNextId - interp->lastCollectId;
4576 elapsedTime = time(NULL) - interp->lastCollectTime;
4579 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4580 Jim_Collect(interp);
4583 #endif
4585 /* -----------------------------------------------------------------------------
4586 * Interpreter related functions
4587 * ---------------------------------------------------------------------------*/
4589 Jim_Interp *Jim_CreateInterp(void)
4591 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4593 i->errorLine = 0;
4594 i->errorFileName = Jim_StrDup("");
4595 i->addStackTrace = 0;
4596 i->numLevels = 0;
4597 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4598 i->returnCode = JIM_OK;
4599 i->returnLevel = 0;
4600 i->exitCode = 0;
4601 i->procEpoch = 0;
4602 i->callFrameEpoch = 0;
4603 i->liveList = i->freeList = NULL;
4604 i->referenceNextId = 0;
4605 i->lastCollectId = 0;
4606 i->lastCollectTime = time(NULL);
4607 i->freeFramesList = NULL;
4608 i->prngState = NULL;
4609 i->id = 0;
4610 i->sigmask = 0;
4611 i->signal_level = 0;
4612 i->signal_set_result = NULL;
4613 i->localProcs = NULL;
4615 /* Note that we can create objects only after the
4616 * interpreter liveList and freeList pointers are
4617 * initialized to NULL. */
4618 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4619 #ifdef JIM_REFERENCES
4620 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4621 #endif
4622 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType, NULL);
4623 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4624 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4625 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4626 i->emptyObj = Jim_NewEmptyStringObj(i);
4627 i->trueObj = Jim_NewIntObj(i, 1);
4628 i->falseObj = Jim_NewIntObj(i, 0);
4629 i->result = i->emptyObj;
4630 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4631 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4632 i->unknown_called = 0;
4633 i->errorProc = i->emptyObj;
4634 i->currentScriptObj = Jim_NewEmptyStringObj(i);
4635 Jim_IncrRefCount(i->emptyObj);
4636 Jim_IncrRefCount(i->result);
4637 Jim_IncrRefCount(i->stackTrace);
4638 Jim_IncrRefCount(i->unknown);
4639 Jim_IncrRefCount(i->currentScriptObj);
4640 Jim_IncrRefCount(i->errorProc);
4641 Jim_IncrRefCount(i->trueObj);
4642 Jim_IncrRefCount(i->falseObj);
4644 /* Initialize key variables every interpreter should contain */
4645 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, ". /lib/jim");
4646 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
4648 return i;
4651 void Jim_FreeInterp(Jim_Interp *i)
4653 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4654 Jim_Obj *objPtr, *nextObjPtr;
4656 Jim_DecrRefCount(i, i->emptyObj);
4657 Jim_DecrRefCount(i, i->trueObj);
4658 Jim_DecrRefCount(i, i->falseObj);
4659 Jim_DecrRefCount(i, i->result);
4660 Jim_DecrRefCount(i, i->stackTrace);
4661 Jim_DecrRefCount(i, i->errorProc);
4662 Jim_DecrRefCount(i, i->unknown);
4663 Jim_Free((void *)i->errorFileName);
4664 Jim_DecrRefCount(i, i->currentScriptObj);
4665 Jim_FreeHashTable(&i->commands);
4666 Jim_FreeHashTable(&i->references);
4667 Jim_FreeHashTable(&i->assocData);
4668 Jim_FreeHashTable(&i->packages);
4669 Jim_Free(i->prngState);
4670 JimDeleteLocalProcs(i);
4672 /* Free the call frames list */
4673 while (cf) {
4674 prevcf = cf->parentCallFrame;
4675 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4676 cf = prevcf;
4678 /* Check that the live object list is empty, otherwise
4679 * there is a memory leak. */
4680 if (i->liveList != NULL) {
4681 Jim_Obj *objPtr = i->liveList;
4683 printf(JIM_NL "-------------------------------------" JIM_NL);
4684 printf("Objects still in the free list:" JIM_NL);
4685 while (objPtr) {
4686 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
4688 printf("%p (%d) %-10s: '%.20s'" JIM_NL,
4689 objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
4690 if (objPtr->typePtr == &sourceObjType) {
4691 printf("FILE %s LINE %d" JIM_NL,
4692 objPtr->internalRep.sourceValue.fileName,
4693 objPtr->internalRep.sourceValue.lineNumber);
4695 objPtr = objPtr->nextObjPtr;
4697 printf("-------------------------------------" JIM_NL JIM_NL);
4698 Jim_Panic(i, "Live list non empty freeing the interpreter! Leak?");
4700 /* Free all the freed objects. */
4701 objPtr = i->freeList;
4702 while (objPtr) {
4703 nextObjPtr = objPtr->nextObjPtr;
4704 Jim_Free(objPtr);
4705 objPtr = nextObjPtr;
4707 /* Free cached CallFrame structures */
4708 cf = i->freeFramesList;
4709 while (cf) {
4710 nextcf = cf->nextFramePtr;
4711 if (cf->vars.table != NULL)
4712 Jim_Free(cf->vars.table);
4713 Jim_Free(cf);
4714 cf = nextcf;
4716 /* Free the sharedString hash table. Make sure to free it
4717 * after every other Jim_Object was freed. */
4718 Jim_FreeHashTable(&i->sharedStrings);
4719 /* Free the interpreter structure. */
4720 Jim_Free(i);
4723 /* Store the call frame relative to the level represented by
4724 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4725 * level is assumed to be '1'.
4727 * If a newLevelptr int pointer is specified, the function stores
4728 * the absolute level integer value of the new target callframe into
4729 * *newLevelPtr. (this is used to adjust interp->numLevels
4730 * in the implementation of [uplevel], so that [info level] will
4731 * return a correct information).
4733 * This function accepts the 'level' argument in the form
4734 * of the commands [uplevel] and [upvar].
4736 * For a function accepting a relative integer as level suitable
4737 * for implementation of [info level ?level?] check the
4738 * GetCallFrameByInteger() function. */
4739 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4740 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4742 long level;
4743 const char *str;
4744 Jim_CallFrame *framePtr;
4746 if (newLevelPtr)
4747 *newLevelPtr = interp->numLevels;
4748 if (levelObjPtr) {
4749 str = Jim_GetString(levelObjPtr, NULL);
4750 if (str[0] == '#') {
4751 char *endptr;
4753 /* speedup for the toplevel (level #0) */
4754 if (str[1] == '0' && str[2] == '\0') {
4755 if (newLevelPtr)
4756 *newLevelPtr = 0;
4757 *framePtrPtr = interp->topFramePtr;
4758 return JIM_OK;
4761 level = strtol(str + 1, &endptr, 0);
4762 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4763 goto badlevel;
4764 /* An 'absolute' level is converted into the
4765 * 'number of levels to go back' format. */
4766 level = interp->numLevels - level;
4767 if (level < 0)
4768 goto badlevel;
4770 else {
4771 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4772 goto badlevel;
4775 else {
4776 str = "1"; /* Needed to format the error message. */
4777 level = 1;
4779 /* Lookup */
4780 framePtr = interp->framePtr;
4781 if (newLevelPtr)
4782 *newLevelPtr = (*newLevelPtr) - level;
4783 while (level--) {
4784 framePtr = framePtr->parentCallFrame;
4785 if (framePtr == NULL)
4786 goto badlevel;
4788 *framePtrPtr = framePtr;
4789 return JIM_OK;
4790 badlevel:
4791 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
4792 return JIM_ERR;
4795 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4796 * as a relative integer like in the [info level ?level?] command. */
4797 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4798 Jim_CallFrame **framePtrPtr)
4800 jim_wide level;
4801 jim_wide relLevel; /* level relative to the current one. */
4802 Jim_CallFrame *framePtr;
4804 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4805 goto badlevel;
4806 if (level > 0) {
4807 /* An 'absolute' level is converted into the
4808 * 'number of levels to go back' format. */
4809 relLevel = interp->numLevels - level;
4811 else {
4812 relLevel = -level;
4814 /* Lookup */
4815 framePtr = interp->framePtr;
4816 while (relLevel--) {
4817 framePtr = framePtr->parentCallFrame;
4818 if (framePtr == NULL)
4819 goto badlevel;
4821 *framePtrPtr = framePtr;
4822 return JIM_OK;
4823 badlevel:
4824 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
4825 return JIM_ERR;
4828 static void JimSetErrorFileName(Jim_Interp *interp, const char *filename)
4830 Jim_Free((void *)interp->errorFileName);
4831 interp->errorFileName = Jim_StrDup(filename);
4834 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4836 interp->errorLine = linenr;
4839 static void JimResetStackTrace(Jim_Interp *interp)
4841 Jim_DecrRefCount(interp, interp->stackTrace);
4842 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4843 Jim_IncrRefCount(interp->stackTrace);
4846 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
4848 int len;
4850 /* Increment reference first in case these are the same object */
4851 Jim_IncrRefCount(stackTraceObj);
4852 Jim_DecrRefCount(interp, interp->stackTrace);
4853 interp->stackTrace = stackTraceObj;
4854 interp->errorFlag = 1;
4856 /* This is a bit ugly.
4857 * If the filename of the last entry of the stack trace is empty,
4858 * the next stack level should be added.
4860 len = Jim_ListLength(interp, interp->stackTrace);
4861 if (len >= 3) {
4862 Jim_Obj *filenameObj;
4864 Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj, JIM_NONE);
4866 Jim_GetString(filenameObj, &len);
4868 if (len == 0) {
4869 interp->addStackTrace = 1;
4874 /* Returns 1 if the stack trace information was used or 0 if not */
4875 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4876 const char *filename, int linenr)
4878 #if 0
4879 printf("JimAppendStackTrace: %s:%d (%s)\n", filename, linenr, procname);
4880 #endif
4882 /* XXX Omit "unknown" for now since it can be confusing (but it may help too!) */
4883 if (strcmp(procname, "unknown") == 0) {
4884 procname = "";
4886 if (!*procname && !*filename) {
4887 /* No useful info here */
4888 return;
4891 if (Jim_IsShared(interp->stackTrace)) {
4892 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
4893 Jim_IncrRefCount(interp->stackTrace);
4896 /* If we have no procname but the previous element did, merge with that frame */
4897 if (!*procname && *filename) {
4898 /* Just a filename. Check the previous entry */
4899 int len = Jim_ListLength(interp, interp->stackTrace);
4901 if (len >= 3) {
4902 Jim_Obj *procnameObj;
4903 Jim_Obj *filenameObj;
4905 if (Jim_ListIndex(interp, interp->stackTrace, len - 3, &procnameObj, JIM_NONE) == JIM_OK
4906 && Jim_ListIndex(interp, interp->stackTrace, len - 2, &filenameObj,
4907 JIM_NONE) == JIM_OK) {
4909 const char *prev_procname = Jim_GetString(procnameObj, NULL);
4910 const char *prev_filename = Jim_GetString(filenameObj, NULL);
4912 if (*prev_procname && !*prev_filename) {
4913 ListSetIndex(interp, interp->stackTrace, len - 2, Jim_NewStringObj(interp,
4914 filename, -1), 0);
4915 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr),
4917 return;
4923 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
4924 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, filename, -1));
4925 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
4928 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
4929 void *data)
4931 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
4933 assocEntryPtr->delProc = delProc;
4934 assocEntryPtr->data = data;
4935 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4938 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4940 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4942 if (entryPtr != NULL) {
4943 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->val;
4945 return assocEntryPtr->data;
4947 return NULL;
4950 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4952 return Jim_DeleteHashEntry(&interp->assocData, key);
4955 int Jim_GetExitCode(Jim_Interp *interp)
4957 return interp->exitCode;
4960 /* -----------------------------------------------------------------------------
4961 * Shared strings.
4962 * Every interpreter has an hash table where to put shared dynamically
4963 * allocate strings that are likely to be used a lot of times.
4964 * For example, in the 'source' object type, there is a pointer to
4965 * the filename associated with that object. Every script has a lot
4966 * of this objects with the identical file name, so it is wise to share
4967 * this info.
4969 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4970 * returns the pointer to the shared string. Every time a reference
4971 * to the string is no longer used, the user should call
4972 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4973 * a given string, it is removed from the hash table.
4974 * ---------------------------------------------------------------------------*/
4975 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4977 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4979 if (he == NULL) {
4980 char *strCopy = Jim_StrDup(str);
4982 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void *)1);
4983 return strCopy;
4985 else {
4986 long refCount = (long)he->val;
4988 refCount++;
4989 he->val = (void *)refCount;
4990 return he->key;
4994 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4996 long refCount;
4997 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4999 if (he == NULL) {
5000 Jim_Panic(interp, "Jim_ReleaseSharedString called with " "unknown shared string '%s'", str);
5002 else {
5003 refCount = (long)he->val;
5004 refCount--;
5005 if (refCount == 0) {
5006 Jim_DeleteHashEntry(&interp->sharedStrings, str);
5008 else {
5009 he->val = (void *)refCount;
5014 /* -----------------------------------------------------------------------------
5015 * Integer object
5016 * ---------------------------------------------------------------------------*/
5017 #define JIM_INTEGER_SPACE 24
5019 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5020 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5022 static const Jim_ObjType intObjType = {
5023 "int",
5024 NULL,
5025 NULL,
5026 UpdateStringOfInt,
5027 JIM_TYPE_NONE,
5030 /* A coerced double is closer to an int than a double.
5031 * It is an int value temporarily masquerading as a double value.
5032 * i.e. it has the same string value as an int and Jim_GetWide()
5033 * succeeds, but also Jim_GetDouble() returns the value directly.
5035 static const Jim_ObjType coercedDoubleObjType = {
5036 "coerced-double",
5037 NULL,
5038 NULL,
5039 UpdateStringOfInt,
5040 JIM_TYPE_NONE,
5044 void UpdateStringOfInt(struct Jim_Obj *objPtr)
5046 int len;
5047 char buf[JIM_INTEGER_SPACE + 1];
5049 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
5050 objPtr->bytes = Jim_Alloc(len + 1);
5051 memcpy(objPtr->bytes, buf, len + 1);
5052 objPtr->length = len;
5055 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5057 jim_wide wideValue;
5058 const char *str;
5060 if (objPtr->typePtr == &coercedDoubleObjType) {
5061 /* Simple switcheroo */
5062 objPtr->typePtr = &intObjType;
5063 return JIM_OK;
5066 /* Get the string representation */
5067 str = Jim_GetString(objPtr, NULL);
5068 /* Try to convert into a jim_wide */
5069 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5070 if (flags & JIM_ERRMSG) {
5071 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5073 return JIM_ERR;
5075 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5076 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5077 return JIM_ERR;
5079 /* Free the old internal repr and set the new one. */
5080 Jim_FreeIntRep(interp, objPtr);
5081 objPtr->typePtr = &intObjType;
5082 objPtr->internalRep.wideValue = wideValue;
5083 return JIM_OK;
5086 static int Jim_IsWide(Jim_Obj *objPtr)
5088 return objPtr->typePtr == &intObjType;
5091 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5093 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5094 return JIM_ERR;
5095 *widePtr = objPtr->internalRep.wideValue;
5096 return JIM_OK;
5099 /* Get a wide but does not set an error if the format is bad. */
5100 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5102 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5103 return JIM_ERR;
5104 *widePtr = objPtr->internalRep.wideValue;
5105 return JIM_OK;
5108 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5110 jim_wide wideValue;
5111 int retval;
5113 retval = Jim_GetWide(interp, objPtr, &wideValue);
5114 if (retval == JIM_OK) {
5115 *longPtr = (long)wideValue;
5116 return JIM_OK;
5118 return JIM_ERR;
5121 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
5123 if (Jim_IsShared(objPtr))
5124 Jim_Panic(interp, "Jim_SetWide called with shared object");
5125 if (objPtr->typePtr != &intObjType) {
5126 Jim_FreeIntRep(interp, objPtr);
5127 objPtr->typePtr = &intObjType;
5129 Jim_InvalidateStringRep(objPtr);
5130 objPtr->internalRep.wideValue = wideValue;
5133 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5135 Jim_Obj *objPtr;
5137 objPtr = Jim_NewObj(interp);
5138 objPtr->typePtr = &intObjType;
5139 objPtr->bytes = NULL;
5140 objPtr->internalRep.wideValue = wideValue;
5141 return objPtr;
5144 /* -----------------------------------------------------------------------------
5145 * Double object
5146 * ---------------------------------------------------------------------------*/
5147 #define JIM_DOUBLE_SPACE 30
5149 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5150 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5152 static const Jim_ObjType doubleObjType = {
5153 "double",
5154 NULL,
5155 NULL,
5156 UpdateStringOfDouble,
5157 JIM_TYPE_NONE,
5160 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5162 int len;
5163 char buf[JIM_DOUBLE_SPACE + 1];
5165 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
5166 objPtr->bytes = Jim_Alloc(len + 1);
5167 memcpy(objPtr->bytes, buf, len + 1);
5168 objPtr->length = len;
5171 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5173 double doubleValue;
5174 jim_wide wideValue;
5175 const char *str;
5177 /* Preserve the string representation.
5178 * Needed so we can convert back to int without loss
5180 str = Jim_GetString(objPtr, NULL);
5182 #ifdef HAVE_LONG_LONG
5183 /* Assume a 53 bit mantissa */
5184 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5185 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5187 if (objPtr->typePtr == &intObjType
5188 && objPtr->internalRep.wideValue >= MIN_INT_IN_DOUBLE
5189 && objPtr->internalRep.wideValue <= MAX_INT_IN_DOUBLE) {
5191 /* Direct conversion to coerced double */
5192 objPtr->typePtr = &coercedDoubleObjType;
5193 return JIM_OK;
5195 else
5196 #endif
5197 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5198 /* Managed to convert to an int, so we can use this as a cooerced double */
5199 Jim_FreeIntRep(interp, objPtr);
5200 objPtr->typePtr = &coercedDoubleObjType;
5201 objPtr->internalRep.wideValue = wideValue;
5202 return JIM_OK;
5204 else {
5205 /* Try to convert into a double */
5206 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5207 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5208 return JIM_ERR;
5210 /* Free the old internal repr and set the new one. */
5211 Jim_FreeIntRep(interp, objPtr);
5213 objPtr->typePtr = &doubleObjType;
5214 objPtr->internalRep.doubleValue = doubleValue;
5215 return JIM_OK;
5218 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5220 if (objPtr->typePtr == &coercedDoubleObjType) {
5221 *doublePtr = objPtr->internalRep.wideValue;
5222 return JIM_OK;
5224 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5225 return JIM_ERR;
5227 if (objPtr->typePtr == &coercedDoubleObjType) {
5228 *doublePtr = objPtr->internalRep.wideValue;
5230 else {
5231 *doublePtr = objPtr->internalRep.doubleValue;
5233 return JIM_OK;
5236 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5238 Jim_Obj *objPtr;
5240 objPtr = Jim_NewObj(interp);
5241 objPtr->typePtr = &doubleObjType;
5242 objPtr->bytes = NULL;
5243 objPtr->internalRep.doubleValue = doubleValue;
5244 return objPtr;
5247 /* -----------------------------------------------------------------------------
5248 * List object
5249 * ---------------------------------------------------------------------------*/
5250 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5251 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5252 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5253 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5254 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5256 /* Note that while the elements of the list may contain references,
5257 * the list object itself can't. This basically means that the
5258 * list object string representation as a whole can't contain references
5259 * that are not presents in the single elements. */
5260 static const Jim_ObjType listObjType = {
5261 "list",
5262 FreeListInternalRep,
5263 DupListInternalRep,
5264 UpdateStringOfList,
5265 JIM_TYPE_NONE,
5268 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5270 int i;
5272 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5273 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
5275 Jim_Free(objPtr->internalRep.listValue.ele);
5278 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5280 int i;
5282 JIM_NOTUSED(interp);
5284 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5285 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5286 dupPtr->internalRep.listValue.ele =
5287 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
5288 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5289 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
5290 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5291 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5293 dupPtr->typePtr = &listObjType;
5296 /* The following function checks if a given string can be encoded
5297 * into a list element without any kind of quoting, surrounded by braces,
5298 * or using escapes to quote. */
5299 #define JIM_ELESTR_SIMPLE 0
5300 #define JIM_ELESTR_BRACE 1
5301 #define JIM_ELESTR_QUOTE 2
5302 static int ListElementQuotingType(const char *s, int len)
5304 int i, level, trySimple = 1;
5306 /* Try with the SIMPLE case */
5307 if (len == 0)
5308 return JIM_ELESTR_BRACE;
5309 if (s[0] == '#')
5310 return JIM_ELESTR_BRACE;
5311 if (s[0] == '"' || s[0] == '{') {
5312 trySimple = 0;
5313 goto testbrace;
5315 for (i = 0; i < len; i++) {
5316 switch (s[i]) {
5317 case ' ':
5318 case '$':
5319 case '"':
5320 case '[':
5321 case ']':
5322 case ';':
5323 case '\\':
5324 case '\r':
5325 case '\n':
5326 case '\t':
5327 case '\f':
5328 case '\v':
5329 trySimple = 0;
5330 case '{':
5331 case '}':
5332 goto testbrace;
5335 return JIM_ELESTR_SIMPLE;
5337 testbrace:
5338 /* Test if it's possible to do with braces */
5339 if (s[len - 1] == '\\' || s[len - 1] == ']')
5340 return JIM_ELESTR_QUOTE;
5341 level = 0;
5342 for (i = 0; i < len; i++) {
5343 switch (s[i]) {
5344 case '{':
5345 level++;
5346 break;
5347 case '}':
5348 level--;
5349 if (level < 0)
5350 return JIM_ELESTR_QUOTE;
5351 break;
5352 case '\\':
5353 if (s[i + 1] == '\n')
5354 return JIM_ELESTR_QUOTE;
5355 else if (s[i + 1] != '\0')
5356 i++;
5357 break;
5360 if (level == 0) {
5361 if (!trySimple)
5362 return JIM_ELESTR_BRACE;
5363 for (i = 0; i < len; i++) {
5364 switch (s[i]) {
5365 case ' ':
5366 case '$':
5367 case '"':
5368 case '[':
5369 case ']':
5370 case ';':
5371 case '\\':
5372 case '\r':
5373 case '\n':
5374 case '\t':
5375 case '\f':
5376 case '\v':
5377 return JIM_ELESTR_BRACE;
5378 break;
5381 return JIM_ELESTR_SIMPLE;
5383 return JIM_ELESTR_QUOTE;
5386 /* Returns the malloc-ed representation of a string
5387 * using backslash to quote special chars. */
5388 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5390 char *q = Jim_Alloc(len * 2 + 1), *p;
5392 p = q;
5393 while (*s) {
5394 switch (*s) {
5395 case ' ':
5396 case '$':
5397 case '"':
5398 case '[':
5399 case ']':
5400 case '{':
5401 case '}':
5402 case ';':
5403 case '\\':
5404 *p++ = '\\';
5405 *p++ = *s++;
5406 break;
5407 case '\n':
5408 *p++ = '\\';
5409 *p++ = 'n';
5410 s++;
5411 break;
5412 case '\r':
5413 *p++ = '\\';
5414 *p++ = 'r';
5415 s++;
5416 break;
5417 case '\t':
5418 *p++ = '\\';
5419 *p++ = 't';
5420 s++;
5421 break;
5422 case '\f':
5423 *p++ = '\\';
5424 *p++ = 'f';
5425 s++;
5426 break;
5427 case '\v':
5428 *p++ = '\\';
5429 *p++ = 'v';
5430 s++;
5431 break;
5432 default:
5433 *p++ = *s++;
5434 break;
5437 *p = '\0';
5438 *qlenPtr = p - q;
5439 return q;
5442 void UpdateStringOfList(struct Jim_Obj *objPtr)
5444 int i, bufLen, realLength;
5445 const char *strRep;
5446 char *p;
5447 int *quotingType;
5448 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5450 /* (Over) Estimate the space needed. */
5451 quotingType = Jim_Alloc(sizeof(int) * objPtr->internalRep.listValue.len + 1);
5452 bufLen = 0;
5453 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5454 int len;
5456 strRep = Jim_GetString(ele[i], &len);
5457 quotingType[i] = ListElementQuotingType(strRep, len);
5458 switch (quotingType[i]) {
5459 case JIM_ELESTR_SIMPLE:
5460 bufLen += len;
5461 break;
5462 case JIM_ELESTR_BRACE:
5463 bufLen += len + 2;
5464 break;
5465 case JIM_ELESTR_QUOTE:
5466 bufLen += len * 2;
5467 break;
5469 bufLen++; /* elements separator. */
5471 bufLen++;
5473 /* Generate the string rep. */
5474 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
5475 realLength = 0;
5476 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5477 int len, qlen;
5478 const char *strRep = Jim_GetString(ele[i], &len);
5479 char *q;
5481 switch (quotingType[i]) {
5482 case JIM_ELESTR_SIMPLE:
5483 memcpy(p, strRep, len);
5484 p += len;
5485 realLength += len;
5486 break;
5487 case JIM_ELESTR_BRACE:
5488 *p++ = '{';
5489 memcpy(p, strRep, len);
5490 p += len;
5491 *p++ = '}';
5492 realLength += len + 2;
5493 break;
5494 case JIM_ELESTR_QUOTE:
5495 q = BackslashQuoteString(strRep, len, &qlen);
5496 memcpy(p, q, qlen);
5497 Jim_Free(q);
5498 p += qlen;
5499 realLength += qlen;
5500 break;
5502 /* Add a separating space */
5503 if (i + 1 != objPtr->internalRep.listValue.len) {
5504 *p++ = ' ';
5505 realLength++;
5508 *p = '\0'; /* nul term. */
5509 objPtr->length = realLength;
5510 Jim_Free(quotingType);
5513 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5515 struct JimParserCtx parser;
5516 const char *str;
5517 int strLen;
5519 /* Get the string representation */
5520 str = Jim_GetString(objPtr, &strLen);
5522 /* Free the old internal repr just now and initialize the
5523 * new one just now. The string->list conversion can't fail. */
5524 Jim_FreeIntRep(interp, objPtr);
5525 objPtr->typePtr = &listObjType;
5526 objPtr->internalRep.listValue.len = 0;
5527 objPtr->internalRep.listValue.maxLen = 0;
5528 objPtr->internalRep.listValue.ele = NULL;
5530 /* Convert into a list */
5531 JimParserInit(&parser, str, strLen, 1);
5532 while (!JimParserEof(&parser)) {
5533 char *token;
5534 int tokenLen, type;
5535 Jim_Obj *elementPtr;
5537 JimParseList(&parser);
5538 if (JimParserTtype(&parser) != JIM_TT_STR && JimParserTtype(&parser) != JIM_TT_ESC)
5539 continue;
5540 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5541 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5542 ListAppendElement(objPtr, elementPtr);
5544 return JIM_OK;
5547 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5549 Jim_Obj *objPtr;
5550 int i;
5552 objPtr = Jim_NewObj(interp);
5553 objPtr->typePtr = &listObjType;
5554 objPtr->bytes = NULL;
5555 objPtr->internalRep.listValue.ele = NULL;
5556 objPtr->internalRep.listValue.len = 0;
5557 objPtr->internalRep.listValue.maxLen = 0;
5558 for (i = 0; i < len; i++) {
5559 ListAppendElement(objPtr, elements[i]);
5561 return objPtr;
5564 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5565 * length of the vector. Note that the user of this function should make
5566 * sure that the list object can't shimmer while the vector returned
5567 * is in use, this vector is the one stored inside the internal representation
5568 * of the list object. This function is not exported, extensions should
5569 * always access to the List object elements using Jim_ListIndex(). */
5570 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
5571 Jim_Obj ***listVec)
5573 *listLen = Jim_ListLength(interp, listObj);
5574 *listVec = listObj->internalRep.listValue.ele;
5577 /* Sorting uses ints, but commands may return wide */
5578 static int JimSign(jim_wide w)
5580 if (w == 0) {
5581 return 0;
5583 else if (w < 0) {
5584 return -1;
5586 return 1;
5589 /* ListSortElements type values */
5590 enum
5591 { JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_INTEGER, JIM_LSORT_COMMAND };
5593 /* Why doesn't qsort allow a user arg!!! */
5594 static jmp_buf sort_jmpbuf;
5595 static Jim_Obj *sort_command = 0;
5596 static Jim_Interp *sort_interp = 0;
5597 static int sort_order;
5599 /* Sort the internal rep of a list. */
5600 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5602 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * sort_order;
5605 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5607 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * sort_order;
5610 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5612 jim_wide lhs = 0, rhs = 0;
5614 /* REVISIT: If these are not valid integers, bogus results ... */
5615 if (Jim_GetWide(sort_interp, *lhsObj, &lhs) != JIM_OK ||
5616 Jim_GetWide(sort_interp, *rhsObj, &rhs) != JIM_OK) {
5617 longjmp(sort_jmpbuf, JIM_ERR);
5620 return JimSign(lhs - rhs) * sort_order;
5623 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5625 Jim_Obj *compare_script;
5626 int rc;
5628 jim_wide ret = 0;
5630 /* This must be a valid list */
5631 compare_script = Jim_DuplicateObj(sort_interp, sort_command);
5632 Jim_ListAppendElement(sort_interp, compare_script, *lhsObj);
5633 Jim_ListAppendElement(sort_interp, compare_script, *rhsObj);
5635 rc = Jim_EvalObj(sort_interp, compare_script);
5637 if (rc != JIM_OK) {
5638 longjmp(sort_jmpbuf, rc);
5641 Jim_GetWide(sort_interp, Jim_GetResult(sort_interp), &ret);
5642 return JimSign(ret) * sort_order;
5645 /* Sort a list *in place*. MUST be called with non-shared objects. */
5646 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type, int order,
5647 Jim_Obj *command)
5649 typedef int (qsort_comparator) (const void *, const void *);
5650 int (*fn) (Jim_Obj **, Jim_Obj **);
5651 Jim_Obj **vector;
5652 int len;
5653 int rc;
5655 if (Jim_IsShared(listObjPtr))
5656 Jim_Panic(interp, "Jim_ListSortElements called with shared object");
5657 if (!Jim_IsList(listObjPtr))
5658 SetListFromAny(interp, listObjPtr);
5660 sort_order = order;
5661 sort_command = command;
5662 sort_interp = interp;
5664 vector = listObjPtr->internalRep.listValue.ele;
5665 len = listObjPtr->internalRep.listValue.len;
5666 switch (type) {
5667 case JIM_LSORT_ASCII:
5668 fn = ListSortString;
5669 break;
5670 case JIM_LSORT_NOCASE:
5671 fn = ListSortStringNoCase;
5672 break;
5673 case JIM_LSORT_INTEGER:
5674 fn = ListSortInteger;
5675 break;
5676 case JIM_LSORT_COMMAND:
5677 fn = ListSortCommand;
5678 break;
5679 default:
5680 fn = NULL; /* avoid warning */
5681 Jim_Panic(interp, "ListSort called with invalid sort type");
5683 if ((rc = setjmp(sort_jmpbuf)) == 0) {
5684 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
5686 Jim_InvalidateStringRep(listObjPtr);
5688 return rc;
5691 /* This is the low-level function to append an element to a list.
5692 * The higher-level Jim_ListAppendElement() performs shared object
5693 * check and invalidate the string repr. This version is used
5694 * in the internals of the List Object and is not exported.
5696 * NOTE: this function can be called only against objects
5697 * with internal type of List. */
5698 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5700 int requiredLen = listPtr->internalRep.listValue.len + 1;
5702 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5703 int maxLen = requiredLen * 2;
5705 listPtr->internalRep.listValue.ele =
5706 Jim_Realloc(listPtr->internalRep.listValue.ele, sizeof(Jim_Obj *) * maxLen);
5707 listPtr->internalRep.listValue.maxLen = maxLen;
5709 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] = objPtr;
5710 listPtr->internalRep.listValue.len++;
5711 Jim_IncrRefCount(objPtr);
5714 /* This is the low-level function to insert elements into a list.
5715 * The higher-level Jim_ListInsertElements() performs shared object
5716 * check and invalidate the string repr. This version is used
5717 * in the internals of the List Object and is not exported.
5719 * NOTE: this function can be called only against objects
5720 * with internal type of List. */
5721 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc, Jim_Obj *const *elemVec)
5723 int currentLen = listPtr->internalRep.listValue.len;
5724 int requiredLen = currentLen + elemc;
5725 int i;
5726 Jim_Obj **point;
5728 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5729 int maxLen = requiredLen * 2;
5731 listPtr->internalRep.listValue.ele =
5732 Jim_Realloc(listPtr->internalRep.listValue.ele, sizeof(Jim_Obj *) * maxLen);
5733 listPtr->internalRep.listValue.maxLen = maxLen;
5735 point = listPtr->internalRep.listValue.ele + index;
5736 memmove(point + elemc, point, (currentLen - index) * sizeof(Jim_Obj *));
5737 for (i = 0; i < elemc; ++i) {
5738 point[i] = elemVec[i];
5739 Jim_IncrRefCount(point[i]);
5741 listPtr->internalRep.listValue.len += elemc;
5744 /* Appends every element of appendListPtr into listPtr.
5745 * Both have to be of the list type. */
5746 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5748 int i, oldLen = listPtr->internalRep.listValue.len;
5749 int appendLen = appendListPtr->internalRep.listValue.len;
5750 int requiredLen = oldLen + appendLen;
5752 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5753 int maxLen = requiredLen * 2;
5755 listPtr->internalRep.listValue.ele =
5756 Jim_Realloc(listPtr->internalRep.listValue.ele, sizeof(Jim_Obj *) * maxLen);
5757 listPtr->internalRep.listValue.maxLen = maxLen;
5759 for (i = 0; i < appendLen; i++) {
5760 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5762 listPtr->internalRep.listValue.ele[oldLen + i] = objPtr;
5763 Jim_IncrRefCount(objPtr);
5765 listPtr->internalRep.listValue.len += appendLen;
5768 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5770 if (Jim_IsShared(listPtr))
5771 Jim_Panic(interp, "Jim_ListAppendElement called with shared object");
5772 if (!Jim_IsList(listPtr))
5773 SetListFromAny(interp, listPtr);
5774 Jim_InvalidateStringRep(listPtr);
5775 ListAppendElement(listPtr, objPtr);
5778 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5780 if (Jim_IsShared(listPtr))
5781 Jim_Panic(interp, "Jim_ListAppendList called with shared object");
5782 if (!Jim_IsList(listPtr))
5783 SetListFromAny(interp, listPtr);
5784 Jim_InvalidateStringRep(listPtr);
5785 ListAppendList(listPtr, appendListPtr);
5788 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
5790 if (!Jim_IsList(objPtr))
5791 SetListFromAny(interp, objPtr);
5792 return objPtr->internalRep.listValue.len;
5795 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5796 int objc, Jim_Obj *const *objVec)
5798 if (Jim_IsShared(listPtr))
5799 Jim_Panic(interp, "Jim_ListInsertElement called with shared object");
5800 if (!Jim_IsList(listPtr))
5801 SetListFromAny(interp, listPtr);
5802 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5803 index = listPtr->internalRep.listValue.len;
5804 else if (index < 0)
5805 index = 0;
5806 Jim_InvalidateStringRep(listPtr);
5807 ListInsertElements(listPtr, index, objc, objVec);
5810 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index, Jim_Obj **objPtrPtr, int flags)
5812 if (!Jim_IsList(listPtr))
5813 SetListFromAny(interp, listPtr);
5814 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5815 (index < 0 && (-index - 1) >= listPtr->internalRep.listValue.len)) {
5816 if (flags & JIM_ERRMSG) {
5817 Jim_SetResultString(interp, "list index out of range", -1);
5819 *objPtrPtr = NULL;
5820 return JIM_ERR;
5822 if (index < 0)
5823 index = listPtr->internalRep.listValue.len + index;
5824 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5825 return JIM_OK;
5828 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5829 Jim_Obj *newObjPtr, int flags)
5831 if (!Jim_IsList(listPtr))
5832 SetListFromAny(interp, listPtr);
5833 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5834 (index < 0 && (-index - 1) >= listPtr->internalRep.listValue.len)) {
5835 if (flags & JIM_ERRMSG) {
5836 Jim_SetResultString(interp, "list index out of range", -1);
5838 return JIM_ERR;
5840 if (index < 0)
5841 index = listPtr->internalRep.listValue.len + index;
5842 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5843 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5844 Jim_IncrRefCount(newObjPtr);
5845 return JIM_OK;
5848 /* Modify the list stored into the variable named 'varNamePtr'
5849 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5850 * with the new element 'newObjptr'. */
5851 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5852 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5854 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5855 int shared, i, index;
5857 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5858 if (objPtr == NULL)
5859 return JIM_ERR;
5860 if ((shared = Jim_IsShared(objPtr)))
5861 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5862 for (i = 0; i < indexc - 1; i++) {
5863 listObjPtr = objPtr;
5864 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5865 goto err;
5866 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr, JIM_ERRMSG) != JIM_OK) {
5867 goto err;
5869 if (Jim_IsShared(objPtr)) {
5870 objPtr = Jim_DuplicateObj(interp, objPtr);
5871 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5873 Jim_InvalidateStringRep(listObjPtr);
5875 if (Jim_GetIndex(interp, indexv[indexc - 1], &index) != JIM_OK)
5876 goto err;
5877 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5878 goto err;
5879 Jim_InvalidateStringRep(objPtr);
5880 Jim_InvalidateStringRep(varObjPtr);
5881 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5882 goto err;
5883 Jim_SetResult(interp, varObjPtr);
5884 return JIM_OK;
5885 err:
5886 if (shared) {
5887 Jim_FreeNewObj(interp, varObjPtr);
5889 return JIM_ERR;
5892 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5894 int i;
5896 /* If all the objects in objv are lists,
5897 * it's possible to return a list as result, that's the
5898 * concatenation of all the lists. */
5899 for (i = 0; i < objc; i++) {
5900 if (!Jim_IsList(objv[i]))
5901 break;
5903 if (i == objc) {
5904 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5906 for (i = 0; i < objc; i++)
5907 Jim_ListAppendList(interp, objPtr, objv[i]);
5908 return objPtr;
5910 else {
5911 /* Else... we have to glue strings together */
5912 int len = 0, objLen;
5913 char *bytes, *p;
5915 /* Compute the length */
5916 for (i = 0; i < objc; i++) {
5917 Jim_GetString(objv[i], &objLen);
5918 len += objLen;
5920 if (objc)
5921 len += objc - 1;
5922 /* Create the string rep, and a stinrg object holding it. */
5923 p = bytes = Jim_Alloc(len + 1);
5924 for (i = 0; i < objc; i++) {
5925 const char *s = Jim_GetString(objv[i], &objLen);
5927 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
5928 s++;
5929 objLen--;
5930 len--;
5932 while (objLen && (s[objLen - 1] == ' ' ||
5933 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
5934 objLen--;
5935 len--;
5937 memcpy(p, s, objLen);
5938 p += objLen;
5939 if (objLen && i + 1 != objc) {
5940 *p++ = ' ';
5942 else if (i + 1 != objc) {
5943 /* Drop the space calcuated for this
5944 * element that is instead null. */
5945 len--;
5948 *p = '\0';
5949 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5953 /* Returns a list composed of the elements in the specified range.
5954 * first and start are directly accepted as Jim_Objects and
5955 * processed for the end?-index? case. */
5956 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
5957 Jim_Obj *lastObjPtr)
5959 int first, last;
5960 int len, rangeLen;
5962 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5963 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5964 return NULL;
5965 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
5966 first = JimRelToAbsIndex(len, first);
5967 last = JimRelToAbsIndex(len, last);
5968 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5969 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
5972 /* -----------------------------------------------------------------------------
5973 * Dict object
5974 * ---------------------------------------------------------------------------*/
5975 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5976 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5977 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5978 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5980 /* Dict HashTable Type.
5982 * Keys and Values are Jim objects. */
5984 unsigned int JimObjectHTHashFunction(const void *key)
5986 const char *str;
5987 Jim_Obj *objPtr = (Jim_Obj *)key;
5988 int len, h;
5990 str = Jim_GetString(objPtr, &len);
5991 h = Jim_GenHashFunction((unsigned char *)str, len);
5992 return h;
5995 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5997 JIM_NOTUSED(privdata);
5999 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2, 0);
6002 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6004 Jim_Obj *objPtr = val;
6006 Jim_DecrRefCount(interp, objPtr);
6009 static const Jim_HashTableType JimDictHashTableType = {
6010 JimObjectHTHashFunction, /* hash function */
6011 NULL, /* key dup */
6012 NULL, /* val dup */
6013 JimObjectHTKeyCompare, /* key compare */
6014 (void (*)(void *, const void *)) /* ATTENTION: const cast */
6015 JimObjectHTKeyValDestructor, /* key destructor */
6016 JimObjectHTKeyValDestructor /* val destructor */
6019 /* Note that while the elements of the dict may contain references,
6020 * the list object itself can't. This basically means that the
6021 * dict object string representation as a whole can't contain references
6022 * that are not presents in the single elements. */
6023 static const Jim_ObjType dictObjType = {
6024 "dict",
6025 FreeDictInternalRep,
6026 DupDictInternalRep,
6027 UpdateStringOfDict,
6028 JIM_TYPE_NONE,
6031 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6033 JIM_NOTUSED(interp);
6035 Jim_FreeHashTable(objPtr->internalRep.ptr);
6036 Jim_Free(objPtr->internalRep.ptr);
6039 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6041 Jim_HashTable *ht, *dupHt;
6042 Jim_HashTableIterator *htiter;
6043 Jim_HashEntry *he;
6045 /* Create a new hash table */
6046 ht = srcPtr->internalRep.ptr;
6047 dupHt = Jim_Alloc(sizeof(*dupHt));
6048 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6049 if (ht->size != 0)
6050 Jim_ExpandHashTable(dupHt, ht->size);
6051 /* Copy every element from the source to the dup hash table */
6052 htiter = Jim_GetHashTableIterator(ht);
6053 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6054 const Jim_Obj *keyObjPtr = he->key;
6055 Jim_Obj *valObjPtr = he->val;
6057 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6058 Jim_IncrRefCount(valObjPtr);
6059 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6061 Jim_FreeHashTableIterator(htiter);
6063 dupPtr->internalRep.ptr = dupHt;
6064 dupPtr->typePtr = &dictObjType;
6067 void UpdateStringOfDict(struct Jim_Obj *objPtr)
6069 int i, bufLen, realLength;
6070 const char *strRep;
6071 char *p;
6072 int *quotingType, objc;
6073 Jim_HashTable *ht;
6074 Jim_HashTableIterator *htiter;
6075 Jim_HashEntry *he;
6076 Jim_Obj **objv;
6078 /* Trun the hash table into a flat vector of Jim_Objects. */
6079 ht = objPtr->internalRep.ptr;
6080 objc = ht->used * 2;
6081 objv = Jim_Alloc(objc * sizeof(Jim_Obj *));
6082 htiter = Jim_GetHashTableIterator(ht);
6083 i = 0;
6084 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6085 objv[i++] = (Jim_Obj *)he->key; /* ATTENTION: const cast */
6086 objv[i++] = he->val;
6088 Jim_FreeHashTableIterator(htiter);
6089 /* (Over) Estimate the space needed. */
6090 quotingType = Jim_Alloc(sizeof(int) * objc);
6091 bufLen = 0;
6092 for (i = 0; i < objc; i++) {
6093 int len;
6095 strRep = Jim_GetString(objv[i], &len);
6096 quotingType[i] = ListElementQuotingType(strRep, len);
6097 switch (quotingType[i]) {
6098 case JIM_ELESTR_SIMPLE:
6099 bufLen += len;
6100 break;
6101 case JIM_ELESTR_BRACE:
6102 bufLen += len + 2;
6103 break;
6104 case JIM_ELESTR_QUOTE:
6105 bufLen += len * 2;
6106 break;
6108 bufLen++; /* elements separator. */
6110 bufLen++;
6112 /* Generate the string rep. */
6113 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6114 realLength = 0;
6115 for (i = 0; i < objc; i++) {
6116 int len, qlen;
6117 const char *strRep = Jim_GetString(objv[i], &len);
6118 char *q;
6120 switch (quotingType[i]) {
6121 case JIM_ELESTR_SIMPLE:
6122 memcpy(p, strRep, len);
6123 p += len;
6124 realLength += len;
6125 break;
6126 case JIM_ELESTR_BRACE:
6127 *p++ = '{';
6128 memcpy(p, strRep, len);
6129 p += len;
6130 *p++ = '}';
6131 realLength += len + 2;
6132 break;
6133 case JIM_ELESTR_QUOTE:
6134 q = BackslashQuoteString(strRep, len, &qlen);
6135 memcpy(p, q, qlen);
6136 Jim_Free(q);
6137 p += qlen;
6138 realLength += qlen;
6139 break;
6141 /* Add a separating space */
6142 if (i + 1 != objc) {
6143 *p++ = ' ';
6144 realLength++;
6147 *p = '\0'; /* nul term. */
6148 objPtr->length = realLength;
6149 Jim_Free(quotingType);
6150 Jim_Free(objv);
6153 #ifdef JIM_OPTIMIZATION
6154 static int SetDictFromList(Jim_Interp *interp, struct Jim_Obj *objPtr)
6156 Jim_HashTable *ht;
6157 int i;
6158 int listlen;
6160 listlen = Jim_ListLength(interp, objPtr);
6161 if (listlen % 2) {
6162 return JIM_ERR;
6165 /* Now we can't fail */
6166 ht = Jim_Alloc(sizeof(*ht));
6167 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6169 for (i = 0; i < listlen; i += 2) {
6170 Jim_Obj *keyObjPtr;
6171 Jim_Obj *valObjPtr;
6173 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
6174 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
6176 Jim_IncrRefCount(keyObjPtr);
6177 Jim_IncrRefCount(valObjPtr);
6179 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
6180 Jim_HashEntry *he;
6182 he = Jim_FindHashEntry(ht, keyObjPtr);
6183 Jim_DecrRefCount(interp, keyObjPtr);
6184 /* ATTENTION: const cast */
6185 Jim_DecrRefCount(interp, (Jim_Obj *)he->val);
6186 he->val = valObjPtr;
6190 Jim_FreeIntRep(interp, objPtr);
6191 objPtr->typePtr = &dictObjType;
6192 objPtr->internalRep.ptr = ht;
6194 return JIM_OK;
6196 #endif
6198 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6200 struct JimParserCtx parser;
6201 Jim_HashTable *ht;
6202 Jim_Obj *objv[2];
6203 const char *str;
6204 int i, strLen;
6206 /* Get the string representation. Do this first so we don't
6207 * change order in case of fast conversion to dict
6209 str = Jim_GetString(objPtr, &strLen);
6211 #ifdef JIM_OPTIMIZATION
6212 /* If the object is of type "list" with a string rep, we can use
6213 * a specialized version.
6215 if (Jim_IsList(objPtr)) {
6216 if (SetDictFromList(interp, objPtr) != JIM_OK) {
6217 goto badlist;
6219 return JIM_OK;
6221 #endif
6223 /* Free the old internal repr just now and initialize the
6224 * new one just now. The string->list conversion can't fail. */
6225 Jim_FreeIntRep(interp, objPtr);
6226 ht = Jim_Alloc(sizeof(*ht));
6227 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
6228 objPtr->typePtr = &dictObjType;
6229 objPtr->internalRep.ptr = ht;
6231 /* Convert into a dict */
6232 JimParserInit(&parser, str, strLen, 1);
6233 i = 0;
6234 while (!JimParserEof(&parser)) {
6235 char *token;
6236 int tokenLen, type;
6238 JimParseList(&parser);
6239 if (JimParserTtype(&parser) != JIM_TT_STR && JimParserTtype(&parser) != JIM_TT_ESC)
6240 continue;
6241 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
6242 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
6243 if (i == 2) {
6244 i = 0;
6245 Jim_IncrRefCount(objv[0]);
6246 Jim_IncrRefCount(objv[1]);
6247 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
6248 Jim_HashEntry *he;
6250 he = Jim_FindHashEntry(ht, objv[0]);
6251 Jim_DecrRefCount(interp, objv[0]);
6252 /* ATTENTION: const cast */
6253 Jim_DecrRefCount(interp, (Jim_Obj *)he->val);
6254 he->val = objv[1];
6258 if (i) {
6259 Jim_FreeNewObj(interp, objv[0]);
6260 objPtr->typePtr = NULL;
6261 Jim_FreeHashTable(ht);
6262 Jim_Free(ht);
6263 #ifdef JIM_OPTIMIZATION
6264 badlist:
6265 #endif
6266 Jim_SetResultString(interp,
6267 "invalid dictionary value: must be a list with an even number of elements", -1);
6268 return JIM_ERR;
6270 return JIM_OK;
6273 /* Dict object API */
6275 /* Add an element to a dict. objPtr must be of the "dict" type.
6276 * The higer-level exported function is Jim_DictAddElement().
6277 * If an element with the specified key already exists, the value
6278 * associated is replaced with the new one.
6280 * if valueObjPtr == NULL, the key is instead removed if it exists. */
6281 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6282 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6284 Jim_HashTable *ht = objPtr->internalRep.ptr;
6286 if (valueObjPtr == NULL) { /* unset */
6287 return Jim_DeleteHashEntry(ht, keyObjPtr);
6289 Jim_IncrRefCount(keyObjPtr);
6290 Jim_IncrRefCount(valueObjPtr);
6291 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
6292 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
6294 Jim_DecrRefCount(interp, keyObjPtr);
6295 /* ATTENTION: const cast */
6296 Jim_DecrRefCount(interp, (Jim_Obj *)he->val);
6297 he->val = valueObjPtr;
6299 return JIM_OK;
6302 /* Add an element, higher-level interface for DictAddElement().
6303 * If valueObjPtr == NULL, the key is removed if it exists. */
6304 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
6305 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
6307 int retcode;
6309 if (Jim_IsShared(objPtr))
6310 Jim_Panic(interp, "Jim_DictAddElement called with shared object");
6311 if (objPtr->typePtr != &dictObjType) {
6312 if (SetDictFromAny(interp, objPtr) != JIM_OK)
6313 return JIM_ERR;
6315 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
6316 Jim_InvalidateStringRep(objPtr);
6317 return retcode;
6320 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6322 Jim_Obj *objPtr;
6323 int i;
6325 if (len % 2)
6326 Jim_Panic(interp, "Jim_NewDicObj() 'len' argument must be even");
6328 objPtr = Jim_NewObj(interp);
6329 objPtr->typePtr = &dictObjType;
6330 objPtr->bytes = NULL;
6331 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
6332 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
6333 for (i = 0; i < len; i += 2)
6334 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
6335 return objPtr;
6338 /* Return the value associated to the specified dict key
6339 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
6341 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
6342 Jim_Obj **objPtrPtr, int flags)
6344 Jim_HashEntry *he;
6345 Jim_HashTable *ht;
6347 if (dictPtr->typePtr != &dictObjType) {
6348 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
6349 return -1;
6351 ht = dictPtr->internalRep.ptr;
6352 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
6353 if (flags & JIM_ERRMSG) {
6354 Jim_SetResultFormatted(interp, "key \"%#s\" not found in dictionary", keyPtr);
6356 return JIM_ERR;
6358 *objPtrPtr = he->val;
6359 return JIM_OK;
6362 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
6363 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
6365 Jim_HashTable *ht;
6366 Jim_HashTableIterator *htiter;
6367 Jim_HashEntry *he;
6368 Jim_Obj **objv;
6369 int i;
6371 if (dictPtr->typePtr != &dictObjType) {
6372 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
6373 return JIM_ERR;
6375 ht = dictPtr->internalRep.ptr;
6377 /* Turn the hash table into a flat vector of Jim_Objects. */
6378 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6379 htiter = Jim_GetHashTableIterator(ht);
6380 i = 0;
6381 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
6382 objv[i++] = (Jim_Obj *)he->key; /* ATTENTION: const cast */
6383 objv[i++] = he->val;
6385 *len = i;
6386 Jim_FreeHashTableIterator(htiter);
6387 *objPtrPtr = objv;
6388 return JIM_OK;
6392 /* Return the value associated to the specified dict keys */
6393 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
6394 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
6396 int i;
6398 if (keyc == 0) {
6399 *objPtrPtr = dictPtr;
6400 return JIM_OK;
6403 for (i = 0; i < keyc; i++) {
6404 Jim_Obj *objPtr;
6406 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
6407 != JIM_OK)
6408 return JIM_ERR;
6409 dictPtr = objPtr;
6411 *objPtrPtr = dictPtr;
6412 return JIM_OK;
6415 /* Modify the dict stored into the variable named 'varNamePtr'
6416 * setting the element specified by the 'keyc' keys objects in 'keyv',
6417 * with the new value of the element 'newObjPtr'.
6419 * If newObjPtr == NULL the operation is to remove the given key
6420 * from the dictionary. */
6421 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
6422 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
6424 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
6425 int shared, i;
6427 varObjPtr = objPtr =
6428 Jim_GetVariable(interp, varNamePtr, newObjPtr == NULL ? JIM_ERRMSG : JIM_NONE);
6429 if (objPtr == NULL) {
6430 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
6431 return JIM_ERR;
6432 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
6433 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
6434 Jim_FreeNewObj(interp, varObjPtr);
6435 return JIM_ERR;
6438 if ((shared = Jim_IsShared(objPtr)))
6439 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6440 for (i = 0; i < keyc - 1; i++) {
6441 dictObjPtr = objPtr;
6443 /* Check if it's a valid dictionary */
6444 if (dictObjPtr->typePtr != &dictObjType) {
6445 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
6446 goto err;
6448 /* Check if the given key exists. */
6449 Jim_InvalidateStringRep(dictObjPtr);
6450 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
6451 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
6452 /* This key exists at the current level.
6453 * Make sure it's not shared!. */
6454 if (Jim_IsShared(objPtr)) {
6455 objPtr = Jim_DuplicateObj(interp, objPtr);
6456 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6459 else {
6460 /* Key not found. If it's an [unset] operation
6461 * this is an error. Only the last key may not
6462 * exist. */
6463 if (newObjPtr == NULL)
6464 goto err;
6465 /* Otherwise set an empty dictionary
6466 * as key's value. */
6467 objPtr = Jim_NewDictObj(interp, NULL, 0);
6468 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
6471 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
6472 goto err;
6474 Jim_InvalidateStringRep(objPtr);
6475 Jim_InvalidateStringRep(varObjPtr);
6476 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6477 goto err;
6478 Jim_SetResult(interp, varObjPtr);
6479 return JIM_OK;
6480 err:
6481 if (shared) {
6482 Jim_FreeNewObj(interp, varObjPtr);
6484 return JIM_ERR;
6487 /* -----------------------------------------------------------------------------
6488 * Index object
6489 * ---------------------------------------------------------------------------*/
6490 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6491 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6493 static const Jim_ObjType indexObjType = {
6494 "index",
6495 NULL,
6496 NULL,
6497 UpdateStringOfIndex,
6498 JIM_TYPE_NONE,
6501 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6503 int len;
6504 char buf[JIM_INTEGER_SPACE + 1];
6506 if (objPtr->internalRep.indexValue >= 0)
6507 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6508 else if (objPtr->internalRep.indexValue == -1)
6509 len = sprintf(buf, "end");
6510 else {
6511 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue + 1);
6513 objPtr->bytes = Jim_Alloc(len + 1);
6514 memcpy(objPtr->bytes, buf, len + 1);
6515 objPtr->length = len;
6518 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6520 int index, end = 0;
6521 const char *str;
6522 char *endptr;
6524 /* Get the string representation */
6525 str = Jim_GetString(objPtr, NULL);
6527 /* Try to convert into an index */
6528 if (strncmp(str, "end", 3) == 0) {
6529 end = 1;
6530 str += 3;
6531 index = 0;
6533 else {
6534 index = strtol(str, &endptr, 10);
6536 if (endptr == str) {
6537 goto badindex;
6539 str = endptr;
6542 /* Now str may include or +<num> or -<num> */
6543 if (*str == '+' || *str == '-') {
6544 int sign = (*str == '+' ? 1 : -1);
6546 index += sign * strtol(++str, &endptr, 10);
6547 if (str == endptr || *endptr) {
6548 goto badindex;
6550 str = endptr;
6552 /* The only thing left should be spaces */
6553 while (isspace(*str)) {
6554 str++;
6556 if (*str) {
6557 goto badindex;
6559 if (end) {
6560 if (index > 0) {
6561 index = INT_MAX;
6563 else {
6564 /* end-1 is repesented as -2 */
6565 index--;
6568 else if (index < 0) {
6569 index = -INT_MAX;
6572 /* Free the old internal repr and set the new one. */
6573 Jim_FreeIntRep(interp, objPtr);
6574 objPtr->typePtr = &indexObjType;
6575 objPtr->internalRep.indexValue = index;
6576 return JIM_OK;
6578 badindex:
6579 Jim_SetResultFormatted(interp,
6580 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
6581 return JIM_ERR;
6584 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6586 /* Avoid shimmering if the object is an integer. */
6587 if (objPtr->typePtr == &intObjType) {
6588 jim_wide val = objPtr->internalRep.wideValue;
6590 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6591 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6592 return JIM_OK;
6595 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
6596 return JIM_ERR;
6597 *indexPtr = objPtr->internalRep.indexValue;
6598 return JIM_OK;
6601 /* -----------------------------------------------------------------------------
6602 * Return Code Object.
6603 * ---------------------------------------------------------------------------*/
6605 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
6606 static const char *jimReturnCodes[] = {
6607 [JIM_OK] = "ok",
6608 [JIM_ERR] = "error",
6609 [JIM_RETURN] = "return",
6610 [JIM_BREAK] = "break",
6611 [JIM_CONTINUE] = "continue",
6612 [JIM_SIGNAL] = "signal",
6613 [JIM_EXIT] = "exit",
6614 [JIM_EVAL] = "eval",
6615 NULL
6618 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
6620 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6622 static const Jim_ObjType returnCodeObjType = {
6623 "return-code",
6624 NULL,
6625 NULL,
6626 NULL,
6627 JIM_TYPE_NONE,
6630 /* Converts a (standard) return code to a string. Returns "?" for
6631 * non-standard return codes.
6633 const char *Jim_ReturnCode(int code)
6635 if (code < 0 || code >= (int)jimReturnCodesSize) {
6636 return "?";
6638 else {
6639 return jimReturnCodes[code];
6643 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6645 int returnCode;
6646 jim_wide wideValue;
6648 /* Try to convert into an integer */
6649 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6650 returnCode = (int)wideValue;
6651 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
6652 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
6653 return JIM_ERR;
6655 /* Free the old internal repr and set the new one. */
6656 Jim_FreeIntRep(interp, objPtr);
6657 objPtr->typePtr = &returnCodeObjType;
6658 objPtr->internalRep.returnCode = returnCode;
6659 return JIM_OK;
6662 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6664 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6665 return JIM_ERR;
6666 *intPtr = objPtr->internalRep.returnCode;
6667 return JIM_OK;
6670 /* -----------------------------------------------------------------------------
6671 * Expression Parsing
6672 * ---------------------------------------------------------------------------*/
6673 static int JimParseExprOperator(struct JimParserCtx *pc);
6674 static int JimParseExprNumber(struct JimParserCtx *pc);
6675 static int JimParseExprIrrational(struct JimParserCtx *pc);
6677 /* Exrp's Stack machine operators opcodes. */
6679 /* Binary operators (numbers) */
6680 enum
6682 /* Continues on from the JIM_TT_ space */
6683 /* Operations */
6684 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 15 */
6685 JIM_EXPROP_DIV,
6686 JIM_EXPROP_MOD,
6687 JIM_EXPROP_SUB,
6688 JIM_EXPROP_ADD,
6689 JIM_EXPROP_LSHIFT,
6690 JIM_EXPROP_RSHIFT,
6691 JIM_EXPROP_ROTL,
6692 JIM_EXPROP_ROTR,
6693 JIM_EXPROP_LT,
6694 JIM_EXPROP_GT,
6695 JIM_EXPROP_LTE,
6696 JIM_EXPROP_GTE,
6697 JIM_EXPROP_NUMEQ,
6698 JIM_EXPROP_NUMNE,
6699 JIM_EXPROP_BITAND, /* 30 */
6700 JIM_EXPROP_BITXOR,
6701 JIM_EXPROP_BITOR,
6703 /* Note must keep these together */
6704 JIM_EXPROP_LOGICAND, /* 33 */
6705 JIM_EXPROP_LOGICAND_LEFT,
6706 JIM_EXPROP_LOGICAND_RIGHT,
6708 /* and these */
6709 JIM_EXPROP_LOGICOR, /* 36 */
6710 JIM_EXPROP_LOGICOR_LEFT,
6711 JIM_EXPROP_LOGICOR_RIGHT,
6713 /* and these */
6714 /* Ternary operators */
6715 JIM_EXPROP_TERNARY, /* 39 */
6716 JIM_EXPROP_TERNARY_LEFT,
6717 JIM_EXPROP_TERNARY_RIGHT,
6719 /* and these */
6720 JIM_EXPROP_COLON, /* 42 */
6721 JIM_EXPROP_COLON_LEFT,
6722 JIM_EXPROP_COLON_RIGHT,
6724 JIM_EXPROP_POW, /* 45 */
6726 /* Binary operators (strings) */
6727 JIM_EXPROP_STREQ,
6728 JIM_EXPROP_STRNE,
6729 JIM_EXPROP_STRIN,
6730 JIM_EXPROP_STRNI,
6732 /* Unary operators (numbers) */
6733 JIM_EXPROP_NOT,
6734 JIM_EXPROP_BITNOT,
6735 JIM_EXPROP_UNARYMINUS,
6736 JIM_EXPROP_UNARYPLUS,
6738 /* Functions */
6739 JIM_EXPROP_FUNC_FIRST,
6740 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
6741 JIM_EXPROP_FUNC_ABS,
6742 JIM_EXPROP_FUNC_DOUBLE,
6743 JIM_EXPROP_FUNC_ROUND,
6745 #ifdef JIM_MATH_FUNCTIONS
6746 /* math functions from libm */
6747 JIM_EXPROP_FUNC_SIN,
6748 JIM_EXPROP_FUNC_COS,
6749 JIM_EXPROP_FUNC_TAN,
6750 JIM_EXPROP_FUNC_ASIN,
6751 JIM_EXPROP_FUNC_ACOS,
6752 JIM_EXPROP_FUNC_ATAN,
6753 JIM_EXPROP_FUNC_SINH,
6754 JIM_EXPROP_FUNC_COSH,
6755 JIM_EXPROP_FUNC_TANH,
6756 JIM_EXPROP_FUNC_CEIL,
6757 JIM_EXPROP_FUNC_FLOOR,
6758 JIM_EXPROP_FUNC_EXP,
6759 JIM_EXPROP_FUNC_LOG,
6760 JIM_EXPROP_FUNC_LOG10,
6761 JIM_EXPROP_FUNC_SQRT,
6762 #endif
6765 struct JimExprState
6767 Jim_Obj **stack;
6768 int stacklen;
6769 int opcode;
6770 int skip;
6773 /* Operators table */
6774 typedef struct Jim_ExprOperator
6776 const char *name;
6777 int precedence;
6778 int arity;
6779 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
6780 int lazy;
6781 } Jim_ExprOperator;
6783 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
6785 Jim_IncrRefCount(obj);
6786 e->stack[e->stacklen++] = obj;
6789 static Jim_Obj *ExprPop(struct JimExprState *e)
6791 return e->stack[--e->stacklen];
6794 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
6796 int intresult = 0;
6797 int rc = JIM_OK;
6798 Jim_Obj *A = ExprPop(e);
6799 double dA, dC = 0;
6800 jim_wide wA, wC = 0;
6802 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
6803 intresult = 1;
6805 switch (e->opcode) {
6806 case JIM_EXPROP_FUNC_INT:
6807 wC = wA;
6808 break;
6809 case JIM_EXPROP_FUNC_ROUND:
6810 wC = wA;
6811 break;
6812 case JIM_EXPROP_FUNC_DOUBLE:
6813 dC = wA;
6814 intresult = 0;
6815 break;
6816 case JIM_EXPROP_FUNC_ABS:
6817 wC = wA >= 0 ? wA : -wA;
6818 break;
6819 case JIM_EXPROP_UNARYMINUS:
6820 wC = -wA;
6821 break;
6822 case JIM_EXPROP_UNARYPLUS:
6823 wC = wA;
6824 break;
6825 case JIM_EXPROP_NOT:
6826 wC = !wA;
6827 break;
6828 default:
6829 abort();
6832 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
6833 switch (e->opcode) {
6834 case JIM_EXPROP_FUNC_INT:
6835 wC = dA;
6836 intresult = 1;
6837 break;
6838 case JIM_EXPROP_FUNC_ROUND:
6839 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
6840 intresult = 1;
6841 break;
6842 case JIM_EXPROP_FUNC_DOUBLE:
6843 dC = dA;
6844 break;
6845 case JIM_EXPROP_FUNC_ABS:
6846 dC = dA >= 0 ? dA : -dA;
6847 break;
6848 case JIM_EXPROP_UNARYMINUS:
6849 dC = -dA;
6850 break;
6851 case JIM_EXPROP_UNARYPLUS:
6852 dC = dA;
6853 break;
6854 case JIM_EXPROP_NOT:
6855 wC = !dA;
6856 intresult = 1;
6857 break;
6858 default:
6859 abort();
6863 if (rc == JIM_OK) {
6864 if (intresult) {
6865 ExprPush(e, Jim_NewIntObj(interp, wC));
6867 else {
6868 ExprPush(e, Jim_NewDoubleObj(interp, dC));
6872 Jim_DecrRefCount(interp, A);
6874 return rc;
6877 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
6879 Jim_Obj *A = ExprPop(e);
6880 jim_wide wA;
6881 int rc = JIM_ERR;
6884 if (Jim_GetWide(interp, A, &wA) == JIM_OK) {
6885 jim_wide wC;
6887 switch (e->opcode) {
6888 case JIM_EXPROP_BITNOT:
6889 wC = ~wA;
6890 break;
6891 default:
6892 abort();
6894 ExprPush(e, Jim_NewIntObj(interp, wC));
6895 rc = JIM_OK;
6898 Jim_DecrRefCount(interp, A);
6900 return rc;
6903 #ifdef JIM_MATH_FUNCTIONS
6904 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
6906 int rc;
6907 Jim_Obj *A = ExprPop(e);
6908 double dA, dC;
6910 rc = Jim_GetDouble(interp, A, &dA);
6911 if (rc == JIM_OK) {
6912 switch (e->opcode) {
6913 case JIM_EXPROP_FUNC_SIN:
6914 dC = sin(dA);
6915 break;
6916 case JIM_EXPROP_FUNC_COS:
6917 dC = cos(dA);
6918 break;
6919 case JIM_EXPROP_FUNC_TAN:
6920 dC = tan(dA);
6921 break;
6922 case JIM_EXPROP_FUNC_ASIN:
6923 dC = asin(dA);
6924 break;
6925 case JIM_EXPROP_FUNC_ACOS:
6926 dC = acos(dA);
6927 break;
6928 case JIM_EXPROP_FUNC_ATAN:
6929 dC = atan(dA);
6930 break;
6931 case JIM_EXPROP_FUNC_SINH:
6932 dC = sinh(dA);
6933 break;
6934 case JIM_EXPROP_FUNC_COSH:
6935 dC = cosh(dA);
6936 break;
6937 case JIM_EXPROP_FUNC_TANH:
6938 dC = tanh(dA);
6939 break;
6940 case JIM_EXPROP_FUNC_CEIL:
6941 dC = ceil(dA);
6942 break;
6943 case JIM_EXPROP_FUNC_FLOOR:
6944 dC = floor(dA);
6945 break;
6946 case JIM_EXPROP_FUNC_EXP:
6947 dC = exp(dA);
6948 break;
6949 case JIM_EXPROP_FUNC_LOG:
6950 dC = log(dA);
6951 break;
6952 case JIM_EXPROP_FUNC_LOG10:
6953 dC = log10(dA);
6954 break;
6955 case JIM_EXPROP_FUNC_SQRT:
6956 dC = sqrt(dA);
6957 break;
6958 default:
6959 abort();
6961 ExprPush(e, Jim_NewDoubleObj(interp, dC));
6964 Jim_DecrRefCount(interp, A);
6966 return rc;
6968 #endif
6970 /* A binary operation on two ints */
6971 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
6973 Jim_Obj *B = ExprPop(e);
6974 Jim_Obj *A = ExprPop(e);
6975 jim_wide wA, wB;
6976 int rc = JIM_ERR;
6978 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
6979 jim_wide wC;
6981 rc = JIM_OK;
6983 switch (e->opcode) {
6984 case JIM_EXPROP_LSHIFT:
6985 wC = wA << wB;
6986 break;
6987 case JIM_EXPROP_RSHIFT:
6988 wC = wA >> wB;
6989 break;
6990 case JIM_EXPROP_BITAND:
6991 wC = wA & wB;
6992 break;
6993 case JIM_EXPROP_BITXOR:
6994 wC = wA ^ wB;
6995 break;
6996 case JIM_EXPROP_BITOR:
6997 wC = wA | wB;
6998 break;
6999 case JIM_EXPROP_POW:
7000 wC = JimPowWide(wA, wB);
7001 break;
7002 case JIM_EXPROP_MOD:
7003 if (wB == 0) {
7004 wC = 0;
7005 Jim_SetResultString(interp, "Division by zero", -1);
7006 rc = JIM_ERR;
7008 else {
7010 * From Tcl 8.x
7012 * This code is tricky: C doesn't guarantee much
7013 * about the quotient or remainder, but Tcl does.
7014 * The remainder always has the same sign as the
7015 * divisor and a smaller absolute value.
7017 int negative = 0;
7019 if (wB < 0) {
7020 wB = -wB;
7021 wA = -wA;
7022 negative = 1;
7024 wC = wA % wB;
7025 if (wC < 0) {
7026 wC += wB;
7028 if (negative) {
7029 wC = -wC;
7032 break;
7033 case JIM_EXPROP_ROTL:{
7034 /* uint32_t would be better. But not everyone has inttypes.h? */
7035 unsigned long uA = (unsigned long)wA;
7036 const unsigned int S = sizeof(unsigned long) * 8;
7038 wC = (unsigned long)((uA << wB) | (uA >> (S - wB)));
7039 break;
7041 case JIM_EXPROP_ROTR:{
7042 unsigned long uA = (unsigned long)wA;
7043 const unsigned int S = sizeof(unsigned long) * 8;
7045 wC = (unsigned long)((uA >> wB) | (uA << (S - wB)));
7046 break;
7048 default:
7049 abort();
7051 ExprPush(e, Jim_NewIntObj(interp, wC));
7055 Jim_DecrRefCount(interp, A);
7056 Jim_DecrRefCount(interp, B);
7058 return rc;
7062 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7063 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7065 int intresult = 0;
7066 int rc = JIM_OK;
7067 double dA, dB, dC = 0;
7068 jim_wide wA, wB, wC = 0;
7070 Jim_Obj *B = ExprPop(e);
7071 Jim_Obj *A = ExprPop(e);
7073 if ((A->typePtr != &doubleObjType || A->bytes) &&
7074 (B->typePtr != &doubleObjType || B->bytes) &&
7075 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7077 /* Both are ints */
7079 intresult = 1;
7081 switch (e->opcode) {
7082 case JIM_EXPROP_POW:
7083 wC = JimPowWide(wA, wB);
7084 break;
7085 case JIM_EXPROP_ADD:
7086 wC = wA + wB;
7087 break;
7088 case JIM_EXPROP_SUB:
7089 wC = wA - wB;
7090 break;
7091 case JIM_EXPROP_MUL:
7092 wC = wA * wB;
7093 break;
7094 case JIM_EXPROP_DIV:
7095 if (wB == 0) {
7096 Jim_SetResultString(interp, "Division by zero", -1);
7097 rc = JIM_ERR;
7099 else {
7101 * From Tcl 8.x
7103 * This code is tricky: C doesn't guarantee much
7104 * about the quotient or remainder, but Tcl does.
7105 * The remainder always has the same sign as the
7106 * divisor and a smaller absolute value.
7108 if (wB < 0) {
7109 wB = -wB;
7110 wA = -wA;
7112 wC = wA / wB;
7113 if (wA % wB < 0) {
7114 wC--;
7117 break;
7118 case JIM_EXPROP_LT:
7119 wC = wA < wB;
7120 break;
7121 case JIM_EXPROP_GT:
7122 wC = wA > wB;
7123 break;
7124 case JIM_EXPROP_LTE:
7125 wC = wA <= wB;
7126 break;
7127 case JIM_EXPROP_GTE:
7128 wC = wA >= wB;
7129 break;
7130 case JIM_EXPROP_NUMEQ:
7131 wC = wA == wB;
7132 break;
7133 case JIM_EXPROP_NUMNE:
7134 wC = wA != wB;
7135 break;
7136 default:
7137 abort();
7140 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7141 switch (e->opcode) {
7142 case JIM_EXPROP_POW:
7143 #ifdef JIM_MATH_FUNCTIONS
7144 dC = pow(dA, dB);
7145 #else
7146 rc = JIM_ERR;
7147 #endif
7148 break;
7149 case JIM_EXPROP_ADD:
7150 dC = dA + dB;
7151 break;
7152 case JIM_EXPROP_SUB:
7153 dC = dA - dB;
7154 break;
7155 case JIM_EXPROP_MUL:
7156 dC = dA * dB;
7157 break;
7158 case JIM_EXPROP_DIV:
7159 if (dB == 0) {
7160 #ifdef INFINITY
7161 dC = dA < 0 ? -INFINITY : INFINITY;
7162 #else
7163 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7164 #endif
7166 else {
7167 dC = dA / dB;
7169 break;
7170 case JIM_EXPROP_LT:
7171 wC = dA < dB;
7172 intresult = 1;
7173 break;
7174 case JIM_EXPROP_GT:
7175 wC = dA > dB;
7176 intresult = 1;
7177 break;
7178 case JIM_EXPROP_LTE:
7179 wC = dA <= dB;
7180 intresult = 1;
7181 break;
7182 case JIM_EXPROP_GTE:
7183 wC = dA >= dB;
7184 intresult = 1;
7185 break;
7186 case JIM_EXPROP_NUMEQ:
7187 wC = dA == dB;
7188 intresult = 1;
7189 break;
7190 case JIM_EXPROP_NUMNE:
7191 wC = dA != dB;
7192 intresult = 1;
7193 break;
7194 default:
7195 abort();
7198 else {
7199 /* Handle the string case */
7200 int Alen, Blen;
7202 const char *sA = Jim_GetString(A, &Alen);
7203 const char *sB = Jim_GetString(B, &Blen);
7205 intresult = 1;
7207 switch (e->opcode) {
7208 case JIM_EXPROP_LT:
7209 wC = JimStringCompare(sA, Alen, sB, Blen, 0) < 0;
7210 break;
7211 case JIM_EXPROP_GT:
7212 wC = JimStringCompare(sA, Alen, sB, Blen, 0) > 0;
7213 break;
7214 case JIM_EXPROP_LTE:
7215 wC = JimStringCompare(sA, Alen, sB, Blen, 0) <= 0;
7216 break;
7217 case JIM_EXPROP_GTE:
7218 wC = JimStringCompare(sA, Alen, sB, Blen, 0) >= 0;
7219 break;
7220 case JIM_EXPROP_NUMEQ:
7221 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7222 break;
7223 case JIM_EXPROP_NUMNE:
7224 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7225 break;
7226 default:
7227 rc = JIM_ERR;
7228 break;
7232 if (rc == JIM_OK) {
7233 if (intresult) {
7234 ExprPush(e, Jim_NewIntObj(interp, wC));
7236 else {
7237 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7241 Jim_DecrRefCount(interp, A);
7242 Jim_DecrRefCount(interp, B);
7244 return rc;
7247 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
7249 int listlen;
7250 int i;
7252 listlen = Jim_ListLength(interp, listObjPtr);
7253 for (i = 0; i < listlen; i++) {
7254 Jim_Obj *objPtr;
7256 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
7258 if (Jim_StringEqObj(objPtr, valObj, 0)) {
7259 return 1;
7262 return 0;
7265 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
7267 Jim_Obj *B = ExprPop(e);
7268 Jim_Obj *A = ExprPop(e);
7270 int Alen, Blen;
7271 jim_wide wC;
7273 /* XXX: Not needed for IN, NI */
7274 const char *sA = Jim_GetString(A, &Alen);
7275 const char *sB = Jim_GetString(B, &Blen);
7277 switch (e->opcode) {
7278 case JIM_EXPROP_STREQ:
7279 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
7280 break;
7281 case JIM_EXPROP_STRNE:
7282 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
7283 break;
7284 case JIM_EXPROP_STRIN:
7285 wC = JimSearchList(interp, B, A);
7286 break;
7287 case JIM_EXPROP_STRNI:
7288 wC = !JimSearchList(interp, B, A);
7289 break;
7290 default:
7291 abort();
7293 ExprPush(e, Jim_NewIntObj(interp, wC));
7295 Jim_DecrRefCount(interp, A);
7296 Jim_DecrRefCount(interp, B);
7298 return JIM_OK;
7301 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
7303 long l;
7304 double d;
7306 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
7307 return l != 0;
7309 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
7310 return d != 0;
7312 return -1;
7315 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
7317 Jim_Obj *skip = ExprPop(e);
7318 Jim_Obj *A = ExprPop(e);
7319 int rc = JIM_OK;
7321 switch (ExprBool(interp, A)) {
7322 case 0:
7323 /* false, so skip RHS opcodes with a 0 result */
7324 e->skip = skip->internalRep.wideValue;
7325 ExprPush(e, Jim_NewIntObj(interp, 0));
7326 break;
7328 case 1:
7329 /* true so continue */
7330 break;
7332 case -1:
7333 /* Invalid */
7334 rc = JIM_ERR;
7336 Jim_DecrRefCount(interp, A);
7337 Jim_DecrRefCount(interp, skip);
7339 return rc;
7342 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
7344 Jim_Obj *skip = ExprPop(e);
7345 Jim_Obj *A = ExprPop(e);
7346 int rc = JIM_OK;
7348 switch (ExprBool(interp, A)) {
7349 case 0:
7350 /* false, so do nothing */
7351 break;
7353 case 1:
7354 /* true so skip RHS opcodes with a 1 result */
7355 e->skip = skip->internalRep.wideValue;
7356 ExprPush(e, Jim_NewIntObj(interp, 1));
7357 break;
7359 case -1:
7360 /* Invalid */
7361 rc = JIM_ERR;
7362 break;
7364 Jim_DecrRefCount(interp, A);
7365 Jim_DecrRefCount(interp, skip);
7367 return rc;
7370 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
7372 Jim_Obj *A = ExprPop(e);
7373 int rc = JIM_OK;
7375 switch (ExprBool(interp, A)) {
7376 case 0:
7377 ExprPush(e, Jim_NewIntObj(interp, 0));
7378 break;
7380 case 1:
7381 ExprPush(e, Jim_NewIntObj(interp, 1));
7382 break;
7384 case -1:
7385 /* Invalid */
7386 rc = JIM_ERR;
7387 break;
7389 Jim_DecrRefCount(interp, A);
7391 return rc;
7394 static int JimExprOpColon(Jim_Interp *interp, struct JimExprState *e)
7396 int rc = JIM_OK;
7398 #if 0
7399 Jim_Obj *C = ExprPop(e);
7400 Jim_Obj *B = ExprPop(e);
7401 Jim_Obj *A = ExprPop(e);
7403 switch (ExprBool(interp, A)) {
7404 case 0:
7405 ExprPush(e, C);
7406 break;
7408 case 1:
7409 ExprPush(e, B);
7410 break;
7412 case -1:
7413 /* Invalid */
7414 rc = JIM_ERR;
7415 break;
7417 Jim_DecrRefCount(interp, A);
7418 Jim_DecrRefCount(interp, B);
7419 Jim_DecrRefCount(interp, C);
7421 #endif
7422 return rc;
7426 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
7428 Jim_Obj *skip = ExprPop(e);
7429 Jim_Obj *A = ExprPop(e);
7430 int rc = JIM_OK;
7432 /* Repush A */
7433 ExprPush(e, A);
7435 switch (ExprBool(interp, A)) {
7436 case 0:
7437 /* false, skip RHS opcodes */
7438 e->skip = skip->internalRep.wideValue;
7439 /* Push a dummy value */
7440 ExprPush(e, Jim_NewIntObj(interp, 0));
7441 break;
7443 case 1:
7444 /* true so do nothing */
7445 break;
7447 case -1:
7448 /* Invalid */
7449 rc = JIM_ERR;
7450 break;
7452 Jim_DecrRefCount(interp, A);
7453 Jim_DecrRefCount(interp, skip);
7455 return rc;
7458 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
7460 Jim_Obj *skip = ExprPop(e);
7461 Jim_Obj *B = ExprPop(e);
7462 Jim_Obj *A = ExprPop(e);
7464 /* No need to check for A as non-boolean */
7465 if (ExprBool(interp, A)) {
7466 /* true, so skip RHS opcodes */
7467 e->skip = skip->internalRep.wideValue;
7468 /* Repush B as the answer */
7469 ExprPush(e, B);
7472 Jim_DecrRefCount(interp, skip);
7473 Jim_DecrRefCount(interp, A);
7474 Jim_DecrRefCount(interp, B);
7475 return JIM_OK;
7478 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
7480 return JIM_OK;
7483 enum
7485 LAZY_NONE,
7486 LAZY_OP,
7487 LAZY_LEFT,
7488 LAZY_RIGHT
7491 /* name - precedence - arity - opcode */
7492 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
7493 [JIM_EXPROP_FUNC_INT] = {"int", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7494 [JIM_EXPROP_FUNC_DOUBLE] = {"double", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7495 [JIM_EXPROP_FUNC_ABS] = {"abs", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7496 [JIM_EXPROP_FUNC_ROUND] = {"round", 400, 1, JimExprOpNumUnary, LAZY_NONE},
7498 #ifdef JIM_MATH_FUNCTIONS
7499 [JIM_EXPROP_FUNC_SIN] = {"sin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7500 [JIM_EXPROP_FUNC_COS] = {"cos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7501 [JIM_EXPROP_FUNC_TAN] = {"tan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7502 [JIM_EXPROP_FUNC_ASIN] = {"asin", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7503 [JIM_EXPROP_FUNC_ACOS] = {"acos", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7504 [JIM_EXPROP_FUNC_ATAN] = {"atan", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7505 [JIM_EXPROP_FUNC_SINH] = {"sinh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7506 [JIM_EXPROP_FUNC_COSH] = {"cosh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7507 [JIM_EXPROP_FUNC_TANH] = {"tanh", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7508 [JIM_EXPROP_FUNC_CEIL] = {"ceil", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7509 [JIM_EXPROP_FUNC_FLOOR] = {"floor", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7510 [JIM_EXPROP_FUNC_EXP] = {"exp", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7511 [JIM_EXPROP_FUNC_LOG] = {"log", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7512 [JIM_EXPROP_FUNC_LOG10] = {"log10", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7513 [JIM_EXPROP_FUNC_SQRT] = {"sqrt", 400, 1, JimExprOpDoubleUnary, LAZY_NONE},
7514 #endif
7516 [JIM_EXPROP_NOT] = {"!", 300, 1, JimExprOpNumUnary, LAZY_NONE},
7517 [JIM_EXPROP_BITNOT] = {"~", 300, 1, JimExprOpIntUnary, LAZY_NONE},
7518 [JIM_EXPROP_UNARYMINUS] = {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7519 [JIM_EXPROP_UNARYPLUS] = {NULL, 300, 1, JimExprOpNumUnary, LAZY_NONE},
7521 [JIM_EXPROP_POW] = {"**", 250, 2, JimExprOpBin, LAZY_NONE},
7523 [JIM_EXPROP_MUL] = {"*", 200, 2, JimExprOpBin, LAZY_NONE},
7524 [JIM_EXPROP_DIV] = {"/", 200, 2, JimExprOpBin, LAZY_NONE},
7525 [JIM_EXPROP_MOD] = {"%", 200, 2, JimExprOpIntBin, LAZY_NONE},
7527 [JIM_EXPROP_SUB] = {"-", 100, 2, JimExprOpBin, LAZY_NONE},
7528 [JIM_EXPROP_ADD] = {"+", 100, 2, JimExprOpBin, LAZY_NONE},
7530 [JIM_EXPROP_ROTL] = {"<<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7531 [JIM_EXPROP_ROTR] = {">>>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7532 [JIM_EXPROP_LSHIFT] = {"<<", 90, 2, JimExprOpIntBin, LAZY_NONE},
7533 [JIM_EXPROP_RSHIFT] = {">>", 90, 2, JimExprOpIntBin, LAZY_NONE},
7535 [JIM_EXPROP_LT] = {"<", 80, 2, JimExprOpBin, LAZY_NONE},
7536 [JIM_EXPROP_GT] = {">", 80, 2, JimExprOpBin, LAZY_NONE},
7537 [JIM_EXPROP_LTE] = {"<=", 80, 2, JimExprOpBin, LAZY_NONE},
7538 [JIM_EXPROP_GTE] = {">=", 80, 2, JimExprOpBin, LAZY_NONE},
7540 [JIM_EXPROP_NUMEQ] = {"==", 70, 2, JimExprOpBin, LAZY_NONE},
7541 [JIM_EXPROP_NUMNE] = {"!=", 70, 2, JimExprOpBin, LAZY_NONE},
7543 [JIM_EXPROP_STREQ] = {"eq", 60, 2, JimExprOpStrBin, LAZY_NONE},
7544 [JIM_EXPROP_STRNE] = {"ne", 60, 2, JimExprOpStrBin, LAZY_NONE},
7546 [JIM_EXPROP_STRIN] = {"in", 55, 2, JimExprOpStrBin, LAZY_NONE},
7547 [JIM_EXPROP_STRNI] = {"ni", 55, 2, JimExprOpStrBin, LAZY_NONE},
7549 [JIM_EXPROP_BITAND] = {"&", 50, 2, JimExprOpIntBin, LAZY_NONE},
7550 [JIM_EXPROP_BITXOR] = {"^", 49, 2, JimExprOpIntBin, LAZY_NONE},
7551 [JIM_EXPROP_BITOR] = {"|", 48, 2, JimExprOpIntBin, LAZY_NONE},
7553 [JIM_EXPROP_LOGICAND] = {"&&", 10, 2, NULL, LAZY_OP},
7554 [JIM_EXPROP_LOGICOR] = {"||", 9, 2, NULL, LAZY_OP},
7556 [JIM_EXPROP_TERNARY] = {"?", 5, 2, JimExprOpNull, LAZY_OP},
7557 [JIM_EXPROP_COLON] = {":", 5, 2, JimExprOpColon, LAZY_OP},
7559 /* private operators */
7560 [JIM_EXPROP_TERNARY_LEFT] = {NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT},
7561 [JIM_EXPROP_TERNARY_RIGHT] = {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7562 [JIM_EXPROP_COLON_LEFT] = {NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT},
7563 [JIM_EXPROP_COLON_RIGHT] = {NULL, 5, 2, JimExprOpNull, LAZY_RIGHT},
7564 [JIM_EXPROP_LOGICAND_LEFT] = {NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT},
7565 [JIM_EXPROP_LOGICAND_RIGHT] = {NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7566 [JIM_EXPROP_LOGICOR_LEFT] = {NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT},
7567 [JIM_EXPROP_LOGICOR_RIGHT] = {NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT},
7570 #define JIM_EXPR_OPERATORS_NUM \
7571 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
7573 int JimParseExpression(struct JimParserCtx *pc)
7575 /* Discard spaces and quoted newline */
7576 while (isspace(*pc->p) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
7577 pc->p++;
7578 pc->len--;
7581 if (pc->len == 0) {
7582 pc->tstart = pc->tend = pc->p;
7583 pc->tline = pc->linenr;
7584 pc->tt = JIM_TT_EOL;
7585 pc->eof = 1;
7586 return JIM_OK;
7588 switch (*(pc->p)) {
7589 case '(':
7590 pc->tstart = pc->tend = pc->p;
7591 pc->tline = pc->linenr;
7592 pc->tt = JIM_TT_SUBEXPR_START;
7593 pc->p++;
7594 pc->len--;
7595 break;
7596 case ')':
7597 pc->tstart = pc->tend = pc->p;
7598 pc->tline = pc->linenr;
7599 pc->tt = JIM_TT_SUBEXPR_END;
7600 pc->p++;
7601 pc->len--;
7602 break;
7603 case '[':
7604 return JimParseCmd(pc);
7605 break;
7606 case '$':
7607 if (JimParseVar(pc) == JIM_ERR)
7608 return JimParseExprOperator(pc);
7609 else
7610 return JIM_OK;
7611 break;
7612 case '0':
7613 case '1':
7614 case '2':
7615 case '3':
7616 case '4':
7617 case '5':
7618 case '6':
7619 case '7':
7620 case '8':
7621 case '9':
7622 case '.':
7623 return JimParseExprNumber(pc);
7624 break;
7625 case '"':
7626 case '{':
7627 /* Here it's possible to reuse the List String parsing. */
7628 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
7629 return JimParseListStr(pc);
7630 break;
7631 case 'N':
7632 case 'I':
7633 case 'n':
7634 case 'i':
7635 if (JimParseExprIrrational(pc) == JIM_ERR)
7636 return JimParseExprOperator(pc);
7637 break;
7638 default:
7639 return JimParseExprOperator(pc);
7640 break;
7642 return JIM_OK;
7645 int JimParseExprNumber(struct JimParserCtx *pc)
7647 int allowdot = 1;
7648 int allowhex = 0;
7650 /* Assume an integer for now */
7651 pc->tt = JIM_TT_EXPR_INT;
7652 pc->tstart = pc->p;
7653 pc->tline = pc->linenr;
7654 while (isdigit(*pc->p)
7655 || (allowhex && isxdigit(*pc->p))
7656 || (allowdot && *pc->p == '.')
7657 || (pc->p - pc->tstart == 1 && *pc->tstart == '0' && (*pc->p == 'x' || *pc->p == 'X'))
7659 if ((*pc->p == 'x') || (*pc->p == 'X')) {
7660 allowhex = 1;
7661 allowdot = 0;
7663 if (*pc->p == '.') {
7664 allowdot = 0;
7665 pc->tt = JIM_TT_EXPR_DOUBLE;
7667 pc->p++;
7668 pc->len--;
7669 if (!allowhex && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
7670 || isdigit(pc->p[1]))) {
7671 pc->p += 2;
7672 pc->len -= 2;
7673 pc->tt = JIM_TT_EXPR_DOUBLE;
7676 pc->tend = pc->p - 1;
7677 return JIM_OK;
7680 int JimParseExprIrrational(struct JimParserCtx *pc)
7682 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
7683 const char **token;
7685 for (token = Tokens; *token != NULL; token++) {
7686 int len = strlen(*token);
7688 if (strncmp(*token, pc->p, len) == 0) {
7689 pc->tstart = pc->p;
7690 pc->tend = pc->p + len - 1;
7691 pc->p += len;
7692 pc->len -= len;
7693 pc->tline = pc->linenr;
7694 pc->tt = JIM_TT_EXPR_DOUBLE;
7695 return JIM_OK;
7698 return JIM_ERR;
7701 int JimParseExprOperator(struct JimParserCtx *pc)
7703 int i;
7704 int bestIdx = -1, bestLen = 0;
7706 /* Try to get the longest match. */
7707 for (i = JIM_TT_EXPR_OP; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
7708 const char *opname;
7709 int oplen;
7711 opname = Jim_ExprOperators[i].name;
7712 if (opname == NULL) {
7713 continue;
7715 oplen = strlen(opname);
7717 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
7718 bestIdx = i;
7719 bestLen = oplen;
7722 if (bestIdx == -1) {
7723 return JIM_ERR;
7726 /* Validate paretheses around function arguments */
7727 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
7728 const char *p = pc->p + bestLen;
7729 int len = pc->len - bestLen;
7731 while (len && isspace(*p)) {
7732 len--;
7733 p++;
7735 if (*p != '(') {
7736 return JIM_ERR;
7739 pc->tstart = pc->p;
7740 pc->tend = pc->p + bestLen - 1;
7741 pc->p += bestLen;
7742 pc->len -= bestLen;
7743 pc->tline = pc->linenr;
7745 pc->tt = bestIdx;
7746 return JIM_OK;
7749 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
7751 return &Jim_ExprOperators[opcode];
7754 /* debugging */
7755 const char *tt_name(int type)
7757 static const char *tt_names[] =
7758 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "???", "(((", ")))", "INT",
7759 "DBL", "???" };
7760 if (type < JIM_TT_EXPR_OP) {
7761 return tt_names[type];
7763 else {
7764 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
7765 static char buf[20];
7767 if (op && op->name) {
7768 return op->name;
7770 sprintf(buf, "(%d)", type);
7771 return buf;
7777 /* -----------------------------------------------------------------------------
7778 * Expression Object
7779 * ---------------------------------------------------------------------------*/
7780 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7781 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7782 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7784 static Jim_ObjType exprObjType = {
7785 "expression",
7786 FreeExprInternalRep,
7787 DupExprInternalRep,
7788 NULL,
7789 JIM_TYPE_REFERENCES,
7792 /* Expr bytecode structure */
7793 typedef struct ExprByteCode
7795 int len; /* Length as number of tokens. */
7796 ScriptToken *token; /* Tokens array. */
7797 int inUse; /* Used for sharing. */
7798 } ExprByteCode;
7800 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
7802 int i;
7804 for (i = 0; i < expr->len; i++) {
7805 Jim_DecrRefCount(interp, expr->token[i].objPtr);
7807 Jim_Free(expr->token);
7808 Jim_Free(expr);
7811 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7813 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
7815 if (expr) {
7816 if (--expr->inUse != 0) {
7817 return;
7820 ExprFreeByteCode(interp, expr);
7824 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7826 JIM_NOTUSED(interp);
7827 JIM_NOTUSED(srcPtr);
7829 /* Just returns an simple string. */
7830 dupPtr->typePtr = NULL;
7833 /* Check if an expr program looks correct. */
7834 static int ExprCheckCorrectness(ExprByteCode * expr)
7836 int i;
7837 int stacklen = 0;
7838 int ternary = 0;
7840 /* Try to check if there are stack underflows,
7841 * and make sure at the end of the program there is
7842 * a single result on the stack. */
7843 for (i = 0; i < expr->len; i++) {
7844 ScriptToken *t = &expr->token[i];
7845 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
7847 if (op) {
7848 stacklen -= op->arity;
7849 if (stacklen < 0) {
7850 break;
7852 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
7853 ternary++;
7855 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
7856 ternary--;
7860 /* All operations and operands add one to the stack */
7861 stacklen++;
7863 if (stacklen != 1 || ternary != 0) {
7864 return JIM_ERR;
7866 return JIM_OK;
7869 /* This procedure converts every occurrence of || and && opereators
7870 * in lazy unary versions.
7872 * a b || is converted into:
7874 * a <offset> |L b |R
7876 * a b && is converted into:
7878 * a <offset> &L b &R
7880 * "|L" checks if 'a' is true:
7881 * 1) if it is true pushes 1 and skips <offset> instructions to reach
7882 * the opcode just after |R.
7883 * 2) if it is false does nothing.
7884 * "|R" checks if 'b' is true:
7885 * 1) if it is true pushes 1, otherwise pushes 0.
7887 * "&L" checks if 'a' is true:
7888 * 1) if it is true does nothing.
7889 * 2) If it is false pushes 0 and skips <offset> instructions to reach
7890 * the opcode just after &R
7891 * "&R" checks if 'a' is true:
7892 * if it is true pushes 1, otherwise pushes 0.
7894 static void ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
7896 int i;
7898 int leftindex, arity, offset;
7900 /* Search for the end of the first operator */
7901 leftindex = expr->len - 1;
7902 arity = 1;
7903 while (arity) {
7904 ScriptToken *tt = &expr->token[leftindex];
7906 if (tt->type >= JIM_TT_EXPR_OP) {
7907 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
7909 arity--;
7910 leftindex--;
7912 leftindex++;
7914 /* Move them up */
7915 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
7916 sizeof(*expr->token) * (expr->len - leftindex));
7917 expr->len += 2;
7918 offset = (expr->len - leftindex) - 1;
7920 /* Now we rely on the fact the the left and right version have opcodes
7921 * 1 and 2 after the main opcode respectively
7923 expr->token[leftindex + 1].type = t->type + 1;
7924 expr->token[leftindex + 1].objPtr = interp->emptyObj;
7926 expr->token[leftindex].type = JIM_TT_EXPR_INT;
7927 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
7929 /* Now add the 'R' operator */
7930 expr->token[expr->len].objPtr = interp->emptyObj;
7931 expr->token[expr->len].type = t->type + 2;
7932 expr->len++;
7934 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
7935 for (i = leftindex - 1; i > 0; i--) {
7936 if (JimExprOperatorInfoByOpcode(expr->token[i].type)->lazy == LAZY_LEFT) {
7937 if (expr->token[i - 1].objPtr->internalRep.wideValue + i - 1 >= leftindex) {
7938 expr->token[i - 1].objPtr->internalRep.wideValue += 2;
7944 static void ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
7946 struct ScriptToken *token = &expr->token[expr->len];
7948 if (JimExprOperatorInfoByOpcode(t->type)->lazy == LAZY_OP) {
7949 ExprAddLazyOperator(interp, expr, t);
7951 else {
7952 token->objPtr = interp->emptyObj;
7953 token->type = t->type;
7954 expr->len++;
7958 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist)
7960 Jim_Stack stack;
7961 ExprByteCode *expr;
7962 int ok = 1;
7963 int i;
7964 int prevtt = JIM_TT_NONE;
7966 /* -1 for EOL */
7967 int count = tokenlist->count - 1;
7969 expr = Jim_Alloc(sizeof(*expr));
7970 expr->inUse = 1;
7971 expr->len = 0;
7973 Jim_InitStack(&stack);
7975 /* Need extra bytecodes for lazy operators */
7976 for (i = 0; i < tokenlist->count; i++) {
7977 ParseToken *t = &tokenlist->list[i];
7979 if (JimExprOperatorInfoByOpcode(t->type)->lazy == LAZY_OP) {
7980 count += 2;
7984 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
7986 for (i = 0; i < tokenlist->count && ok; i++) {
7987 ParseToken *t = &tokenlist->list[i];
7989 /* Next token will be stored here */
7990 struct ScriptToken *token = &expr->token[expr->len];
7992 if (t->type == JIM_TT_EOL) {
7993 break;
7996 switch (t->type) {
7997 case JIM_TT_STR:
7998 case JIM_TT_ESC:
7999 case JIM_TT_VAR:
8000 case JIM_TT_DICTSUGAR:
8001 case JIM_TT_CMD:
8002 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8003 token->type = t->type;
8004 expr->len++;
8005 break;
8007 case JIM_TT_EXPR_INT:
8008 token->objPtr = Jim_NewIntObj(interp, strtoull(t->token, NULL, 0));
8009 token->type = t->type;
8010 expr->len++;
8011 break;
8013 case JIM_TT_EXPR_DOUBLE:
8014 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, NULL));
8015 token->type = t->type;
8016 expr->len++;
8017 break;
8019 case JIM_TT_SUBEXPR_START:
8020 Jim_StackPush(&stack, t);
8021 prevtt = JIM_TT_NONE;
8022 continue;
8024 case JIM_TT_SUBEXPR_END:
8025 ok = 0;
8026 while (Jim_StackLen(&stack)) {
8027 ParseToken *tt = Jim_StackPop(&stack);
8029 if (tt->type == JIM_TT_SUBEXPR_START) {
8030 ok = 1;
8031 break;
8034 ExprAddOperator(interp, expr, tt);
8036 if (!ok) {
8037 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8038 goto err;
8040 break;
8043 default:{
8044 /* Must be an operator */
8045 const struct Jim_ExprOperator *op;
8046 ParseToken *tt;
8048 /* Convert -/+ to unary minus or unary plus if necessary */
8049 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
8050 if (t->type == JIM_EXPROP_SUB) {
8051 t->type = JIM_EXPROP_UNARYMINUS;
8053 else if (t->type == JIM_EXPROP_ADD) {
8054 t->type = JIM_EXPROP_UNARYPLUS;
8058 op = JimExprOperatorInfoByOpcode(t->type);
8060 /* Now handle precedence */
8061 while ((tt = Jim_StackPeek(&stack)) != NULL) {
8062 const struct Jim_ExprOperator *tt_op =
8063 JimExprOperatorInfoByOpcode(tt->type);
8065 /* XXX: Should handle right-to-left associativity of ?: operator */
8067 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
8068 ExprAddOperator(interp, expr, tt);
8069 Jim_StackPop(&stack);
8071 else {
8072 break;
8075 Jim_StackPush(&stack, t);
8076 break;
8079 prevtt = t->type;
8082 /* Reduce any remaining subexpr */
8083 while (Jim_StackLen(&stack)) {
8084 ParseToken *tt = Jim_StackPop(&stack);
8086 if (tt->type == JIM_TT_SUBEXPR_START) {
8087 ok = 0;
8088 Jim_SetResultString(interp, "Missing close parenthesis", -1);
8089 goto err;
8091 ExprAddOperator(interp, expr, tt);
8094 err:
8095 /* Free the stack used for the compilation. */
8096 Jim_FreeStack(&stack);
8098 for (i = 0; i < expr->len; i++) {
8099 Jim_IncrRefCount(expr->token[i].objPtr);
8102 if (!ok) {
8103 ExprFreeByteCode(interp, expr);
8104 return NULL;
8107 return expr;
8111 /* This method takes the string representation of an expression
8112 * and generates a program for the Expr's stack-based VM. */
8113 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
8115 int exprTextLen;
8116 const char *exprText;
8117 struct JimParserCtx parser;
8118 struct ExprByteCode *expr;
8119 ParseTokenList tokenlist;
8120 int rc = JIM_ERR;
8122 exprText = Jim_GetString(objPtr, &exprTextLen);
8124 /* Initially tokenise the expression into tokenlist */
8125 ScriptTokenListInit(&tokenlist);
8127 JimParserInit(&parser, exprText, exprTextLen, 0);
8128 while (!JimParserEof(&parser)) {
8129 if (JimParseExpression(&parser) != JIM_OK) {
8130 ScriptTokenListFree(&tokenlist);
8131 invalidexpr:
8132 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
8133 expr = NULL;
8134 goto err;
8137 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
8138 parser.tline);
8141 /* Now create the expression bytecode from the tokenlist */
8142 expr = ExprCreateByteCode(interp, &tokenlist);
8144 /* No longer need the token list */
8145 ScriptTokenListFree(&tokenlist);
8147 if (!expr) {
8148 goto err;
8151 #if 0
8152 int i;
8154 printf("==== Expr ====\n");
8155 for (i = 0; i < expr->len; i++) {
8156 ScriptToken *t = &expr->token[i];
8158 printf("[%2d] %s '%s'\n", i, tt_name(t->type), Jim_GetString(t->objPtr, NULL));
8160 #endif
8162 /* Check program correctness. */
8163 if (ExprCheckCorrectness(expr) != JIM_OK) {
8164 ExprFreeByteCode(interp, expr);
8165 goto invalidexpr;
8168 rc = JIM_OK;
8170 #if 0
8171 printf("==== Expr ====\n");
8172 for (i = 0; i < expr->len; i++) {
8173 ScriptToken *t = &expr->token[i];
8175 printf("[%2d] %s '%s'\n", i, tt_name(t->type), Jim_GetString(t->objPtr, NULL));
8177 #endif
8179 err:
8180 /* Free the old internal rep and set the new one. */
8181 Jim_FreeIntRep(interp, objPtr);
8182 Jim_SetIntRepPtr(objPtr, expr);
8183 objPtr->typePtr = &exprObjType;
8184 return rc;
8187 static ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
8189 if (objPtr->typePtr != &exprObjType) {
8190 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
8191 return NULL;
8194 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
8197 /* -----------------------------------------------------------------------------
8198 * Expressions evaluation.
8199 * Jim uses a specialized stack-based virtual machine for expressions,
8200 * that takes advantage of the fact that expr's operators
8201 * can't be redefined.
8203 * Jim_EvalExpression() uses the bytecode compiled by
8204 * SetExprFromAny() method of the "expression" object.
8206 * On success a Tcl Object containing the result of the evaluation
8207 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
8208 * returned.
8209 * On error the function returns a retcode != to JIM_OK and set a suitable
8210 * error on the interp.
8211 * ---------------------------------------------------------------------------*/
8212 #define JIM_EE_STATICSTACK_LEN 10
8214 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
8216 ExprByteCode *expr;
8217 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
8218 int i;
8219 int retcode = JIM_OK;
8220 struct JimExprState e;
8222 expr = Jim_GetExpression(interp, exprObjPtr);
8223 if (!expr) {
8224 return JIM_ERR; /* error in expression. */
8227 #ifdef JIM_OPTIMIZATION
8228 /* Check for one of the following common expressions used by while/for
8230 * CONST
8231 * $a
8232 * !$a
8233 * $a < CONST, $a < $b
8234 * $a <= CONST, $a <= $b
8235 * $a > CONST, $a > $b
8236 * $a >= CONST, $a >= $b
8237 * $a != CONST, $a != $b
8238 * $a == CONST, $a == $b
8241 Jim_Obj *objPtr;
8243 /* STEP 1 -- Check if there are the conditions to run the specialized
8244 * version of while */
8246 switch (expr->len) {
8247 case 1:
8248 if (expr->token[0].type == JIM_TT_EXPR_INT) {
8249 *exprResultPtrPtr = expr->token[0].objPtr;
8250 Jim_IncrRefCount(*exprResultPtrPtr);
8251 return JIM_OK;
8253 if (expr->token[0].type == JIM_TT_VAR) {
8254 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
8255 if (objPtr) {
8256 *exprResultPtrPtr = objPtr;
8257 Jim_IncrRefCount(*exprResultPtrPtr);
8258 return JIM_OK;
8261 break;
8263 case 2:
8264 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
8265 jim_wide wideValue;
8267 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8268 if (objPtr && Jim_IsWide(objPtr)
8269 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
8270 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
8271 Jim_IncrRefCount(*exprResultPtrPtr);
8272 return JIM_OK;
8275 break;
8277 case 3:
8278 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
8279 || expr->token[1].type == JIM_TT_VAR)) {
8280 switch (expr->token[2].type) {
8281 case JIM_EXPROP_LT:
8282 case JIM_EXPROP_LTE:
8283 case JIM_EXPROP_GT:
8284 case JIM_EXPROP_GTE:
8285 case JIM_EXPROP_NUMEQ:
8286 case JIM_EXPROP_NUMNE:{
8287 /* optimise ok */
8288 jim_wide wideValueA;
8289 jim_wide wideValueB;
8291 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
8292 if (objPtr && Jim_IsWide(objPtr)
8293 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
8294 if (expr->token[1].type == JIM_TT_VAR) {
8295 objPtr =
8296 Jim_GetVariable(interp, expr->token[1].objPtr,
8297 JIM_NONE);
8299 else {
8300 objPtr = expr->token[1].objPtr;
8302 if (objPtr && Jim_IsWide(objPtr)
8303 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
8304 int cmpRes;
8306 switch (expr->token[2].type) {
8307 case JIM_EXPROP_LT:
8308 cmpRes = wideValueA < wideValueB;
8309 break;
8310 case JIM_EXPROP_LTE:
8311 cmpRes = wideValueA <= wideValueB;
8312 break;
8313 case JIM_EXPROP_GT:
8314 cmpRes = wideValueA > wideValueB;
8315 break;
8316 case JIM_EXPROP_GTE:
8317 cmpRes = wideValueA >= wideValueB;
8318 break;
8319 case JIM_EXPROP_NUMEQ:
8320 cmpRes = wideValueA == wideValueB;
8321 break;
8322 case JIM_EXPROP_NUMNE:
8323 cmpRes = wideValueA != wideValueB;
8324 break;
8325 default: /*notreached */
8326 cmpRes = 0;
8328 *exprResultPtrPtr =
8329 cmpRes ? interp->trueObj : interp->falseObj;
8330 Jim_IncrRefCount(*exprResultPtrPtr);
8331 return JIM_OK;
8337 break;
8340 #endif
8342 /* In order to avoid that the internal repr gets freed due to
8343 * shimmering of the exprObjPtr's object, we make the internal rep
8344 * shared. */
8345 expr->inUse++;
8347 /* The stack-based expr VM itself */
8349 /* Stack allocation. Expr programs have the feature that
8350 * a program of length N can't require a stack longer than
8351 * N. */
8352 if (expr->len > JIM_EE_STATICSTACK_LEN)
8353 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
8354 else
8355 e.stack = staticStack;
8357 e.stacklen = 0;
8359 /* Execute every instruction */
8360 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
8361 Jim_Obj *objPtr;
8363 switch (expr->token[i].type) {
8364 case JIM_TT_EXPR_INT:
8365 case JIM_TT_EXPR_DOUBLE:
8366 case JIM_TT_STR:
8367 ExprPush(&e, expr->token[i].objPtr);
8368 break;
8370 case JIM_TT_VAR:
8371 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
8372 if (objPtr) {
8373 ExprPush(&e, objPtr);
8375 else {
8376 retcode = JIM_ERR;
8378 break;
8380 case JIM_TT_DICTSUGAR:
8381 objPtr = Jim_ExpandDictSugar(interp, expr->token[i].objPtr);
8382 if (objPtr) {
8383 ExprPush(&e, objPtr);
8385 else {
8386 retcode = JIM_ERR;
8388 break;
8390 case JIM_TT_ESC:
8391 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
8392 if (retcode == JIM_OK) {
8393 ExprPush(&e, objPtr);
8395 break;
8397 case JIM_TT_CMD:
8398 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
8399 if (retcode == JIM_OK) {
8400 ExprPush(&e, Jim_GetResult(interp));
8402 break;
8404 default:{
8405 /* Find and execute the operation */
8406 e.skip = 0;
8407 e.opcode = expr->token[i].type;
8409 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
8410 /* Skip some opcodes if necessary */
8411 i += e.skip;
8412 continue;
8417 expr->inUse--;
8419 if (retcode == JIM_OK) {
8420 *exprResultPtrPtr = ExprPop(&e);
8422 else {
8423 for (i = 0; i < e.stacklen; i++) {
8424 Jim_DecrRefCount(interp, e.stack[i]);
8427 if (e.stack != staticStack) {
8428 Jim_Free(e.stack);
8430 return retcode;
8433 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
8435 int retcode;
8436 jim_wide wideValue;
8437 double doubleValue;
8438 Jim_Obj *exprResultPtr;
8440 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
8441 if (retcode != JIM_OK)
8442 return retcode;
8444 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
8445 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
8446 Jim_DecrRefCount(interp, exprResultPtr);
8447 return JIM_ERR;
8449 else {
8450 Jim_DecrRefCount(interp, exprResultPtr);
8451 *boolPtr = doubleValue != 0;
8452 return JIM_OK;
8455 *boolPtr = wideValue != 0;
8457 Jim_DecrRefCount(interp, exprResultPtr);
8458 return JIM_OK;
8461 /* -----------------------------------------------------------------------------
8462 * ScanFormat String Object
8463 * ---------------------------------------------------------------------------*/
8465 /* This Jim_Obj will held a parsed representation of a format string passed to
8466 * the Jim_ScanString command. For error diagnostics, the scanformat string has
8467 * to be parsed in its entirely first and then, if correct, can be used for
8468 * scanning. To avoid endless re-parsing, the parsed representation will be
8469 * stored in an internal representation and re-used for performance reason. */
8471 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
8472 * scanformat string. This part will later be used to extract information
8473 * out from the string to be parsed by Jim_ScanString */
8475 typedef struct ScanFmtPartDescr
8477 char type; /* Type of conversion (e.g. c, d, f) */
8478 char modifier; /* Modify type (e.g. l - long, h - short */
8479 size_t width; /* Maximal width of input to be converted */
8480 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
8481 char *arg; /* Specification of a CHARSET conversion */
8482 char *prefix; /* Prefix to be scanned literally before conversion */
8483 } ScanFmtPartDescr;
8485 /* The ScanFmtStringObj will hold the internal representation of a scanformat
8486 * string parsed and separated in part descriptions. Furthermore it contains
8487 * the original string representation of the scanformat string to allow for
8488 * fast update of the Jim_Obj's string representation part.
8490 * As an add-on the internal object representation adds some scratch pad area
8491 * for usage by Jim_ScanString to avoid endless allocating and freeing of
8492 * memory for purpose of string scanning.
8494 * The error member points to a static allocated string in case of a mal-
8495 * formed scanformat string or it contains '0' (NULL) in case of a valid
8496 * parse representation.
8498 * The whole memory of the internal representation is allocated as a single
8499 * area of memory that will be internally separated. So freeing and duplicating
8500 * of such an object is cheap */
8502 typedef struct ScanFmtStringObj
8504 jim_wide size; /* Size of internal repr in bytes */
8505 char *stringRep; /* Original string representation */
8506 size_t count; /* Number of ScanFmtPartDescr contained */
8507 size_t convCount; /* Number of conversions that will assign */
8508 size_t maxPos; /* Max position index if XPG3 is used */
8509 const char *error; /* Ptr to error text (NULL if no error */
8510 char *scratch; /* Some scratch pad used by Jim_ScanString */
8511 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
8512 } ScanFmtStringObj;
8515 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8516 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8517 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
8519 static const Jim_ObjType scanFmtStringObjType = {
8520 "scanformatstring",
8521 FreeScanFmtInternalRep,
8522 DupScanFmtInternalRep,
8523 UpdateStringOfScanFmt,
8524 JIM_TYPE_NONE,
8527 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8529 JIM_NOTUSED(interp);
8530 Jim_Free((char *)objPtr->internalRep.ptr);
8531 objPtr->internalRep.ptr = 0;
8534 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8536 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
8537 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
8539 JIM_NOTUSED(interp);
8540 memcpy(newVec, srcPtr->internalRep.ptr, size);
8541 dupPtr->internalRep.ptr = newVec;
8542 dupPtr->typePtr = &scanFmtStringObjType;
8545 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
8547 char *bytes = ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep;
8549 objPtr->bytes = Jim_StrDup(bytes);
8550 objPtr->length = strlen(bytes);
8553 /* SetScanFmtFromAny will parse a given string and create the internal
8554 * representation of the format specification. In case of an error
8555 * the error data member of the internal representation will be set
8556 * to an descriptive error text and the function will be left with
8557 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
8558 * specification */
8560 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
8562 ScanFmtStringObj *fmtObj;
8563 char *buffer;
8564 int maxCount, i, approxSize, lastPos = -1;
8565 const char *fmt = objPtr->bytes;
8566 int maxFmtLen = objPtr->length;
8567 const char *fmtEnd = fmt + maxFmtLen;
8568 int curr;
8570 Jim_FreeIntRep(interp, objPtr);
8571 /* Count how many conversions could take place maximally */
8572 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
8573 if (fmt[i] == '%')
8574 ++maxCount;
8575 /* Calculate an approximation of the memory necessary */
8576 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
8577 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
8578 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
8579 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
8580 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
8581 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
8582 +1; /* safety byte */
8583 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
8584 memset(fmtObj, 0, approxSize);
8585 fmtObj->size = approxSize;
8586 fmtObj->maxPos = 0;
8587 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
8588 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
8589 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
8590 buffer = fmtObj->stringRep + maxFmtLen + 1;
8591 objPtr->internalRep.ptr = fmtObj;
8592 objPtr->typePtr = &scanFmtStringObjType;
8593 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
8594 int width = 0, skip;
8595 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
8597 fmtObj->count++;
8598 descr->width = 0; /* Assume width unspecified */
8599 /* Overread and store any "literal" prefix */
8600 if (*fmt != '%' || fmt[1] == '%') {
8601 descr->type = 0;
8602 descr->prefix = &buffer[i];
8603 for (; fmt < fmtEnd; ++fmt) {
8604 if (*fmt == '%') {
8605 if (fmt[1] != '%')
8606 break;
8607 ++fmt;
8609 buffer[i++] = *fmt;
8611 buffer[i++] = 0;
8613 /* Skip the conversion introducing '%' sign */
8614 ++fmt;
8615 /* End reached due to non-conversion literal only? */
8616 if (fmt >= fmtEnd)
8617 goto done;
8618 descr->pos = 0; /* Assume "natural" positioning */
8619 if (*fmt == '*') {
8620 descr->pos = -1; /* Okay, conversion will not be assigned */
8621 ++fmt;
8623 else
8624 fmtObj->convCount++; /* Otherwise count as assign-conversion */
8625 /* Check if next token is a number (could be width or pos */
8626 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
8627 fmt += skip;
8628 /* Was the number a XPG3 position specifier? */
8629 if (descr->pos != -1 && *fmt == '$') {
8630 int prev;
8632 ++fmt;
8633 descr->pos = width;
8634 width = 0;
8635 /* Look if "natural" postioning and XPG3 one was mixed */
8636 if ((lastPos == 0 && descr->pos > 0)
8637 || (lastPos > 0 && descr->pos == 0)) {
8638 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
8639 return JIM_ERR;
8641 /* Look if this position was already used */
8642 for (prev = 0; prev < curr; ++prev) {
8643 if (fmtObj->descr[prev].pos == -1)
8644 continue;
8645 if (fmtObj->descr[prev].pos == descr->pos) {
8646 fmtObj->error =
8647 "variable is assigned by multiple \"%n$\" conversion specifiers";
8648 return JIM_ERR;
8651 /* Try to find a width after the XPG3 specifier */
8652 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
8653 descr->width = width;
8654 fmt += skip;
8656 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
8657 fmtObj->maxPos = descr->pos;
8659 else {
8660 /* Number was not a XPG3, so it has to be a width */
8661 descr->width = width;
8664 /* If positioning mode was undetermined yet, fix this */
8665 if (lastPos == -1)
8666 lastPos = descr->pos;
8667 /* Handle CHARSET conversion type ... */
8668 if (*fmt == '[') {
8669 int swapped = 1, beg = i, end, j;
8671 descr->type = '[';
8672 descr->arg = &buffer[i];
8673 ++fmt;
8674 if (*fmt == '^')
8675 buffer[i++] = *fmt++;
8676 if (*fmt == ']')
8677 buffer[i++] = *fmt++;
8678 while (*fmt && *fmt != ']')
8679 buffer[i++] = *fmt++;
8680 if (*fmt != ']') {
8681 fmtObj->error = "unmatched [ in format string";
8682 return JIM_ERR;
8684 end = i;
8685 buffer[i++] = 0;
8686 /* In case a range fence was given "backwards", swap it */
8687 while (swapped) {
8688 swapped = 0;
8689 for (j = beg + 1; j < end - 1; ++j) {
8690 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
8691 char tmp = buffer[j - 1];
8693 buffer[j - 1] = buffer[j + 1];
8694 buffer[j + 1] = tmp;
8695 swapped = 1;
8700 else {
8701 /* Remember any valid modifier if given */
8702 if (strchr("hlL", *fmt) != 0)
8703 descr->modifier = tolower((int)*fmt++);
8705 descr->type = *fmt;
8706 if (strchr("efgcsndoxui", *fmt) == 0) {
8707 fmtObj->error = "bad scan conversion character";
8708 return JIM_ERR;
8710 else if (*fmt == 'c' && descr->width != 0) {
8711 fmtObj->error = "field width may not be specified in %c " "conversion";
8712 return JIM_ERR;
8714 else if (*fmt == 'u' && descr->modifier == 'l') {
8715 fmtObj->error = "unsigned wide not supported";
8716 return JIM_ERR;
8719 curr++;
8721 done:
8722 return JIM_OK;
8725 /* Some accessor macros to allow lowlevel access to fields of internal repr */
8727 #define FormatGetCnvCount(_fo_) \
8728 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
8729 #define FormatGetMaxPos(_fo_) \
8730 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
8731 #define FormatGetError(_fo_) \
8732 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
8734 /* Some Bit testing/setting/cleaning routines. For now only used in handling
8735 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
8736 * bitvector implementation in Jim? */
8738 static int JimTestBit(const char *bitvec, char ch)
8740 div_t pos = div(ch - 1, 8);
8742 return bitvec[pos.quot] & (1 << pos.rem);
8745 static void JimSetBit(char *bitvec, char ch)
8747 div_t pos = div(ch - 1, 8);
8749 bitvec[pos.quot] |= (1 << pos.rem);
8752 #if 0 /* currently not used */
8753 static void JimClearBit(char *bitvec, char ch)
8755 div_t pos = div(ch - 1, 8);
8757 bitvec[pos.quot] &= ~(1 << pos.rem);
8759 #endif
8761 /* JimScanAString is used to scan an unspecified string that ends with
8762 * next WS, or a string that is specified via a charset. The charset
8763 * is currently implemented in a way to only allow for usage with
8764 * ASCII. Whenever we will switch to UNICODE, another idea has to
8765 * be born :-/
8767 * FIXME: Works only with ASCII */
8769 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
8771 size_t i;
8772 Jim_Obj *result;
8773 char charset[256 / 8 + 1]; /* A Charset may contain max 256 chars */
8774 char *buffer = Jim_Alloc(strlen(str) + 1), *anchor = buffer;
8776 /* First init charset to nothing or all, depending if a specified
8777 * or an unspecified string has to be parsed */
8778 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
8779 if (sdescr) {
8780 /* There was a set description given, that means we are parsing
8781 * a specified string. So we have to build a corresponding
8782 * charset reflecting the description */
8783 int notFlag = 0;
8785 /* Should the set be negated at the end? */
8786 if (*sdescr == '^') {
8787 notFlag = 1;
8788 ++sdescr;
8790 /* Here '-' is meant literally and not to define a range */
8791 if (*sdescr == '-') {
8792 JimSetBit(charset, '-');
8793 ++sdescr;
8795 while (*sdescr) {
8796 if (sdescr[1] == '-' && sdescr[2] != 0) {
8797 /* Handle range definitions */
8798 int i;
8800 for (i = sdescr[0]; i <= sdescr[2]; ++i)
8801 JimSetBit(charset, (char)i);
8802 sdescr += 3;
8804 else {
8805 /* Handle verbatim character definitions */
8806 JimSetBit(charset, *sdescr++);
8809 /* Negate the charset if there was a NOT given */
8810 for (i = 0; notFlag && i < sizeof(charset); ++i)
8811 charset[i] = ~charset[i];
8813 /* And after all the mess above, the real work begin ... */
8814 while (str && *str) {
8815 if (!sdescr && isspace(*str))
8816 break; /* EOS via WS if unspecified */
8817 if (JimTestBit(charset, *str))
8818 *buffer++ = *str++;
8819 else
8820 break; /* EOS via mismatch if specified scanning */
8822 *buffer = 0; /* Close the string properly ... */
8823 result = Jim_NewStringObj(interp, anchor, -1);
8824 Jim_Free(anchor); /* ... and free it afer usage */
8825 return result;
8828 /* ScanOneEntry will scan one entry out of the string passed as argument.
8829 * It use the sscanf() function for this task. After extracting and
8830 * converting of the value, the count of scanned characters will be
8831 * returned of -1 in case of no conversion tool place and string was
8832 * already scanned thru */
8834 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
8835 ScanFmtStringObj * fmtObj, long index, Jim_Obj **valObjPtr)
8837 const char *tok;
8838 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
8839 size_t sLen = strlen(&str[pos]), scanned = 0;
8840 size_t anchor = pos;
8841 int i;
8843 /* First pessimistically assume, we will not scan anything :-) */
8844 *valObjPtr = 0;
8845 if (descr->prefix) {
8846 /* There was a prefix given before the conversion, skip it and adjust
8847 * the string-to-be-parsed accordingly */
8848 for (i = 0; str[pos] && descr->prefix[i]; ++i) {
8849 /* If prefix require, skip WS */
8850 if (isspace(descr->prefix[i]))
8851 while (str[pos] && isspace(str[pos]))
8852 ++pos;
8853 else if (descr->prefix[i] != str[pos])
8854 break; /* Prefix do not match here, leave the loop */
8855 else
8856 ++pos; /* Prefix matched so far, next round */
8858 if (str[pos] == 0)
8859 return -1; /* All of str consumed: EOF condition */
8860 else if (descr->prefix[i] != 0)
8861 return 0; /* Not whole prefix consumed, no conversion possible */
8863 /* For all but following conversion, skip leading WS */
8864 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
8865 while (isspace(str[pos]))
8866 ++pos;
8867 /* Determine how much skipped/scanned so far */
8868 scanned = pos - anchor;
8869 if (descr->type == 'n') {
8870 /* Return pseudo conversion means: how much scanned so far? */
8871 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
8873 else if (str[pos] == 0) {
8874 /* Cannot scan anything, as str is totally consumed */
8875 return -1;
8877 else {
8878 /* Processing of conversions follows ... */
8879 if (descr->width > 0) {
8880 /* Do not try to scan as fas as possible but only the given width.
8881 * To ensure this, we copy the part that should be scanned. */
8882 size_t tLen = descr->width > sLen ? sLen : descr->width;
8884 tok = Jim_StrDupLen(&str[pos], tLen);
8886 else {
8887 /* As no width was given, simply refer to the original string */
8888 tok = &str[pos];
8890 switch (descr->type) {
8891 case 'c':
8892 *valObjPtr = Jim_NewIntObj(interp, *tok);
8893 scanned += 1;
8894 break;
8895 case 'd':
8896 case 'o':
8897 case 'x':
8898 case 'u':
8899 case 'i':{
8900 char *endp; /* Position where the number finished */
8901 jim_wide w;
8903 int base = descr->type == 'o' ? 8
8904 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
8906 /* Try to scan a number with the given base */
8907 w = strtoull(tok, &endp, base);
8908 if (endp == tok && base == 0) {
8909 /* If scanning failed, and base was undetermined, simply
8910 * put it to 10 and try once more. This should catch the
8911 * case where %i begin to parse a number prefix (e.g.
8912 * '0x' but no further digits follows. This will be
8913 * handled as a ZERO followed by a char 'x' by Tcl */
8914 w = strtoull(tok, &endp, 10);
8917 if (endp != tok) {
8918 /* There was some number sucessfully scanned! */
8919 *valObjPtr = Jim_NewIntObj(interp, w);
8921 /* Adjust the number-of-chars scanned so far */
8922 scanned += endp - tok;
8924 else {
8925 /* Nothing was scanned. We have to determine if this
8926 * happened due to e.g. prefix mismatch or input str
8927 * exhausted */
8928 scanned = *tok ? 0 : -1;
8930 break;
8932 case 's':
8933 case '[':{
8934 *valObjPtr = JimScanAString(interp, descr->arg, tok);
8935 scanned += Jim_Length(*valObjPtr);
8936 break;
8938 case 'e':
8939 case 'f':
8940 case 'g':{
8941 char *endp;
8942 double value = strtod(tok, &endp);
8944 if (endp != tok) {
8945 /* There was some number sucessfully scanned! */
8946 *valObjPtr = Jim_NewDoubleObj(interp, value);
8947 /* Adjust the number-of-chars scanned so far */
8948 scanned += endp - tok;
8950 else {
8951 /* Nothing was scanned. We have to determine if this
8952 * happened due to e.g. prefix mismatch or input str
8953 * exhausted */
8954 scanned = *tok ? 0 : -1;
8956 break;
8959 /* If a substring was allocated (due to pre-defined width) do not
8960 * forget to free it */
8961 if (tok != &str[pos])
8962 Jim_Free((char *)tok);
8964 return scanned;
8967 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
8968 * string and returns all converted (and not ignored) values in a list back
8969 * to the caller. If an error occured, a NULL pointer will be returned */
8971 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
8973 size_t i, pos;
8974 int scanned = 1;
8975 const char *str = Jim_GetString(strObjPtr, 0);
8976 Jim_Obj *resultList = 0;
8977 Jim_Obj **resultVec = 0;
8978 int resultc;
8979 Jim_Obj *emptyStr = 0;
8980 ScanFmtStringObj *fmtObj;
8982 /* This should never happen. The format object should already be of the correct type */
8983 if (fmtObjPtr->typePtr != &scanFmtStringObjType) {
8984 Jim_Panic(interp, "Jim_ScanString() for non-scan format");
8986 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
8987 /* Check if format specification was valid */
8988 if (fmtObj->error != 0) {
8989 if (flags & JIM_ERRMSG)
8990 Jim_SetResultString(interp, fmtObj->error, -1);
8991 return 0;
8993 /* Allocate a new "shared" empty string for all unassigned conversions */
8994 emptyStr = Jim_NewEmptyStringObj(interp);
8995 Jim_IncrRefCount(emptyStr);
8996 /* Create a list and fill it with empty strings up to max specified XPG3 */
8997 resultList = Jim_NewListObj(interp, 0, 0);
8998 if (fmtObj->maxPos > 0) {
8999 for (i = 0; i < fmtObj->maxPos; ++i)
9000 Jim_ListAppendElement(interp, resultList, emptyStr);
9001 JimListGetElements(interp, resultList, &resultc, &resultVec);
9003 /* Now handle every partial format description */
9004 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9005 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9006 Jim_Obj *value = 0;
9008 /* Only last type may be "literal" w/o conversion - skip it! */
9009 if (descr->type == 0)
9010 continue;
9011 /* As long as any conversion could be done, we will proceed */
9012 if (scanned > 0)
9013 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
9014 /* In case our first try results in EOF, we will leave */
9015 if (scanned == -1 && i == 0)
9016 goto eof;
9017 /* Advance next pos-to-be-scanned for the amount scanned already */
9018 pos += scanned;
9019 /* value == 0 means no conversion took place so take empty string */
9020 if (value == 0)
9021 value = Jim_NewEmptyStringObj(interp);
9022 /* If value is a non-assignable one, skip it */
9023 if (descr->pos == -1) {
9024 Jim_FreeNewObj(interp, value);
9026 else if (descr->pos == 0)
9027 /* Otherwise append it to the result list if no XPG3 was given */
9028 Jim_ListAppendElement(interp, resultList, value);
9029 else if (resultVec[descr->pos - 1] == emptyStr) {
9030 /* But due to given XPG3, put the value into the corr. slot */
9031 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9032 Jim_IncrRefCount(value);
9033 resultVec[descr->pos - 1] = value;
9035 else {
9036 /* Otherwise, the slot was already used - free obj and ERROR */
9037 Jim_FreeNewObj(interp, value);
9038 goto err;
9041 Jim_DecrRefCount(interp, emptyStr);
9042 return resultList;
9043 eof:
9044 Jim_DecrRefCount(interp, emptyStr);
9045 Jim_FreeNewObj(interp, resultList);
9046 return (Jim_Obj *)EOF;
9047 err:
9048 Jim_DecrRefCount(interp, emptyStr);
9049 Jim_FreeNewObj(interp, resultList);
9050 return 0;
9053 /* -----------------------------------------------------------------------------
9054 * Pseudo Random Number Generation
9055 * ---------------------------------------------------------------------------*/
9056 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed, int seedLen);
9058 /* Initialize the sbox with the numbers from 0 to 255 */
9059 static void JimPrngInit(Jim_Interp *interp)
9061 int i;
9062 /* REVISIT: Move off stack */
9063 unsigned int seed[256];
9065 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9066 for (i = 0; i < 256; i++)
9067 seed[i] = (rand() ^ time(NULL) ^ clock());
9068 JimPrngSeed(interp, (unsigned char *)seed, sizeof(int) * 256);
9071 /* Generates N bytes of random data */
9072 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9074 Jim_PrngState *prng;
9075 unsigned char *destByte = (unsigned char *)dest;
9076 unsigned int si, sj, x;
9078 /* initialization, only needed the first time */
9079 if (interp->prngState == NULL)
9080 JimPrngInit(interp);
9081 prng = interp->prngState;
9082 /* generates 'len' bytes of pseudo-random numbers */
9083 for (x = 0; x < len; x++) {
9084 prng->i = (prng->i + 1) & 0xff;
9085 si = prng->sbox[prng->i];
9086 prng->j = (prng->j + si) & 0xff;
9087 sj = prng->sbox[prng->j];
9088 prng->sbox[prng->i] = sj;
9089 prng->sbox[prng->j] = si;
9090 *destByte++ = prng->sbox[(si + sj) & 0xff];
9094 /* Re-seed the generator with user-provided bytes */
9095 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed, int seedLen)
9097 int i;
9098 /* REVISIT: Move off stack */
9099 unsigned char buf[256];
9100 Jim_PrngState *prng;
9102 /* initialization, only needed the first time */
9103 if (interp->prngState == NULL)
9104 JimPrngInit(interp);
9105 prng = interp->prngState;
9107 /* Set the sbox[i] with i */
9108 for (i = 0; i < 256; i++)
9109 prng->sbox[i] = i;
9110 /* Now use the seed to perform a random permutation of the sbox */
9111 for (i = 0; i < seedLen; i++) {
9112 unsigned char t;
9114 t = prng->sbox[i & 0xFF];
9115 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9116 prng->sbox[seed[i]] = t;
9118 prng->i = prng->j = 0;
9119 /* discard the first 256 bytes of stream. */
9120 JimRandomBytes(interp, buf, 256);
9123 /* -----------------------------------------------------------------------------
9124 * Eval
9125 * ---------------------------------------------------------------------------*/
9126 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
9127 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
9129 /* Handle calls to the [unknown] command */
9130 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *filename,
9131 int linenr)
9133 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
9134 int retCode;
9136 /* If JimUnknown() is recursively called too many times...
9137 * done here
9139 if (interp->unknown_called > 50) {
9140 return JIM_ERR;
9143 /* If the [unknown] command does not exists returns
9144 * just now */
9145 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
9146 return JIM_ERR;
9148 /* The object interp->unknown just contains
9149 * the "unknown" string, it is used in order to
9150 * avoid to lookup the unknown command every time
9151 * but instread to cache the result. */
9152 if (argc + 1 <= JIM_EVAL_SARGV_LEN)
9153 v = sv;
9154 else
9155 v = Jim_Alloc(sizeof(Jim_Obj *) * (argc + 1));
9156 /* Make a copy of the arguments vector, but shifted on
9157 * the right of one position. The command name of the
9158 * command will be instead the first argument of the
9159 * [unknown] call. */
9160 memcpy(v + 1, argv, sizeof(Jim_Obj *) * argc);
9161 v[0] = interp->unknown;
9162 /* Call it */
9163 interp->unknown_called++;
9164 retCode = JimEvalObjVector(interp, argc + 1, v, filename, linenr);
9165 interp->unknown_called--;
9167 /* Clean up */
9168 if (v != sv)
9169 Jim_Free(v);
9170 return retCode;
9173 /* Eval the object vector 'objv' composed of 'objc' elements.
9174 * Every element is used as single argument.
9175 * Jim_EvalObj() will call this function every time its object
9176 * argument is of "list" type, with no string representation.
9178 * This is possible because the string representation of a
9179 * list object generated by the UpdateStringOfList is made
9180 * in a way that ensures that every list element is a different
9181 * command argument. */
9182 static int JimEvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv,
9183 const char *filename, int linenr)
9185 int i, retcode;
9186 Jim_Cmd *cmdPtr;
9188 /* Incr refcount of arguments. */
9189 for (i = 0; i < objc; i++)
9190 Jim_IncrRefCount(objv[i]);
9191 /* Command lookup */
9192 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
9193 if (cmdPtr == NULL) {
9194 retcode = JimUnknown(interp, objc, objv, filename, linenr);
9196 else {
9197 /* Call it -- Make sure result is an empty object. */
9198 JimIncrCmdRefCount(cmdPtr);
9199 Jim_SetEmptyResult(interp);
9200 if (cmdPtr->cmdProc) {
9201 interp->cmdPrivData = cmdPtr->privData;
9202 retcode = cmdPtr->cmdProc(interp, objc, objv);
9204 else {
9205 retcode = JimCallProcedure(interp, cmdPtr, filename, linenr, objc, objv);
9207 JimDecrCmdRefCount(interp, cmdPtr);
9209 /* Decr refcount of arguments and return the retcode */
9210 for (i = 0; i < objc; i++)
9211 Jim_DecrRefCount(interp, objv[i]);
9213 return retcode;
9216 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
9218 return JimEvalObjVector(interp, objc, objv, NULL, 0);
9221 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
9222 * via *objPtrPtr. This function is only called by Jim_EvalObj().
9223 * The returned object has refcount = 0. */
9224 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken * token, int tokens, Jim_Obj **objPtrPtr)
9226 int totlen = 0, i, retcode;
9227 Jim_Obj **intv;
9228 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
9229 Jim_Obj *objPtr;
9230 char *s;
9232 if (tokens <= JIM_EVAL_SINTV_LEN)
9233 intv = sintv;
9234 else
9235 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
9236 /* Compute every token forming the argument
9237 * in the intv objects vector. */
9238 for (i = 0; i < tokens; i++) {
9239 switch (token[i].type) {
9240 case JIM_TT_ESC:
9241 case JIM_TT_STR:
9242 intv[i] = token[i].objPtr;
9243 break;
9244 case JIM_TT_VAR:
9245 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9246 if (!intv[i]) {
9247 retcode = JIM_ERR;
9248 goto err;
9250 break;
9251 case JIM_TT_DICTSUGAR:
9252 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
9253 if (!intv[i]) {
9254 retcode = JIM_ERR;
9255 goto err;
9257 break;
9258 case JIM_TT_CMD:
9259 retcode = Jim_EvalObj(interp, token[i].objPtr);
9260 if (retcode != JIM_OK)
9261 goto err;
9262 intv[i] = Jim_GetResult(interp);
9263 break;
9264 default:
9265 Jim_Panic(interp, "default token type reached " "in Jim_InterpolateTokens().");
9266 exit(1);
9268 Jim_IncrRefCount(intv[i]);
9269 /* Make sure there is a valid
9270 * string rep, and add the string
9271 * length to the total legnth. */
9272 Jim_GetString(intv[i], NULL);
9273 totlen += intv[i]->length;
9275 /* Concatenate every token in an unique
9276 * object. */
9277 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
9279 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
9280 && token[2].type == JIM_TT_VAR) {
9281 /* May be able to do fast interpolated object -> dictSubst */
9282 objPtr->typePtr = &interpolatedObjType;
9283 objPtr->internalRep.twoPtrValue.ptr1 = token;
9284 objPtr->internalRep.twoPtrValue.ptr2 = intv[2];
9285 Jim_IncrRefCount(intv[2]);
9288 s = objPtr->bytes = Jim_Alloc(totlen + 1);
9289 objPtr->length = totlen;
9290 for (i = 0; i < tokens; i++) {
9291 memcpy(s, intv[i]->bytes, intv[i]->length);
9292 s += intv[i]->length;
9293 Jim_DecrRefCount(interp, intv[i]);
9295 objPtr->bytes[totlen] = '\0';
9296 /* Free the intv vector if not static. */
9297 if (tokens > JIM_EVAL_SINTV_LEN)
9298 Jim_Free(intv);
9300 *objPtrPtr = objPtr;
9301 return JIM_OK;
9302 err:
9303 i--;
9304 for (; i >= 0; i--)
9305 Jim_DecrRefCount(interp, intv[i]);
9306 if (tokens > JIM_EVAL_SINTV_LEN)
9307 Jim_Free(intv);
9308 return retcode;
9311 /* Helper of Jim_EvalObj() to perform argument expansion.
9312 * Basically this function append an argument to 'argv'
9313 * (and increments argc by reference accordingly), performing
9314 * expansion of the list object if 'expand' is non-zero, or
9315 * just adding objPtr to argv if 'expand' is zero. */
9316 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
9317 int *argcPtr, int expand, Jim_Obj *objPtr)
9319 if (!expand) {
9320 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj *) * ((*argcPtr) + 1));
9321 /* refcount of objPtr not incremented because
9322 * we are actually transfering a reference from
9323 * the old 'argv' to the expanded one. */
9324 (*argv)[*argcPtr] = objPtr;
9325 (*argcPtr)++;
9327 else {
9328 int len, i;
9330 len = Jim_ListLength(interp, objPtr);
9331 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj *) * ((*argcPtr) + len));
9332 for (i = 0; i < len; i++) {
9333 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
9334 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
9335 (*argcPtr)++;
9337 /* The original object reference is no longer needed,
9338 * after the expansion it is no longer present on
9339 * the argument vector, but the single elements are
9340 * in its place. */
9341 Jim_DecrRefCount(interp, objPtr);
9345 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, const char *filename, int line)
9347 int rc = retcode;
9349 #if 0
9350 /* XXX: Don't create a stack frame for 'return -code error' */
9352 /* Pick up 'return -code error' too */
9353 if (retcode == JIM_RETURN) {
9354 rc = interp->returnCode;
9356 #endif
9357 #if 0
9358 printf("JimAddErrorToStack: retcode=%s, %s:%d, ast=%d, errorFlag=%d\n",
9359 Jim_ReturnCode(retcode), filename, line, interp->addStackTrace, interp->errorFlag);
9360 #endif
9362 if (rc == JIM_ERR && !interp->errorFlag) {
9363 /* This is the first error, so save the file/line information and reset the stack */
9364 interp->errorFlag = 1;
9365 JimSetErrorFileName(interp, filename);
9366 JimSetErrorLineNumber(interp, line);
9368 JimResetStackTrace(interp);
9369 /* Always add a level where the error first occurs */
9370 interp->addStackTrace++;
9373 /* Now if this is an "interesting" level, add it to the stack trace */
9374 if (rc == JIM_ERR && interp->addStackTrace > 0) {
9375 /* Add the stack info for the current level */
9377 JimAppendStackTrace(interp, Jim_GetString(interp->errorProc, NULL), filename, line);
9379 /* Note: if we didn't have a filename for this level,
9380 * don't clear the addStackTrace flag
9381 * so we can pick it up at the next level
9383 if (*filename) {
9384 interp->addStackTrace = 0;
9387 Jim_DecrRefCount(interp, interp->errorProc);
9388 interp->errorProc = interp->emptyObj;
9389 Jim_IncrRefCount(interp->errorProc);
9391 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
9392 /* Propagate the addStackTrace value through 'return -code error' */
9394 else {
9395 interp->addStackTrace = 0;
9399 /* And delete any local procs */
9400 static void JimDeleteLocalProcs(Jim_Interp *interp)
9402 if (interp->localProcs) {
9403 char *procname;
9405 while ((procname = Jim_StackPop(interp->localProcs)) != NULL) {
9406 Jim_DeleteCommand(interp, procname);
9407 Jim_Free(procname);
9409 Jim_FreeStack(interp->localProcs);
9410 Jim_Free(interp->localProcs);
9411 interp->localProcs = NULL;
9415 /* If listPtr is a list, call JimEvalObjVector() with the given source info.
9416 * Otherwise eval with Jim_EvalObj()
9418 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr, const char *filename, int linenr)
9420 if (!Jim_IsList(listPtr)) {
9421 return Jim_EvalObj(interp, listPtr);
9423 else {
9424 int retcode = JIM_OK;
9426 if (listPtr->internalRep.listValue.len) {
9427 Jim_IncrRefCount(listPtr);
9428 retcode = JimEvalObjVector(interp,
9429 listPtr->internalRep.listValue.len,
9430 listPtr->internalRep.listValue.ele, filename, linenr);
9431 Jim_DecrRefCount(interp, listPtr);
9433 return retcode;
9437 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
9439 int i, j = 0, len;
9440 ScriptObj *script;
9441 ScriptToken *token;
9442 ScriptToken *cmdtoken = NULL;
9443 int *cs; /* command structure array */
9444 int retcode = JIM_OK;
9445 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
9447 interp->errorFlag = 0;
9449 /* If the object is of type "list", we can call
9450 * a specialized version of Jim_EvalObj() */
9451 if (Jim_IsList(scriptObjPtr)) {
9452 return Jim_EvalObjList(interp, scriptObjPtr, NULL, 0);
9455 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
9456 script = Jim_GetScript(interp, scriptObjPtr);
9458 /* Reset the interpreter result. This is useful to
9459 * return the emtpy result in the case of empty program. */
9460 Jim_SetEmptyResult(interp);
9462 #ifdef JIM_OPTIMIZATION
9463 /* Check for one of the following common scripts used by for, while
9465 * {}
9466 * incr a
9468 if (script->len == 0) {
9469 Jim_DecrRefCount(interp, scriptObjPtr);
9470 return JIM_OK;
9472 if (script->len == 4 && script->token[0].type == JIM_TT_ESC
9473 && script->token[2].type == JIM_TT_ESC
9474 && script->token[2].objPtr->typePtr == &variableObjType) {
9475 if (Jim_CompareStringImmediate(interp, script->token[0].objPtr, "incr")) {
9476 Jim_Obj *objPtr = Jim_GetVariable(interp, script->token[2].objPtr, JIM_NONE);
9478 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
9479 objPtr->internalRep.wideValue++;
9480 Jim_InvalidateStringRep(objPtr);
9481 Jim_DecrRefCount(interp, scriptObjPtr);
9482 Jim_SetResult(interp, objPtr);
9483 return JIM_OK;
9487 #endif
9489 /* Now we have to make sure the internal repr will not be
9490 * freed on shimmering.
9492 * Think for example to this:
9494 * set x {llength $x; ... some more code ...}; eval $x
9496 * In order to preserve the internal rep, we increment the
9497 * inUse field of the script internal rep structure. */
9498 script->inUse++;
9500 token = script->token;
9501 len = script->len;
9502 cs = script->cmdStruct;
9503 i = 0; /* 'i' is the current token index. */
9505 /* Execute every command sequentially, returns on
9506 * error (i.e. if a command does not return JIM_OK) */
9507 while (i < len) {
9508 int expand = 0;
9509 int argc = *cs++; /* Get the number of arguments */
9510 Jim_Cmd *cmd;
9512 /* Set the expand flag if needed. */
9513 if (argc < 0) {
9514 expand++;
9515 argc = -argc;
9517 /* Allocate the arguments vector */
9518 if (argc <= JIM_EVAL_SARGV_LEN)
9519 argv = sargv;
9520 else
9521 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
9523 /* This is the command token. Remember it in the case of error */
9524 cmdtoken = &token[i];
9526 /* Populate the arguments objects. */
9527 for (j = 0; j < argc; j++) {
9528 int tokens = *cs++;
9530 /* tokens is negative if expansion is needed.
9531 * for this argument. */
9532 if (tokens < 0) {
9533 tokens = (-tokens) - 1;
9534 i++;
9536 if (tokens == 1) {
9537 /* Fast path if the token does not
9538 * need interpolation */
9539 switch (token[i].type) {
9540 case JIM_TT_ESC:
9541 case JIM_TT_STR:
9542 argv[j] = token[i].objPtr;
9543 break;
9544 case JIM_TT_VAR:
9545 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9546 if (!tmpObjPtr) {
9547 retcode = JIM_ERR;
9548 goto err;
9550 argv[j] = tmpObjPtr;
9551 break;
9552 case JIM_TT_DICTSUGAR:
9553 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9554 if (!tmpObjPtr) {
9555 retcode = JIM_ERR;
9556 goto err;
9558 argv[j] = tmpObjPtr;
9559 break;
9560 case JIM_TT_CMD:
9561 retcode = Jim_EvalObj(interp, token[i].objPtr);
9562 if (retcode != JIM_OK) {
9563 goto err;
9565 argv[j] = Jim_GetResult(interp);
9566 break;
9567 default:
9568 Jim_Panic(interp, "default token type reached " "in Jim_EvalObj().");
9569 exit(1);
9571 Jim_IncrRefCount(argv[j]);
9572 i += 2;
9574 else {
9575 /* For interpolation we call a helper
9576 * function to do the work for us. */
9577 if ((retcode = Jim_InterpolateTokens(interp,
9578 token + i, tokens, &tmpObjPtr)) != JIM_OK) {
9579 goto err;
9581 argv[j] = tmpObjPtr;
9582 Jim_IncrRefCount(argv[j]);
9583 i += tokens + 1;
9586 /* Handle {expand} expansion */
9587 if (expand) {
9588 int *ecs = cs - argc;
9589 int eargc = 0;
9590 Jim_Obj **eargv = NULL;
9592 for (j = 0; j < argc; j++) {
9593 Jim_ExpandArgument(interp, &eargv, &eargc, ecs[j] < 0, argv[j]);
9595 if (argv != sargv)
9596 Jim_Free(argv);
9597 argc = eargc;
9598 argv = eargv;
9599 j = argc;
9600 if (argc == 0) {
9601 /* Nothing to do with zero args. */
9602 Jim_Free(eargv);
9603 continue;
9606 /* Lookup the command to call */
9607 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
9608 if (cmd != NULL) {
9609 /* Call it -- Make sure result is an empty object. */
9610 JimIncrCmdRefCount(cmd);
9611 Jim_SetEmptyResult(interp);
9612 if (cmd->cmdProc) {
9613 interp->cmdPrivData = cmd->privData;
9614 retcode = cmd->cmdProc(interp, argc, argv);
9616 else {
9617 retcode =
9618 JimCallProcedure(interp, cmd, script->fileName, cmdtoken->linenr, argc, argv);
9620 JimDecrCmdRefCount(interp, cmd);
9622 else {
9623 /* Call [unknown] */
9624 retcode = JimUnknown(interp, argc, argv, script->fileName, cmdtoken->linenr);
9626 if (interp->signal_level && interp->sigmask) {
9627 /* Check for a signal after each command */
9628 retcode = JIM_SIGNAL;
9630 if (retcode != JIM_OK) {
9631 goto err;
9633 /* Decrement the arguments count */
9634 for (j = 0; j < argc; j++) {
9635 Jim_DecrRefCount(interp, argv[j]);
9638 if (argv != sargv) {
9639 Jim_Free(argv);
9640 argv = NULL;
9643 /* Note that we don't have to decrement inUse, because the
9644 * following code transfers our use of the reference again to
9645 * the script object. */
9646 j = 0; /* on normal termination, the argv array is already
9647 Jim_DecrRefCount-ed. */
9648 err:
9649 JimAddErrorToStack(interp, retcode, script->fileName, cmdtoken ? cmdtoken->linenr : 0);
9650 Jim_FreeIntRep(interp, scriptObjPtr);
9651 scriptObjPtr->typePtr = &scriptObjType;
9652 Jim_SetIntRepPtr(scriptObjPtr, script);
9653 Jim_DecrRefCount(interp, scriptObjPtr);
9654 for (i = 0; i < j; i++) {
9655 Jim_DecrRefCount(interp, argv[i]);
9657 if (argv != sargv)
9658 Jim_Free(argv);
9660 return retcode;
9663 /* Call a procedure implemented in Tcl.
9664 * It's possible to speed-up a lot this function, currently
9665 * the callframes are not cached, but allocated and
9666 * destroied every time. What is expecially costly is
9667 * to create/destroy the local vars hash table every time.
9669 * This can be fixed just implementing callframes caching
9670 * in JimCreateCallFrame() and JimFreeCallFrame(). */
9671 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
9672 Jim_Obj *const *argv)
9674 int i, d, retcode;
9675 Jim_CallFrame *callFramePtr;
9676 Jim_Obj *argObjPtr;
9677 Jim_Obj *procname = argv[0];
9678 Jim_Stack *prevLocalProcs;
9680 /* Check arity */
9681 if (argc - 1 < cmd->leftArity + cmd->rightArity ||
9682 (!cmd->args && argc - 1 > cmd->leftArity + cmd->rightArity + cmd->optionalArgs)) {
9683 /* Create a nice error message, consistent with Tcl 8.5 */
9684 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
9685 int arglen = Jim_ListLength(interp, cmd->argListObjPtr);
9687 for (i = 0; i < arglen; i++) {
9688 Jim_Obj *argObjPtr;
9690 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
9692 Jim_AppendString(interp, argmsg, " ", 1);
9694 if (i < cmd->leftArity || i >= arglen - cmd->rightArity) {
9695 Jim_AppendObj(interp, argmsg, argObjPtr);
9697 else if (i == arglen - cmd->rightArity - cmd->args) {
9698 Jim_AppendString(interp, argmsg, "?argument ...?", -1);
9700 else {
9701 Jim_Obj *objPtr;
9703 Jim_AppendString(interp, argmsg, "?", 1);
9704 Jim_ListIndex(interp, argObjPtr, 0, &objPtr, JIM_NONE);
9705 Jim_AppendObj(interp, argmsg, objPtr);
9706 Jim_AppendString(interp, argmsg, "?", 1);
9709 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procname, argmsg);
9710 Jim_FreeNewObj(interp, argmsg);
9711 return JIM_ERR;
9714 /* Check if there are too nested calls */
9715 if (interp->numLevels == interp->maxNestingDepth) {
9716 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
9717 return JIM_ERR;
9720 /* Create a new callframe */
9721 callFramePtr = JimCreateCallFrame(interp);
9722 callFramePtr->parentCallFrame = interp->framePtr;
9723 callFramePtr->argv = argv;
9724 callFramePtr->argc = argc;
9725 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
9726 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
9727 callFramePtr->staticVars = cmd->staticVars;
9728 callFramePtr->filename = filename;
9729 callFramePtr->line = linenr;
9730 Jim_IncrRefCount(cmd->argListObjPtr);
9731 Jim_IncrRefCount(cmd->bodyObjPtr);
9732 interp->framePtr = callFramePtr;
9733 interp->numLevels++;
9735 /* Simplify arg counting */
9736 argv++;
9737 argc--;
9739 /* Set arguments */
9741 /* Assign in this order:
9742 * leftArity required args.
9743 * rightArity required args (but actually do it last for simplicity)
9744 * optionalArgs optional args
9745 * remaining args into 'args' if 'args'
9748 /* Note that 'd' steps along the arg list, whilst argc/argv follow the supplied args */
9750 /* leftArity required args */
9751 for (d = 0; d < cmd->leftArity; d++) {
9752 Jim_ListIndex(interp, cmd->argListObjPtr, d, &argObjPtr, JIM_NONE);
9753 Jim_SetVariable(interp, argObjPtr, *argv++);
9754 argc--;
9757 /* Shorten our idea of the number of supplied args */
9758 argc -= cmd->rightArity;
9760 /* optionalArgs optional args */
9761 for (i = 0; i < cmd->optionalArgs; i++) {
9762 Jim_Obj *nameObjPtr;
9763 Jim_Obj *valueObjPtr;
9765 Jim_ListIndex(interp, cmd->argListObjPtr, d++, &argObjPtr, JIM_NONE);
9767 /* The name is the first element of the list */
9768 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
9769 if (argc) {
9770 valueObjPtr = *argv++;
9771 argc--;
9773 else {
9774 /* No more values, so use default */
9775 /* The value is the second element of the list */
9776 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
9778 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
9781 /* Any remaining args go to 'args' */
9782 if (cmd->args) {
9783 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
9785 /* Use the 'args' name from the procedure args */
9786 Jim_ListIndex(interp, cmd->argListObjPtr, d, &argObjPtr, JIM_NONE);
9787 Jim_SetVariable(interp, argObjPtr, listObjPtr);
9788 argv += argc;
9789 d++;
9792 /* rightArity required args */
9793 for (i = 0; i < cmd->rightArity; i++) {
9794 Jim_ListIndex(interp, cmd->argListObjPtr, d++, &argObjPtr, JIM_NONE);
9795 Jim_SetVariable(interp, argObjPtr, *argv++);
9798 /* Install a new stack for local procs */
9799 prevLocalProcs = interp->localProcs;
9800 interp->localProcs = NULL;
9802 /* Eval the body */
9803 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
9805 /* Delete any local procs */
9806 JimDeleteLocalProcs(interp);
9807 interp->localProcs = prevLocalProcs;
9809 /* Destroy the callframe */
9810 interp->numLevels--;
9811 interp->framePtr = interp->framePtr->parentCallFrame;
9812 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
9813 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
9815 else {
9816 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
9818 /* Handle the JIM_EVAL return code */
9819 while (retcode == JIM_EVAL) {
9820 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
9822 Jim_IncrRefCount(resultScriptObjPtr);
9823 /* Should be a list! */
9824 retcode = Jim_EvalObjList(interp, resultScriptObjPtr, filename, linenr);
9825 Jim_DecrRefCount(interp, resultScriptObjPtr);
9827 /* Handle the JIM_RETURN return code */
9828 if (retcode == JIM_RETURN) {
9829 if (--interp->returnLevel <= 0) {
9830 retcode = interp->returnCode;
9831 interp->returnCode = JIM_OK;
9832 interp->returnLevel = 0;
9835 else if (retcode == JIM_ERR) {
9836 interp->addStackTrace++;
9837 Jim_DecrRefCount(interp, interp->errorProc);
9838 interp->errorProc = procname;
9839 Jim_IncrRefCount(interp->errorProc);
9841 return retcode;
9844 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
9846 int retval;
9847 Jim_Obj *scriptObjPtr;
9849 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
9850 Jim_IncrRefCount(scriptObjPtr);
9853 if (filename) {
9854 Jim_Obj *prevScriptObj;
9856 JimSetSourceInfo(interp, scriptObjPtr, filename, lineno);
9858 prevScriptObj = interp->currentScriptObj;
9859 interp->currentScriptObj = scriptObjPtr;
9861 retval = Jim_EvalObj(interp, scriptObjPtr);
9863 interp->currentScriptObj = prevScriptObj;
9865 else {
9866 retval = Jim_EvalObj(interp, scriptObjPtr);
9868 Jim_DecrRefCount(interp, scriptObjPtr);
9869 return retval;
9872 int Jim_Eval(Jim_Interp *interp, const char *script)
9874 return Jim_Eval_Named(interp, script, NULL, 0);
9877 /* Execute script in the scope of the global level */
9878 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
9880 Jim_CallFrame *savedFramePtr;
9881 int retval;
9883 savedFramePtr = interp->framePtr;
9884 interp->framePtr = interp->topFramePtr;
9885 retval = Jim_Eval(interp, script);
9886 interp->framePtr = savedFramePtr;
9887 return retval;
9890 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
9892 Jim_CallFrame *savedFramePtr;
9893 int retval;
9895 savedFramePtr = interp->framePtr;
9896 interp->framePtr = interp->topFramePtr;
9897 retval = Jim_EvalObj(interp, scriptObjPtr);
9898 interp->framePtr = savedFramePtr;
9899 /* Try to report the error (if any) via the bgerror proc */
9900 if (retval != JIM_OK) {
9901 Jim_Obj *objv[2];
9903 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
9904 objv[1] = Jim_GetResult(interp);
9905 Jim_IncrRefCount(objv[0]);
9906 Jim_IncrRefCount(objv[1]);
9907 if (Jim_GetCommand(interp, objv[0], JIM_NONE) == NULL || Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
9908 /* Report the error to stderr. */
9909 fprintf(stderr, "Background error:" JIM_NL);
9910 Jim_PrintErrorMessage(interp);
9912 Jim_DecrRefCount(interp, objv[0]);
9913 Jim_DecrRefCount(interp, objv[1]);
9915 return retval;
9918 #include <sys/stat.h>
9920 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
9922 FILE *fp;
9923 char *buf;
9924 Jim_Obj *scriptObjPtr;
9925 Jim_Obj *prevScriptObj;
9926 Jim_Stack *prevLocalProcs;
9927 struct stat sb;
9928 int retcode;
9929 int readlen;
9930 char missing;
9932 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "r")) == NULL) {
9933 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
9934 return JIM_ERR;
9936 if (sb.st_size == 0) {
9937 fclose(fp);
9938 return JIM_OK;
9941 buf = Jim_Alloc(sb.st_size + 1);
9942 readlen = fread(buf, sb.st_size, 1, fp);
9943 fclose(fp);
9944 if (readlen != 1) {
9945 Jim_Free(buf);
9946 return JIM_ERR;
9948 buf[sb.st_size] = 0;
9950 if (!Jim_ScriptIsComplete(buf, sb.st_size, &missing)) {
9951 Jim_SetResultFormatted(interp, "missing %s in \"%s\"",
9952 missing == '{' ? "close-brace" : "\"", filename);
9953 Jim_Free(buf);
9954 return JIM_ERR;
9957 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, sb.st_size);
9958 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
9959 Jim_IncrRefCount(scriptObjPtr);
9961 prevScriptObj = interp->currentScriptObj;
9962 interp->currentScriptObj = scriptObjPtr;
9964 /* Install a new stack for local procs */
9965 prevLocalProcs = interp->localProcs;
9966 interp->localProcs = NULL;
9968 retcode = Jim_EvalObj(interp, scriptObjPtr);
9970 /* Delete any local procs */
9971 JimDeleteLocalProcs(interp);
9972 interp->localProcs = prevLocalProcs;
9974 /* Handle the JIM_RETURN return code */
9975 if (retcode == JIM_RETURN) {
9976 if (--interp->returnLevel <= 0) {
9977 retcode = interp->returnCode;
9978 interp->returnCode = JIM_OK;
9979 interp->returnLevel = 0;
9982 if (retcode == JIM_ERR) {
9983 /* EvalFile changes context, so add a stack frame here */
9984 interp->addStackTrace++;
9987 interp->currentScriptObj = prevScriptObj;
9989 Jim_DecrRefCount(interp, scriptObjPtr);
9991 return retcode;
9994 /* -----------------------------------------------------------------------------
9995 * Subst
9996 * ---------------------------------------------------------------------------*/
9997 static int JimParseSubstStr(struct JimParserCtx *pc)
9999 pc->tstart = pc->p;
10000 pc->tline = pc->linenr;
10001 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
10002 if (*pc->p == '\\' && pc->len > 1) {
10003 pc->p++;
10004 pc->len--;
10006 pc->p++;
10007 pc->len--;
10009 pc->tend = pc->p - 1;
10010 pc->tt = JIM_TT_ESC;
10011 return JIM_OK;
10014 static int JimParseSubst(struct JimParserCtx *pc, int flags)
10016 int retval;
10018 if (pc->len == 0) {
10019 pc->tstart = pc->tend = pc->p;
10020 pc->tline = pc->linenr;
10021 pc->tt = JIM_TT_EOL;
10022 pc->eof = 1;
10023 return JIM_OK;
10025 switch (*pc->p) {
10026 case '[':
10027 retval = JimParseCmd(pc);
10028 if (flags & JIM_SUBST_NOCMD) {
10029 pc->tstart--;
10030 pc->tend++;
10031 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
10033 return retval;
10034 break;
10035 case '$':
10036 if (JimParseVar(pc) == JIM_ERR) {
10037 pc->tstart = pc->tend = pc->p++;
10038 pc->len--;
10039 pc->tline = pc->linenr;
10040 pc->tt = JIM_TT_STR;
10042 else {
10043 if (flags & JIM_SUBST_NOVAR) {
10044 pc->tstart--;
10045 if (flags & JIM_SUBST_NOESC)
10046 pc->tt = JIM_TT_STR;
10047 else
10048 pc->tt = JIM_TT_ESC;
10049 if (*pc->tstart == '{') {
10050 pc->tstart--;
10051 if (*(pc->tend + 1))
10052 pc->tend++;
10056 break;
10057 default:
10058 retval = JimParseSubstStr(pc);
10059 if (flags & JIM_SUBST_NOESC)
10060 pc->tt = JIM_TT_STR;
10061 return retval;
10062 break;
10064 return JIM_OK;
10067 /* The subst object type reuses most of the data structures and functions
10068 * of the script object. Script's data structures are a bit more complex
10069 * for what is needed for [subst]itution tasks, but the reuse helps to
10070 * deal with a single data structure at the cost of some more memory
10071 * usage for substitutions. */
10072 static const Jim_ObjType substObjType = {
10073 "subst",
10074 FreeScriptInternalRep,
10075 DupScriptInternalRep,
10076 NULL,
10077 JIM_TYPE_REFERENCES,
10080 /* This method takes the string representation of an object
10081 * as a Tcl string where to perform [subst]itution, and generates
10082 * the pre-parsed internal representation. */
10083 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
10085 int scriptTextLen;
10086 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
10087 struct JimParserCtx parser;
10088 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
10089 ParseTokenList tokenlist;
10091 /* Initially parse the subst into tokens (in tokenlist) */
10092 ScriptTokenListInit(&tokenlist);
10094 JimParserInit(&parser, scriptText, scriptTextLen, 1);
10095 while (1) {
10096 JimParseSubst(&parser, flags);
10097 if (JimParserEof(&parser)) {
10098 /* Note that subst doesn't need the EOL token */
10099 break;
10101 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
10102 parser.tline);
10105 /* Create the "real" subst/script tokens from the initial token list */
10106 script->cmdStruct = NULL;
10107 script->csLen = 0;
10108 script->inUse = 1;
10109 script->substFlags = flags;
10110 script->fileName = NULL;
10111 #ifdef JIM_OPTIMIZATION
10112 SubstObjAddTokens(interp, script, &tokenlist);
10113 #else
10114 ScriptObjAddTokens(interp, script, &tokenlist);
10115 #endif
10117 /* No longer need the token list */
10118 ScriptTokenListFree(&tokenlist);
10120 #if 0
10121 int i;
10123 printf("==== Subst ====\n");
10124 for (i = 0; i < script->len; i++) {
10125 printf("[%2d] %s (%d)'%s'\n", i, tt_name(script->token[i].type),
10126 script->token[i].objPtr->length, script->token[i].objPtr->bytes);
10128 #endif
10130 /* Free the old internal rep and set the new one. */
10131 Jim_FreeIntRep(interp, objPtr);
10132 Jim_SetIntRepPtr(objPtr, script);
10133 objPtr->typePtr = &scriptObjType;
10134 return JIM_OK;
10137 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
10139 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
10141 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
10142 SetSubstFromAny(interp, objPtr, flags);
10143 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
10146 /* Performs commands,variables,blackslashes substitution,
10147 * storing the result object (with refcount 0) into
10148 * resObjPtrPtr. */
10149 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
10151 ScriptObj *script;
10152 ScriptToken *token;
10153 int i, len, retcode = JIM_OK;
10154 int rc;
10155 Jim_Obj *resObjPtr, *savedResultObjPtr;
10157 script = Jim_GetSubst(interp, substObjPtr, flags);
10158 #ifdef JIM_OPTIMIZATION
10159 /* Fast path for a very common case with array-alike syntax,
10160 * that's: $foo($bar) */
10161 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
10162 Jim_Obj *varObjPtr = script->token[0].objPtr;
10164 Jim_IncrRefCount(varObjPtr);
10165 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
10166 if (resObjPtr == NULL) {
10167 Jim_DecrRefCount(interp, varObjPtr);
10168 return JIM_ERR;
10170 Jim_DecrRefCount(interp, varObjPtr);
10171 *resObjPtrPtr = resObjPtr;
10172 return JIM_OK;
10174 #endif
10176 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
10177 /* In order to preserve the internal rep, we increment the
10178 * inUse field of the script internal rep structure. */
10179 script->inUse++;
10181 token = script->token;
10182 len = script->len;
10184 /* Save the interp old result, to set it again before
10185 * to return. */
10186 savedResultObjPtr = interp->result;
10187 Jim_IncrRefCount(savedResultObjPtr);
10189 /* Perform the substitution. Starts with an empty object
10190 * and adds every token (performing the appropriate
10191 * var/command/escape substitution). */
10192 resObjPtr = Jim_NewStringObj(interp, "", 0);
10193 for (i = 0; i < len; i++) {
10194 Jim_Obj *objPtr;
10196 switch (token[i].type) {
10197 case JIM_TT_STR:
10198 case JIM_TT_ESC:
10199 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
10200 break;
10201 case JIM_TT_VAR:
10202 case JIM_TT_DICTSUGAR:
10203 if (token[i].type == JIM_TT_VAR) {
10204 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10206 else {
10207 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
10209 if (objPtr == NULL)
10210 goto err;
10211 Jim_IncrRefCount(objPtr);
10212 Jim_AppendObj(interp, resObjPtr, objPtr);
10213 Jim_DecrRefCount(interp, objPtr);
10214 break;
10215 case JIM_TT_CMD:
10216 rc = Jim_EvalObj(interp, token[i].objPtr);
10217 if (rc == JIM_BREAK) {
10218 /* Stop substituting */
10219 goto ok;
10221 else if (rc == JIM_CONTINUE) {
10222 /* just skip this one */
10224 else if (rc == JIM_OK || rc == JIM_RETURN) {
10225 Jim_AppendObj(interp, resObjPtr, interp->result);
10227 else {
10228 goto err;
10230 break;
10231 default:
10232 Jim_Panic(interp,
10233 "default token type (%d) reached " "in Jim_SubstObj().", token[i].type);
10234 break;
10238 if (retcode == JIM_OK)
10239 Jim_SetResult(interp, savedResultObjPtr);
10240 Jim_DecrRefCount(interp, savedResultObjPtr);
10241 /* Note that we don't have to decrement inUse, because the
10242 * following code transfers our use of the reference again to
10243 * the script object. */
10244 Jim_FreeIntRep(interp, substObjPtr);
10245 substObjPtr->typePtr = &scriptObjType;
10246 Jim_SetIntRepPtr(substObjPtr, script);
10247 Jim_DecrRefCount(interp, substObjPtr);
10248 *resObjPtrPtr = resObjPtr;
10249 return retcode;
10250 err:
10251 Jim_FreeNewObj(interp, resObjPtr);
10252 retcode = JIM_ERR;
10253 goto ok;
10256 /* -----------------------------------------------------------------------------
10257 * Core commands utility functions
10258 * ---------------------------------------------------------------------------*/
10259 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
10261 int i;
10262 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
10264 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
10265 for (i = 0; i < argc; i++) {
10266 Jim_AppendObj(interp, objPtr, argv[i]);
10267 if (!(i + 1 == argc && msg[0] == '\0'))
10268 Jim_AppendString(interp, objPtr, " ", 1);
10270 Jim_AppendString(interp, objPtr, msg, -1);
10271 Jim_AppendString(interp, objPtr, "\"", 1);
10272 Jim_SetResult(interp, objPtr);
10275 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int procs_only)
10277 Jim_HashTableIterator *htiter;
10278 Jim_HashEntry *he;
10279 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10280 const char *pattern;
10281 int patternLen = 0;
10283 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
10284 htiter = Jim_GetHashTableIterator(&interp->commands);
10285 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10286 Jim_Cmd *cmdPtr = he->val;
10288 if (procs_only && cmdPtr->cmdProc != NULL) {
10289 continue;
10291 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
10292 strlen((const char *)he->key), 0))
10293 continue;
10294 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
10296 Jim_FreeHashTableIterator(htiter);
10297 return listObjPtr;
10300 /* Keep this in order */
10301 #define JIM_VARLIST_GLOBALS 0
10302 #define JIM_VARLIST_LOCALS 1
10303 #define JIM_VARLIST_VARS 2
10305 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
10307 Jim_HashTableIterator *htiter;
10308 Jim_HashEntry *he;
10309 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
10310 const char *pattern;
10311 int patternLen = 0;
10313 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
10314 if (mode == JIM_VARLIST_GLOBALS) {
10315 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
10317 else {
10318 /* For [info locals], if we are at top level an emtpy list
10319 * is returned. I don't agree, but we aim at compatibility (SS) */
10320 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr)
10321 return listObjPtr;
10322 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
10324 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
10325 Jim_Var *varPtr = (Jim_Var *)he->val;
10327 if (mode == JIM_VARLIST_LOCALS) {
10328 if (varPtr->linkFramePtr != NULL)
10329 continue;
10331 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
10332 strlen((const char *)he->key), 0))
10333 continue;
10334 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
10336 Jim_FreeHashTableIterator(htiter);
10337 return listObjPtr;
10340 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
10341 Jim_Obj **objPtrPtr, int info_level_cmd)
10343 Jim_CallFrame *targetCallFrame;
10345 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
10346 != JIM_OK)
10347 return JIM_ERR;
10348 /* No proc call at toplevel callframe */
10349 if (targetCallFrame == interp->topFramePtr) {
10350 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
10351 return JIM_ERR;
10353 if (info_level_cmd) {
10354 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
10356 else {
10357 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
10359 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
10360 Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp,
10361 targetCallFrame->filename ? : "", -1));
10362 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
10363 *objPtrPtr = listObj;
10365 return JIM_OK;
10368 /* -----------------------------------------------------------------------------
10369 * Core commands
10370 * ---------------------------------------------------------------------------*/
10372 /* fake [puts] -- not the real puts, just for debugging. */
10373 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10375 const char *str;
10376 int nonewline = 0;
10378 if (argc != 2 && argc != 3) {
10379 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
10380 return JIM_ERR;
10382 if (argc == 3) {
10383 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
10384 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
10385 return JIM_OK;
10387 else {
10388 nonewline = 1;
10389 argv++;
10392 str = Jim_GetString(argv[1], 0);
10393 printf("%s%s", str, nonewline ? "" : "\n");
10394 return JIM_OK;
10397 /* Helper for [+] and [*] */
10398 static int Jim_AddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10400 jim_wide wideValue, res;
10401 double doubleValue, doubleRes;
10402 int i;
10404 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
10406 for (i = 1; i < argc; i++) {
10407 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
10408 goto trydouble;
10409 if (op == JIM_EXPROP_ADD)
10410 res += wideValue;
10411 else
10412 res *= wideValue;
10414 Jim_SetResultInt(interp, res);
10415 return JIM_OK;
10416 trydouble:
10417 doubleRes = (double)res;
10418 for (; i < argc; i++) {
10419 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10420 return JIM_ERR;
10421 if (op == JIM_EXPROP_ADD)
10422 doubleRes += doubleValue;
10423 else
10424 doubleRes *= doubleValue;
10426 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10427 return JIM_OK;
10430 /* Helper for [-] and [/] */
10431 static int Jim_SubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
10433 jim_wide wideValue, res = 0;
10434 double doubleValue, doubleRes = 0;
10435 int i = 2;
10437 if (argc < 2) {
10438 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
10439 return JIM_ERR;
10441 else if (argc == 2) {
10442 /* The arity = 2 case is different. For [- x] returns -x,
10443 * while [/ x] returns 1/x. */
10444 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
10445 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
10446 return JIM_ERR;
10448 else {
10449 if (op == JIM_EXPROP_SUB)
10450 doubleRes = -doubleValue;
10451 else
10452 doubleRes = 1.0 / doubleValue;
10453 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10454 return JIM_OK;
10457 if (op == JIM_EXPROP_SUB) {
10458 res = -wideValue;
10459 Jim_SetResultInt(interp, res);
10461 else {
10462 doubleRes = 1.0 / wideValue;
10463 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10465 return JIM_OK;
10467 else {
10468 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
10469 if (Jim_GetDouble(interp, argv[1], &doubleRes)
10470 != JIM_OK) {
10471 return JIM_ERR;
10473 else {
10474 goto trydouble;
10478 for (i = 2; i < argc; i++) {
10479 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
10480 doubleRes = (double)res;
10481 goto trydouble;
10483 if (op == JIM_EXPROP_SUB)
10484 res -= wideValue;
10485 else
10486 res /= wideValue;
10488 Jim_SetResultInt(interp, res);
10489 return JIM_OK;
10490 trydouble:
10491 for (; i < argc; i++) {
10492 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
10493 return JIM_ERR;
10494 if (op == JIM_EXPROP_SUB)
10495 doubleRes -= doubleValue;
10496 else
10497 doubleRes /= doubleValue;
10499 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
10500 return JIM_OK;
10504 /* [+] */
10505 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10507 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
10510 /* [*] */
10511 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10513 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
10516 /* [-] */
10517 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10519 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
10522 /* [/] */
10523 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10525 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
10528 /* [set] */
10529 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10531 if (argc != 2 && argc != 3) {
10532 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
10533 return JIM_ERR;
10535 if (argc == 2) {
10536 Jim_Obj *objPtr;
10538 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10539 if (!objPtr)
10540 return JIM_ERR;
10541 Jim_SetResult(interp, objPtr);
10542 return JIM_OK;
10544 /* argc == 3 case. */
10545 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10546 return JIM_ERR;
10547 Jim_SetResult(interp, argv[2]);
10548 return JIM_OK;
10551 /* [unset]
10553 * unset ?-nocomplain? ?--? ?varName ...?
10555 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10557 int i = 1;
10558 int complain = 1;
10560 while (i < argc) {
10561 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
10562 i++;
10563 break;
10565 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
10566 complain = 0;
10567 i++;
10568 continue;
10570 break;
10573 while (i < argc) {
10574 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
10575 && complain) {
10576 return JIM_ERR;
10578 i++;
10580 return JIM_OK;
10583 /* [incr] */
10584 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10586 jim_wide wideValue, increment = 1;
10587 Jim_Obj *intObjPtr;
10589 if (argc != 2 && argc != 3) {
10590 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10591 return JIM_ERR;
10593 if (argc == 3) {
10594 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10595 return JIM_ERR;
10597 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10598 if (!intObjPtr) {
10599 /* Set missing variable to 0 */
10600 wideValue = 0;
10602 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10603 return JIM_ERR;
10605 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10606 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10607 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10608 Jim_FreeNewObj(interp, intObjPtr);
10609 return JIM_ERR;
10612 else {
10613 Jim_SetWide(interp, intObjPtr, wideValue + increment);
10614 /* The following step is required in order to invalidate the
10615 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10616 if (argv[1]->typePtr != &variableObjType) {
10617 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10618 return JIM_ERR;
10622 Jim_SetResult(interp, intObjPtr);
10623 return JIM_OK;
10626 /* [while] */
10627 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10629 if (argc != 3) {
10630 Jim_WrongNumArgs(interp, 1, argv, "condition body");
10631 return JIM_ERR;
10634 /* The general purpose implementation of while starts here */
10635 while (1) {
10636 int boolean, retval;
10638 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
10639 return retval;
10640 if (!boolean)
10641 break;
10643 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
10644 switch (retval) {
10645 case JIM_BREAK:
10646 goto out;
10647 break;
10648 case JIM_CONTINUE:
10649 continue;
10650 break;
10651 default:
10652 return retval;
10656 out:
10657 Jim_SetEmptyResult(interp);
10658 return JIM_OK;
10661 /* [for] */
10662 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10664 int retval;
10665 int boolean = 1;
10666 Jim_Obj *varNamePtr = NULL;
10667 Jim_Obj *stopVarNamePtr = NULL;
10669 if (argc != 5) {
10670 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
10671 return JIM_ERR;
10674 /* Do the initialisation */
10675 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
10676 return retval;
10679 /* And do the first test now. Better for optimisation
10680 * if we can do next/test at the bottom of the loop
10682 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
10684 /* Ready to do the body as follows:
10685 * while (1) {
10686 * body // check retcode
10687 * next // check retcode
10688 * test // check retcode/test bool
10692 #ifdef JIM_OPTIMIZATION
10693 /* Check if the for is on the form:
10694 * for ... {$i < CONST} {incr i}
10695 * for ... {$i < $j} {incr i}
10697 if (retval == JIM_OK && boolean) {
10698 ScriptObj *incrScript;
10699 ExprByteCode *expr;
10700 jim_wide stop, currentVal;
10701 unsigned jim_wide procEpoch;
10702 Jim_Obj *objPtr;
10703 int cmpOffset;
10705 /* Do it only if there aren't shared arguments */
10706 expr = Jim_GetExpression(interp, argv[2]);
10707 incrScript = Jim_GetScript(interp, argv[3]);
10709 /* Ensure proper lengths to start */
10710 if (incrScript->len != 4 || !expr || expr->len != 3) {
10711 goto evalstart;
10713 /* Ensure proper token types. */
10714 if (incrScript->token[2].type != JIM_TT_ESC ||
10715 expr->token[0].type != JIM_TT_VAR ||
10716 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
10717 goto evalstart;
10720 if (expr->token[2].type == JIM_EXPROP_LT) {
10721 cmpOffset = 0;
10723 else if (expr->token[2].type == JIM_EXPROP_LTE) {
10724 cmpOffset = 1;
10726 else {
10727 goto evalstart;
10730 /* Update command must be incr */
10731 if (!Jim_CompareStringImmediate(interp, incrScript->token[0].objPtr, "incr")) {
10732 goto evalstart;
10735 /* incr, expression must be about the same variable */
10736 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr, 0)) {
10737 goto evalstart;
10740 /* Get the stop condition (must be a variable or integer) */
10741 if (expr->token[1].type == JIM_TT_EXPR_INT) {
10742 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
10743 goto evalstart;
10746 else {
10747 stopVarNamePtr = expr->token[1].objPtr;
10748 Jim_IncrRefCount(stopVarNamePtr);
10749 /* Keep the compiler happy */
10750 stop = 0;
10753 /* Initialization */
10754 procEpoch = interp->procEpoch;
10755 varNamePtr = expr->token[0].objPtr;
10756 Jim_IncrRefCount(varNamePtr);
10758 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10759 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
10760 goto testcond;
10763 /* --- OPTIMIZED FOR --- */
10764 while (retval == JIM_OK) {
10765 /* === Check condition === */
10766 /* Note that currentVal is already set here */
10768 /* Immediate or Variable? get the 'stop' value if the latter. */
10769 if (stopVarNamePtr) {
10770 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10771 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
10772 goto testcond;
10776 if (currentVal >= stop + cmpOffset) {
10777 break;
10780 /* Eval body */
10781 retval = Jim_EvalObj(interp, argv[4]);
10782 if (retval == JIM_OK || retval == JIM_CONTINUE) {
10783 retval = JIM_OK;
10784 /* If there was a change in procedures/command continue
10785 * with the usual [for] command implementation */
10786 if (procEpoch != interp->procEpoch) {
10787 goto evalnext;
10790 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10792 /* Increment */
10793 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10794 currentVal = ++objPtr->internalRep.wideValue;
10795 Jim_InvalidateStringRep(objPtr);
10797 else {
10798 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
10799 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
10800 ++currentVal)) != JIM_OK) {
10801 goto evalnext;
10806 goto out;
10808 evalstart:
10809 #endif
10811 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
10812 /* Body */
10813 retval = Jim_EvalObj(interp, argv[4]);
10815 if (retval == JIM_OK || retval == JIM_CONTINUE) {
10816 /* increment */
10817 evalnext:
10818 retval = Jim_EvalObj(interp, argv[3]);
10819 if (retval == JIM_OK || retval == JIM_CONTINUE) {
10820 /* test */
10821 testcond:
10822 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
10826 out:
10827 if (stopVarNamePtr) {
10828 Jim_DecrRefCount(interp, stopVarNamePtr);
10830 if (varNamePtr) {
10831 Jim_DecrRefCount(interp, varNamePtr);
10834 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
10835 Jim_SetEmptyResult(interp);
10836 return JIM_OK;
10839 return retval;
10842 /* foreach + lmap implementation. */
10843 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
10845 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10846 int nbrOfLoops = 0;
10847 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10849 if (argc < 4 || argc % 2 != 0) {
10850 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10851 return JIM_ERR;
10853 if (doMap) {
10854 mapRes = Jim_NewListObj(interp, NULL, 0);
10855 Jim_IncrRefCount(mapRes);
10857 emptyStr = Jim_NewEmptyStringObj(interp);
10858 Jim_IncrRefCount(emptyStr);
10859 script = argv[argc - 1]; /* Last argument is a script */
10860 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10861 listsIdx = (int *)Jim_Alloc(nbrOfLists * sizeof(int));
10862 listsEnd = (int *)Jim_Alloc(nbrOfLists * 2 * sizeof(int));
10863 /* Initialize iterators and remember max nbr elements each list */
10864 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10865 /* Remember lengths of all lists and calculate how much rounds to loop */
10866 for (i = 0; i < nbrOfLists * 2; i += 2) {
10867 div_t cnt;
10868 int count;
10870 listsEnd[i] = Jim_ListLength(interp, argv[i + 1]);
10871 listsEnd[i + 1] = Jim_ListLength(interp, argv[i + 2]);
10872 if (listsEnd[i] == 0) {
10873 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10874 goto err;
10876 cnt = div(listsEnd[i + 1], listsEnd[i]);
10877 count = cnt.quot + (cnt.rem ? 1 : 0);
10878 if (count > nbrOfLoops)
10879 nbrOfLoops = count;
10881 for (; nbrOfLoops-- > 0;) {
10882 for (i = 0; i < nbrOfLists; ++i) {
10883 int varIdx = 0, var = i * 2;
10885 while (varIdx < listsEnd[var]) {
10886 Jim_Obj *varName, *ele;
10887 int lst = i * 2 + 1;
10889 if (Jim_ListIndex(interp, argv[var + 1], varIdx, &varName, JIM_ERRMSG)
10890 != JIM_OK)
10891 goto err;
10892 if (listsIdx[i] < listsEnd[lst]) {
10893 if (Jim_ListIndex(interp, argv[lst + 1], listsIdx[i], &ele, JIM_ERRMSG)
10894 != JIM_OK)
10895 goto err;
10896 /* Avoid shimmering */
10897 Jim_IncrRefCount(ele);
10898 result = Jim_SetVariable(interp, varName, ele);
10899 Jim_DecrRefCount(interp, ele);
10900 if (result == JIM_OK) {
10901 ++listsIdx[i]; /* Remember next iterator of current list */
10902 ++varIdx; /* Next variable */
10903 continue;
10906 else if (Jim_SetVariable(interp, varName, emptyStr) == JIM_OK) {
10907 ++varIdx; /* Next variable */
10908 continue;
10910 goto err;
10913 switch (result = Jim_EvalObj(interp, script)) {
10914 case JIM_OK:
10915 if (doMap)
10916 Jim_ListAppendElement(interp, mapRes, interp->result);
10917 break;
10918 case JIM_CONTINUE:
10919 break;
10920 case JIM_BREAK:
10921 goto out;
10922 break;
10923 default:
10924 goto err;
10927 out:
10928 result = JIM_OK;
10929 if (doMap)
10930 Jim_SetResult(interp, mapRes);
10931 else
10932 Jim_SetEmptyResult(interp);
10933 err:
10934 if (doMap)
10935 Jim_DecrRefCount(interp, mapRes);
10936 Jim_DecrRefCount(interp, emptyStr);
10937 Jim_Free(listsIdx);
10938 Jim_Free(listsEnd);
10939 return result;
10942 /* [foreach] */
10943 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10945 return JimForeachMapHelper(interp, argc, argv, 0);
10948 /* [lmap] */
10949 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10951 return JimForeachMapHelper(interp, argc, argv, 1);
10954 /* [if] */
10955 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10957 int boolean, retval, current = 1, falsebody = 0;
10959 if (argc >= 3) {
10960 while (1) {
10961 /* Far not enough arguments given! */
10962 if (current >= argc)
10963 goto err;
10964 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
10965 != JIM_OK)
10966 return retval;
10967 /* There lacks something, isn't it? */
10968 if (current >= argc)
10969 goto err;
10970 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
10971 current++;
10972 /* Tsk tsk, no then-clause? */
10973 if (current >= argc)
10974 goto err;
10975 if (boolean)
10976 return Jim_EvalObj(interp, argv[current]);
10977 /* Ok: no else-clause follows */
10978 if (++current >= argc) {
10979 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10980 return JIM_OK;
10982 falsebody = current++;
10983 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
10984 /* IIICKS - else-clause isn't last cmd? */
10985 if (current != argc - 1)
10986 goto err;
10987 return Jim_EvalObj(interp, argv[current]);
10989 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
10990 /* Ok: elseif follows meaning all the stuff
10991 * again (how boring...) */
10992 continue;
10993 /* OOPS - else-clause is not last cmd? */
10994 else if (falsebody != argc - 1)
10995 goto err;
10996 return Jim_EvalObj(interp, argv[falsebody]);
10998 return JIM_OK;
11000 err:
11001 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
11002 return JIM_ERR;
11006 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
11007 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
11008 Jim_Obj *stringObj, int nocase)
11010 Jim_Obj *parms[4];
11011 int argc = 0;
11012 long eq;
11013 int rc;
11015 parms[argc++] = commandObj;
11016 if (nocase) {
11017 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
11019 parms[argc++] = patternObj;
11020 parms[argc++] = stringObj;
11022 rc = Jim_EvalObjVector(interp, argc, parms);
11024 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
11025 eq = -rc;
11028 return eq;
11031 enum
11032 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
11034 /* [switch] */
11035 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11037 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
11038 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
11039 Jim_Obj *script = 0;
11041 if (argc < 3) {
11042 wrongnumargs:
11043 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
11044 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
11045 return JIM_ERR;
11047 for (opt = 1; opt < argc; ++opt) {
11048 const char *option = Jim_GetString(argv[opt], 0);
11050 if (*option != '-')
11051 break;
11052 else if (strncmp(option, "--", 2) == 0) {
11053 ++opt;
11054 break;
11056 else if (strncmp(option, "-exact", 2) == 0)
11057 matchOpt = SWITCH_EXACT;
11058 else if (strncmp(option, "-glob", 2) == 0)
11059 matchOpt = SWITCH_GLOB;
11060 else if (strncmp(option, "-regexp", 2) == 0)
11061 matchOpt = SWITCH_RE;
11062 else if (strncmp(option, "-command", 2) == 0) {
11063 matchOpt = SWITCH_CMD;
11064 if ((argc - opt) < 2)
11065 goto wrongnumargs;
11066 command = argv[++opt];
11068 else {
11069 Jim_SetResultFormatted(interp,
11070 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
11071 argv[opt]);
11072 return JIM_ERR;
11074 if ((argc - opt) < 2)
11075 goto wrongnumargs;
11077 strObj = argv[opt++];
11078 patCount = argc - opt;
11079 if (patCount == 1) {
11080 Jim_Obj **vector;
11082 JimListGetElements(interp, argv[opt], &patCount, &vector);
11083 caseList = vector;
11085 else
11086 caseList = &argv[opt];
11087 if (patCount == 0 || patCount % 2 != 0)
11088 goto wrongnumargs;
11089 for (i = 0; script == 0 && i < patCount; i += 2) {
11090 Jim_Obj *patObj = caseList[i];
11092 if (!Jim_CompareStringImmediate(interp, patObj, "default")
11093 || i < (patCount - 2)) {
11094 switch (matchOpt) {
11095 case SWITCH_EXACT:
11096 if (Jim_StringEqObj(strObj, patObj, 0))
11097 script = caseList[i + 1];
11098 break;
11099 case SWITCH_GLOB:
11100 if (Jim_StringMatchObj(patObj, strObj, 0))
11101 script = caseList[i + 1];
11102 break;
11103 case SWITCH_RE:
11104 command = Jim_NewStringObj(interp, "regexp", -1);
11105 /* Fall thru intentionally */
11106 case SWITCH_CMD:{
11107 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
11109 /* After the execution of a command we need to
11110 * make sure to reconvert the object into a list
11111 * again. Only for the single-list style [switch]. */
11112 if (argc - opt == 1) {
11113 Jim_Obj **vector;
11115 JimListGetElements(interp, argv[opt], &patCount, &vector);
11116 caseList = vector;
11118 /* command is here already decref'd */
11119 if (rc < 0) {
11120 return -rc;
11122 if (rc)
11123 script = caseList[i + 1];
11124 break;
11128 else {
11129 script = caseList[i + 1];
11132 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
11133 script = caseList[i + 1];
11134 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
11135 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
11136 return JIM_ERR;
11138 Jim_SetEmptyResult(interp);
11139 if (script) {
11140 return Jim_EvalObj(interp, script);
11142 return JIM_OK;
11145 /* [list] */
11146 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11148 Jim_Obj *listObjPtr;
11150 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
11151 Jim_SetResult(interp, listObjPtr);
11152 return JIM_OK;
11155 /* [lindex] */
11156 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11158 Jim_Obj *objPtr, *listObjPtr;
11159 int i;
11160 int index;
11162 if (argc < 3) {
11163 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
11164 return JIM_ERR;
11166 objPtr = argv[1];
11167 Jim_IncrRefCount(objPtr);
11168 for (i = 2; i < argc; i++) {
11169 listObjPtr = objPtr;
11170 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
11171 Jim_DecrRefCount(interp, listObjPtr);
11172 return JIM_ERR;
11174 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr, JIM_NONE) != JIM_OK) {
11175 /* Returns an empty object if the index
11176 * is out of range. */
11177 Jim_DecrRefCount(interp, listObjPtr);
11178 Jim_SetEmptyResult(interp);
11179 return JIM_OK;
11181 Jim_IncrRefCount(objPtr);
11182 Jim_DecrRefCount(interp, listObjPtr);
11184 Jim_SetResult(interp, objPtr);
11185 Jim_DecrRefCount(interp, objPtr);
11186 return JIM_OK;
11189 /* [llength] */
11190 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11192 if (argc != 2) {
11193 Jim_WrongNumArgs(interp, 1, argv, "list");
11194 return JIM_ERR;
11196 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
11197 return JIM_OK;
11200 /* [lsearch] */
11201 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11203 static const char *options[] = {
11204 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
11205 NULL
11207 enum
11208 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
11209 OPT_COMMAND };
11210 int i;
11211 int opt_bool = 0;
11212 int opt_not = 0;
11213 int opt_nocase = 0;
11214 int opt_all = 0;
11215 int opt_inline = 0;
11216 int opt_match = OPT_EXACT;
11217 int listlen;
11218 int rc = JIM_OK;
11219 Jim_Obj *listObjPtr = NULL;
11220 Jim_Obj *commandObj = NULL;
11222 if (argc < 3) {
11223 wrongargs:
11224 Jim_WrongNumArgs(interp, 1, argv,
11225 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
11226 return JIM_ERR;
11229 for (i = 1; i < argc - 2; i++) {
11230 int option;
11232 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
11233 return JIM_ERR;
11235 switch (option) {
11236 case OPT_BOOL:
11237 opt_bool = 1;
11238 opt_inline = 0;
11239 break;
11240 case OPT_NOT:
11241 opt_not = 1;
11242 break;
11243 case OPT_NOCASE:
11244 opt_nocase = 1;
11245 break;
11246 case OPT_INLINE:
11247 opt_inline = 1;
11248 opt_bool = 0;
11249 break;
11250 case OPT_ALL:
11251 opt_all = 1;
11252 break;
11253 case OPT_COMMAND:
11254 if (i >= argc - 2) {
11255 goto wrongargs;
11257 commandObj = argv[++i];
11258 /* fallthru */
11259 case OPT_EXACT:
11260 case OPT_GLOB:
11261 case OPT_REGEXP:
11262 opt_match = option;
11263 break;
11267 argv += i;
11269 if (opt_all) {
11270 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11272 if (opt_match == OPT_REGEXP) {
11273 commandObj = Jim_NewStringObj(interp, "regexp", -1);
11275 if (commandObj) {
11276 Jim_IncrRefCount(commandObj);
11279 listlen = Jim_ListLength(interp, argv[0]);
11280 for (i = 0; i < listlen; i++) {
11281 Jim_Obj *objPtr;
11282 int eq = 0;
11284 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
11285 switch (opt_match) {
11286 case OPT_EXACT:
11287 eq = Jim_StringEqObj(objPtr, argv[1], opt_nocase);
11288 break;
11290 case OPT_GLOB:
11291 eq = Jim_StringMatchObj(argv[1], objPtr, opt_nocase);
11292 break;
11294 case OPT_REGEXP:
11295 case OPT_COMMAND:
11296 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
11297 if (eq < 0) {
11298 if (listObjPtr) {
11299 Jim_FreeNewObj(interp, listObjPtr);
11301 rc = JIM_ERR;
11302 goto done;
11304 break;
11307 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
11308 if (!eq && opt_bool && opt_not && !opt_all) {
11309 continue;
11312 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
11313 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
11314 Jim_Obj *resultObj;
11316 if (opt_bool) {
11317 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
11319 else if (!opt_inline) {
11320 resultObj = Jim_NewIntObj(interp, i);
11322 else {
11323 resultObj = objPtr;
11326 if (opt_all) {
11327 Jim_ListAppendElement(interp, listObjPtr, resultObj);
11329 else {
11330 Jim_SetResult(interp, resultObj);
11331 goto done;
11336 if (opt_all) {
11337 Jim_SetResult(interp, listObjPtr);
11339 else {
11340 /* No match */
11341 if (opt_bool) {
11342 Jim_SetResultBool(interp, opt_not);
11344 else if (!opt_inline) {
11345 Jim_SetResultInt(interp, -1);
11349 done:
11350 if (commandObj) {
11351 Jim_DecrRefCount(interp, commandObj);
11353 return rc;
11356 /* [lappend] */
11357 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11359 Jim_Obj *listObjPtr;
11360 int shared, i;
11362 if (argc < 2) {
11363 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
11364 return JIM_ERR;
11366 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
11367 if (!listObjPtr) {
11368 /* Create the list if it does not exists */
11369 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11370 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11371 Jim_FreeNewObj(interp, listObjPtr);
11372 return JIM_ERR;
11375 shared = Jim_IsShared(listObjPtr);
11376 if (shared)
11377 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
11378 for (i = 2; i < argc; i++)
11379 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
11380 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
11381 if (shared)
11382 Jim_FreeNewObj(interp, listObjPtr);
11383 return JIM_ERR;
11385 Jim_SetResult(interp, listObjPtr);
11386 return JIM_OK;
11389 /* [linsert] */
11390 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11392 int index, len;
11393 Jim_Obj *listPtr;
11395 if (argc < 4) {
11396 Jim_WrongNumArgs(interp, 1, argv, "list index element " "?element ...?");
11397 return JIM_ERR;
11399 listPtr = argv[1];
11400 if (Jim_IsShared(listPtr))
11401 listPtr = Jim_DuplicateObj(interp, listPtr);
11402 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
11403 goto err;
11404 len = Jim_ListLength(interp, listPtr);
11405 if (index >= len)
11406 index = len;
11407 else if (index < 0)
11408 index = len + index + 1;
11409 Jim_ListInsertElements(interp, listPtr, index, argc - 3, &argv[3]);
11410 Jim_SetResult(interp, listPtr);
11411 return JIM_OK;
11412 err:
11413 if (listPtr != argv[1]) {
11414 Jim_FreeNewObj(interp, listPtr);
11416 return JIM_ERR;
11419 /* [lreplace] */
11420 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11422 int first, last, len, rangeLen;
11423 Jim_Obj *listObj;
11424 Jim_Obj *newListObj;
11425 int i;
11426 int shared;
11428 if (argc < 4) {
11429 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element element ...?");
11430 return JIM_ERR;
11432 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
11433 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
11434 return JIM_ERR;
11437 listObj = argv[1];
11438 len = Jim_ListLength(interp, listObj);
11440 first = JimRelToAbsIndex(len, first);
11441 last = JimRelToAbsIndex(len, last);
11442 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
11444 /* Now construct a new list which consists of:
11445 * <elements before first> <supplied elements> <elements after last>
11448 /* Check to see if trying to replace past the end of the list */
11449 if (first < len) {
11450 /* OK. Not past the end */
11452 else if (len == 0) {
11453 /* Special for empty list, adjust first to 0 */
11454 first = 0;
11456 else {
11457 Jim_SetResultString(interp, "list doesn't contain element ", -1);
11458 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
11459 return JIM_ERR;
11462 newListObj = Jim_NewListObj(interp, NULL, 0);
11464 shared = Jim_IsShared(listObj);
11465 if (shared) {
11466 listObj = Jim_DuplicateObj(interp, listObj);
11469 /* Add the first set of elements */
11470 for (i = 0; i < first; i++) {
11471 Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
11474 /* Add supplied elements */
11475 for (i = 4; i < argc; i++) {
11476 Jim_ListAppendElement(interp, newListObj, argv[i]);
11479 /* Add the remaining elements */
11480 for (i = first + rangeLen; i < len; i++) {
11481 Jim_ListAppendElement(interp, newListObj, listObj->internalRep.listValue.ele[i]);
11483 Jim_SetResult(interp, newListObj);
11484 if (shared) {
11485 Jim_FreeNewObj(interp, listObj);
11487 return JIM_OK;
11490 /* [lset] */
11491 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11493 if (argc < 3) {
11494 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
11495 return JIM_ERR;
11497 else if (argc == 3) {
11498 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11499 return JIM_ERR;
11500 Jim_SetResult(interp, argv[2]);
11501 return JIM_OK;
11503 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
11504 == JIM_ERR)
11505 return JIM_ERR;
11506 return JIM_OK;
11509 /* [lsort] */
11510 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
11512 const char *options[] = {
11513 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", NULL
11515 enum
11516 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER };
11517 Jim_Obj *resObj;
11518 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
11519 int lsort_order = 1;
11520 Jim_Obj *lsort_command = NULL;
11521 int retCode;
11523 if (argc < 2) {
11524 wrongargs:
11525 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
11526 return JIM_ERR;
11528 for (i = 1; i < (argc - 1); i++) {
11529 int option;
11531 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG)
11532 != JIM_OK)
11533 return JIM_ERR;
11534 switch (option) {
11535 case OPT_ASCII:
11536 lsortType = JIM_LSORT_ASCII;
11537 break;
11538 case OPT_NOCASE:
11539 lsortType = JIM_LSORT_NOCASE;
11540 break;
11541 case OPT_INTEGER:
11542 lsortType = JIM_LSORT_INTEGER;
11543 break;
11544 case OPT_INCREASING:
11545 lsort_order = 1;
11546 break;
11547 case OPT_DECREASING:
11548 lsort_order = -1;
11549 break;
11550 case OPT_COMMAND:
11551 if (i >= (argc - 2)) {
11552 goto wrongargs;
11554 lsortType = JIM_LSORT_COMMAND;
11555 lsort_command = argv[i + 1];
11556 i++;
11557 break;
11560 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
11561 retCode = ListSortElements(interp, resObj, lsortType, lsort_order, lsort_command);
11562 if (retCode == JIM_OK) {
11563 Jim_SetResult(interp, resObj);
11565 else {
11566 Jim_FreeNewObj(interp, resObj);
11568 return retCode;
11571 /* [append] */
11572 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11574 Jim_Obj *stringObjPtr;
11575 int shared, i;
11577 if (argc < 2) {
11578 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
11579 return JIM_ERR;
11581 if (argc == 2) {
11582 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11583 if (!stringObjPtr)
11584 return JIM_ERR;
11586 else {
11587 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
11588 if (!stringObjPtr) {
11589 /* Create the string if it does not exists */
11590 stringObjPtr = Jim_NewEmptyStringObj(interp);
11591 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
11592 != JIM_OK) {
11593 Jim_FreeNewObj(interp, stringObjPtr);
11594 return JIM_ERR;
11598 shared = Jim_IsShared(stringObjPtr);
11599 if (shared)
11600 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
11601 for (i = 2; i < argc; i++)
11602 Jim_AppendObj(interp, stringObjPtr, argv[i]);
11603 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
11604 if (shared)
11605 Jim_FreeNewObj(interp, stringObjPtr);
11606 return JIM_ERR;
11608 Jim_SetResult(interp, stringObjPtr);
11609 return JIM_OK;
11612 /* [debug] */
11613 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11615 const char *options[] = {
11616 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
11617 "exprbc",
11618 NULL
11620 enum
11622 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
11623 OPT_EXPRLEN, OPT_EXPRBC
11625 int option;
11627 if (argc < 2) {
11628 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
11629 return JIM_ERR;
11631 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
11632 return JIM_ERR;
11633 if (option == OPT_REFCOUNT) {
11634 if (argc != 3) {
11635 Jim_WrongNumArgs(interp, 2, argv, "object");
11636 return JIM_ERR;
11638 Jim_SetResultInt(interp, argv[2]->refCount);
11639 return JIM_OK;
11641 else if (option == OPT_OBJCOUNT) {
11642 int freeobj = 0, liveobj = 0;
11643 /* REVISIT: Move off stack */
11644 char buf[256];
11645 Jim_Obj *objPtr;
11647 if (argc != 2) {
11648 Jim_WrongNumArgs(interp, 2, argv, "");
11649 return JIM_ERR;
11651 /* Count the number of free objects. */
11652 objPtr = interp->freeList;
11653 while (objPtr) {
11654 freeobj++;
11655 objPtr = objPtr->nextObjPtr;
11657 /* Count the number of live objects. */
11658 objPtr = interp->liveList;
11659 while (objPtr) {
11660 liveobj++;
11661 objPtr = objPtr->nextObjPtr;
11663 /* Set the result string and return. */
11664 sprintf(buf, "free %d used %d", freeobj, liveobj);
11665 Jim_SetResultString(interp, buf, -1);
11666 return JIM_OK;
11668 else if (option == OPT_OBJECTS) {
11669 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
11671 /* Count the number of live objects. */
11672 objPtr = interp->liveList;
11673 listObjPtr = Jim_NewListObj(interp, NULL, 0);
11674 while (objPtr) {
11675 /* REVISIT: Move off stack */
11676 char buf[128];
11677 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
11679 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
11680 sprintf(buf, "%p", objPtr);
11681 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
11682 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
11683 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
11684 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
11685 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
11686 objPtr = objPtr->nextObjPtr;
11688 Jim_SetResult(interp, listObjPtr);
11689 return JIM_OK;
11691 else if (option == OPT_INVSTR) {
11692 Jim_Obj *objPtr;
11694 if (argc != 3) {
11695 Jim_WrongNumArgs(interp, 2, argv, "object");
11696 return JIM_ERR;
11698 objPtr = argv[2];
11699 if (objPtr->typePtr != NULL)
11700 Jim_InvalidateStringRep(objPtr);
11701 Jim_SetEmptyResult(interp);
11702 return JIM_OK;
11704 else if (option == OPT_SCRIPTLEN) {
11705 ScriptObj *script;
11707 if (argc != 3) {
11708 Jim_WrongNumArgs(interp, 2, argv, "script");
11709 return JIM_ERR;
11711 script = Jim_GetScript(interp, argv[2]);
11712 Jim_SetResultInt(interp, script->len);
11713 return JIM_OK;
11715 else if (option == OPT_EXPRLEN) {
11716 ExprByteCode *expr;
11718 if (argc != 3) {
11719 Jim_WrongNumArgs(interp, 2, argv, "expression");
11720 return JIM_ERR;
11722 expr = Jim_GetExpression(interp, argv[2]);
11723 if (expr == NULL)
11724 return JIM_ERR;
11725 Jim_SetResultInt(interp, expr->len);
11726 return JIM_OK;
11728 else if (option == OPT_EXPRBC) {
11729 Jim_Obj *objPtr;
11730 ExprByteCode *expr;
11731 int i;
11733 if (argc != 3) {
11734 Jim_WrongNumArgs(interp, 2, argv, "expression");
11735 return JIM_ERR;
11737 expr = Jim_GetExpression(interp, argv[2]);
11738 if (expr == NULL)
11739 return JIM_ERR;
11740 objPtr = Jim_NewListObj(interp, NULL, 0);
11741 for (i = 0; i < expr->len; i++) {
11742 const char *type;
11743 const Jim_ExprOperator *op;
11744 Jim_Obj *obj = expr->token[i].objPtr;
11746 switch (expr->token[i].type) {
11747 case JIM_TT_EXPR_INT:
11748 type = "int";
11749 break;
11750 case JIM_TT_EXPR_DOUBLE:
11751 type = "double";
11752 break;
11753 case JIM_TT_CMD:
11754 type = "command";
11755 break;
11756 case JIM_TT_VAR:
11757 type = "variable";
11758 break;
11759 case JIM_TT_DICTSUGAR:
11760 type = "dictsugar";
11761 break;
11762 case JIM_TT_ESC:
11763 type = "subst";
11764 break;
11765 case JIM_TT_STR:
11766 type = "string";
11767 break;
11768 default:
11769 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
11770 if (op == NULL) {
11771 type = "private";
11773 else {
11774 type = "operator";
11776 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
11777 break;
11779 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
11780 Jim_ListAppendElement(interp, objPtr, obj);
11782 Jim_SetResult(interp, objPtr);
11783 return JIM_OK;
11785 else {
11786 Jim_SetResultString(interp,
11787 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
11788 return JIM_ERR;
11790 return JIM_OK; /* unreached */
11793 /* [eval] */
11794 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11796 int rc;
11797 Jim_Stack *prevLocalProcs;
11799 if (argc < 2) {
11800 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
11801 return JIM_ERR;
11804 /* Install a new stack for local procs */
11805 prevLocalProcs = interp->localProcs;
11806 interp->localProcs = NULL;
11808 if (argc == 2) {
11809 rc = Jim_EvalObj(interp, argv[1]);
11811 else {
11812 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
11815 /* Delete any local procs */
11816 JimDeleteLocalProcs(interp);
11817 interp->localProcs = prevLocalProcs;
11819 if (rc == JIM_ERR) {
11820 /* eval is "interesting", so add a stack frame here */
11821 interp->addStackTrace++;
11823 return rc;
11826 /* [uplevel] */
11827 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11829 if (argc >= 2) {
11830 int retcode, newLevel, oldLevel;
11831 Jim_CallFrame *savedCallFrame, *targetCallFrame;
11832 Jim_Obj *objPtr;
11833 const char *str;
11835 /* Save the old callframe pointer */
11836 savedCallFrame = interp->framePtr;
11838 /* Lookup the target frame pointer */
11839 str = Jim_GetString(argv[1], NULL);
11840 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
11841 if (Jim_GetCallFrameByLevel(interp, argv[1], &targetCallFrame, &newLevel) != JIM_OK)
11842 return JIM_ERR;
11843 argc--;
11844 argv++;
11846 else {
11847 if (Jim_GetCallFrameByLevel(interp, NULL, &targetCallFrame, &newLevel) != JIM_OK)
11848 return JIM_ERR;
11850 if (argc < 2) {
11851 argv--;
11852 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
11853 return JIM_ERR;
11855 /* Eval the code in the target callframe. */
11856 interp->framePtr = targetCallFrame;
11857 oldLevel = interp->numLevels;
11858 interp->numLevels = newLevel;
11859 if (argc == 2) {
11860 retcode = Jim_EvalObj(interp, argv[1]);
11862 else {
11863 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
11864 Jim_IncrRefCount(objPtr);
11865 retcode = Jim_EvalObj(interp, objPtr);
11866 Jim_DecrRefCount(interp, objPtr);
11868 interp->numLevels = oldLevel;
11869 interp->framePtr = savedCallFrame;
11870 return retcode;
11872 else {
11873 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
11874 return JIM_ERR;
11878 /* [expr] */
11879 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11881 Jim_Obj *exprResultPtr;
11882 int retcode;
11884 if (argc == 2) {
11885 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
11887 else if (argc > 2) {
11888 Jim_Obj *objPtr;
11890 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
11891 Jim_IncrRefCount(objPtr);
11892 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
11893 Jim_DecrRefCount(interp, objPtr);
11895 else {
11896 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
11897 return JIM_ERR;
11899 if (retcode != JIM_OK)
11900 return retcode;
11901 Jim_SetResult(interp, exprResultPtr);
11902 Jim_DecrRefCount(interp, exprResultPtr);
11903 return JIM_OK;
11906 /* [break] */
11907 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11909 if (argc != 1) {
11910 Jim_WrongNumArgs(interp, 1, argv, "");
11911 return JIM_ERR;
11913 return JIM_BREAK;
11916 /* [continue] */
11917 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11919 if (argc != 1) {
11920 Jim_WrongNumArgs(interp, 1, argv, "");
11921 return JIM_ERR;
11923 return JIM_CONTINUE;
11926 /* [return] */
11927 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11929 int i;
11930 Jim_Obj *stackTraceObj = NULL;
11931 Jim_Obj *errorCodeObj = NULL;
11932 int returnCode = JIM_OK;
11933 long level = 1;
11935 for (i = 1; i < argc - 1; i += 2) {
11936 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
11937 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
11938 return JIM_ERR;
11941 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
11942 stackTraceObj = argv[i + 1];
11944 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
11945 errorCodeObj = argv[i + 1];
11947 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
11948 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
11949 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
11950 return JIM_ERR;
11953 else {
11954 break;
11958 if (i != argc - 1 && i != argc) {
11959 Jim_WrongNumArgs(interp, 1, argv,
11960 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
11963 /* If a stack trace is supplied and code is error, set the stack trace */
11964 if (stackTraceObj && returnCode == JIM_ERR) {
11965 JimSetStackTrace(interp, stackTraceObj);
11967 /* If an error code list is supplied, set the global $errorCode */
11968 if (errorCodeObj && returnCode == JIM_ERR) {
11969 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
11971 interp->returnCode = returnCode;
11972 interp->returnLevel = level;
11974 if (i == argc - 1) {
11975 Jim_SetResult(interp, argv[i]);
11977 return JIM_RETURN;
11980 /* [tailcall] */
11981 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11983 Jim_Obj *objPtr;
11985 objPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
11986 Jim_SetResult(interp, objPtr);
11987 return JIM_EVAL;
11990 /* [proc] */
11991 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11993 int argListLen;
11994 int leftArity, rightArity;
11995 int i;
11996 int optionalArgs = 0;
11997 int args = 0;
11999 if (argc != 4 && argc != 5) {
12000 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
12001 return JIM_ERR;
12003 argListLen = Jim_ListLength(interp, argv[2]);
12004 leftArity = 0;
12005 rightArity = 0;
12007 /* Examine the argument list for default parameters and 'args' */
12008 for (i = 0; i < argListLen; i++) {
12009 Jim_Obj *argPtr;
12010 int len;
12012 Jim_ListIndex(interp, argv[2], i, &argPtr, JIM_NONE);
12013 if (Jim_CompareStringImmediate(interp, argPtr, "args")) {
12014 if (args) {
12015 Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
12016 return JIM_ERR;
12018 if (rightArity) {
12019 Jim_SetResultString(interp, "procedure has 'args' in invalid position", -1);
12020 return JIM_ERR;
12022 args = 1;
12023 continue;
12026 /* Does this parameter have a default? */
12027 Jim_GetString(argPtr, NULL);
12028 len = Jim_ListLength(interp, argPtr);
12029 if (len == 0) {
12030 Jim_SetResultString(interp, "procedure has argument with no name", -1);
12031 return JIM_ERR;
12033 if (len > 2) {
12034 Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
12035 return JIM_ERR;
12037 if (len == 1) {
12038 /* A required arg. Is it part of leftArity or rightArity? */
12039 if (optionalArgs || args) {
12040 rightArity++;
12042 else {
12043 leftArity++;
12046 else {
12047 /* Optional arg. Can't be after rightArity */
12048 if (rightArity || args) {
12049 Jim_SetResultString(interp, "procedure has optional arg in invalid position", -1);
12050 return JIM_ERR;
12052 optionalArgs++;
12056 if (argc == 4) {
12057 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
12058 argv[2], NULL, argv[3], leftArity, optionalArgs, args, rightArity);
12060 else {
12061 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
12062 argv[2], argv[3], argv[4], leftArity, optionalArgs, args, rightArity);
12066 /* [local] */
12067 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12069 /* Evaluate the arguments */
12070 int retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
12072 /* If OK, and the result is a proc, add it to the list of local procs */
12073 if (retcode == 0) {
12074 const char *procname = Jim_GetString(Jim_GetResult(interp), NULL);
12076 if (Jim_FindHashEntry(&interp->commands, procname) == NULL) {
12077 Jim_SetResultFormatted(interp, "not a proc: \"%s\"", procname);
12078 return JIM_ERR;
12080 if (interp->localProcs == NULL) {
12081 interp->localProcs = Jim_Alloc(sizeof(*interp->localProcs));
12082 Jim_InitStack(interp->localProcs);
12084 Jim_StackPush(interp->localProcs, Jim_StrDup(procname));
12087 return retcode;
12091 /* [concat] */
12092 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12094 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12095 return JIM_OK;
12098 /* [upvar] */
12099 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12101 int i;
12102 Jim_CallFrame *targetCallFrame;
12104 /* Lookup the target frame pointer */
12105 if (argc > 3 && (argc % 2 == 0)) {
12106 if (Jim_GetCallFrameByLevel(interp, argv[1], &targetCallFrame, NULL) != JIM_OK) {
12107 return JIM_ERR;
12109 argc--;
12110 argv++;
12112 else if (Jim_GetCallFrameByLevel(interp, NULL, &targetCallFrame, NULL) != JIM_OK) {
12113 return JIM_ERR;
12116 /* Check for arity */
12117 if (argc < 3) {
12118 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
12119 return JIM_ERR;
12122 /* Now... for every other/local couple: */
12123 for (i = 1; i < argc; i += 2) {
12124 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
12125 return JIM_ERR;
12127 return JIM_OK;
12130 /* [global] */
12131 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12133 int i;
12135 if (argc < 2) {
12136 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
12137 return JIM_ERR;
12139 /* Link every var to the toplevel having the same name */
12140 if (interp->numLevels == 0)
12141 return JIM_OK; /* global at toplevel... */
12142 for (i = 1; i < argc; i++) {
12143 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
12144 return JIM_ERR;
12146 return JIM_OK;
12149 /* does the [string map] operation. On error NULL is returned,
12150 * otherwise a new string object with the result, having refcount = 0,
12151 * is returned. */
12152 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
12153 Jim_Obj *objPtr, int nocase)
12155 int numMaps;
12156 const char **key, *str, *noMatchStart = NULL;
12157 Jim_Obj **value;
12158 int *keyLen, strLen, i;
12159 Jim_Obj *resultObjPtr;
12161 numMaps = Jim_ListLength(interp, mapListObjPtr);
12162 if (numMaps % 2) {
12163 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
12164 return NULL;
12166 /* Initialization */
12167 numMaps /= 2;
12168 key = Jim_Alloc(sizeof(char *) * numMaps);
12169 keyLen = Jim_Alloc(sizeof(int) * numMaps);
12170 value = Jim_Alloc(sizeof(Jim_Obj *) * numMaps);
12171 resultObjPtr = Jim_NewStringObj(interp, "", 0);
12172 for (i = 0; i < numMaps; i++) {
12173 Jim_Obj *eleObjPtr = 0;
12175 Jim_ListIndex(interp, mapListObjPtr, i * 2, &eleObjPtr, JIM_NONE);
12176 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
12177 Jim_ListIndex(interp, mapListObjPtr, i * 2 + 1, &eleObjPtr, JIM_NONE);
12178 value[i] = eleObjPtr;
12180 str = Jim_GetString(objPtr, &strLen);
12181 /* Map it */
12182 while (strLen) {
12183 for (i = 0; i < numMaps; i++) {
12184 if (strLen >= keyLen[i] && keyLen[i]) {
12185 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i], nocase)) {
12186 if (noMatchStart) {
12187 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12188 noMatchStart = NULL;
12190 Jim_AppendObj(interp, resultObjPtr, value[i]);
12191 str += keyLen[i];
12192 strLen -= keyLen[i];
12193 break;
12197 if (i == numMaps) { /* no match */
12198 if (noMatchStart == NULL)
12199 noMatchStart = str;
12200 str++;
12201 strLen--;
12204 if (noMatchStart) {
12205 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
12207 Jim_Free((void *)key);
12208 Jim_Free(keyLen);
12209 Jim_Free(value);
12210 return resultObjPtr;
12213 /* [string] */
12214 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12216 int len;
12217 int opt_case = 1;
12218 int option;
12219 static const char *options[] = {
12220 "length", "compare", "match", "equal", "is", "range", "map",
12221 "repeat", "reverse", "index", "first", "last",
12222 "trim", "trimleft", "trimright", "tolower", "toupper", NULL
12224 enum
12226 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_RANGE, OPT_MAP,
12227 OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
12228 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER
12230 static const char *nocase_options[] = {
12231 "-nocase", NULL
12234 if (argc < 2) {
12235 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12236 return JIM_ERR;
12238 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
12239 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
12240 return JIM_ERR;
12242 switch (option) {
12243 case OPT_LENGTH:
12244 if (argc != 3) {
12245 Jim_WrongNumArgs(interp, 2, argv, "string");
12246 return JIM_ERR;
12248 Jim_GetString(argv[2], &len);
12249 Jim_SetResultInt(interp, len);
12250 return JIM_OK;
12252 case OPT_COMPARE:
12253 case OPT_EQUAL:
12254 if (argc != 4 &&
12255 (argc != 5 ||
12256 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12257 JIM_ENUM_ABBREV) != JIM_OK)) {
12258 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? string1 string2");
12259 return JIM_ERR;
12261 if (opt_case == 0) {
12262 argv++;
12264 if (option == OPT_COMPARE) {
12265 Jim_SetResultInt(interp, Jim_StringCompareObj(argv[2], argv[3], !opt_case));
12267 else {
12268 Jim_SetResultBool(interp, Jim_StringEqObj(argv[2], argv[3], !opt_case));
12270 return JIM_OK;
12272 case OPT_MATCH:
12273 if (argc != 4 &&
12274 (argc != 5 ||
12275 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12276 JIM_ENUM_ABBREV) != JIM_OK)) {
12277 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
12278 return JIM_ERR;
12280 if (opt_case == 0) {
12281 argv++;
12283 Jim_SetResultBool(interp, Jim_StringMatchObj(argv[2], argv[3], !opt_case));
12284 return JIM_OK;
12286 case OPT_MAP:{
12287 Jim_Obj *objPtr;
12289 if (argc != 4 &&
12290 (argc != 5 ||
12291 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
12292 JIM_ENUM_ABBREV) != JIM_OK)) {
12293 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
12294 return JIM_ERR;
12297 if (opt_case == 0) {
12298 argv++;
12300 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
12301 if (objPtr == NULL) {
12302 return JIM_ERR;
12304 Jim_SetResult(interp, objPtr);
12305 return JIM_OK;
12308 case OPT_RANGE:{
12309 Jim_Obj *objPtr;
12311 if (argc != 5) {
12312 Jim_WrongNumArgs(interp, 2, argv, "string first last");
12313 return JIM_ERR;
12315 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
12316 if (objPtr == NULL) {
12317 return JIM_ERR;
12319 Jim_SetResult(interp, objPtr);
12320 return JIM_OK;
12323 case OPT_REPEAT:{
12324 Jim_Obj *objPtr;
12325 jim_wide count;
12327 if (argc != 4) {
12328 Jim_WrongNumArgs(interp, 2, argv, "string count");
12329 return JIM_ERR;
12331 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
12332 return JIM_ERR;
12334 objPtr = Jim_NewStringObj(interp, "", 0);
12335 if (count > 0) {
12336 while (count--) {
12337 Jim_AppendObj(interp, objPtr, argv[2]);
12340 Jim_SetResult(interp, objPtr);
12341 return JIM_OK;
12344 case OPT_REVERSE:{
12345 char *buf;
12346 const char *str;
12347 int i;
12349 if (argc != 3) {
12350 Jim_WrongNumArgs(interp, 2, argv, "string");
12351 return JIM_ERR;
12353 str = Jim_GetString(argv[2], &len);
12354 buf = Jim_Alloc(len + 1);
12355 for (i = 0; i < len; i++) {
12356 buf[i] = str[len - i - 1];
12358 buf[i] = 0;
12359 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
12360 return JIM_OK;
12363 case OPT_INDEX:{
12364 int index, len;
12365 const char *str;
12367 if (argc != 4) {
12368 Jim_WrongNumArgs(interp, 2, argv, "string index");
12369 return JIM_ERR;
12371 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK) {
12372 return JIM_ERR;
12374 str = Jim_GetString(argv[2], &len);
12375 if (index != INT_MIN && index != INT_MAX) {
12376 index = JimRelToAbsIndex(len, index);
12378 if (index < 0 || index >= len) {
12379 Jim_SetResultString(interp, "", 0);
12381 else {
12382 Jim_SetResultString(interp, str + index, 1);
12384 return JIM_OK;
12387 case OPT_FIRST:
12388 case OPT_LAST:{
12389 int index = 0, l1, l2;
12390 const char *s1, *s2;
12392 if (argc != 4 && argc != 5) {
12393 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
12394 return JIM_ERR;
12396 s1 = Jim_GetString(argv[2], &l1);
12397 s2 = Jim_GetString(argv[3], &l2);
12398 if (argc == 5) {
12399 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK) {
12400 return JIM_ERR;
12402 index = JimRelToAbsIndex(l2, index);
12404 else if (option == OPT_LAST) {
12405 index = l2;
12407 if (option == OPT_FIRST) {
12408 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, index));
12410 else {
12411 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, index));
12413 return JIM_OK;
12416 case OPT_TRIM:
12417 case OPT_TRIMLEFT:
12418 case OPT_TRIMRIGHT:{
12419 Jim_Obj *trimchars;
12421 if (argc != 3 && argc != 4) {
12422 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
12423 return JIM_ERR;
12425 trimchars = (argc == 4 ? argv[3] : NULL);
12426 if (option == OPT_TRIM) {
12427 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
12429 else if (option == OPT_TRIMLEFT) {
12430 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
12432 else if (option == OPT_TRIMRIGHT) {
12433 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
12435 return JIM_OK;
12438 case OPT_TOLOWER:
12439 case OPT_TOUPPER:
12440 if (argc != 3) {
12441 Jim_WrongNumArgs(interp, 2, argv, "string");
12442 return JIM_ERR;
12444 if (option == OPT_TOLOWER) {
12445 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
12447 else {
12448 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
12450 return JIM_OK;
12452 case OPT_IS:
12453 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
12454 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
12456 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
12457 return JIM_ERR;
12459 return JIM_OK;
12462 /* [time] */
12463 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12465 long i, count = 1;
12466 jim_wide start, elapsed;
12467 char buf[60];
12468 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
12470 if (argc < 2) {
12471 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
12472 return JIM_ERR;
12474 if (argc == 3) {
12475 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
12476 return JIM_ERR;
12478 if (count < 0)
12479 return JIM_OK;
12480 i = count;
12481 start = JimClock();
12482 while (i-- > 0) {
12483 int retval;
12485 retval = Jim_EvalObj(interp, argv[1]);
12486 if (retval != JIM_OK) {
12487 return retval;
12490 elapsed = JimClock() - start;
12491 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
12492 Jim_SetResultString(interp, buf, -1);
12493 return JIM_OK;
12496 /* [exit] */
12497 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12499 long exitCode = 0;
12501 if (argc > 2) {
12502 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
12503 return JIM_ERR;
12505 if (argc == 2) {
12506 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
12507 return JIM_ERR;
12509 interp->exitCode = exitCode;
12510 return JIM_EXIT;
12513 /* [catch] */
12514 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12516 int exitCode = 0;
12517 int i;
12518 int sig = 0;
12520 /* Which return codes are caught? These are the defaults */
12521 jim_wide mask =
12522 (1 << JIM_OK | 1 << JIM_ERR | 1 << JIM_BREAK | 1 << JIM_CONTINUE | 1 << JIM_RETURN);
12524 /* Reset the error code before catch.
12525 * Note that this is not strictly correct.
12527 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
12529 for (i = 1; i < argc - 1; i++) {
12530 const char *arg = Jim_GetString(argv[i], NULL);
12531 jim_wide option;
12532 int add;
12534 /* It's a pity we can't use Jim_GetEnum here :-( */
12535 if (strcmp(arg, "--") == 0) {
12536 i++;
12537 break;
12539 if (*arg != '-') {
12540 break;
12543 if (strncmp(arg, "-no", 3) == 0) {
12544 arg += 3;
12545 add = 0;
12547 else {
12548 arg++;
12549 add = 1;
12552 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
12553 option = -1;
12555 if (option < 0) {
12556 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
12558 if (option < 0) {
12559 goto wrongargs;
12562 if (add) {
12563 mask |= (1 << option);
12565 else {
12566 mask &= ~(1 << option);
12570 argc -= i;
12571 if (argc < 1 || argc > 3) {
12572 wrongargs:
12573 Jim_WrongNumArgs(interp, 1, argv,
12574 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
12575 return JIM_ERR;
12577 argv += i;
12579 if (mask & (1 << JIM_SIGNAL)) {
12580 sig++;
12583 interp->signal_level += sig;
12584 if (interp->signal_level && interp->sigmask) {
12585 /* If a signal is set, don't even try to execute the body */
12586 exitCode = JIM_SIGNAL;
12588 else {
12589 exitCode = Jim_EvalObj(interp, argv[0]);
12591 interp->signal_level -= sig;
12593 /* Catch or pass through? Only the first 64 codes can be passed through */
12594 if (exitCode >= 0 && exitCode < (int)sizeof(mask) && ((1 << exitCode) & mask) == 0) {
12595 /* Not caught, pass it up */
12596 return exitCode;
12599 if (sig && exitCode == JIM_SIGNAL) {
12600 /* Catch the signal at this level */
12601 if (interp->signal_set_result) {
12602 interp->signal_set_result(interp, interp->sigmask);
12604 else {
12605 Jim_SetResultInt(interp, interp->sigmask);
12607 interp->sigmask = 0;
12610 if (argc >= 2) {
12611 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
12612 return JIM_ERR;
12614 if (argc == 3) {
12615 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
12617 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
12618 Jim_ListAppendElement(interp, optListObj,
12619 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
12620 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
12621 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
12622 if (exitCode == JIM_ERR) {
12623 Jim_Obj *errorCode;
12624 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
12625 -1));
12626 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
12628 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
12629 if (errorCode) {
12630 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
12631 Jim_ListAppendElement(interp, optListObj, errorCode);
12634 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
12635 return JIM_ERR;
12639 Jim_SetResultInt(interp, exitCode);
12640 return JIM_OK;
12643 #ifdef JIM_REFERENCES
12645 /* [ref] */
12646 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12648 if (argc != 3 && argc != 4) {
12649 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
12650 return JIM_ERR;
12652 if (argc == 3) {
12653 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
12655 else {
12656 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
12658 return JIM_OK;
12661 /* [getref] */
12662 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12664 Jim_Reference *refPtr;
12666 if (argc != 2) {
12667 Jim_WrongNumArgs(interp, 1, argv, "reference");
12668 return JIM_ERR;
12670 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
12671 return JIM_ERR;
12672 Jim_SetResult(interp, refPtr->objPtr);
12673 return JIM_OK;
12676 /* [setref] */
12677 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12679 Jim_Reference *refPtr;
12681 if (argc != 3) {
12682 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
12683 return JIM_ERR;
12685 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
12686 return JIM_ERR;
12687 Jim_IncrRefCount(argv[2]);
12688 Jim_DecrRefCount(interp, refPtr->objPtr);
12689 refPtr->objPtr = argv[2];
12690 Jim_SetResult(interp, argv[2]);
12691 return JIM_OK;
12694 /* [collect] */
12695 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12697 if (argc != 1) {
12698 Jim_WrongNumArgs(interp, 1, argv, "");
12699 return JIM_ERR;
12701 Jim_SetResultInt(interp, Jim_Collect(interp));
12702 return JIM_OK;
12705 /* [finalize] reference ?newValue? */
12706 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12708 if (argc != 2 && argc != 3) {
12709 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
12710 return JIM_ERR;
12712 if (argc == 2) {
12713 Jim_Obj *cmdNamePtr;
12715 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
12716 return JIM_ERR;
12717 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
12718 Jim_SetResult(interp, cmdNamePtr);
12720 else {
12721 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
12722 return JIM_ERR;
12723 Jim_SetResult(interp, argv[2]);
12725 return JIM_OK;
12728 /* TODO */
12730 /* [info references] (list of all the references/finalizers) */
12731 #endif
12733 /* [rename] */
12734 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12736 const char *oldName, *newName;
12738 if (argc != 3) {
12739 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
12740 return JIM_ERR;
12742 oldName = Jim_GetString(argv[1], NULL);
12743 newName = Jim_GetString(argv[2], NULL);
12744 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
12745 Jim_SetResultFormatted(interp, "can't rename \"%#s\": command doesn't exist", argv[1]);
12746 return JIM_ERR;
12748 return JIM_OK;
12751 /* [dict] */
12752 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12754 Jim_Obj *objPtr;
12755 int option;
12756 const char *options[] = {
12757 "create", "get", "set", "unset", "exists", NULL
12759 enum
12761 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
12764 if (argc < 2) {
12765 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
12766 return JIM_ERR;
12769 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
12770 return JIM_ERR;
12773 switch (option) {
12774 case OPT_GET:
12775 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
12776 JIM_ERRMSG) != JIM_OK) {
12777 return JIM_ERR;
12779 Jim_SetResult(interp, objPtr);
12780 return JIM_OK;
12782 case OPT_SET:
12783 if (argc < 5) {
12784 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
12785 return JIM_ERR;
12787 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
12789 case OPT_EXIST:
12790 Jim_SetResultBool(interp, Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3,
12791 &objPtr, JIM_ERRMSG) == JIM_OK);
12792 return JIM_OK;
12794 case OPT_UNSET:
12795 if (argc < 4) {
12796 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
12797 return JIM_ERR;
12799 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL);
12801 case OPT_CREATE:
12802 if (argc % 2) {
12803 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
12804 return JIM_ERR;
12806 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
12807 Jim_SetResult(interp, objPtr);
12808 return JIM_OK;
12810 default:
12811 abort();
12815 /* [subst] */
12816 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12818 const char *options[] = {
12819 "-nobackslashes", "-nocommands", "-novariables", NULL
12821 enum
12822 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
12823 int i;
12824 int flags = JIM_SUBST_FLAG;
12825 Jim_Obj *objPtr;
12827 if (argc < 2) {
12828 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
12829 return JIM_ERR;
12831 for (i = 1; i < (argc - 1); i++) {
12832 int option;
12834 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
12835 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
12836 return JIM_ERR;
12838 switch (option) {
12839 case OPT_NOBACKSLASHES:
12840 flags |= JIM_SUBST_NOESC;
12841 break;
12842 case OPT_NOCOMMANDS:
12843 flags |= JIM_SUBST_NOCMD;
12844 break;
12845 case OPT_NOVARIABLES:
12846 flags |= JIM_SUBST_NOVAR;
12847 break;
12850 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
12851 return JIM_ERR;
12853 Jim_SetResult(interp, objPtr);
12854 return JIM_OK;
12857 /* [info] */
12858 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12860 int cmd;
12861 Jim_Obj *objPtr;
12862 int mode = 0;
12864 static const char *commands[] = {
12865 "body", "commands", "procs", "exists", "globals", "level", "frame", "locals",
12866 "vars", "version", "patchlevel", "complete", "args", "hostname",
12867 "script", "source", "stacktrace", "nameofexecutable", "returncodes", NULL
12869 enum
12870 { INFO_BODY, INFO_COMMANDS, INFO_PROCS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL, INFO_FRAME,
12871 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
12872 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
12873 INFO_RETURNCODES
12876 if (argc < 2) {
12877 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
12878 return JIM_ERR;
12880 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
12881 != JIM_OK) {
12882 return JIM_ERR;
12885 /* Test for the the most common commands first, just in case it makes a difference */
12886 switch (cmd) {
12887 case INFO_EXISTS:{
12888 if (argc != 3) {
12889 Jim_WrongNumArgs(interp, 2, argv, "varName");
12890 return JIM_ERR;
12892 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
12893 break;
12896 case INFO_COMMANDS:
12897 case INFO_PROCS:
12898 if (argc != 2 && argc != 3) {
12899 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
12900 return JIM_ERR;
12902 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL,
12903 (cmd == INFO_PROCS)));
12904 break;
12906 case INFO_VARS:
12907 mode++; /* JIM_VARLIST_VARS */
12908 case INFO_LOCALS:
12909 mode++; /* JIM_VARLIST_LOCALS */
12910 case INFO_GLOBALS:
12911 /* mode 0 => JIM_VARLIST_GLOBALS */
12912 if (argc != 2 && argc != 3) {
12913 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
12914 return JIM_ERR;
12916 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
12917 break;
12919 case INFO_SCRIPT:
12920 if (argc != 2) {
12921 Jim_WrongNumArgs(interp, 2, argv, "");
12922 return JIM_ERR;
12924 Jim_SetResultString(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileName,
12925 -1);
12926 break;
12928 case INFO_SOURCE:{
12929 const char *filename = "";
12930 int line = 0;
12931 Jim_Obj *resObjPtr;
12933 if (argc != 3) {
12934 Jim_WrongNumArgs(interp, 2, argv, "source");
12935 return JIM_ERR;
12937 if (argv[2]->typePtr == &sourceObjType) {
12938 filename = argv[2]->internalRep.sourceValue.fileName;
12939 line = argv[2]->internalRep.sourceValue.lineNumber;
12941 else if (argv[2]->typePtr == &scriptObjType) {
12942 ScriptObj *script = Jim_GetScript(interp, argv[2]);
12944 filename = script->fileName;
12945 if (script->token) {
12946 line = script->token->linenr;
12949 resObjPtr = Jim_NewListObj(interp, NULL, 0);
12950 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObj(interp, filename, -1));
12951 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
12952 Jim_SetResult(interp, resObjPtr);
12953 break;
12956 case INFO_STACKTRACE:
12957 Jim_SetResult(interp, interp->stackTrace);
12958 break;
12960 case INFO_LEVEL:
12961 case INFO_FRAME:
12962 switch (argc) {
12963 case 2:
12964 Jim_SetResultInt(interp, interp->numLevels);
12965 break;
12967 case 3:
12968 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
12969 return JIM_ERR;
12971 Jim_SetResult(interp, objPtr);
12972 break;
12974 default:
12975 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
12976 return JIM_ERR;
12978 break;
12980 case INFO_BODY:
12981 case INFO_ARGS:{
12982 Jim_Cmd *cmdPtr;
12984 if (argc != 3) {
12985 Jim_WrongNumArgs(interp, 2, argv, "procname");
12986 return JIM_ERR;
12988 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
12989 return JIM_ERR;
12991 if (cmdPtr->cmdProc != NULL) {
12992 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
12993 return JIM_ERR;
12995 Jim_SetResult(interp,
12996 cmd == INFO_BODY ? cmdPtr->bodyObjPtr : cmdPtr->argListObjPtr);
12997 break;
13000 case INFO_VERSION:
13001 case INFO_PATCHLEVEL:{
13002 char buf[(JIM_INTEGER_SPACE * 2) + 1];
13004 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
13005 Jim_SetResultString(interp, buf, -1);
13006 break;
13009 case INFO_COMPLETE:
13010 if (argc != 3) {
13011 Jim_WrongNumArgs(interp, 2, argv, "script");
13012 return JIM_ERR;
13014 else {
13015 int len;
13016 const char *s = Jim_GetString(argv[2], &len);
13018 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, NULL));
13020 break;
13022 case INFO_HOSTNAME:
13023 /* Redirect to os.gethostname if it exists */
13024 return Jim_Eval(interp, "os.gethostname");
13026 case INFO_NAMEOFEXECUTABLE:
13027 /* Redirect to Tcl proc */
13028 return Jim_Eval(interp, "{info nameofexecutable}");
13030 case INFO_RETURNCODES:
13031 if (argc == 2) {
13032 int i;
13033 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13035 for (i = 0; jimReturnCodes[i]; i++) {
13036 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
13037 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
13038 jimReturnCodes[i], -1));
13041 Jim_SetResult(interp, listObjPtr);
13043 else if (argc == 3) {
13044 long code;
13045 const char *name;
13047 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
13048 return JIM_ERR;
13050 name = Jim_ReturnCode(code);
13051 if (*name == '?') {
13052 Jim_SetResultInt(interp, code);
13054 else {
13055 Jim_SetResultString(interp, name, -1);
13058 else {
13059 Jim_WrongNumArgs(interp, 2, argv, "?code?");
13060 return JIM_ERR;
13062 break;
13064 return JIM_OK;
13067 /* [split] */
13068 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13070 const char *str, *splitChars, *noMatchStart;
13071 int splitLen, strLen, i;
13072 Jim_Obj *resObjPtr;
13074 if (argc != 2 && argc != 3) {
13075 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
13076 return JIM_ERR;
13078 /* Init */
13079 if (argc == 2) {
13080 splitChars = " \n\t\r";
13081 splitLen = 4;
13083 else {
13084 splitChars = Jim_GetString(argv[2], &splitLen);
13086 str = Jim_GetString(argv[1], &strLen);
13087 if (!strLen)
13088 return JIM_OK;
13089 noMatchStart = str;
13090 resObjPtr = Jim_NewListObj(interp, NULL, 0);
13091 /* Split */
13092 if (splitLen) {
13093 while (strLen) {
13094 for (i = 0; i < splitLen; i++) {
13095 if (*str == splitChars[i]) {
13096 Jim_Obj *objPtr;
13098 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
13099 Jim_ListAppendElement(interp, resObjPtr, objPtr);
13100 noMatchStart = str + 1;
13101 break;
13104 str++;
13105 strLen--;
13107 Jim_ListAppendElement(interp, resObjPtr,
13108 Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart)));
13110 else {
13111 /* This handles the special case of splitchars eq {}. This
13112 * is trivial but we want to perform object sharing as Tcl does. */
13113 Jim_Obj *objCache[256];
13114 const unsigned char *u = (unsigned char *)str;
13116 memset(objCache, 0, sizeof(objCache));
13117 for (i = 0; i < strLen; i++) {
13118 int c = u[i];
13120 if (objCache[c] == NULL)
13121 objCache[c] = Jim_NewStringObj(interp, (char *)u + i, 1);
13122 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
13125 Jim_SetResult(interp, resObjPtr);
13126 return JIM_OK;
13129 /* [join] */
13130 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13132 const char *joinStr;
13133 int joinStrLen, i, listLen;
13134 Jim_Obj *resObjPtr;
13136 if (argc != 2 && argc != 3) {
13137 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
13138 return JIM_ERR;
13140 /* Init */
13141 if (argc == 2) {
13142 joinStr = " ";
13143 joinStrLen = 1;
13145 else {
13146 joinStr = Jim_GetString(argv[2], &joinStrLen);
13148 listLen = Jim_ListLength(interp, argv[1]);
13149 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
13150 /* Split */
13151 for (i = 0; i < listLen; i++) {
13152 Jim_Obj *objPtr = 0;
13154 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
13155 Jim_AppendObj(interp, resObjPtr, objPtr);
13156 if (i + 1 != listLen) {
13157 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
13160 Jim_SetResult(interp, resObjPtr);
13161 return JIM_OK;
13164 /* [format] */
13165 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13167 Jim_Obj *objPtr;
13169 if (argc < 2) {
13170 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
13171 return JIM_ERR;
13173 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
13174 if (objPtr == NULL)
13175 return JIM_ERR;
13176 Jim_SetResult(interp, objPtr);
13177 return JIM_OK;
13180 /* [scan] */
13181 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13183 Jim_Obj *listPtr, **outVec;
13184 int outc, i, count = 0;
13186 if (argc < 3) {
13187 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
13188 return JIM_ERR;
13190 if (argv[2]->typePtr != &scanFmtStringObjType)
13191 SetScanFmtFromAny(interp, argv[2]);
13192 if (FormatGetError(argv[2]) != 0) {
13193 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
13194 return JIM_ERR;
13196 if (argc > 3) {
13197 int maxPos = FormatGetMaxPos(argv[2]);
13198 int count = FormatGetCnvCount(argv[2]);
13200 if (maxPos > argc - 3) {
13201 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
13202 return JIM_ERR;
13204 else if (count > argc - 3) {
13205 Jim_SetResultString(interp, "different numbers of variable names and "
13206 "field specifiers", -1);
13207 return JIM_ERR;
13209 else if (count < argc - 3) {
13210 Jim_SetResultString(interp, "variable is not assigned by any "
13211 "conversion specifiers", -1);
13212 return JIM_ERR;
13215 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
13216 if (listPtr == 0)
13217 return JIM_ERR;
13218 if (argc > 3) {
13219 int rc = JIM_OK;
13221 count = 0;
13223 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
13224 int len = Jim_ListLength(interp, listPtr);
13226 if (len != 0) {
13227 JimListGetElements(interp, listPtr, &outc, &outVec);
13228 for (i = 0; i < outc; ++i) {
13229 if (Jim_Length(outVec[i]) > 0) {
13230 ++count;
13231 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
13232 rc = JIM_ERR;
13237 Jim_FreeNewObj(interp, listPtr);
13239 else {
13240 count = -1;
13242 if (rc == JIM_OK) {
13243 Jim_SetResultInt(interp, count);
13245 return rc;
13247 else {
13248 if (listPtr == (Jim_Obj *)EOF) {
13249 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
13250 return JIM_OK;
13252 Jim_SetResult(interp, listPtr);
13254 return JIM_OK;
13257 /* [error] */
13258 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13260 if (argc != 2 && argc != 3) {
13261 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
13262 return JIM_ERR;
13264 Jim_SetResult(interp, argv[1]);
13265 if (argc == 3) {
13266 JimSetStackTrace(interp, argv[2]);
13267 return JIM_ERR;
13269 interp->addStackTrace++;
13270 return JIM_ERR;
13273 /* [lrange] */
13274 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13276 Jim_Obj *objPtr;
13278 if (argc != 4) {
13279 Jim_WrongNumArgs(interp, 1, argv, "list first last");
13280 return JIM_ERR;
13282 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
13283 return JIM_ERR;
13284 Jim_SetResult(interp, objPtr);
13285 return JIM_OK;
13288 /* [lrepeat] */
13289 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13291 Jim_Obj *objPtr;
13292 long count;
13294 if (argc < 3 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count <= 0) {
13295 Jim_WrongNumArgs(interp, 1, argv, "positiveCount value ?value ...?");
13296 return JIM_ERR;
13299 argc -= 2;
13300 argv += 2;
13302 objPtr = Jim_NewListObj(interp, argv, argc);
13303 while (--count) {
13304 int i;
13306 for (i = 0; i < argc; i++) {
13307 ListAppendElement(objPtr, argv[i]);
13311 Jim_SetResult(interp, objPtr);
13312 return JIM_OK;
13315 /* [env] */
13316 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13318 const char *key;
13319 const char *val;
13321 if (argc == 1) {
13322 extern char **environ;
13324 int i;
13325 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
13327 for (i = 0; environ[i]; i++) {
13328 const char *equals = strchr(environ[i], '=');
13330 if (equals) {
13331 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i],
13332 equals - environ[i]));
13333 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
13337 Jim_SetResult(interp, listObjPtr);
13338 return JIM_OK;
13341 if (argc < 2) {
13342 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
13343 return JIM_ERR;
13345 key = Jim_GetString(argv[1], NULL);
13346 val = getenv(key);
13347 if (val == NULL) {
13348 if (argc < 3) {
13349 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
13350 return JIM_ERR;
13352 val = Jim_GetString(argv[2], NULL);
13354 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
13355 return JIM_OK;
13358 /* [source] */
13359 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13361 int retval;
13363 if (argc != 2) {
13364 Jim_WrongNumArgs(interp, 1, argv, "fileName");
13365 return JIM_ERR;
13367 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
13368 if (retval == JIM_RETURN)
13369 return JIM_OK;
13370 return retval;
13373 /* [lreverse] */
13374 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13376 Jim_Obj *revObjPtr, **ele;
13377 int len;
13379 if (argc != 2) {
13380 Jim_WrongNumArgs(interp, 1, argv, "list");
13381 return JIM_ERR;
13383 JimListGetElements(interp, argv[1], &len, &ele);
13384 len--;
13385 revObjPtr = Jim_NewListObj(interp, NULL, 0);
13386 while (len >= 0)
13387 ListAppendElement(revObjPtr, ele[len--]);
13388 Jim_SetResult(interp, revObjPtr);
13389 return JIM_OK;
13392 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
13394 jim_wide len;
13396 if (step == 0)
13397 return -1;
13398 if (start == end)
13399 return 0;
13400 else if (step > 0 && start > end)
13401 return -1;
13402 else if (step < 0 && end > start)
13403 return -1;
13404 len = end - start;
13405 if (len < 0)
13406 len = -len; /* abs(len) */
13407 if (step < 0)
13408 step = -step; /* abs(step) */
13409 len = 1 + ((len - 1) / step);
13410 /* We can truncate safely to INT_MAX, the range command
13411 * will always return an error for a such long range
13412 * because Tcl lists can't be so long. */
13413 if (len > INT_MAX)
13414 len = INT_MAX;
13415 return (int)((len < 0) ? -1 : len);
13418 /* [range] */
13419 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13421 jim_wide start = 0, end, step = 1;
13422 int len, i;
13423 Jim_Obj *objPtr;
13425 if (argc < 2 || argc > 4) {
13426 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
13427 return JIM_ERR;
13429 if (argc == 2) {
13430 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
13431 return JIM_ERR;
13433 else {
13434 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
13435 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
13436 return JIM_ERR;
13437 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
13438 return JIM_ERR;
13440 if ((len = JimRangeLen(start, end, step)) == -1) {
13441 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
13442 return JIM_ERR;
13444 objPtr = Jim_NewListObj(interp, NULL, 0);
13445 for (i = 0; i < len; i++)
13446 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
13447 Jim_SetResult(interp, objPtr);
13448 return JIM_OK;
13451 /* [rand] */
13452 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13454 jim_wide min = 0, max = 0, len, maxMul;
13456 if (argc < 1 || argc > 3) {
13457 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
13458 return JIM_ERR;
13460 if (argc == 1) {
13461 max = JIM_WIDE_MAX;
13462 } else if (argc == 2) {
13463 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
13464 return JIM_ERR;
13465 } else if (argc == 3) {
13466 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
13467 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
13468 return JIM_ERR;
13470 len = max-min;
13471 if (len < 0) {
13472 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
13473 return JIM_ERR;
13475 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
13476 while (1) {
13477 jim_wide r;
13479 JimRandomBytes(interp, &r, sizeof(jim_wide));
13480 if (r < 0 || r >= maxMul) continue;
13481 r = (len == 0) ? 0 : r%len;
13482 Jim_SetResultInt(interp, min+r);
13483 return JIM_OK;
13487 static const struct {
13488 const char *name;
13489 Jim_CmdProc cmdProc;
13490 } Jim_CoreCommandsTable[] = {
13491 {"set", Jim_SetCoreCommand},
13492 {"unset", Jim_UnsetCoreCommand},
13493 {"puts", Jim_PutsCoreCommand},
13494 {"+", Jim_AddCoreCommand},
13495 {"*", Jim_MulCoreCommand},
13496 {"-", Jim_SubCoreCommand},
13497 {"/", Jim_DivCoreCommand},
13498 {"incr", Jim_IncrCoreCommand},
13499 {"while", Jim_WhileCoreCommand},
13500 {"for", Jim_ForCoreCommand},
13501 {"foreach", Jim_ForeachCoreCommand},
13502 {"lmap", Jim_LmapCoreCommand},
13503 {"if", Jim_IfCoreCommand},
13504 {"switch", Jim_SwitchCoreCommand},
13505 {"list", Jim_ListCoreCommand},
13506 {"lindex", Jim_LindexCoreCommand},
13507 {"lset", Jim_LsetCoreCommand},
13508 {"lsearch", Jim_LsearchCoreCommand},
13509 {"llength", Jim_LlengthCoreCommand},
13510 {"lappend", Jim_LappendCoreCommand},
13511 {"linsert", Jim_LinsertCoreCommand},
13512 {"lreplace", Jim_LreplaceCoreCommand},
13513 {"lsort", Jim_LsortCoreCommand},
13514 {"append", Jim_AppendCoreCommand},
13515 {"debug", Jim_DebugCoreCommand},
13516 {"eval", Jim_EvalCoreCommand},
13517 {"uplevel", Jim_UplevelCoreCommand},
13518 {"expr", Jim_ExprCoreCommand},
13519 {"break", Jim_BreakCoreCommand},
13520 {"continue", Jim_ContinueCoreCommand},
13521 {"proc", Jim_ProcCoreCommand},
13522 {"concat", Jim_ConcatCoreCommand},
13523 {"return", Jim_ReturnCoreCommand},
13524 {"upvar", Jim_UpvarCoreCommand},
13525 {"global", Jim_GlobalCoreCommand},
13526 {"string", Jim_StringCoreCommand},
13527 {"time", Jim_TimeCoreCommand},
13528 {"exit", Jim_ExitCoreCommand},
13529 {"catch", Jim_CatchCoreCommand},
13530 #ifdef JIM_REFERENCES
13531 {"ref", Jim_RefCoreCommand},
13532 {"getref", Jim_GetrefCoreCommand},
13533 {"setref", Jim_SetrefCoreCommand},
13534 {"finalize", Jim_FinalizeCoreCommand},
13535 {"collect", Jim_CollectCoreCommand},
13536 #endif
13537 {"rename", Jim_RenameCoreCommand},
13538 {"dict", Jim_DictCoreCommand},
13539 {"subst", Jim_SubstCoreCommand},
13540 {"info", Jim_InfoCoreCommand},
13541 {"split", Jim_SplitCoreCommand},
13542 {"join", Jim_JoinCoreCommand},
13543 {"format", Jim_FormatCoreCommand},
13544 {"scan", Jim_ScanCoreCommand},
13545 {"error", Jim_ErrorCoreCommand},
13546 {"lrange", Jim_LrangeCoreCommand},
13547 {"lrepeat", Jim_LrepeatCoreCommand},
13548 {"env", Jim_EnvCoreCommand},
13549 {"source", Jim_SourceCoreCommand},
13550 {"lreverse", Jim_LreverseCoreCommand},
13551 {"range", Jim_RangeCoreCommand},
13552 {"rand", Jim_RandCoreCommand},
13553 {"tailcall", Jim_TailcallCoreCommand},
13554 {"local", Jim_LocalCoreCommand},
13555 {NULL, NULL},
13558 void Jim_RegisterCoreCommands(Jim_Interp *interp)
13560 int i = 0;
13562 while (Jim_CoreCommandsTable[i].name != NULL) {
13563 Jim_CreateCommand(interp,
13564 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
13565 i++;
13569 /* -----------------------------------------------------------------------------
13570 * Interactive prompt
13571 * ---------------------------------------------------------------------------*/
13572 void Jim_PrintErrorMessage(Jim_Interp *interp)
13574 int len, i;
13576 if (*interp->errorFileName) {
13577 fprintf(stderr, "%s:%d: Runtime Error: ", interp->errorFileName, interp->errorLine);
13579 fprintf(stderr, "%s" JIM_NL, Jim_GetString(interp->result, NULL));
13580 len = Jim_ListLength(interp, interp->stackTrace);
13581 for (i = len - 3; i >= 0; i -= 3) {
13582 Jim_Obj *objPtr = 0;
13583 const char *proc, *file, *line;
13585 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
13586 proc = Jim_GetString(objPtr, NULL);
13587 Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr, JIM_NONE);
13588 file = Jim_GetString(objPtr, NULL);
13589 Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr, JIM_NONE);
13590 line = Jim_GetString(objPtr, NULL);
13591 if (*proc) {
13592 fprintf(stderr, "in procedure '%s' ", proc);
13593 if (*file) {
13594 fprintf(stderr, "called ");
13597 if (*file) {
13598 fprintf(stderr, "at file \"%s\", line %s", file, line);
13600 if (*file || *proc) {
13601 fprintf(stderr, JIM_NL);
13606 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
13607 const char *prefix, const char *const *tablePtr, const char *name)
13609 int count;
13610 char **tablePtrSorted;
13611 int i;
13613 for (count = 0; tablePtr[count]; count++) {
13616 if (name == NULL) {
13617 name = "option";
13620 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
13621 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
13622 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
13623 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
13624 for (i = 0; i < count; i++) {
13625 if (i + 1 == count && count > 1) {
13626 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
13628 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
13629 if (i + 1 != count) {
13630 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
13633 Jim_Free(tablePtrSorted);
13636 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
13637 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
13639 const char *bad = "bad ";
13640 const char *const *entryPtr = NULL;
13641 int i;
13642 int match = -1;
13643 int arglen;
13644 const char *arg = Jim_GetString(objPtr, &arglen);
13646 *indexPtr = -1;
13648 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
13649 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
13650 /* Found an exact match */
13651 *indexPtr = i;
13652 return JIM_OK;
13654 if (flags & JIM_ENUM_ABBREV) {
13655 /* Accept an unambiguous abbreviation.
13656 * Note that '-' doesnt' consitute a valid abbreviation
13658 if (strncmp(arg, *entryPtr, arglen) == 0) {
13659 if (*arg == '-' && arglen == 1) {
13660 break;
13662 if (match >= 0) {
13663 bad = "ambiguous ";
13664 goto ambiguous;
13666 match = i;
13671 /* If we had an unambiguous partial match */
13672 if (match >= 0) {
13673 *indexPtr = match;
13674 return JIM_OK;
13677 ambiguous:
13678 if (flags & JIM_ERRMSG) {
13679 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
13681 return JIM_ERR;
13684 int Jim_FindByName(const char *name, const char *array[], size_t len)
13686 int i;
13688 for (i = 0; i < (int)len; i++) {
13689 if (array[i] && strcmp(array[i], name) == 0) {
13690 return i;
13693 return -1;
13696 int Jim_IsDict(Jim_Obj *objPtr)
13698 return objPtr->typePtr == &dictObjType;
13701 int Jim_IsList(Jim_Obj *objPtr)
13703 return objPtr->typePtr == &listObjType;
13707 * Very simple printf-like formatting, designed for error messages.
13709 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
13710 * The resulting string is created and set as the result.
13712 * Each '%s' should correspond to a regular string parameter.
13713 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
13714 * Any other printf specifier is not allowed (but %% is allowed for the % character).
13716 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
13718 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
13720 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
13722 /* Initial space needed */
13723 int len = strlen(format);
13724 int extra = 0;
13725 int n = 0;
13726 const char *params[5];
13727 char *buf;
13728 va_list args;
13729 int i;
13731 va_start(args, format);
13733 for (i = 0; i < len && n < 5; i++) {
13734 int l;
13736 if (strncmp(format + i, "%s", 2) == 0) {
13737 params[n] = va_arg(args, char *);
13739 l = strlen(params[n]);
13741 else if (strncmp(format + i, "%#s", 3) == 0) {
13742 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
13744 params[n] = Jim_GetString(objPtr, &l);
13746 else {
13747 if (format[i] == '%') {
13748 i++;
13750 continue;
13752 n++;
13753 extra += l;
13756 len += extra;
13757 buf = Jim_Alloc(len + 1);
13758 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
13760 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13764 * Local Variables: ***
13765 * c-basic-offset: 4 ***
13766 * tab-width: 4 ***
13767 * End: ***