1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
14 * Redistribution and use in source and binary forms, with or without
15 * modification, are permitted provided that the following conditions
18 * 1. Redistributions of source code must retain the above copyright
19 * notice, this list of conditions and the following disclaimer.
20 * 2. Redistributions in binary form must reproduce the above
21 * copyright notice, this list of conditions and the following
22 * disclaimer in the documentation and/or other materials
23 * provided with the distribution.
25 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
26 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
28 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
29 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
30 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
31 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
32 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
33 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
34 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
36 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
38 * The views and conclusions contained in the software and documentation
39 * are those of the authors and should not be interpreted as representing
40 * official policies, either expressed or implied, of the Jim Tcl Project.
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
46 #include <pkgconf/jimtcl.h>
49 #define JIM_DYNLIB /* Dynamic library support for UNIX and WIN32 */
50 #endif /* JIM_ANSIC */
52 #define _GNU_SOURCE /* for vasprintf() */
63 /* sys/time - need is different */
65 #include <sys/time.h> // for gettimeofday()
68 #include "replacements.h"
70 /* Include the platform dependent libraries for
71 * dynamic loading of libraries. */
73 #if defined(_WIN32) || defined(WIN32)
80 #define WIN32_LEAN_AND_MEAN
83 #pragma warning(disable:4146)
88 #endif /* JIM_DYNLIB */
95 #include <cyg/jimtcl/jim.h>
100 #ifdef HAVE_BACKTRACE
101 #include <execinfo.h>
104 /* -----------------------------------------------------------------------------
106 * ---------------------------------------------------------------------------*/
108 /* A shared empty string for the objects string representation.
109 * Jim_InvalidateStringRep knows about it and don't try to free. */
110 static char *JimEmptyStringRep = (char*) "";
112 /* -----------------------------------------------------------------------------
113 * Required prototypes of not exported functions
114 * ---------------------------------------------------------------------------*/
115 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
116 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
117 static void JimRegisterCoreApi(Jim_Interp *interp);
119 static Jim_HashTableType JimVariablesHashTableType;
121 /* -----------------------------------------------------------------------------
123 * ---------------------------------------------------------------------------*/
126 jim_vasprintf( const char *fmt, va_list ap )
128 #ifndef HAVE_VASPRINTF
130 static char buf[2048];
131 vsnprintf( buf, sizeof(buf), fmt, ap );
132 /* garentee termination */
133 buf[sizeof(buf)-1] = 0;
137 result = vasprintf( &buf, fmt, ap );
138 if (result < 0) exit(-1);
144 jim_vasprintf_done( void *buf )
146 #ifndef HAVE_VASPRINTF
155 * Convert a string to a jim_wide INTEGER.
156 * This function originates from BSD.
158 * Ignores `locale' stuff. Assumes that the upper and lower case
159 * alphabets and digits are each contiguous.
161 #ifdef HAVE_LONG_LONG
162 #define JimIsAscii(c) (((c) & ~0x7f) == 0)
163 static jim_wide JimStrtoll(const char *nptr, char **endptr, register int base)
165 register const char *s;
166 register unsigned jim_wide acc;
167 register unsigned char c;
168 register unsigned jim_wide qbase, cutoff;
169 register int neg, any, cutlim;
172 * Skip white space and pick up leading +/- sign if any.
173 * If base is 0, allow 0x for hex and 0 for octal, else
174 * assume decimal; if base is already 16, allow 0x.
179 } while (isspace(c));
188 if ((base == 0 || base == 16) &&
189 c == '0' && (*s == 'x' || *s == 'X')) {
195 base = c == '0' ? 8 : 10;
198 * Compute the cutoff value between legal numbers and illegal
199 * numbers. That is the largest legal value, divided by the
200 * base. An input number that is greater than this value, if
201 * followed by a legal input character, is too big. One that
202 * is equal to this value may be valid or not; the limit
203 * between valid and invalid numbers is then based on the last
204 * digit. For instance, if the range for quads is
205 * [-9223372036854775808..9223372036854775807] and the input base
206 * is 10, cutoff will be set to 922337203685477580 and cutlim to
207 * either 7 (neg==0) or 8 (neg==1), meaning that if we have
208 * accumulated a value > 922337203685477580, or equal but the
209 * next digit is > 7 (or 8), the number is too big, and we will
210 * return a range error.
212 * Set any if any `digits' consumed; make it negative to indicate
215 qbase = (unsigned)base;
216 cutoff = neg ? (unsigned jim_wide)-(LLONG_MIN + LLONG_MAX) + LLONG_MAX
218 cutlim = (int)(cutoff % qbase);
220 for (acc = 0, any = 0;; c = *s++) {
226 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
231 if (any < 0 || acc > cutoff || (acc == cutoff && c > cutlim))
240 acc = neg ? LLONG_MIN : LLONG_MAX;
245 *endptr = (char *)(any ? s - 1 : nptr);
250 /* Glob-style pattern matching. */
251 static int JimStringMatch(const char *pattern, int patternLen,
252 const char *string, int stringLen, int nocase)
257 while (pattern[1] == '*') {
262 return 1; /* match */
264 if (JimStringMatch(pattern+1, patternLen-1,
265 string, stringLen, nocase))
266 return 1; /* match */
270 return 0; /* no match */
274 return 0; /* no match */
284 not = pattern[0] == '^';
291 if (pattern[0] == '\\') {
294 if (pattern[0] == string[0])
296 } else if (pattern[0] == ']') {
298 } else if (patternLen == 0) {
302 } else if (pattern[1] == '-' && patternLen >= 3) {
303 int start = pattern[0];
304 int end = pattern[2];
312 start = tolower(start);
318 if (c >= start && c <= end)
322 if (pattern[0] == string[0])
325 if (tolower((int)pattern[0]) == tolower((int)string[0]))
335 return 0; /* no match */
341 if (patternLen >= 2) {
348 if (pattern[0] != string[0])
349 return 0; /* no match */
351 if (tolower((int)pattern[0]) != tolower((int)string[0]))
352 return 0; /* no match */
360 if (stringLen == 0) {
361 while(*pattern == '*') {
368 if (patternLen == 0 && stringLen == 0)
373 int JimStringCompare(const char *s1, int l1, const char *s2, int l2,
376 unsigned char *u1 = (unsigned char*) s1, *u2 = (unsigned char*) s2;
382 u1++; u2++; l1--; l2--;
384 if (!l1 && !l2) return 0;
388 if (tolower((int)*u1) != tolower((int)*u2))
389 return tolower((int)*u1)-tolower((int)*u2);
390 u1++; u2++; l1--; l2--;
392 if (!l1 && !l2) return 0;
397 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
398 * The index of the first occurrence of s1 in s2 is returned.
399 * If s1 is not found inside s2, -1 is returned. */
400 int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int index)
404 if (!l1 || !l2 || l1 > l2) return -1;
405 if (index < 0) index = 0;
407 for (i = index; i <= l2-l1; i++) {
408 if (memcmp(s2, s1, l1) == 0)
415 int Jim_WideToString(char *buf, jim_wide wideValue)
417 const char *fmt = "%" JIM_WIDE_MODIFIER;
418 return sprintf(buf, fmt, wideValue);
421 int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
425 #ifdef HAVE_LONG_LONG
426 *widePtr = JimStrtoll(str, &endptr, base);
428 *widePtr = strtol(str, &endptr, base);
430 if ((str[0] == '\0') || (str == endptr) )
432 if (endptr[0] != '\0') {
434 if (!isspace((int)*endptr))
442 int Jim_StringToIndex(const char *str, int *intPtr)
446 *intPtr = strtol(str, &endptr, 10);
447 if ( (str[0] == '\0') || (str == endptr) )
449 if (endptr[0] != '\0') {
451 if (!isspace((int)*endptr))
459 /* The string representation of references has two features in order
460 * to make the GC faster. The first is that every reference starts
461 * with a non common character '~', in order to make the string matching
462 * fater. The second is that the reference string rep his 32 characters
463 * in length, this allows to avoid to check every object with a string
464 * repr < 32, and usually there are many of this objects. */
466 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
468 static int JimFormatReference(char *buf, Jim_Reference *refPtr, jim_wide id)
470 const char *fmt = "<reference.<%s>.%020" JIM_WIDE_MODIFIER ">";
471 sprintf(buf, fmt, refPtr->tag, id);
472 return JIM_REFERENCE_SPACE;
475 int Jim_DoubleToString(char *buf, double doubleValue)
480 len = sprintf(buf, "%.17g", doubleValue);
483 if (*s == '.') return len;
486 /* Add a final ".0" if it's a number. But not
488 if (isdigit((int)buf[0])
489 || ((buf[0] == '-' || buf[0] == '+')
490 && isdigit((int)buf[1]))) {
499 int Jim_StringToDouble(const char *str, double *doublePtr)
503 *doublePtr = strtod(str, &endptr);
504 if (str[0] == '\0' || endptr[0] != '\0' || (str == endptr) )
509 static jim_wide JimPowWide(jim_wide b, jim_wide e)
512 if ((b==0 && e!=0) || (e<0)) return 0;
513 for(i=0; i<e; i++) {res *= b;}
517 /* -----------------------------------------------------------------------------
519 * ---------------------------------------------------------------------------*/
521 /* Note that 'interp' may be NULL if not available in the
522 * context of the panic. It's only useful to get the error
523 * file descriptor, it will default to stderr otherwise. */
524 void Jim_Panic(Jim_Interp *interp, const char *fmt, ...)
530 * Send it here first.. Assuming STDIO still works
532 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
533 vfprintf(stderr, fmt, ap);
534 fprintf(stderr, JIM_NL JIM_NL);
537 #ifdef HAVE_BACKTRACE
543 size = backtrace(array, 40);
544 strings = backtrace_symbols(array, size);
545 for (i = 0; i < size; i++)
546 fprintf(fp,"[backtrace] %s" JIM_NL, strings[i]);
547 fprintf(fp,"[backtrace] Include the above lines and the output" JIM_NL);
548 fprintf(fp,"[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
552 /* This may actually crash... we do it last */
553 if( interp && interp->cookie_stderr ){
554 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL "JIM INTERPRETER PANIC: ");
555 Jim_vfprintf( interp, interp->cookie_stderr, fmt, ap );
556 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL JIM_NL );
561 /* -----------------------------------------------------------------------------
563 * ---------------------------------------------------------------------------*/
565 /* Macro used for memory debugging.
566 * In order for they to work you have to rename Jim_Alloc into _Jim_Alloc
567 * and similary for Jim_Realloc and Jim_Free */
569 #define Jim_Alloc(s) (printf("%s %d: Jim_Alloc(%d)\n",__FILE__,__LINE__,s),_Jim_Alloc(s))
570 #define Jim_Free(p) (printf("%s %d: Jim_Free(%p)\n",__FILE__,__LINE__,p),_Jim_Free(p))
571 #define Jim_Realloc(p,s) (printf("%s %d: Jim_Realloc(%p,%d)\n",__FILE__,__LINE__,p,s),_Jim_Realloc(p,s))
574 void *Jim_Alloc(int size)
576 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
579 void *p = malloc(size);
581 Jim_Panic(NULL,"malloc: Out of memory");
585 void Jim_Free(void *ptr) {
589 void *Jim_Realloc(void *ptr, int size)
591 /* We allocate zero length arrayes, etc. to use a single orthogonal codepath */
594 void *p = realloc(ptr, size);
596 Jim_Panic(NULL,"realloc: Out of memory");
600 char *Jim_StrDup(const char *s)
603 char *copy = Jim_Alloc(l+1);
605 memcpy(copy, s, l+1);
609 char *Jim_StrDupLen(const char *s, int l)
611 char *copy = Jim_Alloc(l+1);
613 memcpy(copy, s, l+1);
614 copy[l] = 0; /* Just to be sure, original could be substring */
618 /* -----------------------------------------------------------------------------
619 * Time related functions
620 * ---------------------------------------------------------------------------*/
621 /* Returns microseconds of CPU used since start. */
622 static jim_wide JimClock(void)
624 #if (defined WIN32) && !(defined JIM_ANSIC)
626 QueryPerformanceFrequency(&f);
627 QueryPerformanceCounter(&t);
628 return (long)((t.QuadPart * 1000000) / f.QuadPart);
630 clock_t clocks = clock();
632 return (long)(clocks*(1000000/CLOCKS_PER_SEC));
636 /* -----------------------------------------------------------------------------
638 * ---------------------------------------------------------------------------*/
640 /* -------------------------- private prototypes ---------------------------- */
641 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht);
642 static unsigned int JimHashTableNextPower(unsigned int size);
643 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key);
645 /* -------------------------- hash functions -------------------------------- */
647 /* Thomas Wang's 32 bit Mix Function */
648 unsigned int Jim_IntHashFunction(unsigned int key)
659 /* Identity hash function for integer keys */
660 unsigned int Jim_IdentityHashFunction(unsigned int key)
665 /* Generic hash function (we are using to multiply by 9 and add the byte
667 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
675 /* ----------------------------- API implementation ------------------------- */
676 /* reset an hashtable already initialized with ht_init().
677 * NOTE: This function should only called by ht_destroy(). */
678 static void JimResetHashTable(Jim_HashTable *ht)
687 /* Initialize the hash table */
688 int Jim_InitHashTable(Jim_HashTable *ht, Jim_HashTableType *type,
691 JimResetHashTable(ht);
693 ht->privdata = privDataPtr;
697 /* Resize the table to the minimal size that contains all the elements,
698 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
699 int Jim_ResizeHashTable(Jim_HashTable *ht)
701 int minimal = ht->used;
703 if (minimal < JIM_HT_INITIAL_SIZE)
704 minimal = JIM_HT_INITIAL_SIZE;
705 return Jim_ExpandHashTable(ht, minimal);
708 /* Expand or create the hashtable */
709 int Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
711 Jim_HashTable n; /* the new hashtable */
712 unsigned int realsize = JimHashTableNextPower(size), i;
714 /* the size is invalid if it is smaller than the number of
715 * elements already inside the hashtable */
716 if (ht->used >= size)
719 Jim_InitHashTable(&n, ht->type, ht->privdata);
721 n.sizemask = realsize-1;
722 n.table = Jim_Alloc(realsize*sizeof(Jim_HashEntry*));
724 /* Initialize all the pointers to NULL */
725 memset(n.table, 0, realsize*sizeof(Jim_HashEntry*));
727 /* Copy all the elements from the old to the new table:
728 * note that if the old hash table is empty ht->size is zero,
729 * so Jim_ExpandHashTable just creates an hash table. */
731 for (i = 0; i < ht->size && ht->used > 0; i++) {
732 Jim_HashEntry *he, *nextHe;
734 if (ht->table[i] == NULL) continue;
736 /* For each hash entry on this slot... */
742 /* Get the new element index */
743 h = Jim_HashKey(ht, he->key) & n.sizemask;
744 he->next = n.table[h];
747 /* Pass to the next element */
751 assert(ht->used == 0);
754 /* Remap the new hashtable in the old */
759 /* Add an element to the target hash table */
760 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
763 Jim_HashEntry *entry;
765 /* Get the index of the new element, or -1 if
766 * the element already exists. */
767 if ((index = JimInsertHashEntry(ht, key)) == -1)
770 /* Allocates the memory and stores key */
771 entry = Jim_Alloc(sizeof(*entry));
772 entry->next = ht->table[index];
773 ht->table[index] = entry;
775 /* Set the hash entry fields. */
776 Jim_SetHashKey(ht, entry, key);
777 Jim_SetHashVal(ht, entry, val);
782 /* Add an element, discarding the old if the key already exists */
783 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
785 Jim_HashEntry *entry;
787 /* Try to add the element. If the key
788 * does not exists Jim_AddHashEntry will suceed. */
789 if (Jim_AddHashEntry(ht, key, val) == JIM_OK)
791 /* It already exists, get the entry */
792 entry = Jim_FindHashEntry(ht, key);
793 /* Free the old value and set the new one */
794 Jim_FreeEntryVal(ht, entry);
795 Jim_SetHashVal(ht, entry, val);
799 /* Search and remove an element */
800 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
803 Jim_HashEntry *he, *prevHe;
807 h = Jim_HashKey(ht, key) & ht->sizemask;
812 if (Jim_CompareHashKeys(ht, key, he->key)) {
813 /* Unlink the element from the list */
815 prevHe->next = he->next;
817 ht->table[h] = he->next;
818 Jim_FreeEntryKey(ht, he);
819 Jim_FreeEntryVal(ht, he);
827 return JIM_ERR; /* not found */
830 /* Destroy an entire hash table */
831 int Jim_FreeHashTable(Jim_HashTable *ht)
835 /* Free all the elements */
836 for (i = 0; i < ht->size && ht->used > 0; i++) {
837 Jim_HashEntry *he, *nextHe;
839 if ((he = ht->table[i]) == NULL) continue;
842 Jim_FreeEntryKey(ht, he);
843 Jim_FreeEntryVal(ht, he);
849 /* Free the table and the allocated cache structure */
851 /* Re-initialize the table */
852 JimResetHashTable(ht);
853 return JIM_OK; /* never fails */
856 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
861 if (ht->size == 0) return NULL;
862 h = Jim_HashKey(ht, key) & ht->sizemask;
865 if (Jim_CompareHashKeys(ht, key, he->key))
872 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
874 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
879 iter->nextEntry = NULL;
883 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
886 if (iter->entry == NULL) {
889 (signed)iter->ht->size) break;
890 iter->entry = iter->ht->table[iter->index];
892 iter->entry = iter->nextEntry;
895 /* We need to save the 'next' here, the iterator user
896 * may delete the entry we are returning. */
897 iter->nextEntry = iter->entry->next;
904 /* ------------------------- private functions ------------------------------ */
906 /* Expand the hash table if needed */
907 static int JimExpandHashTableIfNeeded(Jim_HashTable *ht)
909 /* If the hash table is empty expand it to the intial size,
910 * if the table is "full" dobule its size. */
912 return Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
913 if (ht->size == ht->used)
914 return Jim_ExpandHashTable(ht, ht->size*2);
918 /* Our hash table capability is a power of two */
919 static unsigned int JimHashTableNextPower(unsigned int size)
921 unsigned int i = JIM_HT_INITIAL_SIZE;
923 if (size >= 2147483648U)
932 /* Returns the index of a free slot that can be populated with
933 * an hash entry for the given 'key'.
934 * If the key already exists, -1 is returned. */
935 static int JimInsertHashEntry(Jim_HashTable *ht, const void *key)
940 /* Expand the hashtable if needed */
941 if (JimExpandHashTableIfNeeded(ht) == JIM_ERR)
943 /* Compute the key hash value */
944 h = Jim_HashKey(ht, key) & ht->sizemask;
945 /* Search if this slot does not already contain the given key */
948 if (Jim_CompareHashKeys(ht, key, he->key))
955 /* ----------------------- StringCopy Hash Table Type ------------------------*/
957 static unsigned int JimStringCopyHTHashFunction(const void *key)
959 return Jim_GenHashFunction(key, strlen(key));
962 static const void *JimStringCopyHTKeyDup(void *privdata, const void *key)
964 int len = strlen(key);
965 char *copy = Jim_Alloc(len+1);
966 JIM_NOTUSED(privdata);
968 memcpy(copy, key, len);
973 static void *JimStringKeyValCopyHTValDup(void *privdata, const void *val)
975 int len = strlen(val);
976 char *copy = Jim_Alloc(len+1);
977 JIM_NOTUSED(privdata);
979 memcpy(copy, val, len);
984 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1,
987 JIM_NOTUSED(privdata);
989 return strcmp(key1, key2) == 0;
992 static void JimStringCopyHTKeyDestructor(void *privdata, const void *key)
994 JIM_NOTUSED(privdata);
996 Jim_Free((void*)key); /* ATTENTION: const cast */
999 static void JimStringKeyValCopyHTValDestructor(void *privdata, void *val)
1001 JIM_NOTUSED(privdata);
1003 Jim_Free((void*)val); /* ATTENTION: const cast */
1006 static Jim_HashTableType JimStringCopyHashTableType = {
1007 JimStringCopyHTHashFunction, /* hash function */
1008 JimStringCopyHTKeyDup, /* key dup */
1010 JimStringCopyHTKeyCompare, /* key compare */
1011 JimStringCopyHTKeyDestructor, /* key destructor */
1012 NULL /* val destructor */
1015 /* This is like StringCopy but does not auto-duplicate the key.
1016 * It's used for intepreter's shared strings. */
1017 static Jim_HashTableType JimSharedStringsHashTableType = {
1018 JimStringCopyHTHashFunction, /* hash function */
1021 JimStringCopyHTKeyCompare, /* key compare */
1022 JimStringCopyHTKeyDestructor, /* key destructor */
1023 NULL /* val destructor */
1026 /* This is like StringCopy but also automatically handle dynamic
1027 * allocated C strings as values. */
1028 static Jim_HashTableType JimStringKeyValCopyHashTableType = {
1029 JimStringCopyHTHashFunction, /* hash function */
1030 JimStringCopyHTKeyDup, /* key dup */
1031 JimStringKeyValCopyHTValDup, /* val dup */
1032 JimStringCopyHTKeyCompare, /* key compare */
1033 JimStringCopyHTKeyDestructor, /* key destructor */
1034 JimStringKeyValCopyHTValDestructor, /* val destructor */
1037 typedef struct AssocDataValue {
1038 Jim_InterpDeleteProc *delProc;
1042 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1044 AssocDataValue *assocPtr = (AssocDataValue *)data;
1045 if (assocPtr->delProc != NULL)
1046 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1050 static Jim_HashTableType JimAssocDataHashTableType = {
1051 JimStringCopyHTHashFunction, /* hash function */
1052 JimStringCopyHTKeyDup, /* key dup */
1054 JimStringCopyHTKeyCompare, /* key compare */
1055 JimStringCopyHTKeyDestructor, /* key destructor */
1056 JimAssocDataHashTableValueDestructor /* val destructor */
1059 /* -----------------------------------------------------------------------------
1060 * Stack - This is a simple generic stack implementation. It is used for
1061 * example in the 'expr' expression compiler.
1062 * ---------------------------------------------------------------------------*/
1063 void Jim_InitStack(Jim_Stack *stack)
1067 stack->vector = NULL;
1070 void Jim_FreeStack(Jim_Stack *stack)
1072 Jim_Free(stack->vector);
1075 int Jim_StackLen(Jim_Stack *stack)
1080 void Jim_StackPush(Jim_Stack *stack, void *element) {
1081 int neededLen = stack->len+1;
1082 if (neededLen > stack->maxlen) {
1083 stack->maxlen = neededLen*2;
1084 stack->vector = Jim_Realloc(stack->vector, sizeof(void*)*stack->maxlen);
1086 stack->vector[stack->len] = element;
1090 void *Jim_StackPop(Jim_Stack *stack)
1092 if (stack->len == 0) return NULL;
1094 return stack->vector[stack->len];
1097 void *Jim_StackPeek(Jim_Stack *stack)
1099 if (stack->len == 0) return NULL;
1100 return stack->vector[stack->len-1];
1103 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr))
1107 for (i = 0; i < stack->len; i++)
1108 freeFunc(stack->vector[i]);
1111 /* -----------------------------------------------------------------------------
1113 * ---------------------------------------------------------------------------*/
1116 #define JIM_TT_NONE -1 /* No token returned */
1117 #define JIM_TT_STR 0 /* simple string */
1118 #define JIM_TT_ESC 1 /* string that needs escape chars conversion */
1119 #define JIM_TT_VAR 2 /* var substitution */
1120 #define JIM_TT_DICTSUGAR 3 /* Syntax sugar for [dict get], $foo(bar) */
1121 #define JIM_TT_CMD 4 /* command substitution */
1122 #define JIM_TT_SEP 5 /* word separator */
1123 #define JIM_TT_EOL 6 /* line separator */
1125 /* Additional token types needed for expressions */
1126 #define JIM_TT_SUBEXPR_START 7
1127 #define JIM_TT_SUBEXPR_END 8
1128 #define JIM_TT_EXPR_NUMBER 9
1129 #define JIM_TT_EXPR_OPERATOR 10
1132 #define JIM_PS_DEF 0 /* Default state */
1133 #define JIM_PS_QUOTE 1 /* Inside "" */
1135 /* Parser context structure. The same context is used both to parse
1136 * Tcl scripts and lists. */
1137 struct JimParserCtx {
1138 const char *prg; /* Program text */
1139 const char *p; /* Pointer to the point of the program we are parsing */
1140 int len; /* Left length of 'prg' */
1141 int linenr; /* Current line number */
1143 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1144 int tline; /* Line number of the returned token */
1145 int tt; /* Token type */
1146 int eof; /* Non zero if EOF condition is true. */
1147 int state; /* Parser state */
1148 int comment; /* Non zero if the next chars may be a comment. */
1151 #define JimParserEof(c) ((c)->eof)
1152 #define JimParserTstart(c) ((c)->tstart)
1153 #define JimParserTend(c) ((c)->tend)
1154 #define JimParserTtype(c) ((c)->tt)
1155 #define JimParserTline(c) ((c)->tline)
1157 static int JimParseScript(struct JimParserCtx *pc);
1158 static int JimParseSep(struct JimParserCtx *pc);
1159 static int JimParseEol(struct JimParserCtx *pc);
1160 static int JimParseCmd(struct JimParserCtx *pc);
1161 static int JimParseVar(struct JimParserCtx *pc);
1162 static int JimParseBrace(struct JimParserCtx *pc);
1163 static int JimParseStr(struct JimParserCtx *pc);
1164 static int JimParseComment(struct JimParserCtx *pc);
1165 static char *JimParserGetToken(struct JimParserCtx *pc,
1166 int *lenPtr, int *typePtr, int *linePtr);
1168 /* Initialize a parser context.
1169 * 'prg' is a pointer to the program text, linenr is the line
1170 * number of the first line contained in the program. */
1171 void JimParserInit(struct JimParserCtx *pc, const char *prg,
1172 int len, int linenr)
1180 pc->tt = JIM_TT_NONE;
1182 pc->state = JIM_PS_DEF;
1183 pc->linenr = linenr;
1187 int JimParseScript(struct JimParserCtx *pc)
1189 while(1) { /* the while is used to reiterate with continue if needed */
1193 pc->tline = pc->linenr;
1194 pc->tt = JIM_TT_EOL;
1200 if (*(pc->p+1) == '\n')
1201 return JimParseSep(pc);
1204 return JimParseStr(pc);
1210 if (pc->state == JIM_PS_DEF)
1211 return JimParseSep(pc);
1214 return JimParseStr(pc);
1220 if (pc->state == JIM_PS_DEF)
1221 return JimParseEol(pc);
1223 return JimParseStr(pc);
1227 return JimParseCmd(pc);
1231 if (JimParseVar(pc) == JIM_ERR) {
1232 pc->tstart = pc->tend = pc->p++; pc->len--;
1233 pc->tline = pc->linenr;
1234 pc->tt = JIM_TT_STR;
1241 JimParseComment(pc);
1244 return JimParseStr(pc);
1248 return JimParseStr(pc);
1255 int JimParseSep(struct JimParserCtx *pc)
1258 pc->tline = pc->linenr;
1259 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' ||
1260 (*pc->p == '\\' && *(pc->p+1) == '\n')) {
1261 if (*pc->p == '\\') {
1268 pc->tt = JIM_TT_SEP;
1272 int JimParseEol(struct JimParserCtx *pc)
1275 pc->tline = pc->linenr;
1276 while (*pc->p == ' ' || *pc->p == '\n' ||
1277 *pc->p == '\t' || *pc->p == '\r' || *pc->p == ';') {
1283 pc->tt = JIM_TT_EOL;
1287 /* Todo. Don't stop if ']' appears inside {} or quoted.
1288 * Also should handle the case of puts [string length "]"] */
1289 int JimParseCmd(struct JimParserCtx *pc)
1294 pc->tstart = ++pc->p; pc->len--;
1295 pc->tline = pc->linenr;
1299 } else if (*pc->p == '[' && blevel == 0) {
1301 } else if (*pc->p == ']' && blevel == 0) {
1304 } else if (*pc->p == '\\') {
1306 } else if (*pc->p == '{') {
1308 } else if (*pc->p == '}') {
1311 } else if (*pc->p == '\n')
1316 pc->tt = JIM_TT_CMD;
1317 if (*pc->p == ']') {
1323 int JimParseVar(struct JimParserCtx *pc)
1325 int brace = 0, stop = 0, ttype = JIM_TT_VAR;
1327 pc->tstart = ++pc->p; pc->len--; /* skip the $ */
1328 pc->tline = pc->linenr;
1329 if (*pc->p == '{') {
1330 pc->tstart = ++pc->p; pc->len--;
1335 if (*pc->p == '}' || pc->len == 0) {
1341 else if (*pc->p == '\n')
1346 /* Include leading colons */
1347 while (*pc->p == ':') {
1352 if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
1353 (*pc->p >= 'A' && *pc->p <= 'Z') ||
1354 (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
1360 /* Parse [dict get] syntax sugar. */
1361 if (*pc->p == '(') {
1362 while (*pc->p != ')' && pc->len) {
1364 if (*pc->p == '\\' && pc->len >= 2) {
1365 pc->p += 2; pc->len -= 2;
1368 if (*pc->p != '\0') {
1371 ttype = JIM_TT_DICTSUGAR;
1375 /* Check if we parsed just the '$' character.
1376 * That's not a variable so an error is returned
1377 * to tell the state machine to consider this '$' just
1379 if (pc->tstart == pc->p) {
1387 int JimParseBrace(struct JimParserCtx *pc)
1391 pc->tstart = ++pc->p; pc->len--;
1392 pc->tline = pc->linenr;
1394 if (*pc->p == '\\' && pc->len >= 2) {
1398 } else if (*pc->p == '{') {
1400 } else if (pc->len == 0 || *pc->p == '}') {
1402 if (pc->len == 0 || level == 0) {
1407 pc->tt = JIM_TT_STR;
1410 } else if (*pc->p == '\n') {
1415 return JIM_OK; /* unreached */
1418 int JimParseStr(struct JimParserCtx *pc)
1420 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1421 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
1422 if (newword && *pc->p == '{') {
1423 return JimParseBrace(pc);
1424 } else if (newword && *pc->p == '"') {
1425 pc->state = JIM_PS_QUOTE;
1429 pc->tline = pc->linenr;
1433 pc->tt = JIM_TT_ESC;
1438 if (pc->state == JIM_PS_DEF &&
1439 *(pc->p+1) == '\n') {
1441 pc->tt = JIM_TT_ESC;
1451 pc->tt = JIM_TT_ESC;
1458 if (pc->state == JIM_PS_DEF) {
1460 pc->tt = JIM_TT_ESC;
1462 } else if (*pc->p == '\n') {
1467 if (pc->state == JIM_PS_QUOTE) {
1469 pc->tt = JIM_TT_ESC;
1471 pc->state = JIM_PS_DEF;
1478 return JIM_OK; /* unreached */
1481 int JimParseComment(struct JimParserCtx *pc)
1484 if (*pc->p == '\n') {
1486 if (*(pc->p-1) != '\\') {
1496 /* xdigitval and odigitval are helper functions for JimParserGetToken() */
1497 static int xdigitval(int c)
1499 if (c >= '0' && c <= '9') return c-'0';
1500 if (c >= 'a' && c <= 'f') return c-'a'+10;
1501 if (c >= 'A' && c <= 'F') return c-'A'+10;
1505 static int odigitval(int c)
1507 if (c >= '0' && c <= '7') return c-'0';
1511 /* Perform Tcl escape substitution of 's', storing the result
1512 * string into 'dest'. The escaped string is guaranteed to
1513 * be the same length or shorted than the source string.
1514 * Slen is the length of the string at 's', if it's -1 the string
1515 * length will be calculated by the function.
1517 * The function returns the length of the resulting string. */
1518 static int JimEscape(char *dest, const char *s, int slen)
1526 for (i = 0; i < slen; i++) {
1530 case 'a': *p++ = 0x7; i++; break;
1531 case 'b': *p++ = 0x8; i++; break;
1532 case 'f': *p++ = 0xc; i++; break;
1533 case 'n': *p++ = 0xa; i++; break;
1534 case 'r': *p++ = 0xd; i++; break;
1535 case 't': *p++ = 0x9; i++; break;
1536 case 'v': *p++ = 0xb; i++; break;
1537 case '\0': *p++ = '\\'; i++; break;
1538 case '\n': *p++ = ' '; i++; break;
1540 if (s[i+1] == 'x') {
1542 int c = xdigitval(s[i+2]);
1549 c = xdigitval(s[i+3]);
1559 } else if (s[i+1] >= '0' && s[i+1] <= '7')
1562 int c = odigitval(s[i+1]);
1564 c = odigitval(s[i+2]);
1571 c = odigitval(s[i+3]);
1597 /* Returns a dynamically allocated copy of the current token in the
1598 * parser context. The function perform conversion of escapes if
1599 * the token is of type JIM_TT_ESC.
1601 * Note that after the conversion, tokens that are grouped with
1602 * braces in the source code, are always recognizable from the
1603 * identical string obtained in a different way from the type.
1605 * For exmple the string:
1609 * will return as first token "expand", of type JIM_TT_STR
1615 * will return as first token "expand", of type JIM_TT_ESC
1617 char *JimParserGetToken(struct JimParserCtx *pc,
1618 int *lenPtr, int *typePtr, int *linePtr)
1620 const char *start, *end;
1624 start = JimParserTstart(pc);
1625 end = JimParserTend(pc);
1627 if (lenPtr) *lenPtr = 0;
1628 if (typePtr) *typePtr = JimParserTtype(pc);
1629 if (linePtr) *linePtr = JimParserTline(pc);
1630 token = Jim_Alloc(1);
1634 len = (end-start)+1;
1635 token = Jim_Alloc(len+1);
1636 if (JimParserTtype(pc) != JIM_TT_ESC) {
1637 /* No escape conversion needed? Just copy it. */
1638 memcpy(token, start, len);
1641 /* Else convert the escape chars. */
1642 len = JimEscape(token, start, len);
1644 if (lenPtr) *lenPtr = len;
1645 if (typePtr) *typePtr = JimParserTtype(pc);
1646 if (linePtr) *linePtr = JimParserTline(pc);
1650 /* The following functin is not really part of the parsing engine of Jim,
1651 * but it somewhat related. Given an string and its length, it tries
1652 * to guess if the script is complete or there are instead " " or { }
1653 * open and not completed. This is useful for interactive shells
1654 * implementation and for [info complete].
1656 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1657 * '{' on scripts incomplete missing one or more '}' to be balanced.
1658 * '"' on scripts incomplete missing a '"' char.
1660 * If the script is complete, 1 is returned, otherwise 0. */
1661 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
1675 } else if (state == '"') {
1682 } else if (state == ' ') {
1699 *stateCharPtr = state;
1700 return state == ' ';
1703 /* -----------------------------------------------------------------------------
1705 * ---------------------------------------------------------------------------*/
1706 static int JimParseListSep(struct JimParserCtx *pc);
1707 static int JimParseListStr(struct JimParserCtx *pc);
1709 int JimParseList(struct JimParserCtx *pc)
1712 pc->tstart = pc->tend = pc->p;
1713 pc->tline = pc->linenr;
1714 pc->tt = JIM_TT_EOL;
1723 if (pc->state == JIM_PS_DEF)
1724 return JimParseListSep(pc);
1726 return JimParseListStr(pc);
1729 return JimParseListStr(pc);
1735 int JimParseListSep(struct JimParserCtx *pc)
1738 pc->tline = pc->linenr;
1739 while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n')
1744 pc->tt = JIM_TT_SEP;
1748 int JimParseListStr(struct JimParserCtx *pc)
1750 int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1751 pc->tt == JIM_TT_NONE);
1752 if (newword && *pc->p == '{') {
1753 return JimParseBrace(pc);
1754 } else if (newword && *pc->p == '"') {
1755 pc->state = JIM_PS_QUOTE;
1759 pc->tline = pc->linenr;
1763 pc->tt = JIM_TT_ESC;
1774 if (pc->state == JIM_PS_DEF) {
1776 pc->tt = JIM_TT_ESC;
1778 } else if (*pc->p == '\n') {
1783 if (pc->state == JIM_PS_QUOTE) {
1785 pc->tt = JIM_TT_ESC;
1787 pc->state = JIM_PS_DEF;
1794 return JIM_OK; /* unreached */
1797 /* -----------------------------------------------------------------------------
1798 * Jim_Obj related functions
1799 * ---------------------------------------------------------------------------*/
1801 /* Return a new initialized object. */
1802 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
1806 /* -- Check if there are objects in the free list -- */
1807 if (interp->freeList != NULL) {
1808 /* -- Unlink the object from the free list -- */
1809 objPtr = interp->freeList;
1810 interp->freeList = objPtr->nextObjPtr;
1812 /* -- No ready to use objects: allocate a new one -- */
1813 objPtr = Jim_Alloc(sizeof(*objPtr));
1816 /* Object is returned with refCount of 0. Every
1817 * kind of GC implemented should take care to don't try
1818 * to scan objects with refCount == 0. */
1819 objPtr->refCount = 0;
1820 /* All the other fields are left not initialized to save time.
1821 * The caller will probably want set they to the right
1824 /* -- Put the object into the live list -- */
1825 objPtr->prevObjPtr = NULL;
1826 objPtr->nextObjPtr = interp->liveList;
1827 if (interp->liveList)
1828 interp->liveList->prevObjPtr = objPtr;
1829 interp->liveList = objPtr;
1834 /* Free an object. Actually objects are never freed, but
1835 * just moved to the free objects list, where they will be
1836 * reused by Jim_NewObj(). */
1837 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
1839 /* Check if the object was already freed, panic. */
1840 if (objPtr->refCount != 0) {
1841 Jim_Panic(interp,"!!!Object %p freed with bad refcount %d", objPtr,
1844 /* Free the internal representation */
1845 Jim_FreeIntRep(interp, objPtr);
1846 /* Free the string representation */
1847 if (objPtr->bytes != NULL) {
1848 if (objPtr->bytes != JimEmptyStringRep)
1849 Jim_Free(objPtr->bytes);
1851 /* Unlink the object from the live objects list */
1852 if (objPtr->prevObjPtr)
1853 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
1854 if (objPtr->nextObjPtr)
1855 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
1856 if (interp->liveList == objPtr)
1857 interp->liveList = objPtr->nextObjPtr;
1858 /* Link the object into the free objects list */
1859 objPtr->prevObjPtr = NULL;
1860 objPtr->nextObjPtr = interp->freeList;
1861 if (interp->freeList)
1862 interp->freeList->prevObjPtr = objPtr;
1863 interp->freeList = objPtr;
1864 objPtr->refCount = -1;
1867 /* Invalidate the string representation of an object. */
1868 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
1870 if (objPtr->bytes != NULL) {
1871 if (objPtr->bytes != JimEmptyStringRep)
1872 Jim_Free(objPtr->bytes);
1874 objPtr->bytes = NULL;
1877 #define Jim_SetStringRep(o, b, l) \
1878 do { (o)->bytes = b; (o)->length = l; } while (0)
1880 /* Set the initial string representation for an object.
1881 * Does not try to free an old one. */
1882 void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
1885 objPtr->bytes = JimEmptyStringRep;
1888 objPtr->bytes = Jim_Alloc(length+1);
1889 objPtr->length = length;
1890 memcpy(objPtr->bytes, bytes, length);
1891 objPtr->bytes[length] = '\0';
1895 /* Duplicate an object. The returned object has refcount = 0. */
1896 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
1900 dupPtr = Jim_NewObj(interp);
1901 if (objPtr->bytes == NULL) {
1902 /* Object does not have a valid string representation. */
1903 dupPtr->bytes = NULL;
1905 Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
1907 if (objPtr->typePtr != NULL) {
1908 if (objPtr->typePtr->dupIntRepProc == NULL) {
1909 dupPtr->internalRep = objPtr->internalRep;
1911 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
1913 dupPtr->typePtr = objPtr->typePtr;
1915 dupPtr->typePtr = NULL;
1920 /* Return the string representation for objPtr. If the object
1921 * string representation is invalid, calls the method to create
1922 * a new one starting from the internal representation of the object. */
1923 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
1925 if (objPtr->bytes == NULL) {
1926 /* Invalid string repr. Generate it. */
1927 if (objPtr->typePtr->updateStringProc == NULL) {
1928 Jim_Panic(NULL,"UpdataStringProc called against '%s' type.",
1929 objPtr->typePtr->name);
1931 objPtr->typePtr->updateStringProc(objPtr);
1934 *lenPtr = objPtr->length;
1935 return objPtr->bytes;
1938 /* Just returns the length of the object's string rep */
1939 int Jim_Length(Jim_Obj *objPtr)
1943 Jim_GetString(objPtr, &len);
1947 /* -----------------------------------------------------------------------------
1949 * ---------------------------------------------------------------------------*/
1950 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
1951 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
1953 static Jim_ObjType stringObjType = {
1956 DupStringInternalRep,
1958 JIM_TYPE_REFERENCES,
1961 void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
1963 JIM_NOTUSED(interp);
1965 /* This is a bit subtle: the only caller of this function
1966 * should be Jim_DuplicateObj(), that will copy the
1967 * string representaion. After the copy, the duplicated
1968 * object will not have more room in teh buffer than
1969 * srcPtr->length bytes. So we just set it to length. */
1970 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
1973 int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
1975 /* Get a fresh string representation. */
1976 (void) Jim_GetString(objPtr, NULL);
1977 /* Free any other internal representation. */
1978 Jim_FreeIntRep(interp, objPtr);
1979 /* Set it as string, i.e. just set the maxLength field. */
1980 objPtr->typePtr = &stringObjType;
1981 objPtr->internalRep.strValue.maxLength = objPtr->length;
1985 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
1987 Jim_Obj *objPtr = Jim_NewObj(interp);
1991 /* Alloc/Set the string rep. */
1993 objPtr->bytes = JimEmptyStringRep;
1996 objPtr->bytes = Jim_Alloc(len+1);
1997 objPtr->length = len;
1998 memcpy(objPtr->bytes, s, len);
1999 objPtr->bytes[len] = '\0';
2002 /* No typePtr field for the vanilla string object. */
2003 objPtr->typePtr = NULL;
2007 /* This version does not try to duplicate the 's' pointer, but
2008 * use it directly. */
2009 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2011 Jim_Obj *objPtr = Jim_NewObj(interp);
2015 Jim_SetStringRep(objPtr, s, len);
2016 objPtr->typePtr = NULL;
2020 /* Low-level string append. Use it only against objects
2021 * of type "string". */
2022 void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2028 needlen = objPtr->length + len;
2029 if (objPtr->internalRep.strValue.maxLength < needlen ||
2030 objPtr->internalRep.strValue.maxLength == 0) {
2031 if (objPtr->bytes == JimEmptyStringRep) {
2032 objPtr->bytes = Jim_Alloc((needlen*2)+1);
2034 objPtr->bytes = Jim_Realloc(objPtr->bytes, (needlen*2)+1);
2036 objPtr->internalRep.strValue.maxLength = needlen*2;
2038 memcpy(objPtr->bytes + objPtr->length, str, len);
2039 objPtr->bytes[objPtr->length+len] = '\0';
2040 objPtr->length += len;
2043 /* Low-level wrapper to append an object. */
2044 void StringAppendObj(Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2049 str = Jim_GetString(appendObjPtr, &len);
2050 StringAppendString(objPtr, str, len);
2053 /* Higher level API to append strings to objects. */
2054 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str,
2057 if (Jim_IsShared(objPtr))
2058 Jim_Panic(interp,"Jim_AppendString called with shared object");
2059 if (objPtr->typePtr != &stringObjType)
2060 SetStringFromAny(interp, objPtr);
2061 StringAppendString(objPtr, str, len);
2064 void Jim_AppendString_sprintf( Jim_Interp *interp, Jim_Obj *objPtr, const char *fmt, ... )
2069 va_start( ap, fmt );
2070 buf = jim_vasprintf( fmt, ap );
2074 Jim_AppendString( interp, objPtr, buf, -1 );
2075 jim_vasprintf_done(buf);
2080 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr,
2081 Jim_Obj *appendObjPtr)
2086 str = Jim_GetString(appendObjPtr, &len);
2087 Jim_AppendString(interp, objPtr, str, len);
2090 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2094 if (objPtr->typePtr != &stringObjType)
2095 SetStringFromAny(interp, objPtr);
2096 va_start(ap, objPtr);
2098 char *s = va_arg(ap, char*);
2100 if (s == NULL) break;
2101 Jim_AppendString(interp, objPtr, s, -1);
2106 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr, int nocase)
2108 const char *aStr, *bStr;
2111 if (aObjPtr == bObjPtr) return 1;
2112 aStr = Jim_GetString(aObjPtr, &aLen);
2113 bStr = Jim_GetString(bObjPtr, &bLen);
2114 if (aLen != bLen) return 0;
2116 return memcmp(aStr, bStr, aLen) == 0;
2117 for (i = 0; i < aLen; i++) {
2118 if (tolower((int)aStr[i]) != tolower((int)bStr[i]))
2124 int Jim_StringMatchObj(Jim_Obj *patternObjPtr, Jim_Obj *objPtr,
2127 const char *pattern, *string;
2128 int patternLen, stringLen;
2130 pattern = Jim_GetString(patternObjPtr, &patternLen);
2131 string = Jim_GetString(objPtr, &stringLen);
2132 return JimStringMatch(pattern, patternLen, string, stringLen, nocase);
2135 int Jim_StringCompareObj(Jim_Obj *firstObjPtr,
2136 Jim_Obj *secondObjPtr, int nocase)
2138 const char *s1, *s2;
2141 s1 = Jim_GetString(firstObjPtr, &l1);
2142 s2 = Jim_GetString(secondObjPtr, &l2);
2143 return JimStringCompare(s1, l1, s2, l2, nocase);
2146 /* Convert a range, as returned by Jim_GetRange(), into
2147 * an absolute index into an object of the specified length.
2148 * This function may return negative values, or values
2149 * bigger or equal to the length of the list if the index
2150 * is out of range. */
2151 static int JimRelToAbsIndex(int len, int index)
2158 /* Convert a pair of index as normalize by JimRelToAbsIndex(),
2159 * into a range stored in *firstPtr, *lastPtr, *rangeLenPtr, suitable
2160 * for implementation of commands like [string range] and [lrange].
2162 * The resulting range is guaranteed to address valid elements of
2164 static void JimRelToAbsRange(int len, int first, int last,
2165 int *firstPtr, int *lastPtr, int *rangeLenPtr)
2172 rangeLen = last-first+1;
2179 rangeLen -= (last-(len-1));
2184 if (rangeLen < 0) rangeLen = 0;
2188 *rangeLenPtr = rangeLen;
2191 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2192 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2198 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
2199 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
2201 str = Jim_GetString(strObjPtr, &len);
2202 first = JimRelToAbsIndex(len, first);
2203 last = JimRelToAbsIndex(len, last);
2204 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
2205 return Jim_NewStringObj(interp, str+first, rangeLen);
2208 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2212 if (strObjPtr->typePtr != &stringObjType) {
2213 SetStringFromAny(interp, strObjPtr);
2216 buf = Jim_Alloc(strObjPtr->length+1);
2218 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2219 for (i = 0; i < strObjPtr->length; i++)
2220 buf[i] = tolower(buf[i]);
2221 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2224 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2228 if (strObjPtr->typePtr != &stringObjType) {
2229 SetStringFromAny(interp, strObjPtr);
2232 buf = Jim_Alloc(strObjPtr->length+1);
2234 memcpy(buf, strObjPtr->bytes, strObjPtr->length+1);
2235 for (i = 0; i < strObjPtr->length; i++)
2236 buf[i] = toupper(buf[i]);
2237 return Jim_NewStringObjNoAlloc(interp, buf, strObjPtr->length);
2240 /* This is the core of the [format] command.
2241 * TODO: Lots of things work - via a hack
2242 * However, no format item can be >= JIM_MAX_FMT
2244 #define JIM_MAX_FMT 2048
2245 static Jim_Obj *Jim_FormatString_Inner(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2246 int objc, Jim_Obj *const *objv, char *sprintf_buf)
2248 const char *fmt, *_fmt;
2253 fmt = Jim_GetString(fmtObjPtr, &fmtLen);
2255 resObjPtr = Jim_NewStringObj(interp, "", 0);
2257 const char *p = fmt;
2261 /* we cheat and use Sprintf()! */
2275 while (*fmt != '%' && fmtLen) {
2278 Jim_AppendString(interp, resObjPtr, p, fmt-p);
2281 fmt++; fmtLen--; /* skip '%' */
2290 prec = -1; /* not found yet */
2297 case 'b': /* binary - not all printfs() do this */
2298 case 's': /* string */
2299 case 'i': /* integer */
2300 case 'd': /* decimal */
2302 case 'X': /* CAP hex */
2303 case 'c': /* char */
2304 case 'o': /* octal */
2305 case 'u': /* unsigned */
2306 case 'f': /* float */
2310 case '0': /* zero pad */
2320 case ' ': /* sign space */
2350 while( isdigit(*fmt) && (fmtLen > 0) ){
2351 accum = (accum * 10) + (*fmt - '0');
2362 /* suck up the next item as an integer */
2366 goto not_enough_args;
2368 if( Jim_GetWide(interp,objv[0],&wideValue )== JIM_ERR ){
2369 Jim_FreeNewObj(interp, resObjPtr );
2376 /* man 3 printf says */
2377 /* if prec is negative, it is zero */
2396 Jim_FreeNewObj(interp, resObjPtr);
2397 Jim_SetResultString(interp,
2398 "not enough arguments for all format specifiers", -1);
2406 * Create the formatter
2407 * cause we cheat and use sprintf()
2417 /* PLUS overrides */
2427 sprintf( cp, "%d", width );
2431 /* did we find a period? */
2435 /* did something occur after the period? */
2437 sprintf( cp, "%d", prec );
2443 /* here we do the work */
2444 /* actually - we make sprintf() do it for us */
2449 /* BUG: we do not handled embeded NULLs */
2450 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, Jim_GetString( objv[0], NULL ));
2455 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2456 Jim_FreeNewObj(interp, resObjPtr);
2459 c = (char) wideValue;
2460 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, c );
2470 if( Jim_GetDouble( interp, objv[0], &doubleValue ) == JIM_ERR ){
2471 Jim_FreeNewObj( interp, resObjPtr );
2474 snprintf( sprintf_buf, JIM_MAX_FMT, fmt_str, doubleValue );
2483 /* jim widevaluse are 64bit */
2484 if( sizeof(jim_wide) == sizeof(long long) ){
2492 if (Jim_GetWide(interp, objv[0], &wideValue) == JIM_ERR) {
2493 Jim_FreeNewObj(interp, resObjPtr);
2496 snprintf(sprintf_buf, JIM_MAX_FMT, fmt_str, wideValue );
2499 sprintf_buf[0] = '%';
2501 objv--; /* undo the objv++ below */
2504 spec[0] = *fmt; spec[1] = '\0';
2505 Jim_FreeNewObj(interp, resObjPtr);
2506 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2507 Jim_AppendStrings(interp, Jim_GetResult(interp),
2508 "bad field specifier \"", spec, "\"", NULL);
2511 /* force terminate */
2513 printf("FMT was: %s\n", fmt_str );
2514 printf("RES was: |%s|\n", sprintf_buf );
2517 sprintf_buf[ JIM_MAX_FMT - 1] = 0;
2518 Jim_AppendString( interp, resObjPtr, sprintf_buf, strlen(sprintf_buf) );
2527 Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr,
2528 int objc, Jim_Obj *const *objv)
2530 char *sprintf_buf=malloc(JIM_MAX_FMT);
2531 Jim_Obj *t=Jim_FormatString_Inner(interp, fmtObjPtr, objc, objv, sprintf_buf);
2536 /* -----------------------------------------------------------------------------
2537 * Compared String Object
2538 * ---------------------------------------------------------------------------*/
2540 /* This is strange object that allows to compare a C literal string
2541 * with a Jim object in very short time if the same comparison is done
2542 * multiple times. For example every time the [if] command is executed,
2543 * Jim has to check if a given argument is "else". This comparions if
2544 * the code has no errors are true most of the times, so we can cache
2545 * inside the object the pointer of the string of the last matching
2546 * comparison. Because most C compilers perform literal sharing,
2547 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
2548 * this works pretty well even if comparisons are at different places
2549 * inside the C code. */
2551 static Jim_ObjType comparedStringObjType = {
2556 JIM_TYPE_REFERENCES,
2559 /* The only way this object is exposed to the API is via the following
2560 * function. Returns true if the string and the object string repr.
2561 * are the same, otherwise zero is returned.
2563 * Note: this isn't binary safe, but it hardly needs to be.*/
2564 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr,
2567 if (objPtr->typePtr == &comparedStringObjType &&
2568 objPtr->internalRep.ptr == str)
2571 const char *objStr = Jim_GetString(objPtr, NULL);
2572 if (strcmp(str, objStr) != 0) return 0;
2573 if (objPtr->typePtr != &comparedStringObjType) {
2574 Jim_FreeIntRep(interp, objPtr);
2575 objPtr->typePtr = &comparedStringObjType;
2577 objPtr->internalRep.ptr = (char*)str; /*ATTENTION: const cast */
2582 int qsortCompareStringPointers(const void *a, const void *b)
2584 char * const *sa = (char * const *)a;
2585 char * const *sb = (char * const *)b;
2586 return strcmp(*sa, *sb);
2589 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
2590 const char * const *tablePtr, int *indexPtr, const char *name, int flags)
2592 const char * const *entryPtr = NULL;
2593 char **tablePtrSorted;
2597 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
2598 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
2602 count++; /* If nothing matches, this will reach the len of tablePtr */
2604 if (flags & JIM_ERRMSG) {
2607 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
2608 Jim_AppendStrings(interp, Jim_GetResult(interp),
2609 "bad ", name, " \"", Jim_GetString(objPtr, NULL), "\": must be one of ",
2611 tablePtrSorted = Jim_Alloc(sizeof(char*)*count);
2612 memcpy(tablePtrSorted, tablePtr, sizeof(char*)*count);
2613 qsort(tablePtrSorted, count, sizeof(char*), qsortCompareStringPointers);
2614 for (i = 0; i < count; i++) {
2615 if (i+1 == count && count > 1)
2616 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
2617 Jim_AppendString(interp, Jim_GetResult(interp),
2618 tablePtrSorted[i], -1);
2620 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
2622 Jim_Free(tablePtrSorted);
2627 int Jim_GetNvp(Jim_Interp *interp,
2629 const Jim_Nvp *nvp_table,
2630 const Jim_Nvp ** result)
2635 e = Jim_Nvp_name2value_obj( interp, nvp_table, objPtr, &n );
2640 /* Success? found? */
2643 *result = (Jim_Nvp *)n;
2650 /* -----------------------------------------------------------------------------
2653 * This object is just a string from the language point of view, but
2654 * in the internal representation it contains the filename and line number
2655 * where this given token was read. This information is used by
2656 * Jim_EvalObj() if the object passed happens to be of type "source".
2658 * This allows to propagate the information about line numbers and file
2659 * names and give error messages with absolute line numbers.
2661 * Note that this object uses shared strings for filenames, and the
2662 * pointer to the filename together with the line number is taken into
2663 * the space for the "inline" internal represenation of the Jim_Object,
2664 * so there is almost memory zero-overhead.
2666 * Also the object will be converted to something else if the given
2667 * token it represents in the source file is not something to be
2668 * evaluated (not a script), and will be specialized in some other way,
2669 * so the time overhead is alzo null.
2670 * ---------------------------------------------------------------------------*/
2672 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2673 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2675 static Jim_ObjType sourceObjType = {
2677 FreeSourceInternalRep,
2678 DupSourceInternalRep,
2680 JIM_TYPE_REFERENCES,
2683 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2685 Jim_ReleaseSharedString(interp,
2686 objPtr->internalRep.sourceValue.fileName);
2689 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2691 dupPtr->internalRep.sourceValue.fileName =
2692 Jim_GetSharedString(interp,
2693 srcPtr->internalRep.sourceValue.fileName);
2694 dupPtr->internalRep.sourceValue.lineNumber =
2695 dupPtr->internalRep.sourceValue.lineNumber;
2696 dupPtr->typePtr = &sourceObjType;
2699 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
2700 const char *fileName, int lineNumber)
2702 if (Jim_IsShared(objPtr))
2703 Jim_Panic(interp,"JimSetSourceInfo called with shared object");
2704 if (objPtr->typePtr != NULL)
2705 Jim_Panic(interp,"JimSetSourceInfo called with typePtr != NULL");
2706 objPtr->internalRep.sourceValue.fileName =
2707 Jim_GetSharedString(interp, fileName);
2708 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
2709 objPtr->typePtr = &sourceObjType;
2712 /* -----------------------------------------------------------------------------
2714 * ---------------------------------------------------------------------------*/
2716 #define JIM_CMDSTRUCT_EXPAND -1
2718 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2719 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2720 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2722 static Jim_ObjType scriptObjType = {
2724 FreeScriptInternalRep,
2725 DupScriptInternalRep,
2727 JIM_TYPE_REFERENCES,
2730 /* The ScriptToken structure represents every token into a scriptObj.
2731 * Every token contains an associated Jim_Obj that can be specialized
2732 * by commands operating on it. */
2733 typedef struct ScriptToken {
2739 /* This is the script object internal representation. An array of
2740 * ScriptToken structures, with an associated command structure array.
2741 * The command structure is a pre-computed representation of the
2742 * command length and arguments structure as a simple liner array
2745 * For example the script:
2748 * set $i $x$y [foo]BAR
2750 * will produce a ScriptObj with the following Tokens:
2767 * This is a description of the tokens, separators, and of lines.
2768 * The command structure instead represents the number of arguments
2769 * of every command, followed by the tokens of which every argument
2770 * is composed. So for the example script, the cmdstruct array will
2775 * Because "puts hello" has two args (2), composed of single tokens (1 1)
2776 * While "set $i $x$y [foo]BAR" has four (4) args, the first two
2777 * composed of single tokens (1 1) and the last two of double tokens
2780 * The precomputation of the command structure makes Jim_Eval() faster,
2781 * and simpler because there aren't dynamic lengths / allocations.
2783 * -- {expand} handling --
2785 * Expand is handled in a special way. When a command
2786 * contains at least an argument with the {expand} prefix,
2787 * the command structure presents a -1 before the integer
2788 * describing the number of arguments. This is used in order
2789 * to send the command exection to a different path in case
2790 * of {expand} and guarantee a fast path for the more common
2791 * case. Also, the integers describing the number of tokens
2792 * are expressed with negative sign, to allow for fast check
2793 * of what's an {expand}-prefixed argument and what not.
2795 * For example the command:
2797 * list {expand}{1 2}
2799 * Will produce the following cmdstruct array:
2803 * -- the substFlags field of the structure --
2805 * The scriptObj structure is used to represent both "script" objects
2806 * and "subst" objects. In the second case, the cmdStruct related
2807 * fields are not used at all, but there is an additional field used
2808 * that is 'substFlags': this represents the flags used to turn
2809 * the string into the intenral representation used to perform the
2810 * substitution. If this flags are not what the application requires
2811 * the scriptObj is created again. For example the script:
2813 * subst -nocommands $string
2814 * subst -novariables $string
2816 * Will recreate the internal representation of the $string object
2819 typedef struct ScriptObj {
2820 int len; /* Length as number of tokens. */
2821 int commands; /* number of top-level commands in script. */
2822 ScriptToken *token; /* Tokens array. */
2823 int *cmdStruct; /* commands structure */
2824 int csLen; /* length of the cmdStruct array. */
2825 int substFlags; /* flags used for the compilation of "subst" objects */
2826 int inUse; /* Used to share a ScriptObj. Currently
2827 only used by Jim_EvalObj() as protection against
2828 shimmering of the currently evaluated object. */
2832 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2835 struct ScriptObj *script = (void*) objPtr->internalRep.ptr;
2838 if (script->inUse != 0) return;
2839 for (i = 0; i < script->len; i++) {
2840 if (script->token[i].objPtr != NULL)
2841 Jim_DecrRefCount(interp, script->token[i].objPtr);
2843 Jim_Free(script->token);
2844 Jim_Free(script->cmdStruct);
2845 Jim_Free(script->fileName);
2849 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2851 JIM_NOTUSED(interp);
2852 JIM_NOTUSED(srcPtr);
2854 /* Just returns an simple string. */
2855 dupPtr->typePtr = NULL;
2858 /* Add a new token to the internal repr of a script object */
2859 static void ScriptObjAddToken(Jim_Interp *interp, struct ScriptObj *script,
2860 char *strtoken, int len, int type, char *filename, int linenr)
2863 struct ScriptToken *token;
2865 prevtype = (script->len == 0) ? JIM_TT_EOL : \
2866 script->token[script->len-1].type;
2867 /* Skip tokens without meaning, like words separators
2868 * following a word separator or an end of command and
2870 if (prevtype == JIM_TT_EOL) {
2871 if (type == JIM_TT_EOL || type == JIM_TT_SEP) {
2875 } else if (prevtype == JIM_TT_SEP) {
2876 if (type == JIM_TT_SEP) {
2879 } else if (type == JIM_TT_EOL) {
2880 /* If an EOL is following by a SEP, drop the previous
2883 Jim_DecrRefCount(interp, script->token[script->len].objPtr);
2885 } else if (prevtype != JIM_TT_EOL && prevtype != JIM_TT_SEP &&
2886 type == JIM_TT_ESC && len == 0)
2888 /* Don't add empty tokens used in interpolation */
2892 /* Make space for a new istruction */
2894 script->token = Jim_Realloc(script->token,
2895 sizeof(ScriptToken)*script->len);
2896 /* Initialize the new token */
2897 token = script->token+(script->len-1);
2899 /* Every object is intially as a string, but the
2900 * internal type may be specialized during execution of the
2902 token->objPtr = Jim_NewStringObjNoAlloc(interp, strtoken, len);
2903 /* To add source info to SEP and EOL tokens is useless because
2904 * they will never by called as arguments of Jim_EvalObj(). */
2905 if (filename && type != JIM_TT_SEP && type != JIM_TT_EOL)
2906 JimSetSourceInfo(interp, token->objPtr, filename, linenr);
2907 Jim_IncrRefCount(token->objPtr);
2908 token->linenr = linenr;
2911 /* Add an integer into the command structure field of the script object. */
2912 static void ScriptObjAddInt(struct ScriptObj *script, int val)
2915 script->cmdStruct = Jim_Realloc(script->cmdStruct,
2916 sizeof(int)*script->csLen);
2917 script->cmdStruct[script->csLen-1] = val;
2920 /* Search a Jim_Obj contained in 'script' with the same stinrg repr.
2921 * of objPtr. Search nested script objects recursively. */
2922 static Jim_Obj *ScriptSearchLiteral(Jim_Interp *interp, ScriptObj *script,
2923 ScriptObj *scriptBarrier, Jim_Obj *objPtr)
2927 for (i = 0; i < script->len; i++) {
2928 if (script->token[i].objPtr != objPtr &&
2929 Jim_StringEqObj(script->token[i].objPtr, objPtr, 0)) {
2930 return script->token[i].objPtr;
2932 /* Enter recursively on scripts only if the object
2933 * is not the same as the one we are searching for
2934 * shared occurrences. */
2935 if (script->token[i].objPtr->typePtr == &scriptObjType &&
2936 script->token[i].objPtr != objPtr) {
2937 Jim_Obj *foundObjPtr;
2939 ScriptObj *subScript =
2940 script->token[i].objPtr->internalRep.ptr;
2941 /* Don't recursively enter the script we are trying
2942 * to make shared to avoid circular references. */
2943 if (subScript == scriptBarrier) continue;
2944 if (subScript != script) {
2946 ScriptSearchLiteral(interp, subScript,
2947 scriptBarrier, objPtr);
2948 if (foundObjPtr != NULL)
2956 /* Share literals of a script recursively sharing sub-scripts literals. */
2957 static void ScriptShareLiterals(Jim_Interp *interp, ScriptObj *script,
2958 ScriptObj *topLevelScript)
2963 /* Try to share with toplevel object. */
2964 if (topLevelScript != NULL) {
2965 for (i = 0; i < script->len; i++) {
2966 Jim_Obj *foundObjPtr;
2967 char *str = script->token[i].objPtr->bytes;
2969 if (script->token[i].objPtr->refCount != 1) continue;
2970 if (script->token[i].objPtr->typePtr == &scriptObjType) continue;
2971 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2972 foundObjPtr = ScriptSearchLiteral(interp,
2974 script, /* barrier */
2975 script->token[i].objPtr);
2976 if (foundObjPtr != NULL) {
2977 Jim_IncrRefCount(foundObjPtr);
2978 Jim_DecrRefCount(interp,
2979 script->token[i].objPtr);
2980 script->token[i].objPtr = foundObjPtr;
2984 /* Try to share locally */
2985 for (i = 0; i < script->len; i++) {
2986 char *str = script->token[i].objPtr->bytes;
2988 if (script->token[i].objPtr->refCount != 1) continue;
2989 if (strchr(str, ' ') || strchr(str, '\n')) continue;
2990 for (j = 0; j < script->len; j++) {
2991 if (script->token[i].objPtr !=
2992 script->token[j].objPtr &&
2993 Jim_StringEqObj(script->token[i].objPtr,
2994 script->token[j].objPtr, 0))
2996 Jim_IncrRefCount(script->token[j].objPtr);
2997 Jim_DecrRefCount(interp,
2998 script->token[i].objPtr);
2999 script->token[i].objPtr =
3000 script->token[j].objPtr;
3006 /* This method takes the string representation of an object
3007 * as a Tcl script, and generates the pre-parsed internal representation
3009 int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3012 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3013 struct JimParserCtx parser;
3014 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
3016 int args, tokens, start, end, i;
3017 int initialLineNumber;
3018 int propagateSourceInfo = 0;
3022 script->commands = 0;
3023 script->token = NULL;
3024 script->cmdStruct = NULL;
3026 /* Try to get information about filename / line number */
3027 if (objPtr->typePtr == &sourceObjType) {
3029 Jim_StrDup(objPtr->internalRep.sourceValue.fileName);
3030 initialLineNumber = objPtr->internalRep.sourceValue.lineNumber;
3031 propagateSourceInfo = 1;
3033 script->fileName = Jim_StrDup("");
3034 initialLineNumber = 1;
3037 JimParserInit(&parser, scriptText, scriptTextLen, initialLineNumber);
3038 while(!JimParserEof(&parser)) {
3040 int len, type, linenr;
3042 JimParseScript(&parser);
3043 token = JimParserGetToken(&parser, &len, &type, &linenr);
3044 ScriptObjAddToken(interp, script, token, len, type,
3045 propagateSourceInfo ? script->fileName : NULL,
3048 token = script->token;
3050 /* Compute the command structure array
3051 * (see the ScriptObj struct definition for more info) */
3052 start = 0; /* Current command start token index */
3053 end = -1; /* Current command end token index */
3055 int expand = 0; /* expand flag. set to 1 on {expand} form. */
3056 int interpolation = 0; /* set to 1 if there is at least one
3057 argument of the command obtained via
3058 interpolation of more tokens. */
3059 /* Search for the end of command, while
3060 * count the number of args. */
3062 if (start >= script->len) break;
3063 args = 1; /* Number of args in current command */
3064 while (token[end].type != JIM_TT_EOL) {
3065 if (end == 0 || token[end-1].type == JIM_TT_SEP ||
3066 token[end-1].type == JIM_TT_EOL)
3068 if (token[end].type == JIM_TT_STR &&
3069 token[end+1].type != JIM_TT_SEP &&
3070 token[end+1].type != JIM_TT_EOL &&
3071 (!strcmp(token[end].objPtr->bytes, "expand") ||
3072 !strcmp(token[end].objPtr->bytes, "*")))
3075 if (token[end].type == JIM_TT_SEP)
3079 interpolation = !((end-start+1) == args*2);
3080 /* Add the 'number of arguments' info into cmdstruct.
3081 * Negative value if there is list expansion involved. */
3083 ScriptObjAddInt(script, -1);
3084 ScriptObjAddInt(script, args);
3085 /* Now add info about the number of tokens. */
3086 tokens = 0; /* Number of tokens in current argument. */
3088 for (i = start; i <= end; i++) {
3089 if (token[i].type == JIM_TT_SEP ||
3090 token[i].type == JIM_TT_EOL)
3092 if (tokens == 1 && expand)
3094 ScriptObjAddInt(script,
3095 expand ? -tokens : tokens);
3100 } else if (tokens == 0 && token[i].type == JIM_TT_STR &&
3101 (!strcmp(token[i].objPtr->bytes, "expand") ||
3102 !strcmp(token[i].objPtr->bytes, "*")))
3109 /* Perform literal sharing, but only for objects that appear
3110 * to be scripts written as literals inside the source code,
3111 * and not computed at runtime. Literal sharing is a costly
3112 * operation that should be done only against objects that
3113 * are likely to require compilation only the first time, and
3114 * then are executed multiple times. */
3115 if (propagateSourceInfo && interp->framePtr->procBodyObjPtr) {
3116 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
3117 if (bodyObjPtr->typePtr == &scriptObjType) {
3118 ScriptObj *bodyScript =
3119 bodyObjPtr->internalRep.ptr;
3120 ScriptShareLiterals(interp, script, bodyScript);
3122 } else if (propagateSourceInfo) {
3123 ScriptShareLiterals(interp, script, NULL);
3125 /* Free the old internal rep and set the new one. */
3126 Jim_FreeIntRep(interp, objPtr);
3127 Jim_SetIntRepPtr(objPtr, script);
3128 objPtr->typePtr = &scriptObjType;
3132 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3134 if (objPtr->typePtr != &scriptObjType) {
3135 SetScriptFromAny(interp, objPtr);
3137 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
3140 /* -----------------------------------------------------------------------------
3142 * ---------------------------------------------------------------------------*/
3144 /* Commands HashTable Type.
3146 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3147 static void Jim_CommandsHT_ValDestructor(void *interp, void *val)
3149 Jim_Cmd *cmdPtr = (void*) val;
3151 if (cmdPtr->cmdProc == NULL) {
3152 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3153 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3154 if (cmdPtr->staticVars) {
3155 Jim_FreeHashTable(cmdPtr->staticVars);
3156 Jim_Free(cmdPtr->staticVars);
3158 } else if (cmdPtr->delProc != NULL) {
3159 /* If it was a C coded command, call the delProc if any */
3160 cmdPtr->delProc(interp, cmdPtr->privData);
3165 static Jim_HashTableType JimCommandsHashTableType = {
3166 JimStringCopyHTHashFunction, /* hash function */
3167 JimStringCopyHTKeyDup, /* key dup */
3169 JimStringCopyHTKeyCompare, /* key compare */
3170 JimStringCopyHTKeyDestructor, /* key destructor */
3171 Jim_CommandsHT_ValDestructor /* val destructor */
3174 /* ------------------------- Commands related functions --------------------- */
3176 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
3177 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3182 he = Jim_FindHashEntry(&interp->commands, cmdName);
3183 if (he == NULL) { /* New command to create */
3184 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3185 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3187 Jim_InterpIncrProcEpoch(interp);
3188 /* Free the arglist/body objects if it was a Tcl procedure */
3190 if (cmdPtr->cmdProc == NULL) {
3191 Jim_DecrRefCount(interp, cmdPtr->argListObjPtr);
3192 Jim_DecrRefCount(interp, cmdPtr->bodyObjPtr);
3193 if (cmdPtr->staticVars) {
3194 Jim_FreeHashTable(cmdPtr->staticVars);
3195 Jim_Free(cmdPtr->staticVars);
3197 cmdPtr->staticVars = NULL;
3198 } else if (cmdPtr->delProc != NULL) {
3199 /* If it was a C coded command, call the delProc if any */
3200 cmdPtr->delProc(interp, cmdPtr->privData);
3204 /* Store the new details for this proc */
3205 cmdPtr->delProc = delProc;
3206 cmdPtr->cmdProc = cmdProc;
3207 cmdPtr->privData = privData;
3209 /* There is no need to increment the 'proc epoch' because
3210 * creation of a new procedure can never affect existing
3211 * cached commands. We don't do negative caching. */
3215 int Jim_CreateProcedure(Jim_Interp *interp, const char *cmdName,
3216 Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
3217 int arityMin, int arityMax)
3221 cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3222 cmdPtr->cmdProc = NULL; /* Not a C coded command */
3223 cmdPtr->argListObjPtr = argListObjPtr;
3224 cmdPtr->bodyObjPtr = bodyObjPtr;
3225 Jim_IncrRefCount(argListObjPtr);
3226 Jim_IncrRefCount(bodyObjPtr);
3227 cmdPtr->arityMin = arityMin;
3228 cmdPtr->arityMax = arityMax;
3229 cmdPtr->staticVars = NULL;
3231 /* Create the statics hash table. */
3232 if (staticsListObjPtr) {
3235 Jim_ListLength(interp, staticsListObjPtr, &len);
3237 cmdPtr->staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3238 Jim_InitHashTable(cmdPtr->staticVars, &JimVariablesHashTableType,
3240 for (i = 0; i < len; i++) {
3241 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3245 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3246 /* Check if it's composed of two elements. */
3247 Jim_ListLength(interp, objPtr, &subLen);
3248 if (subLen == 1 || subLen == 2) {
3249 /* Try to get the variable value from the current
3251 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3253 initObjPtr = Jim_GetVariable(interp, nameObjPtr,
3255 if (initObjPtr == NULL) {
3256 Jim_SetResult(interp,
3257 Jim_NewEmptyStringObj(interp));
3258 Jim_AppendStrings(interp, Jim_GetResult(interp),
3259 "variable for initialization of static \"",
3260 Jim_GetString(nameObjPtr, NULL),
3261 "\" not found in the local context",
3266 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3268 varPtr = Jim_Alloc(sizeof(*varPtr));
3269 varPtr->objPtr = initObjPtr;
3270 Jim_IncrRefCount(initObjPtr);
3271 varPtr->linkFramePtr = NULL;
3272 if (Jim_AddHashEntry(cmdPtr->staticVars,
3273 Jim_GetString(nameObjPtr, NULL),
3276 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3277 Jim_AppendStrings(interp, Jim_GetResult(interp),
3278 "static variable name \"",
3279 Jim_GetString(objPtr, NULL), "\"",
3280 " duplicated in statics list", NULL);
3281 Jim_DecrRefCount(interp, initObjPtr);
3286 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3287 Jim_AppendStrings(interp, Jim_GetResult(interp),
3288 "too many fields in static specifier \"",
3289 objPtr, "\"", NULL);
3296 /* Add the new command */
3298 /* it may already exist, so we try to delete the old one */
3299 if (Jim_DeleteHashEntry(&interp->commands, cmdName) != JIM_ERR) {
3300 /* There was an old procedure with the same name, this requires
3301 * a 'proc epoch' update. */
3302 Jim_InterpIncrProcEpoch(interp);
3304 /* If a procedure with the same name didn't existed there is no need
3305 * to increment the 'proc epoch' because creation of a new procedure
3306 * can never affect existing cached commands. We don't do
3307 * negative caching. */
3308 Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
3312 Jim_FreeHashTable(cmdPtr->staticVars);
3313 Jim_Free(cmdPtr->staticVars);
3314 Jim_DecrRefCount(interp, argListObjPtr);
3315 Jim_DecrRefCount(interp, bodyObjPtr);
3320 int Jim_DeleteCommand(Jim_Interp *interp, const char *cmdName)
3322 if (Jim_DeleteHashEntry(&interp->commands, cmdName) == JIM_ERR)
3324 Jim_InterpIncrProcEpoch(interp);
3328 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName,
3329 const char *newName)
3333 Jim_Cmd *copyCmdPtr;
3335 if (newName[0] == '\0') /* Delete! */
3336 return Jim_DeleteCommand(interp, oldName);
3338 he = Jim_FindHashEntry(&interp->commands, oldName);
3340 return JIM_ERR; /* Invalid command name */
3342 copyCmdPtr = Jim_Alloc(sizeof(Jim_Cmd));
3343 *copyCmdPtr = *cmdPtr;
3344 /* In order to avoid that a procedure will get arglist/body/statics
3345 * freed by the hash table methods, fake a C-coded command
3346 * setting cmdPtr->cmdProc as not NULL */
3347 cmdPtr->cmdProc = (void*)1;
3348 /* Also make sure delProc is NULL. */
3349 cmdPtr->delProc = NULL;
3350 /* Destroy the old command, and make sure the new is freed
3352 Jim_DeleteHashEntry(&interp->commands, oldName);
3353 Jim_DeleteHashEntry(&interp->commands, newName);
3354 /* Now the new command. We are sure it can't fail because
3355 * the target name was already freed. */
3356 Jim_AddHashEntry(&interp->commands, newName, copyCmdPtr);
3357 /* Increment the epoch */
3358 Jim_InterpIncrProcEpoch(interp);
3362 /* -----------------------------------------------------------------------------
3364 * ---------------------------------------------------------------------------*/
3366 static int SetCommandFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3368 static Jim_ObjType commandObjType = {
3373 JIM_TYPE_REFERENCES,
3376 int SetCommandFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
3379 const char *cmdName;
3381 /* Get the string representation */
3382 cmdName = Jim_GetString(objPtr, NULL);
3383 /* Lookup this name into the commands hash table */
3384 he = Jim_FindHashEntry(&interp->commands, cmdName);
3388 /* Free the old internal repr and set the new one. */
3389 Jim_FreeIntRep(interp, objPtr);
3390 objPtr->typePtr = &commandObjType;
3391 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
3392 objPtr->internalRep.cmdValue.cmdPtr = (void*)he->val;
3396 /* This function returns the command structure for the command name
3397 * stored in objPtr. It tries to specialize the objPtr to contain
3398 * a cached info instead to perform the lookup into the hash table
3399 * every time. The information cached may not be uptodate, in such
3400 * a case the lookup is performed and the cache updated. */
3401 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
3403 if ((objPtr->typePtr != &commandObjType ||
3404 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch) &&
3405 SetCommandFromAny(interp, objPtr) == JIM_ERR) {
3406 if (flags & JIM_ERRMSG) {
3407 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3408 Jim_AppendStrings(interp, Jim_GetResult(interp),
3409 "invalid command name \"", objPtr->bytes, "\"",
3414 return objPtr->internalRep.cmdValue.cmdPtr;
3417 /* -----------------------------------------------------------------------------
3419 * ---------------------------------------------------------------------------*/
3421 /* Variables HashTable Type.
3423 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3424 static void JimVariablesHTValDestructor(void *interp, void *val)
3426 Jim_Var *varPtr = (void*) val;
3428 Jim_DecrRefCount(interp, varPtr->objPtr);
3432 static Jim_HashTableType JimVariablesHashTableType = {
3433 JimStringCopyHTHashFunction, /* hash function */
3434 JimStringCopyHTKeyDup, /* key dup */
3436 JimStringCopyHTKeyCompare, /* key compare */
3437 JimStringCopyHTKeyDestructor, /* key destructor */
3438 JimVariablesHTValDestructor /* val destructor */
3441 /* -----------------------------------------------------------------------------
3443 * ---------------------------------------------------------------------------*/
3445 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
3447 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3449 static Jim_ObjType variableObjType = {
3454 JIM_TYPE_REFERENCES,
3457 /* Return true if the string "str" looks like syntax sugar for [dict]. I.e.
3458 * is in the form "varname(key)". */
3459 static int Jim_NameIsDictSugar(const char *str, int len)
3463 if (len && str[len-1] == ')' && strchr(str, '(') != NULL)
3468 /* This method should be called only by the variable API.
3469 * It returns JIM_OK on success (variable already exists),
3470 * JIM_ERR if it does not exists, JIM_DICT_GLUE if it's not
3471 * a variable name, but syntax glue for [dict] i.e. the last
3472 * character is ')' */
3473 int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3476 const char *varName;
3479 /* Check if the object is already an uptodate variable */
3480 if (objPtr->typePtr == &variableObjType &&
3481 objPtr->internalRep.varValue.callFrameId == interp->framePtr->id)
3482 return JIM_OK; /* nothing to do */
3483 /* Get the string representation */
3484 varName = Jim_GetString(objPtr, &len);
3485 /* Make sure it's not syntax glue to get/set dict. */
3486 if (Jim_NameIsDictSugar(varName, len))
3487 return JIM_DICT_SUGAR;
3488 if (varName[0] == ':' && varName[1] == ':') {
3489 he = Jim_FindHashEntry(&interp->topFramePtr->vars, varName + 2);
3495 /* Lookup this name into the variables hash table */
3496 he = Jim_FindHashEntry(&interp->framePtr->vars, varName);
3498 /* Try with static vars. */
3499 if (interp->framePtr->staticVars == NULL)
3501 if (!(he = Jim_FindHashEntry(interp->framePtr->staticVars, varName)))
3505 /* Free the old internal repr and set the new one. */
3506 Jim_FreeIntRep(interp, objPtr);
3507 objPtr->typePtr = &variableObjType;
3508 objPtr->internalRep.varValue.callFrameId = interp->framePtr->id;
3509 objPtr->internalRep.varValue.varPtr = (void*)he->val;
3513 /* -------------------- Variables related functions ------------------------- */
3514 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr,
3515 Jim_Obj *valObjPtr);
3516 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr);
3518 /* For now that's dummy. Variables lookup should be optimized
3519 * in many ways, with caching of lookups, and possibly with
3520 * a table of pre-allocated vars in every CallFrame for local vars.
3521 * All the caching should also have an 'epoch' mechanism similar
3522 * to the one used by Tcl for procedures lookup caching. */
3524 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
3530 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3531 /* Check for [dict] syntax sugar. */
3532 if (err == JIM_DICT_SUGAR)
3533 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
3534 /* New variable to create */
3535 name = Jim_GetString(nameObjPtr, NULL);
3537 var = Jim_Alloc(sizeof(*var));
3538 var->objPtr = valObjPtr;
3539 Jim_IncrRefCount(valObjPtr);
3540 var->linkFramePtr = NULL;
3541 /* Insert the new variable */
3542 if (name[0] == ':' && name[1] == ':') {
3543 /* Into to the top evel frame */
3544 Jim_AddHashEntry(&interp->topFramePtr->vars, name + 2, var);
3547 Jim_AddHashEntry(&interp->framePtr->vars, name, var);
3549 /* Make the object int rep a variable */
3550 Jim_FreeIntRep(interp, nameObjPtr);
3551 nameObjPtr->typePtr = &variableObjType;
3552 nameObjPtr->internalRep.varValue.callFrameId =
3553 interp->framePtr->id;
3554 nameObjPtr->internalRep.varValue.varPtr = var;
3556 var = nameObjPtr->internalRep.varValue.varPtr;
3557 if (var->linkFramePtr == NULL) {
3558 Jim_IncrRefCount(valObjPtr);
3559 Jim_DecrRefCount(interp, var->objPtr);
3560 var->objPtr = valObjPtr;
3561 } else { /* Else handle the link */
3562 Jim_CallFrame *savedCallFrame;
3564 savedCallFrame = interp->framePtr;
3565 interp->framePtr = var->linkFramePtr;
3566 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
3567 interp->framePtr = savedCallFrame;
3575 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3577 Jim_Obj *nameObjPtr;
3580 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3581 Jim_IncrRefCount(nameObjPtr);
3582 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
3583 Jim_DecrRefCount(interp, nameObjPtr);
3587 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
3589 Jim_CallFrame *savedFramePtr;
3592 savedFramePtr = interp->framePtr;
3593 interp->framePtr = interp->topFramePtr;
3594 result = Jim_SetVariableStr(interp, name, objPtr);
3595 interp->framePtr = savedFramePtr;
3599 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
3601 Jim_Obj *nameObjPtr, *valObjPtr;
3604 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3605 valObjPtr = Jim_NewStringObj(interp, val, -1);
3606 Jim_IncrRefCount(nameObjPtr);
3607 Jim_IncrRefCount(valObjPtr);
3608 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
3609 Jim_DecrRefCount(interp, nameObjPtr);
3610 Jim_DecrRefCount(interp, valObjPtr);
3614 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3615 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
3617 const char *varName;
3620 /* Check for cycles. */
3621 if (interp->framePtr == targetCallFrame) {
3622 Jim_Obj *objPtr = targetNameObjPtr;
3624 /* Cycles are only possible with 'uplevel 0' */
3626 if (Jim_StringEqObj(objPtr, nameObjPtr, 0)) {
3627 Jim_SetResultString(interp,
3628 "can't upvar from variable to itself", -1);
3631 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
3633 varPtr = objPtr->internalRep.varValue.varPtr;
3634 if (varPtr->linkFramePtr != targetCallFrame) break;
3635 objPtr = varPtr->objPtr;
3638 varName = Jim_GetString(nameObjPtr, &len);
3639 if (Jim_NameIsDictSugar(varName, len)) {
3640 Jim_SetResultString(interp,
3641 "Dict key syntax invalid as link source", -1);
3644 /* Perform the binding */
3645 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
3646 /* We are now sure 'nameObjPtr' type is variableObjType */
3647 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
3651 /* Return the Jim_Obj pointer associated with a variable name,
3652 * or NULL if the variable was not found in the current context.
3653 * The same optimization discussed in the comment to the
3654 * 'SetVariable' function should apply here. */
3655 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3659 /* All the rest is handled here */
3660 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3661 /* Check for [dict] syntax sugar. */
3662 if (err == JIM_DICT_SUGAR)
3663 return JimDictSugarGet(interp, nameObjPtr);
3664 if (flags & JIM_ERRMSG) {
3665 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3666 Jim_AppendStrings(interp, Jim_GetResult(interp),
3667 "can't read \"", nameObjPtr->bytes,
3668 "\": no such variable", NULL);
3674 Jim_CallFrame *savedCallFrame;
3676 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3677 if (varPtr->linkFramePtr == NULL)
3678 return varPtr->objPtr;
3679 /* The variable is a link? Resolve it. */
3680 savedCallFrame = interp->framePtr;
3681 interp->framePtr = varPtr->linkFramePtr;
3682 objPtr = Jim_GetVariable(interp, varPtr->objPtr, JIM_NONE);
3683 if (objPtr == NULL && flags & JIM_ERRMSG) {
3684 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3685 Jim_AppendStrings(interp, Jim_GetResult(interp),
3686 "can't read \"", nameObjPtr->bytes,
3687 "\": no such variable", NULL);
3689 interp->framePtr = savedCallFrame;
3694 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr,
3697 Jim_CallFrame *savedFramePtr;
3700 savedFramePtr = interp->framePtr;
3701 interp->framePtr = interp->topFramePtr;
3702 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3703 interp->framePtr = savedFramePtr;
3708 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
3710 Jim_Obj *nameObjPtr, *varObjPtr;
3712 nameObjPtr = Jim_NewStringObj(interp, name, -1);
3713 Jim_IncrRefCount(nameObjPtr);
3714 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
3715 Jim_DecrRefCount(interp, nameObjPtr);
3719 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name,
3722 Jim_CallFrame *savedFramePtr;
3725 savedFramePtr = interp->framePtr;
3726 interp->framePtr = interp->topFramePtr;
3727 objPtr = Jim_GetVariableStr(interp, name, flags);
3728 interp->framePtr = savedFramePtr;
3733 /* Unset a variable.
3734 * Note: On success unset invalidates all the variable objects created
3735 * in the current call frame incrementing. */
3736 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
3742 if ((err = SetVariableFromAny(interp, nameObjPtr)) != JIM_OK) {
3743 /* Check for [dict] syntax sugar. */
3744 if (err == JIM_DICT_SUGAR)
3745 return JimDictSugarSet(interp, nameObjPtr, NULL);
3746 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3747 Jim_AppendStrings(interp, Jim_GetResult(interp),
3748 "can't unset \"", nameObjPtr->bytes,
3749 "\": no such variable", NULL);
3750 return JIM_ERR; /* var not found */
3752 varPtr = nameObjPtr->internalRep.varValue.varPtr;
3753 /* If it's a link call UnsetVariable recursively */
3754 if (varPtr->linkFramePtr) {
3757 Jim_CallFrame *savedCallFrame;
3759 savedCallFrame = interp->framePtr;
3760 interp->framePtr = varPtr->linkFramePtr;
3761 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
3762 interp->framePtr = savedCallFrame;
3763 if (retval != JIM_OK && flags & JIM_ERRMSG) {
3764 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
3765 Jim_AppendStrings(interp, Jim_GetResult(interp),
3766 "can't unset \"", nameObjPtr->bytes,
3767 "\": no such variable", NULL);
3771 name = Jim_GetString(nameObjPtr, NULL);
3772 if (Jim_DeleteHashEntry(&interp->framePtr->vars, name)
3773 != JIM_OK) return JIM_ERR;
3774 /* Change the callframe id, invalidating var lookup caching */
3775 JimChangeCallFrameId(interp, interp->framePtr);
3780 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
3782 /* Given a variable name for [dict] operation syntax sugar,
3783 * this function returns two objects, the first with the name
3784 * of the variable to set, and the second with the rispective key.
3785 * For example "foo(bar)" will return objects with string repr. of
3788 * The returned objects have refcount = 1. The function can't fail. */
3789 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
3790 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
3792 const char *str, *p;
3794 int len, keyLen, nameLen;
3795 Jim_Obj *varObjPtr, *keyObjPtr;
3797 str = Jim_GetString(objPtr, &len);
3798 p = strchr(str, '(');
3800 keyLen = len-((p-str)+1);
3801 nameLen = (p-str)-1;
3802 /* Create the objects with the variable name and key. */
3803 t = Jim_Alloc(nameLen+1);
3804 memcpy(t, str, nameLen);
3806 varObjPtr = Jim_NewStringObjNoAlloc(interp, t, nameLen);
3808 t = Jim_Alloc(keyLen+1);
3809 memcpy(t, p, keyLen);
3811 keyObjPtr = Jim_NewStringObjNoAlloc(interp, t, keyLen);
3813 Jim_IncrRefCount(varObjPtr);
3814 Jim_IncrRefCount(keyObjPtr);
3815 *varPtrPtr = varObjPtr;
3816 *keyPtrPtr = keyObjPtr;
3819 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
3820 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
3821 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr,
3824 Jim_Obj *varObjPtr, *keyObjPtr;
3827 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3828 err = Jim_SetDictKeysVector(interp, varObjPtr, &keyObjPtr, 1,
3830 Jim_DecrRefCount(interp, varObjPtr);
3831 Jim_DecrRefCount(interp, keyObjPtr);
3835 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
3836 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr)
3838 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3840 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3841 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
3846 if (Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_ERRMSG)
3851 Jim_DecrRefCount(interp, varObjPtr);
3852 Jim_DecrRefCount(interp, keyObjPtr);
3856 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
3858 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3859 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3862 static Jim_ObjType dictSubstObjType = {
3863 "dict-substitution",
3864 FreeDictSubstInternalRep,
3865 DupDictSubstInternalRep,
3870 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3872 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
3873 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
3876 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr,
3879 JIM_NOTUSED(interp);
3881 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
3882 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
3883 dupPtr->internalRep.dictSubstValue.indexObjPtr =
3884 srcPtr->internalRep.dictSubstValue.indexObjPtr;
3885 dupPtr->typePtr = &dictSubstObjType;
3888 /* This function is used to expand [dict get] sugar in the form
3889 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
3890 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
3891 * object that is *guaranteed* to be in the form VARNAME(INDEX).
3892 * The 'index' part is [subst]ituted, and is used to lookup a key inside
3893 * the [dict]ionary contained in variable VARNAME. */
3894 Jim_Obj *Jim_ExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
3896 Jim_Obj *varObjPtr, *keyObjPtr, *dictObjPtr, *resObjPtr;
3897 Jim_Obj *substKeyObjPtr = NULL;
3899 if (objPtr->typePtr != &dictSubstObjType) {
3900 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
3901 Jim_FreeIntRep(interp, objPtr);
3902 objPtr->typePtr = &dictSubstObjType;
3903 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
3904 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
3906 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
3907 &substKeyObjPtr, JIM_NONE)
3909 substKeyObjPtr = NULL;
3912 Jim_IncrRefCount(substKeyObjPtr);
3913 dictObjPtr = Jim_GetVariable(interp,
3914 objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_ERRMSG);
3919 if (Jim_DictKey(interp, dictObjPtr, substKeyObjPtr, &resObjPtr, JIM_ERRMSG)
3925 if (substKeyObjPtr) Jim_DecrRefCount(interp, substKeyObjPtr);
3929 /* -----------------------------------------------------------------------------
3931 * ---------------------------------------------------------------------------*/
3933 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp)
3936 if (interp->freeFramesList) {
3937 cf = interp->freeFramesList;
3938 interp->freeFramesList = cf->nextFramePtr;
3940 cf = Jim_Alloc(sizeof(*cf));
3941 cf->vars.table = NULL;
3944 cf->id = interp->callFrameEpoch++;
3945 cf->parentCallFrame = NULL;
3948 cf->procArgsObjPtr = NULL;
3949 cf->procBodyObjPtr = NULL;
3950 cf->nextFramePtr = NULL;
3951 cf->staticVars = NULL;
3952 if (cf->vars.table == NULL)
3953 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
3957 /* Used to invalidate every caching related to callframe stability. */
3958 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
3960 cf->id = interp->callFrameEpoch++;
3963 #define JIM_FCF_NONE 0 /* no flags */
3964 #define JIM_FCF_NOHT 1 /* don't free the hash table */
3965 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf,
3968 if (cf->procArgsObjPtr) Jim_DecrRefCount(interp, cf->procArgsObjPtr);
3969 if (cf->procBodyObjPtr) Jim_DecrRefCount(interp, cf->procBodyObjPtr);
3970 if (!(flags & JIM_FCF_NOHT))
3971 Jim_FreeHashTable(&cf->vars);
3974 Jim_HashEntry **table = cf->vars.table, *he;
3976 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
3978 while (he != NULL) {
3979 Jim_HashEntry *nextEntry = he->next;
3980 Jim_Var *varPtr = (void*) he->val;
3982 Jim_DecrRefCount(interp, varPtr->objPtr);
3984 Jim_Free((void*)he->key); /* ATTENTION: const cast */
3992 cf->nextFramePtr = interp->freeFramesList;
3993 interp->freeFramesList = cf;
3996 /* -----------------------------------------------------------------------------
3998 * ---------------------------------------------------------------------------*/
4000 /* References HashTable Type.
4002 * Keys are jim_wide integers, dynamically allocated for now but in the
4003 * future it's worth to cache this 8 bytes objects. Values are poitners
4004 * to Jim_References. */
4005 static void JimReferencesHTValDestructor(void *interp, void *val)
4007 Jim_Reference *refPtr = (void*) val;
4009 Jim_DecrRefCount(interp, refPtr->objPtr);
4010 if (refPtr->finalizerCmdNamePtr != NULL) {
4011 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4016 unsigned int JimReferencesHTHashFunction(const void *key)
4018 /* Only the least significant bits are used. */
4019 const jim_wide *widePtr = key;
4020 unsigned int intValue = (unsigned int) *widePtr;
4021 return Jim_IntHashFunction(intValue);
4024 unsigned int JimReferencesHTDoubleHashFunction(const void *key)
4026 /* Only the least significant bits are used. */
4027 const jim_wide *widePtr = key;
4028 unsigned int intValue = (unsigned int) *widePtr;
4029 return intValue; /* identity function. */
4032 const void *JimReferencesHTKeyDup(void *privdata, const void *key)
4034 void *copy = Jim_Alloc(sizeof(jim_wide));
4035 JIM_NOTUSED(privdata);
4037 memcpy(copy, key, sizeof(jim_wide));
4041 int JimReferencesHTKeyCompare(void *privdata, const void *key1,
4044 JIM_NOTUSED(privdata);
4046 return memcmp(key1, key2, sizeof(jim_wide)) == 0;
4049 void JimReferencesHTKeyDestructor(void *privdata, const void *key)
4051 JIM_NOTUSED(privdata);
4053 Jim_Free((void*)key);
4056 static Jim_HashTableType JimReferencesHashTableType = {
4057 JimReferencesHTHashFunction, /* hash function */
4058 JimReferencesHTKeyDup, /* key dup */
4060 JimReferencesHTKeyCompare, /* key compare */
4061 JimReferencesHTKeyDestructor, /* key destructor */
4062 JimReferencesHTValDestructor /* val destructor */
4065 /* -----------------------------------------------------------------------------
4066 * Reference object type and References API
4067 * ---------------------------------------------------------------------------*/
4069 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
4071 static Jim_ObjType referenceObjType = {
4075 UpdateStringOfReference,
4076 JIM_TYPE_REFERENCES,
4079 void UpdateStringOfReference(struct Jim_Obj *objPtr)
4082 char buf[JIM_REFERENCE_SPACE+1];
4083 Jim_Reference *refPtr;
4085 refPtr = objPtr->internalRep.refValue.refPtr;
4086 len = JimFormatReference(buf, refPtr, objPtr->internalRep.refValue.id);
4087 objPtr->bytes = Jim_Alloc(len+1);
4088 memcpy(objPtr->bytes, buf, len+1);
4089 objPtr->length = len;
4092 /* returns true if 'c' is a valid reference tag character.
4093 * i.e. inside the range [_a-zA-Z0-9] */
4094 static int isrefchar(int c)
4096 if (c == '_' || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
4097 (c >= '0' && c <= '9')) return 1;
4101 int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4105 const char *str, *start, *end;
4107 Jim_Reference *refPtr;
4110 /* Get the string representation */
4111 str = Jim_GetString(objPtr, &len);
4112 /* Check if it looks like a reference */
4113 if (len < JIM_REFERENCE_SPACE) goto badformat;
4117 while (*start == ' ') start++;
4118 while (*end == ' ' && end > start) end--;
4119 if (end-start+1 != JIM_REFERENCE_SPACE) goto badformat;
4120 /* <reference.<1234567>.%020> */
4121 if (memcmp(start, "<reference.<", 12) != 0) goto badformat;
4122 if (start[12+JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>') goto badformat;
4123 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
4124 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4125 if (!isrefchar(start[12+i])) goto badformat;
4127 /* Extract info from the refernece. */
4128 memcpy(refId, start+14+JIM_REFERENCE_TAGLEN, 20);
4130 /* Try to convert the ID into a jim_wide */
4131 if (Jim_StringToWide(refId, &wideValue, 10) != JIM_OK) goto badformat;
4132 /* Check if the reference really exists! */
4133 he = Jim_FindHashEntry(&interp->references, &wideValue);
4135 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4136 Jim_AppendStrings(interp, Jim_GetResult(interp),
4137 "Invalid reference ID \"", str, "\"", NULL);
4141 /* Free the old internal repr and set the new one. */
4142 Jim_FreeIntRep(interp, objPtr);
4143 objPtr->typePtr = &referenceObjType;
4144 objPtr->internalRep.refValue.id = wideValue;
4145 objPtr->internalRep.refValue.refPtr = refPtr;
4149 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4150 Jim_AppendStrings(interp, Jim_GetResult(interp),
4151 "expected reference but got \"", str, "\"", NULL);
4155 /* Returns a new reference pointing to objPtr, having cmdNamePtr
4156 * as finalizer command (or NULL if there is no finalizer).
4157 * The returned reference object has refcount = 0. */
4158 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr,
4159 Jim_Obj *cmdNamePtr)
4161 struct Jim_Reference *refPtr;
4162 jim_wide wideValue = interp->referenceNextId;
4167 /* Perform the Garbage Collection if needed. */
4168 Jim_CollectIfNeeded(interp);
4170 refPtr = Jim_Alloc(sizeof(*refPtr));
4171 refPtr->objPtr = objPtr;
4172 Jim_IncrRefCount(objPtr);
4173 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4175 Jim_IncrRefCount(cmdNamePtr);
4176 Jim_AddHashEntry(&interp->references, &wideValue, refPtr);
4177 refObjPtr = Jim_NewObj(interp);
4178 refObjPtr->typePtr = &referenceObjType;
4179 refObjPtr->bytes = NULL;
4180 refObjPtr->internalRep.refValue.id = interp->referenceNextId;
4181 refObjPtr->internalRep.refValue.refPtr = refPtr;
4182 interp->referenceNextId++;
4183 /* Set the tag. Trimmered at JIM_REFERENCE_TAGLEN. Everything
4184 * that does not pass the 'isrefchar' test is replaced with '_' */
4185 tag = Jim_GetString(tagPtr, &tagLen);
4186 if (tagLen > JIM_REFERENCE_TAGLEN)
4187 tagLen = JIM_REFERENCE_TAGLEN;
4188 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
4190 refPtr->tag[i] = tag[i];
4192 refPtr->tag[i] = '_';
4194 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
4198 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
4200 if (objPtr->typePtr != &referenceObjType &&
4201 SetReferenceFromAny(interp, objPtr) == JIM_ERR)
4203 return objPtr->internalRep.refValue.refPtr;
4206 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
4208 Jim_Reference *refPtr;
4210 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4212 Jim_IncrRefCount(cmdNamePtr);
4213 if (refPtr->finalizerCmdNamePtr)
4214 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4215 refPtr->finalizerCmdNamePtr = cmdNamePtr;
4219 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
4221 Jim_Reference *refPtr;
4223 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
4225 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
4229 /* -----------------------------------------------------------------------------
4230 * References Garbage Collection
4231 * ---------------------------------------------------------------------------*/
4233 /* This the hash table type for the "MARK" phase of the GC */
4234 static Jim_HashTableType JimRefMarkHashTableType = {
4235 JimReferencesHTHashFunction, /* hash function */
4236 JimReferencesHTKeyDup, /* key dup */
4238 JimReferencesHTKeyCompare, /* key compare */
4239 JimReferencesHTKeyDestructor, /* key destructor */
4240 NULL /* val destructor */
4243 /* #define JIM_DEBUG_GC 1 */
4245 /* Performs the garbage collection. */
4246 int Jim_Collect(Jim_Interp *interp)
4248 Jim_HashTable marks;
4249 Jim_HashTableIterator *htiter;
4254 /* Avoid recursive calls */
4255 if (interp->lastCollectId == -1) {
4256 /* Jim_Collect() already running. Return just now. */
4259 interp->lastCollectId = -1;
4261 /* Mark all the references found into the 'mark' hash table.
4262 * The references are searched in every live object that
4263 * is of a type that can contain references. */
4264 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
4265 objPtr = interp->liveList;
4267 if (objPtr->typePtr == NULL ||
4268 objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
4269 const char *str, *p;
4272 /* If the object is of type reference, to get the
4273 * Id is simple... */
4274 if (objPtr->typePtr == &referenceObjType) {
4275 Jim_AddHashEntry(&marks,
4276 &objPtr->internalRep.refValue.id, NULL);
4278 Jim_fprintf(interp,interp->cookie_stdout,
4279 "MARK (reference): %d refcount: %d" JIM_NL,
4280 (int) objPtr->internalRep.refValue.id,
4283 objPtr = objPtr->nextObjPtr;
4286 /* Get the string repr of the object we want
4287 * to scan for references. */
4288 p = str = Jim_GetString(objPtr, &len);
4289 /* Skip objects too little to contain references. */
4290 if (len < JIM_REFERENCE_SPACE) {
4291 objPtr = objPtr->nextObjPtr;
4294 /* Extract references from the object string repr. */
4300 if ((p = strstr(p, "<reference.<")) == NULL)
4302 /* Check if it's a valid reference. */
4303 if (len-(p-str) < JIM_REFERENCE_SPACE) break;
4304 if (p[41] != '>' || p[19] != '>' || p[20] != '.') break;
4305 for (i = 21; i <= 40; i++)
4306 if (!isdigit((int)p[i]))
4309 memcpy(buf, p+21, 20);
4311 Jim_StringToWide(buf, &id, 10);
4313 /* Ok, a reference for the given ID
4314 * was found. Mark it. */
4315 Jim_AddHashEntry(&marks, &id, NULL);
4317 Jim_fprintf(interp,interp->cookie_stdout,"MARK: %d" JIM_NL, (int)id);
4319 p += JIM_REFERENCE_SPACE;
4322 objPtr = objPtr->nextObjPtr;
4325 /* Run the references hash table to destroy every reference that
4326 * is not referenced outside (not present in the mark HT). */
4327 htiter = Jim_GetHashTableIterator(&interp->references);
4328 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
4329 const jim_wide *refId;
4330 Jim_Reference *refPtr;
4333 /* Check if in the mark phase we encountered
4334 * this reference. */
4335 if (Jim_FindHashEntry(&marks, refId) == NULL) {
4337 Jim_fprintf(interp,interp->cookie_stdout,"COLLECTING %d" JIM_NL, (int)*refId);
4340 /* Drop the reference, but call the
4341 * finalizer first if registered. */
4343 if (refPtr->finalizerCmdNamePtr) {
4344 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE+1);
4345 Jim_Obj *objv[3], *oldResult;
4347 JimFormatReference(refstr, refPtr, *refId);
4349 objv[0] = refPtr->finalizerCmdNamePtr;
4350 objv[1] = Jim_NewStringObjNoAlloc(interp,
4352 objv[2] = refPtr->objPtr;
4353 Jim_IncrRefCount(objv[0]);
4354 Jim_IncrRefCount(objv[1]);
4355 Jim_IncrRefCount(objv[2]);
4357 /* Drop the reference itself */
4358 Jim_DeleteHashEntry(&interp->references, refId);
4360 /* Call the finalizer. Errors ignored. */
4361 oldResult = interp->result;
4362 Jim_IncrRefCount(oldResult);
4363 Jim_EvalObjVector(interp, 3, objv);
4364 Jim_SetResult(interp, oldResult);
4365 Jim_DecrRefCount(interp, oldResult);
4367 Jim_DecrRefCount(interp, objv[0]);
4368 Jim_DecrRefCount(interp, objv[1]);
4369 Jim_DecrRefCount(interp, objv[2]);
4371 Jim_DeleteHashEntry(&interp->references, refId);
4375 Jim_FreeHashTableIterator(htiter);
4376 Jim_FreeHashTable(&marks);
4377 interp->lastCollectId = interp->referenceNextId;
4378 interp->lastCollectTime = time(NULL);
4382 #define JIM_COLLECT_ID_PERIOD 5000
4383 #define JIM_COLLECT_TIME_PERIOD 300
4385 void Jim_CollectIfNeeded(Jim_Interp *interp)
4390 elapsedId = interp->referenceNextId - interp->lastCollectId;
4391 elapsedTime = time(NULL) - interp->lastCollectTime;
4394 if (elapsedId > JIM_COLLECT_ID_PERIOD ||
4395 elapsedTime > JIM_COLLECT_TIME_PERIOD) {
4396 Jim_Collect(interp);
4400 /* -----------------------------------------------------------------------------
4401 * Interpreter related functions
4402 * ---------------------------------------------------------------------------*/
4404 Jim_Interp *Jim_CreateInterp(void)
4406 Jim_Interp *i = Jim_Alloc(sizeof(*i));
4410 i->errorFileName = Jim_StrDup("");
4412 i->maxNestingDepth = JIM_MAX_NESTING_DEPTH;
4413 i->returnCode = JIM_OK;
4416 i->callFrameEpoch = 0;
4417 i->liveList = i->freeList = NULL;
4418 i->scriptFileName = Jim_StrDup("");
4419 i->referenceNextId = 0;
4420 i->lastCollectId = 0;
4421 i->lastCollectTime = time(NULL);
4422 i->freeFramesList = NULL;
4423 i->prngState = NULL;
4424 i->evalRetcodeLevel = -1;
4425 i->cookie_stdin = stdin;
4426 i->cookie_stdout = stdout;
4427 i->cookie_stderr = stderr;
4428 i->cb_fwrite = ((size_t (*)( const void *, size_t, size_t, void *))(fwrite));
4429 i->cb_fread = ((size_t (*)( void *, size_t, size_t, void *))(fread));
4430 i->cb_vfprintf = ((int (*)( void *, const char *fmt, va_list ))(vfprintf));
4431 i->cb_fflush = ((int (*)( void *))(fflush));
4432 i->cb_fgets = ((char * (*)( char *, int, void *))(fgets));
4434 /* Note that we can create objects only after the
4435 * interpreter liveList and freeList pointers are
4436 * initialized to NULL. */
4437 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
4438 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
4439 Jim_InitHashTable(&i->sharedStrings, &JimSharedStringsHashTableType,
4441 Jim_InitHashTable(&i->stub, &JimStringCopyHashTableType, NULL);
4442 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
4443 Jim_InitHashTable(&i->packages, &JimStringKeyValCopyHashTableType, NULL);
4444 i->framePtr = i->topFramePtr = JimCreateCallFrame(i);
4445 i->emptyObj = Jim_NewEmptyStringObj(i);
4446 i->result = i->emptyObj;
4447 i->stackTrace = Jim_NewListObj(i, NULL, 0);
4448 i->unknown = Jim_NewStringObj(i, "unknown", -1);
4449 i->unknown_called = 0;
4450 Jim_IncrRefCount(i->emptyObj);
4451 Jim_IncrRefCount(i->result);
4452 Jim_IncrRefCount(i->stackTrace);
4453 Jim_IncrRefCount(i->unknown);
4455 /* Initialize key variables every interpreter should contain */
4456 pathPtr = Jim_NewStringObj(i, "./", -1);
4457 Jim_SetVariableStr(i, "jim_libpath", pathPtr);
4458 Jim_SetVariableStrWithStr(i, "jim_interactive", "0");
4460 /* Export the core API to extensions */
4461 JimRegisterCoreApi(i);
4465 /* This is the only function Jim exports directly without
4466 * to use the STUB system. It is only used by embedders
4467 * in order to get an interpreter with the Jim API pointers
4469 Jim_Interp *ExportedJimCreateInterp(void)
4471 return Jim_CreateInterp();
4474 void Jim_FreeInterp(Jim_Interp *i)
4476 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
4477 Jim_Obj *objPtr, *nextObjPtr;
4479 Jim_DecrRefCount(i, i->emptyObj);
4480 Jim_DecrRefCount(i, i->result);
4481 Jim_DecrRefCount(i, i->stackTrace);
4482 Jim_DecrRefCount(i, i->unknown);
4483 Jim_Free((void*)i->errorFileName);
4484 Jim_Free((void*)i->scriptFileName);
4485 Jim_FreeHashTable(&i->commands);
4486 Jim_FreeHashTable(&i->references);
4487 Jim_FreeHashTable(&i->stub);
4488 Jim_FreeHashTable(&i->assocData);
4489 Jim_FreeHashTable(&i->packages);
4490 Jim_Free(i->prngState);
4491 /* Free the call frames list */
4493 prevcf = cf->parentCallFrame;
4494 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
4497 /* Check that the live object list is empty, otherwise
4498 * there is a memory leak. */
4499 if (i->liveList != NULL) {
4500 Jim_Obj *objPtr = i->liveList;
4502 Jim_fprintf( i, i->cookie_stdout,JIM_NL "-------------------------------------" JIM_NL);
4503 Jim_fprintf( i, i->cookie_stdout,"Objects still in the free list:" JIM_NL);
4505 const char *type = objPtr->typePtr ?
4506 objPtr->typePtr->name : "";
4507 Jim_fprintf( i, i->cookie_stdout,"%p \"%-10s\": '%.20s' (refCount: %d)" JIM_NL,
4509 objPtr->bytes ? objPtr->bytes
4510 : "(null)", objPtr->refCount);
4511 if (objPtr->typePtr == &sourceObjType) {
4512 Jim_fprintf( i, i->cookie_stdout, "FILE %s LINE %d" JIM_NL,
4513 objPtr->internalRep.sourceValue.fileName,
4514 objPtr->internalRep.sourceValue.lineNumber);
4516 objPtr = objPtr->nextObjPtr;
4518 Jim_fprintf( i, i->cookie_stdout, "-------------------------------------" JIM_NL JIM_NL);
4519 Jim_Panic(i,"Live list non empty freeing the interpreter! Leak?");
4521 /* Free all the freed objects. */
4522 objPtr = i->freeList;
4524 nextObjPtr = objPtr->nextObjPtr;
4526 objPtr = nextObjPtr;
4528 /* Free cached CallFrame structures */
4529 cf = i->freeFramesList;
4531 nextcf = cf->nextFramePtr;
4532 if (cf->vars.table != NULL)
4533 Jim_Free(cf->vars.table);
4537 /* Free the sharedString hash table. Make sure to free it
4538 * after every other Jim_Object was freed. */
4539 Jim_FreeHashTable(&i->sharedStrings);
4540 /* Free the interpreter structure. */
4544 /* Store the call frame relative to the level represented by
4545 * levelObjPtr into *framePtrPtr. If levelObjPtr == NULL, the
4546 * level is assumed to be '1'.
4548 * If a newLevelptr int pointer is specified, the function stores
4549 * the absolute level integer value of the new target callframe into
4550 * *newLevelPtr. (this is used to adjust interp->numLevels
4551 * in the implementation of [uplevel], so that [info level] will
4552 * return a correct information).
4554 * This function accepts the 'level' argument in the form
4555 * of the commands [uplevel] and [upvar].
4557 * For a function accepting a relative integer as level suitable
4558 * for implementation of [info level ?level?] check the
4559 * GetCallFrameByInteger() function. */
4560 int Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4561 Jim_CallFrame **framePtrPtr, int *newLevelPtr)
4565 Jim_CallFrame *framePtr;
4567 if (newLevelPtr) *newLevelPtr = interp->numLevels;
4569 str = Jim_GetString(levelObjPtr, NULL);
4570 if (str[0] == '#') {
4572 /* speedup for the toplevel (level #0) */
4573 if (str[1] == '0' && str[2] == '\0') {
4574 if (newLevelPtr) *newLevelPtr = 0;
4575 *framePtrPtr = interp->topFramePtr;
4579 level = strtol(str+1, &endptr, 0);
4580 if (str[1] == '\0' || endptr[0] != '\0' || level < 0)
4582 /* An 'absolute' level is converted into the
4583 * 'number of levels to go back' format. */
4584 level = interp->numLevels - level;
4585 if (level < 0) goto badlevel;
4587 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0)
4591 str = "1"; /* Needed to format the error message. */
4595 framePtr = interp->framePtr;
4596 if (newLevelPtr) *newLevelPtr = (*newLevelPtr)-level;
4598 framePtr = framePtr->parentCallFrame;
4599 if (framePtr == NULL) goto badlevel;
4601 *framePtrPtr = framePtr;
4604 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4605 Jim_AppendStrings(interp, Jim_GetResult(interp),
4606 "bad level \"", str, "\"", NULL);
4610 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
4611 * as a relative integer like in the [info level ?level?] command. */
4612 static int JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr,
4613 Jim_CallFrame **framePtrPtr)
4616 jim_wide relLevel; /* level relative to the current one. */
4617 Jim_CallFrame *framePtr;
4619 if (Jim_GetWide(interp, levelObjPtr, &level) != JIM_OK)
4622 /* An 'absolute' level is converted into the
4623 * 'number of levels to go back' format. */
4624 relLevel = interp->numLevels - level;
4629 framePtr = interp->framePtr;
4630 while (relLevel--) {
4631 framePtr = framePtr->parentCallFrame;
4632 if (framePtr == NULL) goto badlevel;
4634 *framePtrPtr = framePtr;
4637 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4638 Jim_AppendStrings(interp, Jim_GetResult(interp),
4639 "bad level \"", Jim_GetString(levelObjPtr, NULL), "\"", NULL);
4643 static void JimSetErrorFileName(Jim_Interp *interp, char *filename)
4645 Jim_Free((void*)interp->errorFileName);
4646 interp->errorFileName = Jim_StrDup(filename);
4649 static void JimSetErrorLineNumber(Jim_Interp *interp, int linenr)
4651 interp->errorLine = linenr;
4654 static void JimResetStackTrace(Jim_Interp *interp)
4656 Jim_DecrRefCount(interp, interp->stackTrace);
4657 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
4658 Jim_IncrRefCount(interp->stackTrace);
4661 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
4662 const char *filename, int linenr)
4664 /* No need to add this dummy entry to the stack trace */
4665 if (strcmp(procname, "unknown") == 0) {
4669 if (Jim_IsShared(interp->stackTrace)) {
4670 interp->stackTrace =
4671 Jim_DuplicateObj(interp, interp->stackTrace);
4672 Jim_IncrRefCount(interp->stackTrace);
4674 Jim_ListAppendElement(interp, interp->stackTrace,
4675 Jim_NewStringObj(interp, procname, -1));
4676 Jim_ListAppendElement(interp, interp->stackTrace,
4677 Jim_NewStringObj(interp, filename, -1));
4678 Jim_ListAppendElement(interp, interp->stackTrace,
4679 Jim_NewIntObj(interp, linenr));
4682 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data)
4684 AssocDataValue *assocEntryPtr = (AssocDataValue *)Jim_Alloc(sizeof(AssocDataValue));
4685 assocEntryPtr->delProc = delProc;
4686 assocEntryPtr->data = data;
4687 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
4690 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
4692 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
4693 if (entryPtr != NULL) {
4694 AssocDataValue *assocEntryPtr = (AssocDataValue *)entryPtr->val;
4695 return assocEntryPtr->data;
4700 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
4702 return Jim_DeleteHashEntry(&interp->assocData, key);
4705 int Jim_GetExitCode(Jim_Interp *interp) {
4706 return interp->exitCode;
4709 void *Jim_SetStdin(Jim_Interp *interp, void *fp)
4711 if (fp != NULL) interp->cookie_stdin = fp;
4712 return interp->cookie_stdin;
4715 void *Jim_SetStdout(Jim_Interp *interp, void *fp)
4717 if (fp != NULL) interp->cookie_stdout = fp;
4718 return interp->cookie_stdout;
4721 void *Jim_SetStderr(Jim_Interp *interp, void *fp)
4723 if (fp != NULL) interp->cookie_stderr = fp;
4724 return interp->cookie_stderr;
4727 /* -----------------------------------------------------------------------------
4729 * Every interpreter has an hash table where to put shared dynamically
4730 * allocate strings that are likely to be used a lot of times.
4731 * For example, in the 'source' object type, there is a pointer to
4732 * the filename associated with that object. Every script has a lot
4733 * of this objects with the identical file name, so it is wise to share
4736 * The API is trivial: Jim_GetSharedString(interp, "foobar")
4737 * returns the pointer to the shared string. Every time a reference
4738 * to the string is no longer used, the user should call
4739 * Jim_ReleaseSharedString(interp, stringPointer). Once no one is using
4740 * a given string, it is removed from the hash table.
4741 * ---------------------------------------------------------------------------*/
4742 const char *Jim_GetSharedString(Jim_Interp *interp, const char *str)
4744 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4747 char *strCopy = Jim_StrDup(str);
4749 Jim_AddHashEntry(&interp->sharedStrings, strCopy, (void*)1);
4752 long refCount = (long) he->val;
4755 he->val = (void*) refCount;
4760 void Jim_ReleaseSharedString(Jim_Interp *interp, const char *str)
4763 Jim_HashEntry *he = Jim_FindHashEntry(&interp->sharedStrings, str);
4766 Jim_Panic(interp,"Jim_ReleaseSharedString called with "
4767 "unknown shared string '%s'", str);
4768 refCount = (long) he->val;
4770 if (refCount == 0) {
4771 Jim_DeleteHashEntry(&interp->sharedStrings, str);
4773 he->val = (void*) refCount;
4777 /* -----------------------------------------------------------------------------
4779 * ---------------------------------------------------------------------------*/
4780 #define JIM_INTEGER_SPACE 24
4782 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
4783 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
4785 static Jim_ObjType intObjType = {
4793 void UpdateStringOfInt(struct Jim_Obj *objPtr)
4796 char buf[JIM_INTEGER_SPACE+1];
4798 len = Jim_WideToString(buf, objPtr->internalRep.wideValue);
4799 objPtr->bytes = Jim_Alloc(len+1);
4800 memcpy(objPtr->bytes, buf, len+1);
4801 objPtr->length = len;
4804 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4809 /* Get the string representation */
4810 str = Jim_GetString(objPtr, NULL);
4811 /* Try to convert into a jim_wide */
4812 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
4813 if (flags & JIM_ERRMSG) {
4814 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4815 Jim_AppendStrings(interp, Jim_GetResult(interp),
4816 "expected integer but got \"", str, "\"", NULL);
4820 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) &&
4822 Jim_SetResultString(interp,
4823 "Integer value too big to be represented", -1);
4826 /* Free the old internal repr and set the new one. */
4827 Jim_FreeIntRep(interp, objPtr);
4828 objPtr->typePtr = &intObjType;
4829 objPtr->internalRep.wideValue = wideValue;
4833 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr)
4835 if (objPtr->typePtr != &intObjType &&
4836 SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
4838 *widePtr = objPtr->internalRep.wideValue;
4842 /* Get a wide but does not set an error if the format is bad. */
4843 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr,
4846 if (objPtr->typePtr != &intObjType &&
4847 SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
4849 *widePtr = objPtr->internalRep.wideValue;
4853 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
4858 retval = Jim_GetWide(interp, objPtr, &wideValue);
4859 if (retval == JIM_OK) {
4860 *longPtr = (long) wideValue;
4866 void Jim_SetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide wideValue)
4868 if (Jim_IsShared(objPtr))
4869 Jim_Panic(interp,"Jim_SetWide called with shared object");
4870 if (objPtr->typePtr != &intObjType) {
4871 Jim_FreeIntRep(interp, objPtr);
4872 objPtr->typePtr = &intObjType;
4874 Jim_InvalidateStringRep(objPtr);
4875 objPtr->internalRep.wideValue = wideValue;
4878 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
4882 objPtr = Jim_NewObj(interp);
4883 objPtr->typePtr = &intObjType;
4884 objPtr->bytes = NULL;
4885 objPtr->internalRep.wideValue = wideValue;
4889 /* -----------------------------------------------------------------------------
4891 * ---------------------------------------------------------------------------*/
4892 #define JIM_DOUBLE_SPACE 30
4894 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
4895 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
4897 static Jim_ObjType doubleObjType = {
4901 UpdateStringOfDouble,
4905 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
4908 char buf[JIM_DOUBLE_SPACE+1];
4910 len = Jim_DoubleToString(buf, objPtr->internalRep.doubleValue);
4911 objPtr->bytes = Jim_Alloc(len+1);
4912 memcpy(objPtr->bytes, buf, len+1);
4913 objPtr->length = len;
4916 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4921 /* Get the string representation */
4922 str = Jim_GetString(objPtr, NULL);
4923 /* Try to convert into a double */
4924 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
4925 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
4926 Jim_AppendStrings(interp, Jim_GetResult(interp),
4927 "expected number but got '", str, "'", NULL);
4930 /* Free the old internal repr and set the new one. */
4931 Jim_FreeIntRep(interp, objPtr);
4932 objPtr->typePtr = &doubleObjType;
4933 objPtr->internalRep.doubleValue = doubleValue;
4937 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
4939 if (objPtr->typePtr != &doubleObjType &&
4940 SetDoubleFromAny(interp, objPtr) == JIM_ERR)
4942 *doublePtr = objPtr->internalRep.doubleValue;
4946 void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double doubleValue)
4948 if (Jim_IsShared(objPtr))
4949 Jim_Panic(interp,"Jim_SetDouble called with shared object");
4950 if (objPtr->typePtr != &doubleObjType) {
4951 Jim_FreeIntRep(interp, objPtr);
4952 objPtr->typePtr = &doubleObjType;
4954 Jim_InvalidateStringRep(objPtr);
4955 objPtr->internalRep.doubleValue = doubleValue;
4958 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
4962 objPtr = Jim_NewObj(interp);
4963 objPtr->typePtr = &doubleObjType;
4964 objPtr->bytes = NULL;
4965 objPtr->internalRep.doubleValue = doubleValue;
4969 /* -----------------------------------------------------------------------------
4971 * ---------------------------------------------------------------------------*/
4972 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
4973 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
4974 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
4975 static void UpdateStringOfList(struct Jim_Obj *objPtr);
4976 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4978 /* Note that while the elements of the list may contain references,
4979 * the list object itself can't. This basically means that the
4980 * list object string representation as a whole can't contain references
4981 * that are not presents in the single elements. */
4982 static Jim_ObjType listObjType = {
4984 FreeListInternalRep,
4990 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4994 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
4995 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
4997 Jim_Free(objPtr->internalRep.listValue.ele);
5000 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5003 JIM_NOTUSED(interp);
5005 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
5006 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
5007 dupPtr->internalRep.listValue.ele =
5008 Jim_Alloc(sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.maxLen);
5009 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
5010 sizeof(Jim_Obj*)*srcPtr->internalRep.listValue.len);
5011 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
5012 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
5014 dupPtr->typePtr = &listObjType;
5017 /* The following function checks if a given string can be encoded
5018 * into a list element without any kind of quoting, surrounded by braces,
5019 * or using escapes to quote. */
5020 #define JIM_ELESTR_SIMPLE 0
5021 #define JIM_ELESTR_BRACE 1
5022 #define JIM_ELESTR_QUOTE 2
5023 static int ListElementQuotingType(const char *s, int len)
5025 int i, level, trySimple = 1;
5027 /* Try with the SIMPLE case */
5028 if (len == 0) return JIM_ELESTR_BRACE;
5029 if (s[0] == '"' || s[0] == '{') {
5033 for (i = 0; i < len; i++) {
5053 return JIM_ELESTR_SIMPLE;
5056 /* Test if it's possible to do with braces */
5057 if (s[len-1] == '\\' ||
5058 s[len-1] == ']') return JIM_ELESTR_QUOTE;
5060 for (i = 0; i < len; i++) {
5062 case '{': level++; break;
5064 if (level < 0) return JIM_ELESTR_QUOTE;
5068 return JIM_ELESTR_QUOTE;
5070 if (s[i+1] != '\0') i++;
5075 if (!trySimple) return JIM_ELESTR_BRACE;
5076 for (i = 0; i < len; i++) {
5090 return JIM_ELESTR_BRACE;
5094 return JIM_ELESTR_SIMPLE;
5096 return JIM_ELESTR_QUOTE;
5099 /* Returns the malloc-ed representation of a string
5100 * using backslash to quote special chars. */
5101 char *BackslashQuoteString(const char *s, int len, int *qlenPtr)
5103 char *q = Jim_Alloc(len*2+1), *p;
5120 case '\n': *p++ = '\\'; *p++ = 'n'; s++; break;
5121 case '\r': *p++ = '\\'; *p++ = 'r'; s++; break;
5122 case '\t': *p++ = '\\'; *p++ = 't'; s++; break;
5123 case '\f': *p++ = '\\'; *p++ = 'f'; s++; break;
5124 case '\v': *p++ = '\\'; *p++ = 'v'; s++; break;
5135 void UpdateStringOfList(struct Jim_Obj *objPtr)
5137 int i, bufLen, realLength;
5141 Jim_Obj **ele = objPtr->internalRep.listValue.ele;
5143 /* (Over) Estimate the space needed. */
5144 quotingType = Jim_Alloc(sizeof(int)*objPtr->internalRep.listValue.len+1);
5146 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5149 strRep = Jim_GetString(ele[i], &len);
5150 quotingType[i] = ListElementQuotingType(strRep, len);
5151 switch (quotingType[i]) {
5152 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5153 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5154 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5156 bufLen++; /* elements separator. */
5160 /* Generate the string rep. */
5161 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5163 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
5165 const char *strRep = Jim_GetString(ele[i], &len);
5168 switch(quotingType[i]) {
5169 case JIM_ELESTR_SIMPLE:
5170 memcpy(p, strRep, len);
5174 case JIM_ELESTR_BRACE:
5176 memcpy(p, strRep, len);
5179 realLength += len+2;
5181 case JIM_ELESTR_QUOTE:
5182 q = BackslashQuoteString(strRep, len, &qlen);
5189 /* Add a separating space */
5190 if (i+1 != objPtr->internalRep.listValue.len) {
5195 *p = '\0'; /* nul term. */
5196 objPtr->length = realLength;
5197 Jim_Free(quotingType);
5200 int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5202 struct JimParserCtx parser;
5206 /* Get the string representation */
5207 str = Jim_GetString(objPtr, &strLen);
5209 /* Free the old internal repr just now and initialize the
5210 * new one just now. The string->list conversion can't fail. */
5211 Jim_FreeIntRep(interp, objPtr);
5212 objPtr->typePtr = &listObjType;
5213 objPtr->internalRep.listValue.len = 0;
5214 objPtr->internalRep.listValue.maxLen = 0;
5215 objPtr->internalRep.listValue.ele = NULL;
5217 /* Convert into a list */
5218 JimParserInit(&parser, str, strLen, 1);
5219 while(!JimParserEof(&parser)) {
5222 Jim_Obj *elementPtr;
5224 JimParseList(&parser);
5225 if (JimParserTtype(&parser) != JIM_TT_STR &&
5226 JimParserTtype(&parser) != JIM_TT_ESC)
5228 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5229 elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5230 ListAppendElement(objPtr, elementPtr);
5235 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements,
5241 objPtr = Jim_NewObj(interp);
5242 objPtr->typePtr = &listObjType;
5243 objPtr->bytes = NULL;
5244 objPtr->internalRep.listValue.ele = NULL;
5245 objPtr->internalRep.listValue.len = 0;
5246 objPtr->internalRep.listValue.maxLen = 0;
5247 for (i = 0; i < len; i++) {
5248 ListAppendElement(objPtr, elements[i]);
5253 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
5254 * length of the vector. Note that the user of this function should make
5255 * sure that the list object can't shimmer while the vector returned
5256 * is in use, this vector is the one stored inside the internal representation
5257 * of the list object. This function is not exported, extensions should
5258 * always access to the List object elements using Jim_ListIndex(). */
5259 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *argc,
5262 Jim_ListLength(interp, listObj, argc);
5263 assert(listObj->typePtr == &listObjType);
5264 *listVec = listObj->internalRep.listValue.ele;
5267 /* ListSortElements type values */
5268 enum {JIM_LSORT_ASCII, JIM_LSORT_NOCASE, JIM_LSORT_ASCII_DECR,
5269 JIM_LSORT_NOCASE_DECR};
5271 /* Sort the internal rep of a list. */
5272 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5274 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0);
5277 static int ListSortStringDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5279 return Jim_StringCompareObj(*lhsObj, *rhsObj, 0) * -1;
5282 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5284 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1);
5287 static int ListSortStringNoCaseDecr(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
5289 return Jim_StringCompareObj(*lhsObj, *rhsObj, 1) * -1;
5292 /* Sort a list *in place*. MUST be called with non-shared objects. */
5293 static void ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, int type)
5295 typedef int (qsort_comparator)(const void *, const void *);
5296 int (*fn)(Jim_Obj**, Jim_Obj**);
5300 if (Jim_IsShared(listObjPtr))
5301 Jim_Panic(interp,"Jim_ListSortElements called with shared object");
5302 if (listObjPtr->typePtr != &listObjType)
5303 SetListFromAny(interp, listObjPtr);
5305 vector = listObjPtr->internalRep.listValue.ele;
5306 len = listObjPtr->internalRep.listValue.len;
5308 case JIM_LSORT_ASCII: fn = ListSortString; break;
5309 case JIM_LSORT_NOCASE: fn = ListSortStringNoCase; break;
5310 case JIM_LSORT_ASCII_DECR: fn = ListSortStringDecr; break;
5311 case JIM_LSORT_NOCASE_DECR: fn = ListSortStringNoCaseDecr; break;
5313 fn = NULL; /* avoid warning */
5314 Jim_Panic(interp,"ListSort called with invalid sort type");
5316 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *)fn);
5317 Jim_InvalidateStringRep(listObjPtr);
5320 /* This is the low-level function to append an element to a list.
5321 * The higher-level Jim_ListAppendElement() performs shared object
5322 * check and invalidate the string repr. This version is used
5323 * in the internals of the List Object and is not exported.
5325 * NOTE: this function can be called only against objects
5326 * with internal type of List. */
5327 void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
5329 int requiredLen = listPtr->internalRep.listValue.len + 1;
5331 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5332 int maxLen = requiredLen * 2;
5334 listPtr->internalRep.listValue.ele =
5335 Jim_Realloc(listPtr->internalRep.listValue.ele,
5336 sizeof(Jim_Obj*)*maxLen);
5337 listPtr->internalRep.listValue.maxLen = maxLen;
5339 listPtr->internalRep.listValue.ele[listPtr->internalRep.listValue.len] =
5341 listPtr->internalRep.listValue.len ++;
5342 Jim_IncrRefCount(objPtr);
5345 /* This is the low-level function to insert elements into a list.
5346 * The higher-level Jim_ListInsertElements() performs shared object
5347 * check and invalidate the string repr. This version is used
5348 * in the internals of the List Object and is not exported.
5350 * NOTE: this function can be called only against objects
5351 * with internal type of List. */
5352 void ListInsertElements(Jim_Obj *listPtr, int index, int elemc,
5353 Jim_Obj *const *elemVec)
5355 int currentLen = listPtr->internalRep.listValue.len;
5356 int requiredLen = currentLen + elemc;
5360 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5361 int maxLen = requiredLen * 2;
5363 listPtr->internalRep.listValue.ele =
5364 Jim_Realloc(listPtr->internalRep.listValue.ele,
5365 sizeof(Jim_Obj*)*maxLen);
5366 listPtr->internalRep.listValue.maxLen = maxLen;
5368 point = listPtr->internalRep.listValue.ele + index;
5369 memmove(point+elemc, point, (currentLen-index) * sizeof(Jim_Obj*));
5370 for (i=0; i < elemc; ++i) {
5371 point[i] = elemVec[i];
5372 Jim_IncrRefCount(point[i]);
5374 listPtr->internalRep.listValue.len += elemc;
5377 /* Appends every element of appendListPtr into listPtr.
5378 * Both have to be of the list type. */
5379 void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5381 int i, oldLen = listPtr->internalRep.listValue.len;
5382 int appendLen = appendListPtr->internalRep.listValue.len;
5383 int requiredLen = oldLen + appendLen;
5385 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
5386 int maxLen = requiredLen * 2;
5388 listPtr->internalRep.listValue.ele =
5389 Jim_Realloc(listPtr->internalRep.listValue.ele,
5390 sizeof(Jim_Obj*)*maxLen);
5391 listPtr->internalRep.listValue.maxLen = maxLen;
5393 for (i = 0; i < appendLen; i++) {
5394 Jim_Obj *objPtr = appendListPtr->internalRep.listValue.ele[i];
5395 listPtr->internalRep.listValue.ele[oldLen+i] = objPtr;
5396 Jim_IncrRefCount(objPtr);
5398 listPtr->internalRep.listValue.len += appendLen;
5401 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
5403 if (Jim_IsShared(listPtr))
5404 Jim_Panic(interp,"Jim_ListAppendElement called with shared object");
5405 if (listPtr->typePtr != &listObjType)
5406 SetListFromAny(interp, listPtr);
5407 Jim_InvalidateStringRep(listPtr);
5408 ListAppendElement(listPtr, objPtr);
5411 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
5413 if (Jim_IsShared(listPtr))
5414 Jim_Panic(interp,"Jim_ListAppendList called with shared object");
5415 if (listPtr->typePtr != &listObjType)
5416 SetListFromAny(interp, listPtr);
5417 Jim_InvalidateStringRep(listPtr);
5418 ListAppendList(listPtr, appendListPtr);
5421 void Jim_ListLength(Jim_Interp *interp, Jim_Obj *listPtr, int *intPtr)
5423 if (listPtr->typePtr != &listObjType)
5424 SetListFromAny(interp, listPtr);
5425 *intPtr = listPtr->internalRep.listValue.len;
5428 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5429 int objc, Jim_Obj *const *objVec)
5431 if (Jim_IsShared(listPtr))
5432 Jim_Panic(interp,"Jim_ListInsertElement called with shared object");
5433 if (listPtr->typePtr != &listObjType)
5434 SetListFromAny(interp, listPtr);
5435 if (index >= 0 && index > listPtr->internalRep.listValue.len)
5436 index = listPtr->internalRep.listValue.len;
5437 else if (index < 0 )
5439 Jim_InvalidateStringRep(listPtr);
5440 ListInsertElements(listPtr, index, objc, objVec);
5443 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5444 Jim_Obj **objPtrPtr, int flags)
5446 if (listPtr->typePtr != &listObjType)
5447 SetListFromAny(interp, listPtr);
5448 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5449 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5450 if (flags & JIM_ERRMSG) {
5451 Jim_SetResultString(interp,
5452 "list index out of range", -1);
5457 index = listPtr->internalRep.listValue.len+index;
5458 *objPtrPtr = listPtr->internalRep.listValue.ele[index];
5462 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int index,
5463 Jim_Obj *newObjPtr, int flags)
5465 if (listPtr->typePtr != &listObjType)
5466 SetListFromAny(interp, listPtr);
5467 if ((index >= 0 && index >= listPtr->internalRep.listValue.len) ||
5468 (index < 0 && (-index-1) >= listPtr->internalRep.listValue.len)) {
5469 if (flags & JIM_ERRMSG) {
5470 Jim_SetResultString(interp,
5471 "list index out of range", -1);
5476 index = listPtr->internalRep.listValue.len+index;
5477 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[index]);
5478 listPtr->internalRep.listValue.ele[index] = newObjPtr;
5479 Jim_IncrRefCount(newObjPtr);
5483 /* Modify the list stored into the variable named 'varNamePtr'
5484 * setting the element specified by the 'indexc' indexes objects in 'indexv',
5485 * with the new element 'newObjptr'. */
5486 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
5487 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
5489 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
5490 int shared, i, index;
5492 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5495 if ((shared = Jim_IsShared(objPtr)))
5496 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5497 for (i = 0; i < indexc-1; i++) {
5498 listObjPtr = objPtr;
5499 if (Jim_GetIndex(interp, indexv[i], &index) != JIM_OK)
5501 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
5502 JIM_ERRMSG) != JIM_OK) {
5505 if (Jim_IsShared(objPtr)) {
5506 objPtr = Jim_DuplicateObj(interp, objPtr);
5507 ListSetIndex(interp, listObjPtr, index, objPtr, JIM_NONE);
5509 Jim_InvalidateStringRep(listObjPtr);
5511 if (Jim_GetIndex(interp, indexv[indexc-1], &index) != JIM_OK)
5513 if (ListSetIndex(interp, objPtr, index, newObjPtr, JIM_ERRMSG) == JIM_ERR)
5515 Jim_InvalidateStringRep(objPtr);
5516 Jim_InvalidateStringRep(varObjPtr);
5517 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
5519 Jim_SetResult(interp, varObjPtr);
5523 Jim_FreeNewObj(interp, varObjPtr);
5528 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
5532 /* If all the objects in objv are lists without string rep.
5533 * it's possible to return a list as result, that's the
5534 * concatenation of all the lists. */
5535 for (i = 0; i < objc; i++) {
5536 if (objv[i]->typePtr != &listObjType || objv[i]->bytes)
5540 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
5541 for (i = 0; i < objc; i++)
5542 Jim_ListAppendList(interp, objPtr, objv[i]);
5545 /* Else... we have to glue strings together */
5546 int len = 0, objLen;
5549 /* Compute the length */
5550 for (i = 0; i < objc; i++) {
5551 Jim_GetString(objv[i], &objLen);
5554 if (objc) len += objc-1;
5555 /* Create the string rep, and a stinrg object holding it. */
5556 p = bytes = Jim_Alloc(len+1);
5557 for (i = 0; i < objc; i++) {
5558 const char *s = Jim_GetString(objv[i], &objLen);
5559 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n'))
5561 s++; objLen--; len--;
5563 while (objLen && (s[objLen-1] == ' ' ||
5564 s[objLen-1] == '\n' || s[objLen-1] == '\t')) {
5567 memcpy(p, s, objLen);
5569 if (objLen && i+1 != objc) {
5571 } else if (i+1 != objc) {
5572 /* Drop the space calcuated for this
5573 * element that is instead null. */
5578 return Jim_NewStringObjNoAlloc(interp, bytes, len);
5582 /* Returns a list composed of the elements in the specified range.
5583 * first and start are directly accepted as Jim_Objects and
5584 * processed for the end?-index? case. */
5585 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
5590 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
5591 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
5593 Jim_ListLength(interp, listObjPtr, &len); /* will convert into list */
5594 first = JimRelToAbsIndex(len, first);
5595 last = JimRelToAbsIndex(len, last);
5596 JimRelToAbsRange(len, first, last, &first, &last, &rangeLen);
5597 return Jim_NewListObj(interp,
5598 listObjPtr->internalRep.listValue.ele+first, rangeLen);
5601 /* -----------------------------------------------------------------------------
5603 * ---------------------------------------------------------------------------*/
5604 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5605 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5606 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
5607 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5609 /* Dict HashTable Type.
5611 * Keys and Values are Jim objects. */
5613 unsigned int JimObjectHTHashFunction(const void *key)
5616 Jim_Obj *objPtr = (Jim_Obj*) key;
5619 str = Jim_GetString(objPtr, &len);
5620 h = Jim_GenHashFunction((unsigned char*)str, len);
5624 int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
5626 JIM_NOTUSED(privdata);
5628 return Jim_StringEqObj((Jim_Obj*)key1, (Jim_Obj*)key2, 0);
5631 static void JimObjectHTKeyValDestructor(void *interp, void *val)
5633 Jim_Obj *objPtr = val;
5635 Jim_DecrRefCount(interp, objPtr);
5638 static Jim_HashTableType JimDictHashTableType = {
5639 JimObjectHTHashFunction, /* hash function */
5642 JimObjectHTKeyCompare, /* key compare */
5643 (void(*)(void*, const void*)) /* ATTENTION: const cast */
5644 JimObjectHTKeyValDestructor, /* key destructor */
5645 JimObjectHTKeyValDestructor /* val destructor */
5648 /* Note that while the elements of the dict may contain references,
5649 * the list object itself can't. This basically means that the
5650 * dict object string representation as a whole can't contain references
5651 * that are not presents in the single elements. */
5652 static Jim_ObjType dictObjType = {
5654 FreeDictInternalRep,
5660 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
5662 JIM_NOTUSED(interp);
5664 Jim_FreeHashTable(objPtr->internalRep.ptr);
5665 Jim_Free(objPtr->internalRep.ptr);
5668 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
5670 Jim_HashTable *ht, *dupHt;
5671 Jim_HashTableIterator *htiter;
5674 /* Create a new hash table */
5675 ht = srcPtr->internalRep.ptr;
5676 dupHt = Jim_Alloc(sizeof(*dupHt));
5677 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
5679 Jim_ExpandHashTable(dupHt, ht->size);
5680 /* Copy every element from the source to the dup hash table */
5681 htiter = Jim_GetHashTableIterator(ht);
5682 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5683 const Jim_Obj *keyObjPtr = he->key;
5684 Jim_Obj *valObjPtr = he->val;
5686 Jim_IncrRefCount((Jim_Obj*)keyObjPtr); /* ATTENTION: const cast */
5687 Jim_IncrRefCount(valObjPtr);
5688 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
5690 Jim_FreeHashTableIterator(htiter);
5692 dupPtr->internalRep.ptr = dupHt;
5693 dupPtr->typePtr = &dictObjType;
5696 void UpdateStringOfDict(struct Jim_Obj *objPtr)
5698 int i, bufLen, realLength;
5701 int *quotingType, objc;
5703 Jim_HashTableIterator *htiter;
5707 /* Trun the hash table into a flat vector of Jim_Objects. */
5708 ht = objPtr->internalRep.ptr;
5710 objv = Jim_Alloc(objc*sizeof(Jim_Obj*));
5711 htiter = Jim_GetHashTableIterator(ht);
5713 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
5714 objv[i++] = (Jim_Obj*)he->key; /* ATTENTION: const cast */
5715 objv[i++] = he->val;
5717 Jim_FreeHashTableIterator(htiter);
5718 /* (Over) Estimate the space needed. */
5719 quotingType = Jim_Alloc(sizeof(int)*objc);
5721 for (i = 0; i < objc; i++) {
5724 strRep = Jim_GetString(objv[i], &len);
5725 quotingType[i] = ListElementQuotingType(strRep, len);
5726 switch (quotingType[i]) {
5727 case JIM_ELESTR_SIMPLE: bufLen += len; break;
5728 case JIM_ELESTR_BRACE: bufLen += len+2; break;
5729 case JIM_ELESTR_QUOTE: bufLen += len*2; break;
5731 bufLen++; /* elements separator. */
5735 /* Generate the string rep. */
5736 p = objPtr->bytes = Jim_Alloc(bufLen+1);
5738 for (i = 0; i < objc; i++) {
5740 const char *strRep = Jim_GetString(objv[i], &len);
5743 switch(quotingType[i]) {
5744 case JIM_ELESTR_SIMPLE:
5745 memcpy(p, strRep, len);
5749 case JIM_ELESTR_BRACE:
5751 memcpy(p, strRep, len);
5754 realLength += len+2;
5756 case JIM_ELESTR_QUOTE:
5757 q = BackslashQuoteString(strRep, len, &qlen);
5764 /* Add a separating space */
5770 *p = '\0'; /* nul term. */
5771 objPtr->length = realLength;
5772 Jim_Free(quotingType);
5776 int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
5778 struct JimParserCtx parser;
5784 /* Get the string representation */
5785 str = Jim_GetString(objPtr, &strLen);
5787 /* Free the old internal repr just now and initialize the
5788 * new one just now. The string->list conversion can't fail. */
5789 Jim_FreeIntRep(interp, objPtr);
5790 ht = Jim_Alloc(sizeof(*ht));
5791 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
5792 objPtr->typePtr = &dictObjType;
5793 objPtr->internalRep.ptr = ht;
5795 /* Convert into a dict */
5796 JimParserInit(&parser, str, strLen, 1);
5798 while(!JimParserEof(&parser)) {
5802 JimParseList(&parser);
5803 if (JimParserTtype(&parser) != JIM_TT_STR &&
5804 JimParserTtype(&parser) != JIM_TT_ESC)
5806 token = JimParserGetToken(&parser, &tokenLen, &type, NULL);
5807 objv[i++] = Jim_NewStringObjNoAlloc(interp, token, tokenLen);
5810 Jim_IncrRefCount(objv[0]);
5811 Jim_IncrRefCount(objv[1]);
5812 if (Jim_AddHashEntry(ht, objv[0], objv[1]) != JIM_OK) {
5814 he = Jim_FindHashEntry(ht, objv[0]);
5815 Jim_DecrRefCount(interp, objv[0]);
5816 /* ATTENTION: const cast */
5817 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5823 Jim_FreeNewObj(interp, objv[0]);
5824 objPtr->typePtr = NULL;
5825 Jim_FreeHashTable(ht);
5826 Jim_SetResultString(interp, "invalid dictionary value: must be a list with an even number of elements", -1);
5832 /* Dict object API */
5834 /* Add an element to a dict. objPtr must be of the "dict" type.
5835 * The higer-level exported function is Jim_DictAddElement().
5836 * If an element with the specified key already exists, the value
5837 * associated is replaced with the new one.
5839 * if valueObjPtr == NULL, the key is instead removed if it exists. */
5840 static void DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5841 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5843 Jim_HashTable *ht = objPtr->internalRep.ptr;
5845 if (valueObjPtr == NULL) { /* unset */
5846 Jim_DeleteHashEntry(ht, keyObjPtr);
5849 Jim_IncrRefCount(keyObjPtr);
5850 Jim_IncrRefCount(valueObjPtr);
5851 if (Jim_AddHashEntry(ht, keyObjPtr, valueObjPtr) != JIM_OK) {
5852 Jim_HashEntry *he = Jim_FindHashEntry(ht, keyObjPtr);
5853 Jim_DecrRefCount(interp, keyObjPtr);
5854 /* ATTENTION: const cast */
5855 Jim_DecrRefCount(interp, (Jim_Obj*)he->val);
5856 he->val = valueObjPtr;
5860 /* Add an element, higher-level interface for DictAddElement().
5861 * If valueObjPtr == NULL, the key is removed if it exists. */
5862 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
5863 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
5865 if (Jim_IsShared(objPtr))
5866 Jim_Panic(interp,"Jim_DictAddElement called with shared object");
5867 if (objPtr->typePtr != &dictObjType) {
5868 if (SetDictFromAny(interp, objPtr) != JIM_OK)
5871 DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
5872 Jim_InvalidateStringRep(objPtr);
5876 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
5882 Jim_Panic(interp,"Jim_NewDicObj() 'len' argument must be even");
5884 objPtr = Jim_NewObj(interp);
5885 objPtr->typePtr = &dictObjType;
5886 objPtr->bytes = NULL;
5887 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
5888 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
5889 for (i = 0; i < len; i += 2)
5890 DictAddElement(interp, objPtr, elements[i], elements[i+1]);
5894 /* Return the value associated to the specified dict key */
5895 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
5896 Jim_Obj **objPtrPtr, int flags)
5901 if (dictPtr->typePtr != &dictObjType) {
5902 if (SetDictFromAny(interp, dictPtr) != JIM_OK)
5905 ht = dictPtr->internalRep.ptr;
5906 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
5907 if (flags & JIM_ERRMSG) {
5908 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
5909 Jim_AppendStrings(interp, Jim_GetResult(interp),
5910 "key \"", Jim_GetString(keyPtr, NULL),
5911 "\" not found in dictionary", NULL);
5915 *objPtrPtr = he->val;
5919 /* Return the value associated to the specified dict keys */
5920 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
5921 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
5927 *objPtrPtr = dictPtr;
5931 for (i = 0; i < keyc; i++) {
5932 if (Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags)
5937 *objPtrPtr = objPtr;
5941 /* Modify the dict stored into the variable named 'varNamePtr'
5942 * setting the element specified by the 'keyc' keys objects in 'keyv',
5943 * with the new value of the element 'newObjPtr'.
5945 * If newObjPtr == NULL the operation is to remove the given key
5946 * from the dictionary. */
5947 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
5948 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr)
5950 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
5953 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
5954 if (objPtr == NULL) {
5955 if (newObjPtr == NULL) /* Cannot remove a key from non existing var */
5957 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
5958 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
5959 Jim_FreeNewObj(interp, varObjPtr);
5963 if ((shared = Jim_IsShared(objPtr)))
5964 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
5965 for (i = 0; i < keyc-1; i++) {
5966 dictObjPtr = objPtr;
5968 /* Check if it's a valid dictionary */
5969 if (dictObjPtr->typePtr != &dictObjType) {
5970 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK)
5973 /* Check if the given key exists. */
5974 Jim_InvalidateStringRep(dictObjPtr);
5975 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
5976 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK)
5978 /* This key exists at the current level.
5979 * Make sure it's not shared!. */
5980 if (Jim_IsShared(objPtr)) {
5981 objPtr = Jim_DuplicateObj(interp, objPtr);
5982 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5985 /* Key not found. If it's an [unset] operation
5986 * this is an error. Only the last key may not
5988 if (newObjPtr == NULL)
5990 /* Otherwise set an empty dictionary
5991 * as key's value. */
5992 objPtr = Jim_NewDictObj(interp, NULL, 0);
5993 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
5996 if (Jim_DictAddElement(interp, objPtr, keyv[keyc-1], newObjPtr)
5999 Jim_InvalidateStringRep(objPtr);
6000 Jim_InvalidateStringRep(varObjPtr);
6001 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6003 Jim_SetResult(interp, varObjPtr);
6007 Jim_FreeNewObj(interp, varObjPtr);
6012 /* -----------------------------------------------------------------------------
6014 * ---------------------------------------------------------------------------*/
6015 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
6016 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6018 static Jim_ObjType indexObjType = {
6022 UpdateStringOfIndex,
6026 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
6029 char buf[JIM_INTEGER_SPACE+1];
6031 if (objPtr->internalRep.indexValue >= 0)
6032 len = sprintf(buf, "%d", objPtr->internalRep.indexValue);
6033 else if (objPtr->internalRep.indexValue == -1)
6034 len = sprintf(buf, "end");
6036 len = sprintf(buf, "end%d", objPtr->internalRep.indexValue+1);
6038 objPtr->bytes = Jim_Alloc(len+1);
6039 memcpy(objPtr->bytes, buf, len+1);
6040 objPtr->length = len;
6043 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6048 /* Get the string representation */
6049 str = Jim_GetString(objPtr, NULL);
6050 /* Try to convert into an index */
6051 if (!strcmp(str, "end")) {
6055 if (!strncmp(str, "end-", 4)) {
6059 if (Jim_StringToIndex(str, &index) != JIM_OK) {
6060 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6061 Jim_AppendStrings(interp, Jim_GetResult(interp),
6062 "bad index \"", Jim_GetString(objPtr, NULL), "\": "
6063 "must be integer or end?-integer?", NULL);
6072 } else if (!end && index < 0)
6074 /* Free the old internal repr and set the new one. */
6075 Jim_FreeIntRep(interp, objPtr);
6076 objPtr->typePtr = &indexObjType;
6077 objPtr->internalRep.indexValue = index;
6081 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
6083 /* Avoid shimmering if the object is an integer. */
6084 if (objPtr->typePtr == &intObjType) {
6085 jim_wide val = objPtr->internalRep.wideValue;
6086 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
6087 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
6091 if (objPtr->typePtr != &indexObjType &&
6092 SetIndexFromAny(interp, objPtr) == JIM_ERR)
6094 *indexPtr = objPtr->internalRep.indexValue;
6098 /* -----------------------------------------------------------------------------
6099 * Return Code Object.
6100 * ---------------------------------------------------------------------------*/
6102 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6104 static Jim_ObjType returnCodeObjType = {
6112 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6115 int strLen, returnCode;
6118 /* Get the string representation */
6119 str = Jim_GetString(objPtr, &strLen);
6120 /* Try to convert into an integer */
6121 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
6122 returnCode = (int) wideValue;
6123 else if (!JimStringCompare(str, strLen, "ok", 2, JIM_NOCASE))
6124 returnCode = JIM_OK;
6125 else if (!JimStringCompare(str, strLen, "error", 5, JIM_NOCASE))
6126 returnCode = JIM_ERR;
6127 else if (!JimStringCompare(str, strLen, "return", 6, JIM_NOCASE))
6128 returnCode = JIM_RETURN;
6129 else if (!JimStringCompare(str, strLen, "break", 5, JIM_NOCASE))
6130 returnCode = JIM_BREAK;
6131 else if (!JimStringCompare(str, strLen, "continue", 8, JIM_NOCASE))
6132 returnCode = JIM_CONTINUE;
6133 else if (!JimStringCompare(str, strLen, "eval", 4, JIM_NOCASE))
6134 returnCode = JIM_EVAL;
6135 else if (!JimStringCompare(str, strLen, "exit", 4, JIM_NOCASE))
6136 returnCode = JIM_EXIT;
6138 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
6139 Jim_AppendStrings(interp, Jim_GetResult(interp),
6140 "expected return code but got '", str, "'",
6144 /* Free the old internal repr and set the new one. */
6145 Jim_FreeIntRep(interp, objPtr);
6146 objPtr->typePtr = &returnCodeObjType;
6147 objPtr->internalRep.returnCode = returnCode;
6151 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
6153 if (objPtr->typePtr != &returnCodeObjType &&
6154 SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
6156 *intPtr = objPtr->internalRep.returnCode;
6160 /* -----------------------------------------------------------------------------
6161 * Expression Parsing
6162 * ---------------------------------------------------------------------------*/
6163 static int JimParseExprOperator(struct JimParserCtx *pc);
6164 static int JimParseExprNumber(struct JimParserCtx *pc);
6165 static int JimParseExprIrrational(struct JimParserCtx *pc);
6167 /* Exrp's Stack machine operators opcodes. */
6169 /* Binary operators (numbers) */
6170 #define JIM_EXPROP_BINARY_NUM_FIRST 0 /* first */
6171 #define JIM_EXPROP_MUL 0
6172 #define JIM_EXPROP_DIV 1
6173 #define JIM_EXPROP_MOD 2
6174 #define JIM_EXPROP_SUB 3
6175 #define JIM_EXPROP_ADD 4
6176 #define JIM_EXPROP_LSHIFT 5
6177 #define JIM_EXPROP_RSHIFT 6
6178 #define JIM_EXPROP_ROTL 7
6179 #define JIM_EXPROP_ROTR 8
6180 #define JIM_EXPROP_LT 9
6181 #define JIM_EXPROP_GT 10
6182 #define JIM_EXPROP_LTE 11
6183 #define JIM_EXPROP_GTE 12
6184 #define JIM_EXPROP_NUMEQ 13
6185 #define JIM_EXPROP_NUMNE 14
6186 #define JIM_EXPROP_BITAND 15
6187 #define JIM_EXPROP_BITXOR 16
6188 #define JIM_EXPROP_BITOR 17
6189 #define JIM_EXPROP_LOGICAND 18
6190 #define JIM_EXPROP_LOGICOR 19
6191 #define JIM_EXPROP_LOGICAND_LEFT 20
6192 #define JIM_EXPROP_LOGICOR_LEFT 21
6193 #define JIM_EXPROP_POW 22
6194 #define JIM_EXPROP_BINARY_NUM_LAST 22 /* last */
6196 /* Binary operators (strings) */
6197 #define JIM_EXPROP_STREQ 23
6198 #define JIM_EXPROP_STRNE 24
6200 /* Unary operators (numbers) */
6201 #define JIM_EXPROP_NOT 25
6202 #define JIM_EXPROP_BITNOT 26
6203 #define JIM_EXPROP_UNARYMINUS 27
6204 #define JIM_EXPROP_UNARYPLUS 28
6205 #define JIM_EXPROP_LOGICAND_RIGHT 29
6206 #define JIM_EXPROP_LOGICOR_RIGHT 30
6208 /* Ternary operators */
6209 #define JIM_EXPROP_TERNARY 31
6212 #define JIM_EXPROP_NUMBER 32
6213 #define JIM_EXPROP_COMMAND 33
6214 #define JIM_EXPROP_VARIABLE 34
6215 #define JIM_EXPROP_DICTSUGAR 35
6216 #define JIM_EXPROP_SUBST 36
6217 #define JIM_EXPROP_STRING 37
6219 /* Operators table */
6220 typedef struct Jim_ExprOperator {
6227 /* name - precedence - arity - opcode */
6228 static struct Jim_ExprOperator Jim_ExprOperators[] = {
6229 {"!", 300, 1, JIM_EXPROP_NOT},
6230 {"~", 300, 1, JIM_EXPROP_BITNOT},
6231 {"unarymin", 300, 1, JIM_EXPROP_UNARYMINUS},
6232 {"unaryplus", 300, 1, JIM_EXPROP_UNARYPLUS},
6234 {"**", 250, 2, JIM_EXPROP_POW},
6236 {"*", 200, 2, JIM_EXPROP_MUL},
6237 {"/", 200, 2, JIM_EXPROP_DIV},
6238 {"%", 200, 2, JIM_EXPROP_MOD},
6240 {"-", 100, 2, JIM_EXPROP_SUB},
6241 {"+", 100, 2, JIM_EXPROP_ADD},
6243 {"<<<", 90, 3, JIM_EXPROP_ROTL},
6244 {">>>", 90, 3, JIM_EXPROP_ROTR},
6245 {"<<", 90, 2, JIM_EXPROP_LSHIFT},
6246 {">>", 90, 2, JIM_EXPROP_RSHIFT},
6248 {"<", 80, 2, JIM_EXPROP_LT},
6249 {">", 80, 2, JIM_EXPROP_GT},
6250 {"<=", 80, 2, JIM_EXPROP_LTE},
6251 {">=", 80, 2, JIM_EXPROP_GTE},
6253 {"==", 70, 2, JIM_EXPROP_NUMEQ},
6254 {"!=", 70, 2, JIM_EXPROP_NUMNE},
6256 {"eq", 60, 2, JIM_EXPROP_STREQ},
6257 {"ne", 60, 2, JIM_EXPROP_STRNE},
6259 {"&", 50, 2, JIM_EXPROP_BITAND},
6260 {"^", 49, 2, JIM_EXPROP_BITXOR},
6261 {"|", 48, 2, JIM_EXPROP_BITOR},
6263 {"&&", 10, 2, JIM_EXPROP_LOGICAND},
6264 {"||", 10, 2, JIM_EXPROP_LOGICOR},
6266 {"?", 5, 3, JIM_EXPROP_TERNARY},
6267 /* private operators */
6268 {NULL, 10, 2, JIM_EXPROP_LOGICAND_LEFT},
6269 {NULL, 10, 1, JIM_EXPROP_LOGICAND_RIGHT},
6270 {NULL, 10, 2, JIM_EXPROP_LOGICOR_LEFT},
6271 {NULL, 10, 1, JIM_EXPROP_LOGICOR_RIGHT},
6274 #define JIM_EXPR_OPERATORS_NUM \
6275 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
6277 int JimParseExpression(struct JimParserCtx *pc)
6279 /* Discard spaces and quoted newline */
6280 while(*(pc->p) == ' ' ||
6284 (*(pc->p) == '\\' && *(pc->p+1) == '\n')) {
6289 pc->tstart = pc->tend = pc->p;
6290 pc->tline = pc->linenr;
6291 pc->tt = JIM_TT_EOL;
6297 pc->tstart = pc->tend = pc->p;
6298 pc->tline = pc->linenr;
6299 pc->tt = JIM_TT_SUBEXPR_START;
6303 pc->tstart = pc->tend = pc->p;
6304 pc->tline = pc->linenr;
6305 pc->tt = JIM_TT_SUBEXPR_END;
6309 return JimParseCmd(pc);
6312 if (JimParseVar(pc) == JIM_ERR)
6313 return JimParseExprOperator(pc);
6318 if ((pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_EXPR_OPERATOR) &&
6319 isdigit((int)*(pc->p+1)))
6320 return JimParseExprNumber(pc);
6322 return JimParseExprOperator(pc);
6324 case '0': case '1': case '2': case '3': case '4':
6325 case '5': case '6': case '7': case '8': case '9': case '.':
6326 return JimParseExprNumber(pc);
6330 /* Here it's possible to reuse the List String parsing. */
6331 pc->tt = JIM_TT_NONE; /* Make sure it's sensed as a new word. */
6332 return JimParseListStr(pc);
6336 if (JimParseExprIrrational(pc) == JIM_ERR)
6337 return JimParseExprOperator(pc);
6340 return JimParseExprOperator(pc);
6346 int JimParseExprNumber(struct JimParserCtx *pc)
6352 pc->tline = pc->linenr;
6353 if (*pc->p == '-') {
6356 while ( isdigit((int)*pc->p)
6357 || (allowhex && isxdigit((int)*pc->p) )
6358 || (allowdot && *pc->p == '.')
6359 || (pc->p-pc->tstart == 1 && *pc->tstart == '0' &&
6360 (*pc->p == 'x' || *pc->p == 'X'))
6363 if ((*pc->p == 'x') || (*pc->p == 'X')) {
6370 if (!allowdot && *pc->p == 'e' && *(pc->p+1) == '-') {
6371 pc->p += 2; pc->len -= 2;
6375 pc->tt = JIM_TT_EXPR_NUMBER;
6379 int JimParseExprIrrational(struct JimParserCtx *pc)
6381 const char *Tokens[] = {"NaN", "nan", "NAN", "Inf", "inf", "INF", NULL};
6383 for (token = Tokens; *token != NULL; token++) {
6384 int len = strlen(*token);
6385 if (strncmp(*token, pc->p, len) == 0) {
6387 pc->tend = pc->p + len - 1;
6388 pc->p += len; pc->len -= len;
6389 pc->tline = pc->linenr;
6390 pc->tt = JIM_TT_EXPR_NUMBER;
6397 int JimParseExprOperator(struct JimParserCtx *pc)
6400 int bestIdx = -1, bestLen = 0;
6402 /* Try to get the longest match. */
6403 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
6407 opname = Jim_ExprOperators[i].name;
6408 if (opname == NULL) continue;
6409 oplen = strlen(opname);
6411 if (strncmp(opname, pc->p, oplen) == 0 && oplen > bestLen) {
6416 if (bestIdx == -1) return JIM_ERR;
6418 pc->tend = pc->p + bestLen - 1;
6419 pc->p += bestLen; pc->len -= bestLen;
6420 pc->tline = pc->linenr;
6421 pc->tt = JIM_TT_EXPR_OPERATOR;
6425 struct Jim_ExprOperator *JimExprOperatorInfo(const char *opname)
6428 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6429 if (Jim_ExprOperators[i].name &&
6430 strcmp(opname, Jim_ExprOperators[i].name) == 0)
6431 return &Jim_ExprOperators[i];
6435 struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
6438 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++)
6439 if (Jim_ExprOperators[i].opcode == opcode)
6440 return &Jim_ExprOperators[i];
6444 /* -----------------------------------------------------------------------------
6446 * ---------------------------------------------------------------------------*/
6447 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6448 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6449 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6451 static Jim_ObjType exprObjType = {
6453 FreeExprInternalRep,
6456 JIM_TYPE_REFERENCES,
6459 /* Expr bytecode structure */
6460 typedef struct ExprByteCode {
6461 int *opcode; /* Integer array of opcodes. */
6462 Jim_Obj **obj; /* Array of associated Jim Objects. */
6463 int len; /* Bytecode length */
6464 int inUse; /* Used for sharing. */
6467 void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6470 ExprByteCode *expr = (void*) objPtr->internalRep.ptr;
6473 if (expr->inUse != 0) return;
6474 for (i = 0; i < expr->len; i++)
6475 Jim_DecrRefCount(interp, expr->obj[i]);
6476 Jim_Free(expr->opcode);
6477 Jim_Free(expr->obj);
6481 void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6483 JIM_NOTUSED(interp);
6484 JIM_NOTUSED(srcPtr);
6486 /* Just returns an simple string. */
6487 dupPtr->typePtr = NULL;
6490 /* Add a new instruction to an expression bytecode structure. */
6491 static void ExprObjAddInstr(Jim_Interp *interp, ExprByteCode *expr,
6492 int opcode, char *str, int len)
6494 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+1));
6495 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+1));
6496 expr->opcode[expr->len] = opcode;
6497 expr->obj[expr->len] = Jim_NewStringObjNoAlloc(interp, str, len);
6498 Jim_IncrRefCount(expr->obj[expr->len]);
6502 /* Check if an expr program looks correct. */
6503 static int ExprCheckCorrectness(ExprByteCode *expr)
6508 /* Try to check if there are stack underflows,
6509 * and make sure at the end of the program there is
6510 * a single result on the stack. */
6511 for (i = 0; i < expr->len; i++) {
6512 switch(expr->opcode[i]) {
6513 case JIM_EXPROP_NUMBER:
6514 case JIM_EXPROP_STRING:
6515 case JIM_EXPROP_SUBST:
6516 case JIM_EXPROP_VARIABLE:
6517 case JIM_EXPROP_DICTSUGAR:
6518 case JIM_EXPROP_COMMAND:
6521 case JIM_EXPROP_NOT:
6522 case JIM_EXPROP_BITNOT:
6523 case JIM_EXPROP_UNARYMINUS:
6524 case JIM_EXPROP_UNARYPLUS:
6525 /* Unary operations */
6526 if (stacklen < 1) return JIM_ERR;
6528 case JIM_EXPROP_ADD:
6529 case JIM_EXPROP_SUB:
6530 case JIM_EXPROP_MUL:
6531 case JIM_EXPROP_DIV:
6532 case JIM_EXPROP_MOD:
6535 case JIM_EXPROP_LTE:
6536 case JIM_EXPROP_GTE:
6537 case JIM_EXPROP_ROTL:
6538 case JIM_EXPROP_ROTR:
6539 case JIM_EXPROP_LSHIFT:
6540 case JIM_EXPROP_RSHIFT:
6541 case JIM_EXPROP_NUMEQ:
6542 case JIM_EXPROP_NUMNE:
6543 case JIM_EXPROP_STREQ:
6544 case JIM_EXPROP_STRNE:
6545 case JIM_EXPROP_BITAND:
6546 case JIM_EXPROP_BITXOR:
6547 case JIM_EXPROP_BITOR:
6548 case JIM_EXPROP_LOGICAND:
6549 case JIM_EXPROP_LOGICOR:
6550 case JIM_EXPROP_POW:
6551 /* binary operations */
6552 if (stacklen < 2) return JIM_ERR;
6556 Jim_Panic(NULL,"Default opcode reached ExprCheckCorrectness");
6560 if (stacklen != 1) return JIM_ERR;
6564 static void ExprShareLiterals(Jim_Interp *interp, ExprByteCode *expr,
6565 ScriptObj *topLevelScript)
6570 for (i = 0; i < expr->len; i++) {
6571 Jim_Obj *foundObjPtr;
6573 if (expr->obj[i] == NULL) continue;
6574 foundObjPtr = ScriptSearchLiteral(interp, topLevelScript,
6575 NULL, expr->obj[i]);
6576 if (foundObjPtr != NULL) {
6577 Jim_IncrRefCount(foundObjPtr);
6578 Jim_DecrRefCount(interp, expr->obj[i]);
6579 expr->obj[i] = foundObjPtr;
6584 /* This procedure converts every occurrence of || and && opereators
6585 * in lazy unary versions.
6587 * a b || is converted into:
6589 * a <offset> |L b |R
6591 * a b && is converted into:
6593 * a <offset> &L b &R
6595 * "|L" checks if 'a' is true:
6596 * 1) if it is true pushes 1 and skips <offset> istructions to reach
6597 * the opcode just after |R.
6598 * 2) if it is false does nothing.
6599 * "|R" checks if 'b' is true:
6600 * 1) if it is true pushes 1, otherwise pushes 0.
6602 * "&L" checks if 'a' is true:
6603 * 1) if it is true does nothing.
6604 * 2) If it is false pushes 0 and skips <offset> istructions to reach
6605 * the opcode just after &R
6606 * "&R" checks if 'a' is true:
6607 * if it is true pushes 1, otherwise pushes 0.
6609 static void ExprMakeLazy(Jim_Interp *interp, ExprByteCode *expr)
6612 int index = -1, leftindex, arity, i, offset;
6613 Jim_ExprOperator *op;
6615 /* Search for || or && */
6616 for (i = 0; i < expr->len; i++) {
6617 if (expr->opcode[i] == JIM_EXPROP_LOGICAND ||
6618 expr->opcode[i] == JIM_EXPROP_LOGICOR) {
6623 if (index == -1) return;
6624 /* Search for the end of the first operator */
6625 leftindex = index-1;
6628 switch(expr->opcode[leftindex]) {
6629 case JIM_EXPROP_NUMBER:
6630 case JIM_EXPROP_COMMAND:
6631 case JIM_EXPROP_VARIABLE:
6632 case JIM_EXPROP_DICTSUGAR:
6633 case JIM_EXPROP_SUBST:
6634 case JIM_EXPROP_STRING:
6637 op = JimExprOperatorInfoByOpcode(expr->opcode[leftindex]);
6639 Jim_Panic(interp,"Default reached in ExprMakeLazy()");
6648 expr->opcode = Jim_Realloc(expr->opcode, sizeof(int)*(expr->len+2));
6649 expr->obj = Jim_Realloc(expr->obj, sizeof(Jim_Obj*)*(expr->len+2));
6650 memmove(&expr->opcode[leftindex+2], &expr->opcode[leftindex],
6651 sizeof(int)*(expr->len-leftindex));
6652 memmove(&expr->obj[leftindex+2], &expr->obj[leftindex],
6653 sizeof(Jim_Obj*)*(expr->len-leftindex));
6656 offset = (index-leftindex)-1;
6657 Jim_DecrRefCount(interp, expr->obj[index]);
6658 if (expr->opcode[index] == JIM_EXPROP_LOGICAND) {
6659 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICAND_LEFT;
6660 expr->opcode[index] = JIM_EXPROP_LOGICAND_RIGHT;
6661 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "&L", -1);
6662 expr->obj[index] = Jim_NewStringObj(interp, "&R", -1);
6664 expr->opcode[leftindex+1] = JIM_EXPROP_LOGICOR_LEFT;
6665 expr->opcode[index] = JIM_EXPROP_LOGICOR_RIGHT;
6666 expr->obj[leftindex+1] = Jim_NewStringObj(interp, "|L", -1);
6667 expr->obj[index] = Jim_NewStringObj(interp, "|R", -1);
6669 expr->opcode[leftindex] = JIM_EXPROP_NUMBER;
6670 expr->obj[leftindex] = Jim_NewIntObj(interp, offset);
6671 Jim_IncrRefCount(expr->obj[index]);
6672 Jim_IncrRefCount(expr->obj[leftindex]);
6673 Jim_IncrRefCount(expr->obj[leftindex+1]);
6677 /* This method takes the string representation of an expression
6678 * and generates a program for the Expr's stack-based VM. */
6679 int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6682 const char *exprText = Jim_GetString(objPtr, &exprTextLen);
6683 struct JimParserCtx parser;
6684 int i, shareLiterals;
6685 ExprByteCode *expr = Jim_Alloc(sizeof(*expr));
6687 Jim_ExprOperator *op;
6689 /* Perform literal sharing with the current procedure
6690 * running only if this expression appears to be not generated
6692 shareLiterals = objPtr->typePtr == &sourceObjType;
6694 expr->opcode = NULL;
6699 Jim_InitStack(&stack);
6700 JimParserInit(&parser, exprText, exprTextLen, 1);
6701 while(!JimParserEof(&parser)) {
6705 if (JimParseExpression(&parser) != JIM_OK) {
6706 Jim_SetResultString(interp, "Syntax error in expression", -1);
6709 token = JimParserGetToken(&parser, &len, &type, NULL);
6710 if (type == JIM_TT_EOL) {
6716 ExprObjAddInstr(interp, expr, JIM_EXPROP_STRING, token, len);
6719 ExprObjAddInstr(interp, expr, JIM_EXPROP_SUBST, token, len);
6722 ExprObjAddInstr(interp, expr, JIM_EXPROP_VARIABLE, token, len);
6724 case JIM_TT_DICTSUGAR:
6725 ExprObjAddInstr(interp, expr, JIM_EXPROP_DICTSUGAR, token, len);
6728 ExprObjAddInstr(interp, expr, JIM_EXPROP_COMMAND, token, len);
6730 case JIM_TT_EXPR_NUMBER:
6731 ExprObjAddInstr(interp, expr, JIM_EXPROP_NUMBER, token, len);
6733 case JIM_TT_EXPR_OPERATOR:
6734 op = JimExprOperatorInfo(token);
6736 Jim_ExprOperator *stackTopOp;
6738 if (Jim_StackPeek(&stack) != NULL) {
6739 stackTopOp = JimExprOperatorInfo(Jim_StackPeek(&stack));
6743 if (Jim_StackLen(&stack) && op->arity != 1 &&
6744 stackTopOp && stackTopOp->precedence >= op->precedence)
6746 ExprObjAddInstr(interp, expr, stackTopOp->opcode,
6747 Jim_StackPeek(&stack), -1);
6748 Jim_StackPop(&stack);
6753 Jim_StackPush(&stack, token);
6755 case JIM_TT_SUBEXPR_START:
6756 Jim_StackPush(&stack, Jim_StrDup("("));
6759 case JIM_TT_SUBEXPR_END:
6762 while(Jim_StackLen(&stack)) {
6763 char *opstr = Jim_StackPop(&stack);
6764 if (!strcmp(opstr, "(")) {
6769 op = JimExprOperatorInfo(opstr);
6770 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6773 Jim_SetResultString(interp,
6774 "Unexpected close parenthesis", -1);
6781 Jim_Panic(interp,"Default reached in SetExprFromAny()");
6785 while (Jim_StackLen(&stack)) {
6786 char *opstr = Jim_StackPop(&stack);
6787 op = JimExprOperatorInfo(opstr);
6788 if (op == NULL && !strcmp(opstr, "(")) {
6790 Jim_SetResultString(interp, "Missing close parenthesis", -1);
6793 ExprObjAddInstr(interp, expr, op->opcode, opstr, -1);
6795 /* Check program correctness. */
6796 if (ExprCheckCorrectness(expr) != JIM_OK) {
6797 Jim_SetResultString(interp, "Invalid expression", -1);
6801 /* Free the stack used for the compilation. */
6802 Jim_FreeStackElements(&stack, Jim_Free);
6803 Jim_FreeStack(&stack);
6805 /* Convert || and && operators in unary |L |R and &L &R for lazyness */
6806 ExprMakeLazy(interp, expr);
6808 /* Perform literal sharing */
6809 if (shareLiterals && interp->framePtr->procBodyObjPtr) {
6810 Jim_Obj *bodyObjPtr = interp->framePtr->procBodyObjPtr;
6811 if (bodyObjPtr->typePtr == &scriptObjType) {
6812 ScriptObj *bodyScript = bodyObjPtr->internalRep.ptr;
6813 ExprShareLiterals(interp, expr, bodyScript);
6817 /* Free the old internal rep and set the new one. */
6818 Jim_FreeIntRep(interp, objPtr);
6819 Jim_SetIntRepPtr(objPtr, expr);
6820 objPtr->typePtr = &exprObjType;
6823 err: /* we jump here on syntax/compile errors. */
6824 Jim_FreeStackElements(&stack, Jim_Free);
6825 Jim_FreeStack(&stack);
6826 Jim_Free(expr->opcode);
6827 for (i = 0; i < expr->len; i++) {
6828 Jim_DecrRefCount(interp,expr->obj[i]);
6830 Jim_Free(expr->obj);
6835 ExprByteCode *Jim_GetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
6837 if (objPtr->typePtr != &exprObjType) {
6838 if (SetExprFromAny(interp, objPtr) != JIM_OK)
6841 return (ExprByteCode*) Jim_GetIntRepPtr(objPtr);
6844 /* -----------------------------------------------------------------------------
6845 * Expressions evaluation.
6846 * Jim uses a specialized stack-based virtual machine for expressions,
6847 * that takes advantage of the fact that expr's operators
6848 * can't be redefined.
6850 * Jim_EvalExpression() uses the bytecode compiled by
6851 * SetExprFromAny() method of the "expression" object.
6853 * On success a Tcl Object containing the result of the evaluation
6854 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
6856 * On error the function returns a retcode != to JIM_OK and set a suitable
6857 * error on the interp.
6858 * ---------------------------------------------------------------------------*/
6859 #define JIM_EE_STATICSTACK_LEN 10
6861 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr,
6862 Jim_Obj **exprResultPtrPtr)
6865 Jim_Obj **stack, *staticStack[JIM_EE_STATICSTACK_LEN];
6866 int stacklen = 0, i, error = 0, errRetCode = JIM_ERR;
6868 Jim_IncrRefCount(exprObjPtr);
6869 expr = Jim_GetExpression(interp, exprObjPtr);
6871 Jim_DecrRefCount(interp, exprObjPtr);
6872 return JIM_ERR; /* error in expression. */
6874 /* In order to avoid that the internal repr gets freed due to
6875 * shimmering of the exprObjPtr's object, we make the internal rep
6879 /* The stack-based expr VM itself */
6881 /* Stack allocation. Expr programs have the feature that
6882 * a program of length N can't require a stack longer than
6884 if (expr->len > JIM_EE_STATICSTACK_LEN)
6885 stack = Jim_Alloc(sizeof(Jim_Obj*)*expr->len);
6887 stack = staticStack;
6889 /* Execute every istruction */
6890 for (i = 0; i < expr->len; i++) {
6891 Jim_Obj *A, *B, *objPtr;
6892 jim_wide wA, wB, wC;
6894 const char *sA, *sB;
6895 int Alen, Blen, retcode;
6896 int opcode = expr->opcode[i];
6898 if (opcode == JIM_EXPROP_NUMBER || opcode == JIM_EXPROP_STRING) {
6899 stack[stacklen++] = expr->obj[i];
6900 Jim_IncrRefCount(expr->obj[i]);
6901 } else if (opcode == JIM_EXPROP_VARIABLE) {
6902 objPtr = Jim_GetVariable(interp, expr->obj[i], JIM_ERRMSG);
6903 if (objPtr == NULL) {
6907 stack[stacklen++] = objPtr;
6908 Jim_IncrRefCount(objPtr);
6909 } else if (opcode == JIM_EXPROP_SUBST) {
6910 if ((retcode = Jim_SubstObj(interp, expr->obj[i],
6911 &objPtr, JIM_NONE)) != JIM_OK)
6914 errRetCode = retcode;
6917 stack[stacklen++] = objPtr;
6918 Jim_IncrRefCount(objPtr);
6919 } else if (opcode == JIM_EXPROP_DICTSUGAR) {
6920 objPtr = Jim_ExpandDictSugar(interp, expr->obj[i]);
6921 if (objPtr == NULL) {
6925 stack[stacklen++] = objPtr;
6926 Jim_IncrRefCount(objPtr);
6927 } else if (opcode == JIM_EXPROP_COMMAND) {
6928 if ((retcode = Jim_EvalObj(interp, expr->obj[i])) != JIM_OK) {
6930 errRetCode = retcode;
6933 stack[stacklen++] = interp->result;
6934 Jim_IncrRefCount(interp->result);
6935 } else if (opcode >= JIM_EXPROP_BINARY_NUM_FIRST &&
6936 opcode <= JIM_EXPROP_BINARY_NUM_LAST)
6938 /* Note that there isn't to increment the
6939 * refcount of objects. the references are moved
6940 * from stack to A and B. */
6941 B = stack[--stacklen];
6942 A = stack[--stacklen];
6944 /* --- Integer --- */
6945 if ((A->typePtr == &doubleObjType && !A->bytes) ||
6946 (B->typePtr == &doubleObjType && !B->bytes) ||
6947 JimGetWideNoErr(interp, A, &wA) != JIM_OK ||
6948 JimGetWideNoErr(interp, B, &wB) != JIM_OK) {
6951 Jim_DecrRefCount(interp, A);
6952 Jim_DecrRefCount(interp, B);
6953 switch(expr->opcode[i]) {
6954 case JIM_EXPROP_ADD: wC = wA+wB; break;
6955 case JIM_EXPROP_SUB: wC = wA-wB; break;
6956 case JIM_EXPROP_MUL: wC = wA*wB; break;
6957 case JIM_EXPROP_LT: wC = wA<wB; break;
6958 case JIM_EXPROP_GT: wC = wA>wB; break;
6959 case JIM_EXPROP_LTE: wC = wA<=wB; break;
6960 case JIM_EXPROP_GTE: wC = wA>=wB; break;
6961 case JIM_EXPROP_LSHIFT: wC = wA<<wB; break;
6962 case JIM_EXPROP_RSHIFT: wC = wA>>wB; break;
6963 case JIM_EXPROP_NUMEQ: wC = wA==wB; break;
6964 case JIM_EXPROP_NUMNE: wC = wA!=wB; break;
6965 case JIM_EXPROP_BITAND: wC = wA&wB; break;
6966 case JIM_EXPROP_BITXOR: wC = wA^wB; break;
6967 case JIM_EXPROP_BITOR: wC = wA|wB; break;
6968 case JIM_EXPROP_POW: wC = JimPowWide(wA,wB); break;
6969 case JIM_EXPROP_LOGICAND_LEFT:
6977 case JIM_EXPROP_LOGICOR_LEFT:
6985 case JIM_EXPROP_DIV:
6986 if (wB == 0) goto divbyzero;
6989 case JIM_EXPROP_MOD:
6990 if (wB == 0) goto divbyzero;
6993 case JIM_EXPROP_ROTL: {
6994 /* uint32_t would be better. But not everyone has inttypes.h?*/
6995 unsigned long uA = (unsigned long)wA;
6997 wC = _rotl(uA,(unsigned long)wB);
6999 const unsigned int S = sizeof(unsigned long) * 8;
7000 wC = (unsigned long)((uA<<wB)|(uA>>(S-wB)));
7004 case JIM_EXPROP_ROTR: {
7005 unsigned long uA = (unsigned long)wA;
7007 wC = _rotr(uA,(unsigned long)wB);
7009 const unsigned int S = sizeof(unsigned long) * 8;
7010 wC = (unsigned long)((uA>>wB)|(uA<<(S-wB)));
7016 wC = 0; /* avoid gcc warning */
7019 stack[stacklen] = Jim_NewIntObj(interp, wC);
7020 Jim_IncrRefCount(stack[stacklen]);
7024 /* --- Double --- */
7025 if (Jim_GetDouble(interp, A, &dA) != JIM_OK ||
7026 Jim_GetDouble(interp, B, &dB) != JIM_OK) {
7028 /* Hmmm! For compatibility, maybe convert != and == into ne and eq */
7029 if (expr->opcode[i] == JIM_EXPROP_NUMNE) {
7030 opcode = JIM_EXPROP_STRNE;
7031 goto retry_as_string;
7033 else if (expr->opcode[i] == JIM_EXPROP_NUMEQ) {
7034 opcode = JIM_EXPROP_STREQ;
7035 goto retry_as_string;
7037 Jim_DecrRefCount(interp, A);
7038 Jim_DecrRefCount(interp, B);
7042 Jim_DecrRefCount(interp, A);
7043 Jim_DecrRefCount(interp, B);
7044 switch(expr->opcode[i]) {
7045 case JIM_EXPROP_ROTL:
7046 case JIM_EXPROP_ROTR:
7047 case JIM_EXPROP_LSHIFT:
7048 case JIM_EXPROP_RSHIFT:
7049 case JIM_EXPROP_BITAND:
7050 case JIM_EXPROP_BITXOR:
7051 case JIM_EXPROP_BITOR:
7052 case JIM_EXPROP_MOD:
7053 case JIM_EXPROP_POW:
7054 Jim_SetResultString(interp,
7055 "Got floating-point value where integer was expected", -1);
7059 case JIM_EXPROP_ADD: dC = dA+dB; break;
7060 case JIM_EXPROP_SUB: dC = dA-dB; break;
7061 case JIM_EXPROP_MUL: dC = dA*dB; break;
7062 case JIM_EXPROP_LT: dC = dA<dB; break;
7063 case JIM_EXPROP_GT: dC = dA>dB; break;
7064 case JIM_EXPROP_LTE: dC = dA<=dB; break;
7065 case JIM_EXPROP_GTE: dC = dA>=dB; break;
7066 case JIM_EXPROP_NUMEQ: dC = dA==dB; break;
7067 case JIM_EXPROP_NUMNE: dC = dA!=dB; break;
7068 case JIM_EXPROP_LOGICAND_LEFT:
7076 case JIM_EXPROP_LOGICOR_LEFT:
7084 case JIM_EXPROP_DIV:
7085 if (dB == 0) goto divbyzero;
7089 dC = 0; /* avoid gcc warning */
7092 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7093 Jim_IncrRefCount(stack[stacklen]);
7095 } else if (opcode == JIM_EXPROP_STREQ || opcode == JIM_EXPROP_STRNE) {
7096 B = stack[--stacklen];
7097 A = stack[--stacklen];
7099 sA = Jim_GetString(A, &Alen);
7100 sB = Jim_GetString(B, &Blen);
7102 case JIM_EXPROP_STREQ:
7103 if (Alen == Blen && memcmp(sA, sB, Alen) ==0)
7108 case JIM_EXPROP_STRNE:
7109 if (Alen != Blen || memcmp(sA, sB, Alen) != 0)
7115 wC = 0; /* avoid gcc warning */
7118 Jim_DecrRefCount(interp, A);
7119 Jim_DecrRefCount(interp, B);
7120 stack[stacklen] = Jim_NewIntObj(interp, wC);
7121 Jim_IncrRefCount(stack[stacklen]);
7123 } else if (opcode == JIM_EXPROP_NOT ||
7124 opcode == JIM_EXPROP_BITNOT ||
7125 opcode == JIM_EXPROP_LOGICAND_RIGHT ||
7126 opcode == JIM_EXPROP_LOGICOR_RIGHT) {
7127 /* Note that there isn't to increment the
7128 * refcount of objects. the references are moved
7129 * from stack to A and B. */
7130 A = stack[--stacklen];
7132 /* --- Integer --- */
7133 if ((A->typePtr == &doubleObjType && !A->bytes) ||
7134 JimGetWideNoErr(interp, A, &wA) != JIM_OK) {
7135 goto trydouble_unary;
7137 Jim_DecrRefCount(interp, A);
7138 switch(expr->opcode[i]) {
7139 case JIM_EXPROP_NOT: wC = !wA; break;
7140 case JIM_EXPROP_BITNOT: wC = ~wA; break;
7141 case JIM_EXPROP_LOGICAND_RIGHT:
7142 case JIM_EXPROP_LOGICOR_RIGHT: wC = (wA != 0); break;
7144 wC = 0; /* avoid gcc warning */
7147 stack[stacklen] = Jim_NewIntObj(interp, wC);
7148 Jim_IncrRefCount(stack[stacklen]);
7152 /* --- Double --- */
7153 if (Jim_GetDouble(interp, A, &dA) != JIM_OK) {
7154 Jim_DecrRefCount(interp, A);
7158 Jim_DecrRefCount(interp, A);
7159 switch(expr->opcode[i]) {
7160 case JIM_EXPROP_NOT: dC = !dA; break;
7161 case JIM_EXPROP_LOGICAND_RIGHT:
7162 case JIM_EXPROP_LOGICOR_RIGHT: dC = (dA != 0); break;
7163 case JIM_EXPROP_BITNOT:
7164 Jim_SetResultString(interp,
7165 "Got floating-point value where integer was expected", -1);
7170 dC = 0; /* avoid gcc warning */
7173 stack[stacklen] = Jim_NewDoubleObj(interp, dC);
7174 Jim_IncrRefCount(stack[stacklen]);
7177 Jim_Panic(interp,"Unknown opcode in Jim_EvalExpression");
7181 /* There is no need to decerement the inUse field because
7182 * this reference is transfered back into the exprObjPtr. */
7183 Jim_FreeIntRep(interp, exprObjPtr);
7184 exprObjPtr->typePtr = &exprObjType;
7185 Jim_SetIntRepPtr(exprObjPtr, expr);
7186 Jim_DecrRefCount(interp, exprObjPtr);
7188 *exprResultPtrPtr = stack[0];
7189 Jim_IncrRefCount(stack[0]);
7190 errRetCode = JIM_OK;
7192 for (i = 0; i < stacklen; i++) {
7193 Jim_DecrRefCount(interp, stack[i]);
7195 if (stack != staticStack)
7200 Jim_SetResultString(interp, "Division by zero", -1);
7204 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
7209 Jim_Obj *exprResultPtr;
7211 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
7212 if (retcode != JIM_OK)
7214 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
7215 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK)
7217 Jim_DecrRefCount(interp, exprResultPtr);
7220 Jim_DecrRefCount(interp, exprResultPtr);
7221 *boolPtr = doubleValue != 0;
7225 Jim_DecrRefCount(interp, exprResultPtr);
7226 *boolPtr = wideValue != 0;
7230 /* -----------------------------------------------------------------------------
7231 * ScanFormat String Object
7232 * ---------------------------------------------------------------------------*/
7234 /* This Jim_Obj will held a parsed representation of a format string passed to
7235 * the Jim_ScanString command. For error diagnostics, the scanformat string has
7236 * to be parsed in its entirely first and then, if correct, can be used for
7237 * scanning. To avoid endless re-parsing, the parsed representation will be
7238 * stored in an internal representation and re-used for performance reason. */
7240 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
7241 * scanformat string. This part will later be used to extract information
7242 * out from the string to be parsed by Jim_ScanString */
7244 typedef struct ScanFmtPartDescr {
7245 char type; /* Type of conversion (e.g. c, d, f) */
7246 char modifier; /* Modify type (e.g. l - long, h - short */
7247 size_t width; /* Maximal width of input to be converted */
7248 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
7249 char *arg; /* Specification of a CHARSET conversion */
7250 char *prefix; /* Prefix to be scanned literally before conversion */
7253 /* The ScanFmtStringObj will held the internal representation of a scanformat
7254 * string parsed and separated in part descriptions. Furthermore it contains
7255 * the original string representation of the scanformat string to allow for
7256 * fast update of the Jim_Obj's string representation part.
7258 * As add-on the internal object representation add some scratch pad area
7259 * for usage by Jim_ScanString to avoid endless allocating and freeing of
7260 * memory for purpose of string scanning.
7262 * The error member points to a static allocated string in case of a mal-
7263 * formed scanformat string or it contains '0' (NULL) in case of a valid
7264 * parse representation.
7266 * The whole memory of the internal representation is allocated as a single
7267 * area of memory that will be internally separated. So freeing and duplicating
7268 * of such an object is cheap */
7270 typedef struct ScanFmtStringObj {
7271 jim_wide size; /* Size of internal repr in bytes */
7272 char *stringRep; /* Original string representation */
7273 size_t count; /* Number of ScanFmtPartDescr contained */
7274 size_t convCount; /* Number of conversions that will assign */
7275 size_t maxPos; /* Max position index if XPG3 is used */
7276 const char *error; /* Ptr to error text (NULL if no error */
7277 char *scratch; /* Some scratch pad used by Jim_ScanString */
7278 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
7282 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7283 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7284 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
7286 static Jim_ObjType scanFmtStringObjType = {
7288 FreeScanFmtInternalRep,
7289 DupScanFmtInternalRep,
7290 UpdateStringOfScanFmt,
7294 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7296 JIM_NOTUSED(interp);
7297 Jim_Free((char*)objPtr->internalRep.ptr);
7298 objPtr->internalRep.ptr = 0;
7301 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7303 size_t size = (size_t)((ScanFmtStringObj*)srcPtr->internalRep.ptr)->size;
7304 ScanFmtStringObj *newVec = (ScanFmtStringObj*)Jim_Alloc(size);
7306 JIM_NOTUSED(interp);
7307 memcpy(newVec, srcPtr->internalRep.ptr, size);
7308 dupPtr->internalRep.ptr = newVec;
7309 dupPtr->typePtr = &scanFmtStringObjType;
7312 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
7314 char *bytes = ((ScanFmtStringObj*)objPtr->internalRep.ptr)->stringRep;
7316 objPtr->bytes = Jim_StrDup(bytes);
7317 objPtr->length = strlen(bytes);
7320 /* SetScanFmtFromAny will parse a given string and create the internal
7321 * representation of the format specification. In case of an error
7322 * the error data member of the internal representation will be set
7323 * to an descriptive error text and the function will be left with
7324 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
7327 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7329 ScanFmtStringObj *fmtObj;
7331 int maxCount, i, approxSize, lastPos = -1;
7332 const char *fmt = objPtr->bytes;
7333 int maxFmtLen = objPtr->length;
7334 const char *fmtEnd = fmt + maxFmtLen;
7337 Jim_FreeIntRep(interp, objPtr);
7338 /* Count how many conversions could take place maximally */
7339 for (i=0, maxCount=0; i < maxFmtLen; ++i)
7342 /* Calculate an approximation of the memory necessary */
7343 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
7344 + (maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
7345 + maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
7346 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
7347 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
7348 + (maxCount +1) * sizeof(char) /* '\0' for every partial */
7349 + 1; /* safety byte */
7350 fmtObj = (ScanFmtStringObj*)Jim_Alloc(approxSize);
7351 memset(fmtObj, 0, approxSize);
7352 fmtObj->size = approxSize;
7354 fmtObj->scratch = (char*)&fmtObj->descr[maxCount+1];
7355 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
7356 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
7357 buffer = fmtObj->stringRep + maxFmtLen + 1;
7358 objPtr->internalRep.ptr = fmtObj;
7359 objPtr->typePtr = &scanFmtStringObjType;
7360 for (i=0, curr=0; fmt < fmtEnd; ++fmt) {
7362 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
7364 descr->width = 0; /* Assume width unspecified */
7365 /* Overread and store any "literal" prefix */
7366 if (*fmt != '%' || fmt[1] == '%') {
7368 descr->prefix = &buffer[i];
7369 for (; fmt < fmtEnd; ++fmt) {
7371 if (fmt[1] != '%') break;
7378 /* Skip the conversion introducing '%' sign */
7380 /* End reached due to non-conversion literal only? */
7383 descr->pos = 0; /* Assume "natural" positioning */
7385 descr->pos = -1; /* Okay, conversion will not be assigned */
7388 fmtObj->convCount++; /* Otherwise count as assign-conversion */
7389 /* Check if next token is a number (could be width or pos */
7390 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7392 /* Was the number a XPG3 position specifier? */
7393 if (descr->pos != -1 && *fmt == '$') {
7398 /* Look if "natural" postioning and XPG3 one was mixed */
7399 if ((lastPos == 0 && descr->pos > 0)
7400 || (lastPos > 0 && descr->pos == 0)) {
7401 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
7404 /* Look if this position was already used */
7405 for (prev=0; prev < curr; ++prev) {
7406 if (fmtObj->descr[prev].pos == -1) continue;
7407 if (fmtObj->descr[prev].pos == descr->pos) {
7408 fmtObj->error = "same \"%n$\" conversion specifier "
7409 "used more than once";
7413 /* Try to find a width after the XPG3 specifier */
7414 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
7415 descr->width = width;
7418 if (descr->pos > 0 && (size_t)descr->pos > fmtObj->maxPos)
7419 fmtObj->maxPos = descr->pos;
7421 /* Number was not a XPG3, so it has to be a width */
7422 descr->width = width;
7425 /* If positioning mode was undetermined yet, fix this */
7427 lastPos = descr->pos;
7428 /* Handle CHARSET conversion type ... */
7430 int swapped = 1, beg = i, end, j;
7432 descr->arg = &buffer[i];
7434 if (*fmt == '^') buffer[i++] = *fmt++;
7435 if (*fmt == ']') buffer[i++] = *fmt++;
7436 while (*fmt && *fmt != ']') buffer[i++] = *fmt++;
7438 fmtObj->error = "unmatched [ in format string";
7443 /* In case a range fence was given "backwards", swap it */
7446 for (j=beg+1; j < end-1; ++j) {
7447 if (buffer[j] == '-' && buffer[j-1] > buffer[j+1]) {
7448 char tmp = buffer[j-1];
7449 buffer[j-1] = buffer[j+1];
7456 /* Remember any valid modifier if given */
7457 if (strchr("hlL", *fmt) != 0)
7458 descr->modifier = tolower((int)*fmt++);
7461 if (strchr("efgcsndoxui", *fmt) == 0) {
7462 fmtObj->error = "bad scan conversion character";
7464 } else if (*fmt == 'c' && descr->width != 0) {
7465 fmtObj->error = "field width may not be specified in %c "
7468 } else if (*fmt == 'u' && descr->modifier == 'l') {
7469 fmtObj->error = "unsigned wide not supported";
7476 if (fmtObj->convCount == 0) {
7477 fmtObj->error = "no any conversion specifier given";
7483 /* Some accessor macros to allow lowlevel access to fields of internal repr */
7485 #define FormatGetCnvCount(_fo_) \
7486 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
7487 #define FormatGetMaxPos(_fo_) \
7488 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
7489 #define FormatGetError(_fo_) \
7490 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
7492 /* Some Bit testing/setting/cleaning routines. For now only used in handling
7493 * charsets ([a-z123]) within scanning. Later on perhaps a base for a
7494 * bitvector implementation in Jim? */
7496 static int JimTestBit(const char *bitvec, char ch)
7498 div_t pos = div(ch-1, 8);
7499 return bitvec[pos.quot] & (1 << pos.rem);
7502 static void JimSetBit(char *bitvec, char ch)
7504 div_t pos = div(ch-1, 8);
7505 bitvec[pos.quot] |= (1 << pos.rem);
7508 #if 0 /* currently not used */
7509 static void JimClearBit(char *bitvec, char ch)
7511 div_t pos = div(ch-1, 8);
7512 bitvec[pos.quot] &= ~(1 << pos.rem);
7516 /* JimScanAString is used to scan an unspecified string that ends with
7517 * next WS, or a string that is specified via a charset. The charset
7518 * is currently implemented in a way to only allow for usage with
7519 * ASCII. Whenever we will switch to UNICODE, another idea has to
7522 * FIXME: Works only with ASCII */
7525 JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
7529 char charset[256/8+1]; /* A Charset may contain max 256 chars */
7530 char *buffer = Jim_Alloc(strlen(str)+1), *anchor = buffer;
7532 /* First init charset to nothing or all, depending if a specified
7533 * or an unspecified string has to be parsed */
7534 memset(charset, (sdescr ? 0 : 255), sizeof(charset));
7536 /* There was a set description given, that means we are parsing
7537 * a specified string. So we have to build a corresponding
7538 * charset reflecting the description */
7540 /* Should the set be negated at the end? */
7541 if (*sdescr == '^') {
7545 /* Here '-' is meant literally and not to define a range */
7546 if (*sdescr == '-') {
7547 JimSetBit(charset, '-');
7551 if (sdescr[1] == '-' && sdescr[2] != 0) {
7552 /* Handle range definitions */
7554 for (i=sdescr[0]; i <= sdescr[2]; ++i)
7555 JimSetBit(charset, (char)i);
7558 /* Handle verbatim character definitions */
7559 JimSetBit(charset, *sdescr++);
7562 /* Negate the charset if there was a NOT given */
7563 for (i=0; notFlag && i < sizeof(charset); ++i)
7564 charset[i] = ~charset[i];
7566 /* And after all the mess above, the real work begin ... */
7567 while (str && *str) {
7568 if (!sdescr && isspace((int)*str))
7569 break; /* EOS via WS if unspecified */
7570 if (JimTestBit(charset, *str)) *buffer++ = *str++;
7571 else break; /* EOS via mismatch if specified scanning */
7573 *buffer = 0; /* Close the string properly ... */
7574 result = Jim_NewStringObj(interp, anchor, -1);
7575 Jim_Free(anchor); /* ... and free it afer usage */
7579 /* ScanOneEntry will scan one entry out of the string passed as argument.
7580 * It use the sscanf() function for this task. After extracting and
7581 * converting of the value, the count of scanned characters will be
7582 * returned of -1 in case of no conversion tool place and string was
7583 * already scanned thru */
7585 static int ScanOneEntry(Jim_Interp *interp, const char *str, long pos,
7586 ScanFmtStringObj *fmtObj, long index, Jim_Obj **valObjPtr)
7588 # define MAX_SIZE (sizeof(jim_wide) > sizeof(double) \
7589 ? sizeof(jim_wide) \
7591 char buffer[MAX_SIZE];
7592 char *value = buffer;
7594 const ScanFmtPartDescr *descr = &fmtObj->descr[index];
7595 size_t sLen = strlen(&str[pos]), scanned = 0;
7596 size_t anchor = pos;
7599 /* First pessimiticly assume, we will not scan anything :-) */
7601 if (descr->prefix) {
7602 /* There was a prefix given before the conversion, skip it and adjust
7603 * the string-to-be-parsed accordingly */
7604 for (i=0; str[pos] && descr->prefix[i]; ++i) {
7605 /* If prefix require, skip WS */
7606 if (isspace((int)descr->prefix[i]))
7607 while (str[pos] && isspace((int)str[pos])) ++pos;
7608 else if (descr->prefix[i] != str[pos])
7609 break; /* Prefix do not match here, leave the loop */
7611 ++pos; /* Prefix matched so far, next round */
7614 return -1; /* All of str consumed: EOF condition */
7615 else if (descr->prefix[i] != 0)
7616 return 0; /* Not whole prefix consumed, no conversion possible */
7618 /* For all but following conversion, skip leading WS */
7619 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
7620 while (isspace((int)str[pos])) ++pos;
7621 /* Determine how much skipped/scanned so far */
7622 scanned = pos - anchor;
7623 if (descr->type == 'n') {
7624 /* Return pseudo conversion means: how much scanned so far? */
7625 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
7626 } else if (str[pos] == 0) {
7627 /* Cannot scan anything, as str is totally consumed */
7630 /* Processing of conversions follows ... */
7631 if (descr->width > 0) {
7632 /* Do not try to scan as fas as possible but only the given width.
7633 * To ensure this, we copy the part that should be scanned. */
7634 size_t tLen = descr->width > sLen ? sLen : descr->width;
7635 tok = Jim_StrDupLen(&str[pos], tLen);
7637 /* As no width was given, simply refer to the original string */
7640 switch (descr->type) {
7642 *valObjPtr = Jim_NewIntObj(interp, *tok);
7645 case 'd': case 'o': case 'x': case 'u': case 'i': {
7646 char *endp; /* Position where the number finished */
7647 int base = descr->type == 'o' ? 8
7648 : descr->type == 'x' ? 16
7649 : descr->type == 'i' ? 0
7653 /* Try to scan a number with the given base */
7654 if (descr->modifier == 'l')
7655 #ifdef HAVE_LONG_LONG
7656 *(jim_wide*)value = JimStrtoll(tok, &endp, base);
7658 *(jim_wide*)value = strtol(tok, &endp, base);
7661 if (descr->type == 'u')
7662 *(long*)value = strtoul(tok, &endp, base);
7664 *(long*)value = strtol(tok, &endp, base);
7665 /* If scanning failed, and base was undetermined, simply
7666 * put it to 10 and try once more. This should catch the
7667 * case where %i begin to parse a number prefix (e.g.
7668 * '0x' but no further digits follows. This will be
7669 * handled as a ZERO followed by a char 'x' by Tcl */
7670 if (endp == tok && base == 0) base = 10;
7674 /* There was some number sucessfully scanned! */
7675 if (descr->modifier == 'l')
7676 *valObjPtr = Jim_NewIntObj(interp, *(jim_wide*)value);
7678 *valObjPtr = Jim_NewIntObj(interp, *(long*)value);
7679 /* Adjust the number-of-chars scanned so far */
7680 scanned += endp - tok;
7682 /* Nothing was scanned. We have to determine if this
7683 * happened due to e.g. prefix mismatch or input str
7685 scanned = *tok ? 0 : -1;
7689 case 's': case '[': {
7690 *valObjPtr = JimScanAString(interp, descr->arg, tok);
7691 scanned += Jim_Length(*valObjPtr);
7694 case 'e': case 'f': case 'g': {
7697 *(double*)value = strtod(tok, &endp);
7699 /* There was some number sucessfully scanned! */
7700 *valObjPtr = Jim_NewDoubleObj(interp, *(double*)value);
7701 /* Adjust the number-of-chars scanned so far */
7702 scanned += endp - tok;
7704 /* Nothing was scanned. We have to determine if this
7705 * happened due to e.g. prefix mismatch or input str
7707 scanned = *tok ? 0 : -1;
7712 /* If a substring was allocated (due to pre-defined width) do not
7713 * forget to free it */
7714 if (tok != &str[pos])
7715 Jim_Free((char*)tok);
7720 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
7721 * string and returns all converted (and not ignored) values in a list back
7722 * to the caller. If an error occured, a NULL pointer will be returned */
7724 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr,
7725 Jim_Obj *fmtObjPtr, int flags)
7729 const char *str = Jim_GetString(strObjPtr, 0);
7730 Jim_Obj *resultList = 0;
7731 Jim_Obj **resultVec;
7733 Jim_Obj *emptyStr = 0;
7734 ScanFmtStringObj *fmtObj;
7736 /* If format specification is not an object, convert it! */
7737 if (fmtObjPtr->typePtr != &scanFmtStringObjType)
7738 SetScanFmtFromAny(interp, fmtObjPtr);
7739 fmtObj = (ScanFmtStringObj*)fmtObjPtr->internalRep.ptr;
7740 /* Check if format specification was valid */
7741 if (fmtObj->error != 0) {
7742 if (flags & JIM_ERRMSG)
7743 Jim_SetResultString(interp, fmtObj->error, -1);
7746 /* Allocate a new "shared" empty string for all unassigned conversions */
7747 emptyStr = Jim_NewEmptyStringObj(interp);
7748 Jim_IncrRefCount(emptyStr);
7749 /* Create a list and fill it with empty strings up to max specified XPG3 */
7750 resultList = Jim_NewListObj(interp, 0, 0);
7751 if (fmtObj->maxPos > 0) {
7752 for (i=0; i < fmtObj->maxPos; ++i)
7753 Jim_ListAppendElement(interp, resultList, emptyStr);
7754 JimListGetElements(interp, resultList, &resultc, &resultVec);
7756 /* Now handle every partial format description */
7757 for (i=0, pos=0; i < fmtObj->count; ++i) {
7758 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
7760 /* Only last type may be "literal" w/o conversion - skip it! */
7761 if (descr->type == 0) continue;
7762 /* As long as any conversion could be done, we will proceed */
7764 scanned = ScanOneEntry(interp, str, pos, fmtObj, i, &value);
7765 /* In case our first try results in EOF, we will leave */
7766 if (scanned == -1 && i == 0)
7768 /* Advance next pos-to-be-scanned for the amount scanned already */
7770 /* value == 0 means no conversion took place so take empty string */
7772 value = Jim_NewEmptyStringObj(interp);
7773 /* If value is a non-assignable one, skip it */
7774 if (descr->pos == -1) {
7775 Jim_FreeNewObj(interp, value);
7776 } else if (descr->pos == 0)
7777 /* Otherwise append it to the result list if no XPG3 was given */
7778 Jim_ListAppendElement(interp, resultList, value);
7779 else if (resultVec[descr->pos-1] == emptyStr) {
7780 /* But due to given XPG3, put the value into the corr. slot */
7781 Jim_DecrRefCount(interp, resultVec[descr->pos-1]);
7782 Jim_IncrRefCount(value);
7783 resultVec[descr->pos-1] = value;
7785 /* Otherwise, the slot was already used - free obj and ERROR */
7786 Jim_FreeNewObj(interp, value);
7790 Jim_DecrRefCount(interp, emptyStr);
7793 Jim_DecrRefCount(interp, emptyStr);
7794 Jim_FreeNewObj(interp, resultList);
7795 return (Jim_Obj*)EOF;
7797 Jim_DecrRefCount(interp, emptyStr);
7798 Jim_FreeNewObj(interp, resultList);
7802 /* -----------------------------------------------------------------------------
7803 * Pseudo Random Number Generation
7804 * ---------------------------------------------------------------------------*/
7805 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7808 /* Initialize the sbox with the numbers from 0 to 255 */
7809 static void JimPrngInit(Jim_Interp *interp)
7812 unsigned int seed[256];
7814 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
7815 for (i = 0; i < 256; i++)
7816 seed[i] = (rand() ^ time(NULL) ^ clock());
7817 JimPrngSeed(interp, (unsigned char*) seed, sizeof(int)*256);
7820 /* Generates N bytes of random data */
7821 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
7823 Jim_PrngState *prng;
7824 unsigned char *destByte = (unsigned char*) dest;
7825 unsigned int si, sj, x;
7827 /* initialization, only needed the first time */
7828 if (interp->prngState == NULL)
7829 JimPrngInit(interp);
7830 prng = interp->prngState;
7831 /* generates 'len' bytes of pseudo-random numbers */
7832 for (x = 0; x < len; x++) {
7833 prng->i = (prng->i+1) & 0xff;
7834 si = prng->sbox[prng->i];
7835 prng->j = (prng->j + si) & 0xff;
7836 sj = prng->sbox[prng->j];
7837 prng->sbox[prng->i] = sj;
7838 prng->sbox[prng->j] = si;
7839 *destByte++ = prng->sbox[(si+sj)&0xff];
7843 /* Re-seed the generator with user-provided bytes */
7844 static void JimPrngSeed(Jim_Interp *interp, const unsigned char *seed,
7848 unsigned char buf[256];
7849 Jim_PrngState *prng;
7851 /* initialization, only needed the first time */
7852 if (interp->prngState == NULL)
7853 JimPrngInit(interp);
7854 prng = interp->prngState;
7856 /* Set the sbox[i] with i */
7857 for (i = 0; i < 256; i++)
7859 /* Now use the seed to perform a random permutation of the sbox */
7860 for (i = 0; i < seedLen; i++) {
7863 t = prng->sbox[i&0xFF];
7864 prng->sbox[i&0xFF] = prng->sbox[seed[i]];
7865 prng->sbox[seed[i]] = t;
7867 prng->i = prng->j = 0;
7868 /* discard the first 256 bytes of stream. */
7869 JimRandomBytes(interp, buf, 256);
7872 /* -----------------------------------------------------------------------------
7873 * Dynamic libraries support (WIN32 not supported)
7874 * ---------------------------------------------------------------------------*/
7879 void * dlopen(const char *path, int mode)
7883 return (void *)LoadLibraryA(path);
7885 int dlclose(void *handle)
7887 FreeLibrary((HANDLE)handle);
7890 void *dlsym(void *handle, const char *symbol)
7892 return GetProcAddress((HMODULE)handle, symbol);
7894 static char win32_dlerror_string[121];
7895 const char *dlerror(void)
7897 FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
7898 LANG_NEUTRAL, win32_dlerror_string, 120, NULL);
7899 return win32_dlerror_string;
7903 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7905 Jim_Obj *libPathObjPtr;
7908 int (*onload)(Jim_Interp *interp);
7910 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
7911 if (libPathObjPtr == NULL) {
7913 libPathObjPtr = NULL;
7915 Jim_IncrRefCount(libPathObjPtr);
7916 Jim_ListLength(interp, libPathObjPtr, &prefixc);
7919 for (i = -1; i < prefixc; i++) {
7921 handle = dlopen(pathName, RTLD_LAZY);
7924 char buf[JIM_PATH_LEN];
7927 Jim_Obj *prefixObjPtr;
7930 if (Jim_ListIndex(interp, libPathObjPtr, i,
7931 &prefixObjPtr, JIM_NONE) != JIM_OK)
7933 prefix = Jim_GetString(prefixObjPtr, &prefixlen);
7934 if (prefixlen+strlen(pathName)+1 >= JIM_PATH_LEN)
7936 if (*pathName == '/') {
7937 strcpy(buf, pathName);
7939 else if (prefixlen && prefix[prefixlen-1] == '/')
7940 sprintf(buf, "%s%s", prefix, pathName);
7942 sprintf(buf, "%s/%s", prefix, pathName);
7943 fp = fopen(buf, "r");
7947 handle = dlopen(buf, RTLD_LAZY);
7949 if (handle == NULL) {
7950 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
7951 Jim_AppendStrings(interp, Jim_GetResult(interp),
7952 "error loading extension \"", pathName,
7953 "\": ", dlerror(), NULL);
7958 if ((onload = dlsym(handle, "Jim_OnLoad")) == NULL) {
7959 Jim_SetResultString(interp,
7960 "No Jim_OnLoad symbol found on extension", -1);
7963 if (onload(interp) == JIM_ERR) {
7967 Jim_SetEmptyResult(interp);
7968 if (libPathObjPtr != NULL)
7969 Jim_DecrRefCount(interp, libPathObjPtr);
7973 if (libPathObjPtr != NULL)
7974 Jim_DecrRefCount(interp, libPathObjPtr);
7977 #else /* JIM_DYNLIB */
7978 int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
7980 JIM_NOTUSED(interp);
7981 JIM_NOTUSED(pathName);
7983 Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
7986 #endif/* JIM_DYNLIB */
7988 /* -----------------------------------------------------------------------------
7990 * ---------------------------------------------------------------------------*/
7992 #define JIM_PKG_ANY_VERSION -1
7994 /* Convert a string of the type "1.2" into an integer.
7995 * MAJOR.MINOR is converted as MAJOR*100+MINOR, so "1.2" is converted
7996 * to the integer with value 102 */
7997 static int JimPackageVersionToInt(Jim_Interp *interp, const char *v,
7998 int *intPtr, int flags)
8001 jim_wide major, minor;
8002 char *majorStr, *minorStr, *p;
8005 *intPtr = JIM_PKG_ANY_VERSION;
8009 copy = Jim_StrDup(v);
8010 p = strchr(copy, '.');
8011 if (p == NULL) goto badfmt;
8016 if (Jim_StringToWide(majorStr, &major, 10) != JIM_OK ||
8017 Jim_StringToWide(minorStr, &minor, 10) != JIM_OK)
8019 *intPtr = (int)(major*100+minor);
8025 if (flags & JIM_ERRMSG) {
8026 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8027 Jim_AppendStrings(interp, Jim_GetResult(interp),
8028 "invalid package version '", v, "'", NULL);
8033 #define JIM_MATCHVER_EXACT (1<<JIM_PRIV_FLAG_SHIFT)
8034 static int JimPackageMatchVersion(int needed, int actual, int flags)
8036 if (needed == JIM_PKG_ANY_VERSION) return 1;
8037 if (flags & JIM_MATCHVER_EXACT) {
8038 return needed == actual;
8040 return needed/100 == actual/100 && (needed <= actual);
8044 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver,
8048 /* Check if the version format is ok */
8049 if (JimPackageVersionToInt(interp, ver, &intVersion, JIM_ERRMSG) != JIM_OK)
8051 /* If the package was already provided returns an error. */
8052 if (Jim_FindHashEntry(&interp->packages, name) != NULL) {
8053 if (flags & JIM_ERRMSG) {
8054 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8055 Jim_AppendStrings(interp, Jim_GetResult(interp),
8056 "package '", name, "' was already provided", NULL);
8060 Jim_AddHashEntry(&interp->packages, name, (char*) ver);
8067 # include <sys/types.h>
8068 # include <dirent.h>
8071 /* Posix dirent.h compatiblity layer for WIN32.
8072 * Copyright Kevlin Henney, 1997, 2003. All rights reserved.
8073 * Copyright Salvatore Sanfilippo ,2005.
8075 * Permission to use, copy, modify, and distribute this software and its
8076 * documentation for any purpose is hereby granted without fee, provided
8077 * that this copyright and permissions notice appear in all copies and
8080 * This software is supplied "as is" without express or implied warranty.
8081 * This software was modified by Salvatore Sanfilippo for the Jim Interpreter.
8088 typedef struct DIR {
8089 long handle; /* -1 for failed rewind */
8090 struct _finddata_t info;
8091 struct dirent result; /* d_name null iff first time */
8092 char *name; /* null-terminated char string */
8095 DIR *opendir(const char *name)
8099 if(name && name[0]) {
8100 size_t base_length = strlen(name);
8101 const char *all = /* search pattern must end with suitable wildcard */
8102 strchr("/\\", name[base_length - 1]) ? "*" : "/*";
8104 if((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 &&
8105 (dir->name = (char *) Jim_Alloc(base_length + strlen(all) + 1)) != 0)
8107 strcat(strcpy(dir->name, name), all);
8109 if((dir->handle = (long) _findfirst(dir->name, &dir->info)) != -1)
8110 dir->result.d_name = 0;
8111 else { /* rollback */
8112 Jim_Free(dir->name);
8116 } else { /* rollback */
8127 int closedir(DIR *dir)
8132 if(dir->handle != -1)
8133 result = _findclose(dir->handle);
8134 Jim_Free(dir->name);
8137 if(result == -1) /* map all errors to EBADF */
8142 struct dirent *readdir(DIR *dir)
8144 struct dirent *result = 0;
8146 if(dir && dir->handle != -1) {
8147 if(!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) {
8148 result = &dir->result;
8149 result->d_name = dir->info.name;
8159 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8160 int prefixc, const char *pkgName, int pkgVer, int flags)
8162 int bestVer = -1, i;
8163 int pkgNameLen = strlen(pkgName);
8164 char *bestPackage = NULL;
8167 for (i = 0; i < prefixc; i++) {
8169 char buf[JIM_PATH_LEN];
8172 if (prefixes[i] == NULL) continue;
8173 strncpy(buf, prefixes[i], JIM_PATH_LEN);
8174 buf[JIM_PATH_LEN-1] = '\0';
8175 prefixLen = strlen(buf);
8176 if (prefixLen && buf[prefixLen-1] == '/')
8177 buf[prefixLen-1] = '\0';
8179 if ((dir = opendir(buf)) == NULL) continue;
8180 while ((de = readdir(dir)) != NULL) {
8181 char *fileName = de->d_name;
8182 int fileNameLen = strlen(fileName);
8184 if (strncmp(fileName, "jim-", 4) == 0 &&
8185 strncmp(fileName+4, pkgName, pkgNameLen) == 0 &&
8186 *(fileName+4+pkgNameLen) == '-' &&
8187 fileNameLen > 4 && /* note that this is not really useful */
8188 (strncmp(fileName+fileNameLen-4, ".tcl", 4) == 0 ||
8189 strncmp(fileName+fileNameLen-4, ".dll", 4) == 0 ||
8190 strncmp(fileName+fileNameLen-3, ".so", 3) == 0))
8192 char ver[6]; /* xx.yy<nulterm> */
8193 char *p = strrchr(fileName, '.');
8194 int verLen, fileVer;
8196 verLen = p - (fileName+4+pkgNameLen+1);
8197 if (verLen < 3 || verLen > 5) continue;
8198 memcpy(ver, fileName+4+pkgNameLen+1, verLen);
8200 if (JimPackageVersionToInt(interp, ver, &fileVer, JIM_NONE)
8201 != JIM_OK) continue;
8202 if (JimPackageMatchVersion(pkgVer, fileVer, flags) &&
8203 (bestVer == -1 || bestVer < fileVer))
8206 Jim_Free(bestPackage);
8207 bestPackage = Jim_Alloc(strlen(buf)+strlen(fileName)+2);
8208 sprintf(bestPackage, "%s/%s", buf, fileName);
8217 #else /* JIM_ANSIC */
8219 static char *JimFindBestPackage(Jim_Interp *interp, char **prefixes,
8220 int prefixc, const char *pkgName, int pkgVer, int flags)
8222 JIM_NOTUSED(interp);
8223 JIM_NOTUSED(prefixes);
8224 JIM_NOTUSED(prefixc);
8225 JIM_NOTUSED(pkgName);
8226 JIM_NOTUSED(pkgVer);
8231 #endif /* JIM_ANSIC */
8233 /* Search for a suitable package under every dir specified by jim_libpath
8234 * and load it if possible. If a suitable package was loaded with success
8235 * JIM_OK is returned, otherwise JIM_ERR is returned. */
8236 static int JimLoadPackage(Jim_Interp *interp, const char *name, int ver,
8239 Jim_Obj *libPathObjPtr;
8240 char **prefixes, *best;
8241 int prefixc, i, retCode = JIM_OK;
8243 libPathObjPtr = Jim_GetGlobalVariableStr(interp, "jim_libpath", JIM_NONE);
8244 if (libPathObjPtr == NULL) {
8246 libPathObjPtr = NULL;
8248 Jim_IncrRefCount(libPathObjPtr);
8249 Jim_ListLength(interp, libPathObjPtr, &prefixc);
8252 prefixes = Jim_Alloc(sizeof(char*)*prefixc);
8253 for (i = 0; i < prefixc; i++) {
8254 Jim_Obj *prefixObjPtr;
8255 if (Jim_ListIndex(interp, libPathObjPtr, i,
8256 &prefixObjPtr, JIM_NONE) != JIM_OK)
8261 prefixes[i] = Jim_StrDup(Jim_GetString(prefixObjPtr, NULL));
8263 /* Scan every directory to find the "best" package. */
8264 best = JimFindBestPackage(interp, prefixes, prefixc, name, ver, flags);
8266 char *p = strrchr(best, '.');
8267 /* Try to load/source it */
8268 if (p && strcmp(p, ".tcl") == 0) {
8269 retCode = Jim_EvalFile(interp, best);
8271 retCode = Jim_LoadLibrary(interp, best);
8277 for (i = 0; i < prefixc; i++)
8278 Jim_Free(prefixes[i]);
8281 Jim_DecrRefCount(interp, libPathObjPtr);
8285 const char *Jim_PackageRequire(Jim_Interp *interp, const char *name,
8286 const char *ver, int flags)
8291 /* Start with an empty error string */
8292 Jim_SetResultString(interp, "", 0);
8294 if (JimPackageVersionToInt(interp, ver, &requiredVer, JIM_ERRMSG) != JIM_OK)
8296 he = Jim_FindHashEntry(&interp->packages, name);
8298 /* Try to load the package. */
8299 if (JimLoadPackage(interp, name, requiredVer, flags) == JIM_OK) {
8300 he = Jim_FindHashEntry(&interp->packages, name);
8306 /* No way... return an error. */
8307 if (flags & JIM_ERRMSG) {
8309 Jim_GetString(Jim_GetResult(interp), &len);
8310 Jim_AppendStrings(interp, Jim_GetResult(interp), len ? "\n" : "",
8311 "Can't find package '", name, "'", NULL);
8316 if (JimPackageVersionToInt(interp, he->val, &actualVer, JIM_ERRMSG)
8321 /* Check if version matches. */
8322 if (JimPackageMatchVersion(requiredVer, actualVer, flags) == 0) {
8323 Jim_AppendStrings(interp, Jim_GetResult(interp),
8324 "Package '", name, "' already loaded, but with version ",
8332 /* -----------------------------------------------------------------------------
8334 * ---------------------------------------------------------------------------*/
8335 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
8336 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
8338 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8339 Jim_Obj *const *argv);
8341 /* Handle calls to the [unknown] command */
8342 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
8344 Jim_Obj **v, *sv[JIM_EVAL_SARGV_LEN];
8347 /* If JimUnknown() is recursively called (e.g. error in the unknown proc,
8350 if (interp->unknown_called) {
8354 /* If the [unknown] command does not exists returns
8356 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
8359 /* The object interp->unknown just contains
8360 * the "unknown" string, it is used in order to
8361 * avoid to lookup the unknown command every time
8362 * but instread to cache the result. */
8363 if (argc+1 <= JIM_EVAL_SARGV_LEN)
8366 v = Jim_Alloc(sizeof(Jim_Obj*)*(argc+1));
8367 /* Make a copy of the arguments vector, but shifted on
8368 * the right of one position. The command name of the
8369 * command will be instead the first argument of the
8370 * [unknonw] call. */
8371 memcpy(v+1, argv, sizeof(Jim_Obj*)*argc);
8372 v[0] = interp->unknown;
8374 interp->unknown_called++;
8375 retCode = Jim_EvalObjVector(interp, argc+1, v);
8376 interp->unknown_called--;
8384 /* Eval the object vector 'objv' composed of 'objc' elements.
8385 * Every element is used as single argument.
8386 * Jim_EvalObj() will call this function every time its object
8387 * argument is of "list" type, with no string representation.
8389 * This is possible because the string representation of a
8390 * list object generated by the UpdateStringOfList is made
8391 * in a way that ensures that every list element is a different
8392 * command argument. */
8393 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
8398 /* Incr refcount of arguments. */
8399 for (i = 0; i < objc; i++)
8400 Jim_IncrRefCount(objv[i]);
8401 /* Command lookup */
8402 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
8403 if (cmdPtr == NULL) {
8404 retcode = JimUnknown(interp, objc, objv);
8406 /* Call it -- Make sure result is an empty object. */
8407 Jim_SetEmptyResult(interp);
8408 if (cmdPtr->cmdProc) {
8409 interp->cmdPrivData = cmdPtr->privData;
8410 retcode = cmdPtr->cmdProc(interp, objc, objv);
8411 if (retcode == JIM_ERR_ADDSTACK) {
8412 //JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8416 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
8417 if (retcode == JIM_ERR) {
8418 JimAppendStackTrace(interp,
8419 Jim_GetString(objv[0], NULL), "", 1);
8423 /* Decr refcount of arguments and return the retcode */
8424 for (i = 0; i < objc; i++)
8425 Jim_DecrRefCount(interp, objv[i]);
8429 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
8430 * via *objPtrPtr. This function is only called by Jim_EvalObj().
8431 * The returned object has refcount = 0. */
8432 int Jim_InterpolateTokens(Jim_Interp *interp, ScriptToken *token,
8433 int tokens, Jim_Obj **objPtrPtr)
8435 int totlen = 0, i, retcode;
8437 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
8441 if (tokens <= JIM_EVAL_SINTV_LEN)
8444 intv = Jim_Alloc(sizeof(Jim_Obj*)*
8446 /* Compute every token forming the argument
8447 * in the intv objects vector. */
8448 for (i = 0; i < tokens; i++) {
8449 switch(token[i].type) {
8452 intv[i] = token[i].objPtr;
8455 intv[i] = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
8461 case JIM_TT_DICTSUGAR:
8462 intv[i] = Jim_ExpandDictSugar(interp, token[i].objPtr);
8469 retcode = Jim_EvalObj(interp, token[i].objPtr);
8470 if (retcode != JIM_OK)
8472 intv[i] = Jim_GetResult(interp);
8476 "default token type reached "
8477 "in Jim_InterpolateTokens().");
8480 Jim_IncrRefCount(intv[i]);
8481 /* Make sure there is a valid
8482 * string rep, and add the string
8483 * length to the total legnth. */
8484 Jim_GetString(intv[i], NULL);
8485 totlen += intv[i]->length;
8487 /* Concatenate every token in an unique
8489 objPtr = Jim_NewStringObjNoAlloc(interp,
8491 s = objPtr->bytes = Jim_Alloc(totlen+1);
8492 objPtr->length = totlen;
8493 for (i = 0; i < tokens; i++) {
8494 memcpy(s, intv[i]->bytes, intv[i]->length);
8495 s += intv[i]->length;
8496 Jim_DecrRefCount(interp, intv[i]);
8498 objPtr->bytes[totlen] = '\0';
8499 /* Free the intv vector if not static. */
8500 if (tokens > JIM_EVAL_SINTV_LEN)
8502 *objPtrPtr = objPtr;
8507 Jim_DecrRefCount(interp, intv[i]);
8508 if (tokens > JIM_EVAL_SINTV_LEN)
8513 /* Helper of Jim_EvalObj() to perform argument expansion.
8514 * Basically this function append an argument to 'argv'
8515 * (and increments argc by reference accordingly), performing
8516 * expansion of the list object if 'expand' is non-zero, or
8517 * just adding objPtr to argv if 'expand' is zero. */
8518 void Jim_ExpandArgument(Jim_Interp *interp, Jim_Obj ***argv,
8519 int *argcPtr, int expand, Jim_Obj *objPtr)
8522 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+1));
8523 /* refcount of objPtr not incremented because
8524 * we are actually transfering a reference from
8525 * the old 'argv' to the expanded one. */
8526 (*argv)[*argcPtr] = objPtr;
8531 Jim_ListLength(interp, objPtr, &len);
8532 (*argv) = Jim_Realloc(*argv, sizeof(Jim_Obj*)*((*argcPtr)+len));
8533 for (i = 0; i < len; i++) {
8534 (*argv)[*argcPtr] = objPtr->internalRep.listValue.ele[i];
8535 Jim_IncrRefCount(objPtr->internalRep.listValue.ele[i]);
8538 /* The original object reference is no longer needed,
8539 * after the expansion it is no longer present on
8540 * the argument vector, but the single elements are
8542 Jim_DecrRefCount(interp, objPtr);
8546 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8551 int *cs; /* command structure array */
8552 int retcode = JIM_OK;
8553 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL, *tmpObjPtr;
8555 interp->errorFlag = 0;
8557 /* If the object is of type "list" and there is no
8558 * string representation for this object, we can call
8559 * a specialized version of Jim_EvalObj() */
8560 if (scriptObjPtr->typePtr == &listObjType &&
8561 scriptObjPtr->internalRep.listValue.len &&
8562 scriptObjPtr->bytes == NULL) {
8563 Jim_IncrRefCount(scriptObjPtr);
8564 retcode = Jim_EvalObjVector(interp,
8565 scriptObjPtr->internalRep.listValue.len,
8566 scriptObjPtr->internalRep.listValue.ele);
8567 Jim_DecrRefCount(interp, scriptObjPtr);
8571 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
8572 script = Jim_GetScript(interp, scriptObjPtr);
8573 /* Now we have to make sure the internal repr will not be
8574 * freed on shimmering.
8576 * Think for example to this:
8578 * set x {llength $x; ... some more code ...}; eval $x
8580 * In order to preserve the internal rep, we increment the
8581 * inUse field of the script internal rep structure. */
8584 token = script->token;
8586 cs = script->cmdStruct;
8587 i = 0; /* 'i' is the current token index. */
8589 /* Reset the interpreter result. This is useful to
8590 * return the emtpy result in the case of empty program. */
8591 Jim_SetEmptyResult(interp);
8593 /* Execute every command sequentially, returns on
8594 * error (i.e. if a command does not return JIM_OK) */
8597 int argc = *cs++; /* Get the number of arguments */
8600 /* Set the expand flag if needed. */
8605 /* Allocate the arguments vector */
8606 if (argc <= JIM_EVAL_SARGV_LEN)
8609 argv = Jim_Alloc(sizeof(Jim_Obj*)*argc);
8610 /* Populate the arguments objects. */
8611 for (j = 0; j < argc; j++) {
8614 /* tokens is negative if expansion is needed.
8615 * for this argument. */
8617 tokens = (-tokens)-1;
8621 /* Fast path if the token does not
8622 * need interpolation */
8623 switch(token[i].type) {
8626 argv[j] = token[i].objPtr;
8629 tmpObjPtr = Jim_GetVariable(interp, token[i].objPtr,
8635 argv[j] = tmpObjPtr;
8637 case JIM_TT_DICTSUGAR:
8638 tmpObjPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
8643 argv[j] = tmpObjPtr;
8646 retcode = Jim_EvalObj(interp, token[i].objPtr);
8647 if (retcode != JIM_OK)
8649 argv[j] = Jim_GetResult(interp);
8653 "default token type reached "
8654 "in Jim_EvalObj().");
8657 Jim_IncrRefCount(argv[j]);
8660 /* For interpolation we call an helper
8661 * function doing the work for us. */
8662 if ((retcode = Jim_InterpolateTokens(interp,
8663 token+i, tokens, &tmpObjPtr)) != JIM_OK)
8667 argv[j] = tmpObjPtr;
8668 Jim_IncrRefCount(argv[j]);
8672 /* Handle {expand} expansion */
8674 int *ecs = cs - argc;
8676 Jim_Obj **eargv = NULL;
8678 for (j = 0; j < argc; j++) {
8679 Jim_ExpandArgument( interp, &eargv, &eargc,
8680 ecs[j] < 0, argv[j]);
8688 /* Nothing to do with zero args. */
8693 /* Lookup the command to call */
8694 cmd = Jim_GetCommand(interp, argv[0], JIM_ERRMSG);
8696 /* Call it -- Make sure result is an empty object. */
8697 Jim_SetEmptyResult(interp);
8699 interp->cmdPrivData = cmd->privData;
8700 retcode = cmd->cmdProc(interp, argc, argv);
8701 if ((retcode == JIM_ERR)||(retcode == JIM_ERR_ADDSTACK)) {
8702 JimAppendStackTrace(interp, "", script->fileName, token[i-argc*2].linenr);
8706 retcode = JimCallProcedure(interp, cmd, argc, argv);
8707 if (retcode == JIM_ERR) {
8708 JimAppendStackTrace(interp,
8709 Jim_GetString(argv[0], NULL), script->fileName,
8710 token[i-argc*2].linenr);
8714 /* Call [unknown] */
8715 retcode = JimUnknown(interp, argc, argv);
8716 if (retcode == JIM_ERR) {
8717 JimAppendStackTrace(interp,
8718 "", script->fileName,
8719 token[i-argc*2].linenr);
8722 if (retcode != JIM_OK) {
8723 i -= argc*2; /* point to the command name. */
8726 /* Decrement the arguments count */
8727 for (j = 0; j < argc; j++) {
8728 Jim_DecrRefCount(interp, argv[j]);
8731 if (argv != sargv) {
8736 /* Note that we don't have to decrement inUse, because the
8737 * following code transfers our use of the reference again to
8738 * the script object. */
8739 j = 0; /* on normal termination, the argv array is already
8740 Jim_DecrRefCount-ed. */
8742 /* Handle errors. */
8743 if (retcode == JIM_ERR && !interp->errorFlag) {
8744 interp->errorFlag = 1;
8745 JimSetErrorFileName(interp, script->fileName);
8746 JimSetErrorLineNumber(interp, token[i].linenr);
8747 JimResetStackTrace(interp);
8749 Jim_FreeIntRep(interp, scriptObjPtr);
8750 scriptObjPtr->typePtr = &scriptObjType;
8751 Jim_SetIntRepPtr(scriptObjPtr, script);
8752 Jim_DecrRefCount(interp, scriptObjPtr);
8753 for (i = 0; i < j; i++) {
8754 Jim_DecrRefCount(interp, argv[i]);
8761 /* Call a procedure implemented in Tcl.
8762 * It's possible to speed-up a lot this function, currently
8763 * the callframes are not cached, but allocated and
8764 * destroied every time. What is expecially costly is
8765 * to create/destroy the local vars hash table every time.
8767 * This can be fixed just implementing callframes caching
8768 * in JimCreateCallFrame() and JimFreeCallFrame(). */
8769 int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc,
8770 Jim_Obj *const *argv)
8773 Jim_CallFrame *callFramePtr;
8777 if (argc < cmd->arityMin || (cmd->arityMax != -1 &&
8778 argc > cmd->arityMax)) {
8779 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
8780 Jim_AppendStrings(interp, objPtr,
8781 "wrong # args: should be \"", Jim_GetString(argv[0], NULL),
8782 (cmd->arityMin > 1) ? " " : "",
8783 Jim_GetString(cmd->argListObjPtr, NULL), "\"", NULL);
8784 Jim_SetResult(interp, objPtr);
8787 /* Check if there are too nested calls */
8788 if (interp->numLevels == interp->maxNestingDepth) {
8789 Jim_SetResultString(interp,
8790 "Too many nested calls. Infinite recursion?", -1);
8793 /* Create a new callframe */
8794 callFramePtr = JimCreateCallFrame(interp);
8795 callFramePtr->parentCallFrame = interp->framePtr;
8796 callFramePtr->argv = argv;
8797 callFramePtr->argc = argc;
8798 callFramePtr->procArgsObjPtr = cmd->argListObjPtr;
8799 callFramePtr->procBodyObjPtr = cmd->bodyObjPtr;
8800 callFramePtr->staticVars = cmd->staticVars;
8801 Jim_IncrRefCount(cmd->argListObjPtr);
8802 Jim_IncrRefCount(cmd->bodyObjPtr);
8803 interp->framePtr = callFramePtr;
8804 interp->numLevels ++;
8807 Jim_ListLength(interp, cmd->argListObjPtr, &num_args);
8809 /* If last argument is 'args', don't set it here */
8810 if (cmd->arityMax == -1) {
8814 for (i = 0; i < num_args; i++) {
8816 Jim_Obj *nameObjPtr;
8817 Jim_Obj *valueObjPtr;
8819 Jim_ListIndex(interp, cmd->argListObjPtr, i, &argObjPtr, JIM_NONE);
8820 if (i + 1 >= cmd->arityMin) {
8821 /* The name is the first element of the list */
8822 Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
8825 /* The element arg is the name */
8826 nameObjPtr = argObjPtr;
8829 if (i + 1 >= argc) {
8830 /* No more values, so use default */
8831 /* The value is the second element of the list */
8832 Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
8835 valueObjPtr = argv[i+1];
8837 Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
8839 /* Set optional arguments */
8840 if (cmd->arityMax == -1) {
8841 Jim_Obj *listObjPtr, *objPtr;
8844 listObjPtr = Jim_NewListObj(interp, argv+i, argc-i);
8845 Jim_ListIndex(interp, cmd->argListObjPtr, num_args, &objPtr, JIM_NONE);
8846 Jim_SetVariable(interp, objPtr, listObjPtr);
8849 retcode = Jim_EvalObj(interp, cmd->bodyObjPtr);
8851 /* Destroy the callframe */
8852 interp->numLevels --;
8853 interp->framePtr = interp->framePtr->parentCallFrame;
8854 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
8855 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
8857 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
8859 /* Handle the JIM_EVAL return code */
8860 if (retcode == JIM_EVAL && interp->evalRetcodeLevel != interp->numLevels) {
8861 int savedLevel = interp->evalRetcodeLevel;
8863 interp->evalRetcodeLevel = interp->numLevels;
8864 while (retcode == JIM_EVAL) {
8865 Jim_Obj *resultScriptObjPtr = Jim_GetResult(interp);
8866 Jim_IncrRefCount(resultScriptObjPtr);
8867 retcode = Jim_EvalObj(interp, resultScriptObjPtr);
8868 Jim_DecrRefCount(interp, resultScriptObjPtr);
8870 interp->evalRetcodeLevel = savedLevel;
8872 /* Handle the JIM_RETURN return code */
8873 if (retcode == JIM_RETURN) {
8874 retcode = interp->returnCode;
8875 interp->returnCode = JIM_OK;
8880 int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
8883 Jim_Obj *scriptObjPtr;
8885 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
8886 Jim_IncrRefCount(scriptObjPtr);
8890 JimSetSourceInfo( interp, scriptObjPtr, filename, lineno );
8893 retval = Jim_EvalObj(interp, scriptObjPtr);
8894 Jim_DecrRefCount(interp, scriptObjPtr);
8898 int Jim_Eval(Jim_Interp *interp, const char *script)
8900 return Jim_Eval_Named( interp, script, NULL, 0 );
8905 /* Execute script in the scope of the global level */
8906 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
8908 Jim_CallFrame *savedFramePtr;
8911 savedFramePtr = interp->framePtr;
8912 interp->framePtr = interp->topFramePtr;
8913 retval = Jim_Eval(interp, script);
8914 interp->framePtr = savedFramePtr;
8918 int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
8920 Jim_CallFrame *savedFramePtr;
8923 savedFramePtr = interp->framePtr;
8924 interp->framePtr = interp->topFramePtr;
8925 retval = Jim_EvalObj(interp, scriptObjPtr);
8926 interp->framePtr = savedFramePtr;
8927 /* Try to report the error (if any) via the bgerror proc */
8928 if (retval != JIM_OK) {
8931 objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
8932 objv[1] = Jim_GetResult(interp);
8933 Jim_IncrRefCount(objv[0]);
8934 Jim_IncrRefCount(objv[1]);
8935 if (Jim_EvalObjVector(interp, 2, objv) != JIM_OK) {
8936 /* Report the error to stderr. */
8937 Jim_fprintf( interp, interp->cookie_stderr, "Background error:" JIM_NL);
8938 Jim_PrintErrorMessage(interp);
8940 Jim_DecrRefCount(interp, objv[0]);
8941 Jim_DecrRefCount(interp, objv[1]);
8946 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
8950 int nread, totread, maxlen, buflen;
8952 Jim_Obj *scriptObjPtr;
8954 if ((fp = fopen(filename, "r")) == NULL) {
8955 const int cwd_len=2048;
8956 char *cwd=malloc(cwd_len);
8957 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
8958 if (!getcwd( cwd, cwd_len )) strcpy(cwd, "unknown");
8959 Jim_AppendStrings(interp, Jim_GetResult(interp),
8960 "Error loading script \"", filename, "\"",
8962 " err: ", strerror(errno), NULL);
8967 maxlen = totread = 0;
8969 if (maxlen < totread+buflen+1) {
8970 maxlen = totread+buflen+1;
8971 prg = Jim_Realloc(prg, maxlen);
8973 /* do not use Jim_fread() - this is really a file */
8974 if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;
8977 prg[totread] = '\0';
8978 /* do not use Jim_fclose() - this is really a file */
8981 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
8982 JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
8983 Jim_IncrRefCount(scriptObjPtr);
8984 retval = Jim_EvalObj(interp, scriptObjPtr);
8985 Jim_DecrRefCount(interp, scriptObjPtr);
8989 /* -----------------------------------------------------------------------------
8991 * ---------------------------------------------------------------------------*/
8992 static int JimParseSubstStr(struct JimParserCtx *pc)
8995 pc->tline = pc->linenr;
8996 while (*pc->p && *pc->p != '$' && *pc->p != '[') {
9000 pc->tt = JIM_TT_ESC;
9004 static int JimParseSubst(struct JimParserCtx *pc, int flags)
9009 pc->tstart = pc->tend = pc->p;
9010 pc->tline = pc->linenr;
9011 pc->tt = JIM_TT_EOL;
9017 retval = JimParseCmd(pc);
9018 if (flags & JIM_SUBST_NOCMD) {
9021 pc->tt = (flags & JIM_SUBST_NOESC) ?
9022 JIM_TT_STR : JIM_TT_ESC;
9027 if (JimParseVar(pc) == JIM_ERR) {
9028 pc->tstart = pc->tend = pc->p++; pc->len--;
9029 pc->tline = pc->linenr;
9030 pc->tt = JIM_TT_STR;
9032 if (flags & JIM_SUBST_NOVAR) {
9034 if (flags & JIM_SUBST_NOESC)
9035 pc->tt = JIM_TT_STR;
9037 pc->tt = JIM_TT_ESC;
9038 if (*pc->tstart == '{') {
9047 retval = JimParseSubstStr(pc);
9048 if (flags & JIM_SUBST_NOESC)
9049 pc->tt = JIM_TT_STR;
9056 /* The subst object type reuses most of the data structures and functions
9057 * of the script object. Script's data structures are a bit more complex
9058 * for what is needed for [subst]itution tasks, but the reuse helps to
9059 * deal with a single data structure at the cost of some more memory
9060 * usage for substitutions. */
9061 static Jim_ObjType substObjType = {
9063 FreeScriptInternalRep,
9064 DupScriptInternalRep,
9066 JIM_TYPE_REFERENCES,
9069 /* This method takes the string representation of an object
9070 * as a Tcl string where to perform [subst]itution, and generates
9071 * the pre-parsed internal representation. */
9072 int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
9075 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
9076 struct JimParserCtx parser;
9077 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
9081 script->commands = 0;
9082 script->token = NULL;
9083 script->cmdStruct = NULL;
9085 script->substFlags = flags;
9086 script->fileName = NULL;
9088 JimParserInit(&parser, scriptText, scriptTextLen, 1);
9091 int len, type, linenr;
9093 JimParseSubst(&parser, flags);
9094 if (JimParserEof(&parser)) break;
9095 token = JimParserGetToken(&parser, &len, &type, &linenr);
9096 ScriptObjAddToken(interp, script, token, len, type,
9099 /* Free the old internal rep and set the new one. */
9100 Jim_FreeIntRep(interp, objPtr);
9101 Jim_SetIntRepPtr(objPtr, script);
9102 objPtr->typePtr = &scriptObjType;
9106 ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
9108 struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
9110 if (objPtr->typePtr != &substObjType || script->substFlags != flags)
9111 SetSubstFromAny(interp, objPtr, flags);
9112 return (ScriptObj*) Jim_GetIntRepPtr(objPtr);
9115 /* Performs commands,variables,blackslashes substitution,
9116 * storing the result object (with refcount 0) into
9118 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr,
9119 Jim_Obj **resObjPtrPtr, int flags)
9123 int i, len, retcode = JIM_OK;
9124 Jim_Obj *resObjPtr, *savedResultObjPtr;
9126 script = Jim_GetSubst(interp, substObjPtr, flags);
9127 #ifdef JIM_OPTIMIZATION
9128 /* Fast path for a very common case with array-alike syntax,
9129 * that's: $foo($bar) */
9130 if (script->len == 1 && script->token[0].type == JIM_TT_VAR) {
9131 Jim_Obj *varObjPtr = script->token[0].objPtr;
9133 Jim_IncrRefCount(varObjPtr);
9134 resObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
9135 if (resObjPtr == NULL) {
9136 Jim_DecrRefCount(interp, varObjPtr);
9139 Jim_DecrRefCount(interp, varObjPtr);
9140 *resObjPtrPtr = resObjPtr;
9145 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
9146 /* In order to preserve the internal rep, we increment the
9147 * inUse field of the script internal rep structure. */
9150 token = script->token;
9153 /* Save the interp old result, to set it again before
9155 savedResultObjPtr = interp->result;
9156 Jim_IncrRefCount(savedResultObjPtr);
9158 /* Perform the substitution. Starts with an empty object
9159 * and adds every token (performing the appropriate
9160 * var/command/escape substitution). */
9161 resObjPtr = Jim_NewStringObj(interp, "", 0);
9162 for (i = 0; i < len; i++) {
9165 switch(token[i].type) {
9168 Jim_AppendObj(interp, resObjPtr, token[i].objPtr);
9171 objPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
9172 if (objPtr == NULL) goto err;
9173 Jim_IncrRefCount(objPtr);
9174 Jim_AppendObj(interp, resObjPtr, objPtr);
9175 Jim_DecrRefCount(interp, objPtr);
9177 case JIM_TT_DICTSUGAR:
9178 objPtr = Jim_ExpandDictSugar(interp, token[i].objPtr);
9185 if (Jim_EvalObj(interp, token[i].objPtr) != JIM_OK)
9187 Jim_AppendObj(interp, resObjPtr, interp->result);
9191 "default token type (%d) reached "
9192 "in Jim_SubstObj().", token[i].type);
9197 if (retcode == JIM_OK)
9198 Jim_SetResult(interp, savedResultObjPtr);
9199 Jim_DecrRefCount(interp, savedResultObjPtr);
9200 /* Note that we don't have to decrement inUse, because the
9201 * following code transfers our use of the reference again to
9202 * the script object. */
9203 Jim_FreeIntRep(interp, substObjPtr);
9204 substObjPtr->typePtr = &scriptObjType;
9205 Jim_SetIntRepPtr(substObjPtr, script);
9206 Jim_DecrRefCount(interp, substObjPtr);
9207 *resObjPtrPtr = resObjPtr;
9210 Jim_FreeNewObj(interp, resObjPtr);
9215 /* -----------------------------------------------------------------------------
9216 * API Input/Export functions
9217 * ---------------------------------------------------------------------------*/
9219 int Jim_GetApi(Jim_Interp *interp, const char *funcname, void *targetPtrPtr)
9223 he = Jim_FindHashEntry(&interp->stub, funcname);
9226 memcpy(targetPtrPtr, &he->val, sizeof(void*));
9230 int Jim_RegisterApi(Jim_Interp *interp, const char *funcname, void *funcptr)
9232 return Jim_AddHashEntry(&interp->stub, funcname, funcptr);
9235 #define JIM_REGISTER_API(name) \
9236 Jim_RegisterApi(interp, "Jim_" #name, (void *)Jim_ ## name)
9238 void JimRegisterCoreApi(Jim_Interp *interp)
9240 interp->getApiFuncPtr = Jim_GetApi;
9241 JIM_REGISTER_API(Alloc);
9242 JIM_REGISTER_API(Free);
9243 JIM_REGISTER_API(Eval);
9244 JIM_REGISTER_API(Eval_Named);
9245 JIM_REGISTER_API(EvalGlobal);
9246 JIM_REGISTER_API(EvalFile);
9247 JIM_REGISTER_API(EvalObj);
9248 JIM_REGISTER_API(EvalObjBackground);
9249 JIM_REGISTER_API(EvalObjVector);
9250 JIM_REGISTER_API(InitHashTable);
9251 JIM_REGISTER_API(ExpandHashTable);
9252 JIM_REGISTER_API(AddHashEntry);
9253 JIM_REGISTER_API(ReplaceHashEntry);
9254 JIM_REGISTER_API(DeleteHashEntry);
9255 JIM_REGISTER_API(FreeHashTable);
9256 JIM_REGISTER_API(FindHashEntry);
9257 JIM_REGISTER_API(ResizeHashTable);
9258 JIM_REGISTER_API(GetHashTableIterator);
9259 JIM_REGISTER_API(NextHashEntry);
9260 JIM_REGISTER_API(NewObj);
9261 JIM_REGISTER_API(FreeObj);
9262 JIM_REGISTER_API(InvalidateStringRep);
9263 JIM_REGISTER_API(InitStringRep);
9264 JIM_REGISTER_API(DuplicateObj);
9265 JIM_REGISTER_API(GetString);
9266 JIM_REGISTER_API(Length);
9267 JIM_REGISTER_API(InvalidateStringRep);
9268 JIM_REGISTER_API(NewStringObj);
9269 JIM_REGISTER_API(NewStringObjNoAlloc);
9270 JIM_REGISTER_API(AppendString);
9271 JIM_REGISTER_API(AppendString_sprintf);
9272 JIM_REGISTER_API(AppendObj);
9273 JIM_REGISTER_API(AppendStrings);
9274 JIM_REGISTER_API(StringEqObj);
9275 JIM_REGISTER_API(StringMatchObj);
9276 JIM_REGISTER_API(StringRangeObj);
9277 JIM_REGISTER_API(FormatString);
9278 JIM_REGISTER_API(CompareStringImmediate);
9279 JIM_REGISTER_API(NewReference);
9280 JIM_REGISTER_API(GetReference);
9281 JIM_REGISTER_API(SetFinalizer);
9282 JIM_REGISTER_API(GetFinalizer);
9283 JIM_REGISTER_API(CreateInterp);
9284 JIM_REGISTER_API(FreeInterp);
9285 JIM_REGISTER_API(GetExitCode);
9286 JIM_REGISTER_API(SetStdin);
9287 JIM_REGISTER_API(SetStdout);
9288 JIM_REGISTER_API(SetStderr);
9289 JIM_REGISTER_API(CreateCommand);
9290 JIM_REGISTER_API(CreateProcedure);
9291 JIM_REGISTER_API(DeleteCommand);
9292 JIM_REGISTER_API(RenameCommand);
9293 JIM_REGISTER_API(GetCommand);
9294 JIM_REGISTER_API(SetVariable);
9295 JIM_REGISTER_API(SetVariableStr);
9296 JIM_REGISTER_API(SetGlobalVariableStr);
9297 JIM_REGISTER_API(SetVariableStrWithStr);
9298 JIM_REGISTER_API(SetVariableLink);
9299 JIM_REGISTER_API(GetVariable);
9300 JIM_REGISTER_API(GetCallFrameByLevel);
9301 JIM_REGISTER_API(Collect);
9302 JIM_REGISTER_API(CollectIfNeeded);
9303 JIM_REGISTER_API(GetIndex);
9304 JIM_REGISTER_API(NewListObj);
9305 JIM_REGISTER_API(ListAppendElement);
9306 JIM_REGISTER_API(ListAppendList);
9307 JIM_REGISTER_API(ListLength);
9308 JIM_REGISTER_API(ListIndex);
9309 JIM_REGISTER_API(SetListIndex);
9310 JIM_REGISTER_API(ConcatObj);
9311 JIM_REGISTER_API(NewDictObj);
9312 JIM_REGISTER_API(DictKey);
9313 JIM_REGISTER_API(DictKeysVector);
9314 JIM_REGISTER_API(GetIndex);
9315 JIM_REGISTER_API(GetReturnCode);
9316 JIM_REGISTER_API(EvalExpression);
9317 JIM_REGISTER_API(GetBoolFromExpr);
9318 JIM_REGISTER_API(GetWide);
9319 JIM_REGISTER_API(GetLong);
9320 JIM_REGISTER_API(SetWide);
9321 JIM_REGISTER_API(NewIntObj);
9322 JIM_REGISTER_API(GetDouble);
9323 JIM_REGISTER_API(SetDouble);
9324 JIM_REGISTER_API(NewDoubleObj);
9325 JIM_REGISTER_API(WrongNumArgs);
9326 JIM_REGISTER_API(SetDictKeysVector);
9327 JIM_REGISTER_API(SubstObj);
9328 JIM_REGISTER_API(RegisterApi);
9329 JIM_REGISTER_API(PrintErrorMessage);
9330 JIM_REGISTER_API(InteractivePrompt);
9331 JIM_REGISTER_API(RegisterCoreCommands);
9332 JIM_REGISTER_API(GetSharedString);
9333 JIM_REGISTER_API(ReleaseSharedString);
9334 JIM_REGISTER_API(Panic);
9335 JIM_REGISTER_API(StrDup);
9336 JIM_REGISTER_API(UnsetVariable);
9337 JIM_REGISTER_API(GetVariableStr);
9338 JIM_REGISTER_API(GetGlobalVariable);
9339 JIM_REGISTER_API(GetGlobalVariableStr);
9340 JIM_REGISTER_API(GetAssocData);
9341 JIM_REGISTER_API(SetAssocData);
9342 JIM_REGISTER_API(DeleteAssocData);
9343 JIM_REGISTER_API(GetEnum);
9344 JIM_REGISTER_API(ScriptIsComplete);
9345 JIM_REGISTER_API(PackageRequire);
9346 JIM_REGISTER_API(PackageProvide);
9347 JIM_REGISTER_API(InitStack);
9348 JIM_REGISTER_API(FreeStack);
9349 JIM_REGISTER_API(StackLen);
9350 JIM_REGISTER_API(StackPush);
9351 JIM_REGISTER_API(StackPop);
9352 JIM_REGISTER_API(StackPeek);
9353 JIM_REGISTER_API(FreeStackElements);
9354 JIM_REGISTER_API(fprintf );
9355 JIM_REGISTER_API(vfprintf );
9356 JIM_REGISTER_API(fwrite );
9357 JIM_REGISTER_API(fread );
9358 JIM_REGISTER_API(fflush );
9359 JIM_REGISTER_API(fgets );
9360 JIM_REGISTER_API(GetNvp);
9361 JIM_REGISTER_API(Nvp_name2value);
9362 JIM_REGISTER_API(Nvp_name2value_simple);
9363 JIM_REGISTER_API(Nvp_name2value_obj);
9364 JIM_REGISTER_API(Nvp_name2value_nocase);
9365 JIM_REGISTER_API(Nvp_name2value_obj_nocase);
9367 JIM_REGISTER_API(Nvp_value2name);
9368 JIM_REGISTER_API(Nvp_value2name_simple);
9369 JIM_REGISTER_API(Nvp_value2name_obj);
9371 JIM_REGISTER_API(GetOpt_Setup);
9372 JIM_REGISTER_API(GetOpt_Debug);
9373 JIM_REGISTER_API(GetOpt_Obj);
9374 JIM_REGISTER_API(GetOpt_String);
9375 JIM_REGISTER_API(GetOpt_Double);
9376 JIM_REGISTER_API(GetOpt_Wide);
9377 JIM_REGISTER_API(GetOpt_Nvp);
9378 JIM_REGISTER_API(GetOpt_NvpUnknown);
9379 JIM_REGISTER_API(GetOpt_Enum);
9381 JIM_REGISTER_API(Debug_ArgvString);
9382 JIM_REGISTER_API(SetResult_sprintf);
9383 JIM_REGISTER_API(SetResult_NvpUnknown);
9387 /* -----------------------------------------------------------------------------
9388 * Core commands utility functions
9389 * ---------------------------------------------------------------------------*/
9390 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv,
9394 Jim_Obj *objPtr = Jim_NewEmptyStringObj(interp);
9396 Jim_AppendString(interp, objPtr, "wrong # args: should be \"", -1);
9397 for (i = 0; i < argc; i++) {
9398 Jim_AppendObj(interp, objPtr, argv[i]);
9399 if (!(i+1 == argc && msg[0] == '\0'))
9400 Jim_AppendString(interp, objPtr, " ", 1);
9402 Jim_AppendString(interp, objPtr, msg, -1);
9403 Jim_AppendString(interp, objPtr, "\"", 1);
9404 Jim_SetResult(interp, objPtr);
9407 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr)
9409 Jim_HashTableIterator *htiter;
9411 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9412 const char *pattern;
9415 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9416 htiter = Jim_GetHashTableIterator(&interp->commands);
9417 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9418 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9419 strlen((const char*)he->key), 0))
9421 Jim_ListAppendElement(interp, listObjPtr,
9422 Jim_NewStringObj(interp, he->key, -1));
9424 Jim_FreeHashTableIterator(htiter);
9428 #define JIM_VARLIST_GLOBALS 0
9429 #define JIM_VARLIST_LOCALS 1
9430 #define JIM_VARLIST_VARS 2
9432 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr,
9435 Jim_HashTableIterator *htiter;
9437 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
9438 const char *pattern;
9441 pattern = patternObjPtr ? Jim_GetString(patternObjPtr, &patternLen) : NULL;
9442 if (mode == JIM_VARLIST_GLOBALS) {
9443 htiter = Jim_GetHashTableIterator(&interp->topFramePtr->vars);
9445 /* For [info locals], if we are at top level an emtpy list
9446 * is returned. I don't agree, but we aim at compatibility (SS) */
9447 if (mode == JIM_VARLIST_LOCALS &&
9448 interp->framePtr == interp->topFramePtr)
9450 htiter = Jim_GetHashTableIterator(&interp->framePtr->vars);
9452 while ((he = Jim_NextHashEntry(htiter)) != NULL) {
9453 Jim_Var *varPtr = (Jim_Var*) he->val;
9454 if (mode == JIM_VARLIST_LOCALS) {
9455 if (varPtr->linkFramePtr != NULL)
9458 if (pattern && !JimStringMatch(pattern, patternLen, he->key,
9459 strlen((const char*)he->key), 0))
9461 Jim_ListAppendElement(interp, listObjPtr,
9462 Jim_NewStringObj(interp, he->key, -1));
9464 Jim_FreeHashTableIterator(htiter);
9468 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
9469 Jim_Obj **objPtrPtr)
9471 Jim_CallFrame *targetCallFrame;
9473 if (JimGetCallFrameByInteger(interp, levelObjPtr, &targetCallFrame)
9476 /* No proc call at toplevel callframe */
9477 if (targetCallFrame == interp->topFramePtr) {
9478 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
9479 Jim_AppendStrings(interp, Jim_GetResult(interp),
9481 Jim_GetString(levelObjPtr, NULL), "\"", NULL);
9484 *objPtrPtr = Jim_NewListObj(interp,
9485 targetCallFrame->argv,
9486 targetCallFrame->argc);
9490 /* -----------------------------------------------------------------------------
9492 * ---------------------------------------------------------------------------*/
9494 /* fake [puts] -- not the real puts, just for debugging. */
9495 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc,
9496 Jim_Obj *const *argv)
9499 int len, nonewline = 0;
9501 if (argc != 2 && argc != 3) {
9502 Jim_WrongNumArgs(interp, 1, argv, "-nonewline string");
9506 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline"))
9508 Jim_SetResultString(interp, "The second argument must "
9509 "be -nonewline", -1);
9516 str = Jim_GetString(argv[1], &len);
9517 Jim_fwrite(interp, str, 1, len, interp->cookie_stdout);
9518 if (!nonewline) Jim_fprintf( interp, interp->cookie_stdout, JIM_NL);
9522 /* Helper for [+] and [*] */
9523 static int Jim_AddMulHelper(Jim_Interp *interp, int argc,
9524 Jim_Obj *const *argv, int op)
9526 jim_wide wideValue, res;
9527 double doubleValue, doubleRes;
9530 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
9532 for (i = 1; i < argc; i++) {
9533 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
9535 if (op == JIM_EXPROP_ADD)
9540 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9543 doubleRes = (double) res;
9544 for (;i < argc; i++) {
9545 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9547 if (op == JIM_EXPROP_ADD)
9548 doubleRes += doubleValue;
9550 doubleRes *= doubleValue;
9552 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9556 /* Helper for [-] and [/] */
9557 static int Jim_SubDivHelper(Jim_Interp *interp, int argc,
9558 Jim_Obj *const *argv, int op)
9560 jim_wide wideValue, res = 0;
9561 double doubleValue, doubleRes = 0;
9565 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
9567 } else if (argc == 2) {
9568 /* The arity = 2 case is different. For [- x] returns -x,
9569 * while [/ x] returns 1/x. */
9570 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
9571 if (Jim_GetDouble(interp, argv[1], &doubleValue) !=
9576 if (op == JIM_EXPROP_SUB)
9577 doubleRes = -doubleValue;
9579 doubleRes = 1.0/doubleValue;
9580 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9585 if (op == JIM_EXPROP_SUB) {
9587 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9589 doubleRes = 1.0/wideValue;
9590 Jim_SetResult(interp, Jim_NewDoubleObj(interp,
9595 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
9596 if (Jim_GetDouble(interp, argv[1], &doubleRes)
9604 for (i = 2; i < argc; i++) {
9605 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
9606 doubleRes = (double) res;
9609 if (op == JIM_EXPROP_SUB)
9614 Jim_SetResult(interp, Jim_NewIntObj(interp, res));
9617 for (;i < argc; i++) {
9618 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
9620 if (op == JIM_EXPROP_SUB)
9621 doubleRes -= doubleValue;
9623 doubleRes /= doubleValue;
9625 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
9631 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc,
9632 Jim_Obj *const *argv)
9634 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
9638 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc,
9639 Jim_Obj *const *argv)
9641 return Jim_AddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
9645 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc,
9646 Jim_Obj *const *argv)
9648 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
9652 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc,
9653 Jim_Obj *const *argv)
9655 return Jim_SubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
9659 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc,
9660 Jim_Obj *const *argv)
9662 if (argc != 2 && argc != 3) {
9663 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
9668 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9671 Jim_SetResult(interp, objPtr);
9674 /* argc == 3 case. */
9675 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
9677 Jim_SetResult(interp, argv[2]);
9682 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc,
9683 Jim_Obj *const *argv)
9688 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
9691 for (i = 1; i < argc; i++) {
9692 if (Jim_UnsetVariable(interp, argv[i], JIM_ERRMSG) != JIM_OK)
9699 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc,
9700 Jim_Obj *const *argv)
9702 jim_wide wideValue, increment = 1;
9705 if (argc != 2 && argc != 3) {
9706 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
9710 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
9713 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
9714 if (!intObjPtr) return JIM_ERR;
9715 if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK)
9717 if (Jim_IsShared(intObjPtr)) {
9718 intObjPtr = Jim_NewIntObj(interp, wideValue+increment);
9719 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9720 Jim_FreeNewObj(interp, intObjPtr);
9724 Jim_SetWide(interp, intObjPtr, wideValue+increment);
9725 /* The following step is required in order to invalidate the
9726 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
9727 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
9731 Jim_SetResult(interp, intObjPtr);
9736 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc,
9737 Jim_Obj *const *argv)
9740 Jim_WrongNumArgs(interp, 1, argv, "condition body");
9743 /* Try to run a specialized version of while if the expression
9744 * is in one of the following forms:
9746 * $a < CONST, $a < $b
9747 * $a <= CONST, $a <= $b
9748 * $a > CONST, $a > $b
9749 * $a >= CONST, $a >= $b
9750 * $a != CONST, $a != $b
9751 * $a == CONST, $a == $b
9757 #ifdef JIM_OPTIMIZATION
9760 Jim_Obj *varAObjPtr = NULL, *varBObjPtr = NULL, *objPtr;
9761 int exprLen, retval;
9763 /* STEP 1 -- Check if there are the conditions to run the specialized
9764 * version of while */
9766 if ((expr = Jim_GetExpression(interp, argv[1])) == NULL) goto noopt;
9767 if (expr->len <= 0 || expr->len > 3) goto noopt;
9770 if (expr->opcode[0] != JIM_EXPROP_VARIABLE &&
9771 expr->opcode[0] != JIM_EXPROP_NUMBER)
9775 if (expr->opcode[1] != JIM_EXPROP_NOT ||
9776 expr->opcode[0] != JIM_EXPROP_VARIABLE)
9780 if (expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9781 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9782 expr->opcode[1] != JIM_EXPROP_VARIABLE))
9784 switch(expr->opcode[2]) {
9786 case JIM_EXPROP_LTE:
9788 case JIM_EXPROP_GTE:
9789 case JIM_EXPROP_NUMEQ:
9790 case JIM_EXPROP_NUMNE:
9799 "Unexpected default reached in Jim_WhileCoreCommand()");
9803 /* STEP 2 -- conditions meet. Initialization. Take different
9804 * branches for different expression lengths. */
9805 exprLen = expr->len;
9810 if (expr->opcode[0] == JIM_EXPROP_VARIABLE) {
9811 varAObjPtr = expr->obj[0];
9812 Jim_IncrRefCount(varAObjPtr);
9814 if (Jim_GetWide(interp, expr->obj[0], &wideValue) != JIM_OK)
9820 Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9821 Jim_GetWide(interp, objPtr, &wideValue) != JIM_OK)
9823 Jim_DecrRefCount(interp, varAObjPtr);
9827 if (!wideValue) break;
9828 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9832 Jim_DecrRefCount(interp, varAObjPtr);
9840 Jim_DecrRefCount(interp, varAObjPtr);
9846 Jim_DecrRefCount(interp, varAObjPtr);
9847 } else if (exprLen == 3) {
9848 jim_wide wideValueA, wideValueB, cmpRes = 0;
9849 int cmpType = expr->opcode[2];
9851 varAObjPtr = expr->obj[0];
9852 Jim_IncrRefCount(varAObjPtr);
9853 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
9854 varBObjPtr = expr->obj[1];
9855 Jim_IncrRefCount(varBObjPtr);
9857 if (Jim_GetWide(interp, expr->obj[1], &wideValueB) != JIM_OK)
9861 if (!(objPtr = Jim_GetVariable(interp, varAObjPtr, JIM_NONE)) ||
9862 Jim_GetWide(interp, objPtr, &wideValueA) != JIM_OK)
9864 Jim_DecrRefCount(interp, varAObjPtr);
9866 Jim_DecrRefCount(interp, varBObjPtr);
9871 Jim_GetVariable(interp, varBObjPtr, JIM_NONE)) ||
9872 Jim_GetWide(interp, objPtr, &wideValueB) != JIM_OK)
9874 Jim_DecrRefCount(interp, varAObjPtr);
9876 Jim_DecrRefCount(interp, varBObjPtr);
9882 cmpRes = wideValueA < wideValueB; break;
9883 case JIM_EXPROP_LTE:
9884 cmpRes = wideValueA <= wideValueB; break;
9886 cmpRes = wideValueA > wideValueB; break;
9887 case JIM_EXPROP_GTE:
9888 cmpRes = wideValueA >= wideValueB; break;
9889 case JIM_EXPROP_NUMEQ:
9890 cmpRes = wideValueA == wideValueB; break;
9891 case JIM_EXPROP_NUMNE:
9892 cmpRes = wideValueA != wideValueB; break;
9895 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9898 Jim_DecrRefCount(interp, varAObjPtr);
9900 Jim_DecrRefCount(interp, varBObjPtr);
9907 Jim_DecrRefCount(interp, varAObjPtr);
9909 Jim_DecrRefCount(interp, varBObjPtr);
9914 Jim_DecrRefCount(interp, varAObjPtr);
9916 Jim_DecrRefCount(interp, varBObjPtr);
9918 /* TODO: case for len == 2 */
9921 Jim_SetEmptyResult(interp);
9927 /* The general purpose implementation of while starts here */
9929 int boolean, retval;
9931 if ((retval = Jim_GetBoolFromExpr(interp, argv[1],
9932 &boolean)) != JIM_OK)
9934 if (!boolean) break;
9935 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
9949 Jim_SetEmptyResult(interp);
9954 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc,
9955 Jim_Obj *const *argv)
9960 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
9963 /* Check if the for is on the form:
9964 * for {set i CONST} {$i < CONST} {incr i}
9965 * for {set i CONST} {$i < $j} {incr i}
9966 * for {set i CONST} {$i <= CONST} {incr i}
9967 * for {set i CONST} {$i <= $j} {incr i}
9968 * XXX: NOTE: if variable traces are implemented, this optimization
9969 * need to be modified to check for the proc epoch at every variable
9971 #ifdef JIM_OPTIMIZATION
9973 ScriptObj *initScript, *incrScript;
9975 jim_wide start, stop, currentVal;
9976 unsigned jim_wide procEpoch = interp->procEpoch;
9977 Jim_Obj *varNamePtr, *stopVarNamePtr = NULL, *objPtr;
9979 struct Jim_Cmd *cmdPtr;
9981 /* Do it only if there aren't shared arguments */
9982 if (argv[1] == argv[2] || argv[2] == argv[3] || argv[1] == argv[3])
9984 initScript = Jim_GetScript(interp, argv[1]);
9985 expr = Jim_GetExpression(interp, argv[2]);
9986 incrScript = Jim_GetScript(interp, argv[3]);
9988 /* Ensure proper lengths to start */
9989 if (initScript->len != 6) goto evalstart;
9990 if (incrScript->len != 4) goto evalstart;
9991 if (expr->len != 3) goto evalstart;
9992 /* Ensure proper token types. */
9993 if (initScript->token[2].type != JIM_TT_ESC ||
9994 initScript->token[4].type != JIM_TT_ESC ||
9995 incrScript->token[2].type != JIM_TT_ESC ||
9996 expr->opcode[0] != JIM_EXPROP_VARIABLE ||
9997 (expr->opcode[1] != JIM_EXPROP_NUMBER &&
9998 expr->opcode[1] != JIM_EXPROP_VARIABLE) ||
9999 (expr->opcode[2] != JIM_EXPROP_LT &&
10000 expr->opcode[2] != JIM_EXPROP_LTE))
10002 cmpType = expr->opcode[2];
10003 /* Initialization command must be [set] */
10004 cmdPtr = Jim_GetCommand(interp, initScript->token[0].objPtr, JIM_NONE);
10005 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_SetCoreCommand)
10007 /* Update command must be incr */
10008 cmdPtr = Jim_GetCommand(interp, incrScript->token[0].objPtr, JIM_NONE);
10009 if (cmdPtr == NULL || cmdPtr->cmdProc != Jim_IncrCoreCommand)
10011 /* set, incr, expression must be about the same variable */
10012 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10013 incrScript->token[2].objPtr, 0))
10015 if (!Jim_StringEqObj(initScript->token[2].objPtr,
10018 /* Check that the initialization and comparison are valid integers */
10019 if (Jim_GetWide(interp, initScript->token[4].objPtr, &start) == JIM_ERR)
10021 if (expr->opcode[1] == JIM_EXPROP_NUMBER &&
10022 Jim_GetWide(interp, expr->obj[1], &stop) == JIM_ERR)
10027 /* Initialization */
10028 varNamePtr = expr->obj[0];
10029 if (expr->opcode[1] == JIM_EXPROP_VARIABLE) {
10030 stopVarNamePtr = expr->obj[1];
10031 Jim_IncrRefCount(stopVarNamePtr);
10033 Jim_IncrRefCount(varNamePtr);
10035 /* --- OPTIMIZED FOR --- */
10036 /* Start to loop */
10037 objPtr = Jim_NewIntObj(interp, start);
10038 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
10039 Jim_DecrRefCount(interp, varNamePtr);
10040 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10041 Jim_FreeNewObj(interp, objPtr);
10045 /* === Check condition === */
10047 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
10048 if (objPtr == NULL ||
10049 Jim_GetWide(interp, objPtr, ¤tVal) != JIM_OK)
10051 Jim_DecrRefCount(interp, varNamePtr);
10052 if (stopVarNamePtr) Jim_DecrRefCount(interp, stopVarNamePtr);
10055 /* Immediate or Variable? get the 'stop' value if the latter. */
10056 if (stopVarNamePtr) {
10057 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
10058 if (objPtr == NULL ||
10059 Jim_GetWide(interp, objPtr, &stop) != JIM_OK)
10061 Jim_DecrRefCount(interp, varNamePtr);
10062 Jim_DecrRefCount(interp, stopVarNamePtr);
10066 if (cmpType == JIM_EXPROP_LT) {
10067 if (currentVal >= stop) break;
10069 if (currentVal > stop) break;
10072 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10075 if (stopVarNamePtr)
10076 Jim_DecrRefCount(interp, stopVarNamePtr);
10077 Jim_DecrRefCount(interp, varNamePtr);
10080 /* nothing to do */
10083 if (stopVarNamePtr)
10084 Jim_DecrRefCount(interp, stopVarNamePtr);
10085 Jim_DecrRefCount(interp, varNamePtr);
10089 /* If there was a change in procedures/command continue
10090 * with the usual [for] command implementation */
10091 if (procEpoch != interp->procEpoch) {
10092 if (stopVarNamePtr)
10093 Jim_DecrRefCount(interp, stopVarNamePtr);
10094 Jim_DecrRefCount(interp, varNamePtr);
10098 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
10099 if (objPtr->refCount == 1 && objPtr->typePtr == &intObjType) {
10100 objPtr->internalRep.wideValue ++;
10101 Jim_InvalidateStringRep(objPtr);
10103 Jim_Obj *auxObjPtr;
10105 if (Jim_GetWide(interp, objPtr, ¤tVal) == JIM_ERR) {
10106 if (stopVarNamePtr)
10107 Jim_DecrRefCount(interp, stopVarNamePtr);
10108 Jim_DecrRefCount(interp, varNamePtr);
10111 auxObjPtr = Jim_NewIntObj(interp, currentVal+1);
10112 if (Jim_SetVariable(interp, varNamePtr, auxObjPtr) == JIM_ERR) {
10113 if (stopVarNamePtr)
10114 Jim_DecrRefCount(interp, stopVarNamePtr);
10115 Jim_DecrRefCount(interp, varNamePtr);
10116 Jim_FreeNewObj(interp, auxObjPtr);
10121 if (stopVarNamePtr)
10122 Jim_DecrRefCount(interp, stopVarNamePtr);
10123 Jim_DecrRefCount(interp, varNamePtr);
10124 Jim_SetEmptyResult(interp);
10130 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
10135 /* Test the condition */
10136 if ((retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean))
10139 if (!boolean) break;
10141 if ((retval = Jim_EvalObj(interp, argv[4])) != JIM_OK) {
10147 /* Nothing to do */
10155 if ((retval = Jim_EvalObj(interp, argv[3])) != JIM_OK) {
10169 Jim_SetEmptyResult(interp);
10173 /* foreach + lmap implementation. */
10174 static int JimForeachMapHelper(Jim_Interp *interp, int argc,
10175 Jim_Obj *const *argv, int doMap)
10177 int result = JIM_ERR, i, nbrOfLists, *listsIdx, *listsEnd;
10178 int nbrOfLoops = 0;
10179 Jim_Obj *emptyStr, *script, *mapRes = NULL;
10181 if (argc < 4 || argc % 2 != 0) {
10182 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
10186 mapRes = Jim_NewListObj(interp, NULL, 0);
10187 Jim_IncrRefCount(mapRes);
10189 emptyStr = Jim_NewEmptyStringObj(interp);
10190 Jim_IncrRefCount(emptyStr);
10191 script = argv[argc-1]; /* Last argument is a script */
10192 nbrOfLists = (argc - 1 - 1) / 2; /* argc - 'foreach' - script */
10193 listsIdx = (int*)Jim_Alloc(nbrOfLists * sizeof(int));
10194 listsEnd = (int*)Jim_Alloc(nbrOfLists*2 * sizeof(int));
10195 /* Initialize iterators and remember max nbr elements each list */
10196 memset(listsIdx, 0, nbrOfLists * sizeof(int));
10197 /* Remember lengths of all lists and calculate how much rounds to loop */
10198 for (i=0; i < nbrOfLists*2; i += 2) {
10201 Jim_ListLength(interp, argv[i+1], &listsEnd[i]);
10202 Jim_ListLength(interp, argv[i+2], &listsEnd[i+1]);
10203 if (listsEnd[i] == 0) {
10204 Jim_SetResultString(interp, "foreach varlist is empty", -1);
10207 cnt = div(listsEnd[i+1], listsEnd[i]);
10208 count = cnt.quot + (cnt.rem ? 1 : 0);
10209 if (count > nbrOfLoops)
10210 nbrOfLoops = count;
10212 for (; nbrOfLoops-- > 0; ) {
10213 for (i=0; i < nbrOfLists; ++i) {
10214 int varIdx = 0, var = i * 2;
10215 while (varIdx < listsEnd[var]) {
10216 Jim_Obj *varName, *ele;
10217 int lst = i * 2 + 1;
10218 if (Jim_ListIndex(interp, argv[var+1], varIdx, &varName, JIM_ERRMSG)
10221 if (listsIdx[i] < listsEnd[lst]) {
10222 if (Jim_ListIndex(interp, argv[lst+1], listsIdx[i], &ele, JIM_ERRMSG)
10225 if (Jim_SetVariable(interp, varName, ele) != JIM_OK) {
10226 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10229 ++listsIdx[i]; /* Remember next iterator of current list */
10230 } else if (Jim_SetVariable(interp, varName, emptyStr) != JIM_OK) {
10231 Jim_SetResultString(interp, "couldn't set loop variable: ", -1);
10234 ++varIdx; /* Next variable */
10237 switch (result = Jim_EvalObj(interp, script)) {
10240 Jim_ListAppendElement(interp, mapRes, interp->result);
10254 Jim_SetResult(interp, mapRes);
10256 Jim_SetEmptyResult(interp);
10259 Jim_DecrRefCount(interp, mapRes);
10260 Jim_DecrRefCount(interp, emptyStr);
10261 Jim_Free(listsIdx);
10262 Jim_Free(listsEnd);
10267 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc,
10268 Jim_Obj *const *argv)
10270 return JimForeachMapHelper(interp, argc, argv, 0);
10274 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc,
10275 Jim_Obj *const *argv)
10277 return JimForeachMapHelper(interp, argc, argv, 1);
10281 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc,
10282 Jim_Obj *const *argv)
10284 int boolean, retval, current = 1, falsebody = 0;
10287 /* Far not enough arguments given! */
10288 if (current >= argc) goto err;
10289 if ((retval = Jim_GetBoolFromExpr(interp,
10290 argv[current++], &boolean))
10293 /* There lacks something, isn't it? */
10294 if (current >= argc) goto err;
10295 if (Jim_CompareStringImmediate(interp, argv[current],
10296 "then")) current++;
10297 /* Tsk tsk, no then-clause? */
10298 if (current >= argc) goto err;
10300 return Jim_EvalObj(interp, argv[current]);
10301 /* Ok: no else-clause follows */
10302 if (++current >= argc) {
10303 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10306 falsebody = current++;
10307 if (Jim_CompareStringImmediate(interp, argv[falsebody],
10309 /* IIICKS - else-clause isn't last cmd? */
10310 if (current != argc-1) goto err;
10311 return Jim_EvalObj(interp, argv[current]);
10312 } else if (Jim_CompareStringImmediate(interp,
10313 argv[falsebody], "elseif"))
10314 /* Ok: elseif follows meaning all the stuff
10315 * again (how boring...) */
10317 /* OOPS - else-clause is not last cmd?*/
10318 else if (falsebody != argc-1)
10320 return Jim_EvalObj(interp, argv[falsebody]);
10325 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
10329 enum {SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD, SWITCH_UNKNOWN};
10332 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc,
10333 Jim_Obj *const *argv)
10335 int retcode = JIM_ERR, matchOpt = SWITCH_EXACT, opt=1, patCount, i;
10336 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
10337 Jim_Obj *script = 0;
10338 if (argc < 3) goto wrongnumargs;
10339 for (opt=1; opt < argc; ++opt) {
10340 const char *option = Jim_GetString(argv[opt], 0);
10341 if (*option != '-') break;
10342 else if (strncmp(option, "--", 2) == 0) { ++opt; break; }
10343 else if (strncmp(option, "-exact", 2) == 0) matchOpt = SWITCH_EXACT;
10344 else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB;
10345 else if (strncmp(option, "-regexp", 2) == 0) matchOpt = SWITCH_RE;
10346 else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD;
10347 if ((argc - opt) < 2) goto wrongnumargs;
10348 command = argv[++opt];
10350 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10351 Jim_AppendStrings(interp, Jim_GetResult(interp),
10352 "bad option \"", option, "\": must be -exact, -glob, "
10353 "-regexp, -command procname or --", 0);
10356 if ((argc - opt) < 2) goto wrongnumargs;
10358 strObj = argv[opt++];
10359 patCount = argc - opt;
10360 if (patCount == 1) {
10362 JimListGetElements(interp, argv[opt], &patCount, &vector);
10365 caseList = &argv[opt];
10366 if (patCount == 0 || patCount % 2 != 0) goto wrongnumargs;
10367 for (i=0; script == 0 && i < patCount; i += 2) {
10368 Jim_Obj *patObj = caseList[i];
10369 if (!Jim_CompareStringImmediate(interp, patObj, "default")
10370 || i < (patCount-2)) {
10371 switch (matchOpt) {
10373 if (Jim_StringEqObj(strObj, patObj, 0))
10374 script = caseList[i+1];
10377 if (Jim_StringMatchObj(patObj, strObj, 0))
10378 script = caseList[i+1];
10381 command = Jim_NewStringObj(interp, "regexp", -1);
10382 /* Fall thru intentionally */
10384 Jim_Obj *parms[] = {command, patObj, strObj};
10385 int rc = Jim_EvalObjVector(interp, 3, parms);
10387 /* After the execution of a command we need to
10388 * make sure to reconvert the object into a list
10389 * again. Only for the single-list style [switch]. */
10390 if (argc-opt == 1) {
10392 JimListGetElements(interp, argv[opt], &patCount,
10396 /* command is here already decref'd */
10397 if (rc != JIM_OK) {
10401 rc = Jim_GetLong(interp, Jim_GetResult(interp), &matching);
10402 if (rc != JIM_OK) {
10407 script = caseList[i+1];
10411 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10412 Jim_AppendStrings(interp, Jim_GetResult(interp),
10413 "internal error: no such option implemented", 0);
10417 script = caseList[i+1];
10420 for(; i < patCount && Jim_CompareStringImmediate(interp, script, "-");
10422 script = caseList[i+1];
10423 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
10424 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
10425 Jim_AppendStrings(interp, Jim_GetResult(interp),
10426 "no body specified for pattern \"",
10427 Jim_GetString(caseList[i-2], 0), "\"", 0);
10431 Jim_SetEmptyResult(interp);
10433 retcode = Jim_EvalObj(interp, script);
10436 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
10437 "pattern body ... ?default body? or "
10438 "{pattern body ?pattern body ...?}");
10444 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc,
10445 Jim_Obj *const *argv)
10447 Jim_Obj *listObjPtr;
10449 listObjPtr = Jim_NewListObj(interp, argv+1, argc-1);
10450 Jim_SetResult(interp, listObjPtr);
10455 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc,
10456 Jim_Obj *const *argv)
10458 Jim_Obj *objPtr, *listObjPtr;
10463 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
10467 Jim_IncrRefCount(objPtr);
10468 for (i = 2; i < argc; i++) {
10469 listObjPtr = objPtr;
10470 if (Jim_GetIndex(interp, argv[i], &index) != JIM_OK) {
10471 Jim_DecrRefCount(interp, listObjPtr);
10474 if (Jim_ListIndex(interp, listObjPtr, index, &objPtr,
10475 JIM_NONE) != JIM_OK) {
10476 /* Returns an empty object if the index
10477 * is out of range. */
10478 Jim_DecrRefCount(interp, listObjPtr);
10479 Jim_SetEmptyResult(interp);
10482 Jim_IncrRefCount(objPtr);
10483 Jim_DecrRefCount(interp, listObjPtr);
10485 Jim_SetResult(interp, objPtr);
10486 Jim_DecrRefCount(interp, objPtr);
10491 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc,
10492 Jim_Obj *const *argv)
10497 Jim_WrongNumArgs(interp, 1, argv, "list");
10500 Jim_ListLength(interp, argv[1], &len);
10501 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
10506 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc,
10507 Jim_Obj *const *argv)
10509 Jim_Obj *listObjPtr;
10513 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10516 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10518 /* Create the list if it does not exists */
10519 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10520 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10521 Jim_FreeNewObj(interp, listObjPtr);
10525 shared = Jim_IsShared(listObjPtr);
10527 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
10528 for (i = 2; i < argc; i++)
10529 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
10530 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
10532 Jim_FreeNewObj(interp, listObjPtr);
10535 Jim_SetResult(interp, listObjPtr);
10540 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc,
10541 Jim_Obj *const *argv)
10547 Jim_WrongNumArgs(interp, 1, argv, "list index element "
10552 if (Jim_IsShared(listPtr))
10553 listPtr = Jim_DuplicateObj(interp, listPtr);
10554 if (Jim_GetIndex(interp, argv[2], &index) != JIM_OK)
10556 Jim_ListLength(interp, listPtr, &len);
10559 else if (index < 0)
10560 index = len + index + 1;
10561 Jim_ListInsertElements(interp, listPtr, index, argc-3, &argv[3]);
10562 Jim_SetResult(interp, listPtr);
10565 if (listPtr != argv[1]) {
10566 Jim_FreeNewObj(interp, listPtr);
10572 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc,
10573 Jim_Obj *const *argv)
10576 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
10578 } else if (argc == 3) {
10579 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
10581 Jim_SetResult(interp, argv[2]);
10584 if (Jim_SetListIndex(interp, argv[1], argv+2, argc-3, argv[argc-1])
10585 == JIM_ERR) return JIM_ERR;
10590 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
10592 const char *options[] = {
10593 "-ascii", "-nocase", "-increasing", "-decreasing", NULL
10595 enum {OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING};
10597 int i, lsortType = JIM_LSORT_ASCII; /* default sort type */
10598 int decreasing = 0;
10601 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
10604 for (i = 1; i < (argc-1); i++) {
10607 if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG)
10611 case OPT_ASCII: lsortType = JIM_LSORT_ASCII; break;
10612 case OPT_NOCASE: lsortType = JIM_LSORT_NOCASE; break;
10613 case OPT_INCREASING: decreasing = 0; break;
10614 case OPT_DECREASING: decreasing = 1; break;
10618 switch(lsortType) {
10619 case JIM_LSORT_ASCII: lsortType = JIM_LSORT_ASCII_DECR; break;
10620 case JIM_LSORT_NOCASE: lsortType = JIM_LSORT_NOCASE_DECR; break;
10623 resObj = Jim_DuplicateObj(interp, argv[argc-1]);
10624 ListSortElements(interp, resObj, lsortType);
10625 Jim_SetResult(interp, resObj);
10630 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc,
10631 Jim_Obj *const *argv)
10633 Jim_Obj *stringObjPtr;
10637 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
10641 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
10642 if (!stringObjPtr) return JIM_ERR;
10644 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_NONE);
10645 if (!stringObjPtr) {
10646 /* Create the string if it does not exists */
10647 stringObjPtr = Jim_NewEmptyStringObj(interp);
10648 if (Jim_SetVariable(interp, argv[1], stringObjPtr)
10650 Jim_FreeNewObj(interp, stringObjPtr);
10655 shared = Jim_IsShared(stringObjPtr);
10657 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
10658 for (i = 2; i < argc; i++)
10659 Jim_AppendObj(interp, stringObjPtr, argv[i]);
10660 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
10662 Jim_FreeNewObj(interp, stringObjPtr);
10665 Jim_SetResult(interp, stringObjPtr);
10670 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc,
10671 Jim_Obj *const *argv)
10673 const char *options[] = {
10674 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
10679 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
10680 OPT_EXPRLEN, OPT_EXPRBC
10685 Jim_WrongNumArgs(interp, 1, argv, "option ?...?");
10688 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
10689 JIM_ERRMSG) != JIM_OK)
10691 if (option == OPT_REFCOUNT) {
10693 Jim_WrongNumArgs(interp, 2, argv, "object");
10696 Jim_SetResult(interp, Jim_NewIntObj(interp, argv[2]->refCount));
10698 } else if (option == OPT_OBJCOUNT) {
10699 int freeobj = 0, liveobj = 0;
10704 Jim_WrongNumArgs(interp, 2, argv, "");
10707 /* Count the number of free objects. */
10708 objPtr = interp->freeList;
10711 objPtr = objPtr->nextObjPtr;
10713 /* Count the number of live objects. */
10714 objPtr = interp->liveList;
10717 objPtr = objPtr->nextObjPtr;
10719 /* Set the result string and return. */
10720 sprintf(buf, "free %d used %d", freeobj, liveobj);
10721 Jim_SetResultString(interp, buf, -1);
10723 } else if (option == OPT_OBJECTS) {
10724 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
10725 /* Count the number of live objects. */
10726 objPtr = interp->liveList;
10727 listObjPtr = Jim_NewListObj(interp, NULL, 0);
10730 const char *type = objPtr->typePtr ?
10731 objPtr->typePtr->name : "";
10732 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
10733 sprintf(buf, "%p", objPtr);
10734 Jim_ListAppendElement(interp, subListObjPtr,
10735 Jim_NewStringObj(interp, buf, -1));
10736 Jim_ListAppendElement(interp, subListObjPtr,
10737 Jim_NewStringObj(interp, type, -1));
10738 Jim_ListAppendElement(interp, subListObjPtr,
10739 Jim_NewIntObj(interp, objPtr->refCount));
10740 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
10741 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
10742 objPtr = objPtr->nextObjPtr;
10744 Jim_SetResult(interp, listObjPtr);
10746 } else if (option == OPT_INVSTR) {
10750 Jim_WrongNumArgs(interp, 2, argv, "object");
10754 if (objPtr->typePtr != NULL)
10755 Jim_InvalidateStringRep(objPtr);
10756 Jim_SetEmptyResult(interp);
10758 } else if (option == OPT_SCRIPTLEN) {
10761 Jim_WrongNumArgs(interp, 2, argv, "script");
10764 script = Jim_GetScript(interp, argv[2]);
10765 Jim_SetResult(interp, Jim_NewIntObj(interp, script->len));
10767 } else if (option == OPT_EXPRLEN) {
10768 ExprByteCode *expr;
10770 Jim_WrongNumArgs(interp, 2, argv, "expression");
10773 expr = Jim_GetExpression(interp, argv[2]);
10776 Jim_SetResult(interp, Jim_NewIntObj(interp, expr->len));
10778 } else if (option == OPT_EXPRBC) {
10780 ExprByteCode *expr;
10784 Jim_WrongNumArgs(interp, 2, argv, "expression");
10787 expr = Jim_GetExpression(interp, argv[2]);
10790 objPtr = Jim_NewListObj(interp, NULL, 0);
10791 for (i = 0; i < expr->len; i++) {
10793 Jim_ExprOperator *op;
10795 switch(expr->opcode[i]) {
10796 case JIM_EXPROP_NUMBER: type = "number"; break;
10797 case JIM_EXPROP_COMMAND: type = "command"; break;
10798 case JIM_EXPROP_VARIABLE: type = "variable"; break;
10799 case JIM_EXPROP_DICTSUGAR: type = "dictsugar"; break;
10800 case JIM_EXPROP_SUBST: type = "subst"; break;
10801 case JIM_EXPROP_STRING: type = "string"; break;
10803 op = JimExprOperatorInfo(Jim_GetString(expr->obj[i], NULL));
10811 Jim_ListAppendElement(interp, objPtr,
10812 Jim_NewStringObj(interp, type, -1));
10813 Jim_ListAppendElement(interp, objPtr, expr->obj[i]);
10815 Jim_SetResult(interp, objPtr);
10818 Jim_SetResultString(interp,
10819 "bad option. Valid options are refcount, "
10820 "objcount, objects, invstr", -1);
10823 return JIM_OK; /* unreached */
10827 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc,
10828 Jim_Obj *const *argv)
10831 return Jim_EvalObj(interp, argv[1]);
10832 } else if (argc > 2) {
10836 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10837 Jim_IncrRefCount(objPtr);
10838 retcode = Jim_EvalObj(interp, objPtr);
10839 Jim_DecrRefCount(interp, objPtr);
10842 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
10848 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc,
10849 Jim_Obj *const *argv)
10852 int retcode, newLevel, oldLevel;
10853 Jim_CallFrame *savedCallFrame, *targetCallFrame;
10857 /* Save the old callframe pointer */
10858 savedCallFrame = interp->framePtr;
10860 /* Lookup the target frame pointer */
10861 str = Jim_GetString(argv[1], NULL);
10862 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#')
10864 if (Jim_GetCallFrameByLevel(interp, argv[1],
10866 &newLevel) != JIM_OK)
10871 if (Jim_GetCallFrameByLevel(interp, NULL,
10873 &newLevel) != JIM_OK)
10879 Jim_WrongNumArgs(interp, 1, argv,
10880 "?level? command ?arg ...?");
10883 /* Eval the code in the target callframe. */
10884 interp->framePtr = targetCallFrame;
10885 oldLevel = interp->numLevels;
10886 interp->numLevels = newLevel;
10888 retcode = Jim_EvalObj(interp, argv[1]);
10890 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10891 Jim_IncrRefCount(objPtr);
10892 retcode = Jim_EvalObj(interp, objPtr);
10893 Jim_DecrRefCount(interp, objPtr);
10895 interp->numLevels = oldLevel;
10896 interp->framePtr = savedCallFrame;
10899 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
10905 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc,
10906 Jim_Obj *const *argv)
10908 Jim_Obj *exprResultPtr;
10912 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
10913 } else if (argc > 2) {
10916 objPtr = Jim_ConcatObj(interp, argc-1, argv+1);
10917 Jim_IncrRefCount(objPtr);
10918 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
10919 Jim_DecrRefCount(interp, objPtr);
10921 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
10924 if (retcode != JIM_OK) return retcode;
10925 Jim_SetResult(interp, exprResultPtr);
10926 Jim_DecrRefCount(interp, exprResultPtr);
10931 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc,
10932 Jim_Obj *const *argv)
10935 Jim_WrongNumArgs(interp, 1, argv, "");
10942 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc,
10943 Jim_Obj *const *argv)
10946 Jim_WrongNumArgs(interp, 1, argv, "");
10949 return JIM_CONTINUE;
10953 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc,
10954 Jim_Obj *const *argv)
10958 } else if (argc == 2) {
10959 Jim_SetResult(interp, argv[1]);
10960 interp->returnCode = JIM_OK;
10962 } else if (argc == 3 || argc == 4) {
10964 if (Jim_GetReturnCode(interp, argv[2], &returnCode) == JIM_ERR)
10966 interp->returnCode = returnCode;
10968 Jim_SetResult(interp, argv[3]);
10971 Jim_WrongNumArgs(interp, 1, argv, "?-code code? ?result?");
10974 return JIM_RETURN; /* unreached */
10978 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc,
10979 Jim_Obj *const *argv)
10983 objPtr = Jim_NewListObj(interp, argv+1, argc-1);
10984 Jim_SetResult(interp, objPtr);
10989 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc,
10990 Jim_Obj *const *argv)
10993 int arityMin, arityMax;
10995 if (argc != 4 && argc != 5) {
10996 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
10999 Jim_ListLength(interp, argv[2], &argListLen);
11000 arityMin = arityMax = argListLen+1;
11007 /* Check for 'args' and adjust arityMin and arityMax if necessary */
11008 Jim_ListIndex(interp, argv[2], argListLen-1, &argPtr, JIM_NONE);
11009 str = Jim_GetString(argPtr, &len);
11010 if (len == 4 && memcmp(str, "args", 4) == 0) {
11015 /* Check for default arguments and reduce arityMin if necessary */
11016 while (arityMin > 1) {
11018 Jim_ListIndex(interp, argv[2], arityMin - 2, &argPtr, JIM_NONE);
11019 Jim_ListLength(interp, argPtr, &len);
11021 /* No default argument */
11028 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11029 argv[2], NULL, argv[3], arityMin, arityMax);
11031 return Jim_CreateProcedure(interp, Jim_GetString(argv[1], NULL),
11032 argv[2], argv[3], argv[4], arityMin, arityMax);
11037 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc,
11038 Jim_Obj *const *argv)
11040 Jim_SetResult(interp, Jim_ConcatObj(interp, argc-1, argv+1));
11045 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc,
11046 Jim_Obj *const *argv)
11050 Jim_CallFrame *targetCallFrame;
11052 /* Lookup the target frame pointer */
11053 str = Jim_GetString(argv[1], NULL);
11055 ((str[0] >= '0' && str[0] <= '9') || str[0] == '#'))
11057 if (Jim_GetCallFrameByLevel(interp, argv[1],
11058 &targetCallFrame, NULL) != JIM_OK)
11063 if (Jim_GetCallFrameByLevel(interp, NULL,
11064 &targetCallFrame, NULL) != JIM_OK)
11067 /* Check for arity */
11068 if (argc < 3 || ((argc-1)%2) != 0) {
11069 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
11072 /* Now... for every other/local couple: */
11073 for (i = 1; i < argc; i += 2) {
11074 if (Jim_SetVariableLink(interp, argv[i+1], argv[i],
11075 targetCallFrame) != JIM_OK) return JIM_ERR;
11081 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc,
11082 Jim_Obj *const *argv)
11087 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
11090 /* Link every var to the toplevel having the same name */
11091 if (interp->numLevels == 0) return JIM_OK; /* global at toplevel... */
11092 for (i = 1; i < argc; i++) {
11093 if (Jim_SetVariableLink(interp, argv[i], argv[i],
11094 interp->topFramePtr) != JIM_OK) return JIM_ERR;
11099 /* does the [string map] operation. On error NULL is returned,
11100 * otherwise a new string object with the result, having refcount = 0,
11102 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
11103 Jim_Obj *objPtr, int nocase)
11106 const char **key, *str, *noMatchStart = NULL;
11108 int *keyLen, strLen, i;
11109 Jim_Obj *resultObjPtr;
11111 Jim_ListLength(interp, mapListObjPtr, &numMaps);
11113 Jim_SetResultString(interp,
11114 "list must contain an even number of elements", -1);
11117 /* Initialization */
11119 key = Jim_Alloc(sizeof(char*)*numMaps);
11120 keyLen = Jim_Alloc(sizeof(int)*numMaps);
11121 value = Jim_Alloc(sizeof(Jim_Obj*)*numMaps);
11122 resultObjPtr = Jim_NewStringObj(interp, "", 0);
11123 for (i = 0; i < numMaps; i++) {
11124 Jim_Obj *eleObjPtr;
11126 Jim_ListIndex(interp, mapListObjPtr, i*2, &eleObjPtr, JIM_NONE);
11127 key[i] = Jim_GetString(eleObjPtr, &keyLen[i]);
11128 Jim_ListIndex(interp, mapListObjPtr, i*2+1, &eleObjPtr, JIM_NONE);
11129 value[i] = eleObjPtr;
11131 str = Jim_GetString(objPtr, &strLen);
11134 for (i = 0; i < numMaps; i++) {
11135 if (strLen >= keyLen[i] && keyLen[i]) {
11136 if (!JimStringCompare(str, keyLen[i], key[i], keyLen[i],
11139 if (noMatchStart) {
11140 Jim_AppendString(interp, resultObjPtr,
11141 noMatchStart, str-noMatchStart);
11142 noMatchStart = NULL;
11144 Jim_AppendObj(interp, resultObjPtr, value[i]);
11146 strLen -= keyLen[i];
11151 if (i == numMaps) { /* no match */
11152 if (noMatchStart == NULL)
11153 noMatchStart = str;
11158 if (noMatchStart) {
11159 Jim_AppendString(interp, resultObjPtr,
11160 noMatchStart, str-noMatchStart);
11162 Jim_Free((void*)key);
11165 return resultObjPtr;
11169 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc,
11170 Jim_Obj *const *argv)
11173 const char *options[] = {
11174 "length", "compare", "match", "equal", "range", "map", "repeat",
11175 "index", "first", "tolower", "toupper", NULL
11178 OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_RANGE,
11179 OPT_MAP, OPT_REPEAT, OPT_INDEX, OPT_FIRST, OPT_TOLOWER, OPT_TOUPPER
11183 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11186 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11187 JIM_ERRMSG) != JIM_OK)
11190 if (option == OPT_LENGTH) {
11194 Jim_WrongNumArgs(interp, 2, argv, "string");
11197 Jim_GetString(argv[2], &len);
11198 Jim_SetResult(interp, Jim_NewIntObj(interp, len));
11200 } else if (option == OPT_COMPARE) {
11202 if ((argc != 4 && argc != 5) ||
11203 (argc == 5 && Jim_CompareStringImmediate(interp,
11204 argv[2], "-nocase") == 0)) {
11205 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11212 Jim_SetResult(interp, Jim_NewIntObj(interp,
11213 Jim_StringCompareObj(argv[2],
11214 argv[3], nocase)));
11216 } else if (option == OPT_MATCH) {
11218 if ((argc != 4 && argc != 5) ||
11219 (argc == 5 && Jim_CompareStringImmediate(interp,
11220 argv[2], "-nocase") == 0)) {
11221 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern "
11229 Jim_SetResult(interp,
11230 Jim_NewIntObj(interp, Jim_StringMatchObj(argv[2],
11231 argv[3], nocase)));
11233 } else if (option == OPT_EQUAL) {
11235 Jim_WrongNumArgs(interp, 2, argv, "string1 string2");
11238 Jim_SetResult(interp,
11239 Jim_NewIntObj(interp, Jim_StringEqObj(argv[2],
11242 } else if (option == OPT_RANGE) {
11246 Jim_WrongNumArgs(interp, 2, argv, "string first last");
11249 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
11250 if (objPtr == NULL)
11252 Jim_SetResult(interp, objPtr);
11254 } else if (option == OPT_MAP) {
11258 if ((argc != 4 && argc != 5) ||
11259 (argc == 5 && Jim_CompareStringImmediate(interp,
11260 argv[2], "-nocase") == 0)) {
11261 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList "
11269 objPtr = JimStringMap(interp, argv[2], argv[3], nocase);
11270 if (objPtr == NULL)
11272 Jim_SetResult(interp, objPtr);
11274 } else if (option == OPT_REPEAT) {
11279 Jim_WrongNumArgs(interp, 2, argv, "string count");
11282 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK)
11284 objPtr = Jim_NewStringObj(interp, "", 0);
11286 Jim_AppendObj(interp, objPtr, argv[2]);
11288 Jim_SetResult(interp, objPtr);
11290 } else if (option == OPT_INDEX) {
11295 Jim_WrongNumArgs(interp, 2, argv, "string index");
11298 if (Jim_GetIndex(interp, argv[3], &index) != JIM_OK)
11300 str = Jim_GetString(argv[2], &len);
11301 if (index != INT_MIN && index != INT_MAX)
11302 index = JimRelToAbsIndex(len, index);
11303 if (index < 0 || index >= len) {
11304 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11307 Jim_SetResult(interp, Jim_NewStringObj(interp, str+index, 1));
11310 } else if (option == OPT_FIRST) {
11311 int index = 0, l1, l2;
11312 const char *s1, *s2;
11314 if (argc != 4 && argc != 5) {
11315 Jim_WrongNumArgs(interp, 2, argv, "subString string ?startIndex?");
11318 s1 = Jim_GetString(argv[2], &l1);
11319 s2 = Jim_GetString(argv[3], &l2);
11321 if (Jim_GetIndex(interp, argv[4], &index) != JIM_OK)
11323 index = JimRelToAbsIndex(l2, index);
11325 Jim_SetResult(interp, Jim_NewIntObj(interp,
11326 JimStringFirst(s1, l1, s2, l2, index)));
11328 } else if (option == OPT_TOLOWER) {
11330 Jim_WrongNumArgs(interp, 2, argv, "string");
11333 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
11334 } else if (option == OPT_TOUPPER) {
11336 Jim_WrongNumArgs(interp, 2, argv, "string");
11339 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
11345 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc,
11346 Jim_Obj *const *argv)
11349 jim_wide start, elapsed;
11351 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
11354 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
11358 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
11364 start = JimClock();
11368 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK)
11371 elapsed = JimClock() - start;
11372 sprintf(buf, fmt, elapsed/count);
11373 Jim_SetResultString(interp, buf, -1);
11378 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc,
11379 Jim_Obj *const *argv)
11384 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
11388 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
11391 interp->exitCode = exitCode;
11396 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc,
11397 Jim_Obj *const *argv)
11401 if (argc != 2 && argc != 3) {
11402 Jim_WrongNumArgs(interp, 1, argv, "script ?varName?");
11405 exitCode = Jim_EvalObj(interp, argv[1]);
11407 if (Jim_SetVariable(interp, argv[2], Jim_GetResult(interp))
11411 Jim_SetResult(interp, Jim_NewIntObj(interp, exitCode));
11416 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc,
11417 Jim_Obj *const *argv)
11419 if (argc != 3 && argc != 4) {
11420 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
11424 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
11426 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2],
11433 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc,
11434 Jim_Obj *const *argv)
11436 Jim_Reference *refPtr;
11439 Jim_WrongNumArgs(interp, 1, argv, "reference");
11442 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11444 Jim_SetResult(interp, refPtr->objPtr);
11449 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc,
11450 Jim_Obj *const *argv)
11452 Jim_Reference *refPtr;
11455 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
11458 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
11460 Jim_IncrRefCount(argv[2]);
11461 Jim_DecrRefCount(interp, refPtr->objPtr);
11462 refPtr->objPtr = argv[2];
11463 Jim_SetResult(interp, argv[2]);
11468 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc,
11469 Jim_Obj *const *argv)
11472 Jim_WrongNumArgs(interp, 1, argv, "");
11475 Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Collect(interp)));
11479 /* [finalize] reference ?newValue? */
11480 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc,
11481 Jim_Obj *const *argv)
11483 if (argc != 2 && argc != 3) {
11484 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
11488 Jim_Obj *cmdNamePtr;
11490 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
11492 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
11493 Jim_SetResult(interp, cmdNamePtr);
11495 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
11497 Jim_SetResult(interp, argv[2]);
11503 /* [info references] (list of all the references/finalizers) */
11506 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc,
11507 Jim_Obj *const *argv)
11509 const char *oldName, *newName;
11512 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
11515 oldName = Jim_GetString(argv[1], NULL);
11516 newName = Jim_GetString(argv[2], NULL);
11517 if (Jim_RenameCommand(interp, oldName, newName) != JIM_OK) {
11518 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11519 Jim_AppendStrings(interp, Jim_GetResult(interp),
11520 "can't rename \"", oldName, "\": ",
11521 "command doesn't exist", NULL);
11528 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc,
11529 Jim_Obj *const *argv)
11532 const char *options[] = {
11533 "create", "get", "set", "unset", "exists", NULL
11536 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXIST
11540 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
11544 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
11545 JIM_ERRMSG) != JIM_OK)
11548 if (option == OPT_CREATE) {
11552 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
11555 objPtr = Jim_NewDictObj(interp, argv+2, argc-2);
11556 Jim_SetResult(interp, objPtr);
11558 } else if (option == OPT_GET) {
11561 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11562 JIM_ERRMSG) != JIM_OK)
11564 Jim_SetResult(interp, objPtr);
11566 } else if (option == OPT_SET) {
11568 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
11571 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-4,
11573 } else if (option == OPT_UNSET) {
11575 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
11578 return Jim_SetDictKeysVector(interp, argv[2], argv+3, argc-3,
11580 } else if (option == OPT_EXIST) {
11584 if (Jim_DictKeysVector(interp, argv[2], argv+3, argc-3, &objPtr,
11585 JIM_ERRMSG) == JIM_OK)
11589 Jim_SetResult(interp, Jim_NewIntObj(interp, exists));
11592 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11593 Jim_AppendStrings(interp, Jim_GetResult(interp),
11594 "bad option \"", Jim_GetString(argv[1], NULL), "\":",
11595 " must be create, get, set", NULL);
11602 static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc,
11603 Jim_Obj *const *argv)
11606 Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
11609 return Jim_LoadLibrary(interp, Jim_GetString(argv[1], NULL));
11613 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc,
11614 Jim_Obj *const *argv)
11620 Jim_WrongNumArgs(interp, 1, argv,
11621 "?-nobackslashes? ?-nocommands? ?-novariables? string");
11626 if (Jim_CompareStringImmediate(interp, argv[i+1],
11628 flags |= JIM_SUBST_NOESC;
11629 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11631 flags |= JIM_SUBST_NOVAR;
11632 else if (Jim_CompareStringImmediate(interp, argv[i+1],
11634 flags |= JIM_SUBST_NOCMD;
11636 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11637 Jim_AppendStrings(interp, Jim_GetResult(interp),
11638 "bad option \"", Jim_GetString(argv[i+1], NULL),
11639 "\": must be -nobackslashes, -nocommands, or "
11640 "-novariables", NULL);
11644 if (Jim_SubstObj(interp, argv[argc-1], &objPtr, flags) != JIM_OK)
11646 Jim_SetResult(interp, objPtr);
11651 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
11652 Jim_Obj *const *argv)
11654 int cmd, result = JIM_OK;
11655 static const char *commands[] = {
11656 "body", "commands", "exists", "globals", "level", "locals",
11657 "vars", "version", "complete", "args", "hostname", NULL
11659 enum {INFO_BODY, INFO_COMMANDS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
11660 INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_COMPLETE, INFO_ARGS, INFO_HOSTNAME};
11663 Jim_WrongNumArgs(interp, 1, argv, "command ?args ...?");
11666 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "command", JIM_ERRMSG)
11671 if (cmd == INFO_COMMANDS) {
11672 if (argc != 2 && argc != 3) {
11673 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11677 Jim_SetResult(interp,JimCommandsList(interp, argv[2]));
11679 Jim_SetResult(interp, JimCommandsList(interp, NULL));
11680 } else if (cmd == INFO_EXISTS) {
11683 Jim_WrongNumArgs(interp, 2, argv, "varName");
11686 exists = Jim_GetVariable(interp, argv[2], 0);
11687 Jim_SetResult(interp, Jim_NewIntObj(interp, exists != 0));
11688 } else if (cmd == INFO_GLOBALS || cmd == INFO_LOCALS || cmd == INFO_VARS) {
11691 case INFO_GLOBALS: mode = JIM_VARLIST_GLOBALS; break;
11692 case INFO_LOCALS: mode = JIM_VARLIST_LOCALS; break;
11693 case INFO_VARS: mode = JIM_VARLIST_VARS; break;
11694 default: mode = 0; /* avoid warning */; break;
11696 if (argc != 2 && argc != 3) {
11697 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
11701 Jim_SetResult(interp,JimVariablesList(interp, argv[2], mode));
11703 Jim_SetResult(interp, JimVariablesList(interp, NULL, mode));
11704 } else if (cmd == INFO_LEVEL) {
11708 Jim_SetResult(interp,
11709 Jim_NewIntObj(interp, interp->numLevels));
11712 if (JimInfoLevel(interp, argv[2], &objPtr) != JIM_OK)
11714 Jim_SetResult(interp, objPtr);
11717 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
11720 } else if (cmd == INFO_BODY || cmd == INFO_ARGS) {
11724 Jim_WrongNumArgs(interp, 2, argv, "procname");
11727 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL)
11729 if (cmdPtr->cmdProc != NULL) {
11730 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11731 Jim_AppendStrings(interp, Jim_GetResult(interp),
11732 "command \"", Jim_GetString(argv[2], NULL),
11733 "\" is not a procedure", NULL);
11736 if (cmd == INFO_BODY)
11737 Jim_SetResult(interp, cmdPtr->bodyObjPtr);
11739 Jim_SetResult(interp, cmdPtr->argListObjPtr);
11740 } else if (cmd == INFO_VERSION) {
11741 char buf[(JIM_INTEGER_SPACE * 2) + 1];
11742 sprintf(buf, "%d.%d",
11743 JIM_VERSION / 100, JIM_VERSION % 100);
11744 Jim_SetResultString(interp, buf, -1);
11745 } else if (cmd == INFO_COMPLETE) {
11750 Jim_WrongNumArgs(interp, 2, argv, "script");
11753 s = Jim_GetString(argv[2], &len);
11754 Jim_SetResult(interp,
11755 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
11756 } else if (cmd == INFO_HOSTNAME) {
11757 /* Redirect to os.hostname if it exists */
11758 Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
11759 result = Jim_EvalObjVector(interp, 1, &command);
11765 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc,
11766 Jim_Obj *const *argv)
11768 const char *str, *splitChars, *noMatchStart;
11769 int splitLen, strLen, i;
11770 Jim_Obj *resObjPtr;
11772 if (argc != 2 && argc != 3) {
11773 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
11778 splitChars = " \n\t\r";
11781 splitChars = Jim_GetString(argv[2], &splitLen);
11783 str = Jim_GetString(argv[1], &strLen);
11784 if (!strLen) return JIM_OK;
11785 noMatchStart = str;
11786 resObjPtr = Jim_NewListObj(interp, NULL, 0);
11790 for (i = 0; i < splitLen; i++) {
11791 if (*str == splitChars[i]) {
11794 objPtr = Jim_NewStringObj(interp, noMatchStart,
11795 (str-noMatchStart));
11796 Jim_ListAppendElement(interp, resObjPtr, objPtr);
11797 noMatchStart = str+1;
11804 Jim_ListAppendElement(interp, resObjPtr,
11805 Jim_NewStringObj(interp, noMatchStart, (str-noMatchStart)));
11807 /* This handles the special case of splitchars eq {}. This
11808 * is trivial but we want to perform object sharing as Tcl does. */
11809 Jim_Obj *objCache[256];
11810 const unsigned char *u = (unsigned char*) str;
11811 memset(objCache, 0, sizeof(objCache));
11812 for (i = 0; i < strLen; i++) {
11815 if (objCache[c] == NULL)
11816 objCache[c] = Jim_NewStringObj(interp, (char*)u+i, 1);
11817 Jim_ListAppendElement(interp, resObjPtr, objCache[c]);
11820 Jim_SetResult(interp, resObjPtr);
11825 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc,
11826 Jim_Obj *const *argv)
11828 const char *joinStr;
11829 int joinStrLen, i, listLen;
11830 Jim_Obj *resObjPtr;
11832 if (argc != 2 && argc != 3) {
11833 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
11841 joinStr = Jim_GetString(argv[2], &joinStrLen);
11843 Jim_ListLength(interp, argv[1], &listLen);
11844 resObjPtr = Jim_NewStringObj(interp, NULL, 0);
11846 for (i = 0; i < listLen; i++) {
11849 Jim_ListIndex(interp, argv[1], i, &objPtr, JIM_NONE);
11850 Jim_AppendObj(interp, resObjPtr, objPtr);
11851 if (i+1 != listLen) {
11852 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
11855 Jim_SetResult(interp, resObjPtr);
11860 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc,
11861 Jim_Obj *const *argv)
11866 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
11869 objPtr = Jim_FormatString(interp, argv[1], argc-2, argv+2);
11870 if (objPtr == NULL)
11872 Jim_SetResult(interp, objPtr);
11877 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc,
11878 Jim_Obj *const *argv)
11880 Jim_Obj *listPtr, **outVec;
11881 int outc, i, count = 0;
11884 Jim_WrongNumArgs(interp, 1, argv, "string formatString ?varName ...?");
11887 if (argv[2]->typePtr != &scanFmtStringObjType)
11888 SetScanFmtFromAny(interp, argv[2]);
11889 if (FormatGetError(argv[2]) != 0) {
11890 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
11894 int maxPos = FormatGetMaxPos(argv[2]);
11895 int count = FormatGetCnvCount(argv[2]);
11896 if (maxPos > argc-3) {
11897 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
11899 } else if (count != 0 && count < argc-3) {
11900 Jim_SetResultString(interp, "variable is not assigned by any "
11901 "conversion specifiers", -1);
11903 } else if (count > argc-3) {
11904 Jim_SetResultString(interp, "different numbers of variable names and "
11905 "field specifiers", -1);
11909 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
11914 if (listPtr != 0 && listPtr != (Jim_Obj*)EOF)
11915 Jim_ListLength(interp, listPtr, &len);
11916 if (listPtr == (Jim_Obj*)EOF || len == 0) { // XXX
11917 Jim_SetResult(interp, Jim_NewIntObj(interp, -1));
11920 JimListGetElements(interp, listPtr, &outc, &outVec);
11921 for (i = 0; i < outc; ++i) {
11922 if (Jim_Length(outVec[i]) > 0) {
11924 if (Jim_SetVariable(interp, argv[3+i], outVec[i]) != JIM_OK)
11928 Jim_FreeNewObj(interp, listPtr);
11929 Jim_SetResult(interp, Jim_NewIntObj(interp, count));
11931 if (listPtr == (Jim_Obj*)EOF) {
11932 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
11935 Jim_SetResult(interp, listPtr);
11939 Jim_FreeNewObj(interp, listPtr);
11944 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc,
11945 Jim_Obj *const *argv)
11948 Jim_WrongNumArgs(interp, 1, argv, "message");
11951 Jim_SetResult(interp, argv[1]);
11956 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc,
11957 Jim_Obj *const *argv)
11962 Jim_WrongNumArgs(interp, 1, argv, "list first last");
11965 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
11967 Jim_SetResult(interp, objPtr);
11972 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc,
11973 Jim_Obj *const *argv)
11979 extern char **environ;
11982 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11984 for (i = 0; environ[i]; i++) {
11985 const char *equals = strchr(environ[i], '=');
11987 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, environ[i], equals - environ[i]));
11988 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
11992 Jim_SetResult(interp, listObjPtr);
11997 Jim_WrongNumArgs(interp, 1, argv, "varName");
12000 key = Jim_GetString(argv[1], NULL);
12003 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12004 Jim_AppendStrings(interp, Jim_GetResult(interp),
12005 "environment variable \"",
12006 key, "\" does not exist", NULL);
12009 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
12014 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc,
12015 Jim_Obj *const *argv)
12020 Jim_WrongNumArgs(interp, 1, argv, "fileName");
12023 retval = Jim_EvalFile(interp, Jim_GetString(argv[1], NULL));
12024 if (retval == JIM_ERR) {
12025 return JIM_ERR_ADDSTACK;
12027 if (retval == JIM_RETURN)
12033 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc,
12034 Jim_Obj *const *argv)
12036 Jim_Obj *revObjPtr, **ele;
12040 Jim_WrongNumArgs(interp, 1, argv, "list");
12043 JimListGetElements(interp, argv[1], &len, &ele);
12045 revObjPtr = Jim_NewListObj(interp, NULL, 0);
12047 ListAppendElement(revObjPtr, ele[len--]);
12048 Jim_SetResult(interp, revObjPtr);
12052 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
12056 if (step == 0) return -1;
12057 if (start == end) return 0;
12058 else if (step > 0 && start > end) return -1;
12059 else if (step < 0 && end > start) return -1;
12061 if (len < 0) len = -len; /* abs(len) */
12062 if (step < 0) step = -step; /* abs(step) */
12063 len = 1 + ((len-1)/step);
12064 /* We can truncate safely to INT_MAX, the range command
12065 * will always return an error for a such long range
12066 * because Tcl lists can't be so long. */
12067 if (len > INT_MAX) len = INT_MAX;
12068 return (int)((len < 0) ? -1 : len);
12072 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc,
12073 Jim_Obj *const *argv)
12075 jim_wide start = 0, end, step = 1;
12079 if (argc < 2 || argc > 4) {
12080 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
12084 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
12087 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
12088 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
12090 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
12093 if ((len = JimRangeLen(start, end, step)) == -1) {
12094 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
12097 objPtr = Jim_NewListObj(interp, NULL, 0);
12098 for (i = 0; i < len; i++)
12099 ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step));
12100 Jim_SetResult(interp, objPtr);
12105 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc,
12106 Jim_Obj *const *argv)
12108 jim_wide min = 0, max, len, maxMul;
12110 if (argc < 1 || argc > 3) {
12111 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
12115 max = JIM_WIDE_MAX;
12116 } else if (argc == 2) {
12117 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
12119 } else if (argc == 3) {
12120 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
12121 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
12126 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
12129 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
12133 JimRandomBytes(interp, &r, sizeof(jim_wide));
12134 if (r < 0 || r >= maxMul) continue;
12135 r = (len == 0) ? 0 : r%len;
12136 Jim_SetResult(interp, Jim_NewIntObj(interp, min+r));
12142 static int Jim_PackageCoreCommand(Jim_Interp *interp, int argc,
12143 Jim_Obj *const *argv)
12146 const char *options[] = {
12147 "require", "provide", NULL
12149 enum {OPT_REQUIRE, OPT_PROVIDE};
12152 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
12155 if (Jim_GetEnum(interp, argv[1], options, &option, "option",
12156 JIM_ERRMSG) != JIM_OK)
12159 if (option == OPT_REQUIRE) {
12163 if (Jim_CompareStringImmediate(interp, argv[2], "-exact")) {
12168 if (argc != 3 && argc != 4) {
12169 Jim_WrongNumArgs(interp, 2, argv, "?-exact? package ?version?");
12172 ver = Jim_PackageRequire(interp, Jim_GetString(argv[2], NULL),
12173 argc == 4 ? Jim_GetString(argv[3], NULL) : "",
12176 return JIM_ERR_ADDSTACK;
12177 Jim_SetResultString(interp, ver, -1);
12178 } else if (option == OPT_PROVIDE) {
12180 Jim_WrongNumArgs(interp, 2, argv, "package version");
12183 return Jim_PackageProvide(interp, Jim_GetString(argv[2], NULL),
12184 Jim_GetString(argv[3], NULL), JIM_ERRMSG);
12191 Jim_CmdProc cmdProc;
12192 } Jim_CoreCommandsTable[] = {
12193 {"set", Jim_SetCoreCommand},
12194 {"unset", Jim_UnsetCoreCommand},
12195 {"puts", Jim_PutsCoreCommand},
12196 {"+", Jim_AddCoreCommand},
12197 {"*", Jim_MulCoreCommand},
12198 {"-", Jim_SubCoreCommand},
12199 {"/", Jim_DivCoreCommand},
12200 {"incr", Jim_IncrCoreCommand},
12201 {"while", Jim_WhileCoreCommand},
12202 {"for", Jim_ForCoreCommand},
12203 {"foreach", Jim_ForeachCoreCommand},
12204 {"lmap", Jim_LmapCoreCommand},
12205 {"if", Jim_IfCoreCommand},
12206 {"switch", Jim_SwitchCoreCommand},
12207 {"list", Jim_ListCoreCommand},
12208 {"lindex", Jim_LindexCoreCommand},
12209 {"lset", Jim_LsetCoreCommand},
12210 {"llength", Jim_LlengthCoreCommand},
12211 {"lappend", Jim_LappendCoreCommand},
12212 {"linsert", Jim_LinsertCoreCommand},
12213 {"lsort", Jim_LsortCoreCommand},
12214 {"append", Jim_AppendCoreCommand},
12215 {"debug", Jim_DebugCoreCommand},
12216 {"eval", Jim_EvalCoreCommand},
12217 {"uplevel", Jim_UplevelCoreCommand},
12218 {"expr", Jim_ExprCoreCommand},
12219 {"break", Jim_BreakCoreCommand},
12220 {"continue", Jim_ContinueCoreCommand},
12221 {"proc", Jim_ProcCoreCommand},
12222 {"concat", Jim_ConcatCoreCommand},
12223 {"return", Jim_ReturnCoreCommand},
12224 {"upvar", Jim_UpvarCoreCommand},
12225 {"global", Jim_GlobalCoreCommand},
12226 {"string", Jim_StringCoreCommand},
12227 {"time", Jim_TimeCoreCommand},
12228 {"exit", Jim_ExitCoreCommand},
12229 {"catch", Jim_CatchCoreCommand},
12230 {"ref", Jim_RefCoreCommand},
12231 {"getref", Jim_GetrefCoreCommand},
12232 {"setref", Jim_SetrefCoreCommand},
12233 {"finalize", Jim_FinalizeCoreCommand},
12234 {"collect", Jim_CollectCoreCommand},
12235 {"rename", Jim_RenameCoreCommand},
12236 {"dict", Jim_DictCoreCommand},
12237 {"load", Jim_LoadCoreCommand},
12238 {"subst", Jim_SubstCoreCommand},
12239 {"info", Jim_InfoCoreCommand},
12240 {"split", Jim_SplitCoreCommand},
12241 {"join", Jim_JoinCoreCommand},
12242 {"format", Jim_FormatCoreCommand},
12243 {"scan", Jim_ScanCoreCommand},
12244 {"error", Jim_ErrorCoreCommand},
12245 {"lrange", Jim_LrangeCoreCommand},
12246 {"env", Jim_EnvCoreCommand},
12247 {"source", Jim_SourceCoreCommand},
12248 {"lreverse", Jim_LreverseCoreCommand},
12249 {"range", Jim_RangeCoreCommand},
12250 {"rand", Jim_RandCoreCommand},
12251 {"package", Jim_PackageCoreCommand},
12252 {"tailcall", Jim_TailcallCoreCommand},
12256 /* Some Jim core command is actually a procedure written in Jim itself. */
12257 static void Jim_RegisterCoreProcedures(Jim_Interp *interp)
12259 Jim_Eval(interp, (char*)
12260 "proc lambda {arglist args} {\n"
12261 " set name [ref {} function lambdaFinalizer]\n"
12262 " uplevel 1 [list proc $name $arglist {expand}$args]\n"
12265 "proc lambdaFinalizer {name val} {\n"
12266 " rename $name {}\n"
12271 void Jim_RegisterCoreCommands(Jim_Interp *interp)
12275 while(Jim_CoreCommandsTable[i].name != NULL) {
12276 Jim_CreateCommand(interp,
12277 Jim_CoreCommandsTable[i].name,
12278 Jim_CoreCommandsTable[i].cmdProc,
12282 Jim_RegisterCoreProcedures(interp);
12285 /* -----------------------------------------------------------------------------
12286 * Interactive prompt
12287 * ---------------------------------------------------------------------------*/
12288 void Jim_PrintErrorMessage(Jim_Interp *interp)
12292 if (*interp->errorFileName) {
12293 Jim_fprintf(interp, interp->cookie_stderr, "Runtime error, file \"%s\", line %d:" JIM_NL " ",
12294 interp->errorFileName, interp->errorLine);
12296 Jim_fprintf(interp,interp->cookie_stderr, "%s" JIM_NL,
12297 Jim_GetString(interp->result, NULL));
12298 Jim_ListLength(interp, interp->stackTrace, &len);
12299 for (i = len-3; i >= 0; i-= 3) {
12301 const char *proc, *file, *line;
12303 Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
12304 proc = Jim_GetString(objPtr, NULL);
12305 Jim_ListIndex(interp, interp->stackTrace, i+1, &objPtr,
12307 file = Jim_GetString(objPtr, NULL);
12308 Jim_ListIndex(interp, interp->stackTrace, i+2, &objPtr,
12310 line = Jim_GetString(objPtr, NULL);
12312 Jim_fprintf( interp, interp->cookie_stderr,
12313 "in procedure '%s' ", proc);
12316 Jim_fprintf( interp, interp->cookie_stderr,
12317 "called at file \"%s\", line %s",
12320 if (*file || *proc) {
12321 Jim_fprintf( interp, interp->cookie_stderr, JIM_NL);
12326 int Jim_InteractivePrompt(Jim_Interp *interp)
12328 int retcode = JIM_OK;
12329 Jim_Obj *scriptObjPtr;
12331 Jim_fprintf(interp,interp->cookie_stdout, "Welcome to Jim version %d.%d, "
12332 "Copyright (c) 2005-8 Salvatore Sanfilippo" JIM_NL,
12333 JIM_VERSION / 100, JIM_VERSION % 100);
12334 Jim_SetVariableStrWithStr(interp, "jim_interactive", "1");
12337 const char *result;
12338 const char *retcodestr[] = {
12339 "ok", "error", "return", "break", "continue", "eval", "exit"
12343 if (retcode != 0) {
12344 if (retcode >= 2 && retcode <= 6)
12345 Jim_fprintf(interp,interp->cookie_stdout, "[%s] . ", retcodestr[retcode]);
12347 Jim_fprintf(interp,interp->cookie_stdout, "[%d] . ", retcode);
12349 Jim_fprintf( interp, interp->cookie_stdout, ". ");
12350 Jim_fflush( interp, interp->cookie_stdout);
12351 scriptObjPtr = Jim_NewStringObj(interp, "", 0);
12352 Jim_IncrRefCount(scriptObjPtr);
12358 if ( Jim_fgets(interp, buf, 1024, interp->cookie_stdin) == NULL) {
12359 Jim_DecrRefCount(interp, scriptObjPtr);
12362 Jim_AppendString(interp, scriptObjPtr, buf, -1);
12363 str = Jim_GetString(scriptObjPtr, &len);
12364 if (Jim_ScriptIsComplete(str, len, &state))
12366 Jim_fprintf( interp, interp->cookie_stdout, "%c> ", state);
12367 Jim_fflush( interp, interp->cookie_stdout);
12369 retcode = Jim_EvalObj(interp, scriptObjPtr);
12370 Jim_DecrRefCount(interp, scriptObjPtr);
12371 result = Jim_GetString(Jim_GetResult(interp), &reslen);
12372 if (retcode == JIM_ERR) {
12373 Jim_PrintErrorMessage(interp);
12374 } else if (retcode == JIM_EXIT) {
12375 exit(Jim_GetExitCode(interp));
12378 Jim_fwrite( interp, result, 1, reslen, interp->cookie_stdout);
12379 Jim_fprintf( interp,interp->cookie_stdout, JIM_NL);
12387 /* -----------------------------------------------------------------------------
12388 * Jim's idea of STDIO..
12389 * ---------------------------------------------------------------------------*/
12391 int Jim_fprintf( Jim_Interp *interp, void *cookie, const char *fmt, ... )
12397 r = Jim_vfprintf( interp, cookie, fmt,ap );
12402 int Jim_vfprintf( Jim_Interp *interp, void *cookie, const char *fmt, va_list ap )
12404 if( (interp == NULL) || (interp->cb_vfprintf == NULL) ){
12408 return (*(interp->cb_vfprintf))( cookie, fmt, ap );
12411 size_t Jim_fwrite( Jim_Interp *interp, const void *ptr, size_t size, size_t n, void *cookie )
12413 if( (interp == NULL) || (interp->cb_fwrite == NULL) ){
12417 return (*(interp->cb_fwrite))( ptr, size, n, cookie);
12420 size_t Jim_fread( Jim_Interp *interp, void *ptr, size_t size, size_t n, void *cookie )
12422 if( (interp == NULL) || (interp->cb_fread == NULL) ){
12426 return (*(interp->cb_fread))( ptr, size, n, cookie);
12429 int Jim_fflush( Jim_Interp *interp, void *cookie )
12431 if( (interp == NULL) || (interp->cb_fflush == NULL) ){
12432 /* pretend all is well */
12435 return (*(interp->cb_fflush))( cookie );
12438 char* Jim_fgets( Jim_Interp *interp, char *s, int size, void *cookie )
12440 if( (interp == NULL) || (interp->cb_fgets == NULL) ){
12444 return (*(interp->cb_fgets))( s, size, cookie );
12447 Jim_Nvp_name2value_simple( const Jim_Nvp *p, const char *name )
12450 if( 0 == strcmp( name, p->name ) ){
12455 return ((Jim_Nvp *)(p));
12459 Jim_Nvp_name2value_nocase_simple( const Jim_Nvp *p, const char *name )
12462 if( 0 == strcasecmp( name, p->name ) ){
12467 return ((Jim_Nvp *)(p));
12471 Jim_Nvp_name2value_obj( Jim_Interp *interp,
12476 return Jim_Nvp_name2value( interp, p, Jim_GetString( o, NULL ), result );
12481 Jim_Nvp_name2value( Jim_Interp *interp,
12488 p = Jim_Nvp_name2value_simple( _p, name );
12492 *result = (Jim_Nvp *)(p);
12504 Jim_Nvp_name2value_obj_nocase( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **puthere )
12506 return Jim_Nvp_name2value_nocase( interp, p, Jim_GetString( o, NULL ), puthere );
12510 Jim_Nvp_name2value_nocase( Jim_Interp *interp, const Jim_Nvp *_p, const char *name, Jim_Nvp **puthere )
12514 p = Jim_Nvp_name2value_nocase_simple( _p, name );
12517 *puthere = (Jim_Nvp *)(p);
12529 Jim_Nvp_value2name_obj( Jim_Interp *interp, const Jim_Nvp *p, Jim_Obj *o, Jim_Nvp **result )
12534 e = Jim_GetWide( interp, o, &w );
12539 return Jim_Nvp_value2name( interp, p, w, result );
12543 Jim_Nvp_value2name_simple( const Jim_Nvp *p, int value )
12546 if( value == p->value ){
12551 return ((Jim_Nvp *)(p));
12556 Jim_Nvp_value2name( Jim_Interp *interp, const Jim_Nvp *_p, int value, Jim_Nvp **result )
12560 p = Jim_Nvp_value2name_simple( _p, value );
12563 *result = (Jim_Nvp *)(p);
12575 Jim_GetOpt_Setup( Jim_GetOptInfo *p, Jim_Interp *interp, int argc, Jim_Obj * const * argv)
12577 memset( p, 0, sizeof(*p) );
12578 p->interp = interp;
12586 Jim_GetOpt_Debug( Jim_GetOptInfo *p )
12590 Jim_fprintf( p->interp, p->interp->cookie_stderr, "---args---\n");
12591 for( x = 0 ; x < p->argc ; x++ ){
12592 Jim_fprintf( p->interp, p->interp->cookie_stderr,
12595 Jim_GetString( p->argv[x], NULL ) );
12597 Jim_fprintf( p->interp, p->interp->cookie_stderr, "-------\n");
12602 Jim_GetOpt_Obj( Jim_GetOptInfo *goi, Jim_Obj **puthere )
12606 o = NULL; // failure
12624 Jim_GetOpt_String( Jim_GetOptInfo *goi, char **puthere, int *len )
12631 r = Jim_GetOpt_Obj( goi, &o );
12633 cp = Jim_GetString( o, len );
12636 *puthere = (char *)(cp);
12643 Jim_GetOpt_Double( Jim_GetOptInfo *goi, double *puthere )
12649 if( puthere == NULL ){
12653 r = Jim_GetOpt_Obj( goi, &o );
12655 r = Jim_GetDouble( goi->interp, o, puthere );
12657 Jim_SetResult_sprintf( goi->interp,
12658 "not a number: %s",
12659 Jim_GetString( o, NULL ) );
12666 Jim_GetOpt_Wide( Jim_GetOptInfo *goi, jim_wide *puthere )
12672 if( puthere == NULL ){
12676 r = Jim_GetOpt_Obj( goi, &o );
12678 r = Jim_GetWide( goi->interp, o, puthere );
12683 int Jim_GetOpt_Nvp( Jim_GetOptInfo *goi,
12684 const Jim_Nvp *nvp,
12691 if( puthere == NULL ){
12695 e = Jim_GetOpt_Obj( goi, &o );
12697 e = Jim_Nvp_name2value_obj( goi->interp,
12707 Jim_GetOpt_NvpUnknown( Jim_GetOptInfo *goi,
12708 const Jim_Nvp *nvptable,
12712 Jim_SetResult_NvpUnknown( goi->interp,
12717 Jim_SetResult_NvpUnknown( goi->interp,
12726 Jim_GetOpt_Enum( Jim_GetOptInfo *goi,
12727 const char * const * lookup,
12734 if( puthere == NULL ){
12737 e = Jim_GetOpt_Obj( goi, &o );
12739 e = Jim_GetEnum( goi->interp,
12752 Jim_SetResult_sprintf( Jim_Interp *interp, const char *fmt,... )
12758 buf = jim_vasprintf( fmt, ap );
12761 Jim_SetResultString( interp, buf, -1 );
12762 jim_vasprintf_done(buf);
12769 Jim_SetResult_NvpUnknown( Jim_Interp *interp,
12770 Jim_Obj *param_name,
12771 Jim_Obj *param_value,
12772 const Jim_Nvp *nvp )
12775 Jim_SetResult_sprintf( interp,
12776 "%s: Unknown: %s, try one of: ",
12777 Jim_GetString( param_name, NULL ),
12778 Jim_GetString( param_value, NULL ) );
12780 Jim_SetResult_sprintf( interp,
12781 "Unknown param: %s, try one of: ",
12782 Jim_GetString( param_value, NULL ) );
12784 while( nvp->name ){
12788 if( (nvp+1)->name ){
12795 Jim_AppendStrings( interp,
12796 Jim_GetResult(interp),
12803 static Jim_Obj *debug_string_obj;
12806 Jim_Debug_ArgvString( Jim_Interp *interp, int argc, Jim_Obj *const *argv )
12810 if( debug_string_obj ){
12811 Jim_FreeObj( interp, debug_string_obj );
12814 debug_string_obj = Jim_NewEmptyStringObj( interp );
12815 for( x = 0 ; x < argc ; x++ ){
12816 Jim_AppendStrings( interp,
12818 Jim_GetString( argv[x], NULL ),
12823 return Jim_GetString( debug_string_obj, NULL );
12829 * Local Variables: ***
12830 * c-basic-offset: 4 ***